Skip to content

R
riscv-gcc-1
Commit 3e4035f8 by Toon Moene Committed by Toon Moene
Options

libf2c: Removed. 

2004-07-15  Toon Moene  <toon@moene.indiv.nluug.nl>

	* libf2c: Removed.
	* gcc/gccbug.in: Updated because of libf2c removal.
	* maintainer-scripts/gcc_release: Ditto.

From-SVN: r84759
parent 48b45647
Showing with 8 additions and 19668 deletions
ChangeLog
2004-07-15 Toon Moene <toon@moene.indiv.nluug.nl>
* libf2c: Removed.
* gcc/gccbug.in: Updated because of libf2c removal.
* maintainer-scripts/gcc_release: Ditto.
2004-07-09 Loren J. Rittle <ljrittle@acm.org>
* configure.in: Build libmudflap by default on FreeBSD.
......
gcc/gccbug.in
......@@ -198,7 +198,7 @@ EOF
done
# spam does not need to be listed here
CATEGORIES="ada bootstrap c++ c debug driver fortran inline-asm java libf2c libgcj libobjc libstdc++ middle-end objc other pch preprocessor rtl-optimization target tree-optimization web"
CATEGORIES="ada bootstrap c++ c debug driver fortran inline-asm java libgcj libobjc libstdc++ middle-end objc other pch preprocessor rtl-optimization target tree-optimization web"
case "$FORMAT" in
lisp) echo "$CATEGORIES" | \
......
libf2c/ChangeLog deleted 100644 → 0
Thu Feb 5 15:08:08 2004 Geoffrey Keating <geoffk@apple.com>
PR 12179
* aclocal.m4 (GLIBCPP_EXPORT_INSTALL_INFO): Use 'gcc', not 'gcc-lib'.
Add comment about poorly-named variables.
* Makefile.in (libsubdir): Use 'gcc', not 'gcc-lib'.
* configure: Regenerate.
2004-01-14 Kelley Cook <kcook@gcc.gnu.org>
* libF77/configure.in: Update to AC_PREREQ(2.13)
* libI77/configure.in: Update to AC_PREREQ(2.13)
* libU77/configure.in: Update to AC_PREREQ(2.13)
* libU77/configure: Regenerate.
2003-10-14 Nathanael Nerode <neroden@gcc.gnu.org>
* configure: Regenerate.
2003-09-21 Toon Moene <toon@moene.indiv.nluug.nl>
PR libf2c/11918
* fstat_.c: Call f_init().
* isatty_.c: Ditto.
* fnum_.c: Check file descriptor before handing it back.
Tue Sep 9 15:22:57 2003 Alan Modra <amodra@bigpond.net.au>
* configure: Regenerate.
2003-07-04 H.J. Lu <hongjiu.lu@intel.com>
* Makefile.in: Replace PWD with PWD_COMMAND.
2003-06-15 Nathanael Nerode <neroden@gcc.gnu.org>
* libU77/bes.c, libU77/dbes.c: Remove.
* libU77/Makefile.in: Remove references to bes.c, dbes.c
2003-04-21 Loren J. Rittle <ljrittle@acm.org>
* libI77/configure.in (_XOPEN_SOURCE): Bump to 600.
* libI77/configure: Regenerate.
* libU77/configure.in (_XOPEN_SOURCE): Bump to 600.
* libU77/configure: Regenerate.
2003-04-11 Bud Davis <bdavis9659@comcast.net>
PR Fortran/1832
* libf2c/libI77/iio.c (z_putc): Check for overflowing length
of output string.
2003-03-24 Bud Davis <bdavis9659@comcast.net>
PR fortran/10197
* libI77/open.c (f_open): A DIRECT ACCESS file is
UNFORMATTED by default.
Wed Mar 12 22:27:14 2003 Andreas Schwab <schwab@suse.de>
* aclocal.m4 (GLIBCPP_EXPORT_INSTALL_INFO): Avoid trailing /. in
glibcpp_toolexeclibdir.
* configure: Rebuilt.
2003-02-20 Alexandre Oliva <aoliva@redhat.com>
* configure.in: Propagate ORIGINAL_LD_FOR_MULTILIBS to
config.status.
* configure: Rebuilt.
2003-02-03 Andreas Jaeger <aj@suse.de>
* libU77/configure.in (AC_PROG_CC_WORKS): Define _GNU_SOURCE.
* libU77/config.hin: Regenerated.
* libU77/configure: Regenerated.
2003-01-27 Alexandre Oliva <aoliva@redhat.com>
* Makefile.in ($(LIBG2C)): -rpath is glibcpp_toolexeclibdir.
* aclocal.m4 (glibcpp_toolexeclibdir): Instead of
$(MULTISUBDIR), use `$CC -print-multi-os-directory`, unless
version_specific_libs is enabled.
* configure: Rebuilt.
2003-01-09 Christian Cornelssen <ccorn@cs.tu-berlin.de>
* Makefile.in (FLAGS_TO_PASS): Also pass DESTDIR.
(install, uninstall): Prepend $(DESTDIR) to destination
paths in all (un)installation commands.
Wed Dec 18 11:33:35 2002 Jason Merrill <jason@redhat.com>
* libU77/date_.c (G77_date_y2kbuggy_0): Declare G77_abort_0 noreturn.
* libU77/vxtidate_.c (G77_vxtidate_y2kbuggy_0): Likewise.
2002-11-26 Nathanael Nerode <neroden@gcc.gnu.org>
* configure.in: Remove skip-this-dir support.
* configure: Regenerate.
2002-11-19 Toon Moene <toon@moene.indiv.nluug.nl>
PR fortran/8587
* libF77/pow_zz.c: Handle (0.0, 0.0) ** power.
2002-10-18 Krister Walfridsson <cato@df.lth.se>
* libU77/configure.in (_XOPEN_SOURCE, _XOPEN_SOURCE_EXTENDED,
__EXTENSIONS__, _FILE_OFFSET_BITS): Check that _XOPEN_SOURCE 500L
may be defined before defining these.
* libU77/configure: Regenerate.
* libI77/configure.in (_XOPEN_SOURCE, _XOPEN_SOURCE_EXTENDED,
__EXTENSIONS__, _FILE_OFFSET_BITS): Check that _XOPEN_SOURCE 500L
may be defined before defining these.
* libI77/configure: Regenerate.
2002-09-23 Zack Weinberg <zack@codesourcery.com>
* libF77/Version.c: Rename junk to __LIBF77_VERSION__. Add
external decls for __LIBI77_VERSION__ and __LIBU77_VERSION__.
Delete __G77_LIBF77_VERSION__
(g77__fvers__): Print all three __LIB*77_VERSION__ strings,
and __VERSION__ if we have it; nothing else.
* libI77/Version.c: Provide only __LIBI77_VERSION__ (formerly junk).
* libU77/Version.c: Provide only __LIBU77_VERSION__ (formerly junk).
Sun Sep 22 23:43:37 2002 Kaveh R. Ghazi <ghazi@caip.rutgers.edu>
* Makefile.in (all): Fix multilib parallel build.
2002-09-14 Tim Prince <tprince@computer.org>
PR libf2c/7384
* libU77/datetime_.c: Use GetLocalTime on MS-Windows.
2002-08-31 Toon Moene <toon@moene.indiv.nluug.nl>
PR fortran/6367
* libI77/rsne.c (x_rsne): Use local variable no2 to count further
list elements to read.
2002-07-10 Toon Moene <toon@moene.indiv.nluug.nl>
* libI77/open.c (f_open): Do not indicate unformatted file
if record length is given without a FORMATTED/UNFORMATTED
specification.
2002-06-25 DJ Delorie <dj@redhat.com>
* aclocal.m4 (GLIBCPP_CONFIGURE): Split out
GLIBCPP_TOPREL_CONFIGURE.
* configure.in: Call it before AC_CANONICAL_SYSTEM.
* configure: Regenerate.
Wed Jun 5 15:05:41 2002 Kaveh R. Ghazi <ghazi@caip.rutgers.edu>
* f2cext.c (alarm_): Mark parameter(s) with attribute `unused'.
* libF77/h_len.c (h_len): Likewise.
* libF77/i_len.c (i_len): Likewise.
* libI77/rsli.c (i_ungetc): Likewise.
* libU77/date_.c (G77_date_y2kbuggy_0): Likewise.
* libU77/fputc_.c (G77_fputc_0): Likewise.
* libU77/vxtidate_.c (G77_vxtidate_y2kbuggy_0): Likewise.
* libU77/vxttime_.c (G77_vxttime_0): Likewise.
Mon Jun 3 22:24:48 2002 Kaveh R. Ghazi <ghazi@caip.rutgers.edu>
* libF77/main.c (f_setarg, f_setsig): Prototype.
* libI77/lread.c (quad_read): Delete.
* libI77/uio.c: Include config.h.
* libI77/wref.c (wrt_E): Cast isdigit arg to unsigned char.
* libU77/dtime_.c (clk_tck): Move to the scope where it is used.
* libU77/etime_.c (clk_tck): Likewise.
Mon Jun 3 22:23:03 2002 Kaveh R. Ghazi <ghazi@caip.rutgers.edu>
* libF77/lbitbits.c (lbit_cshift): disambiguate expressions
with parentheses.
* libF77/qbitbits.c (qbit_cshift): Likewise.
* libI77/inquire.c (f_inqu): Likewise.
* libI77/rdfmt.c (rd_Z): Likewise.
* libI77/rsne.c (x_rsne): Likewise.
Mon Jun 3 22:21:23 2002 Kaveh R. Ghazi <ghazi@caip.rutgers.edu>
* Makefile.in (s-libe77): Add WARN_CFLAGS.
Sun Jun 2 10:32:35 2002 Kaveh R. Ghazi <ghazi@caip.rutgers.edu>
* libI77/dfe.c (s_rdfe, s_wdfe): Wrap parentheses around
assignment used as truth value.
* libI77/due.c (s_rdue, s_wdue): Likewise.
* libI77/endfile.c (f_end): Likewise.
* libI77/iio.c (s_rsfi, s_wsfi): Likewise.
* libI77/lread.c (ERR, l_C, nmL_getc, s_rsle): Likewise.
* libI77/lwrite.c (l_g, l_put): Likewise.
* libI77/open.c (f_open): Likewise.
* libI77/rdfmt.c (rd_Z): Likewise.
* libI77/rsfe.c (s_rsfe): Likewise.
* libI77/rsne.c (hash, mk_hashtab, nl_init, getname, getdimen,
x_rsne, s_rsne): Likewise.
* libI77/sue.c (s_rsue, s_wsue): Likewise.
* libI77/wref.c (wrt_E, wrt_F): Likewise.
* libI77/wsfe.c (s_wsfe): Likewise.
* libI77/wsle.c (s_wsle): Likewise.
* libI77/wsne.c (s_wsne): Likewise.
Sun Jun 2 08:59:50 2002 Kaveh R. Ghazi <ghazi@caip.rutgers.edu>
* libF77/main.c (main): Avoid implicit int.
* libI77/dfe.c (y_rsk, y_getc, c_dfe): Likewise.
* libI77/due.c (c_due): Likewise.
* libI77/err.c (f__canseek, f__nowreading, f__nowwriting):
Likewise.
* libI77/fmt.c (op_gen, ne_d, e_d, pars_f, type_f, en_fio):
Likewise.
* libI77/iio.c (z_getc, z_rnew, c_si, z_wnew): Likewise.
* libI77/lread.c (t_getc, c_le, l_read): Likewise.
* libI77/lwrite.c (l_write): Likewise.
* libI77/open.c (fk_open): Likewise.
* libI77/rdfmt.c (rd_ed, rd_ned): Likewise.
* libI77/rsfe.c (xrd_SL, x_getc, x_endp, x_rev): Likewise.
* libI77/rsne.c (t_getc, x_rsne): Likewise.
* libI77/sfe.c (c_sfe): Likewise.
* libI77/sue.c (c_sue): Likewise.
* libI77/uio.c (do_us): Likewise.
* libI77/wref.c (wrt_E, wrt_F): Likewise.
* libI77/wrtfmt.c (wrt_L, w_ed, w_ned): Likewise.
Sun Jun 2 08:58:05 2002 Kaveh R. Ghazi <ghazi@caip.rutgers.edu>
* libI77/rdfmt.c (rd_I): Delete unused variable(s).
* libU77/access_.c (G77_access_0): Likewise.
* libU77/chdir_.c (G77_chdir_0): Likewise.
* libU77/chmod_.c (G77_chmod_0): Likewise.
* libU77/ctime_.c (G77_ctime_0): Likewise.
* libU77/link_.c (G77_link_0): Likewise.
* libU77/lstat_.c (G77_lstat_0): Likewise.
* libU77/rename_.c (G77_rename_0): Likewise.
* libU77/stat_.c (G77_stat_0): Likewise.
* libU77/symlnk_.c (G77_symlnk_0): Likewise.
* libU77/unlink_.c (G77_unlink_0): Likewise.
Sun Jun 2 08:55:20 2002 Kaveh R. Ghazi <ghazi@caip.rutgers.edu>
* libI77/inquire.c (f_inqu): Avoid ambiguous else clauses.
* libI77/lread.c (l_C, l_L): Likewise.
* libI77/open.c (f_open): Likewise.
* libI77/rsne.c (x_rsne): Likewise.
* libI77/wref.c (wrt_F): Likewise.
Sun Jun 2 08:53:15 2002 Kaveh R. Ghazi <ghazi@caip.rutgers.edu>
* libF77/getenv_.c (G77_getenv_0): Avoid signed/unsigned warning.
* libF77/system_.c (G77_system_0): Likewise.
* libI77/open.c (f_open): Likewise.
* libI77/rdfmt.c (rd_Z): Likewise.
* libI77/uio.c (do_us, do_ud): Likewise.
Sat Jun 1 08:33:14 2002 Kaveh R. Ghazi <ghazi@caip.rutgers.edu>
* libF77/*: Fix formatting.
* libI77/*: Likewise.
* libU77/*: Likewise.
Fri May 31 21:56:30 2002 Kaveh R. Ghazi <ghazi@caip.rutgers.edu>
* g2c.hin, libF77/d_cnjg.c, libF77/main.c, libF77/r_cnjg.c,
libF77/s_cat.c, libF77/s_paus.c, libF77/s_rnge.c, libF77/setarg.c,
libF77/setsig.c, libF77/signal1.h0, libI77/dfe.c, libI77/due.c,
libI77/err.c, libI77/fio.h, libI77/fmt.c, libI77/iio.c,
libI77/ilnw.c, libI77/lread.c, libI77/lwrite.c, libI77/rsfe.c,
libI77/rsli.c, libI77/rsne.c, libI77/sfe.c, libI77/sue.c,
libI77/util.c, libI77/wrtfmt.c, libI77/wsfe.c, libI77/wsle.c,
libI77/xwsne.c, libU77/date_.c: Kill VOID, Void and Int.
Fri May 31 21:54:37 2002 Kaveh R. Ghazi <ghazi@caip.rutgers.edu>
* libF77/F77_aloc.c, libF77/exit_.c, libF77/main.c,
libF77/s_paus.c, libF77/s_stop.c, libF77/setarg.c,
libF77/setsig.c, libF77/sig_die.c, libF77/signal1.h0,
libI77/close.c, libI77/dolio.c, libI77/fio.h, libI77/fmt.h,
libI77/lio.h: Delete checks on __cplusplus.
Fri May 31 21:50:01 2002 Kaveh R. Ghazi <ghazi@caip.rutgers.edu>
* libF77/*: Delete KR_headers cruft.
* libI77/*: Likewise.
* libU77/*: Likewise.
Thu May 30 23:04:52 2002 Kaveh R. Ghazi <ghazi@caip.rutgers.edu>
* Makefile.in (WARN_CFLAGS): New.
(FLAGS_TO_PASS): Add WARN_CFLAGS.
* libF77/Makefile.in (ALL_CFLAGS): Likewise.
* libI77/Makefile.in (ALL_CFLAGS): Likewise.
* libU77/Makefile.in (ALL_CFLAGS): Likewise.
2002-05-30 H.J. Lu (hjl@gnu.org)
* libI77/open.c (_XOPEN_SOURCE): Removed.
Mon May 20 13:03:54 2002 Kaveh R. Ghazi <ghazi@caip.rutgers.edu>
* libF77/Makefile.in (SHELL): Set to @SHELL@.
* libI77/Makefile.in (SHELL): Likewise.
* libU77/Makefile.in (SHELL): Likewise.
2002-05-20 Toon Moene <toon@moene.indiv.nluug.nl>
* Makefile.in: Use @SHELL@, not /bin/sh for SHELL
definition.
2002-05-16 Rainer Orth <ro@TechFak.Uni-Bielefeld.DE>
* Makefile.in: Allow for PWDCMD to override hardcoded pwd.
* aclocal.m4: Likewise.
* configure: Regenerate.
2002-05-08 Alexandre Oliva <aoliva@redhat.com>
* configure.in (ORIGINAL_LD_FOR_MULTILIBS): Preserve LD at
script entry, and set LD to it when configuring multilibs.
* configure: Rebuilt.
2002-05-02 Alexandre Oliva <aoliva@redhat.com>
* Makefile.in: Fix for multilibbed natives.
2002-04-15 Loren J. Rittle <ljrittle@acm.org>
* aclocal.m4 (gcc_version_trigger): Use robust path construction.
* configure: Rebuilt.
2002-04-11 Toon Moene <toon@moene.indiv.nluug.nl>
* libI77/lio.h: Treat INTEGER*1 as signed char.
2002-03-06 Phil Edwards <pme@gcc.gnu.org>
* libF77/Version.c: Fix misplaced leading blanks on first line.
* libI77/Version.c: Likewise.
* libU77/Version.c: Likewise.
2002-01-28 Geoffrey Keating <geoffk@redhat.com>
* aclocal.m4: Replace with version copied from libstdc++-v3.
* configure.in: Update for changes to aclocal and Makefile.
* configure: Regenerate.
* Makefile.in: Correct install and uninstall for cross targets.
* libU77/configure: Regenerate.
2002-01-20 Toon Moene <toon@moene.indiv.nluug.nl>
* Makefile.in: $(MULTISUBDIR) has an implied leading `/';
remove duplicates.
Use libtool for removing libg2c{a|la|so} for the `uninstall' target.
2002-01-18 Toon Moene <toon@moene.indiv.nluug.nl>
* Makefile.in: Add missing `/' separator in last change.
2002-01-18 Toon Moene <toon@moene.indiv.nluug.nl>
* Makefile.in: Install libg2c.{a|la|so} in $(libdir)$(MULTISUBDIR)
instead of $(libsubdir)$(MULTISUBDIR).
2002-01-15 Loren J. Rittle <ljrittle@acm.org>
* libI77/configure.in: Remove fcntl.h check; never define
_POSIX_SOURCE, NO_FCNTL or OPEN_DECL. Add check for tmpnam().
* libI77/configure: Rebuilt.
* libI77/config.h.in: Rebuilt.
* libI77/Makefile.in: Remove all traces of rawio.h from
dependencies lists.
* libI77/fio.h (FSEEK): Unroll -j1.7 -j1.6 made 2002-01-04.
* libI77/open.c (f_open): Use HAVE_TMPNAM.
* libI77/rawio.h: Remove file.
2002-01-14 John David Anglin <dave@hiauly1.hia.nrc.ca>
* libI77/configure.in (_LARGEFILE_SOURCE): AC_DEFINE.
* libI77/configure: Rebuilt.
* libI77/config.h.in: Rebuilt.
2002-01-04 Loren J. Rittle <ljrittle@acm.org>
* libI77/fio.h (FSEEK): Enforce type of second parameter to be
off_t when prototype is missing from system headers for the
non-standard function.
2002-01-03 Loren J. Rittle <ljrittle@acm.org>
* Makefile.in ($(LIBG2C):): Let libtool decide when to add -lc.
2001-12-04 Alexandre Oliva <aoliva@redhat.com>
* Makefile.in ($(LIBG2C)): Fix -rpath argument to libtool.
* Makefile.in (AR, RANLIB): Add, for substitutions.
(all-unilib, $(LIBG2C)): Depend on object lists, not
convenience libraries.
(s-libe77): Renamed from libE77.la; build object list.
(install): Do not move libraries to libdir.
(mostlyclean, clean): Adjust.
* libF77/Makefile.in (RANLIB): Add.
(LINK): Remove.
(../s-libf77): Renamed from ../libF77.la; build object list.
(../libfrtbegin.a): Remove target first. Don't use $<.
(all, clean, distclean): Adjust.
* libF77/configure.in: Substitute RANLIB.
* libF77/configure: Rebuilt.
* libI77/Makefile.in (LINK): Delete.
(../s-libi77): Renamed from ../libI77.la; build object list.
(all, clean, distclean): Adjust.
* libU77/Makefile.in: Likewise.
2001-12-02 Toon Moene <toon@moene.indiv.nluug.nl>
PR fortran/4885
* endfile.c (t_runc): After ftruncate, seek to end-of-file.
2001-11-25 Toon Moene <toon@moene.indiv.nluug.nl>
* libF77/Makefile.in: Fix non-portable use of `$<' in z_log.c's rule.
2001-11-23 Toon Moene <toon@moene.indiv.nluug.nl>
PR libf2c/4930
* libF77/Makefile.in: Compile z_log.c with -ffloat-store.
2001-11-16 John David Anglin <dave@hiauly1.hia.nrc.ca>
* Makefile.in: Add MAKEOVERRIDES= to suppress exporting
environment to (sub)shells.
2001-11-13 Toon Moene <toon@moene.indiv.nluug.nl>
* Makefile.in: Change dependencies on stamp files
into dependencies on the generated .la files.
Get rid of objlist. Update comment.
* libF77/Makefile.in: Ditto.
* libI77/Makefile.in: Ditto.
* libU77/Makefile.in: Ditto.
2001-10-20 Hans-Peter Nilsson <hp@bitrange.com>
* configure.in: Fake AC_EXEEXT invocation.
* configure: Regenerate.
2001-10-20 David Edelsohn <dje@watson.ibm.com>
* Makefile.in: Do not include SUBDIRS in objlist. Create
libg2c.so from F2CEXT and SUBDIRS archives.
* libF77/Makefile.in: Create archive.
* libI77/Makefile.in: Same.
* libU77/Makefile.in: Same.
2001-10-05 Toon Moene <toon@moene.indiv.nluug.nl>
* Makefile.in: Move libg2c.so and libg2c.{l}a to
the same directory at install.
2001-10-03 Toon Moene <toon@moene.indiv.nluug.nl>
* Makefile.in: Add "AR" reference, change
from frtbegin.o to libfrtbegin.a.
* libF77/Makefile.in: Ditto.
2001-10-02 Toon Moene <toon@moene.indiv.nluug.nl>
* libF77/Makefile.in: Make .lo the target of compilation.
* libI77/Makefile.in: Ditto.
* libU77/Makefile.in: Ditto.
2001-10-01 Toon Moene <toon@moene.indiv.nluug.nl>
* Makefile.in: Set major:minor:sub version number
of shared libf2c to 0:0:0.
2001-09-29 Juergen Pfeifer <juergen.pfeifer@gmx.net>
Toon Moene <toon@moene.indiv.nluug.nl>
Make libf2c a shared library.
* aclocal.m4: Get definition of libtool.
* Makefile.in: Use libtool.
* configure.in: Use libtool.
* configure: Regenerated.
* libF77/Makefile.in: Use libtool; treat main program contained in
libF77/main.c specially.
* libF77/configure.in: Use libtool.
* libF77/configure: Regenerated.
* libI77/Makefile.in: Use libtool.
* libI77/configure.in: Use libtool.
* libI77/configure: Regenerated.
* libU77/Makefile.in: Use libtool.
* libU77/configure.in: Use libtool.
* libU77/configure: Regenerated.
* libU77/date_.c: Adapt for -fPIC compiling.
* libU77/vxtidate_.c: Ditto.
2001-09-22 Richard Earnshaw <rearnsha@arm.com>
* libI77/configure.in (__EXTENSIONS__): Define.
* libI77/config.h.in, libI77/conifgure: regenerate.
* libU77/configure.in (__EXTENSIONS__): Likewise.
2001-07-18 Toon Moene <toon@moene.indiv.nluug.nl>
* libI77/configure.in (_XOPEN_SOURCE, _FILE_OFFSET_BITS): Move
these defines before tests which might be affected by them.
(_XOPEN_SOURCE_EXTENDED): Define.
* libI77/configure, libI77/config.h.in: Regenerate.
Wed Jul 18 11:14:33 2001 Kaveh R. Ghazi <ghazi@caip.rutgers.edu>
* libU77/configure.in (_XOPEN_SOURCE, _FILE_OFFSET_BITS): Move
these defines before tests which might be affected by them.
(_XOPEN_SOURCE_EXTENDED): Define.
* libU77/configure, libU77/config.hin: Regenerate.
2001-07-10 Toon Moene <toon@moene.indiv.nluug.nl>
* libI77/fio.h: Revert type of url from off_t to int.
* libI77/dfe.c (c_dfe): Cast offset expression in FSEEK to off_t.
* libI77/due.c (c_due): Ditto. (e_rdue): Ditto.
* libI77/ftell_.c (G77_ftell_0): Cast result of FTELL to integer.
(G77_fseek_0): Cast offset argument of FSEEK to off_t.
2001-07-07 Toon Moene <toon@moene.indiv.nluug.nl>
* libI77/Makefile.in: Update config.h dependencies.
* libI77/configure.in: Define _XOPEN_SOURCE and
_FILE_OFFSET_BITS unconditionally.
* libI77/configure: Rebuilt.
* libI77/config.h.in: Rebuilt.
* libI77/endfile.c (t_runc): Replace rewind by FSEEK.
* libI77/err.c (f__nowwriting): The type of `loc' is off_t.
* libI77/open.c (f_open): Replace rewind by FSEEK.
* libI77/rewind.c: Include config.h. (f_rew): Replace
rewind by FSEEK.
* libI77/sfe.c: Include config.h.
* libI77/wsfe.c: Ditto.
* libU77/configure.in: Define _XOPEN_SOURCE and
_FILE_OFFSET_BITS unconditionally.
* libU77/configure: Rebuilt.
* libU77/config.hin: Rebuilt.
2001-07-07 Toon Moene <toon@moene.indiv.nluug.nl>
* libI77/Makefile.in: Add necessary dependencies on config.h.
2001-07-06 Toon Moene <toon@moene.indiv.nluug.nl>
Pedro Vazquez <vazquez@penelope.iqm.unicamp.br>
* libI77/configure.in: Check for fseeko, ftello.
* libI77/configure: Rebuilt.
* libI77/config.h.in: Rebuilt.
* libI77/fio.h: Define FSEEK to be fseek or fseeko, depending
on configure's findings. Ditto for FTELL and ftell / ftello.
* libI77/backspace.c (f_back): Use FSEEK for fseek, FTELL for ftell.
* libI77/dfe.c (c_dfe): Ditto.
* libI77/due.c (c_due, e_rdue): Ditto.
* libI77/endfile.c (t_runc): Ditto.
* libI77/err.c (f__nowreading, f__nowwriting): Ditto.
* libI77/ftell_.c (G77_ftell_0, G77_fseek_0): Ditto.
* libI77/inquire.c (f_inqu): Ditto.
* libI77/open.c (f_open): Ditto.
* libI77/rdfmt.c (rd_ed): Ditto.
* libI77/sue.c (s_wsue, e_wsue, e_rsue): Ditto.
2001-07-04 Zack Weinberg <zackw@stanford.edu>
* Makefile.in: Take PICFLAG and RUNTESTFLAGS out of FLAGS_TO_PASS.
2001-07-01 Toon Moene <toon@moene.indiv.nluug.nl>
* libI77/fio.h: Include <sys/types.h> for off_t.
2001-07-01 Toon Moene <toon@moene.indiv.nluug.nl>
Pedro Vazquez <vazquez@penelope.iqm.unicamp.br>
* libI77/fio.h: Use off_t when appropriate.
* libI77/backspace.c (f_back): Ditto.
* libI77/endfile.c (t_runc): Ditto.
* libI77/err.c (f__nowreading): Ditto.
* libI77/ftell_.c (unit_chk): Ditto.
* libI77/sue.c (global f__recloc, s_wsue): Ditto.
2001-06-13 Toon Moene <toon@moene.indiv.nluug.nl>
* libI77/inquire.c: Include "config.h".
2001-05-21 Loren J. Rittle <ljrittle@acm.org>
* libI77/Makefile.in (stamp-h): Create in $(objdir) instead
of $(srcdir).
2001-05-18 Andreas Jaeger <aj@suse.de>
* libI77/Makefile.in (stamp-h): Only create config.h, touch stamp-h.
(${srcdir}/config.h.in): Add true rule.
* libI77/stamp-h.in: Added.
2001-05-17 Andreas Jaeger <aj@suse.de>
* libI77/Makefile.in: Add rules to rebuild config.h.in when
needed.
2001-05-16 Andreas Jaeger <aj@suse.de>
* libI77/backspace.c: Include "config.h".
* libI77/close.c: Likewise.
* libI77/dfe.c: Likewise.
* libI77/dolio.c: Likewise.
* libI77/due.c: Likewise.
* libI77/err.c: Likewise.
* libI77/fmt.c: Likewise.
* libI77/fmtlib.c: Likewise.
* libI77/ftell_.c: Likewise.
* libI77/ilnw.c: Likewise.
* libI77/lread.c: Likewise.
* libI77/open.c: Likewise.
* libI77/rdfmt.c: Likewise.
* libI77/rsfe.c: Likewise.
* libI77/rsne.c: Likewise.
* libI77/util.c: Likewise.
* libI77/wrtfmt.c: Likewise.
* libI77/wsne.c: Likewise.
* libI77/xwsne.c: Likewise.
* libI77/config.h.in: Generate with autoheader.
* libI77/configure.in: Add comments for all AC_DEFINES so that
autoheader can grok it.
* libI77/configure: Regenerated.
2001-05-16 Andreas Jaeger <aj@suse.de>
* libI77/Makefile.in (endfile.o): Add dependency on config.h.
* libI77/endfile.c: Include config.h and sys/types for off_t.
* libI77/config.h.in: New file.
* libI77/configure.in: Add test for off_t, create config.h file.
* libI77/configure: Regenerated.
2001-05-15 Loren J. Rittle <ljrittle@acm.org>
* libI77/endfile.c (t_runc): Add cast to help case where
ftruncate() prototype is somehow missing even though autoconf
test found it properly.
2001-02-26 Toon Moene <toon@moene.indiv.nluug.nl>
* libI77/configure.in: Test for ftruncate.
* libI77/configure: Rebuilt.
* libI77/endfile.c: Use fflush/ftruncate when available.
2001-02-19 Joseph S. Myers <jsm28@cam.ac.uk>
* libF77/Version.c, libI77/Version.c, libU77/Version.c: Update G77
version number to 0.5.27.
2001-02-08 Geoffrey Keating <geoffk@redhat.com>
* configure.in: Don't run AC_PROG_CC_WORKS, because
we're not interested in the result and it might fail.
* libF77/configure.in: Likewise.
* libI77/configure.in: Likewise.
* libU77/configure.in: Likewise.
* configure: Regenerated.
* libF77/configure: Likewise.
* libI77/configure: Likewise.
* libU77/configure: Likewise.
2001-01-29 Phil Edwards <pme@sources.redhat.com>
* libU77/COPYING.LIB: Update to LGPL 2.1 from the FSF.
2001-01-24 Michael Sokolov <msokolov@ivan.Harhan.ORG>
* libU77/alarm_.c: Separate the #ifdef KR_headers logic from the
G77_alarm_0 function definition. Check for SIG_ERR and provide our own
if missing.
2001-01-24 David Billinghurst <David.Billinghurst@riotinto.com>
* libU77/Makefile.in: Explicitly generate a.out for check.
2001-01-23 Michael Sokolov <msokolov@ivan.Harhan.ORG>
* libU77/ctime_.c: #include <sys/types.h> for time_t.
* libU77/datetime_.c: Likewise.
* libU77/fdate_.c: Likewise.
* libU77/gmtime_.c: Likewise.
* libU77/idate_.c: Likewise.
* libU77/itime_.c: Likewise.
* libU77/ltime_.c: Likewise.
* libU77/sys_clock_.c: Likewise.
* libU77/vxtidate_.c: Likewise.
* libU77/vxttime_.c: Likewise.
* libU77/sys_clock_.c: #include <sys/param.h> for the clock tick rate.
2000-12-09 Toon Moene <toon@moene.indiv.nluug.nl>
Update to Netlib version 20001205.
Thanks go to David M. Gay for these updates.
* libF77/Version.c: Update version information.
* libF77/z_log.c: Improve accuracy of real(log(z)) for
z near (+-1,eps) with |eps| small.
* libF77/s_cat.c: Adjust call when ftnint and ftnlen are
of different size.
* libF77/dtime_.c, libF77/etime_.c: Use floating point divide.
* libI77/Version.c: Update version information.
* libI77/rsne.c, libI77/xwsne.c: Adjust code for when ftnint
and ftnlen differ in size.
* libI77/lread.c: Fix reading of namelist logical values followed
by <name>= where <name> starts with T or F.
2000-11-26 Toon Moene <toon@moene.indiv.nluug.nl>
* libI77/Version.c, libF77/Version.c, libU77/Version.c:
Designate version as (experimental) instead of (prerelease)
2000-11-15 Toon Moene <toon@moene.indiv.nluug.nl>
* libI77/configure.in: See if `mkstemp' is available.
* libI77/configure: Regenerate.
* libI77/open.c: Use `mkstemp' to create scratch
file atomically.
2000-07-03 Donn Terry (donnte@microsoft.com)
* libU77/aclocal.m4: check for 2 argument gettimeofday without
struct timezone
2000-07-02 Toon Moene <toon@moene.indiv.nluug.nl>
* libF77/Version.c: Bumped version number to 0.5.26.
* libI77/Version.c: Ditto.
* libU77/Version.c: Ditto.
2000-06-21 Zack Weinberg <zack@wolery.cumb.org>
* libU77/dtime_.c, libU77/etime_.c: Include stdlib.h if
HAVE_STDLIB_H is defined.
2000-06-11 Herman A.J. ten Brugge <Haj.Ten.Brugge@net.HCC.nl>
* rdfmt.c (rd_L): Use if-then-else instead of case statement to
solve problems when sizeof(char) == sizeof(short).
2000-05-18 Chris Demetriou <cgd@sibyte.com>
* configure.in: Test for __g77_integer, __g77_uinteger,
__g77_longint, and __g77_ulongint builtin types, rather
than mucking around with compiler headers.
* configure: Regenerate.
* g2c.hin (integer, logical, flag, ftnlen, ftnint): Use
__g77_integer rather than autoconfigured value.
(uinteger): Use __g77_uinteger rather than autoconfigured value.
(longint): Use __g77_longint rather than autoconfigured value.
(ulongint): Use __g77_ulongint rather than autoconfigured value.
Sun Mar 12 20:12;30 2000 Toon Moene <toon@moene.indiv.nluug.nl>
Based on work done by David M. Gay (Bell Labs)
* libF77/configure.in: Define IEEE_COMPLEX_DIVIDE.
* libF77/[cz]_div.c: Arrange for compilation under
-DIEEE_COMPLEX_DIVIDE to make these routines
avoid calling sig_die when the denominator vanishes.
* libF77/s_rnge.c: Add casts for the case of
sizeof(ftnint) == sizeof(int) < sizeof(long).
* libI77/endfile.c: Set state to writing (b->uwrt = 1) when an
endfile statement requires copying the file
Also, supply a missing (long) cast in the sprintf call.
* libI77/sfe.c: Add #ifdef ALWAYS_FLUSH logic, for formatted I/O.
Wed Feb 16 11:10:05 2000 Kaveh R. Ghazi <ghazi@caip.rutgers.edu>
* configure.in (gcc_version): When setting, narrow search to
lines containing `version_string'.
Tue Nov 16 20:39:42 1999 Geoffrey Keating <geoffk@cygnus.com>
* libU77/u77-test.f (wd): Allow for longer working directory
pathnames.
1999-10-14 Theo Papadopoulo <Theodore.Papadopoulo@sophia.inria.fr>
* libU77/acconfig.h: Define GETTIMEOFDAY_ONE_ARGUMENT and
HAVE_TIMEZONE in acconfig.h.
* libU77/config.hin: Rebuilt.
1999-10-12 Dave Love <fx@gnu.org>
* libU77/aclocal.m4: Re-write, defining LIBU77_GETTIMEOFDAY, not
LIBU77_HAVE_STRUCT_TIMEZONE.
* libU77/configure.in: Use LIBU77_GETTIMEOFDAY, not
LIBU77_HAVE_STRUCT_TIMEZONE. Don't check for gettimeofday
separately.
* libU77/datetime_.c (G77_date_and_time_0): Use
GETTIMEOFDAY_ONE_ARGUMENT.
Tue Sep 14 01:44:01 1999 Marc Espie <espie@cvs.openbsd.org>
* Makefile.in: Prepend $(SHELL) to move-if-change calls.
Fri Aug 6 23:32:29 1999 Daniel Jacobowitz <drow@drow.them.org>
* Makefile.in (FLAGS_TO_PASS): Include prefix, exec_prefix,
libdir, libsubdir and tooldir.
Wed Jul 7 15:58:16 1999 Craig Burley <craig@jcb-sc.com>
* libU77/date_.c (G77_date_y2kbug_0): G77_time_0 returns
longint, not integer, and G77_ctime_0 takes longint, not
integer, argument.
* libU77/Version.c: Bump version.
Mon Jun 28 21:27:08 1999 Craig Burley <craig@jcb-sc.com>
Update to Netlib version of 1999-06-28:
* changes.netlib, libI77/Version.c, libI77/rsne.c
readme.netlib: See changes.netlib for info.
Fri Jun 18 11:38:07 1999 Craig Burley <craig@jcb-sc.com>
* libU77/ttynam_.c: if !defined (HAVE_TTYNAM),
write all spaces into return value instead of trying
to return -1 from a void function.
Fri Jun 18 11:22:21 1999 Craig Burley <craig@jcb-sc.com>
Update to Netlib version of 1999-05-10:
* changes.netlib, libI77/Version.c, libI77/backspace.c
readme.netlib: See changes.netlib for info.
Fri Jun 18 11:15:24 1999 Craig Burley <craig@jcb-sc.com>
* libI77/backspace.c: Undo Wednesday's change, in
preparation for slightly different Netlib change.
Wed Jun 16 11:38:58 1999 Craig Burley <craig@jcb-sc.com>
From Ian Watson <WATSON_IAN_A@Lilly.com> 1999-06-12:
* libI77/backspace.c: Reload file descriptor after
calling t_runc.
* libI77/Version.c: Bump libg2c version.
Wed May 26 14:26:35 1999 Craig Burley <craig@jcb-sc.com>
* libF77/Version.c, libI77/Version.c, libU77/Version.c:
Use 0.5.24 to designate the version of g77 within GCC 2.95.
Thu May 20 03:20:59 1999 Jeffrey A Law (law@cygnus.com)
* configure.in (AC_EXEEXT): Remove call.
(compiler_name): Explicitly check with no extension and .exe
extension.
* configure: Regenerate.
Mon May 10 17:33:45 1999 Craig Burley <craig@jcb-sc.com>
Update to Netlib version of 1999-05-10:
* changes.netlib, libF77/Version.c, libF77/abort_.c,
libF77/c_log.c, libF77/ef1asc_.c, libF77/s_rnge.c,
libF77/s_stop.c, libI77/Version.c, libI77/open.c,
readme.netlib: See changes.netlib for info.
Fri May 7 9:33:55 1999 Donn Terry (donn@interix.com)
* libU77/dtime_.c (G77_dtime_0): Standard-conforming error check.
* libU77/etime_.c (G77_etime_0): Likewise.
Mon May 3 19:15:07 1999 Craig Burley <craig@jcb-sc.com>
* libU77/u77-test.f (main): Declare ABORT as intrinsic.
1999-05-03 Craig Burley <craig@jcb-sc.com>
* libU77/u77-test.f: Reverse order of two arguments to
CTIME_subr, DTIME_subr, ETIME_subr, and TTYNAM_subr.
Mon May 3 11:21:35 1999 Craig Burley <craig@jcb-sc.com>
* libF77/c_log.c: Cope with partial overlap a la z_log.c.
(Change likely to be made to netlib version shortly.)
Mon May 3 11:12:38 1999 Craig Burley <craig@jcb-sc.com>
Update to Netlib version of 1999-05-03:
* changes.netlib, libF77/Version.c, libF77/c_cos.c,
libF77/c_exp.c, libF77/c_sin.c, libF77/d_cnjg.c,
libF77/dtime_.c, libF77/etime_.c, libF77/getenv_.c,
libF77/r_cnjg.c, libF77/z_cos.c, libF77/z_exp.c,
libF77/z_log.c, libF77/z_sin.c, libI77/Version.c,
libI77/err.c, libI77/open.c, libI77/rdfmt.c, readme.netlib:
See changes.netlib for info.
Mon May 3 10:52:53 1999 Craig Burley <craig@jcb-sc.com>
* libF77/c_cos.c, libF77/c_div.c, libF77/c_exp.c, libF77/c_log.c,
libF77/c_sin.c, libF77/c_sqrt.c, libF77/d_cnjg.c, libF77/pow_zi.c,
libF77/r_cnjg.c, libF77/z_cos.c, libF77/z_div.c, libF77/z_exp.c,
libF77/z_log.c, libF77/z_sin.c, libF77/z_sqrt.c: Revert back to
netlib versions as of f2c-19990501.
Sun May 2 01:38:50 1999 Craig Burley <craig@jcb-sc.com>
* libU77/u77-test.f (main): Declare FTELL as intrinsic.
Sun May 2 01:13:37 1999 Craig Burley <craig@jcb-sc.com>
* libU77/u77-test.f (main): List libU77 intrinsics
not currently tested.
Add tests for TIME8, CTIME_subr, IARGC, TTYNAM_subr,
GETENV, FDATE_subr, DTIME_subr, ETIME_subr, DATE, ITIME,
FTELL_subr, MCLOCK, MCLOCK8, and CPU_TIME.
Trim blanks off the ends of some printed strings.
Sun May 2 00:06:45 1999 Craig Burley <craig@jcb-sc.com>
* libU77/u77-test.f (main): Just warn about FSTAT gid
disagreement, as it's expected on some systems.
Sat May 1 23:57:18 1999 Craig Burley <craig@jcb-sc.com>
* libU77/u77-test.f: Generalize sum-checking to
use a new function, which allows for some slop.
Clean up some commentary.
(issum): The new function.
(sgladd): Deleted subroutine.
Sat May 1 23:35:18 1999 Craig Burley <craig@jcb-sc.com>
* libU77/u77-test.f: Modify to be more like testsuite
version, bringing patches to that version here.
Add suitable commentary.
Sat Apr 24 11:02:48 1999 Craig Burley <craig@jcb-sc.com>
* Makefile.in (s-libi77, s-libf77, s-libu77): Revert
the patch from <hjl@gnu.org>, as per the commentary.
Sat Apr 17 17:33:30 1999 Craig Burley <craig@jcb-sc.com>
From H.J. Lu <hjl@gnu.org>:
* Makefile.in (s-libi77): Depend on i77.
(s-libf77): Depend on i77.
(s-libu77): Depend on u77.
Mon Apr 12 21:38:14 1999 Mumit Khan <khan@xraylith.wisc.edu>
* libF77/getenv_.c: Include stdlib.h.
Sun Apr 11 23:30:42 1999 Mumit Khan <khan@xraylith.wisc.edu>
* libU77/dtime_.c: Handle all variants of WIN32.
* libU77/etime_.c: Likewise.
* libU77/aclocal.m4: New file.
* libU77/configure.in (LIBU77_HAVE_STRUCT_TIMEZONE): Add test.
* libU77/acconfig.h (HAVE_STRUCT_TIMEZONE): Add macro.
* libU77/datetime_c.c (G77_date_and_time_0): Use.
* libU77/config.hin: Regenerate.
* libU77/configure: Likewise.
Wed Mar 31 13:50:24 1999 Kaveh R. Ghazi <ghazi@caip.rutgers.edu>
* configure.in (extra_includes): Don't attempt to calculate the
location of the gcc src or obj directories. Instead rely on
precomputed variables, $topsrcdir and $r, to obtain these values.
Set -I flags appropriately.
1999-03-28 Dave Love <fx@gnu.org>
* configure: Rebuilt.
* configure.in: Fix integer size tests: sanity check first; search
toplevel include dir (from Rainer Orth); only mess with ac_cpp
once; use -DIN_GCC -DHAVE_CONFIG_H.
* configure.in: Use `g77_cv_...', not `f77_cv_...'.
Wed Mar 24 22:41:28 1999 Mumit Khan <khan@xraylith.wisc.edu>
* configure.in (AC_PREREQ): Update to 2.13.
(AC_EXEEXT): Call to find possible file extension.
(compiler_name): Use.
* configure: Regenerate.
1999-03-17 Craig Burley <craig@jcb-sc.com>
Update to Netlib version of 1999-03-17:
* libF77/F77_aloc.c, libF77/README.netlib, libF77/dtime_.c,
libF77/etime_.c, libF77/signal1.h0, libI77/Version.c,
libI77/dfe.c, libI77/endfile.c, libI77/lread.c,
libI77/sfe.c, readme.netlib, changes.netlib:
See changes.netlib for info.
1999-03-06 Craig Burley <craig@jcb-sc.com>
Mon Dec 21 23:03:54 1998 Hans-Peter Nilsson <hp@axis.se>:
* libI77/Makefile.in (all *.o except VersionI.o): Added dependence
on respective .c file.
* libF77/Makefile.in (all .o except VersionF.o): Similarly.
* libU77/Makefile.in (date_.o): Added dependence on date_.c
1999-03-06 Craig Burley <craig@jcb-sc.com>
Rename non-Y2K-compliant intrinsics:
* Makefile.in (F2CEXT): Now two versions each of
`date' and `vxtidt'.
* f2cext.c (date_, vxtidate_): Split into two versions,
the existing one calling a new "y2kbuggy" routine that
does not exist, and a new one named with "y2kbug" that
calls the newly renamed underlying routine.
* libU77/date_.c (G77_date_y2kbug_0): Rename from G77_date_0.
* libU77/vxtidate_.c (G77_vxtidate_y2kbug_0): Rename from
G77_vxtidate_0.
* libU77/Version.c: Bump version.
1999-03-03 Craig Burley <craig@jcb-sc.com>
* libU77/vxtidate_.c (G77_vxtidate_0): Truncate
year to last two digits (i.e. modulo 100), as per
documentation and (documented) Y2K non-compliance.
1999-02-20 Craig Burley <craig@jcb-sc.com>
From Krister Walfridsson <cato@df.lth.se>:
* libU77/lstat_.c (G77_lstat_0): Kill spurious setting
of element 6 to zero, as it undid the previous setting.
1999-02-15 Craig Burley <craig@jcb-sc.com>
* f2c.h: Delete my (old) email address.
1999-02-14 Craig Burley <craig@jcb-sc.com>
* libU77/Version.c: Bump ("update" below) to date of last change.
* libI77/Version.c: Bump to date of last change.
Tue Feb 9 18:13:30 GMT 1999 Nathan Sidwell <nathan@acm.org>
* Makefile.in (distclean): Move Makefile deletion to end of
commands.
1999-01-15 Dave Love <fx@gnu.org>
* libU77/datetime_.c (G77_date_and_time_0): Return milliseconds as
such, not as microseconds.
(s_copy): Declare.
1998-11-26 Manfred Hollstein <manfred@s-direktnet.de>
* configure.in (compiler_name): Add check to detect if this
language's compiler has been built.
* configure: Regenerate.
Mon Nov 23 16:52:22 1998 Kaveh R. Ghazi <ghazi@caip.rutgers.edu>
* configure.in: Use AC_PREREQ(2.12.1).
* libF77/configure.in: Likewise.
* libI77/configure.in: Likewise.
* libU77/configure.in: Likewise.
1998-10-24 Dave Love <d.love@dl.ac.uk>
* configure.in: Touch g2c.h in AC_OUTPUT after multilib
disturbance.
1998-10-23 Dave Love <d.love@dl.ac.uk>
* f2cext.c: Include math.h.
1998-10-19 Dave Love <d.love@dl.ac.uk>
* configure: Regenerate.
* configure.in: Use AC_CONFIG_AUX_DIR.
1998-10-12 Dave Love <fx@gnu.org>
* libI77/open.c (_XOPEN_SOURCE): Define.
1998-10-12 Dave Love <fx@gnu.org>
* Makefile.in (.SUFFIXES): Don't use any.
(all-unilib): New target, like old all.
(all): Use it.
(.PHONY): Add all-unilib.
1998-10-12 Dave Love <d.love@dl.ac.uk>
* configure.in: Reorder Makefile, g2c.h in AC_OUTPUT.
Tue Oct 6 21:16:58 1998 Jeffrey A Law (law@cygnus.com)
* Makefile.in: Revert last patch.
Mon Oct 5 01:16:10 1998 H.J. Lu (hjl@gnu.org)
* Makefile.in (s-libi77): Depend on i77.
(s-libf77): Depend on i77.
(s-libu77): Depend on u77.
1998-09-30 Dave Love <d.love@dl.ac.uk>
* Makefile.in (f2cext.c): Depend on g2c.h.
1998-09-30 Robert Lipe <robertl@dgii.com>
* Makefile.in (all): Correct dependencies so --disable-multilibs
works again.
(distclean): Correct typo.
1998-09-28 Dave Love <d.love@dl.ac.uk>
* libI77/open.c: Back out part of last Netlib update affecting
scratch files which clashed with the g77 variations and broke
implicit endfile on rewind.
1998-09-21 Dave Love <d.love@dl.ac.uk>
* libI77/Version.c: Update.
Mon Sep 21 12:27:27 1998 Robert Lipe <robertl@dgii.com>
* Makefile.in (distclean, clean, uninstall, install, all): Add
multilib support.
* configure.in: Likewise.
* configure: Regenerate.
* libF77/Makefile.in, libU77/Makefile.in, libI77/Makefile.in (clean):
Explictly remove stamp in parent's directory.
1998-09-20 Dave Love <d.love@dl.ac.uk>
* libI77/sfe.c (e_wdfe): Set f__init to avoid spurious recursive
i/o error from formatted direct i/o.
Thu Sep 10 14:57:25 1998 Kamil Iskra <iskra@student.uci.agh.edu.pl>
* Makefile.in (install): Add missing "else true;".
1998-09-09 Craig Burley <burley@gnu.org>
* configure.in: Test $srcdir, not $subdir (probable typo).
Clarify commentary, fix a bit of spacing.
1998-09-07 Dave Love <d.love@dl.ac.uk>
* ChangeLog.egcs: Deleted. Entries merged here.
1998-09-07 Dave Love <d.love@dl.ac.uk>
* libI77/sfe.c, libI77/dfe.c: Revert last change.
1998-09-06 Dave Love <d.love@dl.ac.uk>
From Toon to fix spurious recursive i/o errors:
* libI77/sfe.c (e_wdfe): Set f__init.
* libI77/dfe.c (c_dfe): Check and set f__init.
(s_rdfe, s_wdfe): Don't check and set f__init.
Fri Sep 4 18:40:32 1998 Craig Burley <burley@gnu.org>
* libU77/sys_clock_.c (G77_system_clock_0): Fix indentation.
Tue Sep 1 10:06:06 1998 Craig Burley <burley@gnu.org>
* libF77/Version.c: Update.
* libU77/Version.c: Update.
* libI77/Version.c: Update.
Wed Aug 26 23:19:40 1998 Jeffrey A Law (law@cygnus.com)
* Makefile.in (FLAGS_TO_PASS): Fix typo.
1998-08-11 Dave Love <d.love@dl.ac.uk>
* README: Update from Craig.
1998-07-24 Dave Love <d.love@dl.ac.uk>
* Makefile.in (s-libe77, ${srcdir}/configure, g2c.h, Makefile)
(config.status, rebuilt): Rely on VPATH, dropping explicit use of
$(srcdir) in various places.
1998-07-19 Dave Love <d.love@dl.ac.uk>
* Makefile.in (all): Depend on s-libe77, not e77.
(.PHONY): Remove e77.
Thu Jul 16 00:58:52 1998 Jeffrey A Law (law@cygnus.com)
* libU77/Makefile.in: Missed one config.h.in -> config.hin change.
* g2c.hin: Renamed from g2c.h.in.
* Makefile.in, configure.in: Changed as needed.
* configure: Rebuilt.
* libU77/config.hin: Renamed from libU77/config.h.in.
* Makefile.in, configure.in: Changed as needed.
* configure: Rebuilt.
Tue Jul 14 21:35:30 1998 Gerald Pfeifer <pfeifer@dbai.tuwien.ac.at>
* Makefile.in (all): Invoke $(MAKE) instead of just make.
Tue Jul 14 02:16:34 1998 Jeffrey A Law (law@cygnus.com)
* Makefile.in: stamp-lib* -> s-lib*.
* libU77/Makefile.in: Likewise.
* libF77/Makefile.in: Likewise.
* libI77/Makefile.in: Likewise.
* libU77/Makefile.in (ALL_CFLAGS): Add -I$(F2C_H_DIR).
Mon Jul 13 13:31:03 1998 Craig Burley <burley@gnu.org>
* libU77/u77-test.f: Double-check ETIME results, just
like 0.5.24 does.
1998-07-10 Dave Love <d.love@dl.ac.uk>
* Makefile.in: Re-write build procedure mainly to honour
dependencies correctly but also allow making in the build
directory by configuring the relevant variables. The lib[FIU]77
subdirs do dependency checking of their objects. Stamp files
dictate when to run (new) archive targets in subdirs. Some
tidying of variables. Supply full set of standard targets.
* configure.in: Move much of testing to new configures in
subdirs. Tidy up handling of RANLIB etc.
* stamp-h.in, libF77/configure.in, libI77/configure.in:
* libF77/configure, libI77/configure: New files.
* libF77/Makefile.in, libI77/Makefile.in, libU77/Makefile.in:
Change in step with libf2c/Makefile.in.
1998-07-09 Dave Love <d.love@dl.ac.uk>
* libU77/Makefile.in (check): Wrap -lg2c ... -lm around $(LIBS) in
case of static link.
* libU77/Version.c, libI77/Version.c: Update version info.
* libU77/sys_clock_.c: Replace TIMES conditional stuff removed in
error by last change.
1998-07-06 Mike Stump <mrs@wrs.com>
* Makefile.in (clean): Don't remove Makefiles, that is done in
distclean.
1998-07-06 Dave Love <d.love@dl.ac.uk>
* libU77/Makefile.in (lib): Change variable lib to LIBS.
1998-07-06 Robert Lipe <robertl@dgii.com>
* libU77/configure.in: Look for -lsocket, add to LIBS if found.
* libU77/Makefile.in (lib): Use LIBS from above.
1998-07-05 Dave Love <d.love@dl.ac.uk>
* f2cext.c (system_clock_): Remove (just f90 intrinsic).
* Makefile.in (F2CEXT): Remove sclock.
(UOBJ): Add libU77/datetime_.o.
* libU77/config.h.in: Add HAVE_GETTIMEOFDAY.
* libU77/configure.in: Check for gettimeofday.
* libU77/datetime_.c: New file.
* libU77/sys_clock_.c: Allow optional args.
* libU77/Makefile.in (G77DIR): Fix for current directory
structure.
(SRCS, OBJS): Add datetime.
* libU77/u77-test.f: Call date_and_time. Call system_clock
omitting args.
1998-06-29 Dave Love <d.love@dl.ac.uk>
* libI77/wsfe.c (s_wsfe): Fix setting of f__curunit lost in
previous change.
* libI77/rsfe.c (s_rsfe): Likewise.
Sat Jun 27 23:04:49 1998 Jeffrey A Law (law@cygnus.com)
* Makefile.in (FLAGS_TO_PASS, case G2C_H_DIR): Use $(TARGET_SUBDIR)
instead of hardcoding "libraries".
1998-06-26 Manfred Hollstein <manfred@s-direktnet.de>
* Makefile.in (gcc_version_trigger): Add new macro.
(config.status): Add dependency upon $(gcc_version_trigger).
* configure.in (gcc_version_trigger): New variable; initialize
using value from toplevel configure; add AC_SUBST for it.
(gcc_version): Change initialization to use this new variable.
* configure: Regenerate.
1998-06-24 Manfred Hollstein <manfred@s-direktnet.de>
* Makefile.in (version): Rename to gcc_version.
* configure.in (version): Likewise.
(gcc_version): Add code to use an option passed from parent configure.
* configure: Regenerate.
1998-06-23 Dave Love <d.love@dl.ac.uk>
* libI77/backspace.c, libI77/dfe.c, libI77/due.c, libI77/iio.c:
* libI77/lread.c, libI77/sfe.c, libI77/sue.c, libI77/wsfe.c: Update
to Netlib version of 1998-06-18.
1998-06-21 Dave Love <d.love@dl.ac.uk>
* configure.in (version, target_alias): Define.
* Makefile.in (version, target_alias, libsubdir): Define.
(install): Remove check for libsubdir.
Sat Jun 13 03:46:40 1998 Craig Burley <burley@gnu.org>
* Makefile.in (install): Don't install if $(libsubdir)
is empty; issue a diagnostic saying top-level Makefile
must pass it in instead, and exit.
* Makefile.in (g2c.h): Rename from f2c.h.
* Makefile.in, libF77/Makefile.in, libI77/Makefile.in:
* libU77/Makefile.in: Rewrite config and var assignment
sections to be even more minimal than before, and to
more clearly documented what macros are expected to be
set and to what sorts of values. Eliminate CROSS and
related stuff, since there's no such things as CROSS
in egcs. Rename GCC_FOR_TARGET to CC throughout.
* Makefile.in (stamp-libi77, stamp-libf77, stamp-libu77):
Eliminate CROSS.
* configure.in: Eliminate CROSS.
Rename libf2c.a and f2c.h to libg2c.a and g2c.h,
normalize and simplify g77/libg2c build process:
* Makefile.in: Remove all stuff pertaining to
installation, cleaning, and so on. Parent Makefile
does all that now. Pass F2C_H_DIR,
G2C_H_DIR, and GCC_H_DIR, the pathnames for the
directories containing f2c.h, g2c.h, and other
#include files, to subdirectory Makefiles.
(stamp-libf77, stamp-libi77, stamp-libu77):
Don't specify `-f Makefile' anymore, it's not needed
now that subdirectory makefile's from netlib are
renamed to makefile.netlib in g77 source (and to
makefile.ori by configuration process, in case they're
still around somehow).
(stamp-libe77): Don't make libE77 dir unless it doesn't
exist, if it does just delete all objects in it.
Compile using $(GCC_FOR_TARGET), not $(CC).
(rebuilt): Remove this and all subordinate targets,
as parent Makefile now handles all that.
(*clean): Remove.
* configure.in (Pad_UDread, ALWAYS_FLUSH, WANT_LEAD_0):
Remove these and commentary to new f2c.h file.
AC_OUTPUT g2c.h instead of f2c.h. Remove old commentary
regarding concatenation.
* g2c.h.in: Rename from f2c.h.in, add appropriate
commentary.
* f2c.h: New file, a wrapper for g2c.h that does
libg2c-specific stuff.
* libF77/Makefile.in, libI77/Makefile.in, libU77/Makefile.in:
Change $(ALL_CFLAGS) to use F2C_H_DIR, G2C_H_DIR, and GCC_H_DIR
macros. Remove F2C_H macro, replace use with explicit
dependencies on f2c.h and g2c.h.
(*clean): Remove.
Mon Apr 27 22:52:31 1998 Richard Henderson <rth@cygnus.com>
* libU77/ltime_.c: Bounce the ftnint argument through a local time_t.
* libU77/gmtime_.c: Likewise.
Sun Apr 26 18:07:56 1998 Richard Henderson <rth@cygnus.com>
* configure.in: Adjust include paths in F2C_INTEGER and F2C_LONGINT
tests to work out of the build directory.
1998-05-20 Dave Love <d.love@dl.ac.uk>
* Makefile.in ($(lib)): Use shell loop instead of unportable
make variable substitution.
Tue May 19 12:50:27 1998 Craig Burley <burley@gnu.org>
Break up main() into separate .o's so making and
linking against shared libraries with non-Fortran
main() routines is easier:
* Makefile.in (MISC): Add setarg.o and setsig.o.
* libF77/Makefile.in (MISC): Ditto.
* libF77/setarg.c: New file, contains f_setarg().
* libF77/setsig.c: New file, contains f_setsig().
* libF77/getarg_.c: Rename xarg* to f__xarg*.
* libF77/iargc_.c: Ditto
Sat May 2 16:44:46 1998 Craig Burley <burley@gnu.org>
* libF77/signal_.c, libI77/dfe.c, libI77/due.c,
libI77/wsfe.c: Tweaks to eliminate unnecessary
differences vs. netlib libf2c.
Fri May 1 11:57:45 1998 Craig Burley <burley@gnu.org>
Update to Netlib version of 1998-04-20:
* libF77/dtime_.c, libF77/etime_.c, libF77/h_dnnt.c,
libF77/h_nint.c, libF77/i_dnnt.c, libF77/i_nint.c,
libF77/main.c, libF77/s_paus.c, libF77/signal1.h0,
libI77/backspace.c, libI77/close.c, libI77/dfe.c,
libI77/endfile.c, libI77/err.c, libI77/fio.h,
libI77/iio.c, libI77/ilnw.c, libI77/lread.c,
libI77/lwrite.c, libI77/open.c, libI77/rawio.h,
libI77/sfe.c, libI77/util.c, libI77/wrtfmt.c,
libI77/wsfe.c, libI77/wsle.c, libI77/wsne.c:
See changes.netlib for info.
Sun Apr 26 09:13:41 1998 Craig Burley <burley@gnu.org>
* libU77/hostnm_.c (G77_hostnm_0): Fix off-by-one error
that was trashing the byte just beyond the CHARACTER*(*)
argument.
Wed Mar 4 16:32:46 1998 Craig Burley <burley@gnu.org>
* libU77/u77-test.f: Don't bother declaring etime.
Use `implicit none' and declare mask and lenstr.
Do ETIME/DTIME consistency check before loop, then
use loop to verify that dtime "ticks" at some point.
Check ETIME array-sum using single-precision add, to
avoid spurious complaint on systems (like x86) that
use more precision for intermediate results.
Fix `Results of ETIME and DTIME...' message to print
pertinent values (r1 and r2 instead of i and j).
Change loop from 10M to 1K repeated up to 1000 times
or until dtime "ticks".
Print the number of 1K loops needed to see this tick.
Answer a commented question.
Split up a long line of output and do other prettying.
Preset lognam in case GETLOG fails to overwrite it.
Sat Feb 28 15:32:15 1998 Craig Burley <burley@gnu.org>
* libI77/open.c (f_open): Use sizeof(buf) instead of
256, for the usual reasons.
1998-02-17 Dave Love <d.love@dl.ac.uk>
* libU77/u77-test.f: Tweak some o/p.
* libU77/Makefile.in (check): Use -L for new directory structure.
* Makefile.in (check): Run the u77 check.
(config.status, Makefile): New targets.
Wed Feb 11 01:46:20 1998 Manfred Hollstein <manfred@s-direktnet.de>
* Makefile.in ($(lib)): Call $(AR) repeatedly to avoid overflowing
argument size limit on ancious System V.
Sun Feb 8 00:32:17 1998 Manfred Hollstein <manfred@s-direktnet.de>
* Makefile.in: Add `info install-info clean-info check dvi' targets.
Mon Feb 2 11:08:49 1998 Richard Henderson <rth@cygnus.com>
* configure.in: Update F2C_INTEGER and F2C_LONGINT tests
for the new placement in the hierarchy.
Sun Feb 1 02:36:33 1998 Richard Henderson <rth@cygnus.com>
* Previous contents of gcc/f/runtime moved into toplevel
"libf2c" directory.
Sun Feb 1 01:42:47 1998 Mumit Khan <khan@xraylith.wisc.edu>
* libU77/configure.in (getlogin,getgid,getuid, kill,link,ttyname):
Check.
* libU77/config.h.in (HAVE_GETLOGIN, HAVE_GETGID, HAVE_GETUID,
HAVE_KILL, HAVE_LINK, HAVE_TTYNAME): New defs.
* libU77/getlog_.c: Conditionalize for target platform. Set errno
to ENOSYS if target libc doesn't have the function.
* libU77/getgid_.c: Likewise.
* libU77/getuid_.c: Likewise.
* libU77/kill_.c: Likewise.
* libU77/link_.c: Likewise.
* libU77/ttynam_.c: Likewise.
Sun Jan 18 20:01:37 1998 Toon Moene <toon@moene.indiv.nluug.nl>
* libI77/backspace.c: (f_back): Use type `uiolen' to determine size
of record length specifier.
Sat Jan 17 22:40:31 1998 Mumit Khan <khan@xraylith.wisc.edu>
* libU77/configure.in (sys/param.h,sys/times.h): Check.
(times,alarm): Likewise.
* libU77/config.h.in (HAVE_SYS_PARAM_H, HAVE_SYS_TIMES_H)
(HAVE_ALARM, HAVE_TIMES): New defs.
* libU77/alarm_.c: Conditionalize for target platform. Set errno
to ENOSYS if target libc doesn't have the function.
* libU77/dtime_.c: Likewise.
* libU77/etime_.c: Likewise.
* libU77/sys_clock_.c: Likewise.
* configure.in (NON_UNIX_STDIO): Define if MINGW32.
(NON_ANSI_RW_MODE): Do not define for CYGWIN32 or MINGW32.
* libI77/rawio.h: Don't providing conflicting declarations for
read() and write(). MINGW32 header files use "const" quals.
* libF77/s_paus.c: _WIN32 does not have pause().
Mon Apr 27 22:52:31 1998 Richard Henderson <rth@cygnus.com>
* libU77/ltime_.c: Bounce the ftnint argument through a local time_t.
* libU77/gmtime_.c: Likewise.
Sun Apr 26 18:07:56 1998 Richard Henderson <rth@cygnus.com>
* configure.in: Adjust include paths in F2C_INTEGER and F2C_LONGINT
tests to work out of the build directory.
Tue Dec 23 22:56:01 1997 Craig Burley <burley@gnu.org>
* libF77/signal_.c (G77_signal_0): Return type is
now `void *', to cope with returning previous signal
handler on 64-bit systems like Alphas.
* f2cext.c (signal_): Changed accordingly.
Tue Nov 18 09:49:04 1997 Mumit Khan (khan@xraylith.wisc.edu)
* libI77/close.c (f_exit): Reset f__init so that f_clos does not
(incorrectly) think there is an I/O recursion when program is
interrupted.
Sat Nov 1 18:03:42 1997 Jeffrey A Law (law@cygnus.com)
* libF77/signal_.c: Undo last change until we can fix it right.
Wed Oct 29 01:01:04 1997 Mumit Khan <khan@brahma.xraylith.wisc.edu>
* configure.in: Set CC to CC_FOR_TARGET when cross-compiling.
Fri Oct 24 11:15:22 1997 Mumit Khan <khan@brahma.xraylith.wisc.edu>
* libI77/close.c (f_exit): Reset f__init so that f_clos does not
(incorrectly) think there is an I/O recursion when program is
interrupted.
Wed Oct 15 10:06:29 1997 Richard Henderson <rth@cygnus.com>
* libF77/signal_.c (G77_signal_0): Make return type sig_pf as well.
* libI77/fio.h: Include <string.h> if STDC_HEADERS.
* libU77/chmod_.c: Likewise.
Tue Oct 7 18:22:10 1997 Richard Henderson <rth@cygnus.com>
* Makefile.in (CGFLAGS): Don't force -g0.
* libF77/Makefile.in, libI77/Makefile.in, libU77/Makefile.in: Likewise.
Mon Oct 6 14:16:46 1997 Jeffrey A Law (law@cygnus.com)
* Makefile.in (distclean): Do a better job at cleaning up.
1997-10-03 Dave Love <d.love@dl.ac.uk>
* configure.in: Check for tempnam (best because it obeys TMPDIR).
* libI77/open.c: Use it.
* libI77/err.c: New message # 132.
Wed Oct 1 01:46:16 1997 Philippe De Muyter <phdm@info.ucl.ac.be>
* libU77/sys_clock_.c: File renamed from system_clock_.c.
* libU77/Makefile.in, Makefile.in : Reference sys_clock_.*, not
system_clock_.*.
* libU77/dtime_.c (clk_tck): Try also HZ macro.
* libU77/access.c (G77_access_0): Check malloc return value against 0,
not NULL.
* libU77/getlog_.c, libU77/ttynam_.c, libU77/chdir_.c: Ditto.
* libU77/chmod_.c, libU77/rename_.c: Ditto.
Tue Sep 30 00:41:39 1997 Craig Burley <burley@gnu.ai.mit.edu>
Do a better job of printing the offending FORMAT string
when producing a diagnostic:
* libI77/err.c (f__fmtlen): New variable to hold operating
length of format string.
(f__fatal): Use new variable to limit length of printed string.
* libI77/fmt.c (f_s): Don't skip spaces after closing paren,
so nicer message results (and nested case already skips them).
(pars_f): Record operating length of format string as indicated
by a successful call to f_s, or ad-hoc-calculate it if failure,
limiting the length to 80 characters (and stopping at NUL).
(do_fio): Use new variable to limit length of printed string.
* libI77/fmt.h (f__fmtlen): Declare new variable.
* libI77/lread.c (c_le): Set new variable to known length.
Mon Sep 29 16:30:31 1997 Craig Burley <burley@gnu.ai.mit.edu>
Update to Netlib version of 1997-09-23:
* libF77/dtime_.c (dtime_), libF77/etime_.c (dtime_):
Return `double' instead of `float' (these are not used
in g77's version of libf2c).
* libI77/fmt.c, libI77/fmt.h, libI77/rdfmt.c, libI77/wrtfmt.c:
Support machines with 64-bit pointers and 32-bit ints (e.g.
Linux on DEC Alpha).
1997-09-19 Dave Love <d.love@dl.ac.uk>
* libU77/dtime_.c (G77_dtime_0): Fix types in HAVE_GETRUSAGE case
so as not to truncate results to integer values.
* libU77/Version.c: Bump.
Thu Sep 18 16:58:46 1997 Jeffrey A Law (law@cygnus.com)
* Makefile.in (stamp-lib): Don't use '$?', explicitly
list the variables containing the object files to include
in libf2c.a
Tue Sep 9 00:33:24 1997 Craig Burley <burley@gnu.ai.mit.edu>
* Version 0.5.21 released.
Mon Sep 8 19:39:01 1997 Craig Burley <burley@gnu.ai.mit.edu>
* libI77/close.c (f_exit): Fix thinko, inverted test
of whether initialization done, so exiting now closes
open units again.
Fri Sep 5 00:18:17 1997 Jeffrey A Law (law@cygnus.com)
* Makefile.in (clean): Don't remove config.cache.
(distclean): Do it here instead.
Tue Aug 26 20:14:08 1997 Robert Lipe (robertl@dgii.com)
* hostnm_.c: Include errno.h
Tue Aug 26 01:42:21 1997 Craig Burley <burley@gnu.ai.mit.edu>
From Jim Wilson:
* configure.in: Make sure RANLIB_TEST is set also.
From Robert Lipe <robertl@dgii.com>:
* libU77/getcwd_.c, libU77/hostnm_.c, libU77/lstat_.c:
Also #include <errno.h>, to define ENOSYS.
Tue Aug 26 01:25:58 1997 Craig Burley <burley@gnu.ai.mit.edu>
* Makefile.in (stamp-lib): Put all f2cext.c objects in
a temp directory named libE77, then `ar' them all at
once into libf2c.a, to get the job done a bit faster.
Still remove the objects (and libE77 directory) afterward.
Mon Aug 25 23:26:05 1997 H.J. Lu (hjl@gnu.ai.mit.edu)
* Makefile.in (mostlyclean, clean): Check if Makefile exists
before using it. Remove stamp-*.
(stamp-libi77, stamp-libf77, stamp-libu77): New.
(stamp-lib): Only depend on stamp-libi77 stamp-libf77
stamp-libu77
Sun Aug 24 05:04:35 1997 Craig Burley <burley@gnu.ai.mit.edu>
* libU77/rand_.c (G77_rand_0), libU77/dtime_.c (G77_dtime_0),
libU77/etime_.c (G77_etime_0), libU77/secnds_.c (G77_secnds_0),
libU77/second_.c (G77_second_0): Really return `double', not
`doublereal', since the result is cast to `float'.
* f2cext.c: (rand_, dtime_, etime_, secnds_, second_): Ditto.
(erf_, erfc_, besj0_, besj1_, besjn_, besy0_, besy1_,
besyn_, dbesj0_, dbesj1_, dbesjn_, dbesy0_, dbesy1_,
dbesyn_): All of these return `double', not `doublereal',
as they either have `float' or `double' results.
* libU77/bes.c (besj0_, besj1_, besjn_, besy0_, besy1_,
besyn_): Ditto.
* libU77/dbes.c (dbesj0_, dbesj1_, dbesjn_, dbesy0_, dbesy1_,
dbesyn_): Ditto.
Update to Netlib version of 1997-08-16:
* libI77/iio.c: Fix bug in internal writes to an array
of character strings.
* Makefile.in (UOBJ): Restore fixes made by Dan Pettet I
lost, which included the addition of mclock_.o already noted
below, plus adding symlnk_.o.
Thu Aug 21 03:58:34 1997 Craig Burley <burley@gnu.ai.mit.edu>
* Makefile.in (UOBJ): Add mclock_.o, thanks to Mumit Khan!
1997-08-21 Dave Love <d.love@dl.ac.uk>
* libU77/alarm_.c: Fix return type: `integer'.
Mon Aug 11 20:12:42 1997 Craig Burley <burley@gnu.ai.mit.edu>
* Makefile.in ($(lib), stamp-lib): Ensure that library
gets fully updated even if updating was aborted earlier.
* libU77/hostnm_.c (G77_hostnm_0): Return ENOSYS and stuff
in errno if system has no gethostname() function.
* libU77/lstat_.c (G77_lstat_0): Return ENOSYS and stuff
in errno if system has no lstat() function.
* libU77/getcwd_.c (G77_getcwd_0): Return ENOSYS and stuff
in errno if system has no getcwd() or getwd() function.
Test HAVE_GETCWD properly.
* libU77/symlnk_.c (G77_symlink_0): Return ENOSYS and stuff
in errno if system has no symlink() function.
* libU77/mclock_.c (G77_mclock_0): Return -1 if system
has no clock() function.
Mon Aug 11 01:55:36 1997 Craig Burley <burley@gnu.ai.mit.edu>
* Makefile.in (F2CEXT): Add `alarm' to this list.
* f2cext.c (alarm_): Fix some typos in this function.
Delete third `status' argument.
* libU77/alarm_.c: Delete third `status' argument,
as caller gets this from function result; return
status value as function result for caller.
* configure.in: Rename `ac_cv_struct_FILE' to
`g77_cv_struct_FILE' according to 1997-06-26 change.
1997-08-06 Dave Love <d.love@dl.ac.uk>
* libU77/vxtidate_.c: Correct day/month argument order.
* f2cext.c: Likewise.
1997-07-07 Dave Love <d.love@dl.ac.uk>
* f2cext.c: Add alarm_.
* Makefile.in, libU77/Makefile.in: Add alarm_.
* libU77/alarm_.c: New file.
1997-06-26 Dave Love <d.love@dl.ac.uk>
* configure.in: Generally use prefix `g77_' for cached values
we've invented, not `ac_'.
Tue Jun 24 18:50:06 1997 Craig Burley <burley@gnu.ai.mit.edu>
* libI77/ilnw.c (s_wsni): Call f_init() here.
(s_wsli): Ditto.
(e_wsli): Turn off "doing I/O" flag here.
1997-06-20 Dave Love <d.love@dl.ac.uk>
* runtime/configure.in: Check for cygwin32 after Mumit Khan (but
differently); if cygwin32 define NON_UNIX_STDIO and don't define
NON_ANSI_RW_MODES.
Tue Jun 01 06:26:29 1997 Craig Burley <burley@gnu.ai.mit.edu>
* libI77/rsne.c (nl_init): Don't call f_init() here,
since s_rsne() already does.
(c_lir): Call f_init() here instead.
* libI77/rsli.c (e_rsli): Turn off "doing I/O" flag here.
* libI77/sue.c (e_rsue): Ditto.
Sun Jun 22 23:27:22 1997 Craig Burley <burley@gnu.ai.mit.edu>
* libI77/fio.h (err): Mark I/O as no longer in progress
before returning a non-zero error indicator (since
that tells the caller to jump over the remaining I/O
calls, including the corresponding `e_whatever' call).
* libI77/err.c (endif): Ditto.
* libI77/sfe.c (e_wsfe): Ditto.
* libI77/lread.c (ERR): Ditto.
* libI77/lread.c (l_read): Ditto by having quad case
use ERR, not return, to return non-zero error code.
Sat Jun 21 12:31:28 1997 Craig Burley <burley@gnu.ai.mit.edu>
* libI77/open.c (fk_open): Temporarily turn off
"doing I/O" flag during f_open() call to avoid recursive
I/O error.
Tue Jun 17 22:40:47 1997 Craig Burley <burley@gnu.ai.mit.edu>
* err.c, close.c, rewind.c, inquire.c, backspace.c, endfile.c,
iio.c, open.c, Version.c, sfe.c, wsle.c, rsne.c, sue.c, rsfe.c,
lread.c, wsfe.c, fio.h, due.c, dfe.c: Change f__init from
`flag' to `int' and to signal not just whether initialization
has happened (bit 0), but also whether I/O is in progress
already (bit 1). Consistently produce a clear diagnostic
in cases of recursive I/O. Avoid infinite recursion in
f__fatal, in case sig_die triggers another error. Don't
output info on internals if not initialized in f__fatal. Don't
bother closing units in f_exit if initialization hasn't
happened.
Tue Jun 10 12:57:44 1997 Craig Burley <burley@gnu.ai.mit.edu>
Update to Netlib version of 1997-06-09:
* libI77/err.c, libI77/lread.c, libI77/rdfmt.c,
libI77/wref.c: Move some #include's around.
Mon Jun 9 18:11:56 1997 Craig Burley <burley@gnu.ai.mit.edu>
* libU77/kill_.c (kill_): KR_headers version needed
`*' in front of args in decls.
Sun May 25 03:16:53 1997 Craig Burley <burley@gnu.ai.mit.edu>
Update to Netlib version of 1997-05-24:
* libF77/README, libF77/Version.c, libF77/main.c,
libF77/makefile, libF77/s_paus.c, libF77/signal1.h,
libF77/signal_.c, libF77/z_div.c, libI77/Notice,
libI77/README, libI77/Version.c, libI77/dfe.c,
libI77/err.c, libI77/fmt.c, libI77/makefile,
libI77/rawio.h: Apply many, but not all, of the changes
made to libf2c since last update.
* libF77/Makefile.in (MISC), Makefile.in (MISC): Rename
exit.o to exit_.o to go along with Netlib.
* libF77/signal.c: Make the prologue much simpler than
Netlib has it.
Sun May 18 20:56:02 1997 Craig Burley <burley@gnu.ai.mit.edu>
* libU77/unlink_.c, libU77/stat_.c, libU77/symlnk_.c,
libU77/chmod_.c: g_char first arg is const.
* libU77/chmod_.c: s_cat expects ftnlen[], not int[] or
integer[], change types of array and variables
accordingly.
May 7 1997 Daniel Pettet <dan.pettet@bchydro.bc.ca>
* libU77/dbes_.c: Commented out the code in the
same way the bes* routines are commented out. This
was done because corresponding C routines are referenced
directly in com-rt.def.
Mon May 5 13:56:02 1997 Craig Burley <burley@gnu.ai.mit.edu>
* libU77/stat_.c: Reverse KR/ANSI decls of g_char().
Apr 18 1997 Daniel Pettet <dan.pettet@bchydro.bc.ca>
* libF77/F77_aloc.c, libF77/abort_.c, libF77/derf_.c,
libF77/derfc_.c, libF77/ef1asc_.c, libF77/ef1cmc_.c,
libF77/erf_.c, libF77/erfc_.c, libF77/exit.c,
libF77/getarg_.c, libF77/getenv_.c, libF77/iargc_.c,
libF77/s_cat.c, libF77/signal_.c, libF77/system_.c,
libI77/close.c, libI77/ftell_.c, libU77/access_.c,
libU77/bes.c, libU77/chdir_.c, libU77/chmod_.c, libU77/ctime_.c,
libU77/date_.c, libU77/dbes.c, libU77/dtime_.c, libU77/etime_.c,
libU77/fdate_.c, libU77/fgetc_.c, libU77/flush1_.c,
libU77/fnum_.c, libU77/fputc_.c, libU77/fstat_.c,
libU77/gerror_.c, libU77/getcwd_.c, libU77/getgid_.c,
libU77/getlog_.c, libU77/getpid_.c, libU77/getuid_.c,
libU77/gmtime_.c, libU77/hostnm_.c, libU77/idate_.c,
libU77/ierrno_.c, libU77/irand_.c, libU77/isatty_.c,
libU77/itime_.c, libU77/kill_.c, libU77/link_.c,
libU77/lnblnk_.c, libU77/ltime_.c, libU77/mclock_.c,
libU77/perror_.c, libU77/rand_.c, libU77/rename_.c,
libU77/secnds_.c, libU77/second_.c, libU77/sleep_.c,
libU77/srand_.c, libU77/stat_.c, libU77/symlnk_.c,
libU77/system_clock_.c, libU77/time_.c, libU77/ttynam_.c,
libU77/umask_.c, libU77/unlink_.c, libU77/vxtidate_.c,
libU77/vxttime_.c: Completed renaming routines that are directly
callable from g77 to internal names of the form
G77_xxxx_0 that are known as intrinsics by g77.
Apr 8 1997 Daniel Pettet <dan.pettet@bchydro.bc.ca>
* Makefile.in: Add libU77/mclock_.o and libU77/symlnk_.o to UOBJ.
* libU77/Makefile.in: Add mclock_.c to SRCS.
Add mclock_.o and symlnk_.o to OBJS.
Add mclock_.o dependency.
Apr 8 1997 Daniel Pettet <dan.pettet@bchydro.bc.ca>
* libU77/symlnk_.c: Added a couple of (char*) casts to malloc
to silence the compiler.
1997-03-17 Dave Love <d.love@dl.ac.uk>
* libU77/access_.c, libU77/chdir_.c, libU77/chmod_.c,
libU77/link_.c, libU77/lstat_.c, libU77/rename_.c, libU77/stat_.c,
libU77/symlnk_.c, libU77/u77-test.f, libU77/unlink_.c: Strip
trailing blanks from file names for consistency with other
implementations (notably Sun's).
* libU77/chmod_.c: Quote the file name given to the shell.
Mon Mar 10 00:19:17 1997 Craig Burley <burley@gnu.ai.mit.edu>
* libI77/uio.c (do_ud) [PAD_UDread]: Add semicolon to err()
invocation when macro not defined (from Mumit Khan
<khan@xraylith.wisc.edu>).
Fri Feb 28 13:16:50 1997 Craig Burley <burley@gnu.ai.mit.edu>
* Version 0.5.20 released.
Wed Feb 26 20:28:53 1997 Craig Burley <burley@gnu.ai.mit.edu>
* Makefile.in: $(MAKE) invocations now explicitly
specify `-f Makefile', just in case the `makefile's
from the netlib distribution would get used instead.
Mon Feb 24 16:43:39 1997 Craig Burley <burley@gnu.ai.mit.edu>
* libU77/Makefile.in (check): Specify driver, and
don't bother enabling already-enabled intrinsic groups.
Also, get the $(srcdir) version of u77-test.f.
Sat Feb 22 14:08:42 1997 Craig Burley <burley@gnu.ai.mit.edu>
* libU77/u77-test.f: Explicitly declare intrinsics, get
rid of useless CHARACTER declarations on intrinsics (maybe
someday appropriate to implement meaning of that in g77
and restore them?).
Add spin loop just to fatten up the timings a bit.
Clarify ETIME output as having three fields.
Call TIME with CHARACTER*8, not CHARACTER*6, argument.
Call new SECOND intrinsic subroutine, after calling
new DUMDUM subroutine just to ensure the correct value
doesn't get left around in a register or something.
Thu Feb 20 15:22:42 1997 Craig Burley <burley@gnu.ai.mit.edu>
* libU77/bes.c: Comment out all the code, as g77 avoids actually
calling it, going directly to the system's library instead.
Mon Feb 17 02:27:41 1997 Craig Burley <burley@gnu.ai.mit.edu>
* libU77/fgetc_.c (fgetc_): Allow return value to be
CHARACTER*(*), properly handle CHARACTER*0 and blank-pad
CHARACTER*n where n>1.
Tue Feb 11 14:12:19 1997 Craig Burley <burley@gnu.ai.mit.edu>
* Makefile.in: Clarify role of $(srcdir) here. Fix
various targets accordingly. Don't rely at all on
gcc/f/include/ being a link to gcc/include/ -- just
use it directly.
(${srcdir}/configure, ${srcdir}/libU77/configure):
Remove the config.cache files in build directory before
cd'ing to source directory as well.
* libF77/Makefile.in, libI77/Makefile.in (ALL_CFLAGS):
Include `-I.' to pick up build directory.
Use gcc/include/ directly.
* libU77/Makefile.in (ALL_CFLAGS): Include `-I$(srcdir)'
to pick up source directory.
(OBJS): Fix typo in `chmod_.o' (was `chmod.o').
Mon Feb 10 12:54:47 1997 Craig Burley <burley@gnu.ai.mit.edu>
* Makefile.in (UOBJ), libU77/Makefile.in (OBJS): Add
libU77/chmod_.o to list of objects.
* libU77/chmod_.c: Fix up headers.
Fix implementation to not prematurely truncate command
string and make room for trailing null.
* libU77/ctime_.c: Incoming xstime argument is now longint.
* libU77/mclock_.c: Now returns longint.
* libU77/time_.c: Now returns longint.
1997-02-10 Dave Love <d.love@dl.ac.uk>
* etime_.c, dtime_.c: Typo rounded times to seconds.
* date_.c: Add missing return.
* hostnm_.c: #include unistd.h.
Sat Feb 8 03:30:19 1997 Craig Burley <burley@gnu.ai.mit.edu>
INTEGER*8 support built in to f2c.h and libf2c (since
gcc will be used to compile relevant code anyway):
* Makefile.in, libF77/Makefile.in: Add pow_qq.o,
qbitbits.o, and qbitshft.o to $POW and $F90BIT macros,
as appropriate.
* f2c.h.in: Define appropriate types and macros.
Place #error directive correctly.
* configure.in: Determine appropriate types for long
integer (F2C_LONGINT).
Meanwhile, quote strings in #error, for consistency.
Fix restoring of ac_cpp macro.
* configure: Regenerated using autoconf-2.12.
* libF77/Version.c, libI77/Version.c, libU77/Version.c:
Update version numbers.
Change names and code for g77-specific version-printing
routines (shorter names should be safer to link on
weird, 8-char systems).
* libF77/c_cos.c, libF77/c_div.c, libF77/c_exp.c,
libF77/c_log.c, libF77/c_sin.c, libF77/c_sqrt.c,
libF77/d_cnjg.c, libF77/pow_zi.c, libF77/r_cnjg.c,
libF77/z_cos.c, libF77/z_div.c, libF77/z_exp.c,
libF77/z_log.c, libF77/z_sin.c, libF77/z_sqrt.c:
Changed to work properly even when result is aliased
with any inputs.
* libF77/makefile, libI77/makefile: Leave these in
the g77 distribution, so it is easier to track changes
to official libf2c.
* libF77/signal_.c: Eliminate redundant `return 0;'.
* libI77/fio.h (err, errfl): Fix these so they work
(and must be expressed) as statements.
Fix up many users of err() to include trailing semicolon.
* Incorporate changes by Bell Labs to libf2c through 1997-02-07.
1997-02-06 Dave Love <d.love@dl.ac.uk>
* libU77/etime_.c, libU77/dtime_.c: Fix getrusage stuff.
* libU77/config.h.in: Regenerate for HAVE_GETRUSAGE.
* libU77/Makefile.in, libI77/Makefile.in, libF77/Makefile.in:
Redo *clean targets; distclean and maintainer-clean remove the stage?
and include links. This probably want looking at further.
Wed Feb 5 00:21:23 1997 Craig Burley <burley@gnu.ai.mit.edu>
Add libU77 library from Dave Love <d.love@dl.ac.uk>:
* Makefile.in: Add libU77 directory, rules, etc.
* configure.in: New libU77 directory, Makefile, etc.
* Makefile.in, libF77/Makefile.in, libI77/Makefile.in,
libU77/Makefile.in: Reorganize these so $(AR) commands
handled by the top-level Makefile instead of the
subordinates. This permits it to do $(AR) only when
one or more object files actually change, instead of
having to force-update it as was necessary before.
And that had the disadvantage of requiring, e.g., user
root to have access to $(AR) to the library simply to
install g77, which might be problematic on an NFS setup.
(mostlyclean, clean, distclean, maintainer-clean):
Properly handle these rules.
* Makefile.in: Don't invoke config.status here -- let
compiler-level stuff handle all that.
* libI77/err.c [MISSING_FILE_ELEMS]: Declare malloc in this case
too, so it doesn't end up as an integer.
Sat Feb 1 02:43:48 1997 Craig Burley <burley@gnu.ai.mit.edu>
* libF77/Makefile.in: More fixup for $(F90BIT) -- wasn't
in list for ar command, and it wasn't correctly listed
in the list of things depending on f2c.h.
* f2c.h.in: Fix up #error directive.
1997-01-31 Dave Love <d.love@dl.ac.uk>
* libF77/Makefile.in ($(lib)): Add $(F90BIT); shouldn't exclude
stuff f2c needs so we can share the library.
Sat Jan 18 19:39:03 1997 Craig Burley <burley@gnu.ai.mit.edu>
* configure.in: No longer define ALWAYS_FLUSH, the
resulting performance is too low.
Wed Dec 18 12:06:02 1996 Craig Burley <burley@gnu.ai.mit.edu>
Patch from Mumit Khan <khan@xraylith.wisc.edu>:
* libF77/s_paus.c: Add __CYGWIN32__ to list of macros
controlling how to pause.
Sun Dec 1 21:25:27 1996 Craig Burley <burley@gnu.ai.mit.edu>
* configure: Regenerated using autoconf-2.12.
Mon Nov 25 21:16:15 1996 Craig Burley <burley@gnu.ai.mit.edu>
* configure: Regenerated using autoconf-2.11.
1996-11-19 Dave Love <d.love@dl.ac.uk>
* libI77/backspace.c: Include sys/types.h for size_t.
Wed Nov 6 14:17:27 1996 Craig Burley <burley@gnu.ai.mit.edu>
* f2c.h.in: Properly comment out the unsupported stuff so
we don't get build-time errors.
* libF77/Version.c, libI77/Version.c: Restore macro definition
of version information.
* libI77/Makefile.in (OBJ) [foo]: Add ftell_.o to list of objects.
* libI77/uio.c (do_ud): Fix up casts in PAD_UDread case just
like they were fixed in the other case.
Thu Oct 31 22:27:45 1996 Craig Burley <burley@gnu.ai.mit.edu>
* libI77/ftell_.c (fseek_): Map incoming whence argument to
system's actual SEEK_CUR, SEEK_SET, or SEEK_END macro for
fseek(), and crash (gracefully) if the argument is invalid.
1996-10-19 Dave Love <d.love@dl.ac.uk>
* configure.in: Add check that we have the tools to cross-compile
if appropriate.
(NO_EOF_CHAR_CHECK,Skip_f2c_Undefs): Define.
* libF77/Makefile.in (F90BIT): New routines from Netlib.
* f2c.h.in:
Use more sanitary #error (indented for K&R compliance if necessary) if
f2c_i2 defined.
Sync with Netlib: Add `uninteger'. (Commented out) integer*8 stuff.
bit_{test,clear,set} macros.
1996-10-19 Dave Love <d.love@dl.ac.uk>
Update to Netlib version of 1996-09-26.
* libI77/Version.c: Use <stdio.h>, not "stdio.h".
* libF77/Version.c: Likewise.
Wed Aug 28 13:25:29 1996 Dave Love <d.love@dl.ac.uk>
* libI77/rsne.c (x_rsne): Use size_t instead of int.
* libI77/endfile.c (copy): Use size_t in place of int.
Wed Aug 28 13:22:20 1996 Dave Love <d.love@dl.ac.uk>
* libI77/backspace.c (f_back): Cast fread arg to size_t.
Tue Aug 27 19:11:30 1996 Dave Love <d.love@dl.ac.uk>
* libI77/Version.c: Supply */ to avoid apparent nested comment.
Tue Aug 20 09:21:43 1996 Dave Love <d.love@dl.ac.uk>
* libF77/Makefile.in (ALL_CFLAGS): Fix missing ../ for include.
* libI77/Makefile.in (ALL_CFLAGS): Likewise.
Sat Aug 17 13:00:47 1996 Dave Love <d.love@dl.ac.uk>
* libF77/qbitshft.c, libF77/qbitbits.c, libF77/lbitshft.c,
libF77/lbitbits.c: New file from Netlib. qbit... not currently
compiled.
Sun Jul 7 18:06:33 1996 Dave Love <d.love@dl.ac.uk>
* libF77/z_sqrt.c, libF77/z_sin.c, libF77/z_exp.c, libF77/z_log.c,
libF77/system_.c, libF77/z_cos.c, libF77/signal_.c,
libF77/s_stop.c, libF77/sig_die.c, libF77/s_paus.c,
libF77/s_rnge.c, libF77/s_cat.c, libF77/r_tan.c, libF77/r_tanh.c,
libF77/r_sinh.c, libF77/r_sqrt.c, libF77/r_sin.c, libF77/r_mod.c,
libF77/r_nint.c, libF77/r_lg10.c, libF77/r_log.c, libF77/r_exp.c,
libF77/r_int.c, libF77/r_cosh.c, libF77/r_atn2.c, libF77/r_cos.c,
libF77/r_asin.c, libF77/r_atan.c, libF77/r_acos.c,
libF77/pow_dd.c, libF77/pow_zz.c, libF77/main.c, libF77/i_dnnt.c,
libF77/i_nint.c, libF77/h_dnnt.c, libF77/h_nint.c, libF77/exit.c,
libF77/d_tan.c, libF77/d_tanh.c, libF77/d_sqrt.c, libF77/d_sin.c,
libF77/d_sinh.c, libF77/d_mod.c, libF77/d_nint.c, libF77/d_log.c,
libF77/d_int.c, libF77/d_lg10.c, libF77/d_cosh.c, libF77/d_exp.c,
libF77/d_atn2.c, libF77/d_cos.c, libF77/d_atan.c, libF77/d_acos.c,
libF77/d_asin.c, libF77/c_sqrt.c, libF77/cabs.c, libF77/c_sin.c,
libF77/c_exp.c, libF77/c_log.c, libF77/c_cos.c, libF77/F77_aloc.c,
libF77/abort_.c, libI77/xwsne.c, libI77/wref.c, libI77/util.c,
libI77/uio.c, libI77/rsne.c, libI77/rdfmt.c, libI77/rawio.h,
libI77/open.c, libI77/lread.c, libI77/inquire.c, libI77/fio.h,
libI77/err.c, libI77/endfile.c, libI77/close.c:
Use #include <...>, not #include "..." for mkdeps
Sat Jul 6 21:39:21 1996 Dave Love <d.love@dl.ac.uk>
* libI77/ftell_.c: Added from Netlib distribution.
Sat Mar 30 20:57:24 1996 Dave Love <d.love@dl.ac.uk>
* configure.in: Eliminate explicit use of
{RANLIB,AR}_FOR_TARGET.
* Makefile.in: Likewise.
* libF77/Makefile.in: Likewise.
* libI77/Makefile.in: Likewise.
* configure: Regenerated.
Sat Mar 30 21:02:03 1996 Dave Love <d.love@dl.ac.uk>
* Makefile.in: Eliminate explicit use of
{RANLIB,AR}_FOR_TARGET.
Tue Mar 26 23:39:59 1996 Dave Love <d.love@dl.ac.uk>
* Makefile.in: Remove hardwired RANLIB and RANLIB_TEST (unnoted
change).
Mon Mar 25 21:04:56 1996 Craig Burley <burley@gnu.ai.mit.edu>
* Incorporate changes by Bell Labs to libf2c through 1996-03-23,
including changes to dmg and netlib email addresses.
Tue Mar 19 13:10:02 1996 Craig Burley <burley@gnu.ai.mit.edu>
* Incorporate changes by AT&T/Bellcore to libf2c through 1996-03-19.
* Makefile.in (rebuilt): New target.
* libF77/Makefile.in, libI77/Makefile.in: Use $AR_FOR_TARGET, not
$AR.
Tue Mar 19 12:53:19 1996 Dave Love <d.love@dl.ac.uk>
* configure.in (ac_cpp): #include <stdio.h> instead
of <features.h>.
Tue Mar 19 12:52:09 1996 Mumit Khan <khan@xraylith.wisc.edu>
* configure.in (ac_cpp): For f2c integer type,
add -I$srcdir/../.. to make it work on mips-ultrix4.2.
Sat Mar 9 17:37:15 1996 Craig Burley <burley@gnu.ai.mit.edu>
* libI77/Makefile.in (.c.o): Add -DAllow_TYQUAD, to enable
I/O support for INTEGER*8.
* f2c.h.in: Turn on longint type.
Fri Dec 29 18:22:01 1995 Craig Burley <burley@gnu.ai.mit.edu>
* Makefile.in: Reorganize the *clean rules to more closely
parallel gcc's.
* libF77/Makefile.in, libI77/Makefile.in: Ignore error from $(AR)
command, in case just doing an install and installer has no write
access to library (this is a kludge fix -- perhaps install targets
should never try updating anything?).
Sat Nov 18 19:37:22 1995 Craig Burley (burley@gnu.ai.mit.edu)
* Version 0.5.17 released.
Thu Nov 16 07:20:35 1995 Craig Burley (burley@gnu.ai.mit.edu)
* Incorporate changes by AT&T/Bellcore to libf2c through 1995-11-15.
Fri Sep 22 02:19:59 1995 Craig Burley (burley@gnu.ai.mit.edu)
* libI77/backspace.c, libI77/close.c, libI77/endfile.c,
libI77/fio.h, libI77/inquire.c, libI77/rawio.h,
libF77/s_paus.c: Not an MSDOS system if GO32
is defined, in the sense that the run-time environment
is thus more UNIX-like.
Wed Sep 20 02:24:51 1995 Craig Burley (burley@gnu.ai.mit.edu)
* libF77/Makefile.in, libI77/Makefile.in: Comment out `ld -r -x'
and `mv' line pairs, since `-x' isn't supported on systems
such as Solaris, and these lines don't seem to do anything
useful after all.
Wed Aug 30 15:58:35 1995 Craig Burley (burley@gnu.ai.mit.edu)
* Version 0.5.16 released.
* Incorporate changes by AT&T/Bellcore to libf2c through 950829.
Mon Aug 28 12:50:34 1995 Craig Burley (burley@gnu.ai.mit.edu)
* libF77/Makefile.in, libI77/Makefile.in ($(lib)): Force ar'ing
and ranlib'ing of libf2c.a, else after rm'ing libf2c.a and
doing a make, only libI77 or libF77 would be added to
the newly created archive.
Also, instead of `$?' list all targets explicitly so all
objects are updated in libf2c.a even if only one actually
needs recompiling, for similar reason -- we can't easily tell
if a given object is really up-to-date in libf2c.a, or even
present there.
Sun Aug 27 14:54:24 1995 Craig Burley (burley@gnu.ai.mit.edu)
* libF77/Makefile.in, libI77/Makefile.in: Fix spacing so
initial tabs are present in all appropriate places.
Move identical $(AR) commands in if then/else clauses
to single command preceding if.
(.c.o, Version[FI].o): Use $@ instead of $* because AIX (RS/6000)
says $@ means source, not object, basename, and $@ seems to work
everywhere.
Wed Aug 23 15:44:25 1995 Craig Burley (burley@gnu.ai.mit.edu)
* libF77/system_.c (system_): Declare as returning `ftnint',
consistent with signal_, instead of defaulting to `int'.
Hope dmg@research.att.com agrees, else probably will
change to whatever he determines is correct (and change
g77 accordingly).
Thu Aug 17 08:46:17 1995 Craig Burley (burley@gnu.ai.mit.edu)
* libI77/rsne.c (s_rsne): Call f_init if not already done.
Thu Aug 17 04:35:28 1995 Craig Burley (burley@gnu.ai.mit.edu)
* Incorporate changes by Bellcore to libf2c through 950817.
And this text is for EMACS: (foo at bar).
Wed Aug 16 17:33:06 1995 Craig Burley (burley@gnu.ai.mit.edu)
* libF77/Makefile.in, libI77/Makefile.in (CFLAGS): Put -g1
after configured CFLAGS but before GCC_CFLAGS, so by default
the libraries are built with minimal debugging information.
Fri Jul 28 10:30:15 1995 Dave Love <d.love@dl.ac.uk>
* libI77/open.c (f_open): Call f_init if not already done.
Sat Jul 1 19:31:56 1995 Craig Burley (burley@gnu.ai.mit.edu)
* libF77/system_.c (system_): Make buff one byte bigger so
following byte doesn't get overwritten by call with large
string.
Tue Jun 27 23:28:16 1995 Craig Burley (burley@gnu.ai.mit.edu)
* Incorporate changes by Bellcore to libf2c through 950613.
* libF77/Version.c (__G77_LIBF77_VERSION__): Add this string
to track g77 mods to libf2c.
* libI77/Version.c (__G77_LIBI77_VERSION__): Add this string
to track g77 mods to libf2c.
* libI77/rawio.h: #include <rawio.h> only conditionally,
using macro intended for that purpose.
Fri May 19 11:20:00 1995 Craig Burley (burley@gnu.ai.mit.edu)
* configure.in: Incorporate change made by d.love,
* configure: Regenerated.
Wed Apr 26 21:08:57 BST 1995 Dave Love <d.love@dl.ac.uk>
* configure.in: Fix quoting problem in atexit check.
* configure: Regenerated (with current autoconf).
Wed Mar 15 12:49:58 1995 Craig Burley (burley@gnu.ai.mit.edu)
* Incorporate changes by Bellcore to libf2c through 950315.
Sun Mar 5 18:54:29 1995 Craig Burley (burley@gnu.ai.mit.edu)
* README: Tell people not to read lib[fi]77/README.
Wed Feb 15 14:30:58 1995 Craig Burley (burley@gnu.ai.mit.edu)
* configure.in: Update copyright notice at top of file.
* f2c.h.in (f2c_i2): Make sure defining this crashes compilations.
* libI77/Makefile.in (F2C_H): Fix typo in definition of this
symbol (was FF2C_H=...).
Sun Feb 12 13:39:36 1995 Craig Burley (burley@gnu.ai.mit.edu)
* README: Remove some obsolete items.
Add date.
* TODO: Add date.
Sat Feb 11 22:07:54 1995 Craig Burley (burley@gnu.ai.mit.edu)
* Makefile.in (libf77, libi77): Add rules to .PHONY list.
* f2c.h.in (flag): Make same type as friends.
* libF77/Makefile.in (libf77): Rename to $(lib), remove from
.PHONY list. Fix some typos.
* libI77/Makefile.in (libi77): Rename to $(lib), remove from
.PHONY list. Fix some typos.
Thu Feb 2 12:22:41 1995 Craig Burley (burley@gnu.ai.mit.edu)
* Makefile.in (libF77/Makefile): Fix typos in this rule's name
and dependencies.
* libF77/Makefile.in (libf77): Add rule to .PHONY list.
* libI77/Makefile.in (libi77): Add rule to .PHONY list.
Local Variables:
add-log-time-format: current-time-string
End:
libf2c/Makefile.in deleted 100644 → 0
# Makefile for GNU F77 compiler runtime.
# Copyright (C) 1995-1998, 2001, 2002, 2003 Free Software Foundation, Inc.
# Contributed by Dave Love (d.love@dl.ac.uk).
#
#This file is part of GNU Fortran.
#
#GNU Fortran 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.
#
#GNU Fortran 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 GNU Fortran; see the file COPYING. If not, write to
#the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
#02111-1307, USA.
SHELL = @SHELL@
PWD_COMMAND = $${PWDCMD-pwd}
MAKEOVERRIDES=
.NOEXPORTS:
#### Start of system configuration section. ####
srcdir = @glibcpp_srcdir@
VPATH = @glibcpp_srcdir@
prefix = @prefix@
exec_prefix = @exec_prefix@
target_alias = @target_alias@
gcc_version = @gcc_version@
gcc_version_trigger = @gcc_version_trigger@
top_srcdir = @top_srcdir@
toplevel_srcdir = @toplevel_srcdir@
toolexecdir = @glibcpp_toolexecdir@
glibcpp_toolexecdir = @glibcpp_toolexecdir@
glibcpp_toolexeclibdir = @glibcpp_toolexeclibdir@
top_builddir = .
libdir = $(exec_prefix)/lib
libsubdir = $(libdir)/gcc/$(target_alias)/$(gcc_version)
#
# Versions should start at 0:0:0 - See libtool manual.
VERSION_MAJOR=0
VERSION_MINOR=0
VERSION_SUB=0
# Multilib support variables.
MULTISRCTOP =
MULTIBUILDTOP =
MULTIDIRS =
MULTISUBDIR =
MULTIDO = true
MULTICLEAN = true
# Not configured per top-level version, since that doesn't get passed
# Versions should start at 0:0:0 - See libtool manual.
# down at configure time, but overrridden by the top-level install
# target.
INSTALL = @INSTALL@
INSTALL_PROGRAM = @INSTALL_PROGRAM@
INSTALL_DATA = @INSTALL_DATA@
LIBTOOL = @LIBTOOL@
CC = @CC@
WARN_CFLAGS = -W -Wall
CFLAGS = @CFLAGS@
AR = @AR@
RANLIB = @RANLIB@
# List of variables to pass to sub-makes.
# Quote this way so that it can be used to set shell variables too.
FLAGS_TO_PASS= \
CC='$(CC)' \
LD='$(LD)' \
LIBTOOL='$(LIBTOOL)' \
WARN_CFLAGS='$(WARN_CFLAGS)' \
CFLAGS='$(CFLAGS)' \
CPPFLAGS='$(CPPFLAGS)' \
DESTDIR='$(DESTDIR)' \
AR='$(AR)' \
RANLIB='$(RANLIB)' \
prefix='$(prefix)' \
exec_prefix='$(exec_prefix)' \
libdir='$(libdir)' \
libsubdir='$(libsubdir)' \
tooldir='$(tooldir)'
LIBG2C_BASE = libg2c
LIBG2C = $(LIBG2C_BASE).la
SUBDIRS = libI77 libF77 libU77
F2CEXT = abort derf derfc ef1asc ef1cmc erf erfc exit getarg getenv iargc \
signal system flush ftell fseek access besj0 besj1 besjn besy0 besy1 \
besyn chdir chmod ctime dbesj0 dbesj1 dbesjn dbesy0 dbesy1 dbesyn \
dtime etime fdate fgetc fget flush1 fnum fputc fput fstat gerror \
getcwd getgid getlog getpid getuid gmtime hostnm idate ierrno irand \
isatty itime kill link lnblnk lstat ltime mclock perror rand rename \
secnds second sleep srand stat symlnk time ttynam umask unlink \
vxttim alarm \
date_y2kbuggy date_y2kbug vxtidt_y2kbuggy vxtidt_y2kbug
.SUFFIXES:
# The logic here is partly dictated by the desire to keep the lib?77
# subdirs for compatibility with the Netlib version and because libU77
# has a different copyright; then the libe77 bit (EXTERNALly-callable
# versions) is funny. Given that, as well as keeping things as simple
# as possible we want (at least) the following:
# * Allow make to be run at the top level (all-target-libf2c), at this
# level, or the subdirs of this level. In the latter case we only
# compile, rather than updating libg2c.a;
# * A robust set of dependencies, so that we rebuild (as little as
# possible) if a configuration file, g2c.h or any lib?77/*.c file
# changes;
# * Avoid unnecessary running of ar and ranlib;
# * Expose parallelism where reasonable, but not as a priority.
# The intended top-level target here does a non-multilib build (via
# the dependency) and then (perhaps) builds multilibs.
all: all-unilib
: $(MAKE) ; exec $(MULTIDO) $(FLAGS_TO_PASS) multi-do DO="all-unilib"
# `all-unilib' is the overall target in the absence of multilibs,
# meant to be invoked via multi-do for multilibs.
# Its dependencies can be satisfied in parallel. The [fiu]77 targets
# update stamp files (object file lists, actually, see the subdir
# makefiles) on which the $(LIBG2C) depends. The stamp files
# s-lib[fiu]77 are intentionally not targets, since we're only meant
# to come in at the level of this target. The [fiu]77 targets always
# invoke sub makes to check dependencies in the subdirs, else we'd
# have to maintain them at this level; we live with the overhead of
# some recursive makes which may do nothing.
all-unilib: i77 f77 u77 s-libe77
$(MAKE) $(FLAGS_TO_PASS) $(LIBG2C)
i77 f77 u77: g2c.h
# This target should normally only get invoked via `all-unilib' --
# after all's well in the subdirs -- actually to assemble the library.
# The stamp files contain the object lists of each component of the
# library. The point of breaking them up is to avoid command-line
# length limitations.
$(LIBG2C): s-libi77 s-libf77 s-libu77 s-libe77
$(LIBTOOL) --mode=link $(CC) -o $@ \
-version-info $(VERSION_MAJOR):$(VERSION_MINOR):$(VERSION_SUB) \
-rpath $(glibcpp_toolexeclibdir) \
-objectlist s-libe77 \
-objectlist s-libf77 \
-objectlist s-libi77 \
-objectlist s-libu77 \
-lm
i77:
cd libI77; $(MAKE) $(FLAGS_TO_PASS) all
f77:
cd libF77; $(MAKE) $(FLAGS_TO_PASS) all
u77:
cd libU77; $(MAKE) $(FLAGS_TO_PASS) all
s-libe77: f2cext.c
if [ -d libE77 ]; then rm -f libE77/*.o libE77/*.lo; else mkdir libE77; fi
-rm -f $@.T $@
for name in $(F2CEXT); \
do \
echo $${name}; \
$(LIBTOOL) --mode=compile $(CC) -c -I. -I$(srcdir) -I../../include \
$(CPPFLAGS) $(WARN_CFLAGS) $(CFLAGS) -DL$${name} $(srcdir)/f2cext.c \
-o libE77/L$${name}.lo ; \
if [ $$? -eq 0 ] ; then true; else exit 1; fi; \
echo libE77/L$${name}.lo >> $@.T; \
done
mv $@.T $@
f2cext.c: g2c.h
${srcdir}/configure: configure.in
rm -f config.cache
cd $(srcdir) && autoconf
# Dependence on Makefile serializes for parallel make.
g2c.h: g2c.hin config.status Makefile
# Might try to avoid rebuilding everything if Makefile or configure
# changes and g2c.h doesn't; see also the Makefile rule. Should
# depend on another stamp file rather than using the commented-out
# lines below, since g2c.h isn't necessarily brought up to date.
# mv g2c.h g2c.x
$(SHELL) config.status
# $(SHELL) $(srcdir)/../move-if-change g2c.h g2c.x && mv g2c.x g2c.h
Makefile: Makefile.in config.status
# Autoconf doc uses `./config.status'. Is there a good reason to use $(SHELL)?
$(SHELL) config.status
config.status: configure $(gcc_version_trigger)
# Make sure we don't pick up a site config file and that configure
# gets run with correct values of variables such as CC.
CONFIG_SITE=no-such-file $(FLAGS_TO_PASS) \
$(SHELL) config.status --recheck
info install-info clean-info dvi TAGS dist installcheck installdirs:
check:
cd libU77; $(MAKE) G77DIR=../../../gcc/ check
install: all
$(SHELL) $(toplevel_srcdir)/mkinstalldirs $(DESTDIR)$(glibcpp_toolexeclibdir)
$(LIBTOOL) --mode=install $(INSTALL) $(LIBG2C) $(DESTDIR)$(glibcpp_toolexeclibdir)
$(INSTALL_DATA) libfrtbegin.a $(DESTDIR)$(glibcpp_toolexeclibdir)
$(RANLIB) $(DESTDIR)$(glibcpp_toolexeclibdir)/libfrtbegin.a
$(INSTALL_DATA) g2c.h $(DESTDIR)$(libsubdir)/include/g2c.h
$(MULTIDO) $(FLAGS_TO_PASS) multi-do DO="$@"
@-$(LIBTOOL) --mode=finish $(DESTDIR)$(glibcpp_toolexeclibdir)
install-strip:
$(MAKE) INSTALL_PROGRAM='$(INSTALL_PROGRAM) -s' install
uninstall:
rm -f $(DESTDIR)$(libsubdir)/include/g2c.h
rm -f $(DESTDIR)$(glibcpp_toolexeclibdir)/libfrtbegin.a
$(LIBTOOL) --mode=uninstall rm -f $(DESTDIR)$(glibcpp_toolexeclibdir)$(LIBG2C_BASE).la
$(MULTIDO) $(FLAGS_TO_PASS) multi-do DO="$@"
mostlyclean:
rm -f $(LIBG2C) objlist
$(MAKE) DO=$@ DODIRS="$(SUBDIRS)" $(FLAGS_TO_PASS) subdir_do; \
$(MULTICLEAN) multi-clean DO=$@
rm -fr libE77 s-libe77
clean: mostlyclean
rm -f config.log
$(MAKE) DO=$@ DODIRS="$(SUBDIRS)" $(FLAGS_TO_PASS) subdir_do; \
$(MULTICLEAN) multi-clean DO=$@
rm -rf .libs
distclean: clean
rm -f g2c.h s-libe77
$(MAKE) DO=$@ DODIRS="$(SUBDIRS)" $(FLAGS_TO_PASS) subdir_do; \
$(MULTICLEAN) multi-clean DO=distclean
rm -f config.cache config.status Makefile
maintainer-clean:
rebuilt: configure
.PHONY: rebuilt mostlyclean clean distclean maintainer-clean all \
i77 f77 u77 check uninstall install-strip dist \
installcheck installdirs all-unilib
subdir_do:
@rootpre=`${PWD_COMMAND}`/; export rootpre; \
srcrootpre=`cd $(srcdir); ${PWD_COMMAND}`/; export srcrootpre; \
for i in .. $(DODIRS); do \
if [ x$$i != x.. ]; then \
if [ -f ./$$i/Makefile ]; then \
if (cd ./$$i; $(MAKE) $(FLAGS_TO_PASS) $(DO)); then \
true; \
else \
exit 1; \
fi; \
else true; fi; \
else true; fi; \
done
# multidoings may be added here by configure.
libf2c/README deleted 100644 → 0
1998-08-11
This directory contains the libf2c library packaged for use with g77
to configure and build automatically (in principle!) as part of the
top-level configure and make steps. g77 names this library `libg2c'
to avoid conflicts with existing copies of `libf2c' on a system.
Some small changes have been made vis-a-vis the netlib distribution of
libf2c, which comes from <ftp:bell-labs.com/netlib/f2c/> and is maintained
(excellently) by David M. Gay <dmg@bell-labs.com>. See the Notice files
for copyright information. We usually try to get g77-specific changes
rolled back into the libf2c distribution.
Files that come directly from netlib are either maintained in the
libf2c directory under their original names or, if they are not pertinent
for g77's version of libf2c, under their original names with `.netlib'
appended. For example, permissions.netlib is a copy of f2c's top-level
`permissions' file in the netlib distribution. In this case, it applies
only to the relevant portions of the libF77/ and libI77/ directories; it
does not apply to the libU77/ directory, which is distributed under
different licensing arrangements. Similarly, the `makefile.netlib' files
in the libF77/ and libI77/ subdirectories are copies of the respective
`makefile' files in the netlib distribution, but are not used when
building g77's version of libf2c.
The README.netlib files in libF77/ and libI77/ thus might be
interesting, but should not be taken as guidelines for how to
configure and build libf2c in g77's distribution.
* Read permissions.netlib for licensing conditions that apply to
distributing programs containing portions of code in the libF77/ and
libI77/ subdirectories. Also read disclaimer.netlib.
* Read libU77/COPYING.LIB for licensing conditions that apply to
distributing programs containing portions of code in the libU77/
subdirectory.
Among the user-visible changes (choices) g77 makes in its version of libf2c:
- f2c.h configured to default to padding unformatted direct reads
(#define Pad_UDread), because that's the behavior most users
expect.
- f2c.h configured to default to outputting leading zeros before
decimal points in formatted and list-directed output, to be compatible
with many other compilers (#define WANT_LEAD_0). Either way is
standard-conforming, however, and you should try to avoid writing
code that assumes one format or another.
- dtime_() and etime_() are from Dave Love's libU77, not from
netlib's libF77.
- Routines that are intended to be called directly via user code
(as in `CALL EXIT', but not the support routines for `OPEN')
have been renamed from `<name>' to `G77_<name>_0'. This, in
combination with g77 recognizing these names as intrinsics and
calling them directly by those names, reduces the likelihood of
interface mismatches occurring due to use of compiler options
that change code generation, and permits use of these names as
both intrinsics and user-supplied routines in applications (as
required by the Fortran standards). f2cext.c contains "jacket"
routines named `<name>' that call `G77_<name>_0', to support
code that relies on calling the relevant routines as `EXTERNAL'
routines.
Note that the `_0' in the name denotes version 0 of the *interface*,
not the *implementation*, of a routine. The interface of a
given routine *must not change* -- instead, introduce a new copy
of the code, with an increment (e.g. `_1') suffix, having the
new interface. Whether the previous interface is maintained is
not as important as ensuring the routine implementing the new
interface is never successfully linked to a call in existing,
e.g. previously compiled, code that expects the old interface.
- Version.c in the subdirectories contains g77-specific version
information and a routine (per subdirectory) to print both the
netlib and g77 version information when called. The `g77 -v'
command is designed to trigger this, by compiling, linking, and
running a small program that calls the routines in sequence.
- libF77/main.c no longer contains the actual code to copy the
argc and argv values into globals or to set up the signal-handling
environment. These have been removed to libF77/setarg.c and
libF77/setsig.c, respectively. libF77/main.c contains procedure
calls to the new code in place of the code itself. This should
simplify linking executables with a main() function other than
that in libF77/main.c (such as one written by the user in C or
C++). See the g77 documentation for more information.
- Complex-arithmetic support routines in libF77/ take a different approach
to avoiding problems resulting from aliased input and output arguments,
which should avoid particularly unusual alias problems that netlib
libf2c might suffer from.
- libF77/signal_.c supports systems with 64-bit pointers and 32-bit
integers.
- I/O routines in libI77/ have code to detect attempts to do recursive
I/O more "directly", mainly to lead to a clearer diagnostic than
typically occurs under such conditions.
- Formatted-I/O routines in libI77/ have code to pretty-print a FORMAT
string when printing a fatal diagnostic involving formatted I/O.
- libI77/open.c supports a more robust, perhaps more secure, method
of naming temporary files on some systems.
- Some g77-specific handling of building under Microsoft operating
systems exists, mainly in libI77/.
libf2c/TODO deleted 100644 → 0
980709
TODO list for the g77 library
* Investigate building shared libraries on systems we know about
(probably using libtool).
* Better test cases.
* Allow the library to be stripped to save space. (The install-strip
makefile target now allows this, should it be easily invocable.)
* An interface to IEEE maths functions from libc where this makes
sense.
libf2c/aclocal.m4 deleted 100644 → 0
dnl Copyright (C) 1994, 1995-8, 1999, 2001, 2002 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
dnl This program is distributed in the hope that it will be useful,
dnl but WITHOUT ANY WARRANTY, to the extent permitted by law; without
dnl even the implied warranty of MERCHANTABILITY or FITNESS FOR A
dnl PARTICULAR PURPOSE.
dnl
dnl Initialize configure bits.
dnl
dnl GLIBCPP_TOPREL_CONFIGURE
AC_DEFUN(GLIBCPP_TOPREL_CONFIGURE, [
dnl Default to --enable-multilib
AC_ARG_ENABLE(multilib,
[ --enable-multilib build hella library versions (default)],
[case "${enableval}" in
yes) multilib=yes ;;
no) multilib=no ;;
*) AC_MSG_ERROR(bad value ${enableval} for multilib option) ;;
esac], [multilib=yes])dnl
# When building with srcdir == objdir, links to the source files will
# be created in directories within the target_subdir. We have to
# adjust toplevel_srcdir accordingly, so that configure finds
# install-sh and other auxiliary files that live in the top-level
# source directory.
if test "${srcdir}" = "."; then
if test -z "${with_target_subdir}"; then
toprel=".."
else
if test "${with_target_subdir}" != "."; then
toprel="${with_multisrctop}../.."
else
toprel="${with_multisrctop}.."
fi
fi
else
toprel=".."
fi
AC_CONFIG_AUX_DIR(${srcdir}/$toprel)
toplevel_srcdir=\${top_srcdir}/$toprel
AC_SUBST(toplevel_srcdir)
])
dnl
dnl Initialize configure bits.
dnl
dnl GLIBCPP_CONFIGURE
AC_DEFUN(GLIBCPP_CONFIGURE, [
# Export build and source directories.
# These need to be absolute paths, yet at the same time need to
# canonicalize only relative paths, because then amd will not unmount
# drives. Thus the use of PWDCMD: set it to 'pawd' or 'amq -w' if using amd.
glibcpp_builddir=`${PWDCMD-pwd}`
case $srcdir in
[\\/$]* | ?:[\\/]*) glibcpp_srcdir=${srcdir} ;;
*) glibcpp_srcdir=`cd "$srcdir" && ${PWDCMD-pwd} || echo "$srcdir"` ;;
esac
AC_SUBST(glibcpp_builddir)
AC_SUBST(glibcpp_srcdir)
dnl This is here just to satisfy automake.
ifelse(not,equal,[AC_CONFIG_AUX_DIR(..)])
# Will set LN_S to either 'ln -s' or 'ln'. With autoconf 2.50+, can also
# be 'cp -p' if linking isn't available.
#ac_cv_prog_LN_S='cp -p'
AC_PROG_LN_S
# We use these options to decide which functions to include.
AC_ARG_WITH(target-subdir,
[ --with-target-subdir=SUBDIR
configuring in a subdirectory])
AC_ARG_WITH(cross-host,
[ --with-cross-host=HOST configuring with a cross compiler])
# Never versions of autoconf add an underscore to these functions.
# Prevent future problems ...
ifdef([AC_PROG_CC_G],[],[define([AC_PROG_CC_G],defn([_AC_PROG_CC_G]))])
ifdef([AC_PROG_CC_GNU],[],[define([AC_PROG_CC_GNU],defn([_AC_PROG_CC_GNU]))])
ifdef([AC_PROG_CXX_G],[],[define([AC_PROG_CXX_G],defn([_AC_PROG_CXX_G]))])
ifdef([AC_PROG_CXX_GNU],[],[define([AC_PROG_CXX_GNU],defn([_AC_PROG_CXX_GNU]))])
# AC_PROG_CC
# FIXME: We temporarily define our own version of AC_PROG_CC. This is
# copied from autoconf 2.12, but does not call AC_PROG_CC_WORKS. We
# are probably using a cross compiler, which will not be able to fully
# link an executable. This should really be fixed in autoconf
# itself.
AC_DEFUN(LIB_AC_PROG_CC,
[AC_BEFORE([$0], [AC_PROG_CPP])dnl
dnl Fool anybody using AC_PROG_CC.
AC_PROVIDE([AC_PROG_CC])
AC_CHECK_PROG(CC, gcc, gcc)
if test -z "$CC"; then
AC_CHECK_PROG(CC, cc, cc, , , /usr/ucb/cc)
test -z "$CC" && AC_MSG_ERROR([no acceptable cc found in \$PATH])
fi
AC_PROG_CC_GNU
if test $ac_cv_prog_gcc = yes; then
GCC=yes
dnl Check whether -g works, even if CFLAGS is set, in case the package
dnl plays around with CFLAGS (such as to build both debugging and
dnl normal versions of a library), tasteless as that idea is.
ac_test_CFLAGS="${CFLAGS+set}"
ac_save_CFLAGS="$CFLAGS"
CFLAGS=
AC_PROG_CC_G
if test "$ac_test_CFLAGS" = set; then
CFLAGS="$ac_save_CFLAGS"
elif test $ac_cv_prog_cc_g = yes; then
CFLAGS="-g -O2"
else
CFLAGS="-O2"
fi
else
GCC=
test "${CFLAGS+set}" = set || CFLAGS="-g"
fi
])
LIB_AC_PROG_CC
AC_CHECK_TOOL(AS, as)
AC_CHECK_TOOL(AR, ar)
AC_CHECK_TOOL(RANLIB, ranlib, ranlib-not-found-in-path-error)
AC_PROG_INSTALL
# We need AC_EXEEXT to keep automake happy in cygnus mode. However,
# at least currently, we never actually build a program, so we never
# need to use $(EXEEXT). Moreover, the test for EXEEXT normally
# fails, because we are probably configuring with a cross compiler
# which can't create executables. So we include AC_EXEEXT to keep
# automake happy, but we don't execute it, since we don't care about
# the result.
if false; then
# autoconf 2.50 runs AC_EXEEXT by default, and the macro expands
# to nothing, so nothing would remain between `then' and `fi' if it
# were not for the `:' below.
:
AC_EXEEXT
fi
])
dnl
dnl GLIBCPP_EXPORT_INSTALL_INFO
dnl calculates gxx_install_dir
dnl exports glibcpp_toolexecdir
dnl exports glibcpp_toolexeclibdir
dnl exports glibcpp_prefixdir
dnl
dnl Assumes cross_compiling bits already done, and with_cross_host in
dnl particular
dnl
dnl GLIBCPP_EXPORT_INSTALL_INFO
AC_DEFUN(GLIBCPP_EXPORT_INSTALL_INFO, [
# Assumes glibcpp_builddir, glibcpp_srcdir are alreay set up and
# exported correctly in GLIBCPP_CONFIGURE.
glibcpp_toolexecdir=no
glibcpp_toolexeclibdir=no
glibcpp_prefixdir=${prefix}
AC_MSG_CHECKING([for interface version number])
libstdcxx_interface=$INTERFACE
AC_MSG_RESULT($libstdcxx_interface)
# Process the option "--enable-version-specific-runtime-libs"
AC_MSG_CHECKING([for --enable-version-specific-runtime-libs])
AC_ARG_ENABLE(version-specific-runtime-libs,
[ --enable-version-specific-runtime-libs Specify that runtime libraries should be installed in a compiler-specific directory ],
[case "$enableval" in
yes) version_specific_libs=yes ;;
no) version_specific_libs=no ;;
*) AC_MSG_ERROR([Unknown argument to enable/disable version-specific libs]);;
esac],
version_specific_libs=no)dnl
# Option set, now we can test it.
AC_MSG_RESULT($version_specific_libs)
gcc_version_trigger=${toplevel_srcdir}/gcc/version.c
gcc_version_full=`grep version_string ${gcc_version_trigger} | sed -e 's/.*\"\([[^ \"]]*\)[[ \"]].*/\1/'`
gcc_version=`echo ${gcc_version_full} | sed -e 's/\([^ ]*\) .*/\1/'`
AC_SUBST(gcc_version)
AC_SUBST(gcc_version_trigger)
if test $version_specific_libs = yes; then
# Need the gcc compiler version to know where to install libraries
# and header files if --enable-version-specific-runtime-libs option
# is selected. FIXME: "toolexecdir" is a misnomer, there are no
# executables installed there.
changequote(,)dnl
glibcpp_toolexecdir='$(libdir)/gcc/$(target_alias)'
glibcpp_toolexeclibdir='$(toolexecdir)/'${gcc_version}'$(MULTISUBDIR)'
changequote([,])dnl
fi
# Calculate glibcpp_toolexecdir, glibcpp_toolexeclibdir
# Install a library built with a cross compiler in tooldir, not libdir.
if test x"$glibcpp_toolexecdir" = x"no"; then
if test -n "$with_cross_host" &&
test x"$with_cross_host" != x"no"; then
glibcpp_toolexecdir='$(exec_prefix)/$(target_alias)'
glibcpp_toolexeclibdir='$(toolexecdir)/lib'
else
glibcpp_toolexecdir='$(libdir)/gcc/$(target_alias)'
glibcpp_toolexeclibdir='$(libdir)'
fi
multi_os_directory=`$CC -print-multi-os-directory`
case $multi_os_directory in
.) ;; # Avoid trailing /.
*) glibcpp_toolexeclibdir=$glibcpp_toolexeclibdir/$multi_os_directory ;;
esac
fi
AC_SUBST(glibcpp_prefixdir)
AC_SUBST(glibcpp_toolexecdir)
AC_SUBST(glibcpp_toolexeclibdir)
])
sinclude(../libtool.m4)
dnl The lines below arrange for aclocal not to bring an installed
dnl libtool.m4 into aclocal.m4, while still arranging for automake to
dnl add a definition of LIBTOOL to Makefile.in.
ifelse(,,,[AC_SUBST(LIBTOOL)
AC_DEFUN([AM_PROG_LIBTOOL])
AC_DEFUN([AC_LIBTOOL_DLOPEN])
AC_DEFUN([AC_PROG_LD])
])
libf2c/changes.netlib deleted 100644 → 0
This source diff could not be displayed because it is too large. You can view the blob instead.
libf2c/configure.in deleted 100644 → 0
# Process this file with autoconf to produce a configure script.
# Copyright (C) 1995, 1997, 1998, 1999, 2002, 2003
# Free Software Foundation, Inc.
# Contributed by Dave Love (d.love@dl.ac.uk).
#
#This file is part of GNU Fortran.
#
#GNU Fortran 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.
#
#GNU Fortran 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 GNU Fortran; see the file COPYING. If not, write to
#the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
#02111-1307, USA.
AC_PREREQ(2.13)
AC_INIT(libF77/Version.c)
# This works around the fact that libtool configuration may change LD
# for this particular configuration, but some shells, instead of
# keeping the changes in LD private, export them just because LD is
# exported.
ORIGINAL_LD_FOR_MULTILIBS=$LD
GLIBCPP_TOPREL_CONFIGURE
AC_CANONICAL_SYSTEM
target_alias=${target_alias-$target}
AC_SUBST(target_alias)
GLIBCPP_CONFIGURE(.)
GLIBCPP_EXPORT_INSTALL_INFO
dnl Checks for programs.
AM_PROG_LIBTOOL
dnl These should be inherited in the recursive make, but ensure they are
dnl defined:
test "$AR" || AR=ar
AC_SUBST(AR)
if test "$RANLIB"; then :
AC_SUBST(RANLIB)
else
AC_PROG_RANLIB
fi
AC_PROG_INSTALL
AC_PROG_MAKE_SET
dnl Checks for header files.
# Sanity check for the cross-compilation case:
AC_CHECK_HEADER(stdio.h,:,
[AC_MSG_ERROR([Can't find stdio.h.
You must have a usable C system for the target already installed, at least
including headers and, preferably, the library, before you can configure
the G77 runtime system. If necessary, install gcc now with \`LANGUAGES=c',
then the target library, then build with \`LANGUAGES=f77'.])])
dnl Checks for g77 integer types built into gcc's C front end.
AC_MSG_CHECKING(for built-in g77 integer types)
AC_CACHE_VAL(libf2c_cv_has_g77_builtin_types,
[AC_TRY_COMPILE(,
[__g77_integer g77i;
__g77_uinteger g77ui;
__g77_longint g77l;
__g77_ulongint g77ul;],
libf2c_cv_has_g77_builtin_types=yes,
libf2c_cv_has_g77_builtin_types=no)])
AC_MSG_RESULT($libf2c_cv_has_g77_builtin_types)
if test $libf2c_cv_has_g77_builtin_types = no; then
AC_MSG_ERROR([gcc doesn't define all of the built in types __g77_integer,
__g77_uinteger, __g77_longint, and __g77_ulongint. You may not be using
a new enough version of gcc, or your target may not have type sizes which
accommodate those types.])
fi
# avoid confusion in case the `makefile's from the f2c distribution have
# got put here
test -f libF77/makefile && mv libF77/makefile libF77/makefile.ori
test -f libI77/makefile && mv libI77/makefile libI77/makefile.ori
test -f libU77/makefile && mv libU77/makefile libU77/makefile.ori
AC_CONFIG_SUBDIRS(libU77 libI77 libF77)
# Do Makefile first since g2c.h depends on it and shouldn't get an
# earlier timestamp. Of course, it does when the multilib gunk below
# edits Makefile, sigh; see additional touch below.
AC_OUTPUT(Makefile g2c.h:g2c.hin,
[test -z "$CONFIG_HEADERS" || echo timestamp > stamp-h
if test -n "$CONFIG_FILES"; then
LD="${ORIGINAL_LD_FOR_MULTILIBS}"
if test -n "${with_target_subdir}"; then
# FIXME: We shouldn't need to set ac_file
ac_file=Makefile
. ${toplevel_srcdir}/config-ml.in
touch g2c.h # to keep it more recent than Makefile
fi
fi],
srcdir=${srcdir}
host=${host}
target=${target}
with_target_subdir=${with_target_subdir}
with_multisubdir=${with_multisubdir}
ac_configure_args="--enable-multilib ${ac_configure_args}"
toplevel_srcdir=${toplevel_srcdir}
CONFIG_SHELL=${CONFIG_SHELL-/bin/sh}
ORIGINAL_LD_FOR_MULTILIBS="${ORIGINAL_LD_FOR_MULTILIBS}"
)
dnl Local Variables:
dnl comment-start: "dnl "
dnl comment-end: ""
dnl comment-start-skip: "\\bdnl\\b\\s *"
dnl End:
libf2c/disclaimer.netlib deleted 100644 → 0
f2c is a Fortran to C converter under development since 1990 by
David M. Gay (then AT&T Bell Labs, now Bell Labs, Lucent Technologies)
Stu Feldman (then at Bellcore, now at IBM)
Mark Maimone (Carnegie-Mellon University)
Norm Schryer (then AT&T Bell Labs, now AT&T Labs)
Please send bug reports to dmg@research.bell-labs.com .
AT&T, Bellcore and Lucent disclaim all warranties with regard to this
software, including all implied warranties of merchantability
and fitness. In no event shall AT&T, Bellcore or Lucent be liable for
any special, indirect or consequential damages or any damages
whatsoever resulting from loss of use, data or profits, whether
in an action of contract, negligence or other tortious action,
arising out of or in connection with the use or performance of
this software.
libf2c/f2c.h deleted 100644 → 0
/* f2c.h file for GNU Fortran run-time library
Copyright (C) 1998 Free Software Foundation, Inc.
Contributed by James Craig Burley.
This file is part of GNU Fortran.
GNU Fortran 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.
GNU Fortran 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 GNU Fortran; see the file COPYING. If not, write to
the Free Software Foundation, 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA. */
/* This file currently is just a stub through which g77's copy
of netlib's libf2c, which g77 builds and installs as libg2c.a
(to avoid conflict), #include's g77's version of f2c.h, named
g2c.h. That file is, in turn, produced via g77's library
configuration process from g2c.h.in.
By going through this extra "hoop", it is easy to provide for
libg2c-specific configuration and typedefs that aren't appropriate
in g2c.h itself (since that is intended to be installed so it can
be shared with f2c users), without changing the libf2c (libg2c)
routines themselves. (They continue to #include "f2c.h", just
like they do in netlib's version.) */
#include "g2c.h"
/* For GNU Fortran (g77), we always enable the following behaviors for
libf2c, to make things easy on the programmer. The alternate
behaviors have their uses, and g77 might provide them as compiler,
rather than library, options, so only a single copy of a shared libf2c
need be built for a system. */
/* This makes unformatted I/O more consistent in relation to other
systems. It is not required by the F77 standard. */
#define Pad_UDread
/* This makes ERR= and IOSTAT= returns work properly in disk-full
situations, making things work more as expected. It slows things
down, so g77 will probably someday choose the original implementation
on a case-by-case basis when it can be shown to not be necessary
(e.g. no ERR= or IOSTAT=) or when it is given the appropriate
compile-time option or, perhaps, source-code directive.
(No longer defined, since it really slows down NFS access too much.) */
/* #define ALWAYS_FLUSH */
/* Most Fortran implementations do this, so to make it easier
to compare the output of g77-compiled programs to those compiled
by most other compilers, tell libf2c to put leading zeros in
appropriate places on output. */
#define WANT_LEAD_0
libf2c/f2cext.c deleted 100644 → 0
/* Copyright (C) 1997 Free Software Foundation, Inc.
This file is part of GNU Fortran run-time library.
This library is free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published
by the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
GNU Fortran 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
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with GNU Fortran; see the file COPYING.LIB. If
not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA. */
#include <math.h> /* for j0 et al */
#include <f2c.h>
typedef void *sig_proc; /* For now, this will have to do. */
#ifdef Labort
int abort_ (void) {
extern int G77_abort_0 (void);
return G77_abort_0 ();
}
#endif
#ifdef Lderf
double derf_ (doublereal *x) {
extern double G77_derf_0 (doublereal *x);
return G77_derf_0 (x);
}
#endif
#ifdef Lderfc
double derfc_ (doublereal *x) {
extern double G77_derfc_0 (doublereal *x);
return G77_derfc_0 (x);
}
#endif
#ifdef Lef1asc
int ef1asc_ (ftnint *a, ftnlen *la, ftnint *b, ftnlen *lb) {
extern int G77_ef1asc_0 (ftnint *a, ftnlen *la, ftnint *b, ftnlen *lb);
return G77_ef1asc_0 (a, la, b, lb);
}
#endif
#ifdef Lef1cmc
integer ef1cmc_ (ftnint *a, ftnlen *la, ftnint *b, ftnlen *lb) {
extern integer G77_ef1cmc_0 (ftnint *a, ftnlen *la, ftnint *b, ftnlen *lb);
return G77_ef1cmc_0 (a, la, b, lb);
}
#endif
#ifdef Lerf
double erf_ (real *x) {
extern double G77_erf_0 (real *x);
return G77_erf_0 (x);
}
#endif
#ifdef Lerfc
double erfc_ (real *x) {
extern double G77_erfc_0 (real *x);
return G77_erfc_0 (x);
}
#endif
#ifdef Lexit
void exit_ (integer *rc) {
extern void G77_exit_0 (integer *rc);
G77_exit_0 (rc);
}
#endif
#ifdef Lgetarg
void getarg_ (ftnint *n, char *s, ftnlen ls) {
extern void G77_getarg_0 (ftnint *n, char *s, ftnlen ls);
G77_getarg_0 (n, s, ls);
}
#endif
#ifdef Lgetenv
void getenv_ (char *fname, char *value, ftnlen flen, ftnlen vlen) {
extern void G77_getenv_0 (char *fname, char *value, ftnlen flen, ftnlen vlen);
G77_getenv_0 (fname, value, flen, vlen);
}
#endif
#ifdef Liargc
ftnint iargc_ (void) {
extern ftnint G77_iargc_0 (void);
return G77_iargc_0 ();
}
#endif
#ifdef Lsignal
void *signal_ (integer *sigp, sig_proc proc) {
extern void *G77_signal_0 (integer *sigp, sig_proc proc);
return G77_signal_0 (sigp, proc);
}
#endif
#ifdef Lsystem
integer system_ (char *s, ftnlen n) {
extern integer G77_system_0 (char *s, ftnlen n);
return G77_system_0 (s, n);
}
#endif
#ifdef Lflush
int flush_ (void) {
extern int G77_flush_0 (void);
return G77_flush_0 ();
}
#endif
#ifdef Lftell
integer ftell_ (integer *Unit) {
extern integer G77_ftell_0 (integer *Unit);
return G77_ftell_0 (Unit);
}
#endif
#ifdef Lfseek
integer fseek_ (integer *Unit, integer *offset, integer *xwhence) {
extern integer G77_fseek_0 (integer *Unit, integer *offset, integer *xwhence);
return G77_fseek_0 (Unit, offset, xwhence);
}
#endif
#ifdef Laccess
integer access_ (const char *name, const char *mode, ftnlen Lname, ftnlen Lmode) {
extern integer G77_access_0 (const char *name, const char *mode, ftnlen Lname, ftnlen Lmode);
return G77_access_0 (name, mode, Lname, Lmode);
}
#endif
#ifdef Lalarm
integer alarm_ (integer *seconds, sig_proc proc,
integer *status __attribute__ ((__unused__))) {
extern integer G77_alarm_0 (integer *seconds, sig_proc proc);
return G77_alarm_0 (seconds, proc);
}
#endif
#ifdef Lbesj0
double besj0_ (const real *x) {
return j0 (*x);
}
#endif
#ifdef Lbesj1
double besj1_ (const real *x) {
return j1 (*x);
}
#endif
#ifdef Lbesjn
double besjn_ (const integer *n, real *x) {
return jn (*n, *x);
}
#endif
#ifdef Lbesy0
double besy0_ (const real *x) {
return y0 (*x);
}
#endif
#ifdef Lbesy1
double besy1_ (const real *x) {
return y1 (*x);
}
#endif
#ifdef Lbesyn
double besyn_ (const integer *n, real *x) {
return yn (*n, *x);
}
#endif
#ifdef Lchdir
integer chdir_ (const char *name, const ftnlen Lname) {
extern integer G77_chdir_0 (const char *name, const ftnlen Lname);
return G77_chdir_0 (name, Lname);
}
#endif
#ifdef Lchmod
integer chmod_ (const char *name, const char *mode, const ftnlen Lname, const ftnlen Lmode) {
extern integer G77_chmod_0 (const char *name, const char *mode, const ftnlen Lname, const ftnlen Lmode);
return G77_chmod_0 (name, mode, Lname, Lmode);
}
#endif
#ifdef Lctime
void ctime_ (char *chtime, const ftnlen Lchtime, longint *xstime) {
extern void G77_ctime_0 (char *chtime, const ftnlen Lchtime, longint *xstime);
G77_ctime_0 (chtime, Lchtime, xstime);
}
#endif
#ifdef Ldate_y2kbuggy
int date_ (char *buf, ftnlen buf_len) {
/* Fail to link, so user sees attempt to invoke non-Y2K-compliant
routine. */
extern int G77_date_y2kbuggy_0 (char *buf, ftnlen buf_len);
return G77_date_y2kbuggy_0 (buf, buf_len);
}
#endif
#ifdef Ldate_y2kbug
int date_y2kbug__ (char *buf, ftnlen buf_len) {
/* If user wants to invoke the non-Y2K-compliant routine via
an `EXTERNAL' interface, avoiding the warning via g77's
`INTRINSIC' interface, force coding of "y2kbug" string in
user's program. */
extern int G77_date_y2kbug_0 (char *buf, ftnlen buf_len);
return G77_date_y2kbug_0 (buf, buf_len);
}
#endif
#ifdef Ldbesj0
double dbesj0_ (const double *x) {
return j0 (*x);
}
#endif
#ifdef Ldbesj1
double dbesj1_ (const double *x) {
return j1 (*x);
}
#endif
#ifdef Ldbesjn
double dbesjn_ (const integer *n, double *x) {
return jn (*n, *x);
}
#endif
#ifdef Ldbesy0
double dbesy0_ (const double *x) {
return y0 (*x);
}
#endif
#ifdef Ldbesy1
double dbesy1_ (const double *x) {
return y1 (*x);
}
#endif
#ifdef Ldbesyn
double dbesyn_ (const integer *n, double *x) {
return yn (*n, *x);
}
#endif
#ifdef Ldtime
double dtime_ (real tarray[2]) {
extern double G77_dtime_0 (real tarray[2]);
return G77_dtime_0 (tarray);
}
#endif
#ifdef Letime
double etime_ (real tarray[2]) {
extern double G77_etime_0 (real tarray[2]);
return G77_etime_0 (tarray);
}
#endif
#ifdef Lfdate
void fdate_ (char *ret_val, ftnlen ret_val_len) {
extern void G77_fdate_0 (char *ret_val, ftnlen ret_val_len);
G77_fdate_0 (ret_val, ret_val_len);
}
#endif
#ifdef Lfgetc
integer fgetc_ (const integer *lunit, char *c, ftnlen Lc) {
extern integer G77_fgetc_0 (const integer *lunit, char *c, ftnlen Lc);
return G77_fgetc_0 (lunit, c, Lc);
}
#endif
#ifdef Lfget
integer fget_ (char *c, const ftnlen Lc) {
extern integer G77_fget_0 (char *c, const ftnlen Lc);
return G77_fget_0 (c, Lc);
}
#endif
#ifdef Lflush1
int flush1_ (const integer *lunit) {
extern int G77_flush1_0 (const integer *lunit);
return G77_flush1_0 (lunit);
}
#endif
#ifdef Lfnum
integer fnum_ (integer *lunit) {
extern integer G77_fnum_0 (integer *lunit);
return G77_fnum_0 (lunit);
}
#endif
#ifdef Lfputc
integer fputc_ (const integer *lunit, const char *c, const ftnlen Lc) {
extern integer G77_fputc_0 (const integer *lunit, const char *c, const ftnlen Lc);
return G77_fputc_0 (lunit, c, Lc);
}
#endif
#ifdef Lfput
integer fput_ (const char *c, const ftnlen Lc) {
extern integer G77_fput_0 (const char *c, const ftnlen Lc);
return G77_fput_0 (c, Lc);
}
#endif
#ifdef Lfstat
integer fstat_ (const integer *lunit, integer statb[13]) {
extern integer G77_fstat_0 (const integer *lunit, integer statb[13]);
return G77_fstat_0 (lunit, statb);
}
#endif
#ifdef Lgerror
int gerror_ (char *str, ftnlen Lstr) {
extern int G77_gerror_0 (char *str, ftnlen Lstr);
return G77_gerror_0 (str, Lstr);
}
#endif
#ifdef Lgetcwd
integer getcwd_ (char *str, const ftnlen Lstr) {
extern integer G77_getcwd_0 (char *str, const ftnlen Lstr);
return G77_getcwd_0 (str, Lstr);
}
#endif
#ifdef Lgetgid
integer getgid_ (void) {
extern integer G77_getgid_0 (void);
return G77_getgid_0 ();
}
#endif
#ifdef Lgetlog
int getlog_ (char *str, const ftnlen Lstr) {
extern int G77_getlog_0 (char *str, const ftnlen Lstr);
return G77_getlog_0 (str, Lstr);
}
#endif
#ifdef Lgetpid
integer getpid_ (void) {
extern integer G77_getpid_0 (void);
return G77_getpid_0 ();
}
#endif
#ifdef Lgetuid
integer getuid_ (void) {
extern integer G77_getuid_0 (void);
return G77_getuid_0 ();
}
#endif
#ifdef Lgmtime
int gmtime_ (const integer *stime, integer tarray[9]) {
extern int G77_gmtime_0 (const integer *stime, integer tarray[9]);
return G77_gmtime_0 (stime, tarray);
}
#endif
#ifdef Lhostnm
integer hostnm_ (char *name, ftnlen Lname) {
extern integer G77_hostnm_0 (char *name, ftnlen Lname);
return G77_hostnm_0 (name, Lname);
}
#endif
#ifdef Lidate
int idate_ (int iarray[3]) {
extern int G77_idate_0 (int iarray[3]);
return G77_idate_0 (iarray);
}
#endif
#ifdef Lierrno
integer ierrno_ (void) {
extern integer G77_ierrno_0 (void);
return G77_ierrno_0 ();
}
#endif
#ifdef Lirand
integer irand_ (integer *flag) {
extern integer G77_irand_0 (integer *flag);
return G77_irand_0 (flag);
}
#endif
#ifdef Lisatty
logical isatty_ (integer *lunit) {
extern logical G77_isatty_0 (integer *lunit);
return G77_isatty_0 (lunit);
}
#endif
#ifdef Litime
int itime_ (integer tarray[3]) {
extern int G77_itime_0 (integer tarray[3]);
return G77_itime_0 (tarray);
}
#endif
#ifdef Lkill
integer kill_ (const integer *pid, const integer *signum) {
extern integer G77_kill_0 (const integer *pid, const integer *signum);
return G77_kill_0 (pid, signum);
}
#endif
#ifdef Llink
integer link_ (const char *path1, const char *path2, const ftnlen Lpath1, const ftnlen Lpath2) {
extern integer G77_link_0 (const char *path1, const char *path2, const ftnlen Lpath1, const ftnlen Lpath2);
return G77_link_0 (path1, path2, Lpath1, Lpath2);
}
#endif
#ifdef Llnblnk
integer lnblnk_ (char *str, ftnlen str_len) {
extern integer G77_lnblnk_0 (char *str, ftnlen str_len);
return G77_lnblnk_0 (str, str_len);
}
#endif
#ifdef Llstat
integer lstat_ (const char *name, integer statb[13], const ftnlen Lname) {
extern integer G77_lstat_0 (const char *name, integer statb[13], const ftnlen Lname);
return G77_lstat_0 (name, statb, Lname);
}
#endif
#ifdef Lltime
int ltime_ (const integer *stime, integer tarray[9]) {
extern int G77_ltime_0 (const integer *stime, integer tarray[9]);
return G77_ltime_0 (stime, tarray);
}
#endif
#ifdef Lmclock
longint mclock_ (void) {
extern longint G77_mclock_0 (void);
return G77_mclock_0 ();
}
#endif
#ifdef Lperror
int perror_ (const char *str, const ftnlen Lstr) {
extern int G77_perror_0 (const char *str, const ftnlen Lstr);
return G77_perror_0 (str, Lstr);
}
#endif
#ifdef Lrand
double rand_ (integer *flag) {
extern double G77_rand_0 (integer *flag);
return G77_rand_0 (flag);
}
#endif
#ifdef Lrename
integer rename_ (const char *path1, const char *path2, const ftnlen Lpath1, const ftnlen Lpath2) {
extern integer G77_rename_0 (const char *path1, const char *path2, const ftnlen Lpath1, const ftnlen Lpath2);
return G77_rename_0 (path1, path2, Lpath1, Lpath2);
}
#endif
#ifdef Lsecnds
double secnds_ (real *r) {
extern double G77_secnds_0 (real *r);
return G77_secnds_0 (r);
}
#endif
#ifdef Lsecond
double second_ () {
extern double G77_second_0 ();
return G77_second_0 ();
}
#endif
#ifdef Lsleep
int sleep_ (const integer *seconds) {
extern int G77_sleep_0 (const integer *seconds);
return G77_sleep_0 (seconds);
}
#endif
#ifdef Lsrand
int srand_ (const integer *seed) {
extern int G77_srand_0 (const integer *seed);
return G77_srand_0 (seed);
}
#endif
#ifdef Lstat
integer stat_ (const char *name, integer statb[13], const ftnlen Lname) {
extern integer G77_stat_0 (const char *name, integer statb[13], const ftnlen Lname);
return G77_stat_0 (name, statb, Lname);
}
#endif
#ifdef Lsymlnk
integer symlnk_ (const char *path1, const char *path2, const ftnlen Lpath1, const ftnlen Lpath2) {
extern integer G77_symlnk_0 (const char *path1, const char *path2, const ftnlen Lpath1, const ftnlen Lpath2);
return G77_symlnk_0 (path1, path2, Lpath1, Lpath2);
}
#endif
#ifdef Ltime
longint time_ (void) {
extern longint G77_time_0 (void);
return G77_time_0 ();
}
#endif
#ifdef Lttynam
void ttynam_ (char *ret_val, ftnlen ret_val_len, integer *lunit) {
extern void G77_ttynam_0 (char *ret_val, ftnlen ret_val_len, integer *lunit);
G77_ttynam_0 (ret_val, ret_val_len, lunit);
}
#endif
#ifdef Lumask
integer umask_ (integer *mask) {
extern integer G77_umask_0 (integer *mask);
return G77_umask_0 (mask);
}
#endif
#ifdef Lunlink
integer unlink_ (const char *str, const ftnlen Lstr) {
extern integer G77_unlink_0 (const char *str, const ftnlen Lstr);
return G77_unlink_0 (str, Lstr);
}
#endif
#ifdef Lvxtidt_y2kbuggy
int vxtidate_ (integer *m, integer *d, integer *y) {
/* Fail to link, so user sees attempt to invoke non-Y2K-compliant
routine. */
extern int G77_vxtidate_y2kbuggy_0 (integer *m, integer *d, integer *y);
return G77_vxtidate_y2kbuggy_0 (m, d, y);
}
#endif
#ifdef Lvxtidt_y2kbug
int vxtidate_y2kbug__ (integer *m, integer *d, integer *y) {
/* If user wants to invoke the non-Y2K-compliant routine via
an `EXTERNAL' interface, avoiding the warning via g77's
`INTRINSIC' interface, force coding of "y2kbug" string in
user's program. */
extern int G77_vxtidate_y2kbug_0 (integer *m, integer *d, integer *y);
return G77_vxtidate_y2kbug_0 (m, d, y);
}
#endif
#ifdef Lvxttim
void vxttime_ (char chtime[8], const ftnlen Lchtime) {
extern void G77_vxttime_0 (char chtime[8], const ftnlen Lchtime);
G77_vxttime_0 (chtime, Lchtime);
}
#endif
libf2c/g2c.hin deleted 100644 → 0
/* g2c.h -- g77 version of f2c (Standard Fortran to C header file) */
/* This file is generated by the g77 libg2c configuration process from a
file named g2c.hin. This process sets up the appropriate types,
defines the appropriate macros, and so on. The resulting g2c.h file
is used to build g77's copy of libf2c, named libg2c, and also can
be used when compiling C code produced by f2c to link the resulting
object file(s) with those produced by the same version of g77 that
produced this file, allowing inter-operability of f2c-compiled and
g77-compiled code. */
/** barf [ba:rf] 2. "He suggested using FORTRAN, and everybody barfed."
- From The Shogakukan DICTIONARY OF NEW ENGLISH (Second edition) */
#ifndef F2C_INCLUDE
#define F2C_INCLUDE
/* F2C_INTEGER will normally be `int' but would be `long' on 16-bit systems */
/* we assume short, float are OK */
typedef __g77_integer integer;
typedef __g77_uinteger uinteger;
typedef char *address;
typedef short int shortint;
typedef float real;
typedef double doublereal;
typedef struct { real r, i; } complex;
typedef struct { doublereal r, i; } doublecomplex;
typedef __g77_integer logical;
typedef short int shortlogical;
typedef char logical1;
typedef char integer1;
typedef __g77_longint longint; /* system-dependent */
typedef __g77_ulongint ulongint; /* system-dependent */
#define qbit_clear(a,b) ((a) & ~((ulongint)1 << (b)))
#define qbit_set(a,b) ((a) | ((ulongint)1 << (b)))
#define TRUE_ (1)
#define FALSE_ (0)
/* Extern is for use with -E */
#ifndef Extern
#define Extern extern
#endif
/* I/O stuff */
#ifdef f2c_i2
#error "f2c_i2 will not work with g77!!!!"
/* for -i2 */
typedef short flag;
typedef short ftnlen;
typedef short ftnint;
#else
typedef __g77_integer flag;
typedef __g77_integer ftnlen;
typedef __g77_integer ftnint;
#endif
/*external read, write*/
typedef struct
{ flag cierr;
ftnint ciunit;
flag ciend;
char *cifmt;
ftnint cirec;
} cilist;
/*internal read, write*/
typedef struct
{ flag icierr;
char *iciunit;
flag iciend;
char *icifmt;
ftnint icirlen;
ftnint icirnum;
} icilist;
/*open*/
typedef struct
{ flag oerr;
ftnint ounit;
char *ofnm;
ftnlen ofnmlen;
char *osta;
char *oacc;
char *ofm;
ftnint orl;
char *oblnk;
} olist;
/*close*/
typedef struct
{ flag cerr;
ftnint cunit;
char *csta;
} cllist;
/*rewind, backspace, endfile*/
typedef struct
{ flag aerr;
ftnint aunit;
} alist;
/* inquire */
typedef struct
{ flag inerr;
ftnint inunit;
char *infile;
ftnlen infilen;
ftnint *inex; /*parameters in standard's order*/
ftnint *inopen;
ftnint *innum;
ftnint *innamed;
char *inname;
ftnlen innamlen;
char *inacc;
ftnlen inacclen;
char *inseq;
ftnlen inseqlen;
char *indir;
ftnlen indirlen;
char *infmt;
ftnlen infmtlen;
char *inform;
ftnint informlen;
char *inunf;
ftnlen inunflen;
ftnint *inrecl;
ftnint *innrec;
char *inblank;
ftnlen inblanklen;
} inlist;
union Multitype { /* for multiple entry points */
integer1 g;
shortint h;
integer i;
/* longint j; */
real r;
doublereal d;
complex c;
doublecomplex z;
};
typedef union Multitype Multitype;
/*typedef long int Long;*/ /* No longer used; formerly in Namelist */
struct Vardesc { /* for Namelist */
char *name;
char *addr;
ftnlen *dims;
int type;
};
typedef struct Vardesc Vardesc;
struct Namelist {
char *name;
Vardesc **vars;
int nvars;
};
typedef struct Namelist Namelist;
#define abs(x) ((x) >= 0 ? (x) : -(x))
#define dabs(x) (doublereal)abs(x)
#define min(a,b) ((a) <= (b) ? (a) : (b))
#define max(a,b) ((a) >= (b) ? (a) : (b))
#define dmin(a,b) (doublereal)min(a,b)
#define dmax(a,b) (doublereal)max(a,b)
#define bit_test(a,b) ((a) >> (b) & 1)
#define bit_clear(a,b) ((a) & ~((uinteger)1 << (b)))
#define bit_set(a,b) ((a) | ((uinteger)1 << (b)))
/* procedure parameter types for -A and -C++ */
#define F2C_proc_par_types 1
#ifdef __cplusplus
typedef int /* Unknown procedure type */ (*U_fp)(...);
typedef shortint (*J_fp)(...);
typedef integer (*I_fp)(...);
typedef real (*R_fp)(...);
typedef doublereal (*D_fp)(...), (*E_fp)(...);
typedef /* Complex */ void (*C_fp)(...);
typedef /* Double Complex */ void (*Z_fp)(...);
typedef logical (*L_fp)(...);
typedef shortlogical (*K_fp)(...);
typedef /* Character */ void (*H_fp)(...);
typedef /* Subroutine */ int (*S_fp)(...);
#else
typedef int /* Unknown procedure type */ (*U_fp)();
typedef shortint (*J_fp)();
typedef integer (*I_fp)();
typedef real (*R_fp)();
typedef doublereal (*D_fp)(), (*E_fp)();
typedef /* Complex */ void (*C_fp)();
typedef /* Double Complex */ void (*Z_fp)();
typedef logical (*L_fp)();
typedef shortlogical (*K_fp)();
typedef /* Character */ void (*H_fp)();
typedef /* Subroutine */ int (*S_fp)();
#endif
/* E_fp is for real functions when -R is not specified */
typedef void C_f; /* complex function */
typedef void H_f; /* character function */
typedef void Z_f; /* double complex function */
typedef doublereal E_f; /* real function with -R not specified */
/* undef any lower-case symbols that your C compiler predefines, e.g.: */
#ifndef Skip_f2c_Undefs
/* (No such symbols should be defined in a strict ANSI C compiler.
We can avoid trouble with f2c-translated code by using
gcc -ansi [-traditional].) */
#undef cray
#undef gcos
#undef mc68010
#undef mc68020
#undef mips
#undef pdp11
#undef sgi
#undef sparc
#undef sun
#undef sun2
#undef sun3
#undef sun4
#undef u370
#undef u3b
#undef u3b2
#undef u3b5
#undef unix
#undef vax
#endif
#endif
libf2c/libF77/F77_aloc.c deleted 100644 → 0
#include "f2c.h"
#undef abs
#undef min
#undef max
#include <stdio.h>
static integer memfailure = 3;
#include <stdlib.h>
extern void G77_exit_0 (integer *);
char *
F77_aloc (integer Len, char *whence)
{
char *rv;
unsigned int uLen = (unsigned int) Len; /* for K&R C */
if (!(rv = (char *) malloc (uLen)))
{
fprintf (stderr, "malloc(%u) failure in %s\n", uLen, whence);
G77_exit_0 (&memfailure);
}
return rv;
}
libf2c/libF77/Makefile.in deleted 100644 → 0
# Makefile for GNU F77 compiler runtime.
# Copyright 1990 - 1994 by AT&T Bell Laboratories and Bellcore (see the
# file `Notice').
# Portions of this file Copyright (C) 1995-1998, 2001 Free Software Foundation, Inc.
# Contributed by Dave Love (d.love@dl.ac.uk).
#
#This file is part of GNU Fortran.
#
#GNU Fortran 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.
#
#GNU Fortran 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 GNU Fortran; see the file COPYING. If not, write to
#the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
#02111-1307, USA.
#### Start of system configuration section. ####
# $(srcdir) must be set to the g77 runtime libF77 source directory.
srcdir = @srcdir@
VPATH = @srcdir@
# configure sets this to all the -D options appropriate for the
# configuration.
DEFS = @DEFS@
F2C_H_DIR = @srcdir@/..
G2C_H_DIR = ..
CC = @CC@
CFLAGS = @CFLAGS@
CPPFLAGS = @CPPFLAGS@
AR = @AR@
ARFLAGS = rc
RANLIB = @RANLIB@
@SET_MAKE@
SHELL = @SHELL@
#### End of system configuration section. ####
ALL_CFLAGS = -I. -I$(srcdir) -I$(G2C_H_DIR) -I$(F2C_H_DIR) $(CPPFLAGS) $(DEFS) $(WARN_CFLAGS) $(CFLAGS)
.SUFFIXES:
.SUFFIXES: .c .lo
.c.lo:
@LIBTOOL@ --mode=compile $(CC) -c -DSkip_f2c_Undefs $(ALL_CFLAGS) $<
MISC = F77_aloc.lo VersionF.lo s_rnge.lo abort_.lo getarg_.lo iargc_.lo\
getenv_.lo signal_.lo s_stop.lo s_paus.lo system_.lo cabs.lo\
derf_.lo derfc_.lo erf_.lo erfc_.lo sig_die.lo exit_.lo setarg.lo setsig.lo
POW = pow_ci.lo pow_dd.lo pow_di.lo pow_hh.lo pow_ii.lo pow_ri.lo pow_zi.lo pow_zz.lo \
pow_qq.lo
CX = c_abs.lo c_cos.lo c_div.lo c_exp.lo c_log.lo c_sin.lo c_sqrt.lo
DCX = z_abs.lo z_cos.lo z_div.lo z_exp.lo z_log.lo z_sin.lo z_sqrt.lo
REAL = r_abs.lo r_acos.lo r_asin.lo r_atan.lo r_atn2.lo r_cnjg.lo r_cos.lo\
r_cosh.lo r_dim.lo r_exp.lo r_imag.lo r_int.lo\
r_lg10.lo r_log.lo r_mod.lo r_nint.lo r_sign.lo\
r_sin.lo r_sinh.lo r_sqrt.lo r_tan.lo r_tanh.lo
DBL = d_abs.lo d_acos.lo d_asin.lo d_atan.lo d_atn2.lo\
d_cnjg.lo d_cos.lo d_cosh.lo d_dim.lo d_exp.lo\
d_imag.lo d_int.lo d_lg10.lo d_log.lo d_mod.lo\
d_nint.lo d_prod.lo d_sign.lo d_sin.lo d_sinh.lo\
d_sqrt.lo d_tan.lo d_tanh.lo
INT = i_abs.lo i_dim.lo i_dnnt.lo i_indx.lo i_len.lo i_mod.lo i_nint.lo i_sign.lo
HALF = h_abs.lo h_dim.lo h_dnnt.lo h_indx.lo h_len.lo h_mod.lo h_nint.lo h_sign.lo
CMP = l_ge.lo l_gt.lo l_le.lo l_lt.lo hl_ge.lo hl_gt.lo hl_le.lo hl_lt.lo
EFL = ef1asc_.lo ef1cmc_.lo
CHAR = s_cat.lo s_cmp.lo s_copy.lo
F90BIT = lbitbits.lo lbitshft.lo qbitbits.lo qbitshft.lo
OBJS = $(MISC) $(POW) $(CX) $(DCX) $(REAL) $(DBL) $(INT) \
$(HALF) $(CMP) $(EFL) $(CHAR) $(F90BIT)
all: ../s-libf77 ../libfrtbegin.a
../s-libf77: $(OBJS)
-rm -f $@.T $@
objs='$(OBJS)'; for name in $$objs; do \
echo libF77/$${name} >> $@.T; done
mv $@.T $@
Makefile: Makefile.in config.status
$(SHELL) config.status
config.status: configure
rm -f config.cache
CONFIG_SITE=no-such-file CC='$(CC)' AR='$(AR)' CFLAGS='$(CFLAGS)' \
CPPFLAGS='$(CPPFLAGS)' $(SHELL) config.status --recheck
${srcdir}/configure: configure.in
rm -f config.cache
cd ${srcdir} && autoconf
VersionF.lo: Version.c
@LIBTOOL@ --mode=compile $(CC) -c $(ALL_CFLAGS) $(srcdir)/Version.c -o $@
frtbegin.o : main.c
$(CC) -c $(ALL_CFLAGS) $(srcdir)/main.c -o $@
../libfrtbegin.a: frtbegin.o
-rm -f $@
$(AR) $(ARFLAGS) $@ frtbegin.o
$(RANLIB) $@
F77_aloc.lo: F77_aloc.c
s_rnge.lo: s_rnge.c
abort_.lo: abort_.c
getarg_.lo: getarg_.c
iargc_.lo: iargc_.c
getenv_.lo: getenv_.c
signal_.lo: signal_.c
s_stop.lo: s_stop.c
s_paus.lo: s_paus.c
system_.lo: system_.c
cabs.lo: cabs.c
derf_.lo: derf_.c
derfc_.lo: derfc_.c
erf_.lo: erf_.c
erfc_.lo: erfc_.c
sig_die.lo: sig_die.c
exit_.lo: exit_.c
setarg.lo: setarg.c
setsig.lo: setsig.c
pow_ci.lo: pow_ci.c
pow_dd.lo: pow_dd.c
pow_di.lo: pow_di.c
pow_hh.lo: pow_hh.c
pow_ii.lo: pow_ii.c
pow_ri.lo: pow_ri.c
pow_zi.lo: pow_zi.c
pow_zz.lo: pow_zz.c
pow_qq.lo: pow_qq.c
c_abs.lo: c_abs.c
c_cos.lo: c_cos.c
c_div.lo: c_div.c
c_exp.lo: c_exp.c
c_log.lo: c_log.c
c_sin.lo: c_sin.c
c_sqrt.lo: c_sqrt.c
z_abs.lo: z_abs.c
z_cos.lo: z_cos.c
z_div.lo: z_div.c
z_exp.lo: z_exp.c
z_log.lo: z_log.c
@LIBTOOL@ --mode=compile $(CC) -c -DSkip_f2c_Undefs $(ALL_CFLAGS) -ffloat-store $(srcdir)/z_log.c
z_sin.lo: z_sin.c
z_sqrt.lo: z_sqrt.c
r_abs.lo: r_abs.c
r_acos.lo: r_acos.c
r_asin.lo: r_asin.c
r_atan.lo: r_atan.c
r_atn2.lo: r_atn2.c
r_cnjg.lo: r_cnjg.c
r_cos.lo: r_cos.c
r_cosh.lo: r_cosh.c
r_dim.lo: r_dim.c
r_exp.lo: r_exp.c
r_imag.lo: r_imag.c
r_int.lo: r_int.c
r_lg10.lo: r_lg10.c
r_log.lo: r_log.c
r_mod.lo: r_mod.c
r_nint.lo: r_nint.c
r_sign.lo: r_sign.c
r_sin.lo: r_sin.c
r_sinh.lo: r_sinh.c
r_sqrt.lo: r_sqrt.c
r_tan.lo: r_tan.c
r_tanh.lo: r_tanh.c
d_abs.lo: d_abs.c
d_acos.lo: d_acos.c
d_asin.lo: d_asin.c
d_atan.lo: d_atan.c
d_atn2.lo: d_atn2.c
d_cnjg.lo: d_cnjg.c
d_cos.lo: d_cos.c
d_cosh.lo: d_cosh.c
d_dim.lo: d_dim.c
d_exp.lo: d_exp.c
d_imag.lo: d_imag.c
d_int.lo: d_int.c
d_lg10.lo: d_lg10.c
d_log.lo: d_log.c
d_mod.lo: d_mod.c
d_nint.lo: d_nint.c
d_prod.lo: d_prod.c
d_sign.lo: d_sign.c
d_sin.lo: d_sin.c
d_sinh.lo: d_sinh.c
d_sqrt.lo: d_sqrt.c
d_tan.lo: d_tan.c
d_tanh.lo: d_tanh.c
i_abs.lo: i_abs.c
i_dim.lo: i_dim.c
i_dnnt.lo: i_dnnt.c
i_indx.lo: i_indx.c
i_len.lo: i_len.c
i_mod.lo: i_mod.c
i_nint.lo: i_nint.c
i_sign.lo: i_sign.c
h_abs.lo: h_abs.c
h_dim.lo: h_dim.c
h_dnnt.lo: h_dnnt.c
h_indx.lo: h_indx.c
h_len.lo: h_len.c
h_mod.lo: h_mod.c
h_nint.lo: h_nint.c
h_sign.lo: h_sign.c
l_ge.lo: l_ge.c
l_gt.lo: l_gt.c
l_le.lo: l_le.c
l_lt.lo: l_lt.c
hl_ge.lo: hl_ge.c
hl_gt.lo: hl_gt.c
hl_le.lo: hl_le.c
hl_lt.lo: hl_lt.c
ef1asc_.lo: ef1asc_.c
ef1cmc_.lo: ef1cmc_.c
s_cat.lo: s_cat.c
s_cmp.lo: s_cmp.c
s_copy.lo: s_copy.c
lbitbits.lo: lbitbits.c
lbitshft.lo: lbitshft.c
qbitbits.lo: qbitbits.c
qbitshft.lo: qbitshft.c
# Not quite all these actually do depend on f2c.h...
$(MISC) $(POW) $(CX) $(DCX) $(REAL) $(DBL) $(INT) $(HALF) $(CMP) $(EFL) \
$(CHAR) $(F90BIT): $(F2C_H_DIR)/f2c.h $(G2C_H_DIR)/g2c.h
check install uninstall install-strip dist installcheck installdirs:
mostlyclean:
rm -f *.o *.lo ../libfrtbegin.a
rm -rf .libs
clean: mostlyclean
rm -f config.log
rm -f ../s-libf77
distclean: clean
rm -f config.cache config.status Makefile ../s-libf77 configure
maintainer-clean:
.PHONY: mostlyclean clean distclean maintainer-clean all check uninstall \
install-strip dist installcheck installdirs archive
libf2c/libF77/Notice deleted 100644 → 0
/****************************************************************
Copyright 1990 - 1997 by AT&T, Lucent Technologies and Bellcore.
Permission to use, copy, modify, and distribute this software
and its documentation for any purpose and without fee is hereby
granted, provided that the above copyright notice appear in all
copies and that both that the copyright notice and this
permission notice and warranty disclaimer appear in supporting
documentation, and that the names of AT&T, Bell Laboratories,
Lucent or Bellcore or any of their entities not be used in
advertising or publicity pertaining to distribution of the
software without specific, written prior permission.
AT&T, Lucent and Bellcore disclaim all warranties with regard to
this software, including all implied warranties of
merchantability and fitness. In no event shall AT&T, Lucent or
Bellcore be liable for any special, indirect or consequential
damages or any damages whatsoever resulting from loss of use,
data or profits, whether in an action of contract, negligence or
other tortious action, arising out of or in connection with the
use or performance of this software.
****************************************************************/
libf2c/libF77/README.netlib deleted 100644 → 0
If your compiler does not recognize ANSI C headers,
compile with KR_headers defined: either add -DKR_headers
to the definition of CFLAGS in the makefile, or insert
#define KR_headers
at the top of f2c.h , cabs.c , main.c , and sig_die.c .
Under MS-DOS, compile s_paus.c with -DMSDOS.
If you have a really ancient K&R C compiler that does not understand
void, add -Dvoid=int to the definition of CFLAGS in the makefile.
If you use a C++ compiler, first create a local f2c.h by appending
f2ch.add to the usual f2c.h, e.g., by issuing the command
make f2c.h
which assumes f2c.h is installed in /usr/include .
If your system lacks onexit() and you are not using an ANSI C
compiler, then you should compile main.c, s_paus.c, s_stop.c, and
sig_die.c with NO_ONEXIT defined. See the comments about onexit in
the makefile.
If your system has a double drem() function such that drem(a,b)
is the IEEE remainder function (with double a, b), then you may
wish to compile r_mod.c and d_mod.c with IEEE_drem defined.
On some systems, you may also need to compile with -Ddrem=remainder .
To check for transmission errors, issue the command
make check
This assumes you have the xsum program whose source, xsum.c,
is distributed as part of "all from f2c/src". If you do not
have xsum, you can obtain xsum.c by sending the following E-mail
message to netlib@netlib.bell-labs.com
send xsum.c from f2c/src
The makefile assumes you have installed f2c.h in a standard
place (and does not cause recompilation when f2c.h is changed);
f2c.h comes with "all from f2c" (the source for f2c) and is
available separately ("f2c.h from f2c").
Most of the routines in libF77 are support routines for Fortran
intrinsic functions or for operations that f2c chooses not
to do "in line". There are a few exceptions, summarized below --
functions and subroutines that appear to your program as ordinary
external Fortran routines.
1. CALL ABORT prints a message and causes a core dump.
2. ERF(r) and DERF(d) and the REAL and DOUBLE PRECISION
error functions (with x REAL and d DOUBLE PRECISION);
DERF must be declared DOUBLE PRECISION in your program.
Both ERF and DERF assume your C library provides the
underlying erf() function (which not all systems do).
3. ERFC(r) and DERFC(d) are the complementary error functions:
ERFC(r) = 1 - ERF(r) and DERFC(d) = 1.d0 - DERFC(d)
(except that their results may be more accurate than
explicitly evaluating the above formulae would give).
Again, ERFC and r are REAL, and DERFC and d are DOUBLE
PRECISION (and must be declared as such in your program),
and ERFC and DERFC rely on your system's erfc().
4. CALL GETARG(n,s), where n is an INTEGER and s is a CHARACTER
variable, sets s to the n-th command-line argument (or to
all blanks if there are fewer than n command-line arguments);
CALL GETARG(0,s) sets s to the name of the program (on systems
that support this feature). See IARGC below.
5. CALL GETENV(name, value), where name and value are of type
CHARACTER, sets value to the environment value, $name, of
name (or to blanks if $name has not been set).
6. NARGS = IARGC() sets NARGS to the number of command-line
arguments (an INTEGER value).
7. CALL SIGNAL(n,func), where n is an INTEGER and func is an
EXTERNAL procedure, arranges for func to be invoked when
signal n occurs (on systems where this makes sense).
8. CALL SYSTEM(cmd), where cmd is of type CHARACTER, passes
cmd to the system's command processor (on systems where
this can be done).
The makefile does not attempt to compile pow_qq.c, qbitbits.c,
and qbitshft.c, which are meant for use with INTEGER*8. To use
INTEGER*8, you must modify f2c.h to declare longint and ulongint
appropriately; then add pow_qq.o to the POW = line in the makefile,
and add " qbitbits.o qbitshft.o" to the makefile's F90BIT = line.
Following Fortran 90, s_cat.c and s_copy.c allow the target of a
(character string) assignment to be appear on its right-hand, at
the cost of some extra overhead for all run-time concatenations.
If you prefer the extra efficiency that comes with the Fortran 77
requirement that the left-hand side of a character assignment not
be involved in the right-hand side, compile s_cat.c and s_copy.c
with -DNO_OVERWRITE .
If your system lacks a ranlib command, you don't need it.
Either comment out the makefile's ranlib invocation, or install
a harmless "ranlib" command somewhere in your PATH, such as the
one-line shell script
exit 0
or (on some systems)
exec /usr/bin/ar lts $1 >/dev/null
If your compiler complains about the signal calls in main.c, s_paus.c,
and signal_.c, you may need to adjust signal1.h suitably. See the
comments in signal1.h.
libf2c/libF77/Version.c deleted 100644 → 0
const char __LIBF77_VERSION__[] = "@(#) LIBF77 VERSION 20000929\n";
extern const char __LIBI77_VERSION__[];
extern const char __LIBU77_VERSION__[];
/*
2.00 11 June 1980. File version.c added to library.
2.01 31 May 1988. s_paus() flushes stderr; names of hl_* fixed
[ d]erf[c ] added
8 Aug. 1989: #ifdefs for f2c -i2 added to s_cat.c
29 Nov. 1989: s_cmp returns long (for f2c)
30 Nov. 1989: arg types from f2c.h
12 Dec. 1989: s_rnge allows long names
19 Dec. 1989: getenv_ allows unsorted environment
28 Mar. 1990: add exit(0) to end of main()
2 Oct. 1990: test signal(...) == SIG_IGN rather than & 01 in main
17 Oct. 1990: abort() calls changed to sig_die(...,1)
22 Oct. 1990: separate sig_die from main
25 Apr. 1991: minor, theoretically invisible tweaks to s_cat, sig_die
31 May 1991: make system_ return status
18 Dec. 1991: change long to ftnlen (for -i2) many places
28 Feb. 1992: repair z_sqrt.c (scribbled on input, gave wrong answer)
18 July 1992: for n < 0, repair handling of 0**n in pow_[dr]i.c
and m**n in pow_hh.c and pow_ii.c;
catch SIGTRAP in main() for error msg before abort
23 July 1992: switch to ANSI prototypes unless KR_headers is #defined
23 Oct. 1992: fix botch in signal_.c (erroneous deref of 2nd arg);
change Cabs to f__cabs.
12 March 1993: various tweaks for C++
2 June 1994: adjust so abnormal terminations invoke f_exit just once
16 Sept. 1994: s_cmp: treat characters as unsigned in comparisons.
19 Sept. 1994: s_paus: flush after end of PAUSE; add -DMSDOS
12 Jan. 1995: pow_[dhiqrz][hiq]: adjust x**i to work on machines
that sign-extend right shifts when i is the most
negative integer.
26 Jan. 1995: adjust s_cat.c, s_copy.c to permit the left-hand side
of character assignments to appear on the right-hand
side (unless compiled with -DNO_OVERWRITE).
27 Jan. 1995: minor tweak to s_copy.c: copy forward whenever
possible (for better cache behavior).
30 May 1995: added subroutine exit(rc) integer rc. Version not changed.
29 Aug. 1995: add F77_aloc.c; use it in s_cat.c and system_.c.
6 Sept. 1995: fix return type of system_ under -DKR_headers.
19 Dec. 1995: s_cat.c: fix bug when 2nd or later arg overlaps lhs.
19 Mar. 1996: s_cat.c: supply missing break after overlap detection.
13 May 1996: add [lq]bitbits.c and [lq]bitshft.c (f90 bit intrinsics).
19 June 1996: add casts to unsigned in [lq]bitshft.c.
26 Feb. 1997: adjust functions with a complex output argument
to permit aliasing it with input arguments.
(For now, at least, this is just for possible
benefit of g77.)
4 April 1997: [cz]_div.c: tweaks invisible on most systems (that may
affect systems using gratuitous extra precision).
19 Sept. 1997: [de]time_.c (Unix systems only): change return
type to double.
2 May 1999: getenv_.c: omit environ in favor of getenv().
c_cos.c, c_exp.c, c_sin.c, d_cnjg.c, r_cnjg.c,
z_cos.c, z_exp.c, z_log.c, z_sin.c: cope fully with
overlapping arguments caused by equivalence.
3 May 1999: "invisible" tweaks to omit compiler warnings in
abort_.c, ef1asc_.c, s_rnge.c, s_stop.c.
7 Sept. 1999: [cz]_div.c: arrange for compilation under
-DIEEE_COMPLEX_DIVIDE to make these routines
avoid calling sig_die when the denominator
vanishes; instead, they return pairs of NaNs
or Infinities, depending whether the numerator
also vanishes or not. VERSION not changed.
15 Nov. 1999: s_rnge.c: add casts for the case of
sizeof(ftnint) == sizeof(int) < sizeof(long).
10 March 2000: z_log.c: improve accuracy of Real(log(z)) for, e.g.,
z near (+-1,eps) with |eps| small. For the old
evaluation, compile with -DPre20000310 .
20 April 2000: s_cat.c: tweak argument types to accord with
calls by f2c when ftnint and ftnlen are of
different sizes (different numbers of bits).
4 July 2000: adjustments to permit compilation by C++ compilers;
VERSION string remains unchanged. NOT APPLIED FOR G77.
29 Sept. 2000: dtime_.c, etime_.c: use floating-point divide.
dtime_.d, erf_.c, erfc_.c, etime.c: for use with
"f2c -R", compile with -DREAL=float.
*/
#include <stdio.h>
void
g77__fvers__ ()
{
fputs ("GNU Fortran library.\n", stderr);
#if defined __GNUC__ && defined __VERSION__
fprintf (stderr, "Compiled by GCC %s\n", __VERSION__);
#endif
fputs (__LIBF77_VERSION__, stderr);
fputs (__LIBI77_VERSION__, stderr);
fputs (__LIBU77_VERSION__, stderr);
}
libf2c/libF77/abort_.c deleted 100644 → 0
#include <stdio.h>
#include "f2c.h"
extern void sig_die (char *, int);
int
G77_abort_0 (void)
{
sig_die ("Fortran abort routine called", 1);
return 0; /* not reached */
}
libf2c/libF77/c_abs.c deleted 100644 → 0
#include "f2c.h"
extern double f__cabs (double, double);
double
c_abs (complex * z)
{
return (f__cabs (z->r, z->i));
}
libf2c/libF77/c_cos.c deleted 100644 → 0
#include "f2c.h"
#undef abs
#include "math.h"
void
c_cos (complex * r, complex * z)
{
double zi = z->i, zr = z->r;
r->r = cos (zr) * cosh (zi);
r->i = -sin (zr) * sinh (zi);
}
libf2c/libF77/c_div.c deleted 100644 → 0
#include "f2c.h"
extern void sig_die (char *, int);
void
c_div (complex * c, complex * a, complex * b)
{
double ratio, den;
double abr, abi, cr;
if ((abr = b->r) < 0.)
abr = -abr;
if ((abi = b->i) < 0.)
abi = -abi;
if (abr <= abi)
{
if (abi == 0)
{
#ifdef IEEE_COMPLEX_DIVIDE
float af, bf;
af = bf = abr;
if (a->i != 0 || a->r != 0)
af = 1.;
c->i = c->r = af / bf;
return;
#else
sig_die ("complex division by zero", 1);
#endif
}
ratio = (double) b->r / b->i;
den = b->i * (1 + ratio * ratio);
cr = (a->r * ratio + a->i) / den;
c->i = (a->i * ratio - a->r) / den;
}
else
{
ratio = (double) b->i / b->r;
den = b->r * (1 + ratio * ratio);
cr = (a->r + a->i * ratio) / den;
c->i = (a->i - a->r * ratio) / den;
}
c->r = cr;
}
libf2c/libF77/c_exp.c deleted 100644 → 0
#include "f2c.h"
#undef abs
#include "math.h"
void
c_exp (complex * r, complex * z)
{
double expx, zi = z->i;
expx = exp (z->r);
r->r = expx * cos (zi);
r->i = expx * sin (zi);
}
libf2c/libF77/c_log.c deleted 100644 → 0
#include "f2c.h"
#undef abs
#include "math.h"
extern double f__cabs (double, double);
void
c_log (complex * r, complex * z)
{
double zi, zr;
r->i = atan2 (zi = z->i, zr = z->r);
r->r = log (f__cabs (zr, zi));
}
libf2c/libF77/c_sin.c deleted 100644 → 0
#include "f2c.h"
#undef abs
#include "math.h"
void
c_sin (complex * r, complex * z)
{
double zi = z->i, zr = z->r;
r->r = sin (zr) * cosh (zi);
r->i = cos (zr) * sinh (zi);
}
libf2c/libF77/c_sqrt.c deleted 100644 → 0
#include "f2c.h"
#undef abs
#include "math.h"
extern double f__cabs (double, double);
void
c_sqrt (complex * r, complex * z)
{
double mag, t;
double zi = z->i, zr = z->r;
if ((mag = f__cabs (zr, zi)) == 0.)
r->r = r->i = 0.;
else if (zr > 0)
{
r->r = t = sqrt (0.5 * (mag + zr));
t = zi / t;
r->i = 0.5 * t;
}
else
{
t = sqrt (0.5 * (mag - zr));
if (zi < 0)
t = -t;
r->i = t;
t = zi / t;
r->r = 0.5 * t;
}
}
libf2c/libF77/cabs.c deleted 100644 → 0
#undef abs
#include <math.h>
double
f__cabs (double real, double imag)
{
double temp;
if (real < 0)
real = -real;
if (imag < 0)
imag = -imag;
if (imag > real)
{
temp = real;
real = imag;
imag = temp;
}
if ((real + imag) == real)
return (real);
temp = imag / real;
temp = real * sqrt (1.0 + temp * temp); /*overflow!! */
return (temp);
}
libf2c/libF77/configure.in deleted 100644 → 0
# Process this file with autoconf to produce a configure script.
# Copyright (C) 1995, 1997, 1998, 2001 Free Software Foundation, Inc.
# Contributed by Dave Love (d.love@dl.ac.uk).
#
#This file is part of GNU Fortran.
#
#GNU Fortran 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.
#
#GNU Fortran 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 GNU Fortran; see the file COPYING. If not, write to
#the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
#02111-1307, USA.
AC_PREREQ(2.13)
AC_INIT(getarg_.c)
dnl Checks for programs.
dnl FIXME AC_PROG_CC wants CC to be able to link things, but it may
dnl not be able to.
define([AC_PROG_CC_WORKS],[])
# For g77 we'll set CC to point at the built gcc, but this will get it into
# the makefiles
AC_PROG_CC
LIBTOOL='$(SHELL) ../libtool'
AC_SUBST(LIBTOOL)
test "$AR" || AR=ar
AC_SUBST(AR)
if test "$RANLIB"; then :
AC_SUBST(RANLIB)
else
AC_PROG_RANLIB
fi
AC_PROG_MAKE_SET
dnl Checks for libraries.
dnl Checks for header files.
# Sanity check for the cross-compilation case:
AC_CHECK_HEADER(stdio.h,:,
[AC_MSG_ERROR([Can't find stdio.h.
You must have a usable C system for the target already installed, at least
including headers and, preferably, the library, before you can configure
the G77 runtime system. If necessary, install gcc now with \`LANGUAGES=c',
then the target library, then build with \`LANGUAGES=f77'.])])
AC_HEADER_STDC
AC_MSG_CHECKING(for posix)
AC_CACHE_VAL(g77_cv_header_posix,
AC_EGREP_CPP(yes,
[#include <sys/types.h>
#include <unistd.h>
#ifdef _POSIX_VERSION
yes
#endif
],
g77_cv_header_posix=yes,
g77_cv_header_posix=no))
AC_MSG_RESULT($g77_cv_header_posix)
# We can rely on the GNU library being posix-ish. I guess checking the
# header isn't actually like checking the functions, though...
AC_MSG_CHECKING(for GNU library)
AC_CACHE_VAL(g77_cv_lib_gnu,
AC_EGREP_CPP(yes,
[#include <stdio.h>
#ifdef __GNU_LIBRARY__
yes
#endif
],
g77_cv_lib_gnu=yes, g77_cv_lib_gnu=no))
AC_MSG_RESULT($g77_cv_lib_gnu)
dnl Checks for library functions.
AC_TYPE_SIGNAL
# we'll get atexit by default
if test $ac_cv_header_stdc != yes; then
AC_CHECK_FUNC(atexit,
AC_DEFINE(onexit,atexit),dnl just in case
[AC_DEFINE(NO_ONEXIT)
AC_CHECK_FUNC(onexit,,
[AC_CHECK_FUNC(on_exit,
AC_DEFINE(onexit,on_exit),)])])
else true
fi
dnl perhaps should check also for remainder
dnl Unfortunately, the message implies we're just checking for -lm...
AC_CHECK_LIB(m,drem,AC_DEFINE(IEEE_drem))
AC_DEFINE(Skip_f2c_Undefs)
AC_DEFINE(IEEE_COMPLEX_DIVIDE)
AC_OUTPUT(Makefile)
dnl Local Variables:
dnl comment-start: "dnl "
dnl comment-end: ""
dnl comment-start-skip: "\\bdnl\\b\\s *"
dnl End:
libf2c/libF77/d_abs.c deleted 100644 → 0
#include "f2c.h"
double
d_abs (doublereal * x)
{
if (*x >= 0)
return (*x);
return (-*x);
}
libf2c/libF77/d_acos.c deleted 100644 → 0
#include "f2c.h"
#undef abs
#include <math.h>
double
d_acos (doublereal * x)
{
return (acos (*x));
}
libf2c/libF77/d_asin.c deleted 100644 → 0
#include "f2c.h"
#undef abs
#include <math.h>
double
d_asin (doublereal * x)
{
return (asin (*x));
}
libf2c/libF77/d_atan.c deleted 100644 → 0
#include "f2c.h"
#undef abs
#include <math.h>
double
d_atan (doublereal * x)
{
return (atan (*x));
}
libf2c/libF77/d_atn2.c deleted 100644 → 0
#include "f2c.h"
#undef abs
#include <math.h>
double
d_atn2 (doublereal * x, doublereal * y)
{
return (atan2 (*x, *y));
}
libf2c/libF77/d_cnjg.c deleted 100644 → 0
#include "f2c.h"
void
d_cnjg (doublecomplex * r, doublecomplex * z)
{
doublereal zi = z->i;
r->r = z->r;
r->i = -zi;
}
libf2c/libF77/d_cos.c deleted 100644 → 0
#include "f2c.h"
#undef abs
#include <math.h>
double
d_cos (doublereal * x)
{
return (cos (*x));
}
libf2c/libF77/d_cosh.c deleted 100644 → 0
#include "f2c.h"
#undef abs
#include <math.h>
double
d_cosh (doublereal * x)
{
return (cosh (*x));
}
libf2c/libF77/d_dim.c deleted 100644 → 0
#include "f2c.h"
double
d_dim (doublereal * a, doublereal * b)
{
return (*a > *b ? *a - *b : 0);
}
libf2c/libF77/d_exp.c deleted 100644 → 0
#include "f2c.h"
#undef abs
#include <math.h>
double
d_exp (doublereal * x)
{
return (exp (*x));
}
libf2c/libF77/d_imag.c deleted 100644 → 0
#include "f2c.h"
double
d_imag (doublecomplex * z)
{
return (z->i);
}
libf2c/libF77/d_int.c deleted 100644 → 0
#include "f2c.h"
#undef abs
#include <math.h>
double
d_int (doublereal * x)
{
return ((*x > 0) ? floor (*x) : -floor (-*x));
}
libf2c/libF77/d_lg10.c deleted 100644 → 0
#include "f2c.h"
#define log10e 0.43429448190325182765
#undef abs
#include <math.h>
double
d_lg10 (doublereal * x)
{
return (log10e * log (*x));
}
libf2c/libF77/d_log.c deleted 100644 → 0
#include "f2c.h"
#undef abs
#include <math.h>
double
d_log (doublereal * x)
{
return (log (*x));
}
libf2c/libF77/d_mod.c deleted 100644 → 0
#include "f2c.h"
#ifdef IEEE_drem
double drem (double, double);
#else
#undef abs
#include <math.h>
#endif
double
d_mod (doublereal * x, doublereal * y)
{
#ifdef IEEE_drem
double xa, ya, z;
if ((ya = *y) < 0.)
ya = -ya;
z = drem (xa = *x, ya);
if (xa > 0)
{
if (z < 0)
z += ya;
}
else if (z > 0)
z -= ya;
return z;
#else
double quotient;
if ((quotient = *x / *y) >= 0)
quotient = floor (quotient);
else
quotient = -floor (-quotient);
return (*x - (*y) * quotient);
#endif
}
libf2c/libF77/d_nint.c deleted 100644 → 0
#include "f2c.h"
#undef abs
#include <math.h>
double
d_nint (doublereal * x)
{
return ((*x) >= 0 ? floor (*x + .5) : -floor (.5 - *x));
}
libf2c/libF77/d_prod.c deleted 100644 → 0
#include "f2c.h"
double
d_prod (real * x, real * y)
{
return ((*x) * (*y));
}
libf2c/libF77/d_sign.c deleted 100644 → 0
#include "f2c.h"
double
d_sign (doublereal * a, doublereal * b)
{
double x;
x = (*a >= 0 ? *a : -*a);
return (*b >= 0 ? x : -x);
}
libf2c/libF77/d_sin.c deleted 100644 → 0
#include "f2c.h"
#undef abs
#include <math.h>
double
d_sin (doublereal * x)
{
return (sin (*x));
}
libf2c/libF77/d_sinh.c deleted 100644 → 0
#include "f2c.h"
#undef abs
#include <math.h>
double
d_sinh (doublereal * x)
{
return (sinh (*x));
}
libf2c/libF77/d_sqrt.c deleted 100644 → 0
#include "f2c.h"
#undef abs
#include <math.h>
double
d_sqrt (doublereal * x)
{
return (sqrt (*x));
}
libf2c/libF77/d_tan.c deleted 100644 → 0
#include "f2c.h"
#undef abs
#include <math.h>
double
d_tan (doublereal * x)
{
return (tan (*x));
}
libf2c/libF77/d_tanh.c deleted 100644 → 0
#include "f2c.h"
#undef abs
#include <math.h>
double
d_tanh (doublereal * x)
{
return (tanh (*x));
}
libf2c/libF77/derf_.c deleted 100644 → 0
#include "f2c.h"
extern double erf (double);
double
G77_derf_0 (doublereal * x)
{
return (erf (*x));
}
libf2c/libF77/derfc_.c deleted 100644 → 0
#include "f2c.h"
extern double erfc (double);
double
G77_derfc_0 (doublereal * x)
{
return (erfc (*x));
}
libf2c/libF77/dtime_.c deleted 100644 → 0
#include "time.h"
#ifdef MSDOS
#undef USE_CLOCK
#define USE_CLOCK
#endif
#ifndef USE_CLOCK
#define _INCLUDE_POSIX_SOURCE /* for HP-UX */
#define _INCLUDE_XOPEN_SOURCE /* for HP-UX */
#include "sys/types.h"
#include "sys/times.h"
#endif
#undef Hz
#ifdef CLK_TCK
#define Hz CLK_TCK
#else
#ifdef HZ
#define Hz HZ
#else
#define Hz 60
#endif
#endif
double
dtime_ (float *tarray)
{
#ifdef USE_CLOCK
#ifndef CLOCKS_PER_SECOND
#define CLOCKS_PER_SECOND Hz
#endif
static double t0;
double t = clock ();
tarray[1] = 0;
tarray[0] = (t - t0) / CLOCKS_PER_SECOND;
t0 = t;
return tarray[0];
#else
struct tms t;
static struct tms t0;
times (&t);
tarray[0] = (double) (t.tms_utime - t0.tms_utime) / Hz;
tarray[1] = (double) (t.tms_stime - t0.tms_stime) / Hz;
t0 = t;
return tarray[0] + tarray[1];
#endif
}
libf2c/libF77/ef1asc_.c deleted 100644 → 0
/* EFL support routine to copy string b to string a */
#include "f2c.h"
#define M ( (long) (sizeof(long) - 1) )
#define EVEN(x) ( ( (x)+ M) & (~M) )
extern void s_copy (char *, char *, ftnlen, ftnlen);
int
G77_ef1asc_0 (ftnint * a, ftnlen * la, ftnint * b, ftnlen * lb)
{
s_copy ((char *) a, (char *) b, EVEN (*la), *lb);
return 0; /* ignored return value */
}
libf2c/libF77/ef1cmc_.c deleted 100644 → 0
/* EFL support routine to compare two character strings */
#include "f2c.h"
extern integer s_cmp (char *, char *, ftnlen, ftnlen);
integer
G77_ef1cmc_0 (ftnint * a, ftnlen * la, ftnint * b, ftnlen * lb)
{
return (s_cmp ((char *) a, (char *) b, *la, *lb));
}
libf2c/libF77/erf_.c deleted 100644 → 0
#include "f2c.h"
extern double erf (double);
double
G77_erf_0 (real * x)
{
return (erf (*x));
}
libf2c/libF77/erfc_.c deleted 100644 → 0
#include "f2c.h"
extern double erfc (double);
double
G77_erfc_0 (real * x)
{
return (erfc (*x));
}
libf2c/libF77/etime_.c deleted 100644 → 0
#include "time.h"
#ifdef MSDOS
#undef USE_CLOCK
#define USE_CLOCK
#endif
#ifndef USE_CLOCK
#define _INCLUDE_POSIX_SOURCE /* for HP-UX */
#define _INCLUDE_XOPEN_SOURCE /* for HP-UX */
#include "sys/types.h"
#include "sys/times.h"
#endif
#undef Hz
#ifdef CLK_TCK
#define Hz CLK_TCK
#else
#ifdef HZ
#define Hz HZ
#else
#define Hz 60
#endif
#endif
double
etime_ (float *tarray)
{
#ifdef USE_CLOCK
#ifndef CLOCKS_PER_SECOND
#define CLOCKS_PER_SECOND Hz
#endif
double t = clock ();
tarray[1] = 0;
return tarray[0] = t / CLOCKS_PER_SECOND;
#else
struct tms t;
times (&t);
return (tarray[0] = (double) t.tms_utime / Hz)
+ (tarray[1] = (double) t.tms_stime / Hz);
#endif
}
libf2c/libF77/exit_.c deleted 100644 → 0
/* This gives the effect of
subroutine exit(rc)
integer*4 rc
stop
end
* with the added side effect of supplying rc as the program's exit code.
*/
#include "f2c.h"
#undef abs
#undef min
#undef max
#include <stdlib.h>
extern void f_exit (void);
void
G77_exit_0 (integer * rc)
{
#ifdef NO_ONEXIT
f_exit ();
#endif
exit (*rc);
}
libf2c/libF77/f2ch.add deleted 100644 → 0
/* If you are using a C++ compiler, append the following to f2c.h
for compiling libF77 and libI77. */
#ifdef __cplusplus
extern "C"
{
extern int abort_ (void);
extern double c_abs (complex *);
extern void c_cos (complex *, complex *);
extern void c_div (complex *, complex *, complex *);
extern void c_exp (complex *, complex *);
extern void c_log (complex *, complex *);
extern void c_sin (complex *, complex *);
extern void c_sqrt (complex *, complex *);
extern double d_abs (double *);
extern double d_acos (double *);
extern double d_asin (double *);
extern double d_atan (double *);
extern double d_atn2 (double *, double *);
extern void d_cnjg (doublecomplex *, doublecomplex *);
extern double d_cos (double *);
extern double d_cosh (double *);
extern double d_dim (double *, double *);
extern double d_exp (double *);
extern double d_imag (doublecomplex *);
extern double d_int (double *);
extern double d_lg10 (double *);
extern double d_log (double *);
extern double d_mod (double *, double *);
extern double d_nint (double *);
extern double d_prod (float *, float *);
extern double d_sign (double *, double *);
extern double d_sin (double *);
extern double d_sinh (double *);
extern double d_sqrt (double *);
extern double d_tan (double *);
extern double d_tanh (double *);
extern double derf_ (double *);
extern double derfc_ (double *);
extern integer do_fio (ftnint *, char *, ftnlen);
extern integer do_lio (ftnint *, ftnint *, char *, ftnlen);
extern integer do_uio (ftnint *, char *, ftnlen);
extern integer e_rdfe (void);
extern integer e_rdue (void);
extern integer e_rsfe (void);
extern integer e_rsfi (void);
extern integer e_rsle (void);
extern integer e_rsli (void);
extern integer e_rsue (void);
extern integer e_wdfe (void);
extern integer e_wdue (void);
extern integer e_wsfe (void);
extern integer e_wsfi (void);
extern integer e_wsle (void);
extern integer e_wsli (void);
extern integer e_wsue (void);
extern int ef1asc_ (ftnint *, ftnlen *, ftnint *, ftnlen *);
extern integer ef1cmc_ (ftnint *, ftnlen *, ftnint *, ftnlen *);
extern double erf (double);
extern double erf_ (float *);
extern double erfc (double);
extern double erfc_ (float *);
extern integer f_back (alist *);
extern integer f_clos (cllist *);
extern integer f_end (alist *);
extern void f_exit (void);
extern integer f_inqu (inlist *);
extern integer f_open (olist *);
extern integer f_rew (alist *);
extern int flush_ (void);
extern void getarg_ (integer *, char *, ftnlen);
extern void getenv_ (char *, char *, ftnlen, ftnlen);
extern short h_abs (short *);
extern short h_dim (short *, short *);
extern short h_dnnt (double *);
extern short h_indx (char *, char *, ftnlen, ftnlen);
extern short h_len (char *, ftnlen);
extern short h_mod (short *, short *);
extern short h_nint (float *);
extern short h_sign (short *, short *);
extern short hl_ge (char *, char *, ftnlen, ftnlen);
extern short hl_gt (char *, char *, ftnlen, ftnlen);
extern short hl_le (char *, char *, ftnlen, ftnlen);
extern short hl_lt (char *, char *, ftnlen, ftnlen);
extern integer i_abs (integer *);
extern integer i_dim (integer *, integer *);
extern integer i_dnnt (double *);
extern integer i_indx (char *, char *, ftnlen, ftnlen);
extern integer i_len (char *, ftnlen);
extern integer i_mod (integer *, integer *);
extern integer i_nint (float *);
extern integer i_sign (integer *, integer *);
extern integer iargc_ (void);
extern ftnlen l_ge (char *, char *, ftnlen, ftnlen);
extern ftnlen l_gt (char *, char *, ftnlen, ftnlen);
extern ftnlen l_le (char *, char *, ftnlen, ftnlen);
extern ftnlen l_lt (char *, char *, ftnlen, ftnlen);
extern void pow_ci (complex *, complex *, integer *);
extern double pow_dd (double *, double *);
extern double pow_di (double *, integer *);
extern short pow_hh (short *, shortint *);
extern integer pow_ii (integer *, integer *);
extern double pow_ri (float *, integer *);
extern void pow_zi (doublecomplex *, doublecomplex *, integer *);
extern void pow_zz (doublecomplex *, doublecomplex *, doublecomplex *);
extern double r_abs (float *);
extern double r_acos (float *);
extern double r_asin (float *);
extern double r_atan (float *);
extern double r_atn2 (float *, float *);
extern void r_cnjg (complex *, complex *);
extern double r_cos (float *);
extern double r_cosh (float *);
extern double r_dim (float *, float *);
extern double r_exp (float *);
extern double r_imag (complex *);
extern double r_int (float *);
extern double r_lg10 (float *);
extern double r_log (float *);
extern double r_mod (float *, float *);
extern double r_nint (float *);
extern double r_sign (float *, float *);
extern double r_sin (float *);
extern double r_sinh (float *);
extern double r_sqrt (float *);
extern double r_tan (float *);
extern double r_tanh (float *);
extern void s_cat (char *, char **, integer *, integer *, ftnlen);
extern integer s_cmp (char *, char *, ftnlen, ftnlen);
extern void s_copy (char *, char *, ftnlen, ftnlen);
extern int s_paus (char *, ftnlen);
extern integer s_rdfe (cilist *);
extern integer s_rdue (cilist *);
extern integer s_rnge (char *, integer, char *, integer);
extern integer s_rsfe (cilist *);
extern integer s_rsfi (icilist *);
extern integer s_rsle (cilist *);
extern integer s_rsli (icilist *);
extern integer s_rsne (cilist *);
extern integer s_rsni (icilist *);
extern integer s_rsue (cilist *);
extern int s_stop (char *, ftnlen);
extern integer s_wdfe (cilist *);
extern integer s_wdue (cilist *);
extern integer s_wsfe (cilist *);
extern integer s_wsfi (icilist *);
extern integer s_wsle (cilist *);
extern integer s_wsli (icilist *);
extern integer s_wsne (cilist *);
extern integer s_wsni (icilist *);
extern integer s_wsue (cilist *);
extern void sig_die (char *, int);
extern integer signal_ (integer *, void (*)(int));
extern integer system_ (char *, ftnlen);
extern double z_abs (doublecomplex *);
extern void z_cos (doublecomplex *, doublecomplex *);
extern void z_div (doublecomplex *, doublecomplex *, doublecomplex *);
extern void z_exp (doublecomplex *, doublecomplex *);
extern void z_log (doublecomplex *, doublecomplex *);
extern void z_sin (doublecomplex *, doublecomplex *);
extern void z_sqrt (doublecomplex *, doublecomplex *);
}
#endif
libf2c/libF77/getarg_.c deleted 100644 → 0
#include "f2c.h"
/*
* subroutine getarg(k, c)
* returns the kth unix command argument in fortran character
* variable argument c
*/
void
G77_getarg_0 (ftnint * n, register char *s, ftnlen ls)
{
extern int f__xargc;
extern char **f__xargv;
register char *t;
register int i;
if (*n >= 0 && *n < f__xargc)
t = f__xargv[*n];
else
t = "";
for (i = 0; i < ls && *t != '\0'; ++i)
*s++ = *t++;
for (; i < ls; ++i)
*s++ = ' ';
}
libf2c/libF77/getenv_.c deleted 100644 → 0
#include "f2c.h"
#undef abs
#include <stdlib.h>
#include <string.h>
extern char *F77_aloc (ftnlen, char *);
/*
* getenv - f77 subroutine to return environment variables
*
* called by:
* call getenv (ENV_NAME, char_var)
* where:
* ENV_NAME is the name of an environment variable
* char_var is a character variable which will receive
* the current value of ENV_NAME, or all blanks
* if ENV_NAME is not defined
*/
void
G77_getenv_0 (char *fname, char *value, ftnlen flen, ftnlen vlen)
{
char buf[256], *ep, *fp;
integer i;
if (flen <= 0)
goto add_blanks;
for (i = 0; i < (integer) sizeof (buf); i++)
{
if (i == flen || (buf[i] = fname[i]) == ' ')
{
buf[i] = 0;
ep = getenv (buf);
goto have_ep;
}
}
while (i < flen && fname[i] != ' ')
i++;
strncpy (fp = F77_aloc (i + 1, "getenv_"), fname, (int) i);
fp[i] = 0;
ep = getenv (fp);
free (fp);
have_ep:
if (ep)
while (*ep && vlen-- > 0)
*value++ = *ep++;
add_blanks:
while (vlen-- > 0)
*value++ = ' ';
}
libf2c/libF77/h_abs.c deleted 100644 → 0
#include "f2c.h"
shortint
h_abs (shortint * x)
{
if (*x >= 0)
return (*x);
return (-*x);
}
libf2c/libF77/h_dim.c deleted 100644 → 0
#include "f2c.h"
shortint
h_dim (shortint * a, shortint * b)
{
return (*a > *b ? *a - *b : 0);
}
libf2c/libF77/h_dnnt.c deleted 100644 → 0
#include "f2c.h"
#undef abs
#include <math.h>
shortint
h_dnnt (doublereal * x)
{
return (shortint) (*x >= 0. ? floor (*x + .5) : -floor (.5 - *x));
}
libf2c/libF77/h_indx.c deleted 100644 → 0
#include "f2c.h"
shortint
h_indx (char *a, char *b, ftnlen la, ftnlen lb)
{
ftnlen i, n;
char *s, *t, *bend;
n = la - lb + 1;
bend = b + lb;
for (i = 0; i < n; ++i)
{
s = a + i;
t = b;
while (t < bend)
if (*s++ != *t++)
goto no;
return ((shortint) i + 1);
no:;
}
return (0);
}
libf2c/libF77/h_len.c deleted 100644 → 0
#include "f2c.h"
shortint
h_len (char *s __attribute__ ((__unused__)), ftnlen n)
{
return (n);
}
libf2c/libF77/h_mod.c deleted 100644 → 0
#include "f2c.h"
shortint
h_mod (short *a, short *b)
{
return (*a % *b);
}
libf2c/libF77/h_nint.c deleted 100644 → 0
#include "f2c.h"
#undef abs
#include <math.h>
shortint
h_nint (real * x)
{
return (shortint) (*x >= 0 ? floor (*x + .5) : -floor (.5 - *x));
}
libf2c/libF77/h_sign.c deleted 100644 → 0
#include "f2c.h"
shortint
h_sign (shortint * a, shortint * b)
{
shortint x;
x = (*a >= 0 ? *a : -*a);
return (*b >= 0 ? x : -x);
}
libf2c/libF77/hl_ge.c deleted 100644 → 0
#include "f2c.h"
extern integer s_cmp (char *, char *, ftnlen, ftnlen);
shortlogical
hl_ge (char *a, char *b, ftnlen la, ftnlen lb)
{
return (s_cmp (a, b, la, lb) >= 0);
}
libf2c/libF77/hl_gt.c deleted 100644 → 0
#include "f2c.h"
extern integer s_cmp (char *, char *, ftnlen, ftnlen);
shortlogical
hl_gt (char *a, char *b, ftnlen la, ftnlen lb)
{
return (s_cmp (a, b, la, lb) > 0);
}
libf2c/libF77/hl_le.c deleted 100644 → 0
#include "f2c.h"
extern integer s_cmp (char *, char *, ftnlen, ftnlen);
shortlogical
hl_le (char *a, char *b, ftnlen la, ftnlen lb)
{
return (s_cmp (a, b, la, lb) <= 0);
}
libf2c/libF77/hl_lt.c deleted 100644 → 0
#include "f2c.h"
extern integer s_cmp (char *, char *, ftnlen, ftnlen);
shortlogical
hl_lt (char *a, char *b, ftnlen la, ftnlen lb)
{
return (s_cmp (a, b, la, lb) < 0);
}
libf2c/libF77/i_abs.c deleted 100644 → 0
#include "f2c.h"
integer
i_abs (integer * x)
{
if (*x >= 0)
return (*x);
return (-*x);
}
libf2c/libF77/i_dim.c deleted 100644 → 0
#include "f2c.h"
integer
i_dim (integer * a, integer * b)
{
return (*a > *b ? *a - *b : 0);
}
libf2c/libF77/i_dnnt.c deleted 100644 → 0
#include "f2c.h"
#undef abs
#include <math.h>
integer
i_dnnt (doublereal * x)
{
return (integer) (*x >= 0. ? floor (*x + .5) : -floor (.5 - *x));
}
libf2c/libF77/i_indx.c deleted 100644 → 0
#include "f2c.h"
integer
i_indx (char *a, char *b, ftnlen la, ftnlen lb)
{
ftnlen i, n;
char *s, *t, *bend;
n = la - lb + 1;
bend = b + lb;
for (i = 0; i < n; ++i)
{
s = a + i;
t = b;
while (t < bend)
if (*s++ != *t++)
goto no;
return (i + 1);
no:;
}
return (0);
}
libf2c/libF77/i_len.c deleted 100644 → 0
#include "f2c.h"
integer
i_len (char *s __attribute__ ((__unused__)), ftnlen n)
{
return (n);
}
libf2c/libF77/i_mod.c deleted 100644 → 0
#include "f2c.h"
integer
i_mod (integer * a, integer * b)
{
return (*a % *b);
}
libf2c/libF77/i_nint.c deleted 100644 → 0
#include "f2c.h"
#undef abs
#include <math.h>
integer
i_nint (real * x)
{
return (integer) (*x >= 0 ? floor (*x + .5) : -floor (.5 - *x));
}
libf2c/libF77/i_sign.c deleted 100644 → 0
#include "f2c.h"
integer
i_sign (integer * a, integer * b)
{
integer x;
x = (*a >= 0 ? *a : -*a);
return (*b >= 0 ? x : -x);
}
libf2c/libF77/iargc_.c deleted 100644 → 0
#include "f2c.h"
ftnint
G77_iargc_0 (void)
{
extern int f__xargc;
return (f__xargc - 1);
}
libf2c/libF77/l_ge.c deleted 100644 → 0
#include "f2c.h"
extern integer s_cmp (char *, char *, ftnlen, ftnlen);
logical
l_ge (char *a, char *b, ftnlen la, ftnlen lb)
{
return (s_cmp (a, b, la, lb) >= 0);
}
libf2c/libF77/l_gt.c deleted 100644 → 0
#include "f2c.h"
extern integer s_cmp (char *, char *, ftnlen, ftnlen);
logical
l_gt (char *a, char *b, ftnlen la, ftnlen lb)
{
return (s_cmp (a, b, la, lb) > 0);
}
libf2c/libF77/l_le.c deleted 100644 → 0
#include "f2c.h"
extern integer s_cmp (char *, char *, ftnlen, ftnlen);
logical
l_le (char *a, char *b, ftnlen la, ftnlen lb)
{
return (s_cmp (a, b, la, lb) <= 0);
}
libf2c/libF77/l_lt.c deleted 100644 → 0
#include "f2c.h"
extern integer s_cmp (char *, char *, ftnlen, ftnlen);
logical
l_lt (char *a, char *b, ftnlen la, ftnlen lb)
{
return (s_cmp (a, b, la, lb) < 0);
}
libf2c/libF77/lbitbits.c deleted 100644 → 0
#include "f2c.h"
#ifndef LONGBITS
#define LONGBITS 32
#endif
integer
lbit_bits (integer a, integer b, integer len)
{
/* Assume 2's complement arithmetic */
unsigned long x, y;
x = (unsigned long) a;
y = (unsigned long) -1L;
x >>= b;
y <<= len;
return (integer) (x & ~y);
}
integer
lbit_cshift (integer a, integer b, integer len)
{
unsigned long x, y, z;
x = (unsigned long) a;
if (len <= 0)
{
if (len == 0)
return 0;
goto full_len;
}
if (len >= LONGBITS)
{
full_len:
if (b >= 0)
{
b %= LONGBITS;
return (integer) (x << b | x >> (LONGBITS - b));
}
b = -b;
b %= LONGBITS;
return (integer) (x << (LONGBITS - b) | x >> b);
}
y = z = (unsigned long) -1;
y <<= len;
z &= ~y;
y &= x;
x &= z;
if (b >= 0)
{
b %= len;
return (integer) (y | (z & (x << b | x >> (len - b))));
}
b = -b;
b %= len;
return (integer) (y | (z & (x >> b | x << (len - b))));
}
libf2c/libF77/lbitshft.c deleted 100644 → 0
#include "f2c.h"
integer
lbit_shift (integer a, integer b)
{
return b >= 0 ? a << b : (integer) ((uinteger) a >> -b);
}
libf2c/libF77/main.c deleted 100644 → 0
/* STARTUP PROCEDURE FOR UNIX FORTRAN PROGRAMS */
#include <stdio.h>
#include "signal1.h"
#include <stdlib.h>
extern void f_exit (void);
#ifndef NO_ONEXIT
#define ONEXIT atexit
extern int atexit (void (*)(void));
#endif
extern void f_init (void);
extern int MAIN__ (void);
extern void f_setarg (int, char **);
extern void f_setsig (void);
int
main (int argc, char **argv)
{
f_setarg (argc, argv);
f_setsig ();
f_init ();
#ifndef NO_ONEXIT
ONEXIT (f_exit);
#endif
MAIN__ ();
#ifdef NO_ONEXIT
f_exit ();
#endif
exit (0); /* exit(0) rather than return(0) to bypass Cray bug */
return 0; /* For compilers that complain of missing return values; */
/* others will complain that this is unreachable code. */
}
libf2c/libF77/makefile.netlib deleted 100644 → 0
.SUFFIXES: .c .o
CC = cc
SHELL = /bin/sh
CFLAGS = -O
# If your system lacks onexit() and you are not using an
# ANSI C compiler, then you should add -DNO_ONEXIT to CFLAGS,
# e.g., by changing the above "CFLAGS =" line to
# CFLAGS = -O -DNO_ONEXIT
# On at least some Sun systems, it is more appropriate to change the
# "CFLAGS =" line to
# CFLAGS = -O -Donexit=on_exit
# compile, then strip unnecessary symbols
.c.o:
$(CC) -c -DSkip_f2c_Undefs $(CFLAGS) $*.c
ld -r -x -o $*.xxx $*.o
mv $*.xxx $*.o
## Under Solaris (and other systems that do not understand ld -x),
## omit -x in the ld line above.
## If your system does not have the ld command, comment out
## or remove both the ld and mv lines above.
MISC = F77_aloc.o Version.o main.o s_rnge.o abort_.o getarg_.o iargc_.o \
getenv_.o signal_.o s_stop.o s_paus.o system_.o cabs.o\
derf_.o derfc_.o erf_.o erfc_.o sig_die.o exit_.o
POW = pow_ci.o pow_dd.o pow_di.o pow_hh.o pow_ii.o pow_ri.o pow_zi.o pow_zz.o
CX = c_abs.o c_cos.o c_div.o c_exp.o c_log.o c_sin.o c_sqrt.o
DCX = z_abs.o z_cos.o z_div.o z_exp.o z_log.o z_sin.o z_sqrt.o
REAL = r_abs.o r_acos.o r_asin.o r_atan.o r_atn2.o r_cnjg.o r_cos.o\
r_cosh.o r_dim.o r_exp.o r_imag.o r_int.o\
r_lg10.o r_log.o r_mod.o r_nint.o r_sign.o\
r_sin.o r_sinh.o r_sqrt.o r_tan.o r_tanh.o
DBL = d_abs.o d_acos.o d_asin.o d_atan.o d_atn2.o\
d_cnjg.o d_cos.o d_cosh.o d_dim.o d_exp.o\
d_imag.o d_int.o d_lg10.o d_log.o d_mod.o\
d_nint.o d_prod.o d_sign.o d_sin.o d_sinh.o\
d_sqrt.o d_tan.o d_tanh.o
INT = i_abs.o i_dim.o i_dnnt.o i_indx.o i_len.o i_mod.o i_nint.o i_sign.o
HALF = h_abs.o h_dim.o h_dnnt.o h_indx.o h_len.o h_mod.o h_nint.o h_sign.o
CMP = l_ge.o l_gt.o l_le.o l_lt.o hl_ge.o hl_gt.o hl_le.o hl_lt.o
EFL = ef1asc_.o ef1cmc_.o
CHAR = F77_aloc.o s_cat.o s_cmp.o s_copy.o
F90BIT = lbitbits.o lbitshft.o
QINT = pow_qq.o qbitbits.o qbitshft.o
TIME = dtime_.o etime_.o
all: signal1.h libF77.a
# You may need to adjust signal1.h suitably for your system...
signal1.h: signal1.h0
cp signal1.h0 signal1.h
# If you get an error compiling dtime_.c or etime_.c, try adding
# -DUSE_CLOCK to the CFLAGS assignment above; if that does not work,
# omit $(TIME) from the dependency list for libF77.a below.
# For INTEGER*8 support (which requires system-dependent adjustments to
# f2c.h), add $(QINT) to the libf2c.a dependency list below...
libF77.a : $(MISC) $(POW) $(CX) $(DCX) $(REAL) $(DBL) $(INT) \
$(HALF) $(CMP) $(EFL) $(CHAR) $(F90BIT) $(TIME)
ar r libF77.a $?
-ranlib libF77.a
### If your system lacks ranlib, you don't need it; see README.
Version.o: Version.c
$(CC) -c Version.c
# To compile with C++, first "make f2c.h"
f2c.h: f2ch.add
cat /usr/include/f2c.h f2ch.add >f2c.h
install: libF77.a
mv libF77.a /usr/lib
ranlib /usr/lib/libF77.a
clean:
rm -f libF77.a *.o
check:
xsum F77_aloc.c Notice README Version.c abort_.c c_abs.c c_cos.c \
c_div.c c_exp.c c_log.c c_sin.c c_sqrt.c cabs.c d_abs.c d_acos.c \
d_asin.c d_atan.c d_atn2.c d_cnjg.c d_cos.c d_cosh.c d_dim.c \
d_exp.c d_imag.c d_int.c d_lg10.c d_log.c d_mod.c d_nint.c \
d_prod.c d_sign.c d_sin.c d_sinh.c d_sqrt.c d_tan.c d_tanh.c \
derf_.c derfc_.c dtime_.c \
ef1asc_.c ef1cmc_.c erf_.c erfc_.c etime_.c exit_.c f2ch.add \
getarg_.c getenv_.c h_abs.c h_dim.c h_dnnt.c h_indx.c h_len.c \
h_mod.c h_nint.c h_sign.c hl_ge.c hl_gt.c hl_le.c hl_lt.c \
i_abs.c i_dim.c i_dnnt.c i_indx.c i_len.c i_mod.c i_nint.c \
i_sign.c iargc_.c l_ge.c l_gt.c l_le.c l_lt.c lbitbits.c lbitshft.c \
main.c makefile pow_ci.c pow_dd.c pow_di.c pow_hh.c pow_ii.c \
pow_qq.c pow_ri.c pow_zi.c pow_zz.c qbitbits.c qbitshft.c \
r_abs.c r_acos.c r_asin.c r_atan.c r_atn2.c \
r_cnjg.c r_cos.c r_cosh.c r_dim.c r_exp.c r_imag.c r_int.c r_lg10.c \
r_log.c r_mod.c r_nint.c r_sign.c r_sin.c r_sinh.c r_sqrt.c \
r_tan.c r_tanh.c s_cat.c s_cmp.c s_copy.c \
s_paus.c s_rnge.c s_stop.c sig_die.c signal1.h0 signal_.c system_.c \
z_abs.c z_cos.c z_div.c z_exp.c z_log.c z_sin.c z_sqrt.c >zap
cmp zap libF77.xsum && rm zap || diff libF77.xsum zap
libf2c/libF77/pow_ci.c deleted 100644 → 0
#include "f2c.h"
extern void pow_zi (doublecomplex *, doublecomplex *, integer *);
void
pow_ci (complex * p, complex * a, integer * b) /* p = a**b */
{
doublecomplex p1, a1;
a1.r = a->r;
a1.i = a->i;
pow_zi (&p1, &a1, b);
p->r = p1.r;
p->i = p1.i;
}
libf2c/libF77/pow_dd.c deleted 100644 → 0
#include "f2c.h"
#undef abs
#include <math.h>
double
pow_dd (doublereal * ap, doublereal * bp)
{
return (pow (*ap, *bp));
}
libf2c/libF77/pow_di.c deleted 100644 → 0
#include "f2c.h"
double
pow_di (doublereal * ap, integer * bp)
{
double pow, x;
integer n;
unsigned long u;
pow = 1;
x = *ap;
n = *bp;
if (n != 0)
{
if (n < 0)
{
n = -n;
x = 1 / x;
}
for (u = n;;)
{
if (u & 01)
pow *= x;
if (u >>= 1)
x *= x;
else
break;
}
}
return (pow);
}
libf2c/libF77/pow_hh.c deleted 100644 → 0
#include "f2c.h"
shortint
pow_hh (shortint * ap, shortint * bp)
{
shortint pow, x, n;
unsigned u;
x = *ap;
n = *bp;
if (n <= 0)
{
if (n == 0 || x == 1)
return 1;
if (x != -1)
return x == 0 ? 1 / x : 0;
n = -n;
}
u = n;
for (pow = 1;;)
{
if (u & 01)
pow *= x;
if (u >>= 1)
x *= x;
else
break;
}
return (pow);
}
libf2c/libF77/pow_ii.c deleted 100644 → 0
#include "f2c.h"
integer
pow_ii (integer * ap, integer * bp)
{
integer pow, x, n;
unsigned long u;
x = *ap;
n = *bp;
if (n <= 0)
{
if (n == 0 || x == 1)
return 1;
if (x != -1)
return x == 0 ? 1 / x : 0;
n = -n;
}
u = n;
for (pow = 1;;)
{
if (u & 01)
pow *= x;
if (u >>= 1)
x *= x;
else
break;
}
return (pow);
}
libf2c/libF77/pow_qq.c deleted 100644 → 0
#include "f2c.h"
longint
pow_qq (longint * ap, longint * bp)
{
longint pow, x, n;
unsigned long long u; /* system-dependent */
x = *ap;
n = *bp;
if (n <= 0)
{
if (n == 0 || x == 1)
return 1;
if (x != -1)
return x == 0 ? 1 / x : 0;
n = -n;
}
u = n;
for (pow = 1;;)
{
if (u & 01)
pow *= x;
if (u >>= 1)
x *= x;
else
break;
}
return (pow);
}
libf2c/libF77/pow_ri.c deleted 100644 → 0
#include "f2c.h"
double
pow_ri (real * ap, integer * bp)
{
double pow, x;
integer n;
unsigned long u;
pow = 1;
x = *ap;
n = *bp;
if (n != 0)
{
if (n < 0)
{
n = -n;
x = 1 / x;
}
for (u = n;;)
{
if (u & 01)
pow *= x;
if (u >>= 1)
x *= x;
else
break;
}
}
return (pow);
}
libf2c/libF77/pow_zi.c deleted 100644 → 0
#include "f2c.h"
extern void z_div (doublecomplex *, doublecomplex *, doublecomplex *);
void
pow_zi (doublecomplex * p, doublecomplex * a, integer * b) /* p = a**b */
{
integer n;
unsigned long u;
double t;
doublecomplex q, x;
static doublecomplex one = { 1.0, 0.0 };
n = *b;
q.r = 1;
q.i = 0;
if (n == 0)
goto done;
if (n < 0)
{
n = -n;
z_div (&x, &one, a);
}
else
{
x.r = a->r;
x.i = a->i;
}
for (u = n;;)
{
if (u & 01)
{
t = q.r * x.r - q.i * x.i;
q.i = q.r * x.i + q.i * x.r;
q.r = t;
}
if (u >>= 1)
{
t = x.r * x.r - x.i * x.i;
x.i = 2 * x.r * x.i;
x.r = t;
}
else
break;
}
done:
p->i = q.i;
p->r = q.r;
}
libf2c/libF77/pow_zz.c deleted 100644 → 0
#include "f2c.h"
#undef abs
#include <math.h>
extern double f__cabs (double, double);
void
pow_zz (doublecomplex * r, doublecomplex * a, doublecomplex * b)
{
double logr, logi, x, y;
if (a->r == 0.0 && a->i == 0.0)
{
/* Algorithm below doesn't cope. */
r->r = r->i = 0.0;
return;
}
logr = log (f__cabs (a->r, a->i));
logi = atan2 (a->i, a->r);
x = exp (logr * b->r - logi * b->i);
y = logr * b->i + logi * b->r;
r->r = x * cos (y);
r->i = x * sin (y);
}
libf2c/libF77/qbitbits.c deleted 100644 → 0
#include "f2c.h"
#ifndef LONGBITS
#define LONGBITS 32
#endif
#ifndef LONG8BITS
#define LONG8BITS (2*LONGBITS)
#endif
integer
qbit_bits (longint a, integer b, integer len)
{
/* Assume 2's complement arithmetic */
ulongint x, y;
x = (ulongint) a;
y = (ulongint) - 1L;
x >>= b;
y <<= len;
return (longint) (x & y);
}
longint
qbit_cshift (longint a, integer b, integer len)
{
ulongint x, y, z;
x = (ulongint) a;
if (len <= 0)
{
if (len == 0)
return 0;
goto full_len;
}
if (len >= LONG8BITS)
{
full_len:
if (b >= 0)
{
b %= LONG8BITS;
return (longint) (x << b | x >> (LONG8BITS - b));
}
b = -b;
b %= LONG8BITS;
return (longint) (x << (LONG8BITS - b) | x >> b);
}
y = z = (unsigned long) -1;
y <<= len;
z &= ~y;
y &= x;
x &= z;
if (b >= 0)
{
b %= len;
return (longint) (y | (z & (x << b | x >> (len - b))));
}
b = -b;
b %= len;
return (longint) (y | (z & (x >> b | x << (len - b))));
}
libf2c/libF77/qbitshft.c deleted 100644 → 0
#include "f2c.h"
longint
qbit_shift (longint a, integer b)
{
return b >= 0 ? a << b : (longint) ((ulongint) a >> -b);
}
libf2c/libF77/r_abs.c deleted 100644 → 0
#include "f2c.h"
double
r_abs (real * x)
{
if (*x >= 0)
return (*x);
return (-*x);
}
libf2c/libF77/r_acos.c deleted 100644 → 0
#include "f2c.h"
#undef abs
#include <math.h>
double
r_acos (real * x)
{
return (acos (*x));
}
libf2c/libF77/r_asin.c deleted 100644 → 0
#include "f2c.h"
#undef abs
#include <math.h>
double
r_asin (real * x)
{
return (asin (*x));
}
libf2c/libF77/r_atan.c deleted 100644 → 0
#include "f2c.h"
#undef abs
#include <math.h>
double
r_atan (real * x)
{
return (atan (*x));
}
libf2c/libF77/r_atn2.c deleted 100644 → 0
#include "f2c.h"
#undef abs
#include <math.h>
double
r_atn2 (real * x, real * y)
{
return (atan2 (*x, *y));
}
libf2c/libF77/r_cnjg.c deleted 100644 → 0
#include "f2c.h"
void
r_cnjg (complex * r, complex * z)
{
real zi = z->i;
r->r = z->r;
r->i = -zi;
}
libf2c/libF77/r_cos.c deleted 100644 → 0
#include "f2c.h"
#undef abs
#include <math.h>
double
r_cos (real * x)
{
return (cos (*x));
}
libf2c/libF77/r_cosh.c deleted 100644 → 0
#include "f2c.h"
#undef abs
#include <math.h>
double
r_cosh (real * x)
{
return (cosh (*x));
}
libf2c/libF77/r_dim.c deleted 100644 → 0
#include "f2c.h"
double
r_dim (real * a, real * b)
{
return (*a > *b ? *a - *b : 0);
}
libf2c/libF77/r_exp.c deleted 100644 → 0
#include "f2c.h"
#undef abs
#include <math.h>
double
r_exp (real * x)
{
return (exp (*x));
}
libf2c/libF77/r_imag.c deleted 100644 → 0
#include "f2c.h"
double
r_imag (complex * z)
{
return (z->i);
}
libf2c/libF77/r_int.c deleted 100644 → 0
#include "f2c.h"
#undef abs
#include <math.h>
double
r_int (real * x)
{
return ((*x > 0) ? floor (*x) : -floor (-*x));
}
libf2c/libF77/r_lg10.c deleted 100644 → 0
#include "f2c.h"
#define log10e 0.43429448190325182765
#undef abs
#include <math.h>
double
r_lg10 (real * x)
{
return (log10e * log (*x));
}
libf2c/libF77/r_log.c deleted 100644 → 0
#include "f2c.h"
#undef abs
#include <math.h>
double
r_log (real * x)
{
return (log (*x));
}
libf2c/libF77/r_mod.c deleted 100644 → 0
#include "f2c.h"
#ifdef IEEE_drem
double drem (double, double);
#else
#undef abs
#include <math.h>
#endif
double
r_mod (real * x, real * y)
{
#ifdef IEEE_drem
double xa, ya, z;
if ((ya = *y) < 0.)
ya = -ya;
z = drem (xa = *x, ya);
if (xa > 0)
{
if (z < 0)
z += ya;
}
else if (z > 0)
z -= ya;
return z;
#else
double quotient;
if ((quotient = (double) *x / *y) >= 0)
quotient = floor (quotient);
else
quotient = -floor (-quotient);
return (*x - (*y) * quotient);
#endif
}
libf2c/libF77/r_nint.c deleted 100644 → 0
#include "f2c.h"
#undef abs
#include <math.h>
double
r_nint (real * x)
{
return ((*x) >= 0 ? floor (*x + .5) : -floor (.5 - *x));
}
libf2c/libF77/r_sign.c deleted 100644 → 0
#include "f2c.h"
double
r_sign (real * a, real * b)
{
double x;
x = (*a >= 0 ? *a : -*a);
return (*b >= 0 ? x : -x);
}
libf2c/libF77/r_sin.c deleted 100644 → 0
#include "f2c.h"
#undef abs
#include <math.h>
double
r_sin (real * x)
{
return (sin (*x));
}
libf2c/libF77/r_sinh.c deleted 100644 → 0
#include "f2c.h"
#undef abs
#include <math.h>
double
r_sinh (real * x)
{
return (sinh (*x));
}
libf2c/libF77/r_sqrt.c deleted 100644 → 0
#include "f2c.h"
#undef abs
#include <math.h>
double
r_sqrt (real * x)
{
return (sqrt (*x));
}
libf2c/libF77/r_tan.c deleted 100644 → 0
#include "f2c.h"
#undef abs
#include <math.h>
double
r_tan (real * x)
{
return (tan (*x));
}
libf2c/libF77/r_tanh.c deleted 100644 → 0
#include "f2c.h"
#undef abs
#include <math.h>
double
r_tanh (real * x)
{
return (tanh (*x));
}
libf2c/libF77/s_cat.c deleted 100644 → 0
/* Unless compiled with -DNO_OVERWRITE, this variant of s_cat allows the
* target of a concatenation to appear on its right-hand side (contrary
* to the Fortran 77 Standard, but in accordance with Fortran 90).
*/
#include "f2c.h"
#ifndef NO_OVERWRITE
#include <stdio.h>
#undef abs
#undef min
#undef max
#include <stdlib.h>
extern char *F77_aloc (ftnlen, char *);
#include <string.h>
#endif /* NO_OVERWRITE */
void
s_cat (char *lp, char *rpp[], ftnint rnp[], ftnint * np, ftnlen ll)
{
ftnlen i, nc;
char *rp;
ftnlen n = *np;
#ifndef NO_OVERWRITE
ftnlen L, m;
char *lp0, *lp1;
lp0 = 0;
lp1 = lp;
L = ll;
i = 0;
while (i < n)
{
rp = rpp[i];
m = rnp[i++];
if (rp >= lp1 || rp + m <= lp)
{
if ((L -= m) <= 0)
{
n = i;
break;
}
lp1 += m;
continue;
}
lp0 = lp;
lp = lp1 = F77_aloc (L = ll, "s_cat");
break;
}
lp1 = lp;
#endif /* NO_OVERWRITE */
for (i = 0; i < n; ++i)
{
nc = ll;
if (rnp[i] < nc)
nc = rnp[i];
ll -= nc;
rp = rpp[i];
while (--nc >= 0)
*lp++ = *rp++;
}
while (--ll >= 0)
*lp++ = ' ';
#ifndef NO_OVERWRITE
if (lp0)
{
memcpy (lp0, lp1, L);
free (lp1);
}
#endif
}
libf2c/libF77/s_cmp.c deleted 100644 → 0
#include "f2c.h"
/* compare two strings */
integer
s_cmp (char *a0, char *b0, ftnlen la, ftnlen lb)
{
register unsigned char *a, *aend, *b, *bend;
a = (unsigned char *) a0;
b = (unsigned char *) b0;
aend = a + la;
bend = b + lb;
if (la <= lb)
{
while (a < aend)
if (*a != *b)
return (*a - *b);
else
{
++a;
++b;
}
while (b < bend)
if (*b != ' ')
return (' ' - *b);
else
++b;
}
else
{
while (b < bend)
if (*a == *b)
{
++a;
++b;
}
else
return (*a - *b);
while (a < aend)
if (*a != ' ')
return (*a - ' ');
else
++a;
}
return (0);
}
libf2c/libF77/s_copy.c deleted 100644 → 0
/* Unless compiled with -DNO_OVERWRITE, this variant of s_copy allows the
* target of an assignment to appear on its right-hand side (contrary
* to the Fortran 77 Standard, but in accordance with Fortran 90),
* as in a(2:5) = a(4:7) .
*/
#include "f2c.h"
/* assign strings: a = b */
void
s_copy (register char *a, register char *b, ftnlen la, ftnlen lb)
{
register char *aend, *bend;
aend = a + la;
if (la <= lb)
#ifndef NO_OVERWRITE
if (a <= b || a >= b + la)
#endif
while (a < aend)
*a++ = *b++;
#ifndef NO_OVERWRITE
else
for (b += la; a < aend;)
*--aend = *--b;
#endif
else
{
bend = b + lb;
#ifndef NO_OVERWRITE
if (a <= b || a >= bend)
#endif
while (b < bend)
*a++ = *b++;
#ifndef NO_OVERWRITE
else
{
a += lb;
while (b < bend)
*--a = *--bend;
a += lb;
}
#endif
while (a < aend)
*a++ = ' ';
}
}
libf2c/libF77/s_paus.c deleted 100644 → 0
#include <stdio.h>
#include "f2c.h"
#define PAUSESIG 15
#include "signal1.h"
#undef abs
#undef min
#undef max
#include <stdlib.h>
extern int getpid (void), isatty (int), pause (void);
extern void f_exit (void);
static void
waitpause (Sigarg)
{
Use_Sigarg;
return;
}
static void
s_1paus (FILE * fin)
{
fprintf (stderr,
"To resume execution, type go. Other input will terminate the job.\n");
fflush (stderr);
if (getc (fin) != 'g' || getc (fin) != 'o' || getc (fin) != '\n')
{
fprintf (stderr, "STOP\n");
#ifdef NO_ONEXIT
f_exit ();
#endif
exit (0);
}
}
int
s_paus (char *s, ftnlen n)
{
fprintf (stderr, "PAUSE ");
if (n > 0)
fprintf (stderr, " %.*s", (int) n, s);
fprintf (stderr, " statement executed\n");
if (isatty (fileno (stdin)))
s_1paus (stdin);
else
{
#if (defined (MSDOS) && !defined (GO32)) || defined (_WIN32)
FILE *fin;
fin = fopen ("con", "r");
if (!fin)
{
fprintf (stderr, "s_paus: can't open con!\n");
fflush (stderr);
exit (1);
}
s_1paus (fin);
fclose (fin);
#else
fprintf (stderr,
"To resume execution, execute a kill -%d %d command\n",
PAUSESIG, getpid ());
signal1 (PAUSESIG, waitpause);
fflush (stderr);
pause ();
#endif
}
fprintf (stderr, "Execution resumes after PAUSE.\n");
fflush (stderr);
return 0; /* NOT REACHED */
}
libf2c/libF77/s_rnge.c deleted 100644 → 0
#include <stdio.h>
#include "f2c.h"
/* called when a subscript is out of range */
extern void sig_die (char *, int);
integer
s_rnge (char *varn, ftnint offset, char *procn, ftnint line)
{
register int i;
fprintf (stderr, "Subscript out of range on file line %ld, procedure ",
(long) line);
while ((i = *procn) && i != '_' && i != ' ')
putc (*procn++, stderr);
fprintf (stderr, ".\nAttempt to access the %ld-th element of variable ",
(long) offset + 1);
while ((i = *varn) && i != ' ')
putc (*varn++, stderr);
sig_die (".", 1);
return 0; /* not reached */
}
libf2c/libF77/s_stop.c deleted 100644 → 0
#include <stdio.h>
#include "f2c.h"
#undef abs
#undef min
#undef max
#include <stdlib.h>
void f_exit (void);
int
s_stop (char *s, ftnlen n)
{
int i;
if (n > 0)
{
fprintf (stderr, "STOP ");
for (i = 0; i < n; ++i)
putc (*s++, stderr);
fprintf (stderr, " statement executed\n");
}
#ifdef NO_ONEXIT
f_exit ();
#endif
exit (0);
/* We cannot avoid (useless) compiler diagnostics here: */
/* some compilers complain if there is no return statement, */
/* and others complain that this one cannot be reached. */
return 0; /* NOT REACHED */
}
libf2c/libF77/setarg.c deleted 100644 → 0
/* Set up the global argc/argv info for use by getarg_, iargc_, and
g77's inlined intrinsic equivalents. */
#include <stdlib.h>
int f__xargc;
char **f__xargv;
void
f_setarg (int argc, char **argv)
{
f__xargc = argc;
f__xargv = argv;
}
libf2c/libF77/setsig.c deleted 100644 → 0
/* Set up the signal behavior. */
#include <stdio.h>
#include "signal1.h"
#ifndef SIGIOT
#ifdef SIGABRT
#define SIGIOT SIGABRT
#endif
#endif
#include <stdlib.h>
extern void sig_die (char *, int);
static void
sigfdie (Sigarg)
{
Use_Sigarg;
sig_die ("Floating Exception", 1);
}
static void
sigidie (Sigarg)
{
Use_Sigarg;
sig_die ("IOT Trap", 1);
}
#ifdef SIGQUIT
static void
sigqdie (Sigarg)
{
Use_Sigarg;
sig_die ("Quit signal", 1);
}
#endif
static void
sigindie (Sigarg)
{
Use_Sigarg;
sig_die ("Interrupt", 0);
}
static void
sigtdie (Sigarg)
{
Use_Sigarg;
sig_die ("Killed", 0);
}
#ifdef SIGTRAP
static void
sigtrdie (Sigarg)
{
Use_Sigarg;
sig_die ("Trace trap", 1);
}
#endif
void
f_setsig ()
{
signal1 (SIGFPE, sigfdie); /* ignore underflow, enable overflow */
#ifdef SIGIOT
signal1 (SIGIOT, sigidie);
#endif
#ifdef SIGTRAP
signal1 (SIGTRAP, sigtrdie);
#endif
#ifdef SIGQUIT
if (signal1 (SIGQUIT, sigqdie) == SIG_IGN)
signal1 (SIGQUIT, SIG_IGN);
#endif
if (signal1 (SIGINT, sigindie) == SIG_IGN)
signal1 (SIGINT, SIG_IGN);
signal1 (SIGTERM, sigtdie);
#ifdef pdp11
ldfps (01200); /* detect overflow as an exception */
#endif
}
libf2c/libF77/sig_die.c deleted 100644 → 0
#include <stdio.h>
#include <signal.h>
#ifndef SIGIOT
#ifdef SIGABRT
#define SIGIOT SIGABRT
#endif
#endif
#include <stdlib.h>
extern void f_exit (void);
void
sig_die (register char *s, int kill)
{
/* print error message, then clear buffers */
fprintf (stderr, "%s\n", s);
if (kill)
{
fflush (stderr);
f_exit ();
fflush (stderr);
/* now get a core */
#ifdef SIGIOT
signal (SIGIOT, SIG_DFL);
#endif
abort ();
}
else
{
#ifdef NO_ONEXIT
f_exit ();
#endif
exit (1);
}
}
libf2c/libF77/signal1.h deleted 100644 → 0
/* The g77 implementation of libf2c directly includes signal1.h0,
instead of copying it to signal1.h, since that seems easier to
cope with at this point. */
#include "signal1.h0"
libf2c/libF77/signal1.h0 deleted 100644 → 0
/* You may need to adjust the definition of signal1 to supply a */
/* cast to the correct argument type. This detail is system- and */
/* compiler-dependent. The #define below assumes signal.h declares */
/* type SIG_PF for the signal function's second argument. */
/* For some C++ compilers, "#define Sigarg_t ..." may be appropriate. */
#include <signal.h>
#ifndef Sigret_t
#define Sigret_t void
#endif
#ifndef Sigarg_t
#define Sigarg_t int
#endif /*Sigarg_t */
#ifdef USE_SIG_PF /* compile with -DUSE_SIG_PF under IRIX */
#define sig_pf SIG_PF
#else
typedef Sigret_t (*sig_pf) (Sigarg_t);
#endif
#define signal1(a,b) signal(a,(sig_pf)b)
#define Sigarg int n
#define Use_Sigarg n = n /* shut up compiler warning */
libf2c/libF77/signal_.c deleted 100644 → 0
#include "f2c.h"
#include "signal1.h"
void *
G77_signal_0 (integer * sigp, sig_pf proc)
{
int sig;
sig = (int) *sigp;
return (void *) signal (sig, proc);
}
libf2c/libF77/system_.c deleted 100644 → 0
/* f77 interface to system routine */
#include "f2c.h"
#undef abs
#undef min
#undef max
#include <stdlib.h>
extern char *F77_aloc (ftnlen, char *);
integer
G77_system_0 (register char *s, ftnlen n)
{
char buff0[256], *buff;
register char *bp, *blast;
integer rv;
buff = bp = n < (ftnlen) sizeof (buff0) ? buff0 : F77_aloc (n + 1, "system_");
blast = bp + n;
while (bp < blast && *s)
*bp++ = *s++;
*bp = 0;
rv = system (buff);
if (buff != buff0)
free (buff);
return rv;
}
libf2c/libF77/z_abs.c deleted 100644 → 0
#include "f2c.h"
double f__cabs (double, double);
double
z_abs (doublecomplex * z)
{
return (f__cabs (z->r, z->i));
}
libf2c/libF77/z_cos.c deleted 100644 → 0
#include "f2c.h"
#undef abs
#include "math.h"
void
z_cos (doublecomplex * r, doublecomplex * z)
{
double zi = z->i, zr = z->r;
r->r = cos (zr) * cosh (zi);
r->i = -sin (zr) * sinh (zi);
}
libf2c/libF77/z_div.c deleted 100644 → 0
#include "f2c.h"
extern void sig_die (char *, int);
void
z_div (doublecomplex * c, doublecomplex * a, doublecomplex * b)
{
double ratio, den;
double abr, abi, cr;
if ((abr = b->r) < 0.)
abr = -abr;
if ((abi = b->i) < 0.)
abi = -abi;
if (abr <= abi)
{
if (abi == 0)
{
#ifdef IEEE_COMPLEX_DIVIDE
if (a->i != 0 || a->r != 0)
abi = 1.;
c->i = c->r = abi / abr;
return;
#else
sig_die ("complex division by zero", 1);
#endif
}
ratio = b->r / b->i;
den = b->i * (1 + ratio * ratio);
cr = (a->r * ratio + a->i) / den;
c->i = (a->i * ratio - a->r) / den;
}
else
{
ratio = b->i / b->r;
den = b->r * (1 + ratio * ratio);
cr = (a->r + a->i * ratio) / den;
c->i = (a->i - a->r * ratio) / den;
}
c->r = cr;
}
libf2c/libF77/z_exp.c deleted 100644 → 0
#include "f2c.h"
#undef abs
#include "math.h"
void
z_exp (doublecomplex * r, doublecomplex * z)
{
double expx, zi = z->i;
expx = exp (z->r);
r->r = expx * cos (zi);
r->i = expx * sin (zi);
}
libf2c/libF77/z_log.c deleted 100644 → 0
#include "f2c.h"
#undef abs
#include "math.h"
extern double f__cabs (double, double);
void
z_log (doublecomplex * r, doublecomplex * z)
{
double s, s0, t, t2, u, v;
double zi = z->i, zr = z->r;
r->i = atan2 (zi, zr);
#ifdef Pre20000310
r->r = log (f__cabs (zr, zi));
#else
if (zi < 0)
zi = -zi;
if (zr < 0)
zr = -zr;
if (zr < zi)
{
t = zi;
zi = zr;
zr = t;
}
t = zi / zr;
s = zr * sqrt (1 + t * t);
/* now s = f__cabs(zi,zr), and zr = |zr| >= |zi| = zi */
if ((t = s - 1) < 0)
t = -t;
if (t > .01)
r->r = log (s);
else
{
#ifdef Comment
log (1 + x) = x - x ^ 2 / 2 + x ^ 3 / 3 - x ^ 4 / 4 + -...
= x (1 - x / 2 + x ^ 2 / 3 - +...)
[sqrt (y ^ 2 + z ^ 2) - 1] *[sqrt (y ^ 2 + z ^ 2) + 1] =
y ^ 2 + z ^ 2 - 1, so sqrt (y ^ 2 + z ^ 2) - 1 =
(y ^ 2 + z ^ 2 - 1) /[sqrt (y ^ 2 + z ^ 2) + 1]
#endif /*Comment */
t = ((zr * zr - 1.) + zi * zi) / (s + 1);
t2 = t * t;
s = 1. - 0.5 * t;
u = v = 1;
do
{
s0 = s;
u *= t2;
v += 2;
s += u / v - t * u / (v + 1);
}
while (s > s0);
r->r = s * t;
}
#endif
}
libf2c/libF77/z_sin.c deleted 100644 → 0
#include "f2c.h"
#undef abs
#include "math.h"
void
z_sin (doublecomplex * r, doublecomplex * z)
{
double zi = z->i, zr = z->r;
r->r = sin (zr) * cosh (zi);
r->i = cos (zr) * sinh (zi);
}
libf2c/libF77/z_sqrt.c deleted 100644 → 0
#include "f2c.h"
#undef abs
#include "math.h"
extern double f__cabs (double, double);
void
z_sqrt (doublecomplex * r, doublecomplex * z)
{
double mag, zi = z->i, zr = z->r;
if ((mag = f__cabs (zr, zi)) == 0.)
r->r = r->i = 0.;
else if (zr > 0)
{
r->r = sqrt (0.5 * (mag + zr));
r->i = zi / r->r / 2;
}
else
{
r->i = sqrt (0.5 * (mag - zr));
if (zi < 0)
r->i = -r->i;
r->r = zi / r->i / 2;
}
}
libf2c/libI77/Makefile.in deleted 100644 → 0
# Makefile for GNU F77 compiler runtime.
# Copyright 1990 - 1994 by AT&T Bell Laboratories and Bellcore (see the
# file `Notice').
# Portions of this file Copyright (C) 1995, 1996, 1998, 2001 Free Software Foundation, Inc.
# Contributed by Dave Love (d.love@dl.ac.uk).
#
#This file is part of GNU Fortran.
#
#GNU Fortran 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.
#
#GNU Fortran 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 GNU Fortran; see the file COPYING. If not, write to
#the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
#02111-1307, USA.
#### Start of system configuration section. ####
# $(srcdir) must be set to the g77 runtime libI77 source directory.
srcdir = @srcdir@
VPATH = @srcdir@
# configure sets this to all the -D options appropriate for the
# configuration.
DEFS = @DEFS@
F2C_H_DIR = @srcdir@/..
G2C_H_DIR = ..
CC = @CC@
CFLAGS = @CFLAGS@
CPPFLAGS = @CPPFLAGS@
@SET_MAKE@
SHELL = @SHELL@
#### End of system configuration section. ####
ALL_CFLAGS = -I. -I$(srcdir) -I$(G2C_H_DIR) -I$(F2C_H_DIR) $(CPPFLAGS) \
$(DEFS) $(WARN_CFLAGS) $(CFLAGS)
.SUFFIXES:
.SUFFIXES: .c .lo
.c.lo:
@LIBTOOL@ --mode=compile $(CC) -c -DSkip_f2c_Undefs -DAllow_TYQUAD $(ALL_CFLAGS) $<
OBJS = VersionI.lo backspace.lo close.lo dfe.lo dolio.lo due.lo endfile.lo err.lo \
fmt.lo fmtlib.lo iio.lo ilnw.lo inquire.lo lread.lo lwrite.lo open.lo \
rdfmt.lo rewind.lo rsfe.lo rsli.lo rsne.lo sfe.lo sue.lo typesize.lo uio.lo \
util.lo wref.lo wrtfmt.lo wsfe.lo wsle.lo wsne.lo xwsne.lo \
ftell_.lo
all: ../s-libi77
../s-libi77: $(OBJS)
-rm -f $@.T $@
objs='$(OBJS)'; for name in $$objs; do \
echo libI77/$${name} >> $@.T; done
mv $@.T $@
Makefile: Makefile.in config.status
$(SHELL) config.status
config.status: configure
rm -f config.cache
CONFIG_SITE=no-such-file CC='$(CC)' CFLAGS='$(CFLAGS)' \
CPPFLAGS='$(CPPFLAGS)' $(SHELL) config.status --recheck
${srcdir}/configure: configure.in
rm -f config.cache
cd ${srcdir} && autoconf
# autoheader might not change config.h.in, so touch a stamp file.
${srcdir}/config.h.in: stamp-h.in; @true
${srcdir}/stamp-h.in: configure.in
(cd ${srcdir} && autoheader)
@rm -f ${srcdir}/stamp-h.in
echo timestamp > ${srcdir}/stamp-h.in
config.h: stamp-h; @true
stamp-h: config.h.in config.status
CONFIG_FILES= CONFIG_HEADERS=config.h $(SHELL) config.status
echo timestamp > stamp-h
VersionI.lo: Version.c
@LIBTOOL@ --mode=compile $(CC) -c $(ALL_CFLAGS) $(srcdir)/Version.c -o $@
backspace.lo: backspace.c fio.h config.h
close.lo: close.c fio.h config.h
dfe.lo: fio.h config.h
dfe.lo: dfe.c fmt.h
dolio.lo: dolio.c config.h
due.lo: due.c fio.h config.h
endfile.lo: endfile.c fio.h config.h
err.lo: err.c fio.h config.h
fmt.lo: fio.h config.h
fmt.lo: fmt.c fmt.h
fmtlib.lo: fmtlib.c config.h
ftell_.lo: ftell_.c fio.h config.h
iio.lo: fio.h
iio.lo: iio.c fmt.h
ilnw.lo: fio.h config.h
ilnw.lo: ilnw.c lio.h
inquire.lo: inquire.c fio.h config.h
lread.lo: fio.h config.h
lread.lo: fmt.h
lread.lo: lio.h
lread.lo: lread.c fp.h
lwrite.lo: fio.h
lwrite.lo: fmt.h
lwrite.lo: lwrite.c lio.h
open.lo: open.c fio.h config.h
rdfmt.lo: fio.h config.h
rdfmt.lo: fmt.h
rdfmt.lo: rdfmt.c fp.h
rewind.lo: rewind.c fio.h config.h
rsfe.lo: fio.h config.h
rsfe.lo: rsfe.c fmt.h
rsli.lo: fio.h
rsli.lo: rsli.c lio.h
rsne.lo: fio.h config.h
rsne.lo: rsne.c lio.h
sfe.lo: sfe.c fio.h config.h
sue.lo: sue.c fio.h config.h
typesize.lo: typesize.c config.h
uio.lo: uio.c fio.h
util.lo: util.c fio.h config.h
wref.lo: fio.h
wref.lo: fmt.h
wref.lo: wref.c fp.h
wrtfmt.lo: fio.h config.h
wrtfmt.lo: wrtfmt.c fmt.h
wsfe.lo: fio.h config.h
wsfe.lo: wsfe.c fmt.h
wsle.lo: fio.h config.h
wsle.lo: fmt.h
wsle.lo: wsle.c lio.h
wsne.lo: fio.h
wsne.lo: wsne.c lio.h
xwsne.lo: fio.h config.h
xwsne.lo: lio.h
xwsne.lo: xwsne.c fmt.h
# May be pessimistic:
$(OBJS): $(F2C_H_DIR)/f2c.h $(G2C_H_DIR)/g2c.h
check install uninstall install-strip dist installcheck installdirs:
mostlyclean:
rm -f *.o *.lo
rm -rf .libs
clean: mostlyclean
rm -f config.log ../s-libi77
distclean: clean
rm -f config.cache config.status Makefile ../s-libi77 configure
maintainer-clean:
.PHONY: mostlyclean clean distclean maintainer-clean all check uninstall \
install-strip dist installcheck installdirs archive
libf2c/libI77/Notice deleted 100644 → 0
/****************************************************************
Copyright 1990 - 1997 by AT&T, Lucent Technologies and Bellcore.
Permission to use, copy, modify, and distribute this software
and its documentation for any purpose and without fee is hereby
granted, provided that the above copyright notice appear in all
copies and that both that the copyright notice and this
permission notice and warranty disclaimer appear in supporting
documentation, and that the names of AT&T, Bell Laboratories,
Lucent or Bellcore or any of their entities not be used in
advertising or publicity pertaining to distribution of the
software without specific, written prior permission.
AT&T, Lucent and Bellcore disclaim all warranties with regard to
this software, including all implied warranties of
merchantability and fitness. In no event shall AT&T, Lucent or
Bellcore be liable for any special, indirect or consequential
damages or any damages whatsoever resulting from loss of use,
data or profits, whether in an action of contract, negligence or
other tortious action, arising out of or in connection with the
use or performance of this software.
****************************************************************/
libf2c/libI77/README.netlib deleted 100644 → 0
If your compiler does not recognize ANSI C headers,
compile with KR_headers defined: either add -DKR_headers
to the definition of CFLAGS in the makefile, or insert
#define KR_headers
at the top of f2c.h and fmtlib.c .
If you have a really ancient K&R C compiler that does not understand
void, add -Dvoid=int to the definition of CFLAGS in the makefile.
If you use a C++ compiler, first create a local f2c.h by appending
f2ch.add to the usual f2c.h, e.g., by issuing the command
make f2c.h
which assumes f2c.h is installed in /usr/include .
If your system lacks /usr/include/fcntl.h , then you
should simply create an empty fcntl.h in this directory.
If your compiler then complains about creat and open not
having a prototype, compile with OPEN_DECL defined.
On many systems, open and creat are declared in fcntl.h .
If your system has /usr/include/fcntl.h, you may need to add
-D_POSIX_SOURCE to the makefile's definition of CFLAGS.
If your system's sprintf does not work the way ANSI C
specifies -- specifically, if it does not return the
number of characters transmitted -- then insert the line
#define USE_STRLEN
at the end of fmt.h . This is necessary with
at least some versions of Sun and DEC software.
In particular, if you get a warning about an improper
pointer/integer combination in compiling wref.c, then
you need to compile with -DUSE_STRLEN .
If your system's fopen does not like the ANSI binary
reading and writing modes "rb" and "wb", then you should
compile open.c with NON_ANSI_RW_MODES #defined.
If you get error messages about references to cf->_ptr
and cf->_base when compiling wrtfmt.c and wsfe.c or to
stderr->_flag when compiling err.c, then insert the line
#define NON_UNIX_STDIO
at the beginning of fio.h, and recompile everything (or
at least those modules that contain NON_UNIX_STDIO).
Unformatted sequential records consist of a length of record
contents, the record contents themselves, and the length of
record contents again (for backspace). Prior to 17 Oct. 1991,
the length was of type int; now it is of type long, but you
can change it back to int by inserting
#define UIOLEN_int
at the beginning of fio.h. This affects only sue.c and uio.c .
On VAX, Cray, or Research Tenth-Edition Unix systems, you may
need to add -DVAX, -DCRAY, or -DV10 (respectively) to CFLAGS
to make fp.h work correctly. Alternatively, you may need to
edit fp.h to suit your machine.
You may need to supply the following non-ANSI routines:
fstat(int fileds, struct stat *buf) is similar
to stat(char *name, struct stat *buf), except that
the first argument, fileds, is the file descriptor
returned by open rather than the name of the file.
fstat is used in the system-dependent routine
canseek (in the libI77 source file err.c), which
is supposed to return 1 if it's possible to issue
seeks on the file in question, 0 if it's not; you may
need to suitably modify err.c . On non-UNIX systems,
you can avoid references to fstat and stat by compiling
with NON_UNIX_STDIO defined; in that case, you may need
to supply access(char *Name,0), which is supposed to
return 0 if file Name exists, nonzero otherwise.
char * mktemp(char *buf) is supposed to replace the
6 trailing X's in buf with a unique number and then
return buf. The idea is to get a unique name for
a temporary file.
On non-UNIX systems, you may need to change a few other,
e.g.: the form of name computed by mktemp() in endfile.c and
open.c; the use of the open(), close(), and creat() system
calls in endfile.c, err.c, open.c; and the modes in calls on
fopen() and fdopen() (and perhaps the use of fdopen() itself
-- it's supposed to return a FILE* corresponding to a given
an integer file descriptor) in err.c and open.c (component ufmt
of struct unit is 1 for formatted I/O -- text mode on some systems
-- and 0 for unformatted I/O -- binary mode on some systems).
Compiling with -DNON_UNIX_STDIO omits all references to creat()
and almost all references to open() and close(), the exception
being in the function f__isdev() (in open.c).
For MS-DOS, compile all of libI77 with -DMSDOS (which implies
-DNON_UNIX_STDIO). You may need to make other compiler-dependent
adjustments; for example, for Turbo C++ you need to adjust the mktemp
invocations and to #undef ungetc in lread.c and rsne.c .
If you want to be able to load against libI77 but not libF77,
then you will need to add sig_die.o (from libF77) to libI77.
If you wish to use translated Fortran that has funny notions
of record length for direct unformatted I/O (i.e., that assumes
RECL= values in OPEN statements are not bytes but rather counts
of some other units -- e.g., 4-character words for VMS), then you
should insert an appropriate #define for url_Adjust at the
beginning of open.c . For VMS Fortran, for example,
#define url_Adjust(x) x *= 4
would suffice.
To check for transmission errors, issue the command
make check
This assumes you have the xsum program whose source, xsum.c,
is distributed as part of "all from f2c/src". If you do not
have xsum, you can obtain xsum.c by sending the following E-mail
message to netlib@netlib.bell-labs.com
send xsum.c from f2c/src
The makefile assumes you have installed f2c.h in a standard
place (and does not cause recompilation when f2c.h is changed);
f2c.h comes with "all from f2c" (the source for f2c) and is
available separately ("f2c.h from f2c").
By default, Fortran I/O units 5, 6, and 0 are pre-connected to
stdin, stdout, and stderr, respectively. You can change this
behavior by changing f_init() in err.c to suit your needs.
Note that f2c assumes READ(*... means READ(5... and WRITE(*...
means WRITE(6... . Moreover, an OPEN(n,... statement that does
not specify a file name (and does not specify STATUS='SCRATCH')
assumes FILE='fort.n' . You can change this by editing open.c
and endfile.c suitably.
Unless you adjust the "#define MXUNIT" line in fio.h, Fortran units
0, 1, ..., 99 are available, i.e., the highest allowed unit number
is MXUNIT - 1.
Lines protected from compilation by #ifdef Allow_TYQUAD
are for a possible extension to 64-bit integers in which
integer = int = 32 bits and longint = long = 64 bits.
Extensions (Feb. 1993) to NAMELIST processing:
1. Reading a ? instead of &name (the start of a namelist) causes
the namelist being sought to be written to stdout (unit 6);
to omit this feature, compile rsne.c with -DNo_Namelist_Questions.
2. Reading the wrong namelist name now leads to an error message
and an attempt to skip input until the right namelist name is found;
to omit this feature, compile rsne.c with -DNo_Bad_Namelist_Skip.
3. Namelist writes now insert newlines before each variable; to omit
this feature, compile xwsne.c with -DNo_Extra_Namelist_Newlines.
4. (Sept. 1995) When looking for the &name that starts namelist
input, lines whose first non-blank character is something other
than &, $, or ? are treated as comment lines and ignored, unless
rsne.c is compiled with -DNo_Namelist_Comments.
Nonstandard extension (Feb. 1993) to open: for sequential files,
ACCESS='APPEND' (or access='anything else starting with "A" or "a"')
causes the file to be positioned at end-of-file, so a write will
append to the file.
Some buggy Fortran programs use unformatted direct I/O to write
an incomplete record and later read more from that record than
they have written. For records other than the last, the unwritten
portion of the record reads as binary zeros. The last record is
a special case: attempting to read more from it than was written
gives end-of-file -- which may help one find a bug. Some other
Fortran I/O libraries treat the last record no differently than
others and thus give no help in finding the bug of reading more
than was written. If you wish to have this behavior, compile
uio.c with -DPad_UDread .
If you want to be able to catch write failures (e.g., due to a
disk being full) with an ERR= specifier, compile dfe.c, due.c,
sfe.c, sue.c, and wsle.c with -DALWAYS_FLUSH. This will lead to
slower execution and more I/O, but should make ERR= work as
expected, provided fflush returns an error return when its
physical write fails.
Carriage controls are meant to be interpreted by the UNIX col
program (or a similar program). Sometimes it's convenient to use
only ' ' as the carriage control character (normal single spacing).
If you compile lwrite.c and wsfe.c with -DOMIT_BLANK_CC, formatted
external output lines will have an initial ' ' quietly omitted,
making use of the col program unnecessary with output that only
has ' ' for carriage control.
The Fortran 77 Standard leaves it up to the implementation whether
formatted writes of floating-point numbers of absolute value < 1 have
a zero before the decimal point. By default, libI77 omits such
superfluous zeros, but you can cause them to appear by compiling
lwrite.c, wref.c, and wrtfmt.c with -DWANT_LEAD_0 .
If your system lacks a ranlib command, you don't need it.
Either comment out the makefile's ranlib invocation, or install
a harmless "ranlib" command somewhere in your PATH, such as the
one-line shell script
exit 0
or (on some systems)
exec /usr/bin/ar lts $1 >/dev/null
Most of the routines in libI77 are support routines for Fortran
I/O. There are a few exceptions, summarized below -- I/O related
functions and subroutines that appear to your program as ordinary
external Fortran routines.
1. CALL FLUSH flushes all buffers.
2. FTELL(i) is an INTEGER function that returns the current
offset of Fortran unit i (or -1 if unit i is not open).
3. CALL FSEEK(i, offset, whence, *errlab) attemps to move
Fortran unit i to the specified offset: absolute offset
if whence = 0; relative to the current offset if whence = 1;
relative to the end of the file if whence = 2. It branches
to label errlab if unit i is not open or if the call
otherwise fails.
libf2c/libI77/Version.c deleted 100644 → 0
const char __LIBI77_VERSION__[] = "@(#) LIBI77 VERSION pjw,dmg-mods 20001205\n";
/*
2.01 $ format added
2.02 Coding bug in open.c repaired
2.03 fixed bugs in lread.c (read * with negative f-format) and lio.c
and lio.h (e-format conforming to spec)
2.04 changed open.c and err.c (fopen and freopen respectively) to
update to new c-library (append mode)
2.05 added namelist capability
2.06 allow internal list and namelist I/O
*/
/*
close.c:
allow upper-case STATUS= values
endfile.c
create fort.nnn if unit nnn not open;
else if (file length == 0) use creat() rather than copy;
use local copy() rather than forking /bin/cp;
rewind, fseek to clear buffer (for no reading past EOF)
err.c
use neither setbuf nor setvbuf; make stderr buffered
fio.h
#define _bufend
inquire.c
upper case responses;
omit byfile test from SEQUENTIAL=
answer "YES" to DIRECT= for unopened file (open to debate)
lio.c
flush stderr, stdout at end of each stmt
space before character strings in list output only at line start
lio.h
adjust LEW, LED consistent with old libI77
lread.c
use atof()
allow "nnn*," when reading complex constants
open.c
try opening for writing when open for read fails, with
special uwrt value (2) delaying creat() to first write;
set curunit so error messages don't drop core;
no file name ==> fort.nnn except for STATUS='SCRATCH'
rdfmt.c
use atof(); trust EOF == end-of-file (so don't read past
end-of-file after endfile stmt)
sfe.c
flush stderr, stdout at end of each stmt
wrtfmt.c:
use upper case
put wrt_E and wrt_F into wref.c, use sprintf()
rather than ecvt() and fcvt() [more accurate on VAX]
*/
/* 16 Oct. 1988: uwrt = 3 after write, rewind, so close won't zap the file. */
/* 10 July 1989: change _bufend to buf_end in fio.h, wsfe.c, wrtfmt.c */
/* 28 Nov. 1989: corrections for IEEE and Cray arithmetic */
/* 29 Nov. 1989: change various int return types to long for f2c */
/* 30 Nov. 1989: various types from f2c.h */
/* 6 Dec. 1989: types corrected various places */
/* 19 Dec. 1989: make iostat= work right for internal I/O */
/* 8 Jan. 1990: add rsne, wsne -- routines for handling NAMELIST */
/* 28 Jan. 1990: have NAMELIST read treat $ as &, general white
space as blank */
/* 27 Mar. 1990: change an = to == in rd_L(rdfmt.c) so formatted reads
of logical values reject letters other than fFtT;
have nowwriting reset cf */
/* 14 Aug. 1990: adjust lread.c to treat tabs as spaces in list input */
/* 17 Aug. 1990: adjust open.c to recognize blank='Z...' as well as
blank='z...' when reopening an open file */
/* 30 Aug. 1990: prevent embedded blanks in list output of complex values;
omit exponent field in list output of values of
magnitude between 10 and 1e8; prevent writing stdin
and reading stdout or stderr; don't close stdin, stdout,
or stderr when reopening units 5, 6, 0. */
/* 18 Sep. 1990: add component udev to unit and consider old == new file
iff uinode and udev values agree; use stat rather than
access to check existence of file (when STATUS='OLD')*/
/* 2 Oct. 1990: adjust rewind.c so two successive rewinds after a write
don't clobber the file. */
/* 9 Oct. 1990: add #include "fcntl.h" to endfile.c, err.c, open.c;
adjust g_char in util.c for segmented memories. */
/* 17 Oct. 1990: replace abort() and _cleanup() with calls on
sig_die(...,1) (defined in main.c). */
/* 5 Nov. 1990: changes to open.c: complain if new= is specified and the
file already exists; allow file= to be omitted in open stmts
and allow status='replace' (Fortran 90 extensions). */
/* 11 Dec. 1990: adjustments for POSIX. */
/* 15 Jan. 1991: tweak i_ungetc in rsli.c to allow reading from
strings in read-only memory. */
/* 25 Apr. 1991: adjust namelist stuff to work with f2c -i2 */
/* 26 Apr. 1991: fix some bugs with NAMELIST read of multi-dim. arrays */
/* 16 May 1991: increase LEFBL in lio.h to bypass NeXT bug */
/* 17 Oct. 1991: change type of length field in sequential unformatted
records from int to long (for systems where sizeof(int)
can vary, depending on the compiler or compiler options). */
/* 14 Nov. 1991: change uint to Uint in fmt.h, rdfmt.c, wrtfmt.c. */
/* 25 Nov. 1991: change uint to Uint in lwrite.c; change sizeof(int) to
sizeof(uioint) in fseeks in sue.c (missed on 17 Oct.). */
/* 1 Dec. 1991: uio.c: add test for read failure (seq. unformatted reads);
adjust an error return from EOF to off end of record */
/* 12 Dec. 1991: rsli.c: fix bug with internal list input that caused
the last character of each record to be ignored.
iio.c: adjust error message in internal formatted
input from "end-of-file" to "off end of record" if
the format specifies more characters than the
record contains. */
/* 17 Jan. 1992: lread.c, rsne.c: in list and namelist input,
treat "r* ," and "r*," alike (where r is a
positive integer constant), and fix a bug in
handling null values following items with repeat
counts (e.g., 2*1,,3); for namelist reading
of a numeric array, allow a new name-value subsequence
to terminate the current one (as though the current
one ended with the right number of null values).
lio.h, lwrite.c: omit insignificant zeros in
list and namelist output. To get the old
behavior, compile with -DOld_list_output . */
/* 18 Jan. 1992: make list output consistent with F format by
printing .1 rather than 0.1 (introduced yesterday). */
/* 3 Feb. 1992: rsne.c: fix namelist read bug that caused the
character following a comma to be ignored. */
/* 19 May 1992: adjust iio.c, ilnw.c, rdfmt.c and rsli.c to make err=
work with internal list and formatted I/O. */
/* 18 July 1992: adjust rsne.c to allow namelist input to stop at
an & (e.g. &end). */
/* 23 July 1992: switch to ANSI prototypes unless KR_headers is #defined ;
recognize Z format (assuming 8-bit bytes). */
/* 14 Aug. 1992: tweak wrt_E in wref.c to avoid -NaN */
/* 23 Oct. 1992: Supply missing l_eof = 0 assignment to s_rsne() in rsne.c
(so end-of-file on other files won't confuse namelist
reads of external files). Prepend f__ to external
names that are only of internal interest to lib[FI]77. */
/* 1 Feb. 1993: backspace.c: fix bug that bit when last char of 2nd
buffer == '\n'.
endfile.c: guard against tiny L_tmpnam; close and reopen
files in t_runc().
lio.h: lengthen LINTW (buffer size in lwrite.c).
err.c, open.c: more prepending of f__ (to [rw]_mode). */
/* 5 Feb. 1993: tweaks to NAMELIST: rsne.c: ? prints the namelist being
sought; namelists of the wrong name are skipped (after
an error message; xwsne.c: namelist writes have a
newline before each new variable.
open.c: ACCESS='APPEND' positions sequential files
at EOF (nonstandard extension -- that doesn't require
changing data structures). */
/* 9 Feb. 1993: Change some #ifdef MSDOS lines to #ifdef NON_UNIX_STDIO.
err.c: under NON_UNIX_STDIO, avoid close(creat(name,0666))
when the unit has another file descriptor for name. */
/* 4 March 1993: err.c, open.c: take declaration of fdopen from rawio.h;
open.c: always give f__w_mode[] 4 elements for use
in t_runc (in endfile.c -- for change of 1 Feb. 1993). */
/* 6 March 1993: uio.c: adjust off-end-of-record test for sequential
unformatted reads to respond to err= rather than end=. */
/* 12 March 1993: various tweaks for C++ */
/* 6 April 1993: adjust error returns for formatted inputs to flush
the current input line when err=label is specified.
To restore the old behavior (input left mid-line),
either adjust the #definition of errfl in fio.h or
omit the invocation of f__doend in err__fl (in err.c). */
/* 23 June 1993: iio.c: fix bug in format reversions for internal writes. */
/* 5 Aug. 1993: lread.c: fix bug in handling repetition counts for
logical data (during list or namelist input).
Change struct f__syl to struct syl (for buggy compilers). */
/* 7 Aug. 1993: lread.c: fix bug in namelist reading of incomplete
logical arrays. */
/* 9 Aug. 1993: lread.c: fix bug in namelist reading of an incomplete
array of numeric data followed by another namelist
item whose name starts with 'd', 'D', 'e', or 'E'. */
/* 8 Sept. 1993: open.c: protect #include "sys/..." with
#ifndef NON_UNIX_STDIO; Version date not changed. */
/* 10 Nov. 1993: backspace.c: add nonsense for #ifdef MSDOS */
/* 8 Dec. 1993: iio.c: adjust internal formatted reads to treat
short records as though padded with blanks
(rather than causing an "off end of record" error). */
/* 22 Feb. 1994: lread.c: check that realloc did not return NULL. */
/* 6 June 1994: Under NON_UNIX_STDIO, use binary mode for direct
formatted files (avoiding any confusion regarding \n). */
/* 5 July 1994: Fix bug (introduced 6 June 1994?) in reopening files
under NON_UNIX_STDIO. */
/* 6 July 1994: wref.c: protect with #ifdef GOOD_SPRINTF_EXPONENT an
optimization that requires exponents to have 2 digits
when 2 digits suffice.
lwrite.c wsfe.c (list and formatted external output):
omit ' ' carriage-control when compiled with
-DOMIT_BLANK_CC . Off-by-one bug fixed in character
count for list output of character strings.
Omit '.' in list-directed printing of Nan, Infinity. */
/* 12 July 1994: wrtfmt.c: under G11.4, write 0. as " .0000 " rather
than " .0000E+00". */
/* 3 Aug. 1994: lwrite.c: do not insert a newline when appending an
oversize item to an empty line. */
/* 12 Aug. 1994: rsli.c rsne.c: fix glitch (reset nml_read) that kept
ERR= (in list- or format-directed input) from working
after a NAMELIST READ. */
/* 7 Sept. 1994: typesize.c: adjust to allow types LOGICAL*1, LOGICAL*2,
INTEGER*1, and (under -DAllow_TYQUAD) INTEGER*8
in NAMELISTs. */
/* 6 Oct. 1994: util.c: omit f__mvgbt, as it is never used. */
/* 2 Nov. 1994: add #ifdef ALWAYS_FLUSH logic. */
/* 26 Jan. 1995: wref.c: fix glitch in printing the exponent of 0 when
GOOD_SPRINTF_EXPONENT is not #defined. */
/* 24 Feb. 1995: iio.c: z_getc: insert (unsigned char *) to allow
internal reading of characters with high-bit set
(on machines that sign-extend characters). */
/* 14 March 1995:lread.c and rsfe.c: adjust s_rsle and s_rsfe to
check for end-of-file (to prevent infinite loops
with empty read statements). */
/* 26 May 1995: iio.c: z_wnew: fix bug in handling T format items
in internal writes whose last item is written to
an earlier position than some previous item. */
/* 29 Aug. 1995: backspace.c: adjust MSDOS logic. */
/* 6 Sept. 1995: Adjust namelist input to treat a subscripted name
whose subscripts do not involve colons similarly
to the name without a subscript: accept several
values, stored in successive elements starting at
the indicated subscript. Adjust namelist output
to quote character strings (avoiding confusion with
arrays of character strings). Adjust f_init calls
for people who don't use libF77's main(); now open and
namelist read statements invoke f_init if needed. */
/* 7 Sept. 1995: Fix some bugs with -DAllow_TYQUAD (for integer*8).
Add -DNo_Namelist_Comments lines to rsne.c. */
/* 5 Oct. 1995: wrtfmt.c: fix bug with t editing (f__cursor was not
always zeroed in mv_cur). */
/* 11 Oct. 1995: move defs of f__hiwater, f__svic, f__icptr from wrtfmt.c
to err.c */
/* 15 Mar. 1996: lread.c, rsfe.c: honor END= in READ stmt with empty iolist */
/* 13 May 1996: add ftell_.c and fseek_.c */
/* 9 June 1996: Adjust rsli.c and lread.c so internal list input with
too few items in the input string will honor end= . */
/* 12 Sept. 1995:fmtlib.c: fix glitch in printing the most negative integer. */
/* 25 Sept. 1995:fmt.h: for formatted writes of negative integer*1 values,
make ic signed on ANSI systems. If formatted writes of
integer*1 values trouble you when using a K&R C compiler,
switch to an ANSI compiler or use a compiler flag that
makes characters signed. */
/* 9 Dec. 1996: d[fu]e.c, err.c: complain about non-positive rec=
in direct read and write statements.
ftell_.c: change param "unit" to "Unit" for -DKR_headers. */
/* 26 Feb. 1997: ftell_.c: on systems that define SEEK_SET, etc., use
SEEK_SET, SEEK_CUR, SEEK_END for *whence = 0, 1, 2. */
/* 7 Apr. 1997: fmt.c: adjust to complain at missing numbers in formats
(but still treat missing ".nnn" as ".0"). */
/* 11 Apr. 1997: err.c: attempt to make stderr line buffered rather
than fully buffered. (Buffering is needed for format
items T and TR.) */
/* 27 May 1997: ftell_.c: fix typo (that caused the third argument to be
treated as 2 on some systems). */
/* 5 Aug. 1997: lread.c: adjust to accord with a change to the Fortran 8X
draft (in 1990 or 1991) that rescinded permission to elide
quote marks in namelist input of character data; compile
with -DF8X_NML_ELIDE_QUOTES to get the old behavior.
wrtfmt.o: wrt_G: tweak to print the right number of 0's
for zero under G format. */
/* 16 Aug. 1997: iio.c: fix bug in internal writes to an array of character
strings that sometimes caused one more array element than
required by the format to be blank-filled. Example:
format(1x). */
/* 16 Sept. 1997:fmt.[ch] rdfmt.c wrtfmt.c: tweak struct syl for machines
with 64-bit pointers and 32-bit ints that did not 64-bit
align struct syl (e.g., Linux on the DEC Alpha). */
/* 19 Jan. 1998: backspace.c: for b->ufmt==0, change sizeof(int) to
sizeof(uiolen). On machines where this would make a
difference, it is best for portability to compile libI77 with
-DUIOLEN_int (which will render the change invisible). */
/* 4 March 1998: open.c: fix glitch in comparing file names under
-DNON_UNIX_STDIO */
/* 17 March 1998: endfile.c, open.c: acquire temporary files from tmpfile(),
unless compiled with -DNON_ANSI_STDIO, which uses mktemp().
New buffering scheme independent of NON_UNIX_STDIO for
handling T format items. Now -DNON_UNIX_STDIO is no
longer be necessary for Linux, and libf2c no longer
causes stderr to be buffered -- the former setbuf or
setvbuf call for stderr was to make T format items work.
open.c: use the Posix access() function to check existence
or nonexistence of files, except under -DNON_POSIX_STDIO,
where trial fopen calls are used. */
/* 5 April 1998: wsfe.c: make $ format item work: this was lost in the
changes of 17 March 1998. */
/* 28 May 1998: backspace.c dfe.c due.c iio.c lread.c rsfe.c sue.c wsfe.c:
set f__curunit sooner so various error messages will
correctly identify the I/O unit involved. */
/* 17 June 1998: lread.c: unless compiled with
ALLOW_FLOAT_IN_INTEGER_LIST_INPUT #defined, treat
floating-point numbers (containing either a decimal point
or an exponent field) as errors when they appear as list
input for integer data. */
/* 7 Sept. 1998: move e_wdfe from sfe.c to dfe.c, where it was originally.
Why did it ever move to sfe.c? */
/* 2 May 1999: open.c: set f__external (to get "external" versus "internal"
right in the error message if we cannot open the file).
err.c: cast a pointer difference to (int) for %d.
rdfmt.c: omit fixed-length buffer that could be overwritten
by formats Inn or Lnn with nn > 83. */
/* 3 May 1999: open.c: insert two casts for machines with 64-bit longs. */
/* 18 June 1999: backspace.c: allow for b->ufd changing in t_runc */
/* 27 June 1999: rsne.c: fix bug in namelist input: a misplaced increment */
/* could cause wrong array elements to be assigned; e.g., */
/* "&input k(5)=10*1 &end" assigned k(5) and k(15..23) */
/* 15 Nov. 1999: endfile.c: set state to writing (b->uwrt = 1) when an */
/* endfile statement requires copying the file. */
/* (Otherwise an immediately following rewind statement */
/* could make the file appear empty.) Also, supply a */
/* missing (long) cast in the sprintf call. */
/* sfe.c: add #ifdef ALWAYS_FLUSH logic, for formatted I/O: */
/* Compiling libf2c with -DALWAYS_FLUSH should prevent losing */
/* any data in buffers should the program fault. It also */
/* makes the program run more slowly. */
/* 20 April 2000: rsne.c, xwsne.c: tweaks that only matter if ftnint and */
/* ftnlen are of different fundamental types (different numbers */
/* of bits). Since these files will not compile when this */
/* change matters, the above VERSION string remains unchanged. */
/* 4 July 2000: adjustments to permit compilation by C++ compilers; */
/* VERSION string remains unchanged. NOT APPLIED FOR G77 */
/* 5 Dec. 2000: lread.c: under namelist input, when reading a logical array, */
/* treat Tstuff= and Fstuff= as new assignments rather than as */
/* logical constants. */
/* Changes for GNU Fortran (g77) version of libf2c: */
/* 17 June 1997: detect recursive I/O and call f__fatal explaining it. */
libf2c/libI77/backspace.c deleted 100644 → 0
#include "config.h"
#include <sys/types.h>
#include "f2c.h"
#include "fio.h"
integer
f_back (alist * a)
{
unit *b;
off_t v, w, x, y, z;
uiolen n;
FILE *f;
f__curunit = b = &f__units[a->aunit]; /* curunit for error messages */
if (f__init & 2)
f__fatal (131, "I/O recursion");
if (a->aunit >= MXUNIT || a->aunit < 0)
err (a->aerr, 101, "backspace");
if (b->useek == 0)
err (a->aerr, 106, "backspace");
if (b->ufd == NULL)
{
fk_open (1, 1, a->aunit);
return (0);
}
if (b->uend == 1)
{
b->uend = 0;
return (0);
}
if (b->uwrt)
{
t_runc (a);
if (f__nowreading (b))
err (a->aerr, errno, "backspace");
}
f = b->ufd; /* may have changed in t_runc() */
if (b->url > 0)
{
x = FTELL (f);
y = x % b->url;
if (y == 0)
x--;
x /= b->url;
x *= b->url;
FSEEK (f, x, SEEK_SET);
return (0);
}
if (b->ufmt == 0)
{
FSEEK (f, -(off_t) sizeof (uiolen), SEEK_CUR);
fread ((char *) &n, sizeof (uiolen), 1, f);
FSEEK (f, -(off_t) n - 2 * sizeof (uiolen), SEEK_CUR);
return (0);
}
w = x = FTELL (f);
z = 0;
loop:
while (x)
{
x -= x < 64 ? x : 64;
FSEEK (f, x, SEEK_SET);
for (y = x; y < w; y++)
{
if (getc (f) != '\n')
continue;
v = FTELL (f);
if (v == w)
{
if (z)
goto break2;
goto loop;
}
z = v;
}
err (a->aerr, (EOF), "backspace");
}
break2:
FSEEK (f, z, SEEK_SET);
return 0;
}
libf2c/libI77/close.c deleted 100644 → 0
#include "config.h"
#include "f2c.h"
#include "fio.h"
#undef abs
#undef min
#undef max
#include <stdlib.h>
#ifdef NON_UNIX_STDIO
#ifndef unlink
#define unlink remove
#endif
#else
#if defined (MSDOS) && !defined (GO32)
#include "io.h"
#else
extern int unlink (const char *);
#endif
#endif
integer
f_clos (cllist * a)
{
unit *b;
if (f__init & 2)
f__fatal (131, "I/O recursion");
if (a->cunit >= MXUNIT)
return (0);
b = &f__units[a->cunit];
if (b->ufd == NULL)
goto done;
if (b->uscrtch == 1)
goto Delete;
if (!a->csta)
goto Keep;
switch (*a->csta)
{
default:
Keep:
case 'k':
case 'K':
if (b->uwrt == 1)
t_runc ((alist *) a);
if (b->ufnm)
{
fclose (b->ufd);
free (b->ufnm);
}
break;
case 'd':
case 'D':
Delete:
fclose (b->ufd);
if (b->ufnm)
{
unlink (b->ufnm);
/*SYSDEP*/ free (b->ufnm);
}
}
b->ufd = NULL;
done:
b->uend = 0;
b->ufnm = NULL;
return (0);
}
void
f_exit (void)
{
int i;
static cllist xx;
if (!(f__init & 1))
return; /* Not initialized, so no open units. */
/* I/O no longer in progress. If, during an I/O operation (such
as waiting for the user to enter a line), there is an
interrupt (such as ^C to stop the program on a UNIX system),
f_exit() is called, but there is no longer any I/O in
progress. Without turning off this flag, f_clos() would
think that there is an I/O recursion in this circumstance. */
f__init &= ~2;
if (!xx.cerr)
{
xx.cerr = 1;
xx.csta = NULL;
for (i = 0; i < MXUNIT; i++)
{
xx.cunit = i;
(void) f_clos (&xx);
}
}
}
int
G77_flush_0 (void)
{
int i;
for (i = 0; i < MXUNIT; i++)
if (f__units[i].ufd != NULL && f__units[i].uwrt)
fflush (f__units[i].ufd);
return 0;
}
libf2c/libI77/configure.in deleted 100644 → 0
# Process this file with autoconf to produce a configure script.
# Copyright (C) 1995, 1997, 1998, 2001, 2002 Free Software Foundation, Inc.
# Contributed by Dave Love (d.love@dl.ac.uk).
#
#This file is part of GNU Fortran.
#
#GNU Fortran 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.
#
#GNU Fortran 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 GNU Fortran; see the file COPYING. If not, write to
#the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
#02111-1307, USA.
AC_PREREQ(2.13)
AC_INIT(ftell_.c)
AC_CONFIG_HEADER(config.h)
dnl FIXME AC_PROG_CC wants CC to be able to link things, but it may
dnl not be able to.
define([AC_PROG_CC_WORKS],[])
# For g77 we'll set CC to point at the built gcc, but this will get it into
# the makefiles
AC_PROG_CC
# These defines are necessary to get 64-bit file size support.
# NetBSD 1.4 header files does not support XOPEN_SOURCE == 600, but it
# handles 64-bit file sizes without needing these defines.
AC_MSG_CHECKING(whether _XOPEN_SOURCE may be defined)
AC_TRY_COMPILE([#define _XOPEN_SOURCE 600L
#include <unistd.h>],,
may_use_xopen_source=yes,
may_use_xopen_source=no)
AC_MSG_RESULT($may_use_xopen_source)
if test $may_use_xopen_source = yes; then
AC_DEFINE(_XOPEN_SOURCE, 600L, [Get Single Unix Specification semantics])
# The following is needed by irix6.2 so that struct timeval is declared.
AC_DEFINE(_XOPEN_SOURCE_EXTENDED, 1, [Get Single Unix Specification semantics])
# The following is needed by Solaris2.5.1 so that struct timeval is declared.
AC_DEFINE(__EXTENSIONS__, 1, [Solaris extensions])
AC_DEFINE(_FILE_OFFSET_BITS, 64, [Get 64-bit file size support])
AC_DEFINE(_LARGEFILE_SOURCE, 1, [Define for HP-UX ftello and fseeko extension.])
fi
dnl Checks for programs.
LIBTOOL='$(SHELL) ../libtool'
AC_SUBST(LIBTOOL)
test "$AR" || AR=ar
AC_SUBST(AR)
AC_PROG_MAKE_SET
dnl Checks for libraries.
dnl Checks for header files.
# Sanity check for the cross-compilation case:
AC_CHECK_HEADER(stdio.h,:,
[AC_MSG_ERROR([Can't find stdio.h.
You must have a usable C system for the target already installed, at least
including headers and, preferably, the library, before you can configure
the G77 runtime system. If necessary, install gcc now with \`LANGUAGES=c',
then the target library, then build with \`LANGUAGES=f77'.])])
AC_HEADER_STDC
AC_MSG_CHECKING(for posix)
AC_CACHE_VAL(g77_cv_header_posix,
AC_EGREP_CPP(yes,
[#include <sys/types.h>
#include <unistd.h>
#ifdef _POSIX_VERSION
yes
#endif
],
g77_cv_header_posix=yes,
g77_cv_header_posix=no))
AC_MSG_RESULT($g77_cv_header_posix)
# We can rely on the GNU library being posix-ish. I guess checking the
# header isn't actually like checking the functions, though...
AC_MSG_CHECKING(for GNU library)
AC_CACHE_VAL(g77_cv_lib_gnu,
AC_EGREP_CPP(yes,
[#include <stdio.h>
#ifdef __GNU_LIBRARY__
yes
#endif
],
g77_cv_lib_gnu=yes, g77_cv_lib_gnu=no))
AC_MSG_RESULT($g77_cv_lib_gnu)
# Apparently cygwin needs to be special-cased.
AC_MSG_CHECKING([for cyg\`win'32])
AC_CACHE_VAL(g77_cv_sys_cygwin32,
AC_EGREP_CPP(yes,
[#ifdef __CYGWIN32__
yes
#endif
],
g77_cv_sys_cygwin32=yes,
g77_cv_sys_cygwin32=no))
AC_MSG_RESULT($g77_cv_sys_cygwin32)
# ditto for mingw32.
AC_MSG_CHECKING([for mingw32])
AC_CACHE_VAL(g77_cv_sys_mingw32,
AC_EGREP_CPP(yes,
[#ifdef __MINGW32__
yes
#endif
],
g77_cv_sys_mingw32=yes,
g77_cv_sys_mingw32=no))
AC_MSG_RESULT($g77_cv_sys_mingw32)
dnl Checks for typedefs, structures, and compiler characteristics.
AC_C_CONST
AC_TYPE_SIZE_T
dnl Checks for library functions.
# This should always succeed on unix.
# Apparently positive result on cygwin loses re. NON_UNIX_STDIO
# (as of cygwin b18). Likewise on mingw.
AC_CHECK_FUNC(fstat)
AC_MSG_CHECKING([need for NON_UNIX_STDIO])
if test $g77_cv_sys_cygwin32 = yes \
|| test $g77_cv_sys_mingw32 = yes \
|| test $ac_cv_func_fstat = no; then
AC_MSG_RESULT(yes)
AC_DEFINE(NON_UNIX_STDIO, 1, [Define if we do not have Unix Stdio.])
else
AC_MSG_RESULT(no)
fi
AC_CHECK_FUNCS(fseeko)
AC_CHECK_FUNCS(ftello)
AC_CHECK_FUNCS(ftruncate)
AC_CHECK_FUNCS(mkstemp)
AC_CHECK_FUNCS(tempnam)
AC_CHECK_FUNCS(tmpnam)
# posix will guarantee the right behaviour for sprintf, else we can't be
# sure; HEADER_STDC wouldn't be the right check in sunos4, for instance.
# However, on my sunos4/gcc setup unistd.h leads us wrongly to believe
# we're posix-conformant, so always do the test.
AC_MSG_CHECKING(for ansi/posix sprintf result)
dnl This loses if included as an argument to AC_CACHE_VAL because the
dnl changequote doesn't take effect and the [] vanish.
dnl fixme: use cached value
AC_TRY_RUN(changequote(<<, >>)dnl
<<#include <stdio.h>
/* does sprintf return the number of chars transferred? */
main () {char foo[2]; (sprintf(foo, "1") == 1) ? exit(0) : exit(1);}
>>changequote([, ]),
g77_cv_sys_sprintf_ansi=yes,
g77_cv_sys_sprintf_ansi=no,
g77_cv_sys_sprintf_ansi=no)
AC_CACHE_VAL(g77_cv_sys_sprintf_ansi,
g77_cv_sys_sprintf_ansi=$g77_cv_sys_sprintf_ansi)
dnl We get a misleading `(cached)' message...
AC_MSG_RESULT($g77_cv_sys_sprintf_ansi)
# The cygwin patch takes steps to avoid defining USE_STRLEN here -- I don't
# understand why.
if test $g77_cv_sys_sprintf_ansi != yes; then
AC_DEFINE(USE_STRLEN, 1, [Define if we use strlen.])
fi
# define NON_ANSI_RW_MODES on unix (can't hurt)
AC_MSG_CHECKING(NON_ANSI_RW_MODES)
AC_EGREP_CPP(yes,
[#ifdef unix
yes
#endif
#ifdef __unix
yes
#endif
#ifdef __unix__
yes
#endif
], is_unix=yes, is_unix=no)
# NON_ANSI_RW_MODES shouldn't be necessary on cygwin for binary mounts.
if test $g77_cv_sys_cygwin32 = yes || test $g77_cv_sys_mingw32 = yes; then
AC_MSG_RESULT(no)
else
if test $is_unix = yes; then
AC_DEFINE(NON_ANSI_RW_MODES, 1, [Define if we have non ANSI RW modes.])
AC_MSG_RESULT(yes)
else
AC_MSG_RESULT(no)
fi
fi
# This EOF_CHAR is a misfeature on unix.
AC_DEFINE(NO_EOF_CHAR_CHECK, 1, [Always defined.])
AC_TYPE_OFF_T
AC_DEFINE(Skip_f2c_Undefs, 1, [Define to skip f2c undefs.])
AC_OUTPUT(Makefile)
dnl We might have configuration options to:
dnl * change unit preconnexion in err.c (f_init.c)
dnl * -DALWAYS_FLUSH
dnl * -DOMIT_BLANK_CC
dnl Local Variables:
dnl comment-start: "dnl "
dnl comment-end: ""
dnl comment-start-skip: "\\bdnl\\b\\s *"
dnl End:
libf2c/libI77/dfe.c deleted 100644 → 0
#include "config.h"
#include "f2c.h"
#include "fio.h"
#include "fmt.h"
int
y_rsk (void)
{
if (f__curunit->uend || f__curunit->url <= f__recpos
|| f__curunit->url == 1)
return 0;
do
{
getc (f__cf);
}
while (++f__recpos < f__curunit->url);
return 0;
}
int
y_getc (void)
{
int ch;
if (f__curunit->uend)
return (-1);
if ((ch = getc (f__cf)) != EOF)
{
f__recpos++;
if (f__curunit->url >= f__recpos || f__curunit->url == 1)
return (ch);
else
return (' ');
}
if (feof (f__cf))
{
f__curunit->uend = 1;
errno = 0;
return (-1);
}
err (f__elist->cierr, errno, "readingd");
}
static int
y_rev (void)
{
if (f__recpos < f__hiwater)
f__recpos = f__hiwater;
if (f__curunit->url > 1)
while (f__recpos < f__curunit->url)
(*f__putn) (' ');
if (f__recpos)
f__putbuf (0);
f__recpos = 0;
return (0);
}
static int
y_err (void)
{
err (f__elist->cierr, 110, "dfe");
}
static int
y_newrec (void)
{
y_rev ();
f__hiwater = f__cursor = 0;
return (1);
}
int
c_dfe (cilist * a)
{
f__sequential = 0;
f__formatted = f__external = 1;
f__elist = a;
f__cursor = f__scale = f__recpos = 0;
f__curunit = &f__units[a->ciunit];
if (a->ciunit > MXUNIT || a->ciunit < 0)
err (a->cierr, 101, "startchk");
if (f__curunit->ufd == NULL && fk_open (DIR, FMT, a->ciunit))
err (a->cierr, 104, "dfe");
f__cf = f__curunit->ufd;
if (!f__curunit->ufmt)
err (a->cierr, 102, "dfe");
if (!f__curunit->useek)
err (a->cierr, 104, "dfe");
f__fmtbuf = a->cifmt;
if (a->cirec <= 0)
err (a->cierr, 130, "dfe");
FSEEK (f__cf, (off_t) f__curunit->url * (a->cirec - 1), SEEK_SET);
f__curunit->uend = 0;
return (0);
}
integer
s_rdfe (cilist * a)
{
int n;
if (f__init != 1)
f_init ();
f__init = 3;
f__reading = 1;
if ((n = c_dfe (a)))
return (n);
if (f__curunit->uwrt && f__nowreading (f__curunit))
err (a->cierr, errno, "read start");
f__getn = y_getc;
f__doed = rd_ed;
f__doned = rd_ned;
f__dorevert = f__donewrec = y_err;
f__doend = y_rsk;
if (pars_f (f__fmtbuf) < 0)
err (a->cierr, 100, "read start");
fmt_bg ();
return (0);
}
integer
s_wdfe (cilist * a)
{
int n;
if (f__init != 1)
f_init ();
f__init = 3;
f__reading = 0;
if ((n = c_dfe (a)))
return (n);
if (f__curunit->uwrt != 1 && f__nowwriting (f__curunit))
err (a->cierr, errno, "startwrt");
f__putn = x_putc;
f__doed = w_ed;
f__doned = w_ned;
f__dorevert = y_err;
f__donewrec = y_newrec;
f__doend = y_rev;
if (pars_f (f__fmtbuf) < 0)
err (a->cierr, 100, "startwrt");
fmt_bg ();
return (0);
}
integer
e_rdfe (void)
{
f__init = 1;
en_fio ();
return (0);
}
integer
e_wdfe (void)
{
f__init = 1;
return en_fio ();
}
libf2c/libI77/dolio.c deleted 100644 → 0
#include "config.h"
#include "f2c.h"
extern int (*f__lioproc) (ftnint *, char *, ftnlen, ftnint);
integer
do_lio (ftnint * type, ftnint * number, char *ptr, ftnlen len)
{
return ((*f__lioproc) (number, ptr, len, *type));
}
libf2c/libI77/due.c deleted 100644 → 0
#include "config.h"
#include "f2c.h"
#include "fio.h"
int
c_due (cilist * a)
{
if (f__init != 1)
f_init ();
f__init = 3;
if (a->ciunit >= MXUNIT || a->ciunit < 0)
err (a->cierr, 101, "startio");
f__sequential = f__formatted = f__recpos = 0;
f__external = 1;
f__curunit = &f__units[a->ciunit];
if (a->ciunit >= MXUNIT || a->ciunit < 0)
err (a->cierr, 101, "startio");
f__elist = a;
if (f__curunit->ufd == NULL && fk_open (DIR, UNF, a->ciunit))
err (a->cierr, 104, "due");
f__cf = f__curunit->ufd;
if (f__curunit->ufmt)
err (a->cierr, 102, "cdue");
if (!f__curunit->useek)
err (a->cierr, 104, "cdue");
if (f__curunit->ufd == NULL)
err (a->cierr, 114, "cdue");
if (a->cirec <= 0)
err (a->cierr, 130, "due");
FSEEK (f__cf, (off_t) (a->cirec - 1) * f__curunit->url, SEEK_SET);
f__curunit->uend = 0;
return (0);
}
integer
s_rdue (cilist * a)
{
int n;
f__reading = 1;
if ((n = c_due (a)))
return (n);
if (f__curunit->uwrt && f__nowreading (f__curunit))
err (a->cierr, errno, "read start");
return (0);
}
integer
s_wdue (cilist * a)
{
int n;
f__reading = 0;
if ((n = c_due (a)))
return (n);
if (f__curunit->uwrt != 1 && f__nowwriting (f__curunit))
err (a->cierr, errno, "write start");
return (0);
}
integer
e_rdue (void)
{
f__init = 1;
if (f__curunit->url == 1 || f__recpos == f__curunit->url)
return (0);
FSEEK (f__cf, (off_t) (f__curunit->url - f__recpos), SEEK_CUR);
if (FTELL (f__cf) % f__curunit->url)
err (f__elist->cierr, 200, "syserr");
return (0);
}
integer
e_wdue (void)
{
f__init = 1;
#ifdef ALWAYS_FLUSH
if (fflush (f__cf))
err (f__elist->cierr, errno, "write end");
#endif
return (e_rdue ());
}
libf2c/libI77/endfile.c deleted 100644 → 0
#include "config.h"
#include "f2c.h"
#include "fio.h"
#include <sys/types.h>
#include <unistd.h>
#undef abs
#undef min
#undef max
#include <stdlib.h>
#include <string.h>
extern char *f__r_mode[], *f__w_mode[];
integer
f_end (alist * a)
{
unit *b;
FILE *tf;
if (f__init & 2)
f__fatal (131, "I/O recursion");
if (a->aunit >= MXUNIT || a->aunit < 0)
err (a->aerr, 101, "endfile");
b = &f__units[a->aunit];
if (b->ufd == NULL)
{
char nbuf[10];
sprintf (nbuf, "fort.%ld", (long) a->aunit);
if ((tf = fopen (nbuf, f__w_mode[0])))
fclose (tf);
return (0);
}
b->uend = 1;
return (b->useek ? t_runc (a) : 0);
}
#ifndef HAVE_FTRUNCATE
static int
copy (FILE * from, register long len, FILE * to)
{
int len1;
char buf[BUFSIZ];
while (fread (buf, len1 = len > BUFSIZ ? BUFSIZ : (int) len, 1, from))
{
if (!fwrite (buf, len1, 1, to))
return 1;
if ((len -= len1) <= 0)
break;
}
return 0;
}
#endif /* !defined(HAVE_FTRUNCATE) */
int
t_runc (alist * a)
{
off_t loc, len;
unit *b;
int rc;
FILE *bf;
#ifndef HAVE_FTRUNCATE
FILE *tf;
#endif /* !defined(HAVE_FTRUNCATE) */
b = &f__units[a->aunit];
if (b->url)
return (0); /*don't truncate direct files */
loc = FTELL (bf = b->ufd);
FSEEK (bf, 0, SEEK_END);
len = FTELL (bf);
if (loc >= len || b->useek == 0 || b->ufnm == NULL)
return (0);
#ifndef HAVE_FTRUNCATE
rc = 0;
fclose (b->ufd);
if (!loc)
{
if (!(bf = fopen (b->ufnm, f__w_mode[b->ufmt])))
rc = 1;
if (b->uwrt)
b->uwrt = 1;
goto done;
}
if (!(bf = fopen (b->ufnm, f__r_mode[0])) || !(tf = tmpfile ()))
{
#ifdef NON_UNIX_STDIO
bad:
#endif
rc = 1;
goto done;
}
if (copy (bf, loc, tf))
{
bad1:
rc = 1;
goto done1;
}
if (!(bf = freopen (b->ufnm, f__w_mode[0], bf)))
goto bad1;
FSEEK (tf, 0, SEEK_SET);
if (copy (tf, loc, bf))
goto bad1;
b->uwrt = 1;
b->urw = 2;
#ifdef NON_UNIX_STDIO
if (b->ufmt)
{
fclose (bf);
if (!(bf = fopen (b->ufnm, f__w_mode[3])))
goto bad;
FSEEK (bf, 0, SEEK_END);
b->urw = 3;
}
#endif
done1:
fclose (tf);
done:
f__cf = b->ufd = bf;
#else /* !defined(HAVE_FTRUNCATE) */
fflush (b->ufd);
rc = ftruncate (fileno (b->ufd), loc);
FSEEK (bf, loc, SEEK_SET);
#endif /* !defined(HAVE_FTRUNCATE) */
if (rc)
err (a->aerr, 111, "endfile");
return 0;
}
libf2c/libI77/err.c deleted 100644 → 0
#include "config.h"
#ifndef NON_UNIX_STDIO
#define _INCLUDE_POSIX_SOURCE /* for HP-UX */
#define _INCLUDE_XOPEN_SOURCE /* for HP-UX */
#include <sys/types.h>
#include <sys/stat.h>
#endif
#include "f2c.h"
#undef abs
#undef min
#undef max
#include <stdlib.h>
#include "fio.h"
#include "fmt.h" /* for struct syl */
/*global definitions*/
unit f__units[MXUNIT]; /*unit table */
int f__init; /*bit 0: set after initializations;
bit 1: set during I/O involving returns to
caller of library (or calls to user code) */
cilist *f__elist; /*active external io list */
icilist *f__svic; /*active internal io list */
flag f__reading; /*1 if reading, 0 if writing */
flag f__cplus, f__cblank;
char *f__fmtbuf;
int f__fmtlen;
flag f__external; /*1 if external io, 0 if internal */
int (*f__getn) (void); /* for formatted input */
void (*f__putn) (int); /* for formatted output */
int (*f__doed) (struct syl *, char *, ftnlen), (*f__doned) (struct syl *);
int (*f__dorevert) (void), (*f__donewrec) (void), (*f__doend) (void);
flag f__sequential; /*1 if sequential io, 0 if direct */
flag f__formatted; /*1 if formatted io, 0 if unformatted */
FILE *f__cf; /*current file */
unit *f__curunit; /*current unit */
int f__recpos; /*place in current record */
int f__cursor, f__hiwater, f__scale;
char *f__icptr;
/*error messages*/
char *F_err[] = {
"error in format", /* 100 */
"illegal unit number", /* 101 */
"formatted io not allowed", /* 102 */
"unformatted io not allowed", /* 103 */
"direct io not allowed", /* 104 */
"sequential io not allowed", /* 105 */
"can't backspace file", /* 106 */
"null file name", /* 107 */
"can't stat file", /* 108 */
"unit not connected", /* 109 */
"off end of record", /* 110 */
"truncation failed in endfile", /* 111 */
"incomprehensible list input", /* 112 */
"out of free space", /* 113 */
"unit not connected", /* 114 */
"read unexpected character", /* 115 */
"bad logical input field", /* 116 */
"bad variable type", /* 117 */
"bad namelist name", /* 118 */
"variable not in namelist", /* 119 */
"no end record", /* 120 */
"variable count incorrect", /* 121 */
"subscript for scalar variable", /* 122 */
"invalid array section", /* 123 */
"substring out of bounds", /* 124 */
"subscript out of bounds", /* 125 */
"can't read file", /* 126 */
"can't write file", /* 127 */
"'new' file exists", /* 128 */
"can't append to file", /* 129 */
"non-positive record number", /* 130 */
"I/O started while already doing I/O", /* 131 */
"Temporary file name (TMPDIR?) too long" /* 132 */
};
#define MAXERR (sizeof(F_err)/sizeof(char *)+100)
int
f__canseek (FILE * f) /*SYSDEP*/
{
#ifdef NON_UNIX_STDIO
return !isatty (fileno (f));
#else
struct stat x;
if (fstat (fileno (f), &x) < 0)
return (0);
#ifdef S_IFMT
switch (x.st_mode & S_IFMT)
{
case S_IFDIR:
case S_IFREG:
if (x.st_nlink > 0) /* !pipe */
return (1);
else
return (0);
case S_IFCHR:
if (isatty (fileno (f)))
return (0);
return (1);
#ifdef S_IFBLK
case S_IFBLK:
return (1);
#endif
}
#else
#ifdef S_ISDIR
/* POSIX version */
if (S_ISREG (x.st_mode) || S_ISDIR (x.st_mode))
{
if (x.st_nlink > 0) /* !pipe */
return (1);
else
return (0);
}
if (S_ISCHR (x.st_mode))
{
if (isatty (fileno (f)))
return (0);
return (1);
}
if (S_ISBLK (x.st_mode))
return (1);
#else
Help ! How does fstat work on this system ?
#endif
#endif
return (0); /* who knows what it is? */
#endif
}
void
f__fatal (int n, char *s)
{
static int dead = 0;
if (n < 100 && n >= 0)
perror (s);
/*SYSDEP*/
else if (n >= (int) MAXERR || n < -1)
{
fprintf (stderr, "%s: illegal error number %d\n", s, n);
}
else if (n == -1)
fprintf (stderr, "%s: end of file\n", s);
else
fprintf (stderr, "%s: %s\n", s, F_err[n - 100]);
if (dead)
{
fprintf (stderr, "(libf2c f__fatal already called, aborting.)");
abort ();
}
dead = 1;
if (f__init & 1)
{
if (f__curunit)
{
fprintf (stderr, "apparent state: unit %d ",
(int) (f__curunit - f__units));
fprintf (stderr, f__curunit->ufnm ? "named %s\n" : "(unnamed)\n",
f__curunit->ufnm);
}
else
fprintf (stderr, "apparent state: internal I/O\n");
if (f__fmtbuf)
fprintf (stderr, "last format: %.*s\n", f__fmtlen, f__fmtbuf);
fprintf (stderr, "lately %s %s %s %s",
f__reading ? "reading" : "writing",
f__sequential ? "sequential" : "direct",
f__formatted ? "formatted" : "unformatted",
f__external ? "external" : "internal");
}
f__init &= ~2; /* No longer doing I/O (no more user code to be called). */
sig_die (" IO", 1);
}
/*initialization routine*/
void
f_init (void)
{
unit *p;
if (f__init & 2)
f__fatal (131, "I/O recursion");
f__init = 1;
p = &f__units[0];
p->ufd = stderr;
p->useek = f__canseek (stderr);
p->ufmt = 1;
p->uwrt = 1;
p = &f__units[5];
p->ufd = stdin;
p->useek = f__canseek (stdin);
p->ufmt = 1;
p->uwrt = 0;
p = &f__units[6];
p->ufd = stdout;
p->useek = f__canseek (stdout);
p->ufmt = 1;
p->uwrt = 1;
}
int
f__nowreading (unit * x)
{
off_t loc;
int ufmt, urw;
extern char *f__r_mode[], *f__w_mode[];
if (x->urw & 1)
goto done;
if (!x->ufnm)
goto cantread;
ufmt = x->url ? 0 : x->ufmt;
loc = FTELL (x->ufd);
urw = 3;
if (!freopen (x->ufnm, f__w_mode[ufmt | 2], x->ufd))
{
urw = 1;
if (!freopen (x->ufnm, f__r_mode[ufmt], x->ufd))
{
cantread:
errno = 126;
return 1;
}
}
FSEEK (x->ufd, loc, SEEK_SET);
x->urw = urw;
done:
x->uwrt = 0;
return 0;
}
int
f__nowwriting (unit * x)
{
off_t loc;
int ufmt;
extern char *f__w_mode[];
if (x->urw & 2)
goto done;
if (!x->ufnm)
goto cantwrite;
ufmt = x->url ? 0 : x->ufmt;
if (x->uwrt == 3)
{ /* just did write, rewind */
if (!(f__cf = x->ufd = freopen (x->ufnm, f__w_mode[ufmt], x->ufd)))
goto cantwrite;
x->urw = 2;
}
else
{
loc = FTELL (x->ufd);
if (!(f__cf = x->ufd = freopen (x->ufnm, f__w_mode[ufmt |= 2], x->ufd)))
{
x->ufd = NULL;
cantwrite:
errno = 127;
return (1);
}
x->urw = 3;
FSEEK (x->ufd, loc, SEEK_SET);
}
done:
x->uwrt = 1;
return 0;
}
int
err__fl (int f, int m, char *s)
{
if (!f)
f__fatal (m, s);
if (f__doend)
(*f__doend) ();
f__init &= ~2;
return errno = m;
}
libf2c/libI77/f2ch.add deleted 100644 → 0
/* If you are using a C++ compiler, append the following to f2c.h
for compiling libF77 and libI77. */
#ifdef __cplusplus
extern "C"
{
extern int abort_ (void);
extern double c_abs (complex *);
extern void c_cos (complex *, complex *);
extern void c_div (complex *, complex *, complex *);
extern void c_exp (complex *, complex *);
extern void c_log (complex *, complex *);
extern void c_sin (complex *, complex *);
extern void c_sqrt (complex *, complex *);
extern double d_abs (double *);
extern double d_acos (double *);
extern double d_asin (double *);
extern double d_atan (double *);
extern double d_atn2 (double *, double *);
extern void d_cnjg (doublecomplex *, doublecomplex *);
extern double d_cos (double *);
extern double d_cosh (double *);
extern double d_dim (double *, double *);
extern double d_exp (double *);
extern double d_imag (doublecomplex *);
extern double d_int (double *);
extern double d_lg10 (double *);
extern double d_log (double *);
extern double d_mod (double *, double *);
extern double d_nint (double *);
extern double d_prod (float *, float *);
extern double d_sign (double *, double *);
extern double d_sin (double *);
extern double d_sinh (double *);
extern double d_sqrt (double *);
extern double d_tan (double *);
extern double d_tanh (double *);
extern double derf_ (double *);
extern double derfc_ (double *);
extern integer do_fio (ftnint *, char *, ftnlen);
extern integer do_lio (ftnint *, ftnint *, char *, ftnlen);
extern integer do_uio (ftnint *, char *, ftnlen);
extern integer e_rdfe (void);
extern integer e_rdue (void);
extern integer e_rsfe (void);
extern integer e_rsfi (void);
extern integer e_rsle (void);
extern integer e_rsli (void);
extern integer e_rsue (void);
extern integer e_wdfe (void);
extern integer e_wdue (void);
extern integer e_wsfe (void);
extern integer e_wsfi (void);
extern integer e_wsle (void);
extern integer e_wsli (void);
extern integer e_wsue (void);
extern int ef1asc_ (ftnint *, ftnlen *, ftnint *, ftnlen *);
extern integer ef1cmc_ (ftnint *, ftnlen *, ftnint *, ftnlen *);
extern double erf (double);
extern double erf_ (float *);
extern double erfc (double);
extern double erfc_ (float *);
extern integer f_back (alist *);
extern integer f_clos (cllist *);
extern integer f_end (alist *);
extern void f_exit (void);
extern integer f_inqu (inlist *);
extern integer f_open (olist *);
extern integer f_rew (alist *);
extern int flush_ (void);
extern void getarg_ (integer *, char *, ftnlen);
extern void getenv_ (char *, char *, ftnlen, ftnlen);
extern short h_abs (short *);
extern short h_dim (short *, short *);
extern short h_dnnt (double *);
extern short h_indx (char *, char *, ftnlen, ftnlen);
extern short h_len (char *, ftnlen);
extern short h_mod (short *, short *);
extern short h_nint (float *);
extern short h_sign (short *, short *);
extern short hl_ge (char *, char *, ftnlen, ftnlen);
extern short hl_gt (char *, char *, ftnlen, ftnlen);
extern short hl_le (char *, char *, ftnlen, ftnlen);
extern short hl_lt (char *, char *, ftnlen, ftnlen);
extern integer i_abs (integer *);
extern integer i_dim (integer *, integer *);
extern integer i_dnnt (double *);
extern integer i_indx (char *, char *, ftnlen, ftnlen);
extern integer i_len (char *, ftnlen);
extern integer i_mod (integer *, integer *);
extern integer i_nint (float *);
extern integer i_sign (integer *, integer *);
extern integer iargc_ (void);
extern ftnlen l_ge (char *, char *, ftnlen, ftnlen);
extern ftnlen l_gt (char *, char *, ftnlen, ftnlen);
extern ftnlen l_le (char *, char *, ftnlen, ftnlen);
extern ftnlen l_lt (char *, char *, ftnlen, ftnlen);
extern void pow_ci (complex *, complex *, integer *);
extern double pow_dd (double *, double *);
extern double pow_di (double *, integer *);
extern short pow_hh (short *, shortint *);
extern integer pow_ii (integer *, integer *);
extern double pow_ri (float *, integer *);
extern void pow_zi (doublecomplex *, doublecomplex *, integer *);
extern void pow_zz (doublecomplex *, doublecomplex *, doublecomplex *);
extern double r_abs (float *);
extern double r_acos (float *);
extern double r_asin (float *);
extern double r_atan (float *);
extern double r_atn2 (float *, float *);
extern void r_cnjg (complex *, complex *);
extern double r_cos (float *);
extern double r_cosh (float *);
extern double r_dim (float *, float *);
extern double r_exp (float *);
extern double r_imag (complex *);
extern double r_int (float *);
extern double r_lg10 (float *);
extern double r_log (float *);
extern double r_mod (float *, float *);
extern double r_nint (float *);
extern double r_sign (float *, float *);
extern double r_sin (float *);
extern double r_sinh (float *);
extern double r_sqrt (float *);
extern double r_tan (float *);
extern double r_tanh (float *);
extern void s_cat (char *, char **, integer *, integer *, ftnlen);
extern integer s_cmp (char *, char *, ftnlen, ftnlen);
extern void s_copy (char *, char *, ftnlen, ftnlen);
extern int s_paus (char *, ftnlen);
extern integer s_rdfe (cilist *);
extern integer s_rdue (cilist *);
extern integer s_rnge (char *, integer, char *, integer);
extern integer s_rsfe (cilist *);
extern integer s_rsfi (icilist *);
extern integer s_rsle (cilist *);
extern integer s_rsli (icilist *);
extern integer s_rsne (cilist *);
extern integer s_rsni (icilist *);
extern integer s_rsue (cilist *);
extern int s_stop (char *, ftnlen);
extern integer s_wdfe (cilist *);
extern integer s_wdue (cilist *);
extern integer s_wsfe (cilist *);
extern integer s_wsfi (icilist *);
extern integer s_wsle (cilist *);
extern integer s_wsli (icilist *);
extern integer s_wsne (cilist *);
extern integer s_wsni (icilist *);
extern integer s_wsue (cilist *);
extern void sig_die (char *, int);
extern integer signal_ (integer *, void (*)(int));
extern integer system_ (char *, ftnlen);
extern double z_abs (doublecomplex *);
extern void z_cos (doublecomplex *, doublecomplex *);
extern void z_div (doublecomplex *, doublecomplex *, doublecomplex *);
extern void z_exp (doublecomplex *, doublecomplex *);
extern void z_log (doublecomplex *, doublecomplex *);
extern void z_sin (doublecomplex *, doublecomplex *);
extern void z_sqrt (doublecomplex *, doublecomplex *);
}
#endif
libf2c/libI77/fio.h deleted 100644 → 0
#include <sys/types.h>
#include <stdio.h>
#include <errno.h>
#ifndef NULL
/* ANSI C */
#include <stddef.h>
#endif
#ifdef STDC_HEADERS
#include <string.h>
#endif
#ifndef SEEK_SET
#define SEEK_SET 0
#define SEEK_CUR 1
#define SEEK_END 2
#endif
/* Only use fseeko/ftello if they are both there. */
#if defined (HAVE_FSEEKO) && defined (HAVE_FTELLO)
#define FSEEK fseeko
#define FTELL ftello
#else
#define FSEEK fseek
#define FTELL ftell
#endif
#if defined (MSDOS) && !defined (GO32)
#ifndef NON_UNIX_STDIO
#define NON_UNIX_STDIO
#endif
#endif
#ifdef UIOLEN_int
typedef int uiolen;
#else
typedef long uiolen;
#endif
/*units*/
typedef struct
{
FILE *ufd; /*0=unconnected */
char *ufnm;
#if !(defined (MSDOS) && !defined (GO32))
long uinode;
int udev;
#endif
int url; /*0=sequential */
flag useek; /*true=can backspace, use dir, ... */
flag ufmt;
flag urw; /* (1 for can read) | (2 for can write) */
flag ublnk;
flag uend;
flag uwrt; /*last io was write */
flag uscrtch;
}
unit;
extern int f__init;
extern cilist *f__elist; /*active external io list */
extern flag f__reading, f__external, f__sequential, f__formatted;
extern int (*f__getn) (void); /* for formatted input */
extern void (*f__putn) (int); /* for formatted output */
extern void x_putc (int);
extern long f__inode (char *, int *);
extern void sig_die (char *, int);
extern void f__fatal (int, char *);
extern int t_runc (alist *);
extern int f__nowreading (unit *), f__nowwriting (unit *);
extern int fk_open (int, int, ftnint);
extern int en_fio (void);
extern void f_init (void);
extern int (*f__donewrec) (void), t_putc (int), x_wSL (void);
extern void b_char (char *, char *, ftnlen), g_char (char *, ftnlen, char *);
extern int c_sfe (cilist *), z_rnew (void);
extern int isatty (int);
extern int err__fl (int, int, char *);
extern int xrd_SL (void);
extern int f__putbuf (int);
extern int (*f__doend) (void);
extern FILE *f__cf; /*current file */
extern unit *f__curunit; /*current unit */
extern unit f__units[];
#define err(f,m,s) do {if(f) {f__init &= ~2; errno= m;} else f__fatal(m,s); return(m);} while(0)
#define errfl(f,m,s) do {return err__fl((int)f,m,s);} while(0)
/*Table sizes*/
#define MXUNIT 100
extern int f__recpos; /*position in current record */
extern int f__cursor; /* offset to move to */
extern int f__hiwater; /* so TL doesn't confuse us */
#define WRITE 1
#define READ 2
#define SEQ 3
#define DIR 4
#define FMT 5
#define UNF 6
#define EXT 7
#define INT 8
#define buf_end(x) (x->_flag & _IONBF ? x->_ptr : x->_base + BUFSIZ)
libf2c/libI77/fmt.c deleted 100644 → 0
#include "config.h"
#include "f2c.h"
#include "fio.h"
#include "fmt.h"
#define skip(s) while(*s==' ') s++
#ifdef interdata
#define SYLMX 300
#endif
#ifdef pdp11
#define SYLMX 300
#endif
#ifdef vax
#define SYLMX 300
#endif
#ifndef SYLMX
#define SYLMX 300
#endif
#define GLITCH '\2'
/* special quote character for stu */
extern int f__cursor, f__scale;
extern flag f__cblank, f__cplus; /*blanks in I and compulsory plus */
static struct syl f__syl[SYLMX];
int f__parenlvl, f__pc, f__revloc;
static char *
ap_end (char *s)
{
char quote;
quote = *s++;
for (; *s; s++)
{
if (*s != quote)
continue;
if (*++s != quote)
return (s);
}
if (f__elist->cierr)
{
errno = 100;
return (NULL);
}
f__fatal (100, "bad string");
/*NOTREACHED*/ return 0;
}
static int
op_gen (int a, int b, int c, int d)
{
struct syl *p = &f__syl[f__pc];
if (f__pc >= SYLMX)
{
fprintf (stderr, "format too complicated:\n");
sig_die (f__fmtbuf, 1);
}
p->op = a;
p->p1 = b;
p->p2.i[0] = c;
p->p2.i[1] = d;
return (f__pc++);
}
static char *f_list (char *);
static char *
gt_num (char *s, int *n, int n1)
{
int m = 0, f__cnt = 0;
char c;
for (c = *s;; c = *s)
{
if (c == ' ')
{
s++;
continue;
}
if (c > '9' || c < '0')
break;
m = 10 * m + c - '0';
f__cnt++;
s++;
}
if (f__cnt == 0)
{
if (!n1)
s = 0;
*n = n1;
}
else
*n = m;
return (s);
}
static char *
f_s (char *s, int curloc)
{
skip (s);
if (*s++ != '(')
{
return (NULL);
}
if (f__parenlvl++ == 1)
f__revloc = curloc;
if (op_gen (RET1, curloc, 0, 0) < 0 || (s = f_list (s)) == NULL)
{
return (NULL);
}
return (s);
}
static int
ne_d (char *s, char **p)
{
int n, x, sign = 0;
struct syl *sp;
switch (*s)
{
default:
return (0);
case ':':
(void) op_gen (COLON, 0, 0, 0);
break;
case '$':
(void) op_gen (NONL, 0, 0, 0);
break;
case 'B':
case 'b':
if (*++s == 'z' || *s == 'Z')
(void) op_gen (BZ, 0, 0, 0);
else
(void) op_gen (BN, 0, 0, 0);
break;
case 'S':
case 's':
if (*(s + 1) == 's' || *(s + 1) == 'S')
{
x = SS;
s++;
}
else if (*(s + 1) == 'p' || *(s + 1) == 'P')
{
x = SP;
s++;
}
else
x = S;
(void) op_gen (x, 0, 0, 0);
break;
case '/':
(void) op_gen (SLASH, 0, 0, 0);
break;
case '-':
sign = 1;
case '+':
s++; /*OUTRAGEOUS CODING TRICK */
case '0':
case '1':
case '2':
case '3':
case '4':
case '5':
case '6':
case '7':
case '8':
case '9':
if (!(s = gt_num (s, &n, 0)))
{
bad:*p = 0;
return 1;
}
switch (*s)
{
default:
return (0);
case 'P':
case 'p':
if (sign)
n = -n;
(void) op_gen (P, n, 0, 0);
break;
case 'X':
case 'x':
(void) op_gen (X, n, 0, 0);
break;
case 'H':
case 'h':
sp = &f__syl[op_gen (H, n, 0, 0)];
sp->p2.s = s + 1;
s += n;
break;
}
break;
case GLITCH:
case '"':
case '\'':
sp = &f__syl[op_gen (APOS, 0, 0, 0)];
sp->p2.s = s;
if ((*p = ap_end (s)) == NULL)
return (0);
return (1);
case 'T':
case 't':
if (*(s + 1) == 'l' || *(s + 1) == 'L')
{
x = TL;
s++;
}
else if (*(s + 1) == 'r' || *(s + 1) == 'R')
{
x = TR;
s++;
}
else
x = T;
if (!(s = gt_num (s + 1, &n, 0)))
goto bad;
s--;
(void) op_gen (x, n, 0, 0);
break;
case 'X':
case 'x':
(void) op_gen (X, 1, 0, 0);
break;
case 'P':
case 'p':
(void) op_gen (P, 1, 0, 0);
break;
}
s++;
*p = s;
return (1);
}
static int
e_d (char *s, char **p)
{
int i, im, n, w, d, e, found = 0, x = 0;
char *sv = s;
s = gt_num (s, &n, 1);
(void) op_gen (STACK, n, 0, 0);
switch (*s++)
{
default:
break;
case 'E':
case 'e':
x = 1;
case 'G':
case 'g':
found = 1;
if (!(s = gt_num (s, &w, 0)))
{
bad:
*p = 0;
return 1;
}
if (w == 0)
break;
if (*s == '.')
{
if (!(s = gt_num (s + 1, &d, 0)))
goto bad;
}
else
d = 0;
if (*s != 'E' && *s != 'e')
(void) op_gen (x == 1 ? E : G, w, d, 0); /* default is Ew.dE2 */
else
{
if (!(s = gt_num (s + 1, &e, 0)))
goto bad;
(void) op_gen (x == 1 ? EE : GE, w, d, e);
}
break;
case 'O':
case 'o':
i = O;
im = OM;
goto finish_I;
case 'Z':
case 'z':
i = Z;
im = ZM;
goto finish_I;
case 'L':
case 'l':
found = 1;
if (!(s = gt_num (s, &w, 0)))
goto bad;
if (w == 0)
break;
(void) op_gen (L, w, 0, 0);
break;
case 'A':
case 'a':
found = 1;
skip (s);
if (*s >= '0' && *s <= '9')
{
s = gt_num (s, &w, 1);
if (w == 0)
break;
(void) op_gen (AW, w, 0, 0);
break;
}
(void) op_gen (A, 0, 0, 0);
break;
case 'F':
case 'f':
if (!(s = gt_num (s, &w, 0)))
goto bad;
found = 1;
if (w == 0)
break;
if (*s == '.')
{
if (!(s = gt_num (s + 1, &d, 0)))
goto bad;
}
else
d = 0;
(void) op_gen (F, w, d, 0);
break;
case 'D':
case 'd':
found = 1;
if (!(s = gt_num (s, &w, 0)))
goto bad;
if (w == 0)
break;
if (*s == '.')
{
if (!(s = gt_num (s + 1, &d, 0)))
goto bad;
}
else
d = 0;
(void) op_gen (D, w, d, 0);
break;
case 'I':
case 'i':
i = I;
im = IM;
finish_I:
if (!(s = gt_num (s, &w, 0)))
goto bad;
found = 1;
if (w == 0)
break;
if (*s != '.')
{
(void) op_gen (i, w, 0, 0);
break;
}
if (!(s = gt_num (s + 1, &d, 0)))
goto bad;
(void) op_gen (im, w, d, 0);
break;
}
if (found == 0)
{
f__pc--; /*unSTACK */
*p = sv;
return (0);
}
*p = s;
return (1);
}
static char *
i_tem (char *s)
{
char *t;
int n, curloc;
if (*s == ')')
return (s);
if (ne_d (s, &t))
return (t);
if (e_d (s, &t))
return (t);
s = gt_num (s, &n, 1);
if ((curloc = op_gen (STACK, n, 0, 0)) < 0)
return (NULL);
return (f_s (s, curloc));
}
static char *
f_list (char *s)
{
for (; *s != 0;)
{
skip (s);
if ((s = i_tem (s)) == NULL)
return (NULL);
skip (s);
if (*s == ',')
s++;
else if (*s == ')')
{
if (--f__parenlvl == 0)
{
(void) op_gen (REVERT, f__revloc, 0, 0);
return (++s);
}
(void) op_gen (GOTO, 0, 0, 0);
return (++s);
}
}
return (NULL);
}
int
pars_f (char *s)
{
char *e;
f__parenlvl = f__revloc = f__pc = 0;
if ((e = f_s (s, 0)) == NULL)
{
/* Try and delimit the format string. Parens within
hollerith and quoted strings have to match for this
to work, but it's probably adequate for most needs.
Note that this is needed because a valid CHARACTER
variable passed for FMT= can contain '(I)garbage',
where `garbage' is billions and billions of junk
characters, and it's up to the run-time library to
know where the format string ends by counting parens.
Meanwhile, still treat NUL byte as "hard stop", since
f2c still appends that at end of FORMAT-statement
strings. */
int level = 0;
for (f__fmtlen = 0;
((*s != ')') || (--level > 0))
&& (*s != '\0') && (f__fmtlen < 80); ++s, ++f__fmtlen)
{
if (*s == '(')
++level;
}
if (*s == ')')
++f__fmtlen;
return (-1);
}
f__fmtlen = e - s;
return (0);
}
#define STKSZ 10
int f__cnt[STKSZ], f__ret[STKSZ], f__cp, f__rp;
flag f__workdone, f__nonl;
static int
type_f (int n)
{
switch (n)
{
default:
return (n);
case RET1:
return (RET1);
case REVERT:
return (REVERT);
case GOTO:
return (GOTO);
case STACK:
return (STACK);
case X:
case SLASH:
case APOS:
case H:
case T:
case TL:
case TR:
return (NED);
case F:
case I:
case IM:
case A:
case AW:
case O:
case OM:
case L:
case E:
case EE:
case D:
case G:
case GE:
case Z:
case ZM:
return (ED);
}
}
integer
do_fio (ftnint * number, char *ptr, ftnlen len)
{
struct syl *p;
int n, i;
for (i = 0; i < *number; i++, ptr += len)
{
loop:switch (type_f ((p = &f__syl[f__pc])->op))
{
default:
fprintf (stderr, "unknown code in do_fio: %d\n%.*s\n",
p->op, f__fmtlen, f__fmtbuf);
err (f__elist->cierr, 100, "do_fio");
case NED:
if ((*f__doned) (p))
{
f__pc++;
goto loop;
}
f__pc++;
continue;
case ED:
if (f__cnt[f__cp] <= 0)
{
f__cp--;
f__pc++;
goto loop;
}
if (ptr == NULL)
return ((*f__doend) ());
f__cnt[f__cp]--;
f__workdone = 1;
if ((n = (*f__doed) (p, ptr, len)) > 0)
errfl (f__elist->cierr, errno, "fmt");
if (n < 0)
err (f__elist->ciend, (EOF), "fmt");
continue;
case STACK:
f__cnt[++f__cp] = p->p1;
f__pc++;
goto loop;
case RET1:
f__ret[++f__rp] = p->p1;
f__pc++;
goto loop;
case GOTO:
if (--f__cnt[f__cp] <= 0)
{
f__cp--;
f__rp--;
f__pc++;
goto loop;
}
f__pc = 1 + f__ret[f__rp--];
goto loop;
case REVERT:
f__rp = f__cp = 0;
f__pc = p->p1;
if (ptr == NULL)
return ((*f__doend) ());
if (!f__workdone)
return (0);
if ((n = (*f__dorevert) ()) != 0)
return (n);
goto loop;
case COLON:
if (ptr == NULL)
return ((*f__doend) ());
f__pc++;
goto loop;
case NONL:
f__nonl = 1;
f__pc++;
goto loop;
case S:
case SS:
f__cplus = 0;
f__pc++;
goto loop;
case SP:
f__cplus = 1;
f__pc++;
goto loop;
case P:
f__scale = p->p1;
f__pc++;
goto loop;
case BN:
f__cblank = 0;
f__pc++;
goto loop;
case BZ:
f__cblank = 1;
f__pc++;
goto loop;
}
}
return (0);
}
int
en_fio (void)
{
ftnint one = 1;
return (do_fio (&one, (char *) NULL, (ftnint) 0));
}
void
fmt_bg (void)
{
f__workdone = f__cp = f__rp = f__pc = f__cursor = 0;
f__cnt[0] = f__ret[0] = 0;
}
libf2c/libI77/fmt.h deleted 100644 → 0
struct syl
{
int op;
int p1;
union
{
int i[2];
char *s;
}
p2;
};
#define RET1 1
#define REVERT 2
#define GOTO 3
#define X 4
#define SLASH 5
#define STACK 6
#define I 7
#define ED 8
#define NED 9
#define IM 10
#define APOS 11
#define H 12
#define TL 13
#define TR 14
#define T 15
#define COLON 16
#define S 17
#define SP 18
#define SS 19
#define P 20
#define BN 21
#define BZ 22
#define F 23
#define E 24
#define EE 25
#define D 26
#define G 27
#define GE 28
#define L 29
#define A 30
#define AW 31
#define O 32
#define NONL 33
#define OM 34
#define Z 35
#define ZM 36
extern int f__pc, f__parenlvl, f__revloc;
typedef union
{
real pf;
doublereal pd;
}
ufloat;
typedef union
{
short is;
signed char ic;
integer il;
#ifdef Allow_TYQUAD
longint ili;
#endif
}
Uint;
extern int (*f__doed) (struct syl *, char *, ftnlen),
(*f__doned) (struct syl *);
extern int (*f__dorevert) (void);
extern void fmt_bg (void);
extern int pars_f (char *);
extern int rd_ed (struct syl *, char *, ftnlen), rd_ned (struct syl *);
extern int w_ed (struct syl *, char *, ftnlen), w_ned (struct syl *);
extern int wrt_E (ufloat *, int, int, int, ftnlen);
extern int wrt_F (ufloat *, int, int, ftnlen);
extern int wrt_L (Uint *, int, ftnlen);
extern flag f__cblank, f__cplus, f__workdone, f__nonl;
extern char *f__fmtbuf;
extern int f__fmtlen;
extern int f__scale;
#define GET(x) if((x=(*f__getn)())<0) return(x)
#define VAL(x) (x!='\n'?x:' ')
#define PUT(x) (*f__putn)(x)
extern int f__cursor;
#undef TYQUAD
#ifndef Allow_TYQUAD
#undef longint
#define longint long
#else
#define TYQUAD 14
#endif
extern char *f__icvt (longint, int *, int *, int);
libf2c/libI77/fmtlib.c deleted 100644 → 0
/* @(#)fmtlib.c 1.2 */
#define MAXINTLENGTH 23
#include "config.h"
#include "f2c.h"
#ifndef Allow_TYQUAD
#undef longint
#define longint long
#undef ulongint
#define ulongint unsigned long
#endif
char *
f__icvt (longint value, int *ndigit, int *sign, int base)
{
static char buf[MAXINTLENGTH + 1];
register int i;
ulongint uvalue;
if (value > 0)
{
uvalue = value;
*sign = 0;
}
else if (value < 0)
{
uvalue = -value;
*sign = 1;
}
else
{
*sign = 0;
*ndigit = 1;
buf[MAXINTLENGTH - 1] = '0';
return &buf[MAXINTLENGTH - 1];
}
i = MAXINTLENGTH;
do
{
buf[--i] = (uvalue % base) + '0';
uvalue /= base;
}
while (uvalue > 0);
*ndigit = MAXINTLENGTH - i;
return &buf[i];
}
libf2c/libI77/fp.h deleted 100644 → 0
#define FMAX 40
#define EXPMAXDIGS 8
#define EXPMAX 99999999
/* FMAX = max number of nonzero digits passed to atof() */
/* EXPMAX = 10^EXPMAXDIGS - 1 = largest allowed exponent absolute value */
#ifdef V10 /* Research Tenth-Edition Unix */
#include "local.h"
#endif
/* MAXFRACDIGS and MAXINTDIGS are for wrt_F -- bounds (not necessarily
tight) on the maximum number of digits to the right and left of
* the decimal point.
*/
#ifdef VAX
#define MAXFRACDIGS 56
#define MAXINTDIGS 38
#else
#ifdef CRAY
#define MAXFRACDIGS 9880
#define MAXINTDIGS 9864
#else
/* values that suffice for IEEE double */
#define MAXFRACDIGS 344
#define MAXINTDIGS 308
#endif
#endif
libf2c/libI77/ftell_.c deleted 100644 → 0
#include "config.h"
#include "f2c.h"
#include "fio.h"
static FILE *
unit_chk (integer Unit, char *who)
{
if (Unit >= MXUNIT || Unit < 0)
f__fatal (101, who);
return f__units[Unit].ufd;
}
integer
G77_ftell_0 (integer * Unit)
{
FILE *f;
return (f = unit_chk (*Unit, "ftell")) ? (integer) FTELL (f) : -1L;
}
integer
G77_fseek_0 (integer * Unit, integer * offset, integer * xwhence)
{
FILE *f;
int w = (int) *xwhence;
#ifdef SEEK_SET
static int wohin[3] = { SEEK_SET, SEEK_CUR, SEEK_END };
#endif
if (w < 0 || w > 2)
w = 0;
#ifdef SEEK_SET
w = wohin[w];
#endif
return !(f = unit_chk (*Unit, "fseek"))
|| FSEEK (f, (off_t) * offset, w) ? 1 : 0;
}
libf2c/libI77/iio.c deleted 100644 → 0
#include "f2c.h"
#include "fio.h"
#include "fmt.h"
extern char *f__icptr;
char *f__icend;
extern icilist *f__svic;
int f__icnum;
extern int f__hiwater;
int
z_getc (void)
{
if (f__recpos++ < f__svic->icirlen)
{
if (f__icptr >= f__icend)
err (f__svic->iciend, (EOF), "endfile");
return (*(unsigned char *) f__icptr++);
}
return '\n';
}
void
z_putc (int c)
{
if (f__recpos++ < f__svic->icirlen && f__icptr < f__icend)
*f__icptr++ = c;
}
int
z_rnew (void)
{
f__icptr = f__svic->iciunit + (++f__icnum) * f__svic->icirlen;
f__recpos = 0;
f__cursor = 0;
f__hiwater = 0;
return 1;
}
static int
z_endp (void)
{
(*f__donewrec) ();
return 0;
}
int
c_si (icilist * a)
{
if (f__init & 2)
f__fatal (131, "I/O recursion");
f__init |= 2;
f__elist = (cilist *) a;
f__fmtbuf = a->icifmt;
f__curunit = 0;
f__sequential = f__formatted = 1;
f__external = 0;
if (pars_f (f__fmtbuf) < 0)
err (a->icierr, 100, "startint");
fmt_bg ();
f__cblank = f__cplus = f__scale = 0;
f__svic = a;
f__icnum = f__recpos = 0;
f__cursor = 0;
f__hiwater = 0;
f__icptr = a->iciunit;
f__icend = f__icptr + a->icirlen * a->icirnum;
f__cf = 0;
return (0);
}
int
iw_rev (void)
{
if (f__workdone)
z_endp ();
f__hiwater = f__recpos = f__cursor = 0;
return (f__workdone = 0);
}
integer
s_rsfi (icilist * a)
{
int n;
if ((n = c_si (a)))
return (n);
f__reading = 1;
f__doed = rd_ed;
f__doned = rd_ned;
f__getn = z_getc;
f__dorevert = z_endp;
f__donewrec = z_rnew;
f__doend = z_endp;
return (0);
}
int
z_wnew (void)
{
if (f__recpos < f__hiwater)
{
f__icptr += f__hiwater - f__recpos;
f__recpos = f__hiwater;
}
while (f__recpos++ < f__svic->icirlen)
*f__icptr++ = ' ';
f__recpos = 0;
f__cursor = 0;
f__hiwater = 0;
f__icnum++;
return 1;
}
integer
s_wsfi (icilist * a)
{
int n;
if ((n = c_si (a)))
return (n);
f__reading = 0;
f__doed = w_ed;
f__doned = w_ned;
f__putn = z_putc;
f__dorevert = iw_rev;
f__donewrec = z_wnew;
f__doend = z_endp;
return (0);
}
integer
e_rsfi (void)
{
int n;
f__init &= ~2;
n = en_fio ();
f__fmtbuf = NULL;
return (n);
}
integer
e_wsfi (void)
{
int n;
f__init &= ~2;
n = en_fio ();
f__fmtbuf = NULL;
if (f__svic->icirnum != 1
&& (f__icnum > f__svic->icirnum
|| (f__icnum == f__svic->icirnum && (f__recpos | f__hiwater))))
err (f__svic->icierr, 110, "inwrite");
if (f__recpos < f__hiwater)
f__recpos = f__hiwater;
if (f__recpos >= f__svic->icirlen)
err (f__svic->icierr, 110, "recend");
if (!f__recpos && f__icnum)
return n;
while (f__recpos++ < f__svic->icirlen)
*f__icptr++ = ' ';
return n;
}
libf2c/libI77/ilnw.c deleted 100644 → 0
#include "config.h"
#include "f2c.h"
#include "fio.h"
#include "lio.h"
extern char *f__icptr;
extern char *f__icend;
extern icilist *f__svic;
extern int f__icnum;
extern void z_putc (int);
static int
z_wSL (void)
{
while (f__recpos < f__svic->icirlen)
z_putc (' ');
return z_rnew ();
}
static void
c_liw (icilist * a)
{
f__reading = 0;
f__external = 0;
f__formatted = 1;
f__putn = z_putc;
L_len = a->icirlen;
f__donewrec = z_wSL;
f__svic = a;
f__icnum = f__recpos = 0;
f__cursor = 0;
f__cf = 0;
f__curunit = 0;
f__icptr = a->iciunit;
f__icend = f__icptr + a->icirlen * a->icirnum;
f__elist = (cilist *) a;
}
integer
s_wsni (icilist * a)
{
cilist ca;
if (f__init != 1)
f_init ();
f__init = 3;
c_liw (a);
ca.cifmt = a->icifmt;
x_wsne (&ca);
z_wSL ();
return 0;
}
integer
s_wsli (icilist * a)
{
if (f__init != 1)
f_init ();
f__init = 3;
f__lioproc = l_write;
c_liw (a);
return (0);
}
integer
e_wsli (void)
{
f__init = 1;
z_wSL ();
return (0);
}
libf2c/libI77/inquire.c deleted 100644 → 0
#include "config.h"
#include "f2c.h"
#include "fio.h"
#include <string.h>
#if defined (MSDOS) && !defined (GO32)
#undef abs
#undef min
#undef max
#include "io.h"
#endif
integer
f_inqu (inlist * a)
{
flag byfile;
int i, n;
unit *p;
char buf[256];
long x;
if (f__init & 2)
f__fatal (131, "I/O recursion");
if (a->infile != NULL)
{
byfile = 1;
g_char (a->infile, a->infilen, buf);
#ifdef NON_UNIX_STDIO
x = access (buf, 0) ? -1 : 0;
for (i = 0, p = NULL; i < MXUNIT; i++)
if (f__units[i].ufd != NULL
&& f__units[i].ufnm != NULL && !strcmp (f__units[i].ufnm, buf))
{
p = &f__units[i];
break;
}
#else
x = f__inode (buf, &n);
for (i = 0, p = NULL; i < MXUNIT; i++)
if (f__units[i].uinode == x
&& f__units[i].ufd != NULL && f__units[i].udev == n)
{
p = &f__units[i];
break;
}
#endif
}
else
{
byfile = 0;
if (a->inunit < MXUNIT && a->inunit >= 0)
{
p = &f__units[a->inunit];
}
else
{
p = NULL;
}
}
if (a->inex != NULL)
{
if ((byfile && x != -1) || (!byfile && p != NULL))
*a->inex = 1;
else
*a->inex = 0;
}
if (a->inopen != NULL)
{
if (byfile)
*a->inopen = (p != NULL);
else
*a->inopen = (p != NULL && p->ufd != NULL);
}
if (a->innum != NULL)
*a->innum = p - f__units;
if (a->innamed != NULL)
{
if (byfile || (p != NULL && p->ufnm != NULL))
*a->innamed = 1;
else
*a->innamed = 0;
}
if (a->inname != NULL)
{
if (byfile)
b_char (buf, a->inname, a->innamlen);
else if (p != NULL && p->ufnm != NULL)
b_char (p->ufnm, a->inname, a->innamlen);
}
if (a->inacc != NULL && p != NULL && p->ufd != NULL)
{
if (p->url)
b_char ("DIRECT", a->inacc, a->inacclen);
else
b_char ("SEQUENTIAL", a->inacc, a->inacclen);
}
if (a->inseq != NULL)
{
if (p != NULL && p->url)
b_char ("NO", a->inseq, a->inseqlen);
else
b_char ("YES", a->inseq, a->inseqlen);
}
if (a->indir != NULL)
{
if (p == NULL || p->url)
b_char ("YES", a->indir, a->indirlen);
else
b_char ("NO", a->indir, a->indirlen);
}
if (a->infmt != NULL)
{
if (p != NULL && p->ufmt == 0)
b_char ("UNFORMATTED", a->infmt, a->infmtlen);
else
b_char ("FORMATTED", a->infmt, a->infmtlen);
}
if (a->inform != NULL)
{
if (p != NULL && p->ufmt == 0)
b_char ("NO", a->inform, a->informlen);
else
b_char ("YES", a->inform, a->informlen);
}
if (a->inunf)
{
if (p != NULL && p->ufmt == 0)
b_char ("YES", a->inunf, a->inunflen);
else if (p != NULL)
b_char ("NO", a->inunf, a->inunflen);
else
b_char ("UNKNOWN", a->inunf, a->inunflen);
}
if (a->inrecl != NULL && p != NULL)
*a->inrecl = p->url;
if (a->innrec != NULL && p != NULL && p->url > 0)
*a->innrec = FTELL (p->ufd) / p->url + 1;
if (a->inblank && p != NULL && p->ufmt)
{
if (p->ublnk)
b_char ("ZERO", a->inblank, a->inblanklen);
else
b_char ("NULL", a->inblank, a->inblanklen);
}
return (0);
}
libf2c/libI77/lio.h deleted 100644 → 0
/* copy of ftypes from the compiler */
/* variable types
* numeric assumptions:
* int < reals < complexes
* TYDREAL-TYREAL = TYDCOMPLEX-TYCOMPLEX
*/
/* 0-10 retain their old (pre LOGICAL*1, etc.) */
/* values to allow mixing old and new objects. */
#define TYUNKNOWN 0
#define TYADDR 1
#define TYSHORT 2
#define TYLONG 3
#define TYREAL 4
#define TYDREAL 5
#define TYCOMPLEX 6
#define TYDCOMPLEX 7
#define TYLOGICAL 8
#define TYCHAR 9
#define TYSUBR 10
#define TYINT1 11
#define TYLOGICAL1 12
#define TYLOGICAL2 13
#ifdef Allow_TYQUAD
#undef TYQUAD
#define TYQUAD 14
#endif
#define LINTW 24
#define LINE 80
#define LLOGW 2
#ifdef Old_list_output
#define LLOW 1.0
#define LHIGH 1.e9
#define LEFMT " %# .8E"
#define LFFMT " %# .9g"
#else
#define LGFMT "%.9G"
#endif
/* LEFBL 20 should suffice; 24 overcomes a NeXT bug. */
#define LEFBL 24
typedef union
{
signed char flchar;
short flshort;
ftnint flint;
#ifdef Allow_TYQUAD
longint fllongint;
#endif
real flreal;
doublereal fldouble;
}
flex;
extern int f__scale;
extern int (*f__lioproc) (ftnint *, char *, ftnlen, ftnint);
extern int l_write (ftnint *, char *, ftnlen, ftnint);
extern void x_wsne (cilist *);
extern int c_le (cilist *), (*l_getc) (void), (*l_ungetc) (int, FILE *);
extern int l_read (ftnint *, char *, ftnlen, ftnint);
extern integer e_rsle (void), e_wsle (void), s_wsne (cilist *);
extern int z_rnew (void);
extern ftnint L_len;
libf2c/libI77/lread.c deleted 100644 → 0
#include "config.h"
#include <ctype.h>
#include "f2c.h"
#include "fio.h"
/* Compile with -DF8X_NML_ELIDE_QUOTES to permit eliding quotation */
/* marks in namelist input a la the Fortran 8X Draft published in */
/* the May 1989 issue of Fortran Forum. */
extern char *f__fmtbuf;
extern int f__fmtlen;
#ifdef Allow_TYQUAD
static longint f__llx;
#endif
#undef abs
#undef min
#undef max
#include <stdlib.h>
#include "fmt.h"
#include "lio.h"
#include "fp.h"
int (*f__lioproc) (ftnint *, char *, ftnlen, ftnint), (*l_getc) (void),
(*l_ungetc) (int, FILE *);
int l_eof;
#define isblnk(x) (f__ltab[x+1]&B)
#define issep(x) (f__ltab[x+1]&SX)
#define isapos(x) (f__ltab[x+1]&AX)
#define isexp(x) (f__ltab[x+1]&EX)
#define issign(x) (f__ltab[x+1]&SG)
#define iswhit(x) (f__ltab[x+1]&WH)
#define SX 1
#define B 2
#define AX 4
#define EX 8
#define SG 16
#define WH 32
char f__ltab[128 + 1] = { /* offset one for EOF */
0,
0, 0, AX, 0, 0, 0, 0, 0, 0, WH | B, SX | WH, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
SX | B | WH, 0, AX, 0, 0, 0, 0, AX, 0, 0, 0, SG, SX, SG, 0, SX,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, EX, EX, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
AX, 0, 0, 0, EX, EX, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0
};
#ifdef ungetc
static int
un_getc (int x, FILE * f__cf)
{
return ungetc (x, f__cf);
}
#else
#define un_getc ungetc
extern int ungetc (int, FILE *); /* for systems with a buggy stdio.h */
#endif
int
t_getc (void)
{
int ch;
if (f__curunit->uend)
return (EOF);
if ((ch = getc (f__cf)) != EOF)
return (ch);
if (feof (f__cf))
f__curunit->uend = l_eof = 1;
return (EOF);
}
integer
e_rsle (void)
{
int ch;
f__init = 1;
if (f__curunit->uend)
return (0);
while ((ch = t_getc ()) != '\n')
if (ch == EOF)
{
if (feof (f__cf))
f__curunit->uend = l_eof = 1;
return EOF;
}
return (0);
}
flag f__lquit;
int f__lcount, f__ltype, nml_read;
char *f__lchar;
double f__lx, f__ly;
#define ERR(x) if((n=(x))) {f__init &= ~2; return(n);}
#define GETC(x) (x=(*l_getc)())
#define Ungetc(x,y) (*l_ungetc)(x,y)
static int
l_R (int poststar, int reqint)
{
char s[FMAX + EXPMAXDIGS + 4];
register int ch;
register char *sp, *spe, *sp1;
long e, exp;
int havenum, havestar, se;
if (!poststar)
{
if (f__lcount > 0)
return (0);
f__lcount = 1;
}
#ifdef Allow_TYQUAD
f__llx = 0;
#endif
f__ltype = 0;
exp = 0;
havestar = 0;
retry:
sp1 = sp = s;
spe = sp + FMAX;
havenum = 0;
switch (GETC (ch))
{
case '-':
*sp++ = ch;
sp1++;
spe++;
case '+':
GETC (ch);
}
while (ch == '0')
{
++havenum;
GETC (ch);
}
while (isdigit (ch))
{
if (sp < spe)
*sp++ = ch;
else
++exp;
GETC (ch);
}
if (ch == '*' && !poststar)
{
if (sp == sp1 || exp || *s == '-')
{
errfl (f__elist->cierr, 112, "bad repetition count");
}
poststar = havestar = 1;
*sp = 0;
f__lcount = atoi (s);
goto retry;
}
if (ch == '.')
{
#ifndef ALLOW_FLOAT_IN_INTEGER_LIST_INPUT
if (reqint)
errfl (f__elist->cierr, 115, "invalid integer");
#endif
GETC (ch);
if (sp == sp1)
while (ch == '0')
{
++havenum;
--exp;
GETC (ch);
}
while (isdigit (ch))
{
if (sp < spe)
{
*sp++ = ch;
--exp;
}
GETC (ch);
}
}
havenum += sp - sp1;
se = 0;
if (issign (ch))
goto signonly;
if (havenum && isexp (ch))
{
#ifndef ALLOW_FLOAT_IN_INTEGER_LIST_INPUT
if (reqint)
errfl (f__elist->cierr, 115, "invalid integer");
#endif
GETC (ch);
if (issign (ch))
{
signonly:
if (ch == '-')
se = 1;
GETC (ch);
}
if (!isdigit (ch))
{
bad:
errfl (f__elist->cierr, 112, "exponent field");
}
e = ch - '0';
while (isdigit (GETC (ch)))
{
e = 10 * e + ch - '0';
if (e > EXPMAX)
goto bad;
}
if (se)
exp -= e;
else
exp += e;
}
(void) Ungetc (ch, f__cf);
if (sp > sp1)
{
++havenum;
while (*--sp == '0')
++exp;
if (exp)
sprintf (sp + 1, "e%ld", exp);
else
sp[1] = 0;
f__lx = atof (s);
#ifdef Allow_TYQUAD
if (reqint & 2 && (se = sp - sp1 + exp) > 14 && se < 20)
{
/* Assuming 64-bit longint and 32-bit long. */
if (exp < 0)
sp += exp;
if (sp1 <= sp)
{
f__llx = *sp1 - '0';
while (++sp1 <= sp)
f__llx = 10 * f__llx + (*sp1 - '0');
}
while (--exp >= 0)
f__llx *= 10;
if (*s == '-')
f__llx = -f__llx;
}
#endif
}
else
f__lx = 0.;
if (havenum)
f__ltype = TYLONG;
else
switch (ch)
{
case ',':
case '/':
break;
default:
if (havestar && (ch == ' ' || ch == '\t' || ch == '\n'))
break;
if (nml_read > 1)
{
f__lquit = 2;
return 0;
}
errfl (f__elist->cierr, 112, "invalid number");
}
return 0;
}
static int
rd_count (register int ch)
{
if (ch < '0' || ch > '9')
return 1;
f__lcount = ch - '0';
while (GETC (ch) >= '0' && ch <= '9')
f__lcount = 10 * f__lcount + ch - '0';
Ungetc (ch, f__cf);
return f__lcount <= 0;
}
static int
l_C (void)
{
int ch, nml_save;
double lz;
if (f__lcount > 0)
return (0);
f__ltype = 0;
GETC (ch);
if (ch != '(')
{
if (nml_read > 1 && (ch < '0' || ch > '9'))
{
Ungetc (ch, f__cf);
f__lquit = 2;
return 0;
}
if (rd_count (ch))
{
if (!f__cf || !feof (f__cf))
errfl (f__elist->cierr, 112, "complex format");
else
err (f__elist->cierr, (EOF), "lread");
}
if (GETC (ch) != '*')
{
if (!f__cf || !feof (f__cf))
errfl (f__elist->cierr, 112, "no star");
else
err (f__elist->cierr, (EOF), "lread");
}
if (GETC (ch) != '(')
{
Ungetc (ch, f__cf);
return (0);
}
}
else
f__lcount = 1;
while (iswhit (GETC (ch)));
Ungetc (ch, f__cf);
nml_save = nml_read;
nml_read = 0;
if ((ch = l_R (1, 0)))
return ch;
if (!f__ltype)
errfl (f__elist->cierr, 112, "no real part");
lz = f__lx;
while (iswhit (GETC (ch)));
if (ch != ',')
{
(void) Ungetc (ch, f__cf);
errfl (f__elist->cierr, 112, "no comma");
}
while (iswhit (GETC (ch)));
(void) Ungetc (ch, f__cf);
if ((ch = l_R (1, 0)))
return ch;
if (!f__ltype)
errfl (f__elist->cierr, 112, "no imaginary part");
while (iswhit (GETC (ch)));
if (ch != ')')
errfl (f__elist->cierr, 112, "no )");
f__ly = f__lx;
f__lx = lz;
#ifdef Allow_TYQUAD
f__llx = 0;
#endif
nml_read = nml_save;
return (0);
}
static char nmLbuf[256], *nmL_next;
static int (*nmL_getc_save) (void);
static int (*nmL_ungetc_save) (int, FILE *);
static int
nmL_getc (void)
{
int rv;
if ((rv = *nmL_next++))
return rv;
l_getc = nmL_getc_save;
l_ungetc = nmL_ungetc_save;
return (*l_getc) ();
}
static int
nmL_ungetc (int x, FILE * f)
{
f = f; /* banish non-use warning */
return *--nmL_next = x;
}
static int
Lfinish (int ch, int dot, int *rvp)
{
char *s, *se;
static char what[] = "namelist input";
s = nmLbuf + 2;
se = nmLbuf + sizeof (nmLbuf) - 1;
*s++ = ch;
while (!issep (GETC (ch)) && ch != EOF)
{
if (s >= se)
{
nmLbuf_ovfl:
return *rvp = err__fl (f__elist->cierr, 131, what);
}
*s++ = ch;
if (ch != '=')
continue;
if (dot)
return *rvp = err__fl (f__elist->cierr, 112, what);
got_eq:
*s = 0;
nmL_getc_save = l_getc;
l_getc = nmL_getc;
nmL_ungetc_save = l_ungetc;
l_ungetc = nmL_ungetc;
nmLbuf[1] = *(nmL_next = nmLbuf) = ',';
*rvp = f__lcount = 0;
return 1;
}
if (dot)
goto done;
for (;;)
{
if (s >= se)
goto nmLbuf_ovfl;
*s++ = ch;
if (!isblnk (ch))
break;
if (GETC (ch) == EOF)
goto done;
}
if (ch == '=')
goto got_eq;
done:
Ungetc (ch, f__cf);
return 0;
}
static int
l_L (void)
{
int ch, rv, sawdot;
if (f__lcount > 0)
return (0);
f__lcount = 1;
f__ltype = 0;
GETC (ch);
if (isdigit (ch))
{
rd_count (ch);
if (GETC (ch) != '*')
{
if (!f__cf || !feof (f__cf))
errfl (f__elist->cierr, 112, "no star");
else
err (f__elist->cierr, (EOF), "lread");
}
GETC (ch);
}
sawdot = 0;
if (ch == '.')
{
sawdot = 1;
GETC (ch);
}
switch (ch)
{
case 't':
case 'T':
if (nml_read && Lfinish (ch, sawdot, &rv))
return rv;
f__lx = 1;
break;
case 'f':
case 'F':
if (nml_read && Lfinish (ch, sawdot, &rv))
return rv;
f__lx = 0;
break;
default:
if (isblnk (ch) || issep (ch) || ch == EOF)
{
(void) Ungetc (ch, f__cf);
return (0);
}
if (nml_read > 1)
{
Ungetc (ch, f__cf);
f__lquit = 2;
return 0;
}
errfl (f__elist->cierr, 112, "logical");
}
f__ltype = TYLONG;
while (!issep (GETC (ch)) && ch != EOF);
(void) Ungetc (ch, f__cf);
return (0);
}
#define BUFSIZE 128
static int
l_CHAR (void)
{
int ch, size, i;
static char rafail[] = "realloc failure";
char quote, *p;
if (f__lcount > 0)
return (0);
f__ltype = 0;
if (f__lchar != NULL)
free (f__lchar);
size = BUFSIZE;
p = f__lchar = (char *) malloc ((unsigned int) size);
if (f__lchar == NULL)
errfl (f__elist->cierr, 113, "no space");
GETC (ch);
if (isdigit (ch))
{
/* allow Fortran 8x-style unquoted string... */
/* either find a repetition count or the string */
f__lcount = ch - '0';
*p++ = ch;
for (i = 1;;)
{
switch (GETC (ch))
{
case '*':
if (f__lcount == 0)
{
f__lcount = 1;
#ifndef F8X_NML_ELIDE_QUOTES
if (nml_read)
goto no_quote;
#endif
goto noquote;
}
p = f__lchar;
goto have_lcount;
case ',':
case ' ':
case '\t':
case '\n':
case '/':
Ungetc (ch, f__cf);
/* no break */
case EOF:
f__lcount = 1;
f__ltype = TYCHAR;
return *p = 0;
}
if (!isdigit (ch))
{
f__lcount = 1;
#ifndef F8X_NML_ELIDE_QUOTES
if (nml_read)
{
no_quote:
errfl (f__elist->cierr, 112,
"undelimited character string");
}
#endif
goto noquote;
}
*p++ = ch;
f__lcount = 10 * f__lcount + ch - '0';
if (++i == size)
{
f__lchar = (char *) realloc (f__lchar,
(unsigned int) (size += BUFSIZE));
if (f__lchar == NULL)
errfl (f__elist->cierr, 113, rafail);
p = f__lchar + i;
}
}
}
else
(void) Ungetc (ch, f__cf);
have_lcount:
if (GETC (ch) == '\'' || ch == '"')
quote = ch;
else if (isblnk (ch) || (issep (ch) && ch != '\n') || ch == EOF)
{
Ungetc (ch, f__cf);
return 0;
}
#ifndef F8X_NML_ELIDE_QUOTES
else if (nml_read > 1)
{
Ungetc (ch, f__cf);
f__lquit = 2;
return 0;
}
#endif
else
{
/* Fortran 8x-style unquoted string */
*p++ = ch;
for (i = 1;;)
{
switch (GETC (ch))
{
case ',':
case ' ':
case '\t':
case '\n':
case '/':
Ungetc (ch, f__cf);
/* no break */
case EOF:
f__ltype = TYCHAR;
return *p = 0;
}
noquote:
*p++ = ch;
if (++i == size)
{
f__lchar = (char *) realloc (f__lchar,
(unsigned int) (size += BUFSIZE));
if (f__lchar == NULL)
errfl (f__elist->cierr, 113, rafail);
p = f__lchar + i;
}
}
}
f__ltype = TYCHAR;
for (i = 0;;)
{
while (GETC (ch) != quote && ch != '\n' && ch != EOF && ++i < size)
*p++ = ch;
if (i == size)
{
newone:
f__lchar = (char *) realloc (f__lchar,
(unsigned int) (size += BUFSIZE));
if (f__lchar == NULL)
errfl (f__elist->cierr, 113, rafail);
p = f__lchar + i - 1;
*p++ = ch;
}
else if (ch == EOF)
return (EOF);
else if (ch == '\n')
{
if (*(p - 1) != '\\')
continue;
i--;
p--;
if (++i < size)
*p++ = ch;
else
goto newone;
}
else if (GETC (ch) == quote)
{
if (++i < size)
*p++ = ch;
else
goto newone;
}
else
{
(void) Ungetc (ch, f__cf);
*p = 0;
return (0);
}
}
}
int
c_le (cilist * a)
{
if (f__init != 1)
f_init ();
f__init = 3;
f__fmtbuf = "list io";
f__curunit = &f__units[a->ciunit];
f__fmtlen = 7;
if (a->ciunit >= MXUNIT || a->ciunit < 0)
err (a->cierr, 101, "stler");
f__scale = f__recpos = 0;
f__elist = a;
if (f__curunit->ufd == NULL && fk_open (SEQ, FMT, a->ciunit))
err (a->cierr, 102, "lio");
f__cf = f__curunit->ufd;
if (!f__curunit->ufmt)
err (a->cierr, 103, "lio");
return (0);
}
int
l_read (ftnint * number, char *ptr, ftnlen len, ftnint type)
{
#define Ptr ((flex *)ptr)
int i, n, ch;
doublereal *yy;
real *xx;
for (i = 0; i < *number; i++)
{
if (f__lquit)
return (0);
if (l_eof)
err (f__elist->ciend, EOF, "list in");
if (f__lcount == 0)
{
f__ltype = 0;
for (;;)
{
GETC (ch);
switch (ch)
{
case EOF:
err (f__elist->ciend, (EOF), "list in");
case ' ':
case '\t':
case '\n':
continue;
case '/':
f__lquit = 1;
goto loopend;
case ',':
f__lcount = 1;
goto loopend;
default:
(void) Ungetc (ch, f__cf);
goto rddata;
}
}
}
rddata:
switch ((int) type)
{
case TYINT1:
case TYSHORT:
case TYLONG:
#ifndef ALLOW_FLOAT_IN_INTEGER_LIST_INPUT
ERR (l_R (0, 1));
break;
#endif
case TYREAL:
case TYDREAL:
ERR (l_R (0, 0));
break;
#ifdef TYQUAD
case TYQUAD:
n = l_R (0, 2);
if (n)
return n;
break;
#endif
case TYCOMPLEX:
case TYDCOMPLEX:
ERR (l_C ());
break;
case TYLOGICAL1:
case TYLOGICAL2:
case TYLOGICAL:
ERR (l_L ());
break;
case TYCHAR:
ERR (l_CHAR ());
break;
}
while (GETC (ch) == ' ' || ch == '\t');
if (ch != ',' || f__lcount > 1)
Ungetc (ch, f__cf);
loopend:
if (f__lquit)
return (0);
if (f__cf && ferror (f__cf))
{
clearerr (f__cf);
errfl (f__elist->cierr, errno, "list in");
}
if (f__ltype == 0)
goto bump;
switch ((int) type)
{
case TYINT1:
case TYLOGICAL1:
Ptr->flchar = (char) f__lx;
break;
case TYLOGICAL2:
case TYSHORT:
Ptr->flshort = (short) f__lx;
break;
case TYLOGICAL:
case TYLONG:
Ptr->flint = (ftnint) f__lx;
break;
#ifdef Allow_TYQUAD
case TYQUAD:
if (!(Ptr->fllongint = f__llx))
Ptr->fllongint = f__lx;
break;
#endif
case TYREAL:
Ptr->flreal = f__lx;
break;
case TYDREAL:
Ptr->fldouble = f__lx;
break;
case TYCOMPLEX:
xx = (real *) ptr;
*xx++ = f__lx;
*xx = f__ly;
break;
case TYDCOMPLEX:
yy = (doublereal *) ptr;
*yy++ = f__lx;
*yy = f__ly;
break;
case TYCHAR:
b_char (f__lchar, ptr, len);
break;
}
bump:
if (f__lcount > 0)
f__lcount--;
ptr += len;
if (nml_read)
nml_read++;
}
return (0);
#undef Ptr
}
integer
s_rsle (cilist * a)
{
int n;
f__reading = 1;
f__external = 1;
f__formatted = 1;
if ((n = c_le (a)))
return (n);
f__lioproc = l_read;
f__lquit = 0;
f__lcount = 0;
l_eof = 0;
if (f__curunit->uwrt && f__nowreading (f__curunit))
err (a->cierr, errno, "read start");
if (f__curunit->uend)
err (f__elist->ciend, (EOF), "read start");
l_getc = t_getc;
l_ungetc = un_getc;
f__doend = xrd_SL;
return (0);
}
libf2c/libI77/lwrite.c deleted 100644 → 0
#include "f2c.h"
#include "fio.h"
#include "fmt.h"
#include "lio.h"
ftnint L_len;
int f__Aquote;
static void
donewrec (void)
{
if (f__recpos)
(*f__donewrec) ();
}
static void
lwrt_I (longint n)
{
char *p;
int ndigit, sign;
p = f__icvt (n, &ndigit, &sign, 10);
if (f__recpos + ndigit >= L_len)
donewrec ();
PUT (' ');
if (sign)
PUT ('-');
while (*p)
PUT (*p++);
}
static void
lwrt_L (ftnint n, ftnlen len)
{
if (f__recpos + LLOGW >= L_len)
donewrec ();
wrt_L ((Uint *) & n, LLOGW, len);
}
static void
lwrt_A (char *p, ftnlen len)
{
int a;
char *p1, *pe;
a = 0;
pe = p + len;
if (f__Aquote)
{
a = 3;
if (len > 1 && p[len - 1] == ' ')
{
while (--len > 1 && p[len - 1] == ' ');
pe = p + len;
}
p1 = p;
while (p1 < pe)
if (*p1++ == '\'')
a++;
}
if (f__recpos + len + a >= L_len)
donewrec ();
if (a
#ifndef OMIT_BLANK_CC
|| !f__recpos
#endif
)
PUT (' ');
if (a)
{
PUT ('\'');
while (p < pe)
{
if (*p == '\'')
PUT ('\'');
PUT (*p++);
}
PUT ('\'');
}
else
while (p < pe)
PUT (*p++);
}
static int
l_g (char *buf, double n)
{
#ifdef Old_list_output
doublereal absn;
char *fmt;
absn = n;
if (absn < 0)
absn = -absn;
fmt = LLOW <= absn && absn < LHIGH ? LFFMT : LEFMT;
#ifdef USE_STRLEN
sprintf (buf, fmt, n);
return strlen (buf);
#else
return sprintf (buf, fmt, n);
#endif
#else
register char *b, c, c1;
b = buf;
*b++ = ' ';
if (n < 0)
{
*b++ = '-';
n = -n;
}
else
*b++ = ' ';
if (n == 0)
{
*b++ = '0';
*b++ = '.';
*b = 0;
goto f__ret;
}
sprintf (b, LGFMT, n);
switch (*b)
{
#ifndef WANT_LEAD_0
case '0':
while (b[0] = b[1])
b++;
break;
#endif
case 'i':
case 'I':
/* Infinity */
case 'n':
case 'N':
/* NaN */
while (*++b);
break;
default:
/* Fortran 77 insists on having a decimal point... */
for (;; b++)
switch (*b)
{
case 0:
*b++ = '.';
*b = 0;
goto f__ret;
case '.':
while (*++b);
goto f__ret;
case 'E':
for (c1 = '.', c = 'E'; (*b = c1); c1 = c, c = *++b);
goto f__ret;
}
}
f__ret:
return b - buf;
#endif
}
static void
l_put (register char *s)
{
register void (*pn) (int) = f__putn;
register int c;
while ((c = *s++))
(*pn) (c);
}
static void
lwrt_F (double n)
{
char buf[LEFBL];
if (f__recpos + l_g (buf, n) >= L_len)
donewrec ();
l_put (buf);
}
static void
lwrt_C (double a, double b)
{
char *ba, *bb, bufa[LEFBL], bufb[LEFBL];
int al, bl;
al = l_g (bufa, a);
for (ba = bufa; *ba == ' '; ba++)
--al;
bl = l_g (bufb, b) + 1; /* intentionally high by 1 */
for (bb = bufb; *bb == ' '; bb++)
--bl;
if (f__recpos + al + bl + 3 >= L_len)
donewrec ();
#ifdef OMIT_BLANK_CC
else
#endif
PUT (' ');
PUT ('(');
l_put (ba);
PUT (',');
if (f__recpos + bl >= L_len)
{
(*f__donewrec) ();
#ifndef OMIT_BLANK_CC
PUT (' ');
#endif
}
l_put (bb);
PUT (')');
}
int
l_write (ftnint * number, char *ptr, ftnlen len, ftnint type)
{
#define Ptr ((flex *)ptr)
int i;
longint x;
double y, z;
real *xx;
doublereal *yy;
for (i = 0; i < *number; i++)
{
switch ((int) type)
{
default:
f__fatal (204, "unknown type in lio");
case TYINT1:
x = Ptr->flchar;
goto xint;
case TYSHORT:
x = Ptr->flshort;
goto xint;
#ifdef Allow_TYQUAD
case TYQUAD:
x = Ptr->fllongint;
goto xint;
#endif
case TYLONG:
x = Ptr->flint;
xint:lwrt_I (x);
break;
case TYREAL:
y = Ptr->flreal;
goto xfloat;
case TYDREAL:
y = Ptr->fldouble;
xfloat:lwrt_F (y);
break;
case TYCOMPLEX:
xx = &Ptr->flreal;
y = *xx++;
z = *xx;
goto xcomplex;
case TYDCOMPLEX:
yy = &Ptr->fldouble;
y = *yy++;
z = *yy;
xcomplex:
lwrt_C (y, z);
break;
case TYLOGICAL1:
x = Ptr->flchar;
goto xlog;
case TYLOGICAL2:
x = Ptr->flshort;
goto xlog;
case TYLOGICAL:
x = Ptr->flint;
xlog:lwrt_L (Ptr->flint, len);
break;
case TYCHAR:
lwrt_A (ptr, len);
break;
}
ptr += len;
}
return (0);
}
libf2c/libI77/makefile.netlib deleted 100644 → 0
.SUFFIXES: .c .o
CC = cc
CFLAGS = -O
SHELL = /bin/sh
# compile, then strip unnecessary symbols
.c.o:
$(CC) -c -DSkip_f2c_Undefs $(CFLAGS) $*.c
ld -r -x -o $*.xxx $*.o
mv $*.xxx $*.o
## Under Solaris (and other systems that do not understand ld -x),
## omit -x in the ld line above.
## If your system does not have the ld command, comment out
## or remove both the ld and mv lines above.
OBJ = Version.o backspace.o close.o dfe.o dolio.o due.o endfile.o err.o \
fmt.o fmtlib.o ftell_.o iio.o ilnw.o inquire.o lread.o lwrite.o \
open.o rdfmt.o rewind.o rsfe.o rsli.o rsne.o sfe.o sue.o typesize.o \
uio.o util.o wref.o wrtfmt.o wsfe.o wsle.o wsne.o xwsne.o
libI77.a: $(OBJ)
ar r libI77.a $?
-ranlib libI77.a
### If your system lacks ranlib, you don't need it; see README.
install: libI77.a
cp libI77.a /usr/lib/libI77.a
ranlib /usr/lib/libI77.a
Version.o: Version.c
$(CC) -c Version.c
# To compile with C++, first "make f2c.h"
f2c.h: f2ch.add
cat /usr/include/f2c.h f2ch.add >f2c.h
clean:
rm -f $(OBJ) libI77.a
clobber: clean
rm -f libI77.a
backspace.o: fio.h
close.o: fio.h
dfe.o: fio.h
dfe.o: fmt.h
due.o: fio.h
endfile.o: fio.h rawio.h
err.o: fio.h rawio.h
fmt.o: fio.h
fmt.o: fmt.h
ftell_.o: fio.h
iio.o: fio.h
iio.o: fmt.h
ilnw.o: fio.h
ilnw.o: lio.h
inquire.o: fio.h
lread.o: fio.h
lread.o: fmt.h
lread.o: lio.h
lread.o: fp.h
lwrite.o: fio.h
lwrite.o: fmt.h
lwrite.o: lio.h
open.o: fio.h rawio.h
rdfmt.o: fio.h
rdfmt.o: fmt.h
rdfmt.o: fp.h
rewind.o: fio.h
rsfe.o: fio.h
rsfe.o: fmt.h
rsli.o: fio.h
rsli.o: lio.h
rsne.o: fio.h
rsne.o: lio.h
sfe.o: fio.h
sue.o: fio.h
uio.o: fio.h
util.o: fio.h
wref.o: fio.h
wref.o: fmt.h
wref.o: fp.h
wrtfmt.o: fio.h
wrtfmt.o: fmt.h
wsfe.o: fio.h
wsfe.o: fmt.h
wsle.o: fio.h
wsle.o: fmt.h
wsle.o: lio.h
wsne.o: fio.h
wsne.o: lio.h
xwsne.o: fio.h
xwsne.o: lio.h
xwsne.o: fmt.h
check:
xsum Notice README Version.c backspace.c close.c dfe.c dolio.c \
due.c endfile.c err.c f2ch.add fio.h fmt.c fmt.h fmtlib.c fp.h \
ftell_.c iio.c ilnw.c inquire.c lio.h lread.c lwrite.c makefile \
open.c rawio.h rdfmt.c rewind.c rsfe.c rsli.c rsne.c sfe.c sue.c \
typesize.c uio.c util.c wref.c wrtfmt.c wsfe.c wsle.c wsne.c \
xwsne.c >zap
cmp zap libI77.xsum && rm zap || diff libI77.xsum zap
libf2c/libI77/open.c deleted 100644 → 0
#include "config.h"
#include "f2c.h"
#include "fio.h"
#include <string.h>
#ifndef NON_POSIX_STDIO
#ifdef MSDOS
#include "io.h"
#else
#include "unistd.h" /* for access */
#endif
#endif
#undef abs
#undef min
#undef max
#include <stdlib.h>
extern int f__canseek (FILE *);
extern integer f_clos (cllist *);
#ifdef NON_ANSI_RW_MODES
char *f__r_mode[2] = { "r", "r" };
char *f__w_mode[4] = { "w", "w", "r+w", "r+w" };
#else
char *f__r_mode[2] = { "rb", "r" };
char *f__w_mode[4] = { "wb", "w", "r+b", "r+" };
#endif
static char f__buf0[400], *f__buf = f__buf0;
int f__buflen = (int) sizeof (f__buf0);
static void
f__bufadj (int n, int c)
{
unsigned int len;
char *nbuf, *s, *t, *te;
if (f__buf == f__buf0)
f__buflen = 1024;
while (f__buflen <= n)
f__buflen <<= 1;
len = (unsigned int) f__buflen;
if (len != f__buflen || !(nbuf = (char *) malloc (len)))
f__fatal (113, "malloc failure");
s = nbuf;
t = f__buf;
te = t + c;
while (t < te)
*s++ = *t++;
if (f__buf != f__buf0)
free (f__buf);
f__buf = nbuf;
}
int
f__putbuf (int c)
{
char *s, *se;
int n;
if (f__hiwater > f__recpos)
f__recpos = f__hiwater;
n = f__recpos + 1;
if (n >= f__buflen)
f__bufadj (n, f__recpos);
s = f__buf;
se = s + f__recpos;
if (c)
*se++ = c;
*se = 0;
for (;;)
{
fputs (s, f__cf);
s += strlen (s);
if (s >= se)
break; /* normally happens the first time */
putc (*s++, f__cf);
}
return 0;
}
void
x_putc (int c)
{
if (f__recpos >= f__buflen)
f__bufadj (f__recpos, f__buflen);
f__buf[f__recpos++] = c;
}
#define opnerr(f,m,s) \
do {if(f) {f__init &= ~2; errno= m;} else opn_err(m,s,a); return(m);} while(0)
static void
opn_err (int m, char *s, olist * a)
{
if (a->ofnm)
{
/* supply file name to error message */
if (a->ofnmlen >= f__buflen)
f__bufadj ((int) a->ofnmlen, 0);
g_char (a->ofnm, a->ofnmlen, f__curunit->ufnm = f__buf);
}
f__fatal (m, s);
}
integer
f_open (olist * a)
{
unit *b;
integer rv;
char buf[256], *s, *env;
cllist x;
int ufmt;
FILE *tf;
int fd, len;
#ifndef NON_UNIX_STDIO
int n;
#endif
if (f__init != 1)
f_init ();
f__external = 1;
if (a->ounit >= MXUNIT || a->ounit < 0)
err (a->oerr, 101, "open");
f__curunit = b = &f__units[a->ounit];
if (b->ufd)
{
if (a->ofnm == 0)
{
same:if (a->oblnk)
b->ublnk = *a->oblnk == 'z' || *a->oblnk == 'Z';
return (0);
}
#ifdef NON_UNIX_STDIO
if (b->ufnm
&& strlen (b->ufnm) == a->ofnmlen
&& !strncmp (b->ufnm, a->ofnm, (unsigned) a->ofnmlen))
goto same;
#else
g_char (a->ofnm, a->ofnmlen, buf);
if (f__inode (buf, &n) == b->uinode && n == b->udev)
goto same;
#endif
x.cunit = a->ounit;
x.csta = 0;
x.cerr = a->oerr;
if ((rv = f_clos (&x)) != 0)
return rv;
}
b->url = (int) a->orl;
b->ublnk = a->oblnk && (*a->oblnk == 'z' || *a->oblnk == 'Z');
if (a->ofm == 0)
if ((a->oacc) && (*a->oacc == 'D' || *a->oacc == 'd'))
b->ufmt = 0;
else
b->ufmt = 1;
else if (*a->ofm == 'f' || *a->ofm == 'F')
b->ufmt = 1;
else
b->ufmt = 0;
ufmt = b->ufmt;
#ifdef url_Adjust
if (b->url && !ufmt)
url_Adjust (b->url);
#endif
if (a->ofnm)
{
g_char (a->ofnm, a->ofnmlen, buf);
if (!buf[0])
opnerr (a->oerr, 107, "open");
}
else
sprintf (buf, "fort.%ld", (long) a->ounit);
b->uscrtch = 0;
b->uend = 0;
b->uwrt = 0;
b->ufd = 0;
b->urw = 3;
switch (a->osta ? *a->osta : 'u')
{
case 'o':
case 'O':
#ifdef NON_POSIX_STDIO
if (!(tf = fopen (buf, "r")))
opnerr (a->oerr, errno, "open");
fclose (tf);
#else
if (access (buf, 0))
opnerr (a->oerr, errno, "open");
#endif
break;
case 's':
case 'S':
b->uscrtch = 1;
#ifdef HAVE_MKSTEMP /* Allow use of TMPDIR preferentially. */
env = getenv ("TMPDIR");
if (!env)
env = getenv ("TEMP");
if (!env)
env = "/tmp";
len = strlen (env);
if (len > 256 - (int) sizeof ("/tmp.FXXXXXX"))
err (a->oerr, 132, "open");
strcpy (buf, env);
strcat (buf, "/tmp.FXXXXXX");
fd = mkstemp (buf);
if (fd == -1 || close (fd))
err (a->oerr, 132, "open");
#else /* ! defined (HAVE_MKSTEMP) */
#ifdef HAVE_TEMPNAM /* Allow use of TMPDIR preferentially. */
s = tempnam (0, buf);
if (strlen (s) >= sizeof (buf))
err (a->oerr, 132, "open");
(void) strcpy (buf, s);
free (s);
#else /* ! defined (HAVE_TEMPNAM) */
#ifdef HAVE_TMPNAM
tmpnam (buf);
#else
(void) strcpy (buf, "tmp.FXXXXXX");
(void) mktemp (buf);
#endif
#endif /* ! defined (HAVE_TEMPNAM) */
#endif /* ! defined (HAVE_MKSTEMP) */
goto replace;
case 'n':
case 'N':
#ifdef NON_POSIX_STDIO
if ((tf = fopen (buf, "r")) || (tf = fopen (buf, "a")))
{
fclose (tf);
opnerr (a->oerr, 128, "open");
}
#else
if (!access (buf, 0))
opnerr (a->oerr, 128, "open");
#endif
/* no break */
case 'r': /* Fortran 90 replace option */
case 'R':
replace:
if ((tf = fopen (buf, f__w_mode[0])))
fclose (tf);
}
b->ufnm = (char *) malloc ((unsigned int) (strlen (buf) + 1));
if (b->ufnm == NULL)
opnerr (a->oerr, 113, "no space");
(void) strcpy (b->ufnm, buf);
if ((s = a->oacc) && b->url)
ufmt = 0;
if (!(tf = fopen (buf, f__w_mode[ufmt | 2])))
{
if ((tf = fopen (buf, f__r_mode[ufmt])))
b->urw = 1;
else if ((tf = fopen (buf, f__w_mode[ufmt])))
{
b->uwrt = 1;
b->urw = 2;
}
else
err (a->oerr, errno, "open");
}
b->useek = f__canseek (b->ufd = tf);
#ifndef NON_UNIX_STDIO
if ((b->uinode = f__inode (buf, &b->udev)) == -1)
opnerr (a->oerr, 108, "open");
#endif
if (b->useek)
{
if (a->orl)
FSEEK (b->ufd, 0, SEEK_SET);
else if ((s = a->oacc) && (*s == 'a' || *s == 'A')
&& FSEEK (b->ufd, 0, SEEK_END))
opnerr (a->oerr, 129, "open");
}
return (0);
}
int
fk_open (int seq, int fmt, ftnint n)
{
char nbuf[10];
olist a;
int rtn;
int save_init;
(void) sprintf (nbuf, "fort.%ld", (long) n);
a.oerr = 1;
a.ounit = n;
a.ofnm = nbuf;
a.ofnmlen = strlen (nbuf);
a.osta = NULL;
a.oacc = seq == SEQ ? "s" : "d";
a.ofm = fmt == FMT ? "f" : "u";
a.orl = seq == DIR ? 1 : 0;
a.oblnk = NULL;
save_init = f__init;
f__init &= ~2;
rtn = f_open (&a);
f__init = save_init | 1;
return rtn;
}
libf2c/libI77/rdfmt.c deleted 100644 → 0
#include "config.h"
#include <ctype.h>
#include "f2c.h"
#include "fio.h"
extern int f__cursor;
#undef abs
#undef min
#undef max
#include <stdlib.h>
#include "fmt.h"
#include "fp.h"
static int
rd_Z (Uint * n, int w, ftnlen len)
{
long x[9];
char *s, *s0, *s1, *se, *t;
int ch, i, w1, w2;
static char hex[256];
static int one = 1;
int bad = 0;
if (!hex['0'])
{
s = "0123456789";
while ((ch = *s++))
hex[ch] = ch - '0' + 1;
s = "ABCDEF";
while ((ch = *s++))
hex[ch] = hex[ch + 'a' - 'A'] = ch - 'A' + 11;
}
s = s0 = (char *) x;
s1 = (char *) &x[4];
se = (char *) &x[8];
if (len > 4 * (ftnlen) sizeof (long))
return errno = 117;
while (w)
{
GET (ch);
if (ch == ',' || ch == '\n')
break;
w--;
if (ch > ' ')
{
if (!hex[ch & 0xff])
bad++;
*s++ = ch;
if (s == se)
{
/* discard excess characters */
for (t = s0, s = s1; t < s1;)
*t++ = *s++;
s = s1;
}
}
}
if (bad)
return errno = 115;
w = (int) len;
w1 = s - s0;
w2 = (w1 + 1) >> 1;
t = (char *) n;
if (*(char *) &one)
{
/* little endian */
t += w - 1;
i = -1;
}
else
i = 1;
for (; w > w2; t += i, --w)
*t = 0;
if (!w)
return 0;
if (w < w2)
s0 = s - (w << 1);
else if (w1 & 1)
{
*t = hex[*s0++ & 0xff] - 1;
if (!--w)
return 0;
t += i;
}
do
{
*t = (hex[*s0 & 0xff] - 1) << 4 | (hex[s0[1] & 0xff] - 1);
t += i;
s0 += 2;
}
while (--w);
return 0;
}
static int
rd_I (Uint * n, int w, ftnlen len, register int base)
{
int ch, sign;
longint x = 0;
if (w <= 0)
goto have_x;
for (;;)
{
GET (ch);
if (ch != ' ')
break;
if (!--w)
goto have_x;
}
sign = 0;
switch (ch)
{
case ',':
case '\n':
w = 0;
goto have_x;
case '-':
sign = 1;
case '+':
break;
default:
if (ch >= '0' && ch <= '9')
{
x = ch - '0';
break;
}
goto have_x;
}
while (--w)
{
GET (ch);
if (ch >= '0' && ch <= '9')
{
x = x * base + ch - '0';
continue;
}
if (ch != ' ')
{
if (ch == '\n' || ch == ',')
w = 0;
break;
}
if (f__cblank)
x *= base;
}
if (sign)
x = -x;
have_x:
if (len == sizeof (integer))
n->il = x;
else if (len == sizeof (char))
n->ic = (char) x;
#ifdef Allow_TYQUAD
else if (len == sizeof (longint))
n->ili = x;
#endif
else
n->is = (short) x;
if (w)
{
while (--w)
GET (ch);
return errno = 115;
}
return 0;
}
static int
rd_L (ftnint * n, int w, ftnlen len)
{
int ch, dot, lv;
if (w <= 0)
goto bad;
for (;;)
{
GET (ch);
--w;
if (ch != ' ')
break;
if (!w)
goto bad;
}
dot = 0;
retry:
switch (ch)
{
case '.':
if (dot++ || !w)
goto bad;
GET (ch);
--w;
goto retry;
case 't':
case 'T':
lv = 1;
break;
case 'f':
case 'F':
lv = 0;
break;
default:
bad:
for (; w > 0; --w)
GET (ch);
/* no break */
case ',':
case '\n':
return errno = 116;
}
/* The switch statement that was here
didn't cut it: It broke down for targets
where sizeof(char) == sizeof(short). */
if (len == sizeof (char))
*(char *) n = (char) lv;
else if (len == sizeof (short))
*(short *) n = (short) lv;
else
*n = lv;
while (w-- > 0)
{
GET (ch);
if (ch == ',' || ch == '\n')
break;
}
return 0;
}
static int
rd_F (ufloat * p, int w, int d, ftnlen len)
{
char s[FMAX + EXPMAXDIGS + 4];
register int ch;
register char *sp, *spe, *sp1;
double x;
int scale1, se;
long e, exp;
sp1 = sp = s;
spe = sp + FMAX;
exp = -d;
x = 0.;
do
{
GET (ch);
w--;
}
while (ch == ' ' && w);
switch (ch)
{
case '-':
*sp++ = ch;
sp1++;
spe++;
case '+':
if (!w)
goto zero;
--w;
GET (ch);
}
while (ch == ' ')
{
blankdrop:
if (!w--)
goto zero;
GET (ch);
}
while (ch == '0')
{
if (!w--)
goto zero;
GET (ch);
}
if (ch == ' ' && f__cblank)
goto blankdrop;
scale1 = f__scale;
while (isdigit (ch))
{
digloop1:
if (sp < spe)
*sp++ = ch;
else
++exp;
digloop1e:
if (!w--)
goto done;
GET (ch);
}
if (ch == ' ')
{
if (f__cblank)
{
ch = '0';
goto digloop1;
}
goto digloop1e;
}
if (ch == '.')
{
exp += d;
if (!w--)
goto done;
GET (ch);
if (sp == sp1)
{ /* no digits yet */
while (ch == '0')
{
skip01:
--exp;
skip0:
if (!w--)
goto done;
GET (ch);
}
if (ch == ' ')
{
if (f__cblank)
goto skip01;
goto skip0;
}
}
while (isdigit (ch))
{
digloop2:
if (sp < spe)
{
*sp++ = ch;
--exp;
}
digloop2e:
if (!w--)
goto done;
GET (ch);
}
if (ch == ' ')
{
if (f__cblank)
{
ch = '0';
goto digloop2;
}
goto digloop2e;
}
}
switch (ch)
{
default:
break;
case '-':
se = 1;
goto signonly;
case '+':
se = 0;
goto signonly;
case 'e':
case 'E':
case 'd':
case 'D':
if (!w--)
goto bad;
GET (ch);
while (ch == ' ')
{
if (!w--)
goto bad;
GET (ch);
}
se = 0;
switch (ch)
{
case '-':
se = 1;
case '+':
signonly:
if (!w--)
goto bad;
GET (ch);
}
while (ch == ' ')
{
if (!w--)
goto bad;
GET (ch);
}
if (!isdigit (ch))
goto bad;
e = ch - '0';
for (;;)
{
if (!w--)
{
ch = '\n';
break;
}
GET (ch);
if (!isdigit (ch))
{
if (ch == ' ')
{
if (f__cblank)
ch = '0';
else
continue;
}
else
break;
}
e = 10 * e + ch - '0';
if (e > EXPMAX && sp > sp1)
goto bad;
}
if (se)
exp -= e;
else
exp += e;
scale1 = 0;
}
switch (ch)
{
case '\n':
case ',':
break;
default:
bad:
return (errno = 115);
}
done:
if (sp > sp1)
{
while (*--sp == '0')
++exp;
if (exp -= scale1)
sprintf (sp + 1, "e%ld", exp);
else
sp[1] = 0;
x = atof (s);
}
zero:
if (len == sizeof (real))
p->pf = x;
else
p->pd = x;
return (0);
}
static int
rd_A (char *p, ftnlen len)
{
int i, ch;
for (i = 0; i < len; i++)
{
GET (ch);
*p++ = VAL (ch);
}
return (0);
}
static int
rd_AW (char *p, int w, ftnlen len)
{
int i, ch;
if (w >= len)
{
for (i = 0; i < w - len; i++)
GET (ch);
for (i = 0; i < len; i++)
{
GET (ch);
*p++ = VAL (ch);
}
return (0);
}
for (i = 0; i < w; i++)
{
GET (ch);
*p++ = VAL (ch);
}
for (i = 0; i < len - w; i++)
*p++ = ' ';
return (0);
}
static int
rd_H (int n, char *s)
{
int i, ch;
for (i = 0; i < n; i++)
if ((ch = (*f__getn) ()) < 0)
return (ch);
else
*s++ = ch == '\n' ? ' ' : ch;
return (1);
}
static int
rd_POS (char *s)
{
char quote;
int ch;
quote = *s++;
for (; *s; s++)
if (*s == quote && *(s + 1) != quote)
break;
else if ((ch = (*f__getn) ()) < 0)
return (ch);
else
*s = ch == '\n' ? ' ' : ch;
return (1);
}
int
rd_ed (struct syl * p, char *ptr, ftnlen len)
{
int ch;
for (; f__cursor > 0; f__cursor--)
if ((ch = (*f__getn) ()) < 0)
return (ch);
if (f__cursor < 0)
{
if (f__recpos + f__cursor < 0) /*err(elist->cierr,110,"fmt") */
f__cursor = -f__recpos; /* is this in the standard? */
if (f__external == 0)
{
extern char *f__icptr;
f__icptr += f__cursor;
}
else if (f__curunit && f__curunit->useek)
FSEEK (f__cf, (off_t) f__cursor, SEEK_CUR);
else
err (f__elist->cierr, 106, "fmt");
f__recpos += f__cursor;
f__cursor = 0;
}
switch (p->op)
{
default:
fprintf (stderr, "rd_ed, unexpected code: %d\n", p->op);
sig_die (f__fmtbuf, 1);
case IM:
case I:
ch = rd_I ((Uint *) ptr, p->p1, len, 10);
break;
/* O and OM don't work right for character, double, complex, */
/* or doublecomplex, and they differ from Fortran 90 in */
/* showing a minus sign for negative values. */
case OM:
case O:
ch = rd_I ((Uint *) ptr, p->p1, len, 8);
break;
case L:
ch = rd_L ((ftnint *) ptr, p->p1, len);
break;
case A:
ch = rd_A (ptr, len);
break;
case AW:
ch = rd_AW (ptr, p->p1, len);
break;
case E:
case EE:
case D:
case G:
case GE:
case F:
ch = rd_F ((ufloat *) ptr, p->p1, p->p2.i[0], len);
break;
/* Z and ZM assume 8-bit bytes. */
case ZM:
case Z:
ch = rd_Z ((Uint *) ptr, p->p1, len);
break;
}
if (ch == 0)
return (ch);
else if (ch == EOF)
return (EOF);
if (f__cf)
clearerr (f__cf);
return (errno);
}
int
rd_ned (struct syl * p)
{
switch (p->op)
{
default:
fprintf (stderr, "rd_ned, unexpected code: %d\n", p->op);
sig_die (f__fmtbuf, 1);
case APOS:
return (rd_POS (p->p2.s));
case H:
return (rd_H (p->p1, p->p2.s));
case SLASH:
return ((*f__donewrec) ());
case TR:
case X:
f__cursor += p->p1;
return (1);
case T:
f__cursor = p->p1 - f__recpos - 1;
return (1);
case TL:
f__cursor -= p->p1;
if (f__cursor < -f__recpos) /* TL1000, 1X */
f__cursor = -f__recpos;
return (1);
}
}
libf2c/libI77/rewind.c deleted 100644 → 0
#include "config.h"
#include "f2c.h"
#include "fio.h"
integer
f_rew (alist * a)
{
unit *b;
if (f__init & 2)
f__fatal (131, "I/O recursion");
if (a->aunit >= MXUNIT || a->aunit < 0)
err (a->aerr, 101, "rewind");
b = &f__units[a->aunit];
if (b->ufd == NULL || b->uwrt == 3)
return (0);
if (!b->useek)
err (a->aerr, 106, "rewind");
if (b->uwrt)
{
(void) t_runc (a);
b->uwrt = 3;
}
FSEEK (b->ufd, 0, SEEK_SET);
b->uend = 0;
return (0);
}
libf2c/libI77/rsfe.c deleted 100644 → 0
/* read sequential formatted external */
#include "config.h"
#include "f2c.h"
#include "fio.h"
#include "fmt.h"
int
xrd_SL (void)
{
int ch;
if (!f__curunit->uend)
while ((ch = getc (f__cf)) != '\n')
if (ch == EOF)
{
f__curunit->uend = 1;
break;
}
f__cursor = f__recpos = 0;
return (1);
}
int
x_getc (void)
{
int ch;
if (f__curunit->uend)
return (EOF);
ch = getc (f__cf);
if (ch != EOF && ch != '\n')
{
f__recpos++;
return (ch);
}
if (ch == '\n')
{
(void) ungetc (ch, f__cf);
return (ch);
}
if (f__curunit->uend || feof (f__cf))
{
errno = 0;
f__curunit->uend = 1;
return (-1);
}
return (-1);
}
int
x_endp (void)
{
xrd_SL ();
return f__curunit->uend == 1 ? EOF : 0;
}
int
x_rev (void)
{
(void) xrd_SL ();
return (0);
}
integer
s_rsfe (cilist * a) /* start */
{
int n;
if (f__init != 1)
f_init ();
f__init = 3;
f__reading = 1;
f__sequential = 1;
f__formatted = 1;
f__external = 1;
if ((n = c_sfe (a)))
return (n);
f__elist = a;
f__cursor = f__recpos = 0;
f__scale = 0;
f__fmtbuf = a->cifmt;
f__curunit = &f__units[a->ciunit];
f__cf = f__curunit->ufd;
if (pars_f (f__fmtbuf) < 0)
err (a->cierr, 100, "startio");
f__getn = x_getc;
f__doed = rd_ed;
f__doned = rd_ned;
fmt_bg ();
f__doend = x_endp;
f__donewrec = xrd_SL;
f__dorevert = x_rev;
f__cblank = f__curunit->ublnk;
f__cplus = 0;
if (f__curunit->uwrt && f__nowreading (f__curunit))
err (a->cierr, errno, "read start");
if (f__curunit->uend)
err (f__elist->ciend, (EOF), "read start");
return (0);
}
libf2c/libI77/rsli.c deleted 100644 → 0
#include "f2c.h"
#include "fio.h"
#include "lio.h"
#include "fmt.h" /* for f__doend */
extern flag f__lquit;
extern int f__lcount;
extern char *f__icptr;
extern char *f__icend;
extern icilist *f__svic;
extern int f__icnum, f__recpos;
static int
i_getc (void)
{
if (f__recpos >= f__svic->icirlen)
{
if (f__recpos++ == f__svic->icirlen)
return '\n';
z_rnew ();
}
f__recpos++;
if (f__icptr >= f__icend)
return EOF;
return (*f__icptr++);
}
static int
i_ungetc (int ch __attribute__ ((__unused__)),
FILE * f __attribute__ ((__unused__)))
{
if (--f__recpos == f__svic->icirlen)
return '\n';
if (f__recpos < -1)
err (f__svic->icierr, 110, "recend");
/* *--icptr == ch, and icptr may point to read-only memory */
return *--f__icptr /* = ch */ ;
}
static void
c_lir (icilist * a)
{
extern int l_eof;
if (f__init != 1)
f_init ();
f__init = 3;
f__reading = 1;
f__external = 0;
f__formatted = 1;
f__svic = a;
L_len = a->icirlen;
f__recpos = -1;
f__icnum = f__recpos = 0;
f__cursor = 0;
l_getc = i_getc;
l_ungetc = i_ungetc;
l_eof = 0;
f__icptr = a->iciunit;
f__icend = f__icptr + a->icirlen * a->icirnum;
f__cf = 0;
f__curunit = 0;
f__elist = (cilist *) a;
}
integer
s_rsli (icilist * a)
{
f__lioproc = l_read;
f__lquit = 0;
f__lcount = 0;
c_lir (a);
f__doend = 0;
return (0);
}
integer
e_rsli (void)
{
f__init = 1;
return 0;
}
extern int x_rsne (cilist *);
integer
s_rsni (icilist * a)
{
extern int nml_read;
integer rv;
cilist ca;
ca.ciend = a->iciend;
ca.cierr = a->icierr;
ca.cifmt = a->icifmt;
c_lir (a);
rv = x_rsne (&ca);
nml_read = 0;
return rv;
}
libf2c/libI77/rsne.c deleted 100644 → 0
#include "config.h"
#include "f2c.h"
#include "fio.h"
#include "lio.h"
#define MAX_NL_CACHE 3 /* maximum number of namelist hash tables to cache */
#define MAXDIM 20 /* maximum number of subscripts */
struct dimen
{
ftnlen extent;
ftnlen curval;
ftnlen delta;
ftnlen stride;
};
typedef struct dimen dimen;
struct hashentry
{
struct hashentry *next;
char *name;
Vardesc *vd;
};
typedef struct hashentry hashentry;
struct hashtab
{
struct hashtab *next;
Namelist *nl;
int htsize;
hashentry *tab[1];
};
typedef struct hashtab hashtab;
static hashtab *nl_cache;
static int n_nlcache;
static hashentry **zot;
static int colonseen;
extern ftnlen f__typesize[];
extern flag f__lquit;
extern int f__lcount, nml_read;
extern int t_getc (void);
#undef abs
#undef min
#undef max
#include <stdlib.h>
#include <string.h>
#ifdef ungetc
static int
un_getc (int x, FILE * f__cf)
{
return ungetc (x, f__cf);
}
#else
#define un_getc ungetc
extern int ungetc (int, FILE *); /* for systems with a buggy stdio.h */
#endif
static Vardesc *
hash (hashtab * ht, register char *s)
{
register int c, x;
register hashentry *h;
char *s0 = s;
for (x = 0; (c = *s++); x = x & 0x4000 ? ((x << 1) & 0x7fff) + 1 : x << 1)
x += c;
for (h = *(zot = ht->tab + x % ht->htsize); h; h = h->next)
if (!strcmp (s0, h->name))
return h->vd;
return 0;
}
hashtab *
mk_hashtab (Namelist * nl)
{
int nht, nv;
hashtab *ht;
Vardesc *v, **vd, **vde;
hashentry *he;
hashtab **x, **x0, *y;
for (x = &nl_cache; (y = *x); x0 = x, x = &y->next)
if (nl == y->nl)
return y;
if (n_nlcache >= MAX_NL_CACHE)
{
/* discard least recently used namelist hash table */
y = *x0;
free ((char *) y->next);
y->next = 0;
}
else
n_nlcache++;
nv = nl->nvars;
if (nv >= 0x4000)
nht = 0x7fff;
else
{
for (nht = 1; nht < nv; nht <<= 1);
nht += nht - 1;
}
ht = (hashtab *) malloc (sizeof (hashtab) + (nht - 1) * sizeof (hashentry *)
+ nv * sizeof (hashentry));
if (!ht)
return 0;
he = (hashentry *) & ht->tab[nht];
ht->nl = nl;
ht->htsize = nht;
ht->next = nl_cache;
nl_cache = ht;
memset ((char *) ht->tab, 0, nht * sizeof (hashentry *));
vd = nl->vars;
vde = vd + nv;
while (vd < vde)
{
v = *vd++;
if (!hash (ht, v->name))
{
he->next = *zot;
*zot = he;
he->name = v->name;
he->vd = v;
he++;
}
}
return ht;
}
static char Alpha[256], Alphanum[256];
static void
nl_init (void)
{
register char *s;
register int c;
for (s = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"; (c = *s++);)
Alpha[c]
= Alphanum[c] = Alpha[c + 'a' - 'A'] = Alphanum[c + 'a' - 'A'] = c;
for (s = "0123456789_"; (c = *s++);)
Alphanum[c] = c;
}
#define GETC(x) (x=(*l_getc)())
#define Ungetc(x,y) (*l_ungetc)(x,y)
static int
getname (register char *s, int slen)
{
register char *se = s + slen - 1;
register int ch;
GETC (ch);
if (!(*s++ = Alpha[ch & 0xff]))
{
if (ch != EOF)
ch = 115;
errfl (f__elist->cierr, ch, "namelist read");
}
while ((*s = Alphanum[GETC (ch) & 0xff]))
if (s < se)
s++;
if (ch == EOF)
err (f__elist->cierr, EOF, "namelist read");
if (ch > ' ')
Ungetc (ch, f__cf);
return *s = 0;
}
static int
getnum (int *chp, ftnlen * val)
{
register int ch, sign;
register ftnlen x;
while (GETC (ch) <= ' ' && ch >= 0);
if (ch == '-')
{
sign = 1;
GETC (ch);
}
else
{
sign = 0;
if (ch == '+')
GETC (ch);
}
x = ch - '0';
if (x < 0 || x > 9)
return 115;
while (GETC (ch) >= '0' && ch <= '9')
x = 10 * x + ch - '0';
while (ch <= ' ' && ch >= 0)
GETC (ch);
if (ch == EOF)
return EOF;
*val = sign ? -x : x;
*chp = ch;
return 0;
}
static int
getdimen (int *chp, dimen * d, ftnlen delta, ftnlen extent, ftnlen * x1)
{
register int k;
ftnlen x2, x3;
if ((k = getnum (chp, x1)))
return k;
x3 = 1;
if (*chp == ':')
{
if ((k = getnum (chp, &x2)))
return k;
x2 -= *x1;
if (*chp == ':')
{
if ((k = getnum (chp, &x3)))
return k;
if (!x3)
return 123;
x2 /= x3;
colonseen = 1;
}
if (x2 < 0 || x2 >= extent)
return 123;
d->extent = x2 + 1;
}
else
d->extent = 1;
d->curval = 0;
d->delta = delta;
d->stride = x3;
return 0;
}
#ifndef No_Namelist_Questions
static void
print_ne (cilist * a)
{
flag intext = f__external;
int rpsave = f__recpos;
FILE *cfsave = f__cf;
unit *usave = f__curunit;
cilist t;
t = *a;
t.ciunit = 6;
s_wsne (&t);
fflush (f__cf);
f__external = intext;
f__reading = 1;
f__recpos = rpsave;
f__cf = cfsave;
f__curunit = usave;
f__elist = a;
}
#endif
static char where0[] = "namelist read start ";
int
x_rsne (cilist * a)
{
int ch, got1, k, n, nd, quote, readall;
Namelist *nl;
static char where[] = "namelist read";
char buf[64];
hashtab *ht;
Vardesc *v;
dimen *dn, *dn0, *dn1;
ftnlen *dims, *dims1;
ftnlen b, b0, b1, ex, no, nomax, size, span;
ftnint no1, type;
char *vaddr;
long iva, ivae;
dimen dimens[MAXDIM], substr;
if (!Alpha['a'])
nl_init ();
f__reading = 1;
f__formatted = 1;
got1 = 0;
top:
for (;;)
switch (GETC (ch))
{
case EOF:
eof:
err (a->ciend, (EOF), where0);
case '&':
case '$':
goto have_amp;
#ifndef No_Namelist_Questions
case '?':
print_ne (a);
continue;
#endif
default:
if (ch <= ' ' && ch >= 0)
continue;
#ifndef No_Namelist_Comments
while (GETC (ch) != '\n')
if (ch == EOF)
goto eof;
#else
errfl (a->cierr, 115, where0);
#endif
}
have_amp:
if ((ch = getname (buf, sizeof (buf))))
return ch;
nl = (Namelist *) a->cifmt;
if (strcmp (buf, nl->name))
#ifdef No_Bad_Namelist_Skip
errfl (a->cierr, 118, where0);
#else
{
fprintf (stderr,
"Skipping namelist \"%s\": seeking namelist \"%s\".\n",
buf, nl->name);
fflush (stderr);
for (;;)
switch (GETC (ch))
{
case EOF:
err (a->ciend, EOF, where0);
case '/':
case '&':
case '$':
if (f__external)
e_rsle ();
else
z_rnew ();
goto top;
case '"':
case '\'':
quote = ch;
more_quoted:
while (GETC (ch) != quote)
if (ch == EOF)
err (a->ciend, EOF, where0);
if (GETC (ch) == quote)
goto more_quoted;
Ungetc (ch, f__cf);
default:
continue;
}
}
#endif
ht = mk_hashtab (nl);
if (!ht)
errfl (f__elist->cierr, 113, where0);
for (;;)
{
for (;;)
switch (GETC (ch))
{
case EOF:
if (got1)
return 0;
err (a->ciend, EOF, where0);
case '/':
case '$':
case '&':
return 0;
default:
if ((ch <= ' ' && ch >= 0) || ch == ',')
continue;
Ungetc (ch, f__cf);
if ((ch = getname (buf, sizeof (buf))))
return ch;
goto havename;
}
havename:
v = hash (ht, buf);
if (!v)
errfl (a->cierr, 119, where);
while (GETC (ch) <= ' ' && ch >= 0);
vaddr = v->addr;
type = v->type;
if (type < 0)
{
size = -type;
type = TYCHAR;
}
else
size = f__typesize[type];
ivae = size;
iva = readall = 0;
if (ch == '(' /*) */ )
{
dn = dimens;
if (!(dims = v->dims))
{
if (type != TYCHAR)
errfl (a->cierr, 122, where);
if ((k = getdimen (&ch, dn, (ftnlen) size, (ftnlen) size, &b)))
errfl (a->cierr, k, where);
if (ch != ')')
errfl (a->cierr, 115, where);
b1 = dn->extent;
if (--b < 0 || b + b1 > size)
return 124;
iva += b;
size = b1;
while (GETC (ch) <= ' ' && ch >= 0);
goto scalar;
}
nd = (int) dims[0];
nomax = span = dims[1];
ivae = iva + size * nomax;
colonseen = 0;
if ((k = getdimen (&ch, dn, size, nomax, &b)))
errfl (a->cierr, k, where);
no = dn->extent;
b0 = dims[2];
dims1 = dims += 3;
ex = 1;
for (n = 1; n++ < nd; dims++)
{
if (ch != ',')
errfl (a->cierr, 115, where);
dn1 = dn + 1;
span /= *dims;
if ((k = getdimen (&ch, dn1, dn->delta ** dims, span, &b1)))
errfl (a->cierr, k, where);
ex *= *dims;
b += b1 * ex;
no *= dn1->extent;
dn = dn1;
}
if (ch != ')')
errfl (a->cierr, 115, where);
readall = 1 - colonseen;
b -= b0;
if (b < 0 || b >= nomax)
errfl (a->cierr, 125, where);
iva += size * b;
dims = dims1;
while (GETC (ch) <= ' ' && ch >= 0);
no1 = 1;
dn0 = dimens;
if (type == TYCHAR && ch == '(' /*) */ )
{
if ((k = getdimen (&ch, &substr, size, size, &b)))
errfl (a->cierr, k, where);
if (ch != ')')
errfl (a->cierr, 115, where);
b1 = substr.extent;
if (--b < 0 || b + b1 > size)
return 124;
iva += b;
b0 = size;
size = b1;
while (GETC (ch) <= ' ' && ch >= 0);
if (b1 < b0)
goto delta_adj;
}
if (readall)
goto delta_adj;
for (; dn0 < dn; dn0++)
{
if (dn0->extent != *dims++ || dn0->stride != 1)
break;
no1 *= dn0->extent;
}
if (dn0 == dimens && dimens[0].stride == 1)
{
no1 = dimens[0].extent;
dn0++;
}
delta_adj:
ex = 0;
for (dn1 = dn0; dn1 <= dn; dn1++)
ex += (dn1->extent - 1) * (dn1->delta *= dn1->stride);
for (dn1 = dn; dn1 > dn0; dn1--)
{
ex -= (dn1->extent - 1) * dn1->delta;
dn1->delta -= ex;
}
}
else if ((dims = v->dims))
{
no = no1 = dims[1];
ivae = iva + no * size;
}
else
scalar:
no = no1 = 1;
if (ch != '=')
errfl (a->cierr, 115, where);
got1 = nml_read = 1;
f__lcount = 0;
readloop:
for (;;)
{
if (iva >= ivae || iva < 0)
{
f__lquit = 1;
goto mustend;
}
else if (iva + no1 * size > ivae)
no1 = (ivae - iva) / size;
f__lquit = 0;
if ((k = l_read (&no1, vaddr + iva, size, type)))
return k;
if (f__lquit == 1)
return 0;
if (readall)
{
iva += dn0->delta;
if (f__lcount > 0)
{
ftnint no2 = (ivae - iva) / size;
if (no2 > f__lcount)
no2 = f__lcount;
if ((k = l_read (&no2, vaddr + iva, size, type)))
return k;
iva += no2 * dn0->delta;
}
}
mustend:
GETC (ch);
if (readall)
{
if (iva >= ivae)
readall = 0;
else
for (;;)
{
switch (ch)
{
case ' ':
case '\t':
case '\n':
GETC (ch);
continue;
}
break;
}
}
if (ch == '/' || ch == '$' || ch == '&')
{
f__lquit = 1;
return 0;
}
else if (f__lquit)
{
while (ch <= ' ' && ch >= 0)
GETC (ch);
Ungetc (ch, f__cf);
if (!Alpha[ch & 0xff] && ch >= 0)
errfl (a->cierr, 125, where);
break;
}
Ungetc (ch, f__cf);
if (readall && !Alpha[ch & 0xff])
goto readloop;
if ((no -= no1) <= 0)
break;
for (dn1 = dn0; dn1 <= dn; dn1++)
{
if (++dn1->curval < dn1->extent)
{
iva += dn1->delta;
goto readloop;
}
dn1->curval = 0;
}
break;
}
}
}
integer
s_rsne (cilist * a)
{
extern int l_eof;
int n;
f__external = 1;
l_eof = 0;
if ((n = c_le (a)))
return n;
if (f__curunit->uwrt && f__nowreading (f__curunit))
err (a->cierr, errno, where0);
l_getc = t_getc;
l_ungetc = un_getc;
f__doend = xrd_SL;
n = x_rsne (a);
nml_read = 0;
if (n)
return n;
return e_rsle ();
}
libf2c/libI77/sfe.c deleted 100644 → 0
/* sequential formatted external common routines*/
#include "config.h"
#include "f2c.h"
#include "fio.h"
extern char *f__fmtbuf;
integer
e_rsfe (void)
{
int n;
f__init = 1;
n = en_fio ();
f__fmtbuf = NULL;
return (n);
}
int
c_sfe (cilist * a) /* check */
{
unit *p;
if (a->ciunit >= MXUNIT || a->ciunit < 0)
err (a->cierr, 101, "startio");
p = &f__units[a->ciunit];
if (p->ufd == NULL && fk_open (SEQ, FMT, a->ciunit))
err (a->cierr, 114, "sfe");
if (!p->ufmt)
err (a->cierr, 102, "sfe");
return (0);
}
integer
e_wsfe (void)
{
int n;
f__init = 1;
n = en_fio ();
f__fmtbuf = NULL;
#ifdef ALWAYS_FLUSH
if (!n && fflush (f__cf))
err (f__elist->cierr, errno, "write end");
#endif
return n;
}
libf2c/libI77/sue.c deleted 100644 → 0
#include "config.h"
#include "f2c.h"
#include "fio.h"
extern uiolen f__reclen;
off_t f__recloc;
int
c_sue (cilist * a)
{
f__external = f__sequential = 1;
f__formatted = 0;
f__curunit = &f__units[a->ciunit];
if (a->ciunit >= MXUNIT || a->ciunit < 0)
err (a->cierr, 101, "startio");
f__elist = a;
if (f__curunit->ufd == NULL && fk_open (SEQ, UNF, a->ciunit))
err (a->cierr, 114, "sue");
f__cf = f__curunit->ufd;
if (f__curunit->ufmt)
err (a->cierr, 103, "sue");
if (!f__curunit->useek)
err (a->cierr, 103, "sue");
return (0);
}
integer
s_rsue (cilist * a)
{
int n;
if (f__init != 1)
f_init ();
f__init = 3;
f__reading = 1;
if ((n = c_sue (a)))
return (n);
f__recpos = 0;
if (f__curunit->uwrt && f__nowreading (f__curunit))
err (a->cierr, errno, "read start");
if (fread ((char *) &f__reclen, sizeof (uiolen), 1, f__cf) != 1)
{
if (feof (f__cf))
{
f__curunit->uend = 1;
err (a->ciend, EOF, "start");
}
clearerr (f__cf);
err (a->cierr, errno, "start");
}
return (0);
}
integer
s_wsue (cilist * a)
{
int n;
if (f__init != 1)
f_init ();
f__init = 3;
if ((n = c_sue (a)))
return (n);
f__reading = 0;
f__reclen = 0;
if (f__curunit->uwrt != 1 && f__nowwriting (f__curunit))
err (a->cierr, errno, "write start");
f__recloc = FTELL (f__cf);
FSEEK (f__cf, (off_t) sizeof (uiolen), SEEK_CUR);
return (0);
}
integer
e_wsue (void)
{
off_t loc;
f__init = 1;
fwrite ((char *) &f__reclen, sizeof (uiolen), 1, f__cf);
#ifdef ALWAYS_FLUSH
if (fflush (f__cf))
err (f__elist->cierr, errno, "write end");
#endif
loc = FTELL (f__cf);
FSEEK (f__cf, f__recloc, SEEK_SET);
fwrite ((char *) &f__reclen, sizeof (uiolen), 1, f__cf);
FSEEK (f__cf, loc, SEEK_SET);
return (0);
}
integer
e_rsue (void)
{
f__init = 1;
FSEEK (f__cf, (off_t) (f__reclen - f__recpos + sizeof (uiolen)), SEEK_CUR);
return (0);
}
libf2c/libI77/typesize.c deleted 100644 → 0
#include "config.h"
#include "f2c.h"
ftnlen f__typesize[] = { 0, 0, sizeof (shortint), sizeof (integer),
sizeof (real), sizeof (doublereal),
sizeof (complex), sizeof (doublecomplex),
sizeof (logical), sizeof (char),
0, sizeof (integer1),
sizeof (logical1), sizeof (shortlogical),
#ifdef Allow_TYQUAD
sizeof (longint),
#endif
0
};
libf2c/libI77/uio.c deleted 100644 → 0
#include "config.h"
#include "f2c.h"
#include "fio.h"
#include <sys/types.h>
uiolen f__reclen;
int
do_us (ftnint * number, char *ptr, ftnlen len)
{
if (f__reading)
{
f__recpos += (int) (*number * len);
if (f__recpos > f__reclen)
err (f__elist->cierr, 110, "do_us");
if (fread (ptr, (size_t) len, (size_t) (*number), f__cf) != (size_t) *number)
err (f__elist->ciend, EOF, "do_us");
return (0);
}
else
{
f__reclen += *number * len;
(void) fwrite (ptr, (size_t) len, (size_t) (*number), f__cf);
return (0);
}
}
integer
do_ud (ftnint * number, char *ptr, ftnlen len)
{
f__recpos += (int) (*number * len);
if (f__recpos > f__curunit->url && f__curunit->url != 1)
err (f__elist->cierr, 110, "do_ud");
if (f__reading)
{
#ifdef Pad_UDread
size_t i;
if (!(i = fread (ptr, (size_t) len, (size_t) (*number), f__cf))
&& !(f__recpos - *number * len))
err (f__elist->cierr, EOF, "do_ud");
if (i < (size_t) *number)
memset (ptr + i * len, 0, (*number - i) * len);
return 0;
#else
if (fread (ptr, (size_t) len, (size_t) (*number), f__cf) != *number)
err (f__elist->cierr, EOF, "do_ud");
else
return (0);
#endif
}
(void) fwrite (ptr, (size_t) len, (size_t) (*number), f__cf);
return (0);
}
integer
do_uio (ftnint * number, char *ptr, ftnlen len)
{
if (f__sequential)
return (do_us (number, ptr, len));
else
return (do_ud (number, ptr, len));
}
libf2c/libI77/util.c deleted 100644 → 0
#include "config.h"
#ifndef NON_UNIX_STDIO
#define _INCLUDE_POSIX_SOURCE /* for HP-UX */
#define _INCLUDE_XOPEN_SOURCE /* for HP-UX */
#include <sys/types.h>
#include <sys/stat.h>
#endif
#include "f2c.h"
#include "fio.h"
void
g_char (char *a, ftnlen alen, char *b)
{
char *x = a + alen, *y = b + alen;
for (;; y--)
{
if (x <= a)
{
*b = 0;
return;
}
if (*--x != ' ')
break;
}
*y-- = 0;
do
*y-- = *x;
while (x-- > a);
}
void
b_char (char *a, char *b, ftnlen blen)
{
int i;
for (i = 0; i < blen && *a != 0; i++)
*b++ = *a++;
for (; i < blen; i++)
*b++ = ' ';
}
#ifndef NON_UNIX_STDIO
long
f__inode (char *a, int *dev)
{
struct stat x;
if (stat (a, &x) < 0)
return (-1);
*dev = x.st_dev;
return (x.st_ino);
}
#endif
libf2c/libI77/wref.c deleted 100644 → 0
#include "f2c.h"
#include "fio.h"
#ifndef VAX
#include <ctype.h>
#endif
#undef abs
#undef min
#undef max
#include <stdlib.h>
#include <string.h>
#include "fmt.h"
#include "fp.h"
int
wrt_E (ufloat * p, int w, int d, int e, ftnlen len)
{
char buf[FMAX + EXPMAXDIGS + 4], *s, *se;
int d1, delta, e1, i, sign, signspace;
double dd;
#ifdef WANT_LEAD_0
int insert0 = 0;
#endif
#ifndef VAX
int e0 = e;
#endif
if (e <= 0)
e = 2;
if (f__scale)
{
if (f__scale >= d + 2 || f__scale <= -d)
goto nogood;
}
if (f__scale <= 0)
--d;
if (len == sizeof (real))
dd = p->pf;
else
dd = p->pd;
if (dd < 0.)
{
signspace = sign = 1;
dd = -dd;
}
else
{
sign = 0;
signspace = (int) f__cplus;
#ifndef VAX
if (!dd)
dd = 0.; /* avoid -0 */
#endif
}
delta = w - (2 /* for the . and the d adjustment above */
+ 2 /* for the E+ */ + signspace + d + e);
#ifdef WANT_LEAD_0
if (f__scale <= 0 && delta > 0)
{
delta--;
insert0 = 1;
}
else
#endif
if (delta < 0)
{
nogood:
while (--w >= 0)
PUT ('*');
return (0);
}
if (f__scale < 0)
d += f__scale;
if (d > FMAX)
{
d1 = d - FMAX;
d = FMAX;
}
else
d1 = 0;
sprintf (buf, "%#.*E", d, dd);
#ifndef VAX
/* check for NaN, Infinity */
if (!isdigit ((unsigned char) buf[0]))
{
switch (buf[0])
{
case 'n':
case 'N':
signspace = 0; /* no sign for NaNs */
}
delta = w - strlen (buf) - signspace;
if (delta < 0)
goto nogood;
while (--delta >= 0)
PUT (' ');
if (signspace)
PUT (sign ? '-' : '+');
for (s = buf; *s; s++)
PUT (*s);
return 0;
}
#endif
se = buf + d + 3;
#ifdef GOOD_SPRINTF_EXPONENT /* When possible, exponent has 2 digits. */
if (f__scale != 1 && dd)
sprintf (se, "%+.2d", atoi (se) + 1 - f__scale);
#else
if (dd)
sprintf (se, "%+.2d", atoi (se) + 1 - f__scale);
else
strcpy (se, "+00");
#endif
s = ++se;
if (e < 2)
{
if (*s != '0')
goto nogood;
}
#ifndef VAX
/* accommodate 3 significant digits in exponent */
if (s[2])
{
#ifdef Pedantic
if (!e0 && !s[3])
for (s -= 2, e1 = 2; s[0] = s[1]; s++);
/* Pedantic gives the behavior that Fortran 77 specifies, */
/* i.e., requires that E be specified for exponent fields */
/* of more than 3 digits. With Pedantic undefined, we get */
/* the behavior that Cray displays -- you get a bigger */
/* exponent field if it fits. */
#else
if (!e0)
{
for (s -= 2, e1 = 2; (s[0] = s[1]); s++)
#ifdef CRAY
delta--;
if ((delta += 4) < 0)
goto nogood
#endif
;
}
#endif
else if (e0 >= 0)
goto shift;
else
e1 = e;
}
else
shift:
#endif
for (s += 2, e1 = 2; *s; ++e1, ++s)
if (e1 >= e)
goto nogood;
while (--delta >= 0)
PUT (' ');
if (signspace)
PUT (sign ? '-' : '+');
s = buf;
i = f__scale;
if (f__scale <= 0)
{
#ifdef WANT_LEAD_0
if (insert0)
PUT ('0');
#endif
PUT ('.');
for (; i < 0; ++i)
PUT ('0');
PUT (*s);
s += 2;
}
else if (f__scale > 1)
{
PUT (*s);
s += 2;
while (--i > 0)
PUT (*s++);
PUT ('.');
}
if (d1)
{
se -= 2;
while (s < se)
PUT (*s++);
se += 2;
do
PUT ('0');
while (--d1 > 0);
}
while (s < se)
PUT (*s++);
if (e < 2)
PUT (s[1]);
else
{
while (++e1 <= e)
PUT ('0');
while (*s)
PUT (*s++);
}
return 0;
}
int
wrt_F (ufloat * p, int w, int d, ftnlen len)
{
int d1, sign, n;
double x;
char *b, buf[MAXINTDIGS + MAXFRACDIGS + 4], *s;
x = (len == sizeof (real) ? p->pf : p->pd);
if (d < MAXFRACDIGS)
d1 = 0;
else
{
d1 = d - MAXFRACDIGS;
d = MAXFRACDIGS;
}
if (x < 0.)
{
x = -x;
sign = 1;
}
else
{
sign = 0;
#ifndef VAX
if (!x)
x = 0.;
#endif
}
if ((n = f__scale))
{
if (n > 0)
do
x *= 10.;
while (--n > 0);
else
do
x *= 0.1;
while (++n < 0);
}
#ifdef USE_STRLEN
sprintf (b = buf, "%#.*f", d, x);
n = strlen (b) + d1;
#else
n = sprintf (b = buf, "%#.*f", d, x) + d1;
#endif
#ifndef WANT_LEAD_0
if (buf[0] == '0' && d)
{
++b;
--n;
}
#endif
if (sign)
{
/* check for all zeros */
for (s = b;;)
{
while (*s == '0')
s++;
switch (*s)
{
case '.':
s++;
continue;
case 0:
sign = 0;
}
break;
}
}
if (sign || f__cplus)
++n;
if (n > w)
{
#ifdef WANT_LEAD_0
if (buf[0] == '0' && --n == w)
++b;
else
#endif
{
while (--w >= 0)
PUT ('*');
return 0;
}
}
for (w -= n; --w >= 0;)
PUT (' ');
if (sign)
PUT ('-');
else if (f__cplus)
PUT ('+');
while ((n = *b++))
PUT (n);
while (--d1 >= 0)
PUT ('0');
return 0;
}
libf2c/libI77/wrtfmt.c deleted 100644 → 0
#include "config.h"
#include "f2c.h"
#include "fio.h"
#include "fmt.h"
extern icilist *f__svic;
extern char *f__icptr;
static int
mv_cur (void) /* shouldn't use fseek because it insists on calling fflush */
/* instead we know too much about stdio */
{
int cursor = f__cursor;
f__cursor = 0;
if (f__external == 0)
{
if (cursor < 0)
{
if (f__hiwater < f__recpos)
f__hiwater = f__recpos;
f__recpos += cursor;
f__icptr += cursor;
if (f__recpos < 0)
err (f__elist->cierr, 110, "left off");
}
else if (cursor > 0)
{
if (f__recpos + cursor >= f__svic->icirlen)
err (f__elist->cierr, 110, "recend");
if (f__hiwater <= f__recpos)
for (; cursor > 0; cursor--)
(*f__putn) (' ');
else if (f__hiwater <= f__recpos + cursor)
{
cursor -= f__hiwater - f__recpos;
f__icptr += f__hiwater - f__recpos;
f__recpos = f__hiwater;
for (; cursor > 0; cursor--)
(*f__putn) (' ');
}
else
{
f__icptr += cursor;
f__recpos += cursor;
}
}
return (0);
}
if (cursor > 0)
{
if (f__hiwater <= f__recpos)
for (; cursor > 0; cursor--)
(*f__putn) (' ');
else if (f__hiwater <= f__recpos + cursor)
{
cursor -= f__hiwater - f__recpos;
f__recpos = f__hiwater;
for (; cursor > 0; cursor--)
(*f__putn) (' ');
}
else
{
f__recpos += cursor;
}
}
else if (cursor < 0)
{
if (cursor + f__recpos < 0)
err (f__elist->cierr, 110, "left off");
if (f__hiwater < f__recpos)
f__hiwater = f__recpos;
f__recpos += cursor;
}
return (0);
}
static int
wrt_Z (Uint * n, int w, int minlen, ftnlen len)
{
register char *s, *se;
register int i, w1;
static int one = 1;
static char hex[] = "0123456789ABCDEF";
s = (char *) n;
--len;
if (*(char *) &one)
{
/* little endian */
se = s;
s += len;
i = -1;
}
else
{
se = s + len;
i = 1;
}
for (;; s += i)
if (s == se || *s)
break;
w1 = (i * (se - s) << 1) + 1;
if (*s & 0xf0)
w1++;
if (w1 > w)
for (i = 0; i < w; i++)
(*f__putn) ('*');
else
{
if ((minlen -= w1) > 0)
w1 += minlen;
while (--w >= w1)
(*f__putn) (' ');
while (--minlen >= 0)
(*f__putn) ('0');
if (!(*s & 0xf0))
{
(*f__putn) (hex[*s & 0xf]);
if (s == se)
return 0;
s += i;
}
for (;; s += i)
{
(*f__putn) (hex[*s >> 4 & 0xf]);
(*f__putn) (hex[*s & 0xf]);
if (s == se)
break;
}
}
return 0;
}
static int
wrt_I (Uint * n, int w, ftnlen len, register int base)
{
int ndigit, sign, spare, i;
longint x;
char *ans;
if (len == sizeof (integer))
x = n->il;
else if (len == sizeof (char))
x = n->ic;
#ifdef Allow_TYQUAD
else if (len == sizeof (longint))
x = n->ili;
#endif
else
x = n->is;
ans = f__icvt (x, &ndigit, &sign, base);
spare = w - ndigit;
if (sign || f__cplus)
spare--;
if (spare < 0)
for (i = 0; i < w; i++)
(*f__putn) ('*');
else
{
for (i = 0; i < spare; i++)
(*f__putn) (' ');
if (sign)
(*f__putn) ('-');
else if (f__cplus)
(*f__putn) ('+');
for (i = 0; i < ndigit; i++)
(*f__putn) (*ans++);
}
return (0);
}
static int
wrt_IM (Uint * n, int w, int m, ftnlen len, int base)
{
int ndigit, sign, spare, i, xsign;
longint x;
char *ans;
if (sizeof (integer) == len)
x = n->il;
else if (len == sizeof (char))
x = n->ic;
#ifdef Allow_TYQUAD
else if (len == sizeof (longint))
x = n->ili;
#endif
else
x = n->is;
ans = f__icvt (x, &ndigit, &sign, base);
if (sign || f__cplus)
xsign = 1;
else
xsign = 0;
if (ndigit + xsign > w || m + xsign > w)
{
for (i = 0; i < w; i++)
(*f__putn) ('*');
return (0);
}
if (x == 0 && m == 0)
{
for (i = 0; i < w; i++)
(*f__putn) (' ');
return (0);
}
if (ndigit >= m)
spare = w - ndigit - xsign;
else
spare = w - m - xsign;
for (i = 0; i < spare; i++)
(*f__putn) (' ');
if (sign)
(*f__putn) ('-');
else if (f__cplus)
(*f__putn) ('+');
for (i = 0; i < m - ndigit; i++)
(*f__putn) ('0');
for (i = 0; i < ndigit; i++)
(*f__putn) (*ans++);
return (0);
}
static int
wrt_AP (char *s)
{
char quote;
int i;
if (f__cursor && (i = mv_cur ()))
return i;
quote = *s++;
for (; *s; s++)
{
if (*s != quote)
(*f__putn) (*s);
else if (*++s == quote)
(*f__putn) (*s);
else
return (1);
}
return (1);
}
static int
wrt_H (int a, char *s)
{
int i;
if (f__cursor && (i = mv_cur ()))
return i;
while (a--)
(*f__putn) (*s++);
return (1);
}
int
wrt_L (Uint * n, int len, ftnlen sz)
{
int i;
long x;
if (sizeof (long) == sz)
x = n->il;
else if (sz == sizeof (char))
x = n->ic;
else
x = n->is;
for (i = 0; i < len - 1; i++)
(*f__putn) (' ');
if (x)
(*f__putn) ('T');
else
(*f__putn) ('F');
return (0);
}
static int
wrt_A (char *p, ftnlen len)
{
while (len-- > 0)
(*f__putn) (*p++);
return (0);
}
static int
wrt_AW (char *p, int w, ftnlen len)
{
while (w > len)
{
w--;
(*f__putn) (' ');
}
while (w-- > 0)
(*f__putn) (*p++);
return (0);
}
static int
wrt_G (ufloat * p, int w, int d, int e, ftnlen len)
{
double up = 1, x;
int i = 0, oldscale, n, j;
x = len == sizeof (real) ? p->pf : p->pd;
if (x < 0)
x = -x;
if (x < .1)
{
if (x != 0.)
return (wrt_E (p, w, d, e, len));
i = 1;
goto have_i;
}
for (; i <= d; i++, up *= 10)
{
if (x >= up)
continue;
have_i:
oldscale = f__scale;
f__scale = 0;
if (e == 0)
n = 4;
else
n = e + 2;
i = wrt_F (p, w - n, d - i, len);
for (j = 0; j < n; j++)
(*f__putn) (' ');
f__scale = oldscale;
return (i);
}
return (wrt_E (p, w, d, e, len));
}
int
w_ed (struct syl * p, char *ptr, ftnlen len)
{
int i;
if (f__cursor && (i = mv_cur ()))
return i;
switch (p->op)
{
default:
fprintf (stderr, "w_ed, unexpected code: %d\n", p->op);
sig_die (f__fmtbuf, 1);
case I:
return (wrt_I ((Uint *) ptr, p->p1, len, 10));
case IM:
return (wrt_IM ((Uint *) ptr, p->p1, p->p2.i[0], len, 10));
/* O and OM don't work right for character, double, complex, */
/* or doublecomplex, and they differ from Fortran 90 in */
/* showing a minus sign for negative values. */
case O:
return (wrt_I ((Uint *) ptr, p->p1, len, 8));
case OM:
return (wrt_IM ((Uint *) ptr, p->p1, p->p2.i[0], len, 8));
case L:
return (wrt_L ((Uint *) ptr, p->p1, len));
case A:
return (wrt_A (ptr, len));
case AW:
return (wrt_AW (ptr, p->p1, len));
case D:
case E:
case EE:
return (wrt_E ((ufloat *) ptr, p->p1, p->p2.i[0], p->p2.i[1], len));
case G:
case GE:
return (wrt_G ((ufloat *) ptr, p->p1, p->p2.i[0], p->p2.i[1], len));
case F:
return (wrt_F ((ufloat *) ptr, p->p1, p->p2.i[0], len));
/* Z and ZM assume 8-bit bytes. */
case Z:
return (wrt_Z ((Uint *) ptr, p->p1, 0, len));
case ZM:
return (wrt_Z ((Uint *) ptr, p->p1, p->p2.i[0], len));
}
}
int
w_ned (struct syl * p)
{
switch (p->op)
{
default:
fprintf (stderr, "w_ned, unexpected code: %d\n", p->op);
sig_die (f__fmtbuf, 1);
case SLASH:
return ((*f__donewrec) ());
case T:
f__cursor = p->p1 - f__recpos - 1;
return (1);
case TL:
f__cursor -= p->p1;
if (f__cursor < -f__recpos) /* TL1000, 1X */
f__cursor = -f__recpos;
return (1);
case TR:
case X:
f__cursor += p->p1;
return (1);
case APOS:
return (wrt_AP (p->p2.s));
case H:
return (wrt_H (p->p1, p->p2.s));
}
}
libf2c/libI77/wsfe.c deleted 100644 → 0
/*write sequential formatted external*/
#include "config.h"
#include "f2c.h"
#include "fio.h"
#include "fmt.h"
extern int f__hiwater;
int
x_wSL (void)
{
int n = f__putbuf ('\n');
f__hiwater = f__recpos = f__cursor = 0;
return (n == 0);
}
static int
xw_end (void)
{
int n;
if (f__nonl)
{
f__putbuf (n = 0);
fflush (f__cf);
}
else
n = f__putbuf ('\n');
f__hiwater = f__recpos = f__cursor = 0;
return n;
}
static int
xw_rev (void)
{
int n = 0;
if (f__workdone)
{
n = f__putbuf ('\n');
f__workdone = 0;
}
f__hiwater = f__recpos = f__cursor = 0;
return n;
}
integer
s_wsfe (cilist * a) /*start */
{
int n;
if (f__init != 1)
f_init ();
f__init = 3;
f__reading = 0;
f__sequential = 1;
f__formatted = 1;
f__external = 1;
if ((n = c_sfe (a)))
return (n);
f__elist = a;
f__hiwater = f__cursor = f__recpos = 0;
f__nonl = 0;
f__scale = 0;
f__fmtbuf = a->cifmt;
f__curunit = &f__units[a->ciunit];
f__cf = f__curunit->ufd;
if (pars_f (f__fmtbuf) < 0)
err (a->cierr, 100, "startio");
f__putn = x_putc;
f__doed = w_ed;
f__doned = w_ned;
f__doend = xw_end;
f__dorevert = xw_rev;
f__donewrec = x_wSL;
fmt_bg ();
f__cplus = 0;
f__cblank = f__curunit->ublnk;
if (f__curunit->uwrt != 1 && f__nowwriting (f__curunit))
err (a->cierr, errno, "write start");
return (0);
}
libf2c/libI77/wsle.c deleted 100644 → 0
#include "config.h"
#include "f2c.h"
#include "fio.h"
#include "fmt.h"
#include "lio.h"
#include "string.h"
integer
s_wsle (cilist * a)
{
int n;
if ((n = c_le (a)))
return (n);
f__reading = 0;
f__external = 1;
f__formatted = 1;
f__putn = x_putc;
f__lioproc = l_write;
L_len = LINE;
f__donewrec = x_wSL;
if (f__curunit->uwrt != 1 && f__nowwriting (f__curunit))
err (a->cierr, errno, "list output start");
return (0);
}
integer
e_wsle (void)
{
int n;
f__init = 1;
n = f__putbuf ('\n');
f__recpos = 0;
#ifdef ALWAYS_FLUSH
if (!n && fflush (f__cf))
err (f__elist->cierr, errno, "write end");
#endif
return (n);
}
libf2c/libI77/wsne.c deleted 100644 → 0
#include "f2c.h"
#include "fio.h"
#include "lio.h"
integer
s_wsne (cilist * a)
{
int n;
if ((n = c_le (a)))
return (n);
f__reading = 0;
f__external = 1;
f__formatted = 1;
f__putn = x_putc;
L_len = LINE;
f__donewrec = x_wSL;
if (f__curunit->uwrt != 1 && f__nowwriting (f__curunit))
err (a->cierr, errno, "namelist output start");
x_wsne (a);
return e_wsle ();
}
libf2c/libI77/xwsne.c deleted 100644 → 0
#include "config.h"
#include "f2c.h"
#include "fio.h"
#include "lio.h"
#include "fmt.h"
extern int f__Aquote;
static void
nl_donewrec (void)
{
(*f__donewrec) ();
PUT (' ');
}
#include <string.h>
void
x_wsne (cilist * a)
{
Namelist *nl;
char *s;
Vardesc *v, **vd, **vde;
ftnint number, type;
ftnlen *dims;
ftnlen size;
extern ftnlen f__typesize[];
nl = (Namelist *) a->cifmt;
PUT ('&');
for (s = nl->name; *s; s++)
PUT (*s);
PUT (' ');
f__Aquote = 1;
vd = nl->vars;
vde = vd + nl->nvars;
while (vd < vde)
{
v = *vd++;
s = v->name;
#ifdef No_Extra_Namelist_Newlines
if (f__recpos + strlen (s) + 2 >= L_len)
#endif
nl_donewrec ();
while (*s)
PUT (*s++);
PUT (' ');
PUT ('=');
number = (dims = v->dims) ? dims[1] : 1;
type = v->type;
if (type < 0)
{
size = -type;
type = TYCHAR;
}
else
size = f__typesize[type];
l_write (&number, v->addr, size, type);
if (vd < vde)
{
if (f__recpos + 2 >= L_len)
nl_donewrec ();
PUT (',');
PUT (' ');
}
else if (f__recpos + 1 >= L_len)
nl_donewrec ();
}
f__Aquote = 0;
PUT ('/');
}
libf2c/libU77/COPYING.LIB deleted 100644 → 0
GNU LESSER GENERAL PUBLIC LICENSE
Version 2.1, February 1999
Copyright (C) 1991, 1999 Free Software Foundation, Inc.
59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
Everyone is permitted to copy and distribute verbatim copies
of this license document, but changing it is not allowed.
[This is the first released version of the Lesser GPL. It also counts
as the successor of the GNU Library Public License, version 2, hence
the version number 2.1.]
Preamble
The licenses for most software are designed to take away your
freedom to share and change it. By contrast, the GNU General Public
Licenses are intended to guarantee your freedom to share and change
free software--to make sure the software is free for all its users.
This license, the Lesser General Public License, applies to some
specially designated software packages--typically libraries--of the
Free Software Foundation and other authors who decide to use it. You
can use it too, but we suggest you first think carefully about whether
this license or the ordinary General Public License is the better
strategy to use in any particular case, based on the explanations below.
When we speak of free software, we are referring to freedom of use,
not price. Our General Public Licenses are designed to make sure that
you have the freedom to distribute copies of free software (and charge
for this service if you wish); that you receive source code or can get
it if you want it; that you can change the software and use pieces of
it in new free programs; and that you are informed that you can do
these things.
To protect your rights, we need to make restrictions that forbid
distributors to deny you these rights or to ask you to surrender these
rights. These restrictions translate to certain responsibilities for
you if you distribute copies of the library or if you modify it.
For example, if you distribute copies of the library, whether gratis
or for a fee, you must give the recipients all the rights that we gave
you. You must make sure that they, too, receive or can get the source
code. If you link other code with the library, you must provide
complete object files to the recipients, so that they can relink them
with the library after making changes to the library and recompiling
it. And you must show them these terms so they know their rights.
We protect your rights with a two-step method: (1) we copyright the
library, and (2) we offer you this license, which gives you legal
permission to copy, distribute and/or modify the library.
To protect each distributor, we want to make it very clear that
there is no warranty for the free library. Also, if the library is
modified by someone else and passed on, the recipients should know
that what they have is not the original version, so that the original
author's reputation will not be affected by problems that might be
introduced by others.
Finally, software patents pose a constant threat to the existence of
any free program. We wish to make sure that a company cannot
effectively restrict the users of a free program by obtaining a
restrictive license from a patent holder. Therefore, we insist that
any patent license obtained for a version of the library must be
consistent with the full freedom of use specified in this license.
Most GNU software, including some libraries, is covered by the
ordinary GNU General Public License. This license, the GNU Lesser
General Public License, applies to certain designated libraries, and
is quite different from the ordinary General Public License. We use
this license for certain libraries in order to permit linking those
libraries into non-free programs.
When a program is linked with a library, whether statically or using
a shared library, the combination of the two is legally speaking a
combined work, a derivative of the original library. The ordinary
General Public License therefore permits such linking only if the
entire combination fits its criteria of freedom. The Lesser General
Public License permits more lax criteria for linking other code with
the library.
We call this license the "Lesser" General Public License because it
does Less to protect the user's freedom than the ordinary General
Public License. It also provides other free software developers Less
of an advantage over competing non-free programs. These disadvantages
are the reason we use the ordinary General Public License for many
libraries. However, the Lesser license provides advantages in certain
special circumstances.
For example, on rare occasions, there may be a special need to
encourage the widest possible use of a certain library, so that it becomes
a de-facto standard. To achieve this, non-free programs must be
allowed to use the library. A more frequent case is that a free
library does the same job as widely used non-free libraries. In this
case, there is little to gain by limiting the free library to free
software only, so we use the Lesser General Public License.
In other cases, permission to use a particular library in non-free
programs enables a greater number of people to use a large body of
free software. For example, permission to use the GNU C Library in
non-free programs enables many more people to use the whole GNU
operating system, as well as its variant, the GNU/Linux operating
system.
Although the Lesser General Public License is Less protective of the
users' freedom, it does ensure that the user of a program that is
linked with the Library has the freedom and the wherewithal to run
that program using a modified version of the Library.
The precise terms and conditions for copying, distribution and
modification follow. Pay close attention to the difference between a
"work based on the library" and a "work that uses the library". The
former contains code derived from the library, whereas the latter must
be combined with the library in order to run.
GNU LESSER GENERAL PUBLIC LICENSE
TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
0. This License Agreement applies to any software library or other
program which contains a notice placed by the copyright holder or
other authorized party saying it may be distributed under the terms of
this Lesser General Public License (also called "this License").
Each licensee is addressed as "you".
A "library" means a collection of software functions and/or data
prepared so as to be conveniently linked with application programs
(which use some of those functions and data) to form executables.
The "Library", below, refers to any such software library or work
which has been distributed under these terms. A "work based on the
Library" means either the Library or any derivative work under
copyright law: that is to say, a work containing the Library or a
portion of it, either verbatim or with modifications and/or translated
straightforwardly into another language. (Hereinafter, translation is
included without limitation in the term "modification".)
"Source code" for a work means the preferred form of the work for
making modifications to it. For a library, complete source code means
all the source code for all modules it contains, plus any associated
interface definition files, plus the scripts used to control compilation
and installation of the library.
Activities other than copying, distribution and modification are not
covered by this License; they are outside its scope. The act of
running a program using the Library is not restricted, and output from
such a program is covered only if its contents constitute a work based
on the Library (independent of the use of the Library in a tool for
writing it). Whether that is true depends on what the Library does
and what the program that uses the Library does.
1. You may copy and distribute verbatim copies of the Library's
complete source code as you receive it, in any medium, provided that
you conspicuously and appropriately publish on each copy an
appropriate copyright notice and disclaimer of warranty; keep intact
all the notices that refer to this License and to the absence of any
warranty; and distribute a copy of this License along with the
Library.
You may charge a fee for the physical act of transferring a copy,
and you may at your option offer warranty protection in exchange for a
fee.
2. You may modify your copy or copies of the Library or any portion
of it, thus forming a work based on the Library, and copy and
distribute such modifications or work under the terms of Section 1
above, provided that you also meet all of these conditions:
a) The modified work must itself be a software library.
b) You must cause the files modified to carry prominent notices
stating that you changed the files and the date of any change.
c) You must cause the whole of the work to be licensed at no
charge to all third parties under the terms of this License.
d) If a facility in the modified Library refers to a function or a
table of data to be supplied by an application program that uses
the facility, other than as an argument passed when the facility
is invoked, then you must make a good faith effort to ensure that,
in the event an application does not supply such function or
table, the facility still operates, and performs whatever part of
its purpose remains meaningful.
(For example, a function in a library to compute square roots has
a purpose that is entirely well-defined independent of the
application. Therefore, Subsection 2d requires that any
application-supplied function or table used by this function must
be optional: if the application does not supply it, the square
root function must still compute square roots.)
These requirements apply to the modified work as a whole. If
identifiable sections of that work are not derived from the Library,
and can be reasonably considered independent and separate works in
themselves, then this License, and its terms, do not apply to those
sections when you distribute them as separate works. But when you
distribute the same sections as part of a whole which is a work based
on the Library, the distribution of the whole must be on the terms of
this License, whose permissions for other licensees extend to the
entire whole, and thus to each and every part regardless of who wrote
it.
Thus, it is not the intent of this section to claim rights or contest
your rights to work written entirely by you; rather, the intent is to
exercise the right to control the distribution of derivative or
collective works based on the Library.
In addition, mere aggregation of another work not based on the Library
with the Library (or with a work based on the Library) on a volume of
a storage or distribution medium does not bring the other work under
the scope of this License.
3. You may opt to apply the terms of the ordinary GNU General Public
License instead of this License to a given copy of the Library. To do
this, you must alter all the notices that refer to this License, so
that they refer to the ordinary GNU General Public License, version 2,
instead of to this License. (If a newer version than version 2 of the
ordinary GNU General Public License has appeared, then you can specify
that version instead if you wish.) Do not make any other change in
these notices.
Once this change is made in a given copy, it is irreversible for
that copy, so the ordinary GNU General Public License applies to all
subsequent copies and derivative works made from that copy.
This option is useful when you wish to copy part of the code of
the Library into a program that is not a library.
4. You may copy and distribute the Library (or a portion or
derivative of it, under Section 2) in object code or executable form
under the terms of Sections 1 and 2 above provided that you accompany
it with the complete corresponding machine-readable source code, which
must be distributed under the terms of Sections 1 and 2 above on a
medium customarily used for software interchange.
If distribution of object code is made by offering access to copy
from a designated place, then offering equivalent access to copy the
source code from the same place satisfies the requirement to
distribute the source code, even though third parties are not
compelled to copy the source along with the object code.
5. A program that contains no derivative of any portion of the
Library, but is designed to work with the Library by being compiled or
linked with it, is called a "work that uses the Library". Such a
work, in isolation, is not a derivative work of the Library, and
therefore falls outside the scope of this License.
However, linking a "work that uses the Library" with the Library
creates an executable that is a derivative of the Library (because it
contains portions of the Library), rather than a "work that uses the
library". The executable is therefore covered by this License.
Section 6 states terms for distribution of such executables.
When a "work that uses the Library" uses material from a header file
that is part of the Library, the object code for the work may be a
derivative work of the Library even though the source code is not.
Whether this is true is especially significant if the work can be
linked without the Library, or if the work is itself a library. The
threshold for this to be true is not precisely defined by law.
If such an object file uses only numerical parameters, data
structure layouts and accessors, and small macros and small inline
functions (ten lines or less in length), then the use of the object
file is unrestricted, regardless of whether it is legally a derivative
work. (Executables containing this object code plus portions of the
Library will still fall under Section 6.)
Otherwise, if the work is a derivative of the Library, you may
distribute the object code for the work under the terms of Section 6.
Any executables containing that work also fall under Section 6,
whether or not they are linked directly with the Library itself.
6. As an exception to the Sections above, you may also combine or
link a "work that uses the Library" with the Library to produce a
work containing portions of the Library, and distribute that work
under terms of your choice, provided that the terms permit
modification of the work for the customer's own use and reverse
engineering for debugging such modifications.
You must give prominent notice with each copy of the work that the
Library is used in it and that the Library and its use are covered by
this License. You must supply a copy of this License. If the work
during execution displays copyright notices, you must include the
copyright notice for the Library among them, as well as a reference
directing the user to the copy of this License. Also, you must do one
of these things:
a) Accompany the work with the complete corresponding
machine-readable source code for the Library including whatever
changes were used in the work (which must be distributed under
Sections 1 and 2 above); and, if the work is an executable linked
with the Library, with the complete machine-readable "work that
uses the Library", as object code and/or source code, so that the
user can modify the Library and then relink to produce a modified
executable containing the modified Library. (It is understood
that the user who changes the contents of definitions files in the
Library will not necessarily be able to recompile the application
to use the modified definitions.)
b) Use a suitable shared library mechanism for linking with the
Library. A suitable mechanism is one that (1) uses at run time a
copy of the library already present on the user's computer system,
rather than copying library functions into the executable, and (2)
will operate properly with a modified version of the library, if
the user installs one, as long as the modified version is
interface-compatible with the version that the work was made with.
c) Accompany the work with a written offer, valid for at
least three years, to give the same user the materials
specified in Subsection 6a, above, for a charge no more
than the cost of performing this distribution.
d) If distribution of the work is made by offering access to copy
from a designated place, offer equivalent access to copy the above
specified materials from the same place.
e) Verify that the user has already received a copy of these
materials or that you have already sent this user a copy.
For an executable, the required form of the "work that uses the
Library" must include any data and utility programs needed for
reproducing the executable from it. However, as a special exception,
the materials to be distributed need not include anything that is
normally distributed (in either source or binary form) with the major
components (compiler, kernel, and so on) of the operating system on
which the executable runs, unless that component itself accompanies
the executable.
It may happen that this requirement contradicts the license
restrictions of other proprietary libraries that do not normally
accompany the operating system. Such a contradiction means you cannot
use both them and the Library together in an executable that you
distribute.
7. You may place library facilities that are a work based on the
Library side-by-side in a single library together with other library
facilities not covered by this License, and distribute such a combined
library, provided that the separate distribution of the work based on
the Library and of the other library facilities is otherwise
permitted, and provided that you do these two things:
a) Accompany the combined library with a copy of the same work
based on the Library, uncombined with any other library
facilities. This must be distributed under the terms of the
Sections above.
b) Give prominent notice with the combined library of the fact
that part of it is a work based on the Library, and explaining
where to find the accompanying uncombined form of the same work.
8. You may not copy, modify, sublicense, link with, or distribute
the Library except as expressly provided under this License. Any
attempt otherwise to copy, modify, sublicense, link with, or
distribute the Library is void, and will automatically terminate your
rights under this License. However, parties who have received copies,
or rights, from you under this License will not have their licenses
terminated so long as such parties remain in full compliance.
9. You are not required to accept this License, since you have not
signed it. However, nothing else grants you permission to modify or
distribute the Library or its derivative works. These actions are
prohibited by law if you do not accept this License. Therefore, by
modifying or distributing the Library (or any work based on the
Library), you indicate your acceptance of this License to do so, and
all its terms and conditions for copying, distributing or modifying
the Library or works based on it.
10. Each time you redistribute the Library (or any work based on the
Library), the recipient automatically receives a license from the
original licensor to copy, distribute, link with or modify the Library
subject to these terms and conditions. You may not impose any further
restrictions on the recipients' exercise of the rights granted herein.
You are not responsible for enforcing compliance by third parties with
this License.
11. If, as a consequence of a court judgment or allegation of patent
infringement or for any other reason (not limited to patent issues),
conditions are imposed on you (whether by court order, agreement or
otherwise) that contradict the conditions of this License, they do not
excuse you from the conditions of this License. If you cannot
distribute so as to satisfy simultaneously your obligations under this
License and any other pertinent obligations, then as a consequence you
may not distribute the Library at all. For example, if a patent
license would not permit royalty-free redistribution of the Library by
all those who receive copies directly or indirectly through you, then
the only way you could satisfy both it and this License would be to
refrain entirely from distribution of the Library.
If any portion of this section is held invalid or unenforceable under any
particular circumstance, the balance of the section is intended to apply,
and the section as a whole is intended to apply in other circumstances.
It is not the purpose of this section to induce you to infringe any
patents or other property right claims or to contest validity of any
such claims; this section has the sole purpose of protecting the
integrity of the free software distribution system which is
implemented by public license practices. Many people have made
generous contributions to the wide range of software distributed
through that system in reliance on consistent application of that
system; it is up to the author/donor to decide if he or she is willing
to distribute software through any other system and a licensee cannot
impose that choice.
This section is intended to make thoroughly clear what is believed to
be a consequence of the rest of this License.
12. If the distribution and/or use of the Library is restricted in
certain countries either by patents or by copyrighted interfaces, the
original copyright holder who places the Library under this License may add
an explicit geographical distribution limitation excluding those countries,
so that distribution is permitted only in or among countries not thus
excluded. In such case, this License incorporates the limitation as if
written in the body of this License.
13. The Free Software Foundation may publish revised and/or new
versions of the Lesser General Public License from time to time.
Such new versions will be similar in spirit to the present version,
but may differ in detail to address new problems or concerns.
Each version is given a distinguishing version number. If the Library
specifies a version number of this License which applies to it and
"any later version", you have the option of following the terms and
conditions either of that version or of any later version published by
the Free Software Foundation. If the Library does not specify a
license version number, you may choose any version ever published by
the Free Software Foundation.
14. If you wish to incorporate parts of the Library into other free
programs whose distribution conditions are incompatible with these,
write to the author to ask for permission. For software which is
copyrighted by the Free Software Foundation, write to the Free
Software Foundation; we sometimes make exceptions for this. Our
decision will be guided by the two goals of preserving the free status
of all derivatives of our free software and of promoting the sharing
and reuse of software generally.
NO WARRANTY
15. BECAUSE THE LIBRARY IS LICENSED FREE OF CHARGE, THERE IS NO
WARRANTY FOR THE LIBRARY, TO THE EXTENT PERMITTED BY APPLICABLE LAW.
EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR
OTHER PARTIES PROVIDE THE LIBRARY "AS IS" WITHOUT WARRANTY OF ANY
KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE
IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE
LIBRARY IS WITH YOU. SHOULD THE LIBRARY PROVE DEFECTIVE, YOU ASSUME
THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION.
16. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN
WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY
AND/OR REDISTRIBUTE THE LIBRARY AS PERMITTED ABOVE, BE LIABLE TO YOU
FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR
CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE
LIBRARY (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING
RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A
FAILURE OF THE LIBRARY TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF
SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH
DAMAGES.
END OF TERMS AND CONDITIONS
How to Apply These Terms to Your New Libraries
If you develop a new library, and you want it to be of the greatest
possible use to the public, we recommend making it free software that
everyone can redistribute and change. You can do so by permitting
redistribution under these terms (or, alternatively, under the terms of the
ordinary General Public License).
To apply these terms, attach the following notices to the library. It is
safest to attach them to the start of each source file to most effectively
convey the exclusion of warranty; and each file should have at least the
"copyright" line and a pointer to where the full notice is found.
<one line to give the library's name and a brief idea of what it does.>
Copyright (C) <year> <name of author>
This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public
License as published by the Free Software Foundation; either
version 2.1 of the License, or (at your option) any later version.
This library 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
Lesser General Public License for more details.
You should have received a copy of the GNU Lesser General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
Also add information on how to contact you by electronic and paper mail.
You should also get your employer (if you work as a programmer) or your
school, if any, to sign a "copyright disclaimer" for the library, if
necessary. Here is a sample; alter the names:
Yoyodyne, Inc., hereby disclaims all copyright interest in the
library `Frob' (a library for tweaking knobs) written by James Random Hacker.
<signature of Ty Coon>, 1 April 1990
Ty Coon, President of Vice
That's all there is to it!
libf2c/libU77/Makefile.in deleted 100644 → 0
# Makefile for GNU F77 compiler runtime, libc interface.
# Copyright (C) 1995-1998, 2001 Free Software Foundation, Inc.
# Contributed by Dave Love (d.love@dl.ac.uk).
#
#This file is part of the GNU Fortran libU77 library.
#
#The GNU Fortran libU77 library is free software; you can redistribute
#it and/or modify it under the terms of the GNU Library General Public
#License as published by the Free Software Foundation; either version 2,
#or (at your option) any later version.
#
#GNU Fortran 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 Library General Public License for more details.
#
#You should have received a copy of the GNU General Public License
#along with GNU Fortran; see the file COPYING. If not, write to
#the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
#02111-1307, USA.
#### Start of system configuration section. ####
# $(srcdir) must be set to the g77 runtime libU77 source directory
srcdir = @srcdir@
VPATH = @srcdir@
# configure sets this to all the -D options appropriate for the
# configuration.
DEFS = @DEFS@
LIBS = @LIBS@
F2C_H_DIR = @srcdir@/..
G2C_H_DIR = ..
CC = @CC@
CFLAGS = @CFLAGS@
CPPFLAGS = @CPPFLAGS@
@SET_MAKE@
SHELL = @SHELL@
#### End of system configuration section. ####
# fio.h is in libI77. config.h is in `.'.
ALL_CFLAGS = -I. -I$(srcdir) -I$(F2C_H_DIR)/libI77 -I$(G2C_H_DIR) \
-I$(F2C_H_DIR) $(CPPFLAGS) $(DEFS) $(WARN_CFLAGS) $(CFLAGS)
# This could probably be done more elegantly, but it's currently
# just for running the u77-test test.
G77DIR = ../../../gcc/
.SUFFIXES:
.SUFFIXES: .c .lo
.c.lo:
@LIBTOOL@ --mode=compile $(CC) -c -DSkip_f2c_Undefs $(ALL_CFLAGS) $<
OBJS = VersionU.lo gerror_.lo perror_.lo ierrno_.lo itime_.lo time_.lo \
unlink_.lo fnum_.lo getpid_.lo getuid_.lo getgid_.lo kill_.lo rand_.lo \
srand_.lo irand_.lo sleep_.lo idate_.lo ctime_.lo etime_.lo \
dtime_.lo isatty_.lo ltime_.lo fstat_.lo stat_.lo \
lstat_.lo access_.lo link_.lo getlog_.lo ttynam_.lo getcwd_.lo symlnk_.lo \
vxttime_.lo vxtidate_.lo gmtime_.lo fdate_.lo secnds_.lo \
chdir_.lo chmod_.lo lnblnk_.lo hostnm_.lo rename_.lo fgetc_.lo fputc_.lo \
umask_.lo sys_clock_.lo date_.lo second_.lo flush1_.lo mclock_.lo \
alarm_.lo datetime_.lo
SRCS = Version.c gerror_.c perror_.c ierrno_.c itime_.c time_.c \
unlink_.c fnum_.c getpid_.c getuid_.c getgid_.c kill_.c rand_.c \
srand_.c irand_.c sleep_.c idate_.c ctime_.c etime_.c \
dtime_.c isatty_.c ltime_.c fstat_.c stat_.c \
lstat_.c access_.c link_.c getlog_.c ttynam_.c getcwd_.c symlnk_.c \
vxttime_.c vxtidate_.c gmtime_.c fdate_.c secnds_.c \
chdir_.c chmod_.c lnblnk_.c hostnm_.c rename_.c fgetc_.c fputc_.c \
umask_.c sys_clock_.c date_.c second_.c flush1_.c mclock_.c \
alarm_.c datetime_.c
all: ../s-libu77
../s-libu77: $(OBJS)
-rm -f $@.T $@
objs='$(OBJS)'; for name in $$objs; do \
echo libU77/$${name} >> $@.T; done
mv $@.T $@
Makefile: Makefile.in config.status
$(SHELL) config.status
config.status: configure
rm -f config.cache
CONFIG_SITE=no-such-file CC='$(CC)' CFLAGS='$(CFLAGS)' \
CPPFLAGS='$(CPPFLAGS)' $(SHELL) config.status --recheck
${srcdir}/configure: configure.in
cd ${srcdir} && autoconf
${srcdir}/config.hin: stamp-h.in
${srcdir}/stamp-h.in: configure.in acconfig.h
cd ${srcdir} && autoheader
echo timestamp > ${srcdir}/stamp-h.in
config.h: stamp-h
stamp-h: config.hin config.status
$(SHELL) config.status
echo timestamp > stamp-h
VersionU.lo: Version.c
@LIBTOOL@ --mode=compile $(CC) -c $(ALL_CFLAGS) $(srcdir)/Version.c -o $@
$(OBJS): $(F2C_H_DIR)/f2c.h $(G2C_H_DIR)/g2c.h config.h
access_.lo: access_.c
ctime_.lo: ctime_.c
dtime_.lo: dtime_.c
etime_.lo: etime_.c
fnum_.lo: fnum_.c $(F2C_H_DIR)/libI77/fio.h
fstat_.lo: fstat_.c
gerror_.lo: gerror_.c
getcwd_.lo: getcwd_.c
getgid_.lo: getgid_.c
getlog_.lo: getlog_.c
getpid_.lo: getpid_.c
getuid_.lo: getuid_.c
idate_.lo: idate_.c
ierrno_.lo: ierrno_.c
irand_.lo: irand_.c
isatty_.lo: isatty_.c $(F2C_H_DIR)/libI77/fio.h
itime_.lo: itime_.c
kill_.lo: kill_.c
link_.lo: link_.c
loc_.lo: loc_.c
lstat_.lo: lstat_.c
ltime_.lo: ltime_.c
perror_.lo: perror_.c
qsort.lo: qsort.c
qsort_.lo: qsort_.c
rand_.lo: rand_.c
rename_.lo: rename_.c
second_.lo: second_.c
sleep_.lo: sleep_.c
srand_.lo: srand_.c
stat_.lo: stat_.c
symlnk_.lo: symlnk_.c
time_.lo: time_.c
ttynam_.lo: ttynam_.c
unlink_.lo: unlink_.c
wait_.lo: wait_.c
vxttime_.lo: vxttime_.c
vtxidate_.lo: vxtidate_.c
fdate_.lo: fdate_.c
gmtime_.lo: gmtime_.c
secnds_.lo: secnds_.c
lnblnk_.lo: lnblnk_.c
chmod_.lo: chmod_.c
chdir_.lo: chdir_.c
hostnm_.lo: hostnm_.c
rename_.lo: rename_.c
fputc_.lo: fputc_.c
fgetc_.lo: fgetc_.c
sys_clock_.lo: sys_clock_.c
date_.lo: date_.c
umask_.lo: umask_.c
flush1_.lo: flush1_.c
mclock_.lo: mclock_.c
alarm_.lo: alarm_.c
datetime_.lo: datetime_.c
check:
-$(G77DIR)g77 -B$(G77DIR) -L.. -g $(srcdir)/u77-test.f \
-lg2c $(LIBS) -lm -o a.out && ./a.out
rm -f a.out
install uninstall install-strip dist installcheck installdirs:
mostlyclean:
rm -f *.o *.lo a.out
rm -rf .libs
clean: mostlyclean
rm -f config.log ../s-libu77
distclean: clean
rm -f config.cache config.status Makefile config.h stamp.h \
../s-libu77 configure
maintainer-clean:
.PHONY: mostlyclean clean distclean maintainer-clean all check uninstall \
install-strip dist installcheck installdirs archive
libf2c/libU77/PROJECTS deleted 100644 → 0
-*- indented-text-*-
* Interface to strget
* Non-blocking (`asynchronous') i/o (per c.l.f. discussion)
* `ioinit'-type routine for various i/o options
* IEEE/VAX/... number format conversion (or XDR interface). This
might be made optionally transparent per logical unit a la DECtran.
libf2c/libU77/README deleted 100644 → 0
19970811 -*-text-*-
g77 libU77
----------
This directory contains an implementation of most of the `traditional'
Unix libU77 routines, mostly an interface to libc and libm routines
and some extra ones for time and date etc. It's intended for use with
g77, to whose configuration procedure it's currently tied, but should
be compatible with f2c otherwise, if using the same f2c.h.
The contents of libU77 and its interfaces aren't consistent across
implementations. This one is mostly taken from documentation for (an
old version of) the Convex implementation and the v2 SunPro one.
As of g77 version 0.5.20, most of these routines have been made
into g77 intrinsics. Some routines have a version with a name prefixed
by `vxt', corresponding to the VMS Fortran versions, and these should
be integrated with g77's intrinsics visibility control.
A few routines are currently missing; in the case of `fork', for
instance, because they're probably not useful, and in the case of
`qsort' and those for stream-based i/o handling, because they need
more effort/research. The configuration should weed out those few
which correspond to facilities which may not be present on some Unix
systems, such as symbolic links. It's unclear whether the interfaces
to the native library random number routines should be retained, since
their implementation is likely to be something one should avoid
assiduously.
This library has been tested it under SunOS4.1.3 and Irix5.2 and there
has been some feedback from Linux; presumably potential problems lie
mainly with systems with impoverished native C library support which
haven't been properly taken care of with autoconf.
There's another GPL'd implementation of this stuff which I only found
out about recently (despite having looked) and I haven't yet checked
how they should be amalgamated.
Dave Love <d.love@dl.ac.uk> Aug '95
(minor changes by Craig Burley <burley@gnu.org> Aug '97)
libf2c/libU77/Version.c deleted 100644 → 0
const char __LIBU77_VERSION__[] = "@(#) LIBU77 VERSION 19980709\n";
libf2c/libU77/access_.c deleted 100644 → 0
/* Copyright (C) 1995, 1997 Free Software Foundation, Inc.
This file is part of GNU Fortran libU77 library.
This library is free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published
by the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
GNU Fortran 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
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with GNU Fortran; see the file COPYING.LIB. If
not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA. */
#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
#if HAVE_UNISTD_H
# include <unistd.h>
#endif
#if HAVE_STDLIB_H
# include <stdlib.h>
#else
# include <stdio.h>
#endif
#include <errno.h>
#include <limits.h>
#include "f2c.h"
#ifndef R_OK /* for SVR1-2 */
# define R_OK 4
#endif
#ifndef W_OK
# define W_OK 2
#endif
#ifndef X_OK
# define X_OK 1
#endif
#ifndef F_OK
# define F_OK 0
#endif
void g_char (const char *a, ftnlen alen, char *b);
integer
G77_access_0 (const char *name, const char *mode, ftnlen Lname, ftnlen Lmode)
{
char *buff;
int amode, i;
buff = malloc (Lname + 1);
if (!buff)
return -1;
g_char (name, Lname, buff);
amode = 0;
for (i = 0; i < Lmode; i++)
{
switch (mode[i])
{
case 'r':
amode |= R_OK;
break;
case 'w':
amode |= W_OK;
break;
case 'x':
amode |= X_OK;
break;
case ' ':
amode |= F_OK;
break; /* as per Sun, at least */
default:
return EINVAL;
}
}
i = access (buff, amode);
free (buff);
return i;
}
libf2c/libU77/acconfig.h deleted 100644 → 0
/* Define as the path of the `chmod' program. */
#undef CHMOD_PATH
/* Define if your sys/time.h defines struct timezone. */
#undef HAVE_STRUCT_TIMEZONE
/* Define if your gettimeofday takes only one argument. */
#undef GETTIMEOFDAY_ONE_ARGUMENT
/* Define if your gettimeofday takes a time zome argument. */
#undef HAVE_TIMEZONE
libf2c/libU77/aclocal.m4 deleted 100644 → 0
dnl Check:
dnl * If we have gettimeofday;
dnl * If we have struct timezone for use in calling it;
dnl * If calling it with a timezone pointer actually works -- this is deemed
dnl obsolete or undefined on some systems which say you should use a null
dnl pointer -- and undefine HAVE_TIMEZONE if so;
dnl * Whether it only takes one arg.
AC_DEFUN(LIBU77_GETTIMEOFDAY, [
AC_CHECK_FUNCS(gettimeofday)
if test "$ac_cv_func_gettimeofday" = yes; then
AC_CACHE_CHECK([for struct timezone], g77_cv_struct_timezone,
[AC_TRY_COMPILE([#include <sys/time.h>],
[struct timezone tz;],
g77_cv_struct_timezone=yes, g77_cv_struct_timezone=no)])
if test $g77_cv_struct_timezone = yes; then
dnl It may be that we can't call gettimeofday with a non-null pointer.
dnl In that case we'll lie about struct timezone.
AC_TRY_RUN([
#ifdef TIME_WITH_SYS_TIME
#include <sys/time.h>
#include <time.h>
#else
#ifdef HAVE_SYS_TIME_H
#include <sys/time.h>
#else
#include <time.h>
#endif
#endif
main ()
{
struct timeval time;
struct timezone dummy;
if (gettimeofday (&time, &dummy))
exit (1);
else
exit (0);
}],
[AC_DEFINE(HAVE_TIMEZONE)], ,[AC_DEFINE(HAVE_TIMEZONE)])
fi
AC_REQUIRE([AC_HEADER_TIME])
AC_CACHE_CHECK(whether gettimeofday can accept two arguments,
emacs_cv_gettimeofday_two_arguments,
AC_TRY_LINK([
#ifdef TIME_WITH_SYS_TIME
#include <sys/time.h>
#include <time.h>
#else
#ifdef HAVE_SYS_TIME_H
#include <sys/time.h>
#else
#include <time.h>
#endif
#endif
],
[
struct timeval time;
#ifdef HAVE_TIMEZONE
struct timezone dummy;
#define DUMMY &dummy
#else
#define DUMMY NULL
#endif
gettimeofday (&time, DUMMY);],
emacs_cv_gettimeofday_two_arguments=yes,
emacs_cv_gettimeofday_two_arguments=no))
if test $emacs_cv_gettimeofday_two_arguments = no; then
AC_DEFINE(GETTIMEOFDAY_ONE_ARGUMENT)
fi
fi])
libf2c/libU77/alarm_.c deleted 100644 → 0
/* Copyright (C) 1997, 2001 Free Software Foundation, Inc.
This file is part of GNU Fortran libU77 library.
This library is free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published
by the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
GNU Fortran 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
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with GNU Fortran; see the file COPYING.LIB. If
not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA. */
#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
#if HAVE_UNISTD_H
# include <unistd.h>
#endif
#include <errno.h> /* for ENOSYS */
#include "f2c.h"
#ifndef RETSIGTYPE
/* we shouldn't rely on this... */
#define RETSIGTYPE void
#endif
typedef RETSIGTYPE (*sig_type) ();
#include <signal.h>
typedef int (*sig_proc) (int);
#ifndef SIG_ERR
#define SIG_ERR ((sig_type) -1)
#endif
integer
G77_alarm_0 (integer * seconds, sig_proc proc)
{
int status;
#if defined (HAVE_ALARM) && defined (SIGALRM)
if (signal (SIGALRM, (sig_type) proc) == SIG_ERR)
status = -1;
else
status = alarm (*seconds);
#else /* ! HAVE_ALARM || ! SIGALRM */
errno = ENOSYS;
status = -1;
#endif
return status;
}
libf2c/libU77/chdir_.c deleted 100644 → 0
/* Copyright (C) 1995, 1997 Free Software Foundation, Inc.
This file is part of GNU Fortran libU77 library.
This library is free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published
by the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
GNU Fortran 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
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with GNU Fortran; see the file COPYING.LIB. If
not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA. */
#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
#if HAVE_UNISTD_H
# include <unistd.h>
#endif
#if HAVE_STDLIB_H
# include <stdlib.h>
#else
# include <stdio.h>
#endif
#include <errno.h>
#include "f2c.h"
void g_char (const char *a, ftnlen alen, char *b);
integer
G77_chdir_0 (const char *name, const ftnlen Lname)
{
char *buff;
int i;
buff = malloc (Lname + 1);
if (!buff)
return -1;
g_char (name, Lname, buff);
i = chdir (buff);
free (buff);
return i ? errno : 0;
}
libf2c/libU77/chmod_.c deleted 100644 → 0
/* Copyright (C) 1995, 1997 Free Software Foundation, Inc.
This file is part of GNU Fortran libU77 library.
This library is free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published
by the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
GNU Fortran 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
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with GNU Fortran; see the file COPYING.LIB. If
not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA. */
/* This definitely shouldn't be done this way -- should canibalise
chmod(1) from GNU or BSD. */
#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
#if HAVE_UNISTD_H
# include <unistd.h>
#endif
#if HAVE_STDLIB_H
# include <stdlib.h>
#else
# include <stdio.h>
#endif
#if STDC_HEADERS
# include <string.h>
#endif
#include "f2c.h"
#ifndef CHMOD_PATH
#define CHMOD_PATH "/bin/chmod"
#endif
extern void s_cat (char *lp, char *rpp[], ftnlen rnp[], ftnlen * np,
ftnlen ll);
void g_char (const char *a, ftnlen alen, char *b);
integer
G77_chmod_0 ( /* const */ char *name, /* const */ char *mode,
const ftnlen Lname, const ftnlen Lmode)
{
char *buff;
int i;
ftnlen l, l2;
ftnlen six = 6;
address a[6];
ftnlen ii[6];
char chmod_path[] = CHMOD_PATH;
l = strlen (chmod_path);
buff = malloc (Lname + Lmode + l + 3 + 13 + 1);
if (!buff)
return -1;
ii[0] = l;
a[0] = chmod_path;
ii[1] = 1;
a[1] = " ";
ii[2] = Lmode;
a[2] = mode;
ii[3] = 2;
a[3] = " '";
for (l2 = Lname; (l2 > 1) && (name[l2 - 1] == ' ');)
l2--;
ii[4] = l2;
a[4] = name;
ii[5] = 13;
a[5] = "' 2>/dev/null";
s_cat (buff, a, ii, &six, Lname + Lmode + l + 3 + 13);
buff[Lname + Lmode + l + 3 + 13] = '\0';
i = system (buff);
free (buff);
return i;
}
libf2c/libU77/configure.in deleted 100644 → 0
# Process this file with autoconf to produce a configure script.
# Copyright (C) 1995, 1998, 1999 Free Software Foundation, Inc.
# Contributed by Dave Love (d.love@dl.ac.uk).
#
#This file is part of the GNU Fortran libU77 library.
#
#This library 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.
#
#GNU Fortran 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 Library General Public License for more details.
#
#You should have received a copy of the GNU Library General Public
#License along with GNU Fortran; see the file COPYING. If not, write
#to Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307,
#USA.
AC_PREREQ(2.13)
AC_INIT(access_.c)
AC_CONFIG_HEADER(config.h:config.hin)
dnl FIXME AC_PROG_CC wants CC to be able to link things, but it may
dnl not be able to.
define([AC_PROG_CC_WORKS],[])
# For g77 we'll set CC to point at the built gcc, but this will get it into
# the makefiles
AC_PROG_CC
# These defines are necessary to get 64-bit file size support.
# NetBSD 1.4 header files does not support XOPEN_SOURCE == 600, but it
# handles 64-bit file sizes without needing these defines.
AC_MSG_CHECKING(whether _XOPEN_SOURCE may be defined)
AC_TRY_COMPILE([#define _XOPEN_SOURCE 600L
#include <unistd.h>],,
may_use_xopen_source=yes,
may_use_xopen_source=no)
AC_MSG_RESULT($may_use_xopen_source)
if test $may_use_xopen_source = yes; then
AC_DEFINE(_XOPEN_SOURCE, 600L, [Get Single Unix Specification semantics])
# The following is needed by irix6.2 so that struct timeval is declared.
AC_DEFINE(_XOPEN_SOURCE_EXTENDED, 1, [Get Single Unix Specification semantics])
# The following is needed by Solaris2.5.1 so that struct timeval is declared.
AC_DEFINE(__EXTENSIONS__, 1, [Solaris extensions])
AC_DEFINE(_FILE_OFFSET_BITS, 64, [Get 64-bit file size support])
# The following is needed by glibc2 so that gethostname is declared.
AC_DEFINE(_GNU_SOURCE, 1, [Get GNU extensions])
fi
dnl Checks for programs.
LIBTOOL='$(SHELL) ../libtool'
AC_SUBST(LIBTOOL)
dnl AC_C_CROSS
dnl Gives misleading `(cached)' message from the check.
if test "$CROSS";then
ac_cv_c_cross=yes
else
ac_cv_c_cross=no
fi
test "$AR" || AR=ar
AC_SUBST(AR)
AC_PROG_MAKE_SET
dnl This is only because we (horribly) punt the chmod job to the program at
dnl present. Note that the result of this test could be wrong in the cross
dnl case.
AC_PATH_PROG(ac_cv_prog_chmod, chmod, no)
if test "$ac_cv_prog_chmod" != no || test "$CROSS"; then
MAYBES=chmod_.o
AC_DEFINE_UNQUOTED(CHMOD_PATH,"$ac_cv_prog_chmod")
else
MAYBES=""
fi
dnl Checks for header files.
AC_HEADER_STDC
AC_HEADER_TIME
AC_CHECK_HEADERS(limits.h unistd.h sys/time.h string.h stdlib.h \
sys/param.h sys/times.h)
dnl Checks for typedefs, structures, and compiler characteristics.
AC_C_CONST
AC_TYPE_SIZE_T
AC_TYPE_MODE_T
AC_TYPE_PID_T
dnl The next 3 demand a dummy fileblocks.o (added to LIBOJS). We don't use
dnl LIBOJS, though.
AC_STRUCT_ST_BLKSIZE
AC_STRUCT_ST_BLOCKS
AC_STRUCT_ST_RDEV
AC_STRUCT_TM
dnl Some systems (SVR4, SCO OpenServer) need -lsocket for gethostname()
AC_CHECK_LIB(socket, gethostname, [LIBS="$LIBS -lsocket"])
dnl Checks for library functions.
AC_CHECK_FUNCS(symlink getcwd getwd lstat gethostname strerror clock \
getrusage times alarm getlogin getgid getuid kill link ttyname)
dnl The standard autoconf HAVE_STRUCT_TIMEZONE doesn't actually check
dnl for struct timezone, as you might think. We also need to check how
dnl to call gettimeofday if we have it.
LIBU77_GETTIMEOFDAY
test $ac_cv_func_symlink = yes && MAYBES="$MAYBES symlnk_.o"
test $ac_cv_func_lstat = yes && MAYBES="$MAYBES lstat_.o"
test $ac_cv_func_gethostname = yes && MAYBES="$MAYBES hostnm_.o"
test $ac_cv_func_clock = yes && MAYBES="$MAYBES mclock_.o"
AC_SUBST(MAYBES)
AC_SUBST(CROSS)
AC_SUBST(RANLIB)
AC_SUBST(RANLIB_TEST)
AC_OUTPUT(Makefile)
libf2c/libU77/ctime_.c deleted 100644 → 0
/* Copyright (C) 1995, 1996, 2001 Free Software Foundation, Inc.
This file is part of GNU Fortran libU77 library.
This library is free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published
by the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
GNU Fortran 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
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with GNU Fortran; see the file COPYING.LIB. If
not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA. */
#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
#include <sys/types.h>
#if TIME_WITH_SYS_TIME
# include <sys/time.h>
# include <time.h>
#else
# if HAVE_SYS_TIME_H
# include <sys/time.h>
# else
# include <time.h>
# endif
#endif
#if HAVE_STRING_H
# include <string.h>
#else
# include <strings.h>
#endif
#include "f2c.h"
/* may need sys/time.h & long arg for stime (bsd, svr1-3) */
/* Character */ void
G77_ctime_0 (char *chtime, const ftnlen Lchtime, longint * xstime)
{
int s_copy ();
time_t stime = *xstime;
/* Allow a length other than 24 for compatibility with what other
systems do, despite it being documented as 24. */
s_copy (chtime, ctime (&stime), Lchtime, 24);
}
libf2c/libU77/date_.c deleted 100644 → 0
/* date_.f -- translated by f2c (version 19961001).
You must link the resulting object file with the libraries:
-lf2c -lm (in that order)
*/
#include "f2c.h"
/* Table of constant values */
static integer c__5 = 5;
/* Subroutine */ int
G77_date_y2kbug_0 (char *buf, ftnlen buf_len)
{
/* System generated locals */
address a__1[5];
longint i__1;
integer i__2[5];
char ch__1[24];
/* Builtin functions */
/* Subroutine */ int s_copy (), s_cat ();
/* Local variables */
static char cbuf[24];
extern longint G77_time_0 ();
extern /* Character */ void G77_ctime_0 ();
i__1 = G77_time_0 ();
G77_ctime_0 (ch__1, 24L, &i__1);
s_copy (cbuf, ch__1, 24L, 24L);
/* Writing concatenation */
i__2[0] = 2, a__1[0] = cbuf + 8;
i__2[1] = 1, a__1[1] = "-";
i__2[2] = 3, a__1[2] = cbuf + 4;
i__2[3] = 1, a__1[3] = "-";
i__2[4] = 2, a__1[4] = cbuf + 22;
s_cat (buf, a__1, i__2, &c__5, buf_len);
return 0;
} /* date_ */
#ifdef PIC
# include <stdio.h>
const char *G77_Non_Y2K_Compliance_Message =
"Call to non Y2K compliant subroutine detected.";
int
G77_date_y2kbuggy_0 (char *buf __attribute__ ((__unused__)),
ftnlen buf_len __attribute__ ((__unused__)))
{
extern int G77_abort_0() __attribute__ ((noreturn));
fprintf (stderr, "%s\n", G77_Non_Y2K_Compliance_Message);
G77_abort_0 ();
}
#endif
libf2c/libU77/datetime_.c deleted 100644 → 0
/* Copyright (C) 1997, 1998, 1999, 2001 Free Software Foundation, Inc.
This file is part of GNU Fortran libU77 library.
This library is free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published
by the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
GNU Fortran 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
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with GNU Fortran; see the file COPYING.LIB. If
not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA. */
#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
#include <stdio.h>
#include <sys/types.h>
#if TIME_WITH_SYS_TIME
# include <sys/time.h>
# include <time.h>
#else
# if HAVE_SYS_TIME_H
# include <sys/time.h>
# else
# include <time.h>
# endif
#endif
#if defined (_WIN32)
#include <windows.h>
#undef min
#undef max
#endif
#include "f2c.h"
void s_copy (register char *a, register char *b, ftnlen la, ftnlen lb);
int
G77_date_and_time_0 (char *date, char *fftime, char *zone,
integer * values, ftnlen date_len,
ftnlen fftime_len, ftnlen zone_len)
{
time_t lt = time (&lt);
struct tm ltime = *localtime (&lt), gtime = *gmtime (&lt);
char dat[9], zon[6], ftim[11];
int i, vals[8];
#if defined (_WIN32)
struct _SYSTEMTIME wdattim;
GetLocalTime(&wdattim);
vals[7] = wdattim.wMilliseconds;
#else
vals[7] = 0; /* no STDC/POSIX way to get this */
/* GNUish way; maybe use `ftime' on other systems. */
#endif
vals[0] = 1900 + ltime.tm_year;
vals[1] = 1 + ltime.tm_mon;
vals[2] = ltime.tm_mday;
/* fixme: year boundaries */
vals[3] = (ltime.tm_min - gtime.tm_min +
60 * (ltime.tm_hour - gtime.tm_hour +
24 * (ltime.tm_yday - gtime.tm_yday)));
vals[4] = ltime.tm_hour;
vals[5] = ltime.tm_min;
vals[6] = ltime.tm_sec;
#if HAVE_GETTIMEOFDAY
{
struct timeval tp;
# if GETTIMEOFDAY_ONE_ARGUMENT
if (!gettimeofday (&tp))
# else
# if HAVE_STRUCT_TIMEZONE
struct timezone tzp;
/* Some systems such as HPUX, do have struct timezone, but
gettimeofday takes void* as the 2nd arg. However, the effect
of passing anything other than a null pointer is unspecified on
HPUX. Configure checks if gettimeofday actually fails with a
non-NULL arg and pretends that struct timezone is missing if it
does fail. */
if (!gettimeofday (&tp, &tzp))
# else
if (!gettimeofday (&tp, (void *) 0))
# endif /* HAVE_STRUCT_TIMEZONE */
# endif /* GETTIMEOFDAY_ONE_ARGUMENT */
vals[7] = tp.tv_usec / 1000;
}
#endif /* HAVE_GETTIMEOFDAY */
if (values) /* null pointer for missing optional */
for (i = 0; i <= 7; i++)
values[i] = vals[i];
sprintf (dat, "%04d%02d%02d", vals[0], vals[1], vals[2]);
s_copy (date, dat, date_len, 8);
if (zone)
{
sprintf (zon, "%+03d%02d", vals[3] / 60, abs (vals[3] % 60));
s_copy (zone, zon, zone_len, 5);
}
if (fftime)
{
sprintf (ftim, "%02d%02d%02d.%03d", vals[4], vals[5], vals[6], vals[7]);
s_copy (fftime, ftim, fftime_len, 10);
}
return 0;
}
libf2c/libU77/dtime_.c deleted 100644 → 0
/* Copyright (C) 1995, 1996 Free Software Foundation, Inc.
This file is part of GNU Fortran libU77 library.
This library is free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published
by the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
GNU Fortran 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
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with GNU Fortran; see the file COPYING.LIB. If
not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA. */
#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
#if HAVE_STDLIB_H
# include <stdlib.h>
#endif
#if HAVE_UNISTD_H
# include <unistd.h>
#endif
#include <sys/types.h>
#if HAVE_SYS_TIMES_H
# include <sys/times.h>
#endif
#if HAVE_SYS_PARAM_H
# include <sys/param.h>
#endif
#if HAVE_GETRUSAGE
# include <sys/time.h>
# include <sys/resource.h>
#endif
#if defined (_WIN32)
# include <windows.h>
# undef min
# undef max
#endif
#include <errno.h> /* for ENOSYS */
#include "f2c.h"
double
G77_dtime_0 (real tarray[2])
{
#if defined (_WIN32)
static int win32_platform = -1;
if (win32_platform == -1)
{
OSVERSIONINFO osv;
osv.dwOSVersionInfoSize = sizeof (osv);
GetVersionEx (&osv);
win32_platform = osv.dwPlatformId;
}
/* We need to use this hack on non-NT platforms, where the first call
returns 0.0 and subsequent ones return the correct value. */
if (win32_platform != VER_PLATFORM_WIN32_NT)
{
static unsigned long long clock_freq;
static unsigned long long old_count;
unsigned long long count;
double delta;
LARGE_INTEGER counter_val;
if (clock_freq == 0)
{
LARGE_INTEGER freq;
if (!QueryPerformanceFrequency (&freq))
{
errno = ENOSYS;
return 0.0;
}
else
{
clock_freq = ((unsigned long long) freq.HighPart << 32)
+ ((unsigned) freq.LowPart);
}
}
if (!QueryPerformanceCounter (&counter_val))
return -1.0;
count = ((unsigned long long) counter_val.HighPart << 32)
+ (unsigned) counter_val.LowPart;
delta = ((double) (count - old_count)) / clock_freq;
tarray[0] = (float) delta;
tarray[1] = 0.0;
old_count = count;
}
else
{
static unsigned long long old_utime, old_stime;
unsigned long long utime, stime;
FILETIME creation_time, exit_time, kernel_time, user_time;
GetProcessTimes (GetCurrentProcess (), &creation_time, &exit_time,
&kernel_time, &user_time);
utime = ((unsigned long long) user_time.dwHighDateTime << 32)
+ (unsigned) user_time.dwLowDateTime;
stime = ((unsigned long long) kernel_time.dwHighDateTime << 32)
+ (unsigned) kernel_time.dwLowDateTime;
tarray[0] = (utime - old_utime) / 1.0e7;
tarray[1] = (stime - old_stime) / 1.0e7;
old_utime = utime;
old_stime = stime;
}
return tarray[0] + tarray[1];
#elif defined (HAVE_GETRUSAGE) || defined (HAVE_TIMES)
/* The getrusage version is only the default for convenience. */
#ifdef HAVE_GETRUSAGE
float utime, stime;
static float old_utime = 0.0, old_stime = 0.0;
struct rusage rbuff;
if (getrusage (RUSAGE_SELF, &rbuff) != 0)
abort ();
utime = (float) (rbuff.ru_utime).tv_sec +
(float) (rbuff.ru_utime).tv_usec / 1000000.0;
tarray[0] = utime - (float) old_utime;
stime = (float) (rbuff.ru_stime).tv_sec +
(float) (rbuff.ru_stime).tv_usec / 1000000.0;
tarray[1] = stime - old_stime;
#else /* HAVE_GETRUSAGE */
/* For dtime, etime we store the clock tick parameter (clk_tck) the
first time either of them is invoked rather than each time. This
approach probably speeds up each invocation by avoiding a system
call each time, but means that the overhead of the first call is
different to all others. */
static long clk_tck = 0;
time_t utime, stime;
static time_t old_utime = 0, old_stime = 0;
struct tms buffer;
/* NeXTStep seems to define _SC_CLK_TCK but not to have sysconf;
fixme: does using _POSIX_VERSION help? */
# if defined _SC_CLK_TCK && defined _POSIX_VERSION
if (!clk_tck)
clk_tck = sysconf (_SC_CLK_TCK);
# elif defined CLOCKS_PER_SECOND
if (!clk_tck)
clk_tck = CLOCKS_PER_SECOND;
# elif defined CLK_TCK
if (!clk_tck)
clk_tck = CLK_TCK;
# elif defined HZ
if (!clk_tck)
clk_tck = HZ;
# elif defined HAVE_GETRUSAGE
# else
#error Dont know clock tick length
# endif
if (times (&buffer) == (clock_t) - 1)
return -1.0;
utime = buffer.tms_utime;
stime = buffer.tms_stime;
tarray[0] = ((float) (utime - old_utime)) / (float) clk_tck;
tarray[1] = ((float) (stime - old_stime)) / (float) clk_tck;
#endif /* HAVE_GETRUSAGE */
old_utime = utime;
old_stime = stime;
return (tarray[0] + tarray[1]);
#else /* ! HAVE_GETRUSAGE && ! HAVE_TIMES */
errno = ENOSYS;
return 0.0;
#endif /* ! HAVE_GETRUSAGE && ! HAVE_TIMES */
}
libf2c/libU77/etime_.c deleted 100644 → 0
/* Copyright (C) 1995, 1996 Free Software Foundation, Inc.
This file is part of GNU Fortran libU77 library.
This library is free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published
by the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
GNU Fortran 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
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with GNU Fortran; see the file COPYING.LIB. If
not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA. */
#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
#if HAVE_STDLIB_H
# include <stdlib.h>
#endif
#if HAVE_UNISTD_H
# include <unistd.h>
#endif
#include <sys/types.h>
#if HAVE_SYS_TIMES_H
# include <sys/times.h>
#endif
#if HAVE_SYS_PARAM_H
# include <sys/param.h>
#endif
#if HAVE_GETRUSAGE
# include <sys/time.h>
# include <sys/resource.h>
#endif
#if defined (_WIN32)
# include <windows.h>
# undef min
# undef max
#endif
#include <errno.h> /* for ENOSYS */
#include "f2c.h"
double
G77_etime_0 (real tarray[2])
{
#if defined (_WIN32)
static int win32_platform = -1;
double usertime, systime;
if (win32_platform == -1)
{
OSVERSIONINFO osv;
osv.dwOSVersionInfoSize = sizeof (osv);
GetVersionEx (&osv);
win32_platform = osv.dwPlatformId;
}
/* non-NT platforms don't have a clue as to how long a process has
been running, so simply return the uptime. Bad judgement call? */
if (win32_platform != VER_PLATFORM_WIN32_NT)
{
static unsigned long long clock_freq;
static unsigned long long old_count;
unsigned long long count;
LARGE_INTEGER counter_val;
if (clock_freq == 0)
{
LARGE_INTEGER freq;
if (!QueryPerformanceFrequency (&freq))
{
errno = ENOSYS;
return 0.0;
}
else
{
clock_freq = ((unsigned long long) freq.HighPart << 32)
+ ((unsigned) freq.LowPart);
if (!QueryPerformanceCounter (&counter_val))
return -1.0;
old_count = ((unsigned long long) counter_val.HighPart << 32)
+ (unsigned) counter_val.LowPart;
}
}
if (!QueryPerformanceCounter (&counter_val))
return -1.0;
count = ((unsigned long long) counter_val.HighPart << 32)
+ (unsigned) counter_val.LowPart;
tarray[0] = usertime = (double) (count - old_count) / clock_freq;
tarray[1] = systime = 0.0;
}
else
{
FILETIME creation_time, exit_time, kernel_time, user_time;
unsigned long long utime, stime;
GetProcessTimes (GetCurrentProcess (), &creation_time, &exit_time,
&kernel_time, &user_time);
utime = ((unsigned long long) user_time.dwHighDateTime << 32)
+ (unsigned) user_time.dwLowDateTime;
stime = ((unsigned long long) kernel_time.dwHighDateTime << 32)
+ (unsigned) kernel_time.dwLowDateTime;
tarray[0] = usertime = utime / 1.0e7;
tarray[1] = systime = stime / 1.0e7;
}
return usertime + systime;
#elif defined (HAVE_GETRUSAGE) || defined (HAVE_TIMES)
/* The getrusage version is only the default for convenience. */
#ifdef HAVE_GETRUSAGE
struct rusage rbuff;
if (getrusage (RUSAGE_SELF, &rbuff) != 0)
abort ();
tarray[0] = ((float) (rbuff.ru_utime).tv_sec +
(float) (rbuff.ru_utime).tv_usec / 1000000.0);
tarray[1] = ((float) (rbuff.ru_stime).tv_sec +
(float) (rbuff.ru_stime).tv_usec / 1000000.0);
#else /* HAVE_GETRUSAGE */
/* For dtime, etime we store the clock tick parameter (clk_tck) the
first time either of them is invoked rather than each time. This
approach probably speeds up each invocation by avoiding a system
call each time, but means that the overhead of the first call is
different to all others. */
static long clk_tck = 0;
struct tms buffer;
/* NeXTStep seems to define _SC_CLK_TCK but not to have sysconf;
fixme: does using _POSIX_VERSION help? */
# if defined _SC_CLK_TCK && defined _POSIX_VERSION
if (!clk_tck)
clk_tck = sysconf (_SC_CLK_TCK);
# elif defined CLOCKS_PER_SECOND
if (!clk_tck)
clk_tck = CLOCKS_PER_SECOND;
# elif defined CLK_TCK
if (!clk_tck)
clk_tck = CLK_TCK;
# elif defined HZ
if (!clk_tck)
clk_tck = HZ;
# elif defined HAVE_GETRUSAGE
# else
#error Dont know clock tick length
# endif
if (times (&buffer) == (clock_t) - 1)
return -1.0;
tarray[0] = (float) buffer.tms_utime / (float) clk_tck;
tarray[1] = (float) buffer.tms_stime / (float) clk_tck;
#endif /* HAVE_GETRUSAGE */
return (tarray[0] + tarray[1]);
#else /* ! HAVE_GETRUSAGE && ! HAVE_TIMES */
errno = ENOSYS;
return 0.0;
#endif /* ! HAVE_GETRUSAGE && ! HAVE_TIMES */
}
libf2c/libU77/fdate_.c deleted 100644 → 0
/* Copyright (C) 1995, 1996, 2001 Free Software Foundation, Inc.
This file is part of GNU Fortran libU77 library.
This library is free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published
by the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
GNU Fortran 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
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with GNU Fortran; see the file COPYING.LIB. If
not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA. */
#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
#include <stdio.h>
#include <sys/types.h>
#if TIME_WITH_SYS_TIME
# include <sys/time.h>
# include <time.h>
#else
# if HAVE_SYS_TIME_H
# include <sys/time.h>
# else
# include <time.h>
# endif
#endif
#if HAVE_STRING_H
# include <string.h>
#else
# include <strings.h>
#endif
#include "f2c.h"
/* NB. this implementation is for a character*24 function. There's
also a subroutine version. Of course, the calling convention is
essentially the same for both. */
/* Character *24 */ void
G77_fdate_0 (char *ret_val, ftnlen ret_val_len)
{
int s_copy ();
time_t tloc;
tloc = time (NULL);
/* Allow a length other than 24 for compatibility with what other
systems do, despite it being documented as 24. */
s_copy (ret_val, ctime ((time_t *) & tloc), ret_val_len, 24);
}
libf2c/libU77/fgetc_.c deleted 100644 → 0
/* Copyright (C) 1996 Free Software Foundation, Inc.
This file is part of GNU Fortran libU77 library.
This library is free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published
by the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
GNU Fortran 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
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with GNU Fortran; see the file COPYING.LIB. If
not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA. */
#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
#include <stdio.h>
#include "f2c.h"
#include "fio.h"
integer
G77_fgetc_0 (const integer * lunit, char *c, ftnlen Lc)
{
int err;
FILE *f = f__units[*lunit].ufd;
if (*lunit >= MXUNIT || *lunit < 0)
return 101; /* bad unit error */
err = getc (f);
if (err == EOF)
{
if (feof (f))
return -1;
else
return ferror (f);
}
else
{
if (Lc == 0)
return 0;
c[0] = err;
while (--Lc)
*++c = ' ';
return 0;
}
}
integer
G77_fget_0 (char *c, const ftnlen Lc)
{
integer five = 5;
return G77_fgetc_0 (&five, c, Lc);
}
libf2c/libU77/flush1_.c deleted 100644 → 0
/* Copyright (C) 1995 Free Software Foundation, Inc.
This file is part of GNU Fortran libU77 library.
This library is free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published
by the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
GNU Fortran 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
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with GNU Fortran; see the file COPYING.LIB. If
not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA. */
#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
#include <stdio.h>
#include "f2c.h"
#include "fio.h"
/* This flushes a single unit, c.f. libI77 version. */
extern integer G77_fnum_0 (integer *);
/* Subroutine */ int
G77_flush1_0 (const integer * lunit)
{
if (*lunit >= MXUNIT || *lunit < 0)
err (1, 101, "flush");
/* f__units is a table of descriptions for the unit numbers (defined
in io.h) with file descriptors rather than streams */
if (f__units[*lunit].ufd != NULL && f__units[*lunit].uwrt)
fflush (f__units[*lunit].ufd);
return 0;
}
libf2c/libU77/fnum_.c deleted 100644 → 0
/* Copyright (C) 1995 Free Software Foundation, Inc.
This file is part of GNU Fortran libU77 library.
This library is free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published
by the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
GNU Fortran 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
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with GNU Fortran; see the file COPYING.LIB. If
not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA. */
#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
#include "f2c.h"
#include "fio.h"
integer
G77_fnum_0 (integer * lunit)
{
if (*lunit >= MXUNIT || *lunit < 0)
err (1, 101, "fnum");
if (f__units[*lunit].ufd == NULL)
err (1, 114, "fnum");
/* f__units is a table of descriptions for the unit numbers (defined
in io.h). Use file descriptor (ufd) and fileno rather than udev
field since udev is unix specific */
return fileno (f__units[*lunit].ufd);
}
libf2c/libU77/fputc_.c deleted 100644 → 0
/* Copyright (C) 1996 Free Software Foundation, Inc.
This file is part of GNU Fortran libU77 library.
This library is free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published
by the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
GNU Fortran 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
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with GNU Fortran; see the file COPYING.LIB. If
not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA. */
#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
#include <stdio.h>
#include "f2c.h"
#include "fio.h"
integer
G77_fputc_0 (const integer * lunit, const char *c,
const ftnlen Lc __attribute__ ((__unused__)))
{
int err;
FILE *f = f__units[*lunit].ufd;
if (*lunit >= MXUNIT || *lunit < 0)
return 101; /* bad unit error */
err = putc (c[0], f);
if (err == EOF)
{
if (feof (f))
return -1;
else
return ferror (f);
}
else
return 0;
}
integer
G77_fput_0 (const char *c, const ftnlen Lc)
{
integer six = 6;
return G77_fputc_0 (&six, c, Lc);
}
libf2c/libU77/fstat_.c deleted 100644 → 0
/* Copyright (C) 1995 Free Software Foundation, Inc.
This file is part of GNU Fortran libU77 library.
This library is free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published
by the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
GNU Fortran 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
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with GNU Fortran; see the file COPYING.LIB. If
not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA. */
#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
#include "f2c.h"
#include "fio.h"
#include <sys/types.h>
#include <sys/stat.h>
extern integer G77_fnum_0 (const integer *);
integer
G77_fstat_0 (const integer * lunit, integer statb[13])
{
int err;
struct stat buf;
if (f__init != 1) f_init();
err = fstat (G77_fnum_0 (lunit), &buf);
statb[0] = buf.st_dev;
statb[1] = buf.st_ino;
statb[2] = buf.st_mode;
statb[3] = buf.st_nlink;
statb[4] = buf.st_uid;
statb[5] = buf.st_gid;
#if HAVE_ST_RDEV
statb[6] = buf.st_rdev; /* not posix */
#else
statb[6] = 0;
#endif
statb[7] = buf.st_size;
statb[8] = buf.st_atime;
statb[9] = buf.st_mtime;
statb[10] = buf.st_ctime;
#if HAVE_ST_BLKSIZE
statb[11] = buf.st_blksize; /* not posix */
#else
statb[11] = -1;
#endif
#if HAVE_ST_BLOCKS
statb[12] = buf.st_blocks; /* not posix */
#else
statb[12] = -1;
#endif
return err;
}
libf2c/libU77/gerror_.c deleted 100644 → 0
/* Copyright (C) 1995 Free Software Foundation, Inc.
This file is part of GNU Fortran libU77 library.
This library is free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published
by the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
GNU Fortran 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
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with GNU Fortran; see the file COPYING.LIB. If
not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA. */
#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
#include <errno.h>
#include <stddef.h>
#if HAVE_STRING_H
# include <string.h>
#else
# include <strings.h>
#endif
#include "f2c.h"
#ifndef HAVE_STRERROR
extern char *sys_errlist[];
# define strerror(i) (sys_errlist[i])
#endif
extern void s_copy (register char *a, register char *b, ftnlen la, ftnlen lb);
/* Subroutine */ int
G77_gerror_0 (char *str, ftnlen Lstr)
{
char *s;
s = strerror (errno);
s_copy (str, s, Lstr, strlen (s));
return 0;
}
libf2c/libU77/getcwd_.c deleted 100644 → 0
/* Copyright (C) 1995, 1996 Free Software Foundation, Inc.
This file is part of GNU Fortran libU77 library.
This library is free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published
by the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
GNU Fortran 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
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with GNU Fortran; see the file COPYING.LIB. If
not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA. */
#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
#include <errno.h>
#if HAVE_STRING_H
# include <string.h>
#else
# include <strings.h>
#endif
#include <stdio.h> /* for NULL */
#include <errno.h> /* for ENOSYS */
#include "f2c.h"
#if HAVE_GETCWD
#ifdef HAVE_UNISTD_H
# include <unistd.h>
#else
extern char *getcwd ();
#endif
extern void s_copy (register char *a, register char *b, ftnlen la, ftnlen lb);
integer
G77_getcwd_0 (char *str, const ftnlen Lstr)
{
int i;
char *ret;
ret = getcwd (str, Lstr);
if (ret == NULL)
return errno;
for (i = strlen (str); i < Lstr; i++)
str[i] = ' ';
return 0;
}
#elif HAVE_GETWD /* HAVE_GETCWD */
/* getwd usage taken from SunOS4 man */
# include <sys/param.h>
extern char *getwd ();
extern void s_copy (register char *a, register char *b, ftnlen la, ftnlen lb);
integer
G77_getcwd_0 (char *str, const ftnlen Lstr)
{
char pathname[MAXPATHLEN];
size_t l;
if (getwd (pathname) == NULL)
{
return errno;
}
else
{
s_copy (str, pathname, Lstr, strlen (str));
return 0;
}
}
#else /* !HAVE_GETWD && !HAVE_GETCWD */
extern void s_copy (register char *a, register char *b, ftnlen la, ftnlen lb);
integer
G77_getcwd_0 (char *str, const ftnlen Lstr)
{
return errno = ENOSYS;
}
#endif
libf2c/libU77/getgid_.c deleted 100644 → 0
/* Copyright (C) 1995 Free Software Foundation, Inc.
This file is part of GNU Fortran libU77 library.
This library is free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published
by the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
GNU Fortran 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
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with GNU Fortran; see the file COPYING.LIB. If
not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA. */
#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
#if HAVE_UNISTD_H
#include <unistd.h>
#endif
#include <sys/types.h>
#include <errno.h> /* for ENOSYS */
#include "f2c.h"
integer
G77_getgid_0 (void)
{
#if defined (HAVE_GETGID)
return getgid ();
#else
errno = ENOSYS;
return -1;
#endif
}
libf2c/libU77/getlog_.c deleted 100644 → 0
/* Copyright (C) 1995 Free Software Foundation, Inc.
This file is part of GNU Fortran libU77 library.
This library is free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published
by the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
GNU Fortran 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
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with GNU Fortran; see the file COPYING.LIB. If
not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA. */
#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
#include <sys/types.h>
#if HAVE_STDLIB_H
# include <stdlib.h>
#else
# include <stdio.h>
#endif
#include <stdio.h>
#if HAVE_UNISTD_H
# include <unistd.h>
#endif
#if HAVE_STRING_H
# include <string.h>
#else
# include <strings.h>
#endif
#include <errno.h> /* for ENOSYS */
#include "f2c.h"
/* getlogin not in svr1-3 */
/* SGI also has character*(*) function getlog() */
extern void s_copy (register char *a, register char *b, ftnlen la, ftnlen lb);
/* Subroutine */ int
G77_getlog_0 (char *str, const ftnlen Lstr)
{
size_t i;
char *p;
int status;
#if defined (HAVE_GETLOGIN)
p = getlogin ();
if (p != NULL)
{
i = strlen (p);
s_copy (str, p, Lstr, i);
}
else
{
s_copy (str, " ", Lstr, 1);
}
status = 0;
#else
errno = ENOSYS;
status = -1;
#endif
return status;
}
libf2c/libU77/getpid_.c deleted 100644 → 0
/* Copyright (C) 1995 Free Software Foundation, Inc.
This file is part of GNU Fortran libU77 library.
This library is free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published
by the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
GNU Fortran 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
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with GNU Fortran; see the file COPYING.LIB. If
not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA. */
#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
#if HAVE_UNISTD_H
#include <unistd.h>
#endif
#include <sys/types.h>
#include "f2c.h"
integer
G77_getpid_0 (void)
{
return getpid ();
}
libf2c/libU77/getuid_.c deleted 100644 → 0
/* Copyright (C) 1995 Free Software Foundation, Inc.
This file is part of GNU Fortran libU77 library.
This library is free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published
by the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
GNU Fortran 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
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with GNU Fortran; see the file COPYING.LIB. If
not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA. */
#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
#if HAVE_UNISTD_H
#include <unistd.h>
#endif
#include <sys/types.h>
#include <errno.h> /* for ENOSYS */
#include "f2c.h"
integer
G77_getuid_0 (void)
{
#if defined (HAVE_GETUID)
return getuid ();
#else
errno = ENOSYS;
return -1;
#endif
}
libf2c/libU77/gmtime_.c deleted 100644 → 0
/* Copyright (C) 1995, 2001 Free Software Foundation, Inc.
This file is part of GNU Fortran libU77 library.
This library is free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published
by the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
GNU Fortran 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
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with GNU Fortran; see the file COPYING.LIB. If
not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA. */
#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
#include <sys/types.h>
/* fixme: do we need to use TM_IN_SYS_TIME? */
#if TIME_WITH_SYS_TIME
# include <sys/time.h>
# include <time.h>
#else
# if HAVE_SYS_TIME_H
# include <sys/time.h>
# else
# include <time.h>
# endif
#endif
#include "f2c.h"
/* Subroutine */ int
G77_gmtime_0 (const integer * xstime, integer tarray[9])
{
struct tm *lt;
time_t stime = *xstime;
lt = gmtime (&stime);
tarray[0] = lt->tm_sec;
tarray[1] = lt->tm_min;
tarray[2] = lt->tm_hour;
tarray[3] = lt->tm_mday;
tarray[4] = lt->tm_mon;
tarray[5] = lt->tm_year;
tarray[6] = lt->tm_wday;
tarray[7] = lt->tm_yday;
tarray[8] = lt->tm_isdst;
return 0;
}
libf2c/libU77/hostnm_.c deleted 100644 → 0
/* Copyright (C) 1995 Free Software Foundation, Inc.
This file is part of GNU Fortran libU77 library.
This library is free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published
by the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
GNU Fortran 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
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with GNU Fortran; see the file COPYING.LIB. If
not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA. */
#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
#if HAVE_STRING_H
# include <string.h>
#else
# include <strings.h>
#endif
#if HAVE_UNISTD_H
# include <unistd.h>
#endif
#include <errno.h> /* for ENOSYS */
#include "f2c.h"
integer
G77_hostnm_0 (char *name, ftnlen Lname)
{
int ret, i;
#if HAVE_GETHOSTNAME
ret = gethostname (name, Lname);
if (ret == 0)
{
/* Pad with blanks (assuming gethostname will make an error
return if it can't fit in the null). */
for (i = strlen (name); i < Lname; i++)
name[i] = ' ';
}
return ret;
#else
return errno = ENOSYS;
#endif
}
libf2c/libU77/idate_.c deleted 100644 → 0
/* Copyright (C) 1995, 1996, 2001 Free Software Foundation, Inc.
This file is part of GNU Fortran libU77 library.
This library is free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published
by the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
GNU Fortran 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
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with GNU Fortran; see the file COPYING.LIB. If
not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA. */
#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
#include <stdio.h>
#include <sys/types.h>
#if TIME_WITH_SYS_TIME
# include <sys/time.h>
# include <time.h>
#else
# if HAVE_SYS_TIME_H
# include <sys/time.h>
# else
# include <time.h>
# endif
#endif
#include "f2c.h"
/* VMS and Irix versions (at least) differ from libU77 elsewhere */
/* libU77 one: */
/* Subroutine */ int
G77_idate_0 (int iarray[3])
{
struct tm *lt;
time_t tim;
tim = time (NULL);
lt = localtime (&tim);
iarray[0] = lt->tm_mday;
iarray[1] = lt->tm_mon + 1; /* in range 1-12 in SunOS (experimentally) */
/* The `+1900' is consistent with SunOS and Irix, but they don't say
it's added. I think I've seen a system where tm_year was since
1970, but can't now verify that, so assume the ANSI definition. */
iarray[2] = lt->tm_year + 1900;
return 0;
}
libf2c/libU77/ierrno_.c deleted 100644 → 0
/* Copyright (C) 1995 Free Software Foundation, Inc.
This file is part of GNU Fortran libU77 library.
This library is free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published
by the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
GNU Fortran 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
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with GNU Fortran; see the file COPYING.LIB. If
not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA. */
#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
#include <errno.h>
#include "f2c.h"
integer
G77_ierrno_0 (void)
{
return errno;
}
libf2c/libU77/irand_.c deleted 100644 → 0
/* Copyright (C) 1995 Free Software Foundation, Inc.
This file is part of GNU Fortran libU77 library.
This library is free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published
by the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
GNU Fortran 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
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with GNU Fortran; see the file COPYING.LIB. If
not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA. */
#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
#if HAVE_STDLIB_H
# include <stdlib.h>
#endif
#include "f2c.h"
/* We could presumably do much better than the traditional libc
version, though at least the glibc one is reasonable, it seems.
For the sake of the innocent, I'm not sure we should really do
this... */
/* Note this is per SunOS -- other s may have no arg. */
integer
G77_irand_0 (integer * flag)
{
switch (*flag)
{
case 0:
break;
case 1:
srand (0); /* Arbitrary choice of initialiser. */
break;
default:
srand (*flag);
}
return rand ();
}
libf2c/libU77/isatty_.c deleted 100644 → 0
/* Copyright (C) 1995 Free Software Foundation, Inc.
This file is part of GNU Fortran libU77 library.
This library is free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published
by the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
GNU Fortran 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
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with GNU Fortran; see the file COPYING.LIB. If
not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA. */
#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
#if HAVE_UNISTD_H
# include <unistd.h>
#endif
#include "f2c.h"
#include "fio.h"
extern integer G77_fnum_0 (integer *);
logical
G77_isatty_0 (integer * lunit)
{
if (f__init != 1) f_init();
if (*lunit >= MXUNIT || *lunit < 0)
err (1, 101, "isatty");
/* f__units is a table of descriptions for the unit numbers (defined
in io.h) with file descriptors rather than streams */
return (isatty (G77_fnum_0 (lunit)) ? TRUE_ : FALSE_);
}
libf2c/libU77/itime_.c deleted 100644 → 0
/* Copyright (C) 1995, 2001 Free Software Foundation, Inc.
This file is part of GNU Fortran libU77 library.
This library is free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published
by the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
GNU Fortran 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
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with GNU Fortran; see the file COPYING.LIB. If
not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA. */
#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
#include <stdio.h>
#include <sys/types.h>
#if TIME_WITH_SYS_TIME
# include <sys/time.h>
# include <time.h>
#else
# if HAVE_SYS_TIME_H
# include <sys/time.h>
# else
# include <time.h>
# endif
#endif
#include "f2c.h"
/* Subroutine */ int
G77_itime_0 (integer tarray[3])
{
struct tm *lt;
time_t tim;
tim = time (NULL);
lt = localtime (&tim);
tarray[0] = lt->tm_hour;
tarray[1] = lt->tm_min;
tarray[2] = lt->tm_sec;
return 0;
}
libf2c/libU77/kill_.c deleted 100644 → 0
/* Copyright (C) 1995 Free Software Foundation, Inc.
This file is part of GNU Fortran libU77 library.
This library is free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published
by the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
GNU Fortran 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
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with GNU Fortran; see the file COPYING.LIB. If
not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA. */
#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
#include <sys/types.h>
#include <signal.h>
#include <errno.h>
#include "f2c.h"
/* fixme: bsd, svr1-3 use int, not pid_t */
integer
G77_kill_0 (const integer * pid, const integer * signum)
{
#if defined (HAVE_KILL)
return kill ((pid_t) * pid, *signum) ? errno : 0;
#else
errno = ENOSYS;
return -1;
#endif
}
libf2c/libU77/link_.c deleted 100644 → 0
/* Copyright (C) 1995, 1997 Free Software Foundation, Inc.
This file is part of GNU Fortran libU77 library.
This library is free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published
by the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
GNU Fortran 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
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with GNU Fortran; see the file COPYING.LIB. If
not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA. */
#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
#if HAVE_STDLIB_H
# include <stdlib.h>
#else
# include <stdio.h>
#endif
#if HAVE_UNISTD_H
# include <unistd.h>
#endif
#include <errno.h>
#if HAVE_SYS_PARAM_H
# include <sys/param.h>
#endif
#include <errno.h> /* for ENOSYS */
#include "f2c.h"
void g_char (const char *a, ftnlen alen, char *b);
integer
G77_link_0 (const char *path1, const char *path2, const ftnlen Lpath1,
const ftnlen Lpath2)
{
#if defined (HAVE_LINK)
char *buff1, *buff2;
int i;
buff1 = malloc (Lpath1 + 1);
if (buff1 == NULL)
return -1;
g_char (path1, Lpath1, buff1);
buff2 = malloc (Lpath2 + 1);
if (buff2 == NULL)
return -1;
g_char (path2, Lpath2, buff2);
i = link (buff1, buff2);
free (buff1);
free (buff2);
return i ? errno : 0;
#else /* ! HAVE_LINK */
errno = ENOSYS;
return -1;
#endif
}
libf2c/libU77/lnblnk_.c deleted 100644 → 0
/* Copyright (C) 1995, 1997 Free Software Foundation, Inc.
This file is part of GNU Fortran libU77 library.
This library is free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published
by the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
GNU Fortran 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
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with GNU Fortran; see the file COPYING.LIB. If
not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA. */
/* via f2c from Fortran */
#include "f2c.h"
integer
G77_lnblnk_0 (char *str, ftnlen str_len)
{
integer ret_val;
integer i_len ();
for (ret_val = str_len; ret_val >= 1; --ret_val)
{
if (*(unsigned char *) &str[ret_val - 1] != ' ')
{
return ret_val;
}
}
return ret_val;
}
libf2c/libU77/lstat_.c deleted 100644 → 0
/* Copyright (C) 1995, 1997 Free Software Foundation, Inc.
This file is part of GNU Fortran libU77 library.
This library is free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published
by the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
GNU Fortran 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
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with GNU Fortran; see the file COPYING.LIB. If
not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA. */
#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
#include <stdio.h>
#if HAVE_STDLIB_H
# include <stdlib.h>
#endif
#include <sys/types.h>
#include <sys/stat.h>
#include <errno.h> /* for ENOSYS */
#include "f2c.h"
/* lstat isn't posix */
void g_char (const char *a, ftnlen alen, char *b);
integer
G77_lstat_0 (const char *name, integer statb[13], const ftnlen Lname)
{
#if HAVE_LSTAT
char *buff;
int err;
struct stat buf;
buff = malloc (Lname + 1);
if (buff == NULL)
return -1;
g_char (name, Lname, buff);
err = lstat (buff, &buf);
free (buff);
statb[0] = buf.st_dev;
statb[1] = buf.st_ino;
statb[2] = buf.st_mode;
statb[3] = buf.st_nlink;
statb[4] = buf.st_uid;
statb[5] = buf.st_gid;
#if HAVE_ST_RDEV
statb[6] = buf.st_rdev;
#else
statb[6] = 0;
#endif
statb[7] = buf.st_size;
statb[8] = buf.st_atime;
statb[9] = buf.st_mtime;
statb[10] = buf.st_ctime;
#if HAVE_ST_BLKSIZE
statb[11] = buf.st_blksize;
#else
statb[11] = -1;
#endif
#if HAVE_ST_BLOCKS
statb[12] = buf.st_blocks;
#else
statb[12] = -1;
#endif
return err;
#else /* !HAVE_LSTAT */
return errno = ENOSYS;
#endif /* !HAVE_LSTAT */
}
libf2c/libU77/ltime_.c deleted 100644 → 0
/* Copyright (C) 1995, 2001 Free Software Foundation, Inc.
This file is part of GNU Fortran libU77 library.
This library is free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published
by the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
GNU Fortran 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
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with GNU Fortran; see the file COPYING.LIB. If
not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA. */
#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
#include <sys/types.h>
/* fixme: do we need to use TM_IN_SYS_TIME? */
#if TIME_WITH_SYS_TIME
# include <sys/time.h>
# include <time.h>
#else
# if HAVE_SYS_TIME_H
# include <sys/time.h>
# else
# include <time.h>
# endif
#endif
#include "f2c.h"
/* Subroutine */ int
G77_ltime_0 (const integer * xstime, integer tarray[9])
{
struct tm *lt;
time_t stime = *xstime;
lt = localtime (&stime);
tarray[0] = lt->tm_sec;
tarray[1] = lt->tm_min;
tarray[2] = lt->tm_hour;
tarray[3] = lt->tm_mday;
tarray[4] = lt->tm_mon;
tarray[5] = lt->tm_year;
tarray[6] = lt->tm_wday;
tarray[7] = lt->tm_yday;
tarray[8] = lt->tm_isdst;
return 0;
}
libf2c/libU77/mclock_.c deleted 100644 → 0
/* Copyright (C) 1996 Free Software Foundation, Inc.
This file is part of GNU Fortran libU77 library.
This library is free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published
by the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
GNU Fortran 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
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with GNU Fortran; see the file COPYING.LIB. If
not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA. */
#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
#if TIME_WITH_SYS_TIME
# include <sys/time.h>
# include <time.h>
#else
# if HAVE_SYS_TIME_H
# include <sys/time.h>
# else
# include <time.h>
# endif
#endif
#include "f2c.h"
/* Reported by wd42ej@sgi83.wwb.noaa.gov (Russ Jones AUTO-Sun3) on AIX. */
longint
G77_mclock_0 (void)
{
#if HAVE_CLOCK
return clock ();
#else
return -1;
#endif
}
libf2c/libU77/perror_.c deleted 100644 → 0
/* Copyright (C) 1995 Free Software Foundation, Inc.
This file is part of GNU Fortran libU77 library.
This library is free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published
by the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
GNU Fortran 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
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with GNU Fortran; see the file COPYING.LIB. If
not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA. */
#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
#include <stdio.h>
#include <errno.h>
#if HAVE_STRING_H
# include <string.h>
#else
# include <strings.h>
#endif
#include "f2c.h"
/* Subroutine */ int
G77_perror_0 (const char *str, const ftnlen Lstr)
{
char buff[1000];
char *bp, *blast;
/* same technique as `system' -- what's wrong with malloc? */
blast = buff + (Lstr < 1000 ? Lstr : 1000);
for (bp = buff; bp < blast && *str != '\0';)
*bp++ = *str++;
*bp = '\0';
perror (buff);
return 0;
}
libf2c/libU77/rand_.c deleted 100644 → 0
/* Copyright (C) 1995 Free Software Foundation, Inc.
This file is part of GNU Fortran libU77 library.
This library is free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published
by the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
GNU Fortran 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
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with GNU Fortran; see the file COPYING.LIB. If
not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA. */
#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
#if HAVE_STDLIB_H
# include <stdlib.h>
#endif
#include "f2c.h"
#ifndef RAND_MAX
# define RAND_MAX 2147483647 /* from SunOS */
#endif
/* We could presumably do much better than the traditional libc
version, though at least the glibc one is reasonable, it seems.
For the sake of the innocent, I'm not sure we should really do
this... */
/* Note this is per SunOS -- other s may have no arg. */
double
G77_rand_0 (integer * flag)
{
switch (*flag)
{
case 0:
break;
case 1:
srand (0); /* Arbitrary choice of initialiser. */
break;
default:
srand (*flag);
}
return (float) rand () / RAND_MAX;
}
libf2c/libU77/rename_.c deleted 100644 → 0
/* Copyright (C) 1995, 1997 Free Software Foundation, Inc.
This file is part of GNU Fortran libU77 library.
This library is free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published
by the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
GNU Fortran 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
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with GNU Fortran; see the file COPYING.LIB. If
not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA. */
#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
#if HAVE_UNISTD_H
# include <unistd.h>
#endif
#if HAVE_STDLIB_H
# include <stdlib.h>
#endif
#include <stdio.h>
#include <errno.h>
#include "f2c.h"
void g_char (const char *a, ftnlen alen, char *b);
integer
G77_rename_0 (const char *path1, const char *path2, const ftnlen Lpath1,
const ftnlen Lpath2)
{
char *buff1, *buff2;
int i;
buff1 = malloc (Lpath1 + 1);
if (buff1 == NULL)
return -1;
g_char (path1, Lpath1, buff1);
buff2 = malloc (Lpath2 + 1);
if (buff2 == NULL)
return -1;
g_char (path2, Lpath2, buff2);
i = rename (buff1, buff2);
free (buff1);
free (buff2);
return i ? errno : 0;
}
libf2c/libU77/secnds_.c deleted 100644 → 0
/* Copyright (C) 1995 Free Software Foundation, Inc.
This file is part of GNU Fortran libU77 library.
This library is free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published
by the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
GNU Fortran 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
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with GNU Fortran; see the file COPYING.LIB. If
not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA. */
#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
#include <stdio.h>
#if TIME_WITH_SYS_TIME
# include <sys/time.h>
# include <time.h>
#else
# if HAVE_SYS_TIME_H
# include <sys/time.h>
# else
# include <time.h>
# endif
#endif
#include <sys/types.h>
#include "f2c.h"
/* This is a VMS intrinsic. */
double
G77_secnds_0 (real * r)
{
struct tm *lt;
time_t clock;
float f;
clock = time (NULL);
lt = localtime (&clock);
f = (3600.0 * ((real) lt->tm_hour) + 60.0 * ((real) lt->tm_min) +
(real) lt->tm_sec - *r);
return f;
}
libf2c/libU77/second_.c deleted 100644 → 0
/* Copyright (C) 1996 Free Software Foundation, Inc.
This file is part of GNU Fortran libU77 library.
This library is free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published
by the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
GNU Fortran 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
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with GNU Fortran; see the file COPYING.LIB. If
not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA. */
#include "f2c.h"
double
G77_second_0 ()
{
extern double G77_etime_0 ();
real tarray[2];
return G77_etime_0 (tarray);
}
libf2c/libU77/sleep_.c deleted 100644 → 0
/* Copyright (C) 1995 Free Software Foundation, Inc.
This file is part of GNU Fortran libU77 library.
This library is free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published
by the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
GNU Fortran 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
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with GNU Fortran; see the file COPYING.LIB. If
not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA. */
#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
#if HAVE_UNISTD_H
# include <unistd.h>
#endif
#include "f2c.h"
/* Subroutine */
int
G77_sleep_0 (const integer * seconds)
{
(void) sleep ((unsigned int) *seconds);
return 0;
}
libf2c/libU77/srand_.c deleted 100644 → 0
/* Copyright (C) 1995 Free Software Foundation, Inc.
This file is part of GNU Fortran libU77 library.
This library is free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published
by the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
GNU Fortran 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
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with GNU Fortran; see the file COPYING.LIB. If
not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA. */
#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
#if STDC_HEADERS
# include <stdlib.h>
#endif
#include "f2c.h"
/* Subroutine */
int
G77_srand_0 (const integer * seed)
{
srand ((unsigned int) *seed);
return 0;
}
libf2c/libU77/stat_.c deleted 100644 → 0
/* Copyright (C) 1995, 1997 Free Software Foundation, Inc.
This file is part of GNU Fortran libU77 library.
This library is free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published
by the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
GNU Fortran 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
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with GNU Fortran; see the file COPYING.LIB. If
not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA. */
#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
#include <stdio.h>
#if HAVE_STDLIB_H
# include <stdlib.h>
#endif
#include <sys/types.h>
#include <sys/stat.h>
#include "f2c.h"
void g_char (const char *a, ftnlen alen, char *b);
integer
G77_stat_0 (const char *name, integer statb[13], const ftnlen Lname)
{
char *buff;
int err;
struct stat buf;
buff = malloc (Lname + 1);
if (buff == NULL)
return -1;
g_char (name, Lname, buff);
err = stat (buff, &buf);
free (buff);
statb[0] = buf.st_dev;
statb[1] = buf.st_ino;
statb[2] = buf.st_mode;
statb[3] = buf.st_nlink;
statb[4] = buf.st_uid;
statb[5] = buf.st_gid;
#if HAVE_ST_RDEV
statb[6] = buf.st_rdev; /* not posix */
#else
statb[6] = 0;
#endif
statb[7] = buf.st_size;
statb[8] = buf.st_atime;
statb[9] = buf.st_mtime;
statb[10] = buf.st_ctime;
#if HAVE_ST_BLKSIZE
statb[11] = buf.st_blksize; /* not posix */
#else
statb[11] = -1;
#endif
#if HAVE_ST_BLOCKS
statb[12] = buf.st_blocks; /* not posix */
#else
statb[12] = -1;
#endif
return err;
}
libf2c/libU77/symlnk_.c deleted 100644 → 0
/* Copyright (C) 1995, 1997 Free Software Foundation, Inc.
This file is part of GNU Fortran.
GNU Fortran is free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published
by the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
GNU Fortran 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
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with GNU Fortran; see the file COPYING.LIB. If
not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA. */
#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
#if HAVE_STDLIB_H
# include <stdlib.h>
#else
# include <stdio.h>
#endif
#if HAVE_UNISTD_H
# include <unistd.h>
#endif
#include <errno.h>
#if HAVE_SYS_PARAM_H
# include <sys/param.h>
#endif
#include "f2c.h"
void g_char (const char *a, ftnlen alen, char *b);
integer
G77_symlnk_0 (const char *path1, const char *path2, const ftnlen Lpath1,
const ftnlen Lpath2)
{
#if HAVE_SYMLINK
char *buff1, *buff2;
int i;
buff1 = (char *) malloc (Lpath1 + 1);
if (buff1 == NULL)
return -1;
g_char (path1, Lpath1, buff1);
buff2 = (char *) malloc (Lpath2 + 1);
if (buff2 == NULL)
return -1;
g_char (path2, Lpath2, buff2);
i = symlink (buff1, buff2);
free (buff1);
free (buff2);
return i ? errno : 0;
#else /* !HAVE_SYMLINK */
return errno = ENOSYS;
#endif /* !HAVE_SYMLINK */
}
libf2c/libU77/sys_clock_.c deleted 100644 → 0
/* Copyright (C) 1996, 1998, 2001 Free Software Foundation, Inc.
This file is part of GNU Fortran libU77 library.
This library is free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published
by the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
GNU Fortran 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
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with GNU Fortran; see the file COPYING.LIB. If
not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA. */
#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
#include <sys/types.h>
#if HAVE_SYS_PARAM_H
# include <sys/param.h>
#endif
#if TIME_WITH_SYS_TIME
# include <sys/time.h>
# include <time.h>
#else
# if HAVE_SYS_TIME_H
# include <sys/time.h>
# else
# include <time.h>
# endif
#endif
#if HAVE_SYS_TIMES_H
# include <sys/times.h>
#endif
#include <limits.h>
#if HAVE_UNISTD_H
# include <unistd.h>
#endif
#include <errno.h> /* for ENOSYS */
#include "f2c.h"
int
G77_system_clock_0 (integer * count, integer * count_rate,
integer * count_max)
{
#if defined (HAVE_TIMES)
struct tms buffer;
unsigned long cnt;
if (count_rate)
{
#ifdef _SC_CLK_TCK
*count_rate = sysconf (_SC_CLK_TCK);
#elif defined CLOCKS_PER_SECOND
*count_rate = CLOCKS_PER_SECOND;
#elif defined CLK_TCK
*count_rate = CLK_TCK;
#elif defined HZ
*count_rate = HZ;
#else
#error Dont know clock tick length
#endif
}
if (count_max) /* optional arg present? */
*count_max = INT_MAX; /* dubious */
cnt = times (&buffer);
if (cnt > (unsigned long) (INT_MAX))
*count = INT_MAX; /* also dubious */
else
*count = cnt;
return 0;
#else /* ! HAVE_TIMES */
errno = ENOSYS;
return -1;
#endif /* ! HAVE_TIMES */
}
libf2c/libU77/time_.c deleted 100644 → 0
/* Copyright (C) 1995 Free Software Foundation, Inc.
This file is part of GNU Fortran libU77 library.
This library is free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published
by the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
GNU Fortran 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
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with GNU Fortran; see the file COPYING.LIB. If
not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA. */
#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
#include <stdio.h>
#if TIME_WITH_SYS_TIME
# include <sys/time.h>
# include <time.h>
#else
# if HAVE_SYS_TIME_H
# include <sys/time.h>
# else
# include <time.h>
# endif
#endif
#include "f2c.h"
/* As well as this external function some compilers have an intrinsic
subroutine which fills a character argument (which is the VMS way)
-- caveat emptor. */
longint
G77_time_0 (void)
{
/* There are potential problems with the cast of the time_t here. */
return time (NULL);
}
libf2c/libU77/ttynam_.c deleted 100644 → 0
/* Copyright (C) 1995, 1996 Free Software Foundation, Inc.
This file is part of GNU Fortran libU77 library.
This library is free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published
by the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
GNU Fortran 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
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with GNU Fortran; see the file COPYING.LIB. If
not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA. */
#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
#include <sys/types.h>
#if STDC_HEADERS
# include <stdlib.h>
#endif
#if HAVE_UNISTD_H
# include <unistd.h> /* POSIX for ttyname */
#endif
#include <stdio.h>
#if HAVE_STRING_H
# include <string.h>
#else
# include <strings.h>
#endif
#include <errno.h> /* for ENOSYS */
#include "f2c.h"
extern integer G77_fnum_0 (integer * lunit);
extern void s_copy (register char *a, register char *b, ftnlen la, ftnlen lb);
/* Character */ void
G77_ttynam_0 (char *ret_val, ftnlen ret_val_len, integer * lunit)
{
#if defined (HAVE_TTYNAME)
size_t i;
char *p;
p = ttyname (G77_fnum_0 (lunit));
if (p != NULL)
{
i = strlen (p);
s_copy (ret_val, p, ret_val_len, i);
}
else
{
s_copy (ret_val, " ", ret_val_len, 1);
}
#else
errno = ENOSYS;
s_copy (ret_val, " ", ret_val_len, 1);
#endif
}
libf2c/libU77/u77-test.f deleted 100644 → 0
*** Some random stuff for testing libU77. Should be done better. It's
* hard to test things where you can't guarantee the result. Have a
* good squint at what it prints, though detected errors will cause
* starred messages.
*
* Currently not tested:
* ALARM
* CHDIR (func)
* CHMOD (func)
* FGET (func/subr)
* FGETC (func)
* FPUT (func/subr)
* FPUTC (func)
* FSTAT (subr)
* GETCWD (subr)
* HOSTNM (subr)
* IRAND
* KILL
* LINK (func)
* LSTAT (subr)
* RENAME (func/subr)
* SIGNAL (subr)
* SRAND
* STAT (subr)
* SYMLNK (func/subr)
* UMASK (func)
* UNLINK (func)
*
* NOTE! This is the libU77 version, so it should be a bit more
* "interactive" than the testsuite version, which is in
* gcc/testsuite/g77.f-torture/execute/u77-test.f.
* This version purposely exits with a "failure" status, to test
* returning of non-zero status, and it doesn't call the ABORT
* intrinsic (it substitutes an EXTERNAL stub, so the code can be
* kept nearly the same in both copies). Also, it goes ahead and
* tests the HOSTNM intrinsic. Please keep the other copy up-to-date when
* you modify this one.
implicit none
* external hostnm
intrinsic hostnm
integer hostnm
integer i, j, k, ltarray (9), idat (3), count, rate, count_max,
+ pid, mask
real tarray1(2), tarray2(2), r1, r2
double precision d1
integer(kind=2) bigi
logical issum
intrinsic getpid, getuid, getgid, ierrno, gerror, time8,
+ fnum, isatty, getarg, access, unlink, fstat, iargc,
+ stat, lstat, getcwd, gmtime, etime, chmod, itime, date,
+ chdir, fgetc, fputc, system_clock, second, idate, secnds,
+ time, ctime, fdate, ttynam, date_and_time, mclock, mclock8,
+ cpu_time, dtime, ftell, abort
external lenstr, ctrlc
integer lenstr
logical l
character gerr*80, c*1
character ctim*25, line*80, lognam*20, wd*1000, line2*80,
+ ddate*8, ttime*10, zone*5, ctim2*25
integer fstatb (13), statb (13)
integer *2 i2zero
integer values(8)
integer(kind=7) sigret
i = time ()
ctim = ctime (i)
WRITE (6,'(A/)') '1 GNU libU77 test at: ' // ctim(:lenstr (ctim))
write (6,'(A,I3,'', '',I3)')
+ ' Logical units 5 and 6 correspond (FNUM) to'
+ // ' Unix i/o units ', fnum(5), fnum(6)
if (lnblnk('foo ').ne.3 .or. len_trim('foo ').ne.3) then
print *, 'LNBLNK or LEN_TRIM failed'
call abort
end if
bigi = time8 ()
call ctime (i, ctim2)
if (ctim .ne. ctim2) then
write (6, *) '*** CALL CTIME disagrees with CTIME(): ',
+ ctim2(:lenstr (ctim2)), ' vs. ', ctim(:lenstr (ctim))
call doabort
end if
j = time ()
if (i .gt. bigi .or. bigi .gt. j) then
write (6, *) '*** TIME/TIME8/TIME sequence failures: ',
+ i, bigi, j
call doabort
end if
print *, 'Command-line arguments: ', iargc ()
do i = 0, iargc ()
call getarg (i, line)
print *, 'Arg ', i, ' is: ', line(:lenstr (line))
end do
l= isatty(6)
line2 = ttynam(6)
if (l) then
line = 'and 6 is a tty device (ISATTY) named '//line2
else
line = 'and 6 isn''t a tty device (ISATTY)'
end if
write (6,'(1X,A)') line(:lenstr(line))
call ttynam (6, line)
if (line .ne. line2) then
print *, '*** CALL TTYNAM disagrees with TTYNAM: ',
+ line(:lenstr (line))
call doabort
end if
* regression test for compiler crash fixed by JCB 1998-08-04 com.c
sigret = signal(2, ctrlc)
pid = getpid()
WRITE (6,'(A,I10)') ' Process id (GETPID): ', pid
WRITE (6,'(A,I10)') ' User id (GETUID): ', GETUID ()
WRITE (6,'(A,I10)') ' Group id (GETGID): ', GETGID ()
WRITE (6, *) 'If you have the `id'' program, the following call'
write (6, *) 'of SYSTEM should agree with the above:'
call flush(6)
CALL SYSTEM ('echo " " `id`')
call flush
lognam = 'blahblahblah'
call getlog (lognam)
write (6,*) 'Login name (GETLOG): ', lognam(:lenstr (lognam))
wd = 'blahblahblah'
call getenv ('LOGNAME', wd)
write (6,*) 'Login name (GETENV of LOGNAME): ', wd(:lenstr (wd))
call umask(0, mask)
write(6,*) 'UMASK returns', mask
call umask(mask)
ctim = fdate()
write (6,*) 'FDATE returns: ', ctim(:lenstr (ctim))
call fdate (ctim)
write (6,*) 'CALL FDATE returns: ', ctim(:lenstr (ctim))
j=time()
call ltime (j, ltarray)
write (6,'(1x,a,9i4)') 'LTIME returns:', ltarray
call gmtime (j, ltarray)
write (6,'(1x,a,9i4)') 'GMTIME returns:', ltarray
call system_clock(count) ! omitting optional args
call system_clock(count, rate, count_max)
write(6,*) 'SYSTEM_CLOCK returns: ', count, rate, count_max
call date_and_time(ddate) ! omitting optional args
call date_and_time(ddate, ttime, zone, values)
write(6, *) 'DATE_AND_TIME returns: ', ddate, ' ', ttime, ' ',
+ zone, ' ', values
write (6,*) 'Sleeping for 1 second (SLEEP) ...'
call sleep (1)
c consistency-check etime vs. dtime for first call
r1 = etime (tarray1)
r2 = dtime (tarray2)
if (abs (r1-r2).gt.1.0) then
write (6,*)
+ 'Results of ETIME and DTIME differ by more than a second:',
+ r1, r2
call doabort
end if
if (.not. issum (r1, tarray1(1), tarray1(2))) then
write (6,*) '*** ETIME didn''t return sum of the array: ',
+ r1, ' /= ', tarray1(1), '+', tarray1(2)
call doabort
end if
if (.not. issum (r2, tarray2(1), tarray2(2))) then
write (6,*) '*** DTIME didn''t return sum of the array: ',
+ r2, ' /= ', tarray2(1), '+', tarray2(2)
call doabort
end if
write (6, '(A,3F10.3)')
+ ' Elapsed total, user, system time (ETIME): ',
+ r1, tarray1
c now try to get times to change enough to see in etime/dtime
write (6,*) 'Looping until clock ticks at least once...'
do i = 1,1000
do j = 1,1000
end do
call dtime (tarray2, r2)
if (tarray2(1) .ne. 0. .or. tarray2(2) .ne. 0.) exit
end do
call etime (tarray1, r1)
if (.not. issum (r1, tarray1(1), tarray1(2))) then
write (6,*) '*** ETIME didn''t return sum of the array: ',
+ r1, ' /= ', tarray1(1), '+', tarray1(2)
call doabort
end if
if (.not. issum (r2, tarray2(1), tarray2(2))) then
write (6,*) '*** DTIME didn''t return sum of the array: ',
+ r2, ' /= ', tarray2(1), '+', tarray2(2)
call doabort
end if
write (6, '(A,3F10.3)')
+ ' Differences in total, user, system time (DTIME): ',
+ r2, tarray2
write (6, '(A,3F10.3)')
+ ' Elapsed total, user, system time (ETIME): ',
+ r1, tarray1
write (6, *) '(Clock-tick detected after ', i, ' 1K loops.)'
call idate (i,j,k)
call idate (idat)
write (6,*) 'IDATE (date,month,year): ',idat
print *, '... and the VXT version (month,date,year): ', i,j,k
if (i/=idat(2) .or. j/=idat(1) .or. k/=mod(idat(3),100)) then
print *, '*** VXT and U77 versions don''t agree'
call doabort
end if
call date (ctim)
write (6,*) 'DATE (dd-mmm-yy): ', ctim(:lenstr (ctim))
call itime (idat)
write (6,*) 'ITIME (hour,minutes,seconds): ', idat
call time(line(:8))
print *, 'TIME: ', line(:8)
write (6,*) 'SECNDS(0.0) returns: ',secnds(0.0)
write (6,*) 'SECOND returns: ', second()
call dumdum(r1)
call second(r1)
write (6,*) 'CALL SECOND returns: ', r1
* compiler crash fixed by 1998-10-01 com.c change
if (rand(0).lt.0.0 .or. rand(0).gt.1.0) then
write (6,*) '*** rand(0) error'
call doabort()
end if
i = getcwd(wd)
if (i.ne.0) then
call perror ('*** getcwd')
call doabort
else
write (6,*) 'Current directory is "'//wd(:lenstr(wd))//'"'
end if
call chdir ('.',i)
if (i.ne.0) then
write (6,*) '***CHDIR to ".": ', i
call doabort
end if
i=hostnm(wd)
if(i.ne.0) then
call perror ('*** hostnm')
call doabort
else
write (6,*) 'Host name is ', wd(:lenstr(wd))
end if
i = access('/dev/null ', 'rw')
if (i.ne.0) write (6,*) '***Read/write ACCESS to /dev/null: ', i
write (6,*) 'Creating file "foo" for testing...'
open (3,file='foo',status='UNKNOWN')
rewind 3
call fputc(3, 'c',i)
call fputc(3, 'd',j)
if (i+j.ne.0) write(6,*) '***FPUTC: ', i
C why is it necessary to reopen? (who wrote this?)
C the better to test with, my dear! (-- burley)
close(3)
open(3,file='foo',status='old')
call fseek(3,0,0,*10)
go to 20
10 write(6,*) '***FSEEK failed'
call doabort
20 call fgetc(3, c,i)
if (i.ne.0) then
write(6,*) '***FGETC: ', i
call doabort
end if
if (c.ne.'c') then
write(6,*) '***FGETC read the wrong thing: ', ichar(c)
call doabort
end if
i= ftell(3)
if (i.ne.1) then
write(6,*) '***FTELL offset: ', i
call doabort
end if
call ftell(3, i)
if (i.ne.1) then
write(6,*) '***CALL FTELL offset: ', i
call doabort
end if
call chmod ('foo', 'a+w',i)
if (i.ne.0) then
write (6,*) '***CHMOD of "foo": ', i
call doabort
end if
i = fstat (3, fstatb)
if (i.ne.0) then
write (6,*) '***FSTAT of "foo": ', i
call doabort
end if
i = stat ('foo', statb)
if (i.ne.0) then
write (6,*) '***STAT of "foo": ', i
call doabort
end if
write (6,*) ' with stat array ', statb
if (statb(6) .ne. getgid ()) then
write (6,*) 'Note: FSTAT gid wrong (happens on some systems).'
end if
if (statb(5) .ne. getuid () .or. statb(4) .ne. 1) then
write (6,*) '*** FSTAT uid or nlink is wrong'
call doabort
end if
do i=1,13
if (fstatb (i) .ne. statb (i)) then
write (6,*) '*** FSTAT and STAT don''t agree on '// '
+ array element ', i, ' value ', fstatb (i), statb (i)
call doabort
end if
end do
i = lstat ('foo', fstatb)
do i=1,13
if (fstatb (i) .ne. statb (i)) then
write (6,*) '*** LSTAT and STAT don''t agree on '//
+ 'array element ', i, ' value ', fstatb (i), statb (i)
call doabort
end if
end do
C in case it exists already:
call unlink ('bar',i)
call link ('foo ', 'bar ',i)
if (i.ne.0) then
write (6,*) '***LINK "foo" to "bar" failed: ', i
call doabort
end if
call unlink ('foo',i)
if (i.ne.0) then
write (6,*) '***UNLINK "foo" failed: ', i
call doabort
end if
call unlink ('foo',i)
if (i.eq.0) then
write (6,*) '***UNLINK "foo" again: ', i
call doabort
end if
call gerror (gerr)
i = ierrno()
write (6,'(A,I3,A/1X,A)') ' The current error number is: ',
+ i,
+ ' and the corresponding message is:', gerr(:lenstr(gerr))
write (6,*) 'This is sent to stderr prefixed by the program name'
call getarg (0, line)
call perror (line (:lenstr (line)))
call unlink ('bar')
print *, 'MCLOCK returns ', mclock ()
print *, 'MCLOCK8 returns ', mclock8 ()
call cpu_time (d1)
print *, 'CPU_TIME returns ', d1
WRITE (6,*) 'You should see exit status 1'
CALL EXIT(1)
99 END
* Return length of STR not including trailing blanks, but always > 0.
integer function lenstr (str)
character*(*) str
if (str.eq.' ') then
lenstr=1
else
lenstr = lnblnk (str)
end if
end
* Just make sure SECOND() doesn't "magically" work the second time.
subroutine dumdum(r)
r = 3.14159
end
* Test whether sum is approximately left+right.
logical function issum (sum, left, right)
implicit none
real sum, left, right
real mysum, delta, width
mysum = left + right
delta = abs (mysum - sum)
width = abs (left) + abs (right)
issum = (delta .le. .0001 * width)
end
* Signal handler
subroutine ctrlc
print *, 'Got ^C'
call doabort
end
* A problem has been noticed, so maybe abort the test.
subroutine doabort
* For this version, print out all problems noticed.
* intrinsic abort
* call abort
end
libf2c/libU77/umask_.c deleted 100644 → 0
/* Copyright (C) 1996 Free Software Foundation, Inc.
This file is part of GNU Fortran libU77 library.
This library is free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published
by the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
GNU Fortran 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
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with GNU Fortran; see the file COPYING.LIB. If
not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA. */
#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
#include <sys/types.h>
#include <sys/stat.h>
#include "f2c.h"
integer
G77_umask_0 (integer * mask)
{
return umask ((mode_t) * mask);
}
libf2c/libU77/unlink_.c deleted 100644 → 0
/* Copyright (C) 1995, 1997 Free Software Foundation, Inc.
This file is part of GNU Fortran libU77 library.
This library is free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published
by the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
GNU Fortran 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
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with GNU Fortran; see the file COPYING.LIB. If
not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA. */
#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
#if HAVE_STDLIB_H
# include <stdlib.h>
#else
# include <stdio.h>
#endif
#if HAVE_UNISTD_H
# include <unistd.h>
#endif
#include <errno.h>
#if HAVE_SYS_PARAM_H
# include <sys/param.h>
#endif
#include "f2c.h"
void g_char (const char *a, ftnlen alen, char *b);
integer
G77_unlink_0 (const char *str, const ftnlen Lstr)
{
char *buff;
int i;
buff = malloc (Lstr + 1);
if (buff == NULL)
return -1;
g_char (str, Lstr, buff);
i = unlink (buff);
free (buff);
return i ? errno : 0; /* SGI version returns -1 on failure. */
}
libf2c/libU77/vxtidate_.c deleted 100644 → 0
/* Copyright (C) 1995, 1996, 2001 Free Software Foundation, Inc.
This file is part of GNU Fortran libU77 library.
This library is free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published
by the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
GNU Fortran 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
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with GNU Fortran; see the file COPYING.LIB. If
not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA. */
#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
#include <stdio.h>
#include <sys/types.h>
#if TIME_WITH_SYS_TIME
# include <sys/time.h>
# include <time.h>
#else
# if HAVE_SYS_TIME_H
# include <sys/time.h>
# else
# include <time.h>
# endif
#endif
#include "f2c.h"
/* VMS and Irix versions (at least) differ from libU77 elsewhere */
/* VMS style: */
/* Subroutine */
int
G77_vxtidate_y2kbug_0 (integer * m, integer * d, integer * y)
{
struct tm *lt;
time_t tim;
tim = time (NULL);
lt = localtime (&tim);
*y = lt->tm_year % 100;
*m = lt->tm_mon + 1;
*d = lt->tm_mday;
return 0;
}
#ifdef PIC
extern const char *G77_Non_Y2K_Compliance_Message;
int
G77_vxtidate_y2kbuggy_0 (integer * m __attribute__ ((__unused__)),
integer * d __attribute__ ((__unused__)),
integer * y __attribute__ ((__unused__)))
{
extern int G77_abort_0() __attribute__ ((noreturn));
fprintf (stderr, "%s\n", G77_Non_Y2K_Compliance_Message);
G77_abort_0 ();
}
#endif
libf2c/libU77/vxttime_.c deleted 100644 → 0
/* Copyright (C) 1995, 2001 Free Software Foundation, Inc.
This file is part of GNU Fortran libU77 library.
This library is free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published
by the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
GNU Fortran 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
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with GNU Fortran; see the file COPYING.LIB. If
not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA. */
#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
#include <stdio.h>
#include <sys/types.h>
#if TIME_WITH_SYS_TIME
# include <sys/time.h>
# include <time.h>
#else
# if HAVE_SYS_TIME_H
# include <sys/time.h>
# else
# include <time.h>
# endif
#endif
#if HAVE_STRING_H
# include <string.h>
#else
# include <strings.h>
#endif
#include "f2c.h"
/* Subroutine */
void
G77_vxttime_0 (char chtime[8],
const ftnlen Lchtime __attribute__ ((__unused__)))
{
time_t tim;
char *ctim;
tim = time (NULL);
ctim = ctime (&tim);
strncpy (chtime, ctim + 11, 8);
}
libf2c/permission.netlib deleted 100644 → 0
/****************************************************************
Copyright 1990 - 1997 by AT&T, Lucent Technologies and Bellcore.
Permission to use, copy, modify, and distribute this software
and its documentation for any purpose and without fee is hereby
granted, provided that the above copyright notice appear in all
copies and that both that the copyright notice and this
permission notice and warranty disclaimer appear in supporting
documentation, and that the names of AT&T, Bell Laboratories,
Lucent or Bellcore or any of their entities not be used in
advertising or publicity pertaining to distribution of the
software without specific, written prior permission.
AT&T, Lucent and Bellcore disclaim all warranties with regard to
this software, including all implied warranties of
merchantability and fitness. In no event shall AT&T, Lucent or
Bellcore be liable for any special, indirect or consequential
damages or any damages whatsoever resulting from loss of use,
data or profits, whether in an action of contract, negligence or
other tortious action, arising out of or in connection with the
use or performance of this software.
****************************************************************/
libf2c/readme.netlib deleted 100644 → 0
====== old index for f2c, now "readme from f2c" ============
FILES:
f2c.h Include file necessary for compiling output of the converter.
See the second NOTE below.
f2c.1 Man page for f2c.
f2c.1t Source for f2c.1 (to be processed by troff -man or nroff -man).
libf77 Library of non I/O support routines the generated C may need.
Fortran main programs result in a C function named MAIN__ that
is meant to be invoked by the main() in libf77.
libi77 Library of Fortran I/O routines the generated C may need.
Note that some vendors (e.g., BSD, Sun and MIPS) provide a
libF77 and libI77 that are incompatible with f2c -- they
provide some differently named routines or routines with the
names that f2c expects, but with different calling sequences.
On such systems, the recommended procedure is to merge
libf77 and libi77 into a single library, say libf2c, and to
install it where you can access it by specifying -lf2c . The
definition of link_msg in sysdep.c assumes this arrangement.
Both libf77 and libi77 are bundles, meant to be unpacked by the
Bourne (or Korn) shell. MS-DOS users can use the MKS Toolkit
to unpack libf77 and libi77.
libf2c.zip
Only available by ftp: combination of libf77 and libi77, with
Unix and PC makefiles.
f2c.ps Postscript for a technical report on f2c. After you strip the
mail header, the first line should be "%!PS".
fixes The complete change log, reporting bug fixes and other changes.
(Some recent change-log entries are given below).
fc A shell script that uses f2c and imitates much of the behavior
of commonly found f77 commands. You will almost certainly
need to adjust some of the shell-variable assignments to make
this script work on your system.
SUBDIRECTORY:
f2c/src Source for the converter itself, including a file of checksums
and source for a program to compute the checksums (to verify
correct transmission of the source), is available: ask netlib
(e.g., netlib@netlib.bell-labs.com) to
send all from f2c/src
If the checksums show damage to just a few source files, or if
the change log file (see "fixes" below) reports corrections to
some source files, you can request those files individually
"from f2c/src". For example, to get defs.h and xsum0.out, you
would ask netlib to
send defs.h xsum0.out from f2c/src
"all from f2c/src" is about 640 kilobytes long; for convenience
(and checksums), it includes copies of f2c.h, f2c.1, and f2c.1t.
Tip: if asked to send over 99,000 bytes in one request, netlib
breaks the shipment into 1000 line pieces and sends each piece
separately (since otherwise some mailers might gag). To avoid
the hassle of reassembling the pieces, try to keep each request
under 99,000 bytes long. The final number in each line of
xsum0.out gives the length of each file in f2c/src. For
example,
send exec.c expr.c from f2c/src
send format.c format_data.c from f2c/src
will give you slightly less hassle than
send exec.c expr.c format.c format_data.c from f2c/src
Alternatively, if all the mailers in your return path allow
long messages, you can supply an appropriate mailsize line in
your netlib request, e.g.
mailsize 200k
send exec.c expr.c format.c format_data.c from f2c/src
The makefile used to generate gram.c; now we distribute a
working gram.c, and you must say
make gram1.c
mv gram1.c gram.c
if you want to generate your own gram.c -- there are just too
many broken variants of yacc floating around nowadays for
generation of gram.c to be the default.
NOTE: You may exercise f2c by sending netlib@netlib.bell-labs.com
a message whose first line is "execute f2c" and whose remaining
lines are the Fortran 77 source that you wish to have converted.
Return mail brings you the resulting C, with f2c's error
messages between #ifdef uNdEfInEd and #endif at the end.
(To understand line numbers in the error messages, regard
the "execute f2c" line as line 0. It is stripped away by
the netlib software before f2c sees your Fortran input.)
Options described in the man page may be transmitted to
netlib by having the first line of input be a comment
whose first 6 characters are "c$f2c " and whose remaining
characters are the desired options, e.g., "c$f2c -R -u".
You may say "execute f2c" in the Subject line instead of (but
*not* in addition to) in the first line of the message body.
The incoming Fortran is saved, at least for a while. Don't
send any secrets!
BUGS: Please send bug reports (including the shortest example
you can find that illustrates the bug) to research!dmg
or dmg@bell-labs.com . You might first check whether
the bug goes away when you turn optimization off.
NOTE: f2c.h defines several types, e.g., real, integer, doublereal.
The definitions in f2c.h are suitable for most machines, but if
your machine has sizeof(double) > 2*sizeof(long), you may need
to adjust f2c.h appropriately. f2c assumes
sizeof(doublecomplex) = 2*sizeof(doublereal)
sizeof(doublereal) = sizeof(complex)
sizeof(doublereal) = 2*sizeof(real)
sizeof(real) = sizeof(integer)
sizeof(real) = sizeof(logical)
sizeof(real) = 2*sizeof(shortint)
EQUIVALENCEs may not be translated correctly if these
assumptions are violated.
On machines, such as those using a DEC Alpha processor, on
which sizeof(short) == 2, sizeof(int) == sizeof(float) == 4,
and sizeof(long) == sizeof(double) == 8, it suffices to
modify f2c.h by removing the first occurrence of "long "
on each line containing "long ", e.g., by issuing the
commands
mv f2c.h f2c.h0
sed 's/long //' f2c.h0 >f2c.h
On such machines, one can enable INTEGER*8 by uncommenting
the typedef of longint in f2c.h, so it reads
typedef long longint;
by compiling libI77 with -DAllow_TYQUAD, and by adjusting
libF77/makefile as described in libF77/README.
Some machines may have sizeof(int) == 4, sizeof(float) == 8,
and sizeof(long long) == 8. On such machines, adjust f2c.h
by changing "long int " to "long long ", e.g., by saying
mv f2c.h f2c.h0
sed 's/long int /long long /' f2c.h0 >f2c.h
One can enable INTEGER*8 on such machines as described
above, but with
typedef long long longint;
There exists a C compiler that objects to the lines
typedef VOID C_f; /* complex function */
typedef VOID H_f; /* character function */
typedef VOID Z_f; /* double complex function */
in f2c.h . If yours is such a compiler, do two things:
1. Complain to your vendor about this compiler bug.
2. Find the line
#define VOID void
in f2c.h and change it to
#define VOID int
(For readability, the f2c.h lines shown above have had two
tabs inserted before their first character.)
FTP: All the material described above is now available by anonymous
ftp from netlib.bell-labs.com (login: anonymous; Password: your
E-mail address; cd netlib/f2c). Note that you can say, e.g.,
cd /netlib/f2c/src
binary
prompt
mget *.gz
to get all the .gz files in src. You must uncompress the .gz
files once you have a copy of them, e.g., by
gzip -dN *.gz
You can also get the entire f2c tree as a tar file:
ftp://netlib.bell-labs.com/netlib/f2c.tar
(which is a synthetic file -- created on the fly and not visible
to ftp's "ls" or "dir" commands).
Subdirectory msdos contains two PC versions of f2c,
f2c.exe.gz and f2cx.exe.gz; the latter uses extended memory.
The README in that directory provides more details.
Changes appear first in the f2c files available by E-mail
from netlib@netlib.bell-labs.com. If the deamons work right,
changed files are available the next day by ftp from
netlib.bell-labs.com. In due course, they reach other netlib servers.
CHANGE NOTIFICATION:
Send the E-mail message
subscribe f2c
to netlib@netlib.bell-labs.com to request notification of new and
changed f2c files. (Beware that automatically sent change
notifications may reach you before changes have reached
ftp://netlib.bell-labs.com/netlib/f2c or to other netlib servers.)
Send the E-mail message
unsubscribe f2c
to recant your notification request.
-----------------
Recent change log (partial)
-----------------
Mon May 13 23:35:26 EDT 1996
Recognize Fortran 90's /= as a synonym for .NE.. (<> remains a
synonym for .NE..)
Emit an empty int function of no arguments to supply an external
name to named block data subprograms (so they can be called somewhere
to force them to be loaded from a library).
Fix bug (memory fault) in handling the following illegal Fortran:
parameter(i=1)
equivalence(i,j)
end
Treat cdabs, cdcos, cdexp, cdlog, cdsin, and cdsqrt as synonyms for
the double complex intrinsics zabs, zcos, zexp, zlog, zsin, and zsqrt,
respectively, unless -cd is specified.
Recognize the Fortran 90 bit-manipulation intrinsics btest, iand,
ibclr, ibits, ibset, ieor, ior, ishft, and ishftc, unless -i90 is
specified. Note that iand, ieor, and ior are thus now synonyms for
"and", "xor", and "or", respectively.
Add three macros (bit_test, bit_clear, bit_set) to f2c.h for use
with btest, ibclr, and ibset, respectively. Add new functions
[lq]bit_bits, [lq]bit_shift, and [lq]_bit_cshift to libF77 for
use with ibits, ishft, and ishftc, respectively.
Add integer function ftell(unit) (returning -1 on error) and
subroutine fseek(unit, offset, whence, *) to libI77 (with branch to
label * on error).
Tue May 14 23:21:12 EDT 1996
Fix glitch (possible memory fault, or worse) in handling multiple
entry points with names over 28 characters long.
Mon Jun 10 01:20:16 EDT 1996
Update netlib E-mail and ftp addresses in f2c/readme and
f2c/src/readme (which are different files) -- to reflect the upcoming
breakup of AT&T.
libf77: trivial tweaks to F77_aloc.c and system_.c; Version.c not
changed.
libi77: Adjust rsli.c and lread.c so internal list input with too
few items in the input string will honor end= .
Mon Jun 10 22:59:57 EDT 1996
Add Bits_per_Byte to sysdep.h and adjust definition of Table_size
to depend on Bits_per_Byte (forcing Table_size to be a power of 2); in
lex.c, change "comstart[c & 0xfff]" to "comstart[c & (Table_size-1)]"
to avoid an out-of-range subscript on end-of-file.
Wed Jun 12 00:24:28 EDT 1996
Fix bug in output.c (dereferencing a freed pointer) revealed in
print * !np in out_call in output.c clobbered by free
end !during out_expr.
Wed Jun 19 08:12:47 EDT 1996
f2c.h: add types uinteger, ulongint (for libF77); add qbit_clear
and qbit_set macros (in a commented-out section) for integer*8.
For integer*8, use qbit_clear and qbit_set for ibclr and ibset.
libf77: add casts to unsigned in [lq]bitshft.c.
Thu Jun 20 13:30:43 EDT 1996
Complain at character*(*) in common (rather than faulting).
Fix bug in recognizing hex constants that start with "16#" (e.g.,
16#1234abcd, which is a synonym for z'1234abcd').
Fix bugs in constant folding of expressions involving btest, ibclr,
and ibset.
Fix bug in constant folding of rshift(16#80000000, -31) (on a 32-bit
machine; more generally, the bug was in constant folding of
rshift(ibset(0,NBITS-1), 1-NBITS) when f2c runs on a machine with
long ints having NBITS bits.
Mon Jun 24 07:58:53 EDT 1996
Adjust struct Literal and newlabel() function to accommodate huge
source files (with more than 32767 newlabel() invocations).
Omit .c file when the .f file has a missing final end statement.
Wed Jun 26 14:00:02 EDT 1996
libi77: Add discussion of MXUNIT (highest allowed Fortran unit number)
to libI77/README.
Fri Jun 28 14:16:11 EDT 1996
Fix glitch with -onetrip: the temporary variable used for nonconstant
initial loop variable values was recycled too soon. Example:
do i = j+1, k
call foo(i+1) ! temp for j+1 was reused here
enddo
end
Tue Jul 2 16:11:27 EDT 1996
formatdata.c: add a 0 to the end of the basetype array (for TYBLANK)
(an omission that was harmless on most machines).
expr.c: fix a dereference of NULL that was only possible with buggy
input, such as
subroutine $sub(s) ! the '$' is erroneous
character s*(*)
s(1:) = ' '
end
Sat Jul 6 00:44:56 EDT 1996
Fix glitch in the intrinsic "real" function when applied to a
complex (or double complex) variable and passed as an argument to
some intrinsic functions. Example:
complex a
b = sqrt(real(a))
end
Fix glitch (only visible if you do not use f2c's malloc and the
malloc you do use is defective in the sense that malloc(0) returns 0)
in handling include files that end with another include (perhaps
followed by comments).
Fix glitch with character*(*) arguments named "h" and "i" when
the body of the subroutine invokes the intrinsic LEN function.
Arrange that after a previous "f2c -P foo.f" has produced foo.P,
running "f2c foo.P foo.f" will produce valid C when foo.f contains
call sub('1234')
end
subroutine sub(msg)
end
Specifically, the length argument in "call sub" is now suppressed.
With or without foo.P, it is also now suppressed when the order of
subprograms in file foo.f is reversed:
subroutine sub(msg)
end
call sub('1234')
end
Adjust copyright notices to reflect AT&T breakup.
Wed Jul 10 09:25:49 EDT 1996
Fix bug (possible memory fault) in handling erroneously placed
and inconsistent declarations. Example that faulted:
character*1 w(8)
call foo(w)
end
subroutine foo(m)
data h /0.5/
integer m(2) ! should be before data
end
Fix bug (possible fault) in handling illegal "if" constructions.
Example (that faulted):
subroutine foo(i,j)
if (i) then ! bug: i is integer, not logical
else if (j) then ! bug: j is integer, not logical
endif
end
Fix glitch with character*(*) argument named "ret_len" to a
character*(*) function.
Wed Jul 10 23:04:16 EDT 1996
Fix more glitches in the intrinsic "real" function when applied to a
complex (or double complex) variable and passed as an argument to
some intrinsic functions. Example:
complex a, b
r = sqrt(real(conjg(a))) + sqrt(real(a*b))
end
Thu Jul 11 17:27:16 EDT 1996
Fix a memory fault associated with complicated, illegal input.
Example:
subroutine goo
character a
call foo(a) ! inconsistent with subsequent def and call
end
subroutine foo(a)
end
call foo(a)
end
Wed Jul 17 19:18:28 EDT 1996
Fix yet another case of intrinsic "real" applied to a complex
argument. Example:
complex a(3)
x = sqrt(real(a(2))) ! gave error message about bad tag
end
Mon Aug 26 11:28:57 EDT 1996
Tweak sysdep.c for non-Unix systems in which process ID's can be
over 5 digits long.
Tue Aug 27 08:31:32 EDT 1996
Adjust the ishft intrinsic to use unsigned right shifts. (Previously,
a negative constant second operand resulted in a possibly signed shift.)
Thu Sep 12 14:04:07 EDT 1996
equiv.c: fix glitch with -DKR_headers.
libi77: fmtlib.c: fix bug in printing the most negative integer.
Fri Sep 13 08:54:40 EDT 1996
Diagnose some illegal appearances of substring notation.
Tue Sep 17 17:48:09 EDT 1996
Fix fault in handling some complex parameters. Example:
subroutine foo(a)
double complex a, b
parameter(b = (0,1))
a = b ! f2c faulted here
end
Thu Sep 26 07:47:10 EDT 1996
libi77: fmt.h: for formatted writes of negative integer*1 values,
make ic signed on ANSI systems. If formatted writes of integer*1
values trouble you when using a K&R C compiler, switch to an ANSI
compiler or use a compiler flag that makes characters signed.
Tue Oct 1 14:41:36 EDT 1996
Give a better error message when dummy arguments appear in data
statements.
Thu Oct 17 13:37:22 EDT 1996
Fix bug in typechecking arguments to character and complex (or
double complex) functions; the bug could cause length arguments
for character arguments to be omitted on invocations appearing
textually after the first invocation. For example, in
subroutine foo
character c
complex zot
call goo(zot(c), zot(c))
end
the length was omitted from the second invocation of zot, and
there was an erroneous error message about inconsistent calling
sequences.
Wed Dec 4 13:59:14 EST 1996
Fix bug revealed by
subroutine test(cdum,rdum)
complex cdum
rdum=cos(real(cdum)) ! "Unexpected tag 3 in opconv_fudge"
end
Fix glitch in parsing "DO 10 D0 = 1, 10".
Fix glitch in parsing
real*8 x
real*8 x ! erroneous "incompatible type" message
call foo(x)
end
lib[FI]77/makefile: add comment about omitting -x under Solaris.
Mon Dec 9 23:15:02 EST 1996
Fix glitch in parameter adjustments for arrays whose lower
bound depends on a scalar argument. Example:
subroutine bug(p,z,m,n)
integer z(*),m,n
double precision p(z(m):z(m) + n) ! p_offset botched
call foo(p(0), p(n))
end
libi77: complain about non-positive rec= in direct read and write
statements.
libf77: trivial adjustments; Version.c not changed.
Wed Feb 12 00:18:03 EST 1997
output.c: fix (seldom problematic) glitch in out_call: put parens
around the ... in a test of the form "if (q->tag == TADDR && ...)".
vax.c: fix bug revealed in the "psi_offset =" assignment in the
following example:
subroutine foo(psi,m)
integer z(100),m
common /a/ z
double precision psi(z(m):z(m) + 10)
call foo(m+1, psi(0),psi(10))
end
Mon Feb 24 23:44:54 EST 1997
For consistency with f2c's current treatment of adjacent character
strings in FORMAT statements, recognize a Hollerith string following
a string (and merge adjacent strings in FORMAT statements).
Wed Feb 26 13:41:11 EST 1997
New libf2c.zip, a combination of the libf77 and libi77 bundles (and
available only by ftp).
libf77: adjust functions with a complex output argument to permit
aliasing it with input arguments. (For now, at least, this is just
for possible benefit of g77.)
libi77: tweak to ftell_.c for systems with strange definitions of
SEEK_SET, etc.
Tue Apr 8 20:57:08 EDT 1997
libf77: [cz]_div.c: tweaks invisible on most systems (that may
improve things slightly with optimized compilation on systems that use
gratuitous extra precision).
libi77: fmt.c: adjust to complain at missing numbers in formats
(but still treat missing ".nnn" as ".0").
Fri Apr 11 14:05:57 EDT 1997
libi77: err.c: attempt to make stderr line buffered rather than
fully buffered. (Buffering is needed for format items T and TR.)
Thu Apr 17 22:42:43 EDT 1997
libf77: add F77_aloc.o to makefile (and makefile.u in libf2c.zip).
Fri Apr 25 19:32:09 EDT 1997
libf77: add [de]time_.c (which may give trouble on some systems).
Tue May 27 09:18:52 EDT 1997
libi77: ftell_.c: fix typo that caused the third argument to be
treated as 2 on some systems.
Mon Jun 9 00:04:37 EDT 1997
libi77 (and libf2c.zip): adjust include order in err.c lread.c wref.c
rdfmt.c to include fmt.h (etc.) after system includes. Version.c not
changed.
Mon Jun 9 14:29:13 EDT 1997
src/gram.c updated; somehow it did not reflect the change of
19961001 to gram.dcl.
Mon Jul 21 16:04:54 EDT 1997
proc.c: fix glitch in logic for "nonpositive dimension" message.
libi77: inquire.c: always include string.h (for possible use with
-DNON_UNIX_STDIO); Version.c not changed.
Thu Jul 24 17:11:23 EDT 1997
Tweak "Notice" to reflect the AT&T breakup -- we missed it when
updating the copyright notices in the source files last summer.
Adjust src/makefile so malloc.o is not used by default, but can
be specified with "make MALLOC=malloc.o".
Add comments to src/README about the "CRAY" T3E.
Tue Aug 5 14:53:25 EDT 1997
Add definition of calloc to malloc.c; this makes f2c's malloc
work on some systems where trouble hitherto arose because references
to calloc brought in the system's malloc. (On sensible systems,
calloc is defined separately from malloc. To avoid confusion on
other systems, f2c/malloc.c now defines calloc.)
libi77: lread.c: adjust to accord with a change to the Fortran 8X
draft (in 1990 or 1991) that rescinded permission to elide quote marks
in namelist input of character data; to get the old behavior, compile
with F8X_NML_ELIDE_QUOTES #defined. wrtfmt.o: wrt_G: tweak to print
the right number of 0's for zero under G format.
Sat Aug 16 05:45:32 EDT 1997
libi77: iio.c: fix bug in internal writes to an array of character
strings that sometimes caused one more array element than required by
the format to be blank-filled. Example: format(1x).
Wed Sep 17 00:39:29 EDT 1997
libi77: fmt.[ch] rdfmt.c wrtfmt.c: tweak struct syl for machines
with 64-bit pointers and 32-bit ints that did not 64-bit align
struct syl (e.g., Linux on the DEC Alpha). This change should be
invisible on other machines.
Sun Sep 21 22:05:19 EDT 1997
libf77: [de]time_.c (Unix systems only): change return type to double.
Thu Dec 4 22:10:09 EST 1997
Fix bug with handling large blocks of comments (over 4k); parts of the
second and subsequent blocks were likely to be lost (not copied into
comments in the resulting C). Allow comment lines to be longer before
breaking them.
Mon Jan 19 17:19:27 EST 1998
makefile: change the rule for making gram.c to one for making gram1.c;
henceforth, asking netlib to "send all from f2c/src" will bring you a
working gram.c. Nowadays there are simply too many broken versions of
yacc floating around.
libi77: backspace.c: for b->ufmt==0, change sizeof(int) to
sizeof(uiolen). On machines where this would make a difference, it is
best for portability to compile libI77 with -DUIOLEN_int, which will
render the change invisible.
Tue Feb 24 08:35:33 EST 1998
makefile: remove gram.c from the "make clean" rule.
Wed Feb 25 08:29:39 EST 1998
makefile: change CFLAGS assignment to -O; add "veryclean" rule.
Wed Mar 4 13:13:21 EST 1998
libi77: open.c: fix glitch in comparing file names under
-DNON_UNIX_STDIO.
Mon Mar 9 23:56:56 EST 1998
putpcc.c: omit an unnecessary temporary variable in computing
(expr)**3.
libf77, libi77: minor tweaks to make some C++ compilers happy;
Version.c not changed.
Wed Mar 18 18:08:47 EST 1998
libf77: minor tweaks to [ed]time_.c; Version.c not changed.
libi77: endfile.c, open.c: acquire temporary files from tmpfile(),
unless compiled with -DNON_ANSI_STDIO, which uses mktemp().
New buffering scheme independent of NON_UNIX_STDIO for handling T
format items. Now -DNON_UNIX_STDIO is no longer be necessary for
Linux, and libf2c no longer causes stderr to be buffered -- the former
setbuf or setvbuf call for stderr was to make T format items work.
open.c: use the Posix access() function to check existence or
nonexistence of files, except under -DNON_POSIX_STDIO, where trial
fopen calls are used. In open.c, fix botch in changes of 19980304.
libf2c.zip: the PC makefiles are now set for NT/W95, with comments
about changes for DOS.
Fri Apr 3 17:22:12 EST 1998
Adjust fix of 19960913 to again permit substring notation on
character variables in data statements.
Sun Apr 5 19:26:50 EDT 1998
libi77: wsfe.c: make $ format item work: this was lost in the changes
of 17 March 1998.
Sat May 16 19:08:51 EDT 1998
Adjust output of ftnlen constants: rather than appending L,
prepend (ftnlen). This should make the resulting C more portable,
e.g., to systems (such as DEC Alpha Unix systems) on which long
may be longer than ftnlen.
Adjust -r so it also casts REAL expressions passed to intrinsic
functions to REAL.
Wed May 27 16:02:35 EDT 1998
libf2c.zip: tweak description of compiling libf2c for INTEGER*8
to accord with makefile.u rather than libF77/makefile.
Thu May 28 22:45:59 EDT 1998
libi77: backspace.c dfe.c due.c iio.c lread.c rsfe.c sue.c wsfe.c:
set f__curunit sooner so various error messages will correctly
identify the I/O unit involved.
libf2c.zip: above, plus tweaks to PC makefiles: for some purposes,
it's still best to compile with -DMSDOS (even for use with NT).
Thu Jun 18 01:22:52 EDT 1998
libi77: lread.c: modified so floating-point numbers (containing
either a decimal point or an exponent field) are treated as errors
when they appear as list input for integer data. Compile lread.c with
-DALLOW_FLOAT_IN_INTEGER_LIST_INPUT to restore the old behavior.
Mon Aug 31 10:38:54 EDT 1998
formatdata.c: if possible, and assuming doubles must be aligned on
double boundaries, use existing holes in DATA for common blocks to
force alignment of the block. For example,
block data
common /abc/ a, b
double precision a
integer b(2)
data b(2)/1/
end
used to generate
struct {
integer fill_1[3];
integer e_2;
doublereal e_3;
} abc_ = { {0}, 1, 0. };
and now generates
struct {
doublereal fill_1[1];
integer fill_2[1];
integer e_3;
} abc_ = { {0}, {0}, 1 };
In the old generated C, e_3 was added to force alignment; in the new C,
fill_1 does this job.
Mon Sep 7 19:48:51 EDT 1998
libi77: move e_wdfe from sfe.c to dfe.c, where it was originally.
Why did it ever move to sfe.c?
Tue Sep 8 10:22:50 EDT 1998
Treat dreal as a synonym for dble unless -cd is specified on the
command line.
Sun Sep 13 22:23:41 EDT 1998
format.c: fix bug in writing prototypes under f2c -A ... *.P:
under some circumstances involving external functions with no known
type, a null pointer was passed to printf.
Tue Oct 20 23:25:54 EDT 1998
Comments added to libf2c/README and libF77/README, pointing out
the need to modify signal1.h on some systems.
Thu Nov 12 15:34:09 EST 1998
libf77, libf2c.zip: minor tweaks to [de]time_.c and the makefiles,
so makefile.sy, makefile.vc, and makefile.wat deal with [de]time_.c.
Wed Feb 10 22:59:52 EST 1999
defs.h lex.c: permit long names (up to at least roughly
MAX_SHARPLINE_LEN = 1000 characters long) in #line lines (which only
matters under -g).
fc: add -U option; recognize .so files.
Sat Feb 13 10:18:27 EST 1999
libf2c: endfile.c, lread.c, signal1.h0: minor tweaks to make some
(C++) compilers happier; f77_aloc.c: make exit_() visible to C++
compilers. Version strings not changed.
Thu Mar 11 23:14:02 EST 1999
Modify f2c (exec.c, expr.c) to diagnose incorrect mixing of types
when (f2c extended) intrinsic functions are involved, as in
(not(17) .and. 4). Catching this in the first executable statement
is a bit tricky, as some checking must be postponed until all statement
function declarations have been parsed. Thus there is a chance of
today's changes introducing bugs under (let us hope) unusual conditions.
Sun Mar 28 13:17:44 EST 1999
lex.c: tweak to get the file name right in error messages caused
by statements just after a # nnn "filename" line emitted by the C
preprocessor. (The trouble is that the line following the # nnn line
must be read to see if it is a continuation of the stuff that preceded
the # nnn line.) When # nnn "filename" lines appear among the lines
for a Fortran statement, the filename reported in an error message for
the statement should now be the file that was current when the first
line of the statement was read.
Sun May 2 22:38:25 EDT 1999
libf77, libi77, libf2c.zip: make getenv_() more portable (call
getenv() rather than knowing about char **environ); adjust some
complex intrinsics to work with overlapping arguments (caused by
inappropriate use of equivalence); open.c: get "external" versus
"internal" right in the error message if a file cannot be opened;
err.c: cast a pointer difference to (int) for %d; rdfmt.c: omit
fixed-length buffer that could be overwritten by formats Inn or Lnn
with nn > 83.
Mon May 3 13:14:07 EDT 1999
"Invisible" changes to omit a few compiler warnings in f2c and
libf2c; two new casts in libf2c/open.c that matter with 64-bit longs,
and one more tweak (libf2c/c_log.c) for pathological equivalences.
Minor update to "fc" script: new -L flag and comment correction.
Tue May 4 10:06:26 EDT 1999
libf77, libf2c.zip: forgot to copy yesterday's latest updates to
netlib.
Fri Jun 18 02:33:08 EDT 1999
libf2c.zip: rename backspace.c backspac.c, and fix a glitch in it
-- b->ufd may change in t_runc(). (For now, it's still backspace.c
in the libi77 bundle.)
Sun Jun 27 22:05:47 EDT 1999
libf2c.zip, libi77: rsne.c: fix bug in namelist input: a misplaced
increment could cause wrong array elements to be assigned; e.g.,
"&input k(5)=10*1 &end" assigned k(5) and k(15 .. 23).
Current timestamps of files in "all from f2c/src", sorted by time,
appear below (mm/dd/year hh:mm:ss). To bring your source up to date,
obtain source files with a timestamp later than the time shown in your
version.c. Note that the time shown in the current version.c is the
timestamp of the source module that immediately follows version.c below:
5/03/1999 12:46:15 version.c
5/03/1999 12:39:35 formatdata.c
5/03/1999 12:31:14 format.c
5/03/1999 12:27:17 p1output.c
5/03/1999 12:27:17 data.c
5/03/1999 10:01:12 xsum0.out
5/03/1999 9:59:36 io.c
5/03/1999 9:59:36 misc.c
5/03/1999 9:59:36 init.c
3/26/1999 23:18:11 lex.c
3/11/1999 16:44:17 expr.c
3/11/1999 16:42:42 exec.c
2/10/1999 17:43:01 defs.h
9/08/1998 10:16:51 f2c.1
9/08/1998 10:16:48 f2c.1t
9/08/1998 10:14:53 intr.c
5/16/1998 16:55:49 output.c
4/03/1998 17:15:05 gram.c
4/03/1998 17:14:59 gram.dcl
3/09/1998 0:30:23 putpcc.c
2/25/1998 8:18:04 makefile
12/04/1997 17:44:11 niceprintf.c
8/05/1997 10:31:26 malloc.c
7/24/1997 17:10:55 README
7/24/1997 16:06:19 Notice
7/21/1997 12:58:44 proc.c
2/11/1997 23:39:14 vax.c
12/04/1996 13:07:53 gram.exec
9/12/1996 12:12:46 equiv.c
8/26/1996 9:41:13 sysdep.c
7/09/1996 10:40:45 names.c
7/04/1996 9:55:45 sysdep.h
7/04/1996 9:55:43 put.c
7/04/1996 9:55:41 pread.c
7/04/1996 9:55:40 parse_args.c
7/04/1996 9:55:36 mem.c
7/04/1996 9:55:36 memset.c
7/04/1996 9:55:35 main.c
7/04/1996 9:55:29 error.c
7/04/1996 9:55:27 cds.c
7/03/1996 15:47:49 xsum.c
6/19/1996 7:04:27 f2c.h
6/19/1996 2:52:05 defines.h
5/13/1996 0:40:32 gram.head
2/25/1994 2:07:19 parse.h
2/22/1994 19:07:20 iob.h
2/22/1994 18:56:53 p1defs.h
2/22/1994 18:53:46 output.h
2/22/1994 18:51:14 names.h
2/22/1994 18:30:41 format.h
1/18/1994 18:12:52 tokens
3/06/1993 14:13:58 gram.expr
1/28/1993 9:03:16 ftypes.h
4/06/1990 0:00:57 gram.io
2/03/1990 0:58:26 niceprintf.h
1/07/1990 1:20:01 usignal.h
11/27/1989 8:27:37 machdefs.h
7/01/1989 11:59:44 pccdefs.h
maintainer-scripts/gcc_release
......@@ -308,7 +308,6 @@ build_tarfiles() {
# Now, build one for each of the languages.
maybe_build_tarfile gcc-ada-${RELEASE} ${ADA_DIRS}
maybe_build_tarfile gcc-g++-${RELEASE} ${CPLUSPLUS_DIRS}
maybe_build_tarfile gcc-g77-${RELEASE} ${FORTRAN_DIRS}
maybe_build_tarfile gcc-fortran-${RELEASE} ${FORTRAN95_DIRS}
maybe_build_tarfile gcc-java-${RELEASE} ${JAVA_DIRS}
maybe_build_tarfile gcc-objc-${RELEASE} ${OBJECTIVEC_DIRS}
......@@ -316,7 +315,7 @@ build_tarfiles() {
# The core is everything else.
EXCLUDES=""
for x in ${ADA_DIRS} ${CPLUSPLUS_DIRS} ${FORTRAN_DIRS} ${FORTRAN95_DIRS}\
for x in ${ADA_DIRS} ${CPLUSPLUS_DIRS} ${FORTRAN95_DIRS}\
${JAVA_DIRS} ${OBJECTIVEC_DIRS} ${TESTSUITE_DIRS}; do
EXCLUDES="${EXCLUDES} --exclude $x"
done
......@@ -503,7 +502,6 @@ SOURCE_DIRECTORY=""
# tar files. These are all relative to the top of the source tree.
ADA_DIRS="gcc/ada libada"
CPLUSPLUS_DIRS="gcc/cp libstdc++-v3"
FORTRAN_DIRS="gcc/f libf2c"
FORTRAN95_DIRS="gcc/fortran libgfortran"
JAVA_DIRS="gcc/java libjava libffi fastjar zlib boehm-gc"
OBJECTIVEC_DIRS="gcc/objc libobjc"
......@@ -653,7 +651,6 @@ SOURCE_DIRECTORY="${WORKING_DIRECTORY}/gcc-${RELEASE}"
# relative to the WORKING_DIRECTORY.
ADA_DIRS=`adjust_dirs ${ADA_DIRS}`
CPLUSPLUS_DIRS=`adjust_dirs ${CPLUSPLUS_DIRS}`
FORTRAN_DIRS=`adjust_dirs ${FORTRAN_DIRS}`
FORTRAN95_DIRS=`adjust_dirs ${FORTRAN95_DIRS}`
JAVA_DIRS=`adjust_dirs ${JAVA_DIRS}`
OBJECTIVEC_DIRS=`adjust_dirs ${OBJECTIVEC_DIRS}`
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment