diff options
Diffstat (limited to 'contrib/libf2c')
234 files changed, 7950 insertions, 8170 deletions
diff --git a/contrib/libf2c/ChangeLog b/contrib/libf2c/ChangeLog index c7086d8..12285ee 100644 --- a/contrib/libf2c/ChangeLog +++ b/contrib/libf2c/ChangeLog @@ -1,12 +1,43 @@ -2003-02-05 Release Manager +2003-07-04 H.J. Lu <hongjiu.lu@intel.com> - * GCC 3.2.2 Released. + * Makefile.in: Replace PWD with PWD_COMMAND. -2003-01-28 Christian Cornelssen <ccorn@cs.tu-berlin.de> +2003-05-13 Release Manager - * Makefile.in (FLAGS_TO_PASS): Also pass DESTDIR. - (install, uninstall): Prepend $(DESTDIR) to destination - paths in all (un)installation commands. + * GCC 3.3 Released. + +2003-05-13 Release Manager + + * GCC 3.3 Released. + +2003-05-13 Release Manager + + * GCC 3.3 Released. + +2003-04-23 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. + +2003-02-20 Alexandre Oliva <aoliva@redhat.com> + + * configure.in: Propagate ORIGINAL_LD_FOR_MULTILIBS to + config.status. + * configure: Rebuilt. 2003-01-27 Alexandre Oliva <aoliva@redhat.com> @@ -16,29 +47,59 @@ version_specific_libs is enabled. * configure: Rebuilt. -2002-11-19 Release Manager +2003-01-26 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. + +2002-11-19 Toon Moene <toon@moene.indiv.nluug.nl> - * GCC 3.2.1 Released. + PR fortran/8587 + * libF77/pow_zz.c: Handle (0.0, 0.0) ** power. -2002-11-19 Release Manager +2002-10-18 Krister Walfridsson <cato@df.lth.se> - * GCC 3.2.1 Released. + * 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-11-18 Release Manager +2002-09-23 Zack Weinberg <zack@codesourcery.com> - * GCC 3.2.1 Released. + * 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. -Mon Oct 7 00:32:38 2002 Kaveh R. Ghazi <ghazi@caip.rutgers.edu> + * 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-08-14 Release Manager +2002-09-14 Tim Prince <tprince@computer.org> + + PR libf2c/7384 + * libU77/datetime_.c: Use GetLocalTime on MS-Windows. - * GCC 3.2 Released. +2002-08-31 Toon Moene <toon@moene.indiv.nluug.nl> -2002-07-25 Release Manager + PR fortran/6367 + * libI77/rsne.c (x_rsne): Use local variable no2 to count further + list elements to read. - * GCC 3.1.1 Released. +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> @@ -47,13 +108,170 @@ Mon Oct 7 00:32:38 2002 Kaveh R. Ghazi <ghazi@caip.rutgers.edu> * configure.in: Call it before AC_CANONICAL_SYSTEM. * configure: Regenerate. -2002-05-14 Release Manager +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. - * GCC 3.1 Released. +2002-05-20 Toon Moene <toon@moene.indiv.nluug.nl> -2002-05-14 Release Manager + * Makefile.in: Use @SHELL@, not /bin/sh for SHELL + definition. - * GCC 3.1 Released. +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> @@ -63,14 +281,18 @@ Mon Oct 7 00:32:38 2002 Kaveh R. Ghazi <ghazi@caip.rutgers.edu> 2002-05-02 Alexandre Oliva <aoliva@redhat.com> - * Makefile.in: Fix for multilibbed natives. + * 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-01 Phil Edwards <pme@gcc.gnu.org> +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. @@ -213,7 +435,7 @@ Mon Oct 7 00:32:38 2002 Kaveh R. Ghazi <ghazi@caip.rutgers.edu> of shared libf2c to 0:0:0. 2001-09-29 Juergen Pfeifer <juergen.pfeifer@gmx.net> - Toon Moene <toon@moene.indiv.nluug.nl> + Toon Moene <toon@moene.indiv.nluug.nl> Make libf2c a shared library. @@ -287,7 +509,7 @@ Wed Jul 18 11:14:33 2001 Kaveh R. Ghazi <ghazi@caip.rutgers.edu> * 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> + Pedro Vazquez <vazquez@penelope.iqm.unicamp.br> * libI77/configure.in: Check for fseeko, ftello. * libI77/configure: Rebuilt. @@ -314,7 +536,7 @@ Wed Jul 18 11:14:33 2001 Kaveh R. Ghazi <ghazi@caip.rutgers.edu> * 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> + Pedro Vazquez <vazquez@penelope.iqm.unicamp.br> * libI77/fio.h: Use off_t when appropriate. * libI77/backspace.c (f_back): Ditto. @@ -472,7 +694,7 @@ Wed Jul 18 11:14:33 2001 Kaveh R. Ghazi <ghazi@caip.rutgers.edu> file atomically. 2000-07-03 Donn Terry (donnte@microsoft.com) - * libU77/aclocal.m4: check for 2 argument gettimeofday without + * libU77/aclocal.m4: check for 2 argument gettimeofday without struct timezone 2000-07-02 Toon Moene <toon@moene.indiv.nluug.nl> diff --git a/contrib/libf2c/Makefile.in b/contrib/libf2c/Makefile.in index fb0f218..7a2c1d9 100644 --- a/contrib/libf2c/Makefile.in +++ b/contrib/libf2c/Makefile.in @@ -19,7 +19,8 @@ #the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA #02111-1307, USA. -SHELL = /bin/sh +SHELL = @SHELL@ +PWD_COMMAND = $${PWDCMD-pwd} MAKEOVERRIDES= .NOEXPORTS: @@ -66,6 +67,7 @@ INSTALL_DATA = @INSTALL_DATA@ LIBTOOL = @LIBTOOL@ CC = @CC@ +WARN_CFLAGS = -W -Wall CFLAGS = @CFLAGS@ AR = @AR@ RANLIB = @RANLIB@ @@ -76,6 +78,7 @@ FLAGS_TO_PASS= \ CC='$(CC)' \ LD='$(LD)' \ LIBTOOL='$(LIBTOOL)' \ + WARN_CFLAGS='$(WARN_CFLAGS)' \ CFLAGS='$(CFLAGS)' \ CPPFLAGS='$(CPPFLAGS)' \ DESTDIR='$(DESTDIR)' \ @@ -173,7 +176,7 @@ s-libe77: f2cext.c do \ echo $${name}; \ $(LIBTOOL) --mode=compile $(CC) -c -I. -I$(srcdir) -I../../include \ - $(CPPFLAGS) $(CFLAGS) -DL$${name} $(srcdir)/f2cext.c \ + $(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; \ @@ -256,8 +259,8 @@ rebuilt: configure installcheck installdirs all-unilib subdir_do: - @rootpre=`pwd`/; export rootpre; \ - srcrootpre=`cd $(srcdir); pwd`/; export srcrootpre; \ + @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 \ diff --git a/contrib/libf2c/aclocal.m4 b/contrib/libf2c/aclocal.m4 index 2bc289d..5d39edc 100644 --- a/contrib/libf2c/aclocal.m4 +++ b/contrib/libf2c/aclocal.m4 @@ -1,4 +1,4 @@ -dnl Copyright (C) 1994, 1995-8, 1999, 2001 Free Software Foundation, Inc. +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. @@ -54,7 +54,7 @@ AC_DEFUN(GLIBCPP_CONFIGURE, [ # 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=`pwd` +glibcpp_builddir=`${PWDCMD-pwd}` case $srcdir in [\\/$]* | ?:[\\/]*) glibcpp_srcdir=${srcdir} ;; *) glibcpp_srcdir=`cd "$srcdir" && ${PWDCMD-pwd} || echo "$srcdir"` ;; diff --git a/contrib/libf2c/configure b/contrib/libf2c/configure index eb98fd8..0d19de5 100755 --- a/contrib/libf2c/configure +++ b/contrib/libf2c/configure @@ -768,7 +768,7 @@ test "$ac_cv_mingw32" = yes && MINGW32=yes # 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=`pwd` +glibcpp_builddir=`${PWDCMD-pwd}` case $srcdir in \\/$* | ?:\\/*) glibcpp_srcdir=${srcdir} ;; *) glibcpp_srcdir=`cd "$srcdir" && ${PWDCMD-pwd} || echo "$srcdir"` ;; @@ -1596,9 +1596,18 @@ gnu*) ;; hpux10.20*|hpux11*) - lt_cv_deplibs_check_method='file_magic (s[0-9][0-9][0-9]|PA-RISC[0-9].[0-9]) shared library' - lt_cv_file_magic_cmd=/usr/bin/file - lt_cv_file_magic_test_file=/usr/lib/libc.sl + case $host_cpu in + hppa*) + lt_cv_deplibs_check_method='file_magic (s[0-9][0-9][0-9]|PA-RISC[0-9].[0-9]) shared library' + lt_cv_file_magic_cmd=/usr/bin/file + lt_cv_file_magic_test_file=/usr/lib/libc.sl + ;; + ia64*) + lt_cv_deplibs_check_method='file_magic (s[0-9][0-9][0-9]|ELF-[0-9][0-9]) shared object file - IA64' + lt_cv_file_magic_cmd=/usr/bin/file + lt_cv_file_magic_test_file=/usr/lib/hpux32/libc.so + ;; + esac ;; irix5* | irix6*) @@ -1688,13 +1697,13 @@ file_magic_cmd=$lt_cv_file_magic_cmd deplibs_check_method=$lt_cv_deplibs_check_method echo $ac_n "checking for object suffix""... $ac_c" 1>&6 -echo "configure:1692: checking for object suffix" >&5 +echo "configure:1701: checking for object suffix" >&5 if eval "test \"`echo '$''{'ac_cv_objext'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else rm -f conftest* echo 'int i = 1;' > conftest.$ac_ext -if { (eval echo configure:1698: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then +if { (eval echo configure:1707: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then for ac_file in conftest.*; do case $ac_file in *.c) ;; @@ -1718,7 +1727,7 @@ case $deplibs_check_method in file_magic*) if test "$file_magic_cmd" = '$MAGIC_CMD'; then echo $ac_n "checking for ${ac_tool_prefix}file""... $ac_c" 1>&6 -echo "configure:1722: checking for ${ac_tool_prefix}file" >&5 +echo "configure:1731: checking for ${ac_tool_prefix}file" >&5 if eval "test \"`echo '$''{'lt_cv_path_MAGIC_CMD'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else @@ -1780,7 +1789,7 @@ fi if test -z "$lt_cv_path_MAGIC_CMD"; then if test -n "$ac_tool_prefix"; then echo $ac_n "checking for file""... $ac_c" 1>&6 -echo "configure:1784: checking for file" >&5 +echo "configure:1793: checking for file" >&5 if eval "test \"`echo '$''{'lt_cv_path_MAGIC_CMD'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else @@ -1851,7 +1860,7 @@ esac # Extract the first word of "${ac_tool_prefix}ranlib", so it can be a program name with args. set dummy ${ac_tool_prefix}ranlib; ac_word=$2 echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 -echo "configure:1855: checking for $ac_word" >&5 +echo "configure:1864: checking for $ac_word" >&5 if eval "test \"`echo '$''{'ac_cv_prog_RANLIB'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else @@ -1883,7 +1892,7 @@ if test -n "$ac_tool_prefix"; then # Extract the first word of "ranlib", so it can be a program name with args. set dummy ranlib; ac_word=$2 echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 -echo "configure:1887: checking for $ac_word" >&5 +echo "configure:1896: checking for $ac_word" >&5 if eval "test \"`echo '$''{'ac_cv_prog_RANLIB'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else @@ -1918,7 +1927,7 @@ fi # Extract the first word of "${ac_tool_prefix}strip", so it can be a program name with args. set dummy ${ac_tool_prefix}strip; ac_word=$2 echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 -echo "configure:1922: checking for $ac_word" >&5 +echo "configure:1931: checking for $ac_word" >&5 if eval "test \"`echo '$''{'ac_cv_prog_STRIP'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else @@ -1950,7 +1959,7 @@ if test -n "$ac_tool_prefix"; then # Extract the first word of "strip", so it can be a program name with args. set dummy strip; ac_word=$2 echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 -echo "configure:1954: checking for $ac_word" >&5 +echo "configure:1963: checking for $ac_word" >&5 if eval "test \"`echo '$''{'ac_cv_prog_STRIP'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else @@ -2017,8 +2026,21 @@ test x"$pic_mode" = xno && libtool_flags="$libtool_flags --prefer-non-pic" case $host in *-*-irix6*) # Find out which ABI we are using. - echo '#line 2021 "configure"' > conftest.$ac_ext - if { (eval echo configure:2022: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then + echo '#line 2030 "configure"' > conftest.$ac_ext + if { (eval echo configure:2031: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then + if test "$lt_cv_prog_gnu_ld" = yes; then + case `/usr/bin/file conftest.$ac_objext` in + *32-bit*) + LD="${LD-ld} -melf32bsmip" + ;; + *N32*) + LD="${LD-ld} -melf32bmipn32" + ;; + *64-bit*) + LD="${LD-ld} -melf64bmip" + ;; + esac + else case `/usr/bin/file conftest.$ac_objext` in *32-bit*) LD="${LD-ld} -32" @@ -2030,6 +2052,65 @@ case $host in LD="${LD-ld} -64" ;; esac + fi + fi + rm -rf conftest* + ;; + +ia64-*-hpux*) + # Find out which ABI we are using. + echo 'int i;' > conftest.$ac_ext + if { (eval echo configure:2064: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then + case "`/usr/bin/file conftest.o`" in + *ELF-32*) + HPUX_IA64_MODE="32" + ;; + *ELF-64*) + HPUX_IA64_MODE="64" + ;; + esac + fi + rm -rf conftest* + ;; + +x86_64-*linux*|ppc*-*linux*|powerpc*-*linux*|s390*-*linux*|sparc*-*linux*) + # Find out which ABI we are using. + echo 'int i;' > conftest.$ac_ext + if { (eval echo configure:2080: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then + case "`/usr/bin/file conftest.o`" in + *32-bit*) + case $host in + x86_64-*linux*) + LD="${LD-ld} -m elf_i386" + ;; + ppc64-*linux*) + LD="${LD-ld} -m elf32ppclinux" + ;; + s390x-*linux*) + LD="${LD-ld} -m elf_s390" + ;; + sparc64-*linux*) + LD="${LD-ld} -m elf32_sparc" + ;; + esac + ;; + *64-bit*) + case $host in + x86_64-*linux*) + LD="${LD-ld} -m elf_x86_64" + ;; + ppc*-*linux*|powerpc*-*linux*) + LD="${LD-ld} -m elf64ppc" + ;; + s390*-*linux*) + LD="${LD-ld} -m elf64_s390" + ;; + sparc*-*linux*) + LD="${LD-ld} -m elf64_sparc" + ;; + esac + ;; + esac fi rm -rf conftest* ;; @@ -2039,7 +2120,7 @@ case $host in SAVE_CFLAGS="$CFLAGS" CFLAGS="$CFLAGS -belf" echo $ac_n "checking whether the C compiler needs -belf""... $ac_c" 1>&6 -echo "configure:2043: checking whether the C compiler needs -belf" >&5 +echo "configure:2124: checking whether the C compiler needs -belf" >&5 if eval "test \"`echo '$''{'lt_cv_cc_needs_belf'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else @@ -2052,14 +2133,14 @@ ac_link='${CC-cc} -o conftest${ac_exeext} $CFLAGS $CPPFLAGS $LDFLAGS conftest.$a cross_compiling=$ac_cv_prog_cc_cross cat > conftest.$ac_ext <<EOF -#line 2056 "configure" +#line 2137 "configure" #include "confdefs.h" int main() { ; return 0; } EOF -if { (eval echo configure:2063: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:2144: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* lt_cv_cc_needs_belf=yes else @@ -2183,7 +2264,7 @@ else # Extract the first word of "ranlib", so it can be a program name with args. set dummy ranlib; ac_word=$2 echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 -echo "configure:2187: checking for $ac_word" >&5 +echo "configure:2268: checking for $ac_word" >&5 if eval "test \"`echo '$''{'ac_cv_prog_RANLIB'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else @@ -2223,7 +2304,7 @@ fi # SVR4 /usr/ucb/install, which tries to use the nonexistent group "staff" # ./install, which can be erroneously created by make from ./install.sh. echo $ac_n "checking for a BSD compatible install""... $ac_c" 1>&6 -echo "configure:2227: checking for a BSD compatible install" >&5 +echo "configure:2308: checking for a BSD compatible install" >&5 if test -z "$INSTALL"; then if eval "test \"`echo '$''{'ac_cv_path_install'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 @@ -2276,7 +2357,7 @@ test -z "$INSTALL_SCRIPT" && INSTALL_SCRIPT='${INSTALL_PROGRAM}' test -z "$INSTALL_DATA" && INSTALL_DATA='${INSTALL} -m 644' echo $ac_n "checking whether ${MAKE-make} sets \${MAKE}""... $ac_c" 1>&6 -echo "configure:2280: checking whether ${MAKE-make} sets \${MAKE}" >&5 +echo "configure:2361: checking whether ${MAKE-make} sets \${MAKE}" >&5 set dummy ${MAKE-make}; ac_make=`echo "$2" | sed 'y%./+-%__p_%'` if eval "test \"`echo '$''{'ac_cv_prog_make_${ac_make}_set'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 @@ -2305,7 +2386,7 @@ fi # Sanity check for the cross-compilation case: echo $ac_n "checking how to run the C preprocessor""... $ac_c" 1>&6 -echo "configure:2309: checking how to run the C preprocessor" >&5 +echo "configure:2390: checking how to run the C preprocessor" >&5 # On Suns, sometimes $CPP names a directory. if test -n "$CPP" && test -d "$CPP"; then CPP= @@ -2320,13 +2401,13 @@ else # On the NeXT, cc -E runs the code through the compiler's parser, # not just through cpp. cat > conftest.$ac_ext <<EOF -#line 2324 "configure" +#line 2405 "configure" #include "confdefs.h" #include <assert.h> Syntax Error EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:2330: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:2411: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then : @@ -2337,13 +2418,13 @@ else rm -rf conftest* CPP="${CC-cc} -E -traditional-cpp" cat > conftest.$ac_ext <<EOF -#line 2341 "configure" +#line 2422 "configure" #include "confdefs.h" #include <assert.h> Syntax Error EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:2347: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:2428: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then : @@ -2354,13 +2435,13 @@ else rm -rf conftest* CPP="${CC-cc} -nologo -E" cat > conftest.$ac_ext <<EOF -#line 2358 "configure" +#line 2439 "configure" #include "confdefs.h" #include <assert.h> Syntax Error EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:2364: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:2445: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then : @@ -2386,17 +2467,17 @@ echo "$ac_t""$CPP" 1>&6 ac_safe=`echo "stdio.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for stdio.h""... $ac_c" 1>&6 -echo "configure:2390: checking for stdio.h" >&5 +echo "configure:2471: checking for stdio.h" >&5 if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <<EOF -#line 2395 "configure" +#line 2476 "configure" #include "confdefs.h" #include <stdio.h> EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:2400: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:2481: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then rm -rf conftest* @@ -2424,12 +2505,12 @@ fi echo $ac_n "checking for built-in g77 integer types""... $ac_c" 1>&6 -echo "configure:2428: checking for built-in g77 integer types" >&5 +echo "configure:2509: checking for built-in g77 integer types" >&5 if eval "test \"`echo '$''{'libf2c_cv_has_g77_builtin_types'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <<EOF -#line 2433 "configure" +#line 2514 "configure" #include "confdefs.h" int main() { @@ -2439,7 +2520,7 @@ __g77_longint g77l; __g77_ulongint g77ul; ; return 0; } EOF -if { (eval echo configure:2443: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then +if { (eval echo configure:2524: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* libf2c_cv_has_g77_builtin_types=yes else @@ -2782,6 +2863,7 @@ 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}" EOF cat >> $CONFIG_STATUS <<\EOF diff --git a/contrib/libf2c/configure.in b/contrib/libf2c/configure.in index 8b2e26a..6ba14c9 100644 --- a/contrib/libf2c/configure.in +++ b/contrib/libf2c/configure.in @@ -1,5 +1,6 @@ # Process this file with autoconf to produce a configure script. -# Copyright (C) 1995, 1997, 1998, 1999, 2002 Free Software Foundation, Inc. +# 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. @@ -137,6 +138,7 @@ 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}" ) diff --git a/contrib/libf2c/f2cext.c b/contrib/libf2c/f2cext.c index 56f9490..69d12b6 100644 --- a/contrib/libf2c/f2cext.c +++ b/contrib/libf2c/f2cext.c @@ -140,7 +140,8 @@ integer access_ (const char *name, const char *mode, ftnlen Lname, ftnlen Lmode) #endif #ifdef Lalarm -integer alarm_ (integer *seconds, sig_proc proc, integer *status) { +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); } diff --git a/contrib/libf2c/g2c.hin b/contrib/libf2c/g2c.hin index 57947ce..577ea2b 100644 --- a/contrib/libf2c/g2c.hin +++ b/contrib/libf2c/g2c.hin @@ -132,8 +132,6 @@ typedef struct ftnlen inblanklen; } inlist; -#define VOID void - union Multitype { /* for multiple entry points */ integer1 g; shortint h; @@ -183,11 +181,11 @@ 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 /* Complex */ void (*C_fp)(...); +typedef /* Double Complex */ void (*Z_fp)(...); typedef logical (*L_fp)(...); typedef shortlogical (*K_fp)(...); -typedef /* Character */ VOID (*H_fp)(...); +typedef /* Character */ void (*H_fp)(...); typedef /* Subroutine */ int (*S_fp)(...); #else typedef int /* Unknown procedure type */ (*U_fp)(); @@ -195,17 +193,17 @@ 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 /* Complex */ void (*C_fp)(); +typedef /* Double Complex */ void (*Z_fp)(); typedef logical (*L_fp)(); typedef shortlogical (*K_fp)(); -typedef /* Character */ VOID (*H_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 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.: */ diff --git a/contrib/libf2c/libF77/F77_aloc.c b/contrib/libf2c/libF77/F77_aloc.c index e329a1b..b286102 100644 --- a/contrib/libf2c/libF77/F77_aloc.c +++ b/contrib/libf2c/libF77/F77_aloc.c @@ -6,33 +6,19 @@ static integer memfailure = 3; -#ifdef KR_headers -extern char *malloc(); -extern void G77_exit_0 (); - - char * -F77_aloc(Len, whence) integer Len; char *whence; -#else #include <stdlib.h> -#ifdef __cplusplus -extern "C" { -#endif -extern void G77_exit_0 (integer*); -#ifdef __cplusplus - } -#endif +extern void G77_exit_0 (integer *); - char * -F77_aloc(integer Len, char *whence) -#endif +char * +F77_aloc (integer Len, char *whence) { - char *rv; - unsigned int uLen = (unsigned int) Len; /* for K&R C */ + 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; - } + if (!(rv = (char *) malloc (uLen))) + { + fprintf (stderr, "malloc(%u) failure in %s\n", uLen, whence); + G77_exit_0 (&memfailure); + } + return rv; +} diff --git a/contrib/libf2c/libF77/Makefile.in b/contrib/libf2c/libF77/Makefile.in index 4f6730d..07af6eb 100644 --- a/contrib/libf2c/libF77/Makefile.in +++ b/contrib/libf2c/libF77/Makefile.in @@ -41,11 +41,11 @@ ARFLAGS = rc RANLIB = @RANLIB@ @SET_MAKE@ -SHELL = /bin/sh +SHELL = @SHELL@ #### End of system configuration section. #### -ALL_CFLAGS = -I. -I$(srcdir) -I$(G2C_H_DIR) -I$(F2C_H_DIR) $(CPPFLAGS) $(DEFS) $(CFLAGS) +ALL_CFLAGS = -I. -I$(srcdir) -I$(G2C_H_DIR) -I$(F2C_H_DIR) $(CPPFLAGS) $(DEFS) $(WARN_CFLAGS) $(CFLAGS) .SUFFIXES: .SUFFIXES: .c .lo diff --git a/contrib/libf2c/libF77/Version.c b/contrib/libf2c/libF77/Version.c index a8c9e24..a27b0df 100644 --- a/contrib/libf2c/libF77/Version.c +++ b/contrib/libf2c/libF77/Version.c @@ -1,9 +1,6 @@ -static char junk[] = "\n@(#)LIBF77 VERSION 20000929\n"; - -/* -*/ - -char __G77_LIBF77_VERSION__[] = "3.2.2 20030205 (release)"; +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. @@ -87,6 +84,11 @@ char __G77_LIBF77_VERSION__[] = "3.2.2 20030205 (release)"; void g77__fvers__ () { - fprintf (stderr, "__G77_LIBF77_VERSION__: %s", __G77_LIBF77_VERSION__); - fputs (junk, stderr); + 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); } diff --git a/contrib/libf2c/libF77/abort_.c b/contrib/libf2c/libF77/abort_.c index f0c2f8d..761bc3b 100644 --- a/contrib/libf2c/libF77/abort_.c +++ b/contrib/libf2c/libF77/abort_.c @@ -1,16 +1,11 @@ #include <stdio.h> #include "f2c.h" -#ifdef KR_headers -extern VOID sig_die(); +extern void sig_die (char *, int); -int G77_abort_0 () -#else -extern void sig_die(char*,int); - -int G77_abort_0 (void) -#endif +int +G77_abort_0 (void) { -sig_die("Fortran abort routine called", 1); -return 0; /* not reached */ + sig_die ("Fortran abort routine called", 1); + return 0; /* not reached */ } diff --git a/contrib/libf2c/libF77/c_abs.c b/contrib/libf2c/libF77/c_abs.c index 041fbd3..3fc4d7c 100644 --- a/contrib/libf2c/libF77/c_abs.c +++ b/contrib/libf2c/libF77/c_abs.c @@ -1,14 +1,9 @@ #include "f2c.h" -#ifdef KR_headers -extern double f__cabs(); +extern double f__cabs (double, double); -double c_abs(z) complex *z; -#else -extern double f__cabs(double, double); - -double c_abs(complex *z) -#endif +double +c_abs (complex * z) { -return( f__cabs( z->r, z->i ) ); + return (f__cabs (z->r, z->i)); } diff --git a/contrib/libf2c/libF77/c_cos.c b/contrib/libf2c/libF77/c_cos.c index 549953d..5965975 100644 --- a/contrib/libf2c/libF77/c_cos.c +++ b/contrib/libf2c/libF77/c_cos.c @@ -1,17 +1,12 @@ #include "f2c.h" -#ifdef KR_headers -extern double sin(), cos(), sinh(), cosh(); - -VOID c_cos(r, z) complex *r, *z; -#else #undef abs #include "math.h" -void c_cos(complex *r, complex *z) -#endif +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); - } + double zi = z->i, zr = z->r; + r->r = cos (zr) * cosh (zi); + r->i = -sin (zr) * sinh (zi); +} diff --git a/contrib/libf2c/libF77/c_div.c b/contrib/libf2c/libF77/c_div.c index 4d153b4..b5ede0e 100644 --- a/contrib/libf2c/libF77/c_div.c +++ b/contrib/libf2c/libF77/c_div.c @@ -1,47 +1,43 @@ #include "f2c.h" -#ifdef KR_headers -extern VOID sig_die(); -VOID c_div(c, a, b) -complex *a, *b, *c; -#else -extern void sig_die(char*,int); -void c_div(complex *c, complex *a, complex *b) -#endif +extern void sig_die (char *, int); +void +c_div (complex * c, complex * a, complex * b) { - double ratio, den; - double abr, abi, cr; + 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) { + 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; + 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); + 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; } + 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; +} diff --git a/contrib/libf2c/libF77/c_exp.c b/contrib/libf2c/libF77/c_exp.c index 52d0d2f..56a8695 100644 --- a/contrib/libf2c/libF77/c_exp.c +++ b/contrib/libf2c/libF77/c_exp.c @@ -1,19 +1,14 @@ #include "f2c.h" -#ifdef KR_headers -extern double exp(), cos(), sin(); - - VOID c_exp(r, z) complex *r, *z; -#else #undef abs #include "math.h" -void c_exp(complex *r, complex *z) -#endif +void +c_exp (complex * r, complex * z) { - double expx, zi = z->i; + double expx, zi = z->i; - expx = exp(z->r); - r->r = expx * cos(zi); - r->i = expx * sin(zi); - } + expx = exp (z->r); + r->r = expx * cos (zi); + r->i = expx * sin (zi); +} diff --git a/contrib/libf2c/libF77/c_log.c b/contrib/libf2c/libF77/c_log.c index 24d1a3c..7d5b951 100644 --- a/contrib/libf2c/libF77/c_log.c +++ b/contrib/libf2c/libF77/c_log.c @@ -1,17 +1,13 @@ #include "f2c.h" -#ifdef KR_headers -extern double log(), f__cabs(), atan2(); -VOID c_log(r, z) complex *r, *z; -#else #undef abs #include "math.h" -extern double f__cabs(double, double); +extern double f__cabs (double, double); -void c_log(complex *r, complex *z) -#endif +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) ); - } + double zi, zr; + r->i = atan2 (zi = z->i, zr = z->r); + r->r = log (f__cabs (zr, zi)); +} diff --git a/contrib/libf2c/libF77/c_sin.c b/contrib/libf2c/libF77/c_sin.c index 93a5766..44bce9f 100644 --- a/contrib/libf2c/libF77/c_sin.c +++ b/contrib/libf2c/libF77/c_sin.c @@ -1,17 +1,12 @@ #include "f2c.h" -#ifdef KR_headers -extern double sin(), cos(), sinh(), cosh(); - -VOID c_sin(r, z) complex *r, *z; -#else #undef abs #include "math.h" -void c_sin(complex *r, complex *z) -#endif +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); - } + double zi = z->i, zr = z->r; + r->r = sin (zr) * cosh (zi); + r->i = cos (zr) * sinh (zi); +} diff --git a/contrib/libf2c/libF77/c_sqrt.c b/contrib/libf2c/libF77/c_sqrt.c index 8481ee4..81b72fc 100644 --- a/contrib/libf2c/libF77/c_sqrt.c +++ b/contrib/libf2c/libF77/c_sqrt.c @@ -1,35 +1,30 @@ #include "f2c.h" -#ifdef KR_headers -extern double sqrt(), f__cabs(); - -VOID c_sqrt(r, z) complex *r, *z; -#else #undef abs #include "math.h" -extern double f__cabs(double, double); +extern double f__cabs (double, double); -void c_sqrt(complex *r, complex *z) -#endif +void +c_sqrt (complex * r, complex * z) { - double mag, t; - double zi = z->i, zr = z->r; + 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; - } - } + 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; + } +} diff --git a/contrib/libf2c/libF77/cabs.c b/contrib/libf2c/libF77/cabs.c index 2fad044..5d2142e 100644 --- a/contrib/libf2c/libF77/cabs.c +++ b/contrib/libf2c/libF77/cabs.c @@ -1,27 +1,24 @@ -#ifdef KR_headers -extern double sqrt(); -double f__cabs(real, imag) double real, imag; -#else #undef abs #include <math.h> -double f__cabs(double real, double imag) -#endif +double +f__cabs (double real, double imag) { -double temp; + 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); + 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); + temp = imag / real; + temp = real * sqrt (1.0 + temp * temp); /*overflow!! */ + return (temp); } diff --git a/contrib/libf2c/libF77/configure b/contrib/libf2c/libF77/configure index 5b6a257..4e198c8 100755 --- a/contrib/libf2c/libF77/configure +++ b/contrib/libf2c/libF77/configure @@ -28,7 +28,6 @@ program_suffix=NONE program_transform_name=s,x,x, silent= site= -sitefile= srcdir= target=NONE verbose= @@ -143,7 +142,6 @@ Configuration: --help print this message --no-create do not create output files --quiet, --silent do not print \`checking...' messages - --site-file=FILE use FILE as the site file --version print the version of autoconf that created configure Directory and file names: --prefix=PREFIX install architecture-independent files in PREFIX @@ -314,11 +312,6 @@ EOF -site=* | --site=* | --sit=*) site="$ac_optarg" ;; - -site-file | --site-file | --site-fil | --site-fi | --site-f) - ac_prev=sitefile ;; - -site-file=* | --site-file=* | --site-fil=* | --site-fi=* | --site-f=*) - sitefile="$ac_optarg" ;; - -srcdir | --srcdir | --srcdi | --srcd | --src | --sr) ac_prev=srcdir ;; -srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*) @@ -484,16 +477,12 @@ fi srcdir=`echo "${srcdir}" | sed 's%\([^/]\)/*$%\1%'` # Prefer explicitly selected file to automatically selected ones. -if test -z "$sitefile"; then - if test -z "$CONFIG_SITE"; then - if test "x$prefix" != xNONE; then - CONFIG_SITE="$prefix/share/config.site $prefix/etc/config.site" - else - CONFIG_SITE="$ac_default_prefix/share/config.site $ac_default_prefix/etc/config.site" - fi +if test -z "$CONFIG_SITE"; then + if test "x$prefix" != xNONE; then + CONFIG_SITE="$prefix/share/config.site $prefix/etc/config.site" + else + CONFIG_SITE="$ac_default_prefix/share/config.site $ac_default_prefix/etc/config.site" fi -else - CONFIG_SITE="$sitefile" fi for ac_site_file in $CONFIG_SITE; do if test -r "$ac_site_file"; then @@ -541,7 +530,7 @@ fi # Extract the first word of "gcc", so it can be a program name with args. set dummy gcc; ac_word=$2 echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 -echo "configure:545: checking for $ac_word" >&5 +echo "configure:534: checking for $ac_word" >&5 if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else @@ -571,7 +560,7 @@ if test -z "$CC"; then # Extract the first word of "cc", so it can be a program name with args. set dummy cc; ac_word=$2 echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 -echo "configure:575: checking for $ac_word" >&5 +echo "configure:564: checking for $ac_word" >&5 if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else @@ -622,7 +611,7 @@ fi # Extract the first word of "cl", so it can be a program name with args. set dummy cl; ac_word=$2 echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 -echo "configure:626: checking for $ac_word" >&5 +echo "configure:615: checking for $ac_word" >&5 if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else @@ -655,7 +644,7 @@ fi echo $ac_n "checking whether we are using GNU C""... $ac_c" 1>&6 -echo "configure:659: checking whether we are using GNU C" >&5 +echo "configure:648: checking whether we are using GNU C" >&5 if eval "test \"`echo '$''{'ac_cv_prog_gcc'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else @@ -664,7 +653,7 @@ else yes; #endif EOF -if { ac_try='${CC-cc} -E conftest.c'; { (eval echo configure:668: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }; } | egrep yes >/dev/null 2>&1; then +if { ac_try='${CC-cc} -E conftest.c'; { (eval echo configure:657: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }; } | egrep yes >/dev/null 2>&1; then ac_cv_prog_gcc=yes else ac_cv_prog_gcc=no @@ -683,7 +672,7 @@ ac_test_CFLAGS="${CFLAGS+set}" ac_save_CFLAGS="$CFLAGS" CFLAGS= echo $ac_n "checking whether ${CC-cc} accepts -g""... $ac_c" 1>&6 -echo "configure:687: checking whether ${CC-cc} accepts -g" >&5 +echo "configure:676: checking whether ${CC-cc} accepts -g" >&5 if eval "test \"`echo '$''{'ac_cv_prog_cc_g'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else @@ -726,7 +715,7 @@ else # Extract the first word of "ranlib", so it can be a program name with args. set dummy ranlib; ac_word=$2 echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 -echo "configure:730: checking for $ac_word" >&5 +echo "configure:719: checking for $ac_word" >&5 if eval "test \"`echo '$''{'ac_cv_prog_RANLIB'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else @@ -755,7 +744,7 @@ fi fi echo $ac_n "checking whether ${MAKE-make} sets \${MAKE}""... $ac_c" 1>&6 -echo "configure:759: checking whether ${MAKE-make} sets \${MAKE}" >&5 +echo "configure:748: checking whether ${MAKE-make} sets \${MAKE}" >&5 set dummy ${MAKE-make}; ac_make=`echo "$2" | sed 'y%./+-%__p_%'` if eval "test \"`echo '$''{'ac_cv_prog_make_${ac_make}_set'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 @@ -785,7 +774,7 @@ fi # Sanity check for the cross-compilation case: echo $ac_n "checking how to run the C preprocessor""... $ac_c" 1>&6 -echo "configure:789: checking how to run the C preprocessor" >&5 +echo "configure:778: checking how to run the C preprocessor" >&5 # On Suns, sometimes $CPP names a directory. if test -n "$CPP" && test -d "$CPP"; then CPP= @@ -800,13 +789,13 @@ else # On the NeXT, cc -E runs the code through the compiler's parser, # not just through cpp. cat > conftest.$ac_ext <<EOF -#line 804 "configure" +#line 793 "configure" #include "confdefs.h" #include <assert.h> Syntax Error EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:810: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:799: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then : @@ -817,13 +806,13 @@ else rm -rf conftest* CPP="${CC-cc} -E -traditional-cpp" cat > conftest.$ac_ext <<EOF -#line 821 "configure" +#line 810 "configure" #include "confdefs.h" #include <assert.h> Syntax Error EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:827: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:816: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then : @@ -834,13 +823,13 @@ else rm -rf conftest* CPP="${CC-cc} -nologo -E" cat > conftest.$ac_ext <<EOF -#line 838 "configure" +#line 827 "configure" #include "confdefs.h" #include <assert.h> Syntax Error EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:844: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:833: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then : @@ -866,17 +855,17 @@ echo "$ac_t""$CPP" 1>&6 ac_safe=`echo "stdio.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for stdio.h""... $ac_c" 1>&6 -echo "configure:870: checking for stdio.h" >&5 +echo "configure:859: checking for stdio.h" >&5 if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <<EOF -#line 875 "configure" +#line 864 "configure" #include "confdefs.h" #include <stdio.h> EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:880: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:869: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then rm -rf conftest* @@ -904,12 +893,12 @@ fi echo $ac_n "checking for ANSI C header files""... $ac_c" 1>&6 -echo "configure:908: checking for ANSI C header files" >&5 +echo "configure:897: checking for ANSI C header files" >&5 if eval "test \"`echo '$''{'ac_cv_header_stdc'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <<EOF -#line 913 "configure" +#line 902 "configure" #include "confdefs.h" #include <stdlib.h> #include <stdarg.h> @@ -917,7 +906,7 @@ else #include <float.h> EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:921: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:910: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then rm -rf conftest* @@ -934,7 +923,7 @@ rm -f conftest* if test $ac_cv_header_stdc = yes; then # SunOS 4.x string.h does not declare mem*, contrary to ANSI. cat > conftest.$ac_ext <<EOF -#line 938 "configure" +#line 927 "configure" #include "confdefs.h" #include <string.h> EOF @@ -952,7 +941,7 @@ fi if test $ac_cv_header_stdc = yes; then # ISC 2.0.2 stdlib.h does not declare free, contrary to ANSI. cat > conftest.$ac_ext <<EOF -#line 956 "configure" +#line 945 "configure" #include "confdefs.h" #include <stdlib.h> EOF @@ -973,7 +962,7 @@ if test "$cross_compiling" = yes; then : else cat > conftest.$ac_ext <<EOF -#line 977 "configure" +#line 966 "configure" #include "confdefs.h" #include <ctype.h> #define ISLOWER(c) ('a' <= (c) && (c) <= 'z') @@ -984,7 +973,7 @@ if (XOR (islower (i), ISLOWER (i)) || toupper (i) != TOUPPER (i)) exit(2); exit (0); } EOF -if { (eval echo configure:988: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null +if { (eval echo configure:977: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null then : else @@ -1007,14 +996,13 @@ EOF fi - echo $ac_n "checking for posix""... $ac_c" 1>&6 -echo "configure:1013: checking for posix" >&5 +echo "configure:1001: checking for posix" >&5 if eval "test \"`echo '$''{'g77_cv_header_posix'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <<EOF -#line 1018 "configure" +#line 1006 "configure" #include "confdefs.h" #include <sys/types.h> #include <unistd.h> @@ -1040,12 +1028,12 @@ echo "$ac_t""$g77_cv_header_posix" 1>&6 # We can rely on the GNU library being posix-ish. I guess checking the # header isn't actually like checking the functions, though... echo $ac_n "checking for GNU library""... $ac_c" 1>&6 -echo "configure:1044: checking for GNU library" >&5 +echo "configure:1032: checking for GNU library" >&5 if eval "test \"`echo '$''{'g77_cv_lib_gnu'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <<EOF -#line 1049 "configure" +#line 1037 "configure" #include "confdefs.h" #include <stdio.h> #ifdef __GNU_LIBRARY__ @@ -1068,12 +1056,12 @@ fi echo "$ac_t""$g77_cv_lib_gnu" 1>&6 echo $ac_n "checking return type of signal handlers""... $ac_c" 1>&6 -echo "configure:1072: checking return type of signal handlers" >&5 +echo "configure:1060: checking return type of signal handlers" >&5 if eval "test \"`echo '$''{'ac_cv_type_signal'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <<EOF -#line 1077 "configure" +#line 1065 "configure" #include "confdefs.h" #include <sys/types.h> #include <signal.h> @@ -1090,7 +1078,7 @@ int main() { int i; ; return 0; } EOF -if { (eval echo configure:1094: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then +if { (eval echo configure:1082: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* ac_cv_type_signal=void else @@ -1111,12 +1099,12 @@ EOF # we'll get atexit by default if test $ac_cv_header_stdc != yes; then echo $ac_n "checking for atexit""... $ac_c" 1>&6 -echo "configure:1115: checking for atexit" >&5 +echo "configure:1103: checking for atexit" >&5 if eval "test \"`echo '$''{'ac_cv_func_atexit'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <<EOF -#line 1120 "configure" +#line 1108 "configure" #include "confdefs.h" /* System header to define __stub macros and hopefully few prototypes, which can conflict with char atexit(); below. */ @@ -1139,7 +1127,7 @@ atexit(); ; return 0; } EOF -if { (eval echo configure:1143: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:1131: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_func_atexit=yes" else @@ -1164,12 +1152,12 @@ else EOF echo $ac_n "checking for onexit""... $ac_c" 1>&6 -echo "configure:1168: checking for onexit" >&5 +echo "configure:1156: checking for onexit" >&5 if eval "test \"`echo '$''{'ac_cv_func_onexit'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <<EOF -#line 1173 "configure" +#line 1161 "configure" #include "confdefs.h" /* System header to define __stub macros and hopefully few prototypes, which can conflict with char onexit(); below. */ @@ -1192,7 +1180,7 @@ onexit(); ; return 0; } EOF -if { (eval echo configure:1196: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:1184: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_func_onexit=yes" else @@ -1210,12 +1198,12 @@ if eval "test \"`echo '$ac_cv_func_'onexit`\" = yes"; then else echo "$ac_t""no" 1>&6 echo $ac_n "checking for on_exit""... $ac_c" 1>&6 -echo "configure:1214: checking for on_exit" >&5 +echo "configure:1202: checking for on_exit" >&5 if eval "test \"`echo '$''{'ac_cv_func_on_exit'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <<EOF -#line 1219 "configure" +#line 1207 "configure" #include "confdefs.h" /* System header to define __stub macros and hopefully few prototypes, which can conflict with char on_exit(); below. */ @@ -1238,7 +1226,7 @@ on_exit(); ; return 0; } EOF -if { (eval echo configure:1242: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:1230: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_func_on_exit=yes" else @@ -1268,7 +1256,7 @@ else true fi echo $ac_n "checking for drem in -lm""... $ac_c" 1>&6 -echo "configure:1272: checking for drem in -lm" >&5 +echo "configure:1260: checking for drem in -lm" >&5 ac_lib_var=`echo m'_'drem | sed 'y%./+-%__p_%'` if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 @@ -1276,7 +1264,7 @@ else ac_save_LIBS="$LIBS" LIBS="-lm $LIBS" cat > conftest.$ac_ext <<EOF -#line 1280 "configure" +#line 1268 "configure" #include "confdefs.h" /* Override any gcc2 internal prototype to avoid an error. */ /* We use char because int might match the return type of a gcc2 @@ -1287,7 +1275,7 @@ int main() { drem() ; return 0; } EOF -if { (eval echo configure:1291: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:1279: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else diff --git a/contrib/libf2c/libF77/configure.in b/contrib/libf2c/libF77/configure.in index ae34d36..838ce96 100644 --- a/contrib/libf2c/libF77/configure.in +++ b/contrib/libf2c/libF77/configure.in @@ -56,17 +56,6 @@ the G77 runtime system. If necessary, install gcc now with \`LANGUAGES=c', then the target library, then build with \`LANGUAGES=f77'.])]) AC_HEADER_STDC -dnl We could do this if we didn't know we were using gcc -dnl AC_MSG_CHECKING(for prototype-savvy compiler) -dnl AC_CACHE_VAL(g77_cv_sys_proto, -dnl [AC_TRY_LINK(, -dnl dnl looks screwy because TRY_LINK expects a function body -dnl [return 0;} int foo (int * bar) {], -dnl g77_cv_sys_proto=yes, -dnl [g77_cv_sys_proto=no -dnl AC_DEFINE(KR_headers)])]) -dnl AC_MSG_RESULT($g77_cv_sys_proto) - AC_MSG_CHECKING(for posix) AC_CACHE_VAL(g77_cv_header_posix, AC_EGREP_CPP(yes, diff --git a/contrib/libf2c/libF77/d_abs.c b/contrib/libf2c/libF77/d_abs.c index cb157e0..a43a5c7 100644 --- a/contrib/libf2c/libF77/d_abs.c +++ b/contrib/libf2c/libF77/d_abs.c @@ -1,12 +1,9 @@ #include "f2c.h" -#ifdef KR_headers -double d_abs(x) doublereal *x; -#else -double d_abs(doublereal *x) -#endif +double +d_abs (doublereal * x) { -if(*x >= 0) - return(*x); -return(- *x); + if (*x >= 0) + return (*x); + return (-*x); } diff --git a/contrib/libf2c/libF77/d_acos.c b/contrib/libf2c/libF77/d_acos.c index 33da536..41c4f17 100644 --- a/contrib/libf2c/libF77/d_acos.c +++ b/contrib/libf2c/libF77/d_acos.c @@ -1,13 +1,9 @@ #include "f2c.h" -#ifdef KR_headers -double acos(); -double d_acos(x) doublereal *x; -#else #undef abs #include <math.h> -double d_acos(doublereal *x) -#endif +double +d_acos (doublereal * x) { -return( acos(*x) ); + return (acos (*x)); } diff --git a/contrib/libf2c/libF77/d_asin.c b/contrib/libf2c/libF77/d_asin.c index 79b33ca..6560389 100644 --- a/contrib/libf2c/libF77/d_asin.c +++ b/contrib/libf2c/libF77/d_asin.c @@ -1,13 +1,9 @@ #include "f2c.h" -#ifdef KR_headers -double asin(); -double d_asin(x) doublereal *x; -#else #undef abs #include <math.h> -double d_asin(doublereal *x) -#endif +double +d_asin (doublereal * x) { -return( asin(*x) ); + return (asin (*x)); } diff --git a/contrib/libf2c/libF77/d_atan.c b/contrib/libf2c/libF77/d_atan.c index caea4a4..e25fa2e 100644 --- a/contrib/libf2c/libF77/d_atan.c +++ b/contrib/libf2c/libF77/d_atan.c @@ -1,13 +1,9 @@ #include "f2c.h" -#ifdef KR_headers -double atan(); -double d_atan(x) doublereal *x; -#else #undef abs #include <math.h> -double d_atan(doublereal *x) -#endif +double +d_atan (doublereal * x) { -return( atan(*x) ); + return (atan (*x)); } diff --git a/contrib/libf2c/libF77/d_atn2.c b/contrib/libf2c/libF77/d_atn2.c index 6748a55..e0b2178 100644 --- a/contrib/libf2c/libF77/d_atn2.c +++ b/contrib/libf2c/libF77/d_atn2.c @@ -1,13 +1,9 @@ #include "f2c.h" -#ifdef KR_headers -double atan2(); -double d_atn2(x,y) doublereal *x, *y; -#else #undef abs #include <math.h> -double d_atn2(doublereal *x, doublereal *y) -#endif +double +d_atn2 (doublereal * x, doublereal * y) { -return( atan2(*x,*y) ); + return (atan2 (*x, *y)); } diff --git a/contrib/libf2c/libF77/d_cnjg.c b/contrib/libf2c/libF77/d_cnjg.c index c1970a5..bc46ae6 100644 --- a/contrib/libf2c/libF77/d_cnjg.c +++ b/contrib/libf2c/libF77/d_cnjg.c @@ -1,13 +1,9 @@ #include "f2c.h" - VOID -#ifdef KR_headers -d_cnjg(r, z) doublecomplex *r, *z; -#else -d_cnjg(doublecomplex *r, doublecomplex *z) -#endif +void +d_cnjg (doublecomplex * r, doublecomplex * z) { - doublereal zi = z->i; - r->r = z->r; - r->i = -zi; - } + doublereal zi = z->i; + r->r = z->r; + r->i = -zi; +} diff --git a/contrib/libf2c/libF77/d_cos.c b/contrib/libf2c/libF77/d_cos.c index fa4d6ca..010db6b 100644 --- a/contrib/libf2c/libF77/d_cos.c +++ b/contrib/libf2c/libF77/d_cos.c @@ -1,13 +1,9 @@ #include "f2c.h" -#ifdef KR_headers -double cos(); -double d_cos(x) doublereal *x; -#else #undef abs #include <math.h> -double d_cos(doublereal *x) -#endif +double +d_cos (doublereal * x) { -return( cos(*x) ); + return (cos (*x)); } diff --git a/contrib/libf2c/libF77/d_cosh.c b/contrib/libf2c/libF77/d_cosh.c index edc0ebc..00938bd 100644 --- a/contrib/libf2c/libF77/d_cosh.c +++ b/contrib/libf2c/libF77/d_cosh.c @@ -1,13 +1,9 @@ #include "f2c.h" -#ifdef KR_headers -double cosh(); -double d_cosh(x) doublereal *x; -#else #undef abs #include <math.h> -double d_cosh(doublereal *x) -#endif +double +d_cosh (doublereal * x) { -return( cosh(*x) ); + return (cosh (*x)); } diff --git a/contrib/libf2c/libF77/d_dim.c b/contrib/libf2c/libF77/d_dim.c index 1d0ecb7..a4274ca 100644 --- a/contrib/libf2c/libF77/d_dim.c +++ b/contrib/libf2c/libF77/d_dim.c @@ -1,10 +1,7 @@ #include "f2c.h" -#ifdef KR_headers -double d_dim(a,b) doublereal *a, *b; -#else -double d_dim(doublereal *a, doublereal *b) -#endif +double +d_dim (doublereal * a, doublereal * b) { -return( *a > *b ? *a - *b : 0); + return (*a > *b ? *a - *b : 0); } diff --git a/contrib/libf2c/libF77/d_exp.c b/contrib/libf2c/libF77/d_exp.c index be12fd7..7b4f3e5 100644 --- a/contrib/libf2c/libF77/d_exp.c +++ b/contrib/libf2c/libF77/d_exp.c @@ -1,13 +1,9 @@ #include "f2c.h" -#ifdef KR_headers -double exp(); -double d_exp(x) doublereal *x; -#else #undef abs #include <math.h> -double d_exp(doublereal *x) -#endif +double +d_exp (doublereal * x) { -return( exp(*x) ); + return (exp (*x)); } diff --git a/contrib/libf2c/libF77/d_imag.c b/contrib/libf2c/libF77/d_imag.c index 793a3f9..cc93764 100644 --- a/contrib/libf2c/libF77/d_imag.c +++ b/contrib/libf2c/libF77/d_imag.c @@ -1,10 +1,7 @@ #include "f2c.h" -#ifdef KR_headers -double d_imag(z) doublecomplex *z; -#else -double d_imag(doublecomplex *z) -#endif +double +d_imag (doublecomplex * z) { -return(z->i); + return (z->i); } diff --git a/contrib/libf2c/libF77/d_int.c b/contrib/libf2c/libF77/d_int.c index beff1e7..f7ab8b0 100644 --- a/contrib/libf2c/libF77/d_int.c +++ b/contrib/libf2c/libF77/d_int.c @@ -1,13 +1,9 @@ #include "f2c.h" -#ifdef KR_headers -double floor(); -double d_int(x) doublereal *x; -#else #undef abs #include <math.h> -double d_int(doublereal *x) -#endif +double +d_int (doublereal * x) { -return( (*x>0) ? floor(*x) : -floor(- *x) ); + return ((*x > 0) ? floor (*x) : -floor (-*x)); } diff --git a/contrib/libf2c/libF77/d_lg10.c b/contrib/libf2c/libF77/d_lg10.c index c0892bd..d0f86e5 100644 --- a/contrib/libf2c/libF77/d_lg10.c +++ b/contrib/libf2c/libF77/d_lg10.c @@ -2,14 +2,10 @@ #define log10e 0.43429448190325182765 -#ifdef KR_headers -double log(); -double d_lg10(x) doublereal *x; -#else #undef abs #include <math.h> -double d_lg10(doublereal *x) -#endif +double +d_lg10 (doublereal * x) { -return( log10e * log(*x) ); + return (log10e * log (*x)); } diff --git a/contrib/libf2c/libF77/d_log.c b/contrib/libf2c/libF77/d_log.c index 592015b..95dc767 100644 --- a/contrib/libf2c/libF77/d_log.c +++ b/contrib/libf2c/libF77/d_log.c @@ -1,13 +1,9 @@ #include "f2c.h" -#ifdef KR_headers -double log(); -double d_log(x) doublereal *x; -#else #undef abs #include <math.h> -double d_log(doublereal *x) -#endif +double +d_log (doublereal * x) { -return( log(*x) ); + return (log (*x)); } diff --git a/contrib/libf2c/libF77/d_mod.c b/contrib/libf2c/libF77/d_mod.c index 23f1929..15cedef 100644 --- a/contrib/libf2c/libF77/d_mod.c +++ b/contrib/libf2c/libF77/d_mod.c @@ -1,40 +1,33 @@ #include "f2c.h" -#ifdef KR_headers #ifdef IEEE_drem -double drem(); -#else -double floor(); -#endif -double d_mod(x,y) doublereal *x, *y; -#else -#ifdef IEEE_drem -double drem(double, double); +double drem (double, double); #else #undef abs #include <math.h> #endif -double d_mod(doublereal *x, doublereal *y) -#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; + 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 ); + double quotient; + if ((quotient = *x / *y) >= 0) + quotient = floor (quotient); + else + quotient = -floor (-quotient); + return (*x - (*y) * quotient); #endif } diff --git a/contrib/libf2c/libF77/d_nint.c b/contrib/libf2c/libF77/d_nint.c index 064beff..8be4275 100644 --- a/contrib/libf2c/libF77/d_nint.c +++ b/contrib/libf2c/libF77/d_nint.c @@ -1,14 +1,9 @@ #include "f2c.h" -#ifdef KR_headers -double floor(); -double d_nint(x) doublereal *x; -#else #undef abs #include <math.h> -double d_nint(doublereal *x) -#endif +double +d_nint (doublereal * x) { -return( (*x)>=0 ? - floor(*x + .5) : -floor(.5 - *x) ); + return ((*x) >= 0 ? floor (*x + .5) : -floor (.5 - *x)); } diff --git a/contrib/libf2c/libF77/d_prod.c b/contrib/libf2c/libF77/d_prod.c index 3d4cef7..11fe2c7 100644 --- a/contrib/libf2c/libF77/d_prod.c +++ b/contrib/libf2c/libF77/d_prod.c @@ -1,10 +1,7 @@ #include "f2c.h" -#ifdef KR_headers -double d_prod(x,y) real *x, *y; -#else -double d_prod(real *x, real *y) -#endif +double +d_prod (real * x, real * y) { -return( (*x) * (*y) ); + return ((*x) * (*y)); } diff --git a/contrib/libf2c/libF77/d_sign.c b/contrib/libf2c/libF77/d_sign.c index 514ff0b..da8d24b 100644 --- a/contrib/libf2c/libF77/d_sign.c +++ b/contrib/libf2c/libF77/d_sign.c @@ -1,12 +1,9 @@ #include "f2c.h" -#ifdef KR_headers -double d_sign(a,b) doublereal *a, *b; -#else -double d_sign(doublereal *a, doublereal *b) -#endif +double +d_sign (doublereal * a, doublereal * b) { -double x; -x = (*a >= 0 ? *a : - *a); -return( *b >= 0 ? x : -x); + double x; + x = (*a >= 0 ? *a : -*a); + return (*b >= 0 ? x : -x); } diff --git a/contrib/libf2c/libF77/d_sin.c b/contrib/libf2c/libF77/d_sin.c index fdd699e..24b37a4 100644 --- a/contrib/libf2c/libF77/d_sin.c +++ b/contrib/libf2c/libF77/d_sin.c @@ -1,13 +1,9 @@ #include "f2c.h" -#ifdef KR_headers -double sin(); -double d_sin(x) doublereal *x; -#else #undef abs #include <math.h> -double d_sin(doublereal *x) -#endif +double +d_sin (doublereal * x) { -return( sin(*x) ); + return (sin (*x)); } diff --git a/contrib/libf2c/libF77/d_sinh.c b/contrib/libf2c/libF77/d_sinh.c index 77f3690..dc9dc43 100644 --- a/contrib/libf2c/libF77/d_sinh.c +++ b/contrib/libf2c/libF77/d_sinh.c @@ -1,13 +1,9 @@ #include "f2c.h" -#ifdef KR_headers -double sinh(); -double d_sinh(x) doublereal *x; -#else #undef abs #include <math.h> -double d_sinh(doublereal *x) -#endif +double +d_sinh (doublereal * x) { -return( sinh(*x) ); + return (sinh (*x)); } diff --git a/contrib/libf2c/libF77/d_sqrt.c b/contrib/libf2c/libF77/d_sqrt.c index b5cf83b..0a45882 100644 --- a/contrib/libf2c/libF77/d_sqrt.c +++ b/contrib/libf2c/libF77/d_sqrt.c @@ -1,13 +1,9 @@ #include "f2c.h" -#ifdef KR_headers -double sqrt(); -double d_sqrt(x) doublereal *x; -#else #undef abs #include <math.h> -double d_sqrt(doublereal *x) -#endif +double +d_sqrt (doublereal * x) { -return( sqrt(*x) ); + return (sqrt (*x)); } diff --git a/contrib/libf2c/libF77/d_tan.c b/contrib/libf2c/libF77/d_tan.c index af94a05..370c1b8 100644 --- a/contrib/libf2c/libF77/d_tan.c +++ b/contrib/libf2c/libF77/d_tan.c @@ -1,13 +1,9 @@ #include "f2c.h" -#ifdef KR_headers -double tan(); -double d_tan(x) doublereal *x; -#else #undef abs #include <math.h> -double d_tan(doublereal *x) -#endif +double +d_tan (doublereal * x) { -return( tan(*x) ); + return (tan (*x)); } diff --git a/contrib/libf2c/libF77/d_tanh.c b/contrib/libf2c/libF77/d_tanh.c index 92a02d4..df81ea0 100644 --- a/contrib/libf2c/libF77/d_tanh.c +++ b/contrib/libf2c/libF77/d_tanh.c @@ -1,13 +1,9 @@ #include "f2c.h" -#ifdef KR_headers -double tanh(); -double d_tanh(x) doublereal *x; -#else #undef abs #include <math.h> -double d_tanh(doublereal *x) -#endif +double +d_tanh (doublereal * x) { -return( tanh(*x) ); + return (tanh (*x)); } diff --git a/contrib/libf2c/libF77/derf_.c b/contrib/libf2c/libF77/derf_.c index fba6b6b..b78fde0 100644 --- a/contrib/libf2c/libF77/derf_.c +++ b/contrib/libf2c/libF77/derf_.c @@ -1,12 +1,8 @@ #include "f2c.h" -#ifdef KR_headers -double erf(); -double G77_derf_0 (x) doublereal *x; -#else -extern double erf(double); -double G77_derf_0 (doublereal *x) -#endif +extern double erf (double); +double +G77_derf_0 (doublereal * x) { -return( erf(*x) ); + return (erf (*x)); } diff --git a/contrib/libf2c/libF77/derfc_.c b/contrib/libf2c/libF77/derfc_.c index ae1ac74..78e8e88 100644 --- a/contrib/libf2c/libF77/derfc_.c +++ b/contrib/libf2c/libF77/derfc_.c @@ -1,14 +1,9 @@ #include "f2c.h" -#ifdef KR_headers -extern double erfc(); +extern double erfc (double); -double G77_derfc_0 (x) doublereal *x; -#else -extern double erfc(double); - -double G77_derfc_0 (doublereal *x) -#endif +double +G77_derfc_0 (doublereal * x) { -return( erfc(*x) ); + return (erfc (*x)); } diff --git a/contrib/libf2c/libF77/dtime_.c b/contrib/libf2c/libF77/dtime_.c index e2c3a03..e2ea1c6 100644 --- a/contrib/libf2c/libF77/dtime_.c +++ b/contrib/libf2c/libF77/dtime_.c @@ -23,31 +23,27 @@ #endif #endif - double -#ifdef KR_headers -dtime_(tarray) float *tarray; -#else -dtime_(float *tarray) -#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]; + 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; + 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]; + 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 - } +} diff --git a/contrib/libf2c/libF77/ef1asc_.c b/contrib/libf2c/libF77/ef1asc_.c index 8588584..d9bea34 100644 --- a/contrib/libf2c/libF77/ef1asc_.c +++ b/contrib/libf2c/libF77/ef1asc_.c @@ -6,14 +6,10 @@ #define M ( (long) (sizeof(long) - 1) ) #define EVEN(x) ( ( (x)+ M) & (~M) ) -#ifdef KR_headers -extern VOID s_copy(); -G77_ef1asc_0 (a, la, b, lb) ftnint *a, *b; ftnlen *la, *lb; -#else -extern void s_copy(char*,char*,ftnlen,ftnlen); -int G77_ef1asc_0 (ftnint *a, ftnlen *la, ftnint *b, ftnlen *lb) -#endif +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 */ + s_copy ((char *) a, (char *) b, EVEN (*la), *lb); + return 0; /* ignored return value */ } diff --git a/contrib/libf2c/libF77/ef1cmc_.c b/contrib/libf2c/libF77/ef1cmc_.c index f471172..2e102fb 100644 --- a/contrib/libf2c/libF77/ef1cmc_.c +++ b/contrib/libf2c/libF77/ef1cmc_.c @@ -2,13 +2,9 @@ #include "f2c.h" -#ifdef KR_headers -extern integer s_cmp(); -integer G77_ef1cmc_0 (a, la, b, lb) ftnint *a, *b; ftnlen *la, *lb; -#else -extern integer s_cmp(char*,char*,ftnlen,ftnlen); -integer G77_ef1cmc_0 (ftnint *a, ftnlen *la, ftnint *b, ftnlen *lb) -#endif +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) ); + return (s_cmp ((char *) a, (char *) b, *la, *lb)); } diff --git a/contrib/libf2c/libF77/erf_.c b/contrib/libf2c/libF77/erf_.c index 1ba4350..fadbfaf 100644 --- a/contrib/libf2c/libF77/erf_.c +++ b/contrib/libf2c/libF77/erf_.c @@ -1,12 +1,8 @@ #include "f2c.h" -#ifdef KR_headers -double erf(); -double G77_erf_0 (x) real *x; -#else -extern double erf(double); -double G77_erf_0 (real *x) -#endif +extern double erf (double); +double +G77_erf_0 (real * x) { -return( erf(*x) ); + return (erf (*x)); } diff --git a/contrib/libf2c/libF77/erfc_.c b/contrib/libf2c/libF77/erfc_.c index f44b1d4..7f3ff8a 100644 --- a/contrib/libf2c/libF77/erfc_.c +++ b/contrib/libf2c/libF77/erfc_.c @@ -1,12 +1,8 @@ #include "f2c.h" -#ifdef KR_headers -double erfc(); -double G77_erfc_0 (x) real *x; -#else -extern double erfc(double); -double G77_erfc_0 (real *x) -#endif +extern double erfc (double); +double +G77_erfc_0 (real * x) { -return( erfc(*x) ); + return (erfc (*x)); } diff --git a/contrib/libf2c/libF77/etime_.c b/contrib/libf2c/libF77/etime_.c index 0c3209d..cc64612 100644 --- a/contrib/libf2c/libF77/etime_.c +++ b/contrib/libf2c/libF77/etime_.c @@ -23,25 +23,21 @@ #endif #endif - double -#ifdef KR_headers -etime_(tarray) float *tarray; -#else -etime_(float *tarray) -#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; + double t = clock (); + tarray[1] = 0; + return tarray[0] = t / CLOCKS_PER_SECOND; #else - struct tms t; + struct tms t; - times(&t); - return (tarray[0] = (double)t.tms_utime/Hz) - + (tarray[1] = (double)t.tms_stime/Hz); + times (&t); + return (tarray[0] = (double) t.tms_utime / Hz) + + (tarray[1] = (double) t.tms_stime / Hz); #endif - } +} diff --git a/contrib/libf2c/libF77/exit_.c b/contrib/libf2c/libF77/exit_.c index 4c0582a..adf3d85 100644 --- a/contrib/libf2c/libF77/exit_.c +++ b/contrib/libf2c/libF77/exit_.c @@ -12,26 +12,14 @@ #undef abs #undef min #undef max -#ifndef KR_headers #include <stdlib.h> -#ifdef __cplusplus -extern "C" { -#endif -extern void f_exit(void); -#endif +extern void f_exit (void); - void -#ifdef KR_headers -G77_exit_0 (rc) integer *rc; -#else -G77_exit_0 (integer *rc) -#endif +void +G77_exit_0 (integer * rc) { #ifdef NO_ONEXIT - f_exit(); + f_exit (); #endif - exit(*rc); - } -#ifdef __cplusplus + exit (*rc); } -#endif diff --git a/contrib/libf2c/libF77/f2ch.add b/contrib/libf2c/libF77/f2ch.add index a2acc17..04b13e8 100644 --- a/contrib/libf2c/libF77/f2ch.add +++ b/contrib/libf2c/libF77/f2ch.add @@ -2,161 +2,162 @@ 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 *); - } +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 diff --git a/contrib/libf2c/libF77/getarg_.c b/contrib/libf2c/libF77/getarg_.c index 5cf3ffb..b35043b 100644 --- a/contrib/libf2c/libF77/getarg_.c +++ b/contrib/libf2c/libF77/getarg_.c @@ -6,23 +6,20 @@ * variable argument c */ -#ifdef KR_headers -VOID G77_getarg_0 (n, s, ls) ftnint *n; register char *s; ftnlen ls; -#else -void G77_getarg_0 (ftnint *n, register char *s, ftnlen ls) -#endif +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; + 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++ = ' '; + 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++ = ' '; } diff --git a/contrib/libf2c/libF77/getenv_.c b/contrib/libf2c/libF77/getenv_.c index 4d0b7cf..4067b8c 100644 --- a/contrib/libf2c/libF77/getenv_.c +++ b/contrib/libf2c/libF77/getenv_.c @@ -1,12 +1,8 @@ #include "f2c.h" #undef abs -#ifdef KR_headers -extern char *F77_aloc(), *getenv(); -#else #include <stdlib.h> #include <string.h> -extern char *F77_aloc(ftnlen, char*); -#endif +extern char *F77_aloc (ftnlen, char *); /* * getenv - f77 subroutine to return environment variables @@ -20,37 +16,34 @@ extern char *F77_aloc(ftnlen, char*); * if ENV_NAME is not defined */ -#ifdef KR_headers - VOID -G77_getenv_0 (fname, value, flen, vlen) char *value, *fname; ftnlen vlen, flen; -#else - void +void G77_getenv_0 (char *fname, char *value, ftnlen flen, ftnlen vlen) -#endif { - char buf[256], *ep, *fp; - integer i; + char buf[256], *ep, *fp; + integer i; - if (flen <= 0) - goto add_blanks; - for(i = 0; i < 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++ = ' '; + 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++ = ' '; +} diff --git a/contrib/libf2c/libF77/h_abs.c b/contrib/libf2c/libF77/h_abs.c index 73b8215..9db19ca 100644 --- a/contrib/libf2c/libF77/h_abs.c +++ b/contrib/libf2c/libF77/h_abs.c @@ -1,12 +1,9 @@ #include "f2c.h" -#ifdef KR_headers -shortint h_abs(x) shortint *x; -#else -shortint h_abs(shortint *x) -#endif +shortint +h_abs (shortint * x) { -if(*x >= 0) - return(*x); -return(- *x); + if (*x >= 0) + return (*x); + return (-*x); } diff --git a/contrib/libf2c/libF77/h_dim.c b/contrib/libf2c/libF77/h_dim.c index ceff660..1519478 100644 --- a/contrib/libf2c/libF77/h_dim.c +++ b/contrib/libf2c/libF77/h_dim.c @@ -1,10 +1,7 @@ #include "f2c.h" -#ifdef KR_headers -shortint h_dim(a,b) shortint *a, *b; -#else -shortint h_dim(shortint *a, shortint *b) -#endif +shortint +h_dim (shortint * a, shortint * b) { -return( *a > *b ? *a - *b : 0); + return (*a > *b ? *a - *b : 0); } diff --git a/contrib/libf2c/libF77/h_dnnt.c b/contrib/libf2c/libF77/h_dnnt.c index 005ac6f..46c83bb 100644 --- a/contrib/libf2c/libF77/h_dnnt.c +++ b/contrib/libf2c/libF77/h_dnnt.c @@ -1,13 +1,9 @@ #include "f2c.h" -#ifdef KR_headers -double floor(); -shortint h_dnnt(x) doublereal *x; -#else #undef abs #include <math.h> -shortint h_dnnt(doublereal *x) -#endif +shortint +h_dnnt (doublereal * x) { -return (shortint)(*x >= 0. ? floor(*x + .5) : -floor(.5 - *x)); + return (shortint) (*x >= 0. ? floor (*x + .5) : -floor (.5 - *x)); } diff --git a/contrib/libf2c/libF77/h_indx.c b/contrib/libf2c/libF77/h_indx.c index a211cc7..2353b2b 100644 --- a/contrib/libf2c/libF77/h_indx.c +++ b/contrib/libf2c/libF77/h_indx.c @@ -1,26 +1,23 @@ #include "f2c.h" -#ifdef KR_headers -shortint h_indx(a, b, la, lb) char *a, *b; ftnlen la, lb; -#else -shortint h_indx(char *a, char *b, ftnlen la, ftnlen lb) -#endif +shortint +h_indx (char *a, char *b, ftnlen la, ftnlen lb) { -ftnlen i, n; -char *s, *t, *bend; + ftnlen i, n; + char *s, *t, *bend; -n = la - lb + 1; -bend = b + lb; + 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); + 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); } diff --git a/contrib/libf2c/libF77/h_len.c b/contrib/libf2c/libF77/h_len.c index 00a2151..506016e 100644 --- a/contrib/libf2c/libF77/h_len.c +++ b/contrib/libf2c/libF77/h_len.c @@ -1,10 +1,7 @@ #include "f2c.h" -#ifdef KR_headers -shortint h_len(s, n) char *s; ftnlen n; -#else -shortint h_len(char *s, ftnlen n) -#endif +shortint +h_len (char *s __attribute__ ((__unused__)), ftnlen n) { -return(n); + return (n); } diff --git a/contrib/libf2c/libF77/h_mod.c b/contrib/libf2c/libF77/h_mod.c index 43431c1..c04e0df8 100644 --- a/contrib/libf2c/libF77/h_mod.c +++ b/contrib/libf2c/libF77/h_mod.c @@ -1,10 +1,7 @@ #include "f2c.h" -#ifdef KR_headers -shortint h_mod(a,b) short *a, *b; -#else -shortint h_mod(short *a, short *b) -#endif +shortint +h_mod (short *a, short *b) { -return( *a % *b); + return (*a % *b); } diff --git a/contrib/libf2c/libF77/h_nint.c b/contrib/libf2c/libF77/h_nint.c index 6b8dc29..a8c366a 100644 --- a/contrib/libf2c/libF77/h_nint.c +++ b/contrib/libf2c/libF77/h_nint.c @@ -1,13 +1,9 @@ #include "f2c.h" -#ifdef KR_headers -double floor(); -shortint h_nint(x) real *x; -#else #undef abs #include <math.h> -shortint h_nint(real *x) -#endif +shortint +h_nint (real * x) { -return (shortint)(*x >= 0 ? floor(*x + .5) : -floor(.5 - *x)); + return (shortint) (*x >= 0 ? floor (*x + .5) : -floor (.5 - *x)); } diff --git a/contrib/libf2c/libF77/h_sign.c b/contrib/libf2c/libF77/h_sign.c index 7b06c15..7040232 100644 --- a/contrib/libf2c/libF77/h_sign.c +++ b/contrib/libf2c/libF77/h_sign.c @@ -1,12 +1,9 @@ #include "f2c.h" -#ifdef KR_headers -shortint h_sign(a,b) shortint *a, *b; -#else -shortint h_sign(shortint *a, shortint *b) -#endif +shortint +h_sign (shortint * a, shortint * b) { -shortint x; -x = (*a >= 0 ? *a : - *a); -return( *b >= 0 ? x : -x); + shortint x; + x = (*a >= 0 ? *a : -*a); + return (*b >= 0 ? x : -x); } diff --git a/contrib/libf2c/libF77/hl_ge.c b/contrib/libf2c/libF77/hl_ge.c index 4c29527..988686d 100644 --- a/contrib/libf2c/libF77/hl_ge.c +++ b/contrib/libf2c/libF77/hl_ge.c @@ -1,12 +1,8 @@ #include "f2c.h" -#ifdef KR_headers -extern integer s_cmp(); -shortlogical hl_ge(a,b,la,lb) char *a, *b; ftnlen la, lb; -#else -extern integer s_cmp(char *, char *, ftnlen, ftnlen); -shortlogical hl_ge(char *a, char *b, ftnlen la, ftnlen lb) -#endif +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); + return (s_cmp (a, b, la, lb) >= 0); } diff --git a/contrib/libf2c/libF77/hl_gt.c b/contrib/libf2c/libF77/hl_gt.c index c4f345a..0024ca7 100644 --- a/contrib/libf2c/libF77/hl_gt.c +++ b/contrib/libf2c/libF77/hl_gt.c @@ -1,12 +1,8 @@ #include "f2c.h" -#ifdef KR_headers -extern integer s_cmp(); -shortlogical hl_gt(a,b,la,lb) char *a, *b; ftnlen la, lb; -#else -extern integer s_cmp(char *, char *, ftnlen, ftnlen); -shortlogical hl_gt(char *a, char *b, ftnlen la, ftnlen lb) -#endif +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); + return (s_cmp (a, b, la, lb) > 0); } diff --git a/contrib/libf2c/libF77/hl_le.c b/contrib/libf2c/libF77/hl_le.c index a9cce59..76aa3e1 100644 --- a/contrib/libf2c/libF77/hl_le.c +++ b/contrib/libf2c/libF77/hl_le.c @@ -1,12 +1,8 @@ #include "f2c.h" -#ifdef KR_headers -extern integer s_cmp(); -shortlogical hl_le(a,b,la,lb) char *a, *b; ftnlen la, lb; -#else -extern integer s_cmp(char *, char *, ftnlen, ftnlen); -shortlogical hl_le(char *a, char *b, ftnlen la, ftnlen lb) -#endif +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); + return (s_cmp (a, b, la, lb) <= 0); } diff --git a/contrib/libf2c/libF77/hl_lt.c b/contrib/libf2c/libF77/hl_lt.c index 162d919..68a47fa 100644 --- a/contrib/libf2c/libF77/hl_lt.c +++ b/contrib/libf2c/libF77/hl_lt.c @@ -1,12 +1,8 @@ #include "f2c.h" -#ifdef KR_headers -extern integer s_cmp(); -shortlogical hl_lt(a,b,la,lb) char *a, *b; ftnlen la, lb; -#else -extern integer s_cmp(char *, char *, ftnlen, ftnlen); -shortlogical hl_lt(char *a, char *b, ftnlen la, ftnlen lb) -#endif +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); + return (s_cmp (a, b, la, lb) < 0); } diff --git a/contrib/libf2c/libF77/i_abs.c b/contrib/libf2c/libF77/i_abs.c index be21295..2ed183a 100644 --- a/contrib/libf2c/libF77/i_abs.c +++ b/contrib/libf2c/libF77/i_abs.c @@ -1,12 +1,9 @@ #include "f2c.h" -#ifdef KR_headers -integer i_abs(x) integer *x; -#else -integer i_abs(integer *x) -#endif +integer +i_abs (integer * x) { -if(*x >= 0) - return(*x); -return(- *x); + if (*x >= 0) + return (*x); + return (-*x); } diff --git a/contrib/libf2c/libF77/i_dim.c b/contrib/libf2c/libF77/i_dim.c index 6e1b170..66ef7c9 100644 --- a/contrib/libf2c/libF77/i_dim.c +++ b/contrib/libf2c/libF77/i_dim.c @@ -1,10 +1,7 @@ #include "f2c.h" -#ifdef KR_headers -integer i_dim(a,b) integer *a, *b; -#else -integer i_dim(integer *a, integer *b) -#endif +integer +i_dim (integer * a, integer * b) { -return( *a > *b ? *a - *b : 0); + return (*a > *b ? *a - *b : 0); } diff --git a/contrib/libf2c/libF77/i_dnnt.c b/contrib/libf2c/libF77/i_dnnt.c index 4ede56a..7a3783d 100644 --- a/contrib/libf2c/libF77/i_dnnt.c +++ b/contrib/libf2c/libF77/i_dnnt.c @@ -1,13 +1,9 @@ #include "f2c.h" -#ifdef KR_headers -double floor(); -integer i_dnnt(x) doublereal *x; -#else #undef abs #include <math.h> -integer i_dnnt(doublereal *x) -#endif +integer +i_dnnt (doublereal * x) { -return (integer)(*x >= 0. ? floor(*x + .5) : -floor(.5 - *x)); + return (integer) (*x >= 0. ? floor (*x + .5) : -floor (.5 - *x)); } diff --git a/contrib/libf2c/libF77/i_indx.c b/contrib/libf2c/libF77/i_indx.c index 96e7bc5..5b8e136 100644 --- a/contrib/libf2c/libF77/i_indx.c +++ b/contrib/libf2c/libF77/i_indx.c @@ -1,26 +1,23 @@ #include "f2c.h" -#ifdef KR_headers -integer i_indx(a, b, la, lb) char *a, *b; ftnlen la, lb; -#else -integer i_indx(char *a, char *b, ftnlen la, ftnlen lb) -#endif +integer +i_indx (char *a, char *b, ftnlen la, ftnlen lb) { -ftnlen i, n; -char *s, *t, *bend; + ftnlen i, n; + char *s, *t, *bend; -n = la - lb + 1; -bend = b + lb; + 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); + 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); } diff --git a/contrib/libf2c/libF77/i_len.c b/contrib/libf2c/libF77/i_len.c index 4020fee..2d5a3a4 100644 --- a/contrib/libf2c/libF77/i_len.c +++ b/contrib/libf2c/libF77/i_len.c @@ -1,10 +1,7 @@ #include "f2c.h" -#ifdef KR_headers -integer i_len(s, n) char *s; ftnlen n; -#else -integer i_len(char *s, ftnlen n) -#endif +integer +i_len (char *s __attribute__ ((__unused__)), ftnlen n) { -return(n); + return (n); } diff --git a/contrib/libf2c/libF77/i_mod.c b/contrib/libf2c/libF77/i_mod.c index 6937c42..7ed7b39 100644 --- a/contrib/libf2c/libF77/i_mod.c +++ b/contrib/libf2c/libF77/i_mod.c @@ -1,10 +1,7 @@ #include "f2c.h" -#ifdef KR_headers -integer i_mod(a,b) integer *a, *b; -#else -integer i_mod(integer *a, integer *b) -#endif +integer +i_mod (integer * a, integer * b) { -return( *a % *b); + return (*a % *b); } diff --git a/contrib/libf2c/libF77/i_nint.c b/contrib/libf2c/libF77/i_nint.c index 411ce32..c4eaff4 100644 --- a/contrib/libf2c/libF77/i_nint.c +++ b/contrib/libf2c/libF77/i_nint.c @@ -1,13 +1,9 @@ #include "f2c.h" -#ifdef KR_headers -double floor(); -integer i_nint(x) real *x; -#else #undef abs #include <math.h> -integer i_nint(real *x) -#endif +integer +i_nint (real * x) { -return (integer)(*x >= 0 ? floor(*x + .5) : -floor(.5 - *x)); + return (integer) (*x >= 0 ? floor (*x + .5) : -floor (.5 - *x)); } diff --git a/contrib/libf2c/libF77/i_sign.c b/contrib/libf2c/libF77/i_sign.c index 94009b8..cf09008 100644 --- a/contrib/libf2c/libF77/i_sign.c +++ b/contrib/libf2c/libF77/i_sign.c @@ -1,12 +1,9 @@ #include "f2c.h" -#ifdef KR_headers -integer i_sign(a,b) integer *a, *b; -#else -integer i_sign(integer *a, integer *b) -#endif +integer +i_sign (integer * a, integer * b) { -integer x; -x = (*a >= 0 ? *a : - *a); -return( *b >= 0 ? x : -x); + integer x; + x = (*a >= 0 ? *a : -*a); + return (*b >= 0 ? x : -x); } diff --git a/contrib/libf2c/libF77/iargc_.c b/contrib/libf2c/libF77/iargc_.c index 1e04c77..c316570 100644 --- a/contrib/libf2c/libF77/iargc_.c +++ b/contrib/libf2c/libF77/iargc_.c @@ -1,11 +1,8 @@ #include "f2c.h" -#ifdef KR_headers -ftnint G77_iargc_0 () -#else -ftnint G77_iargc_0 (void) -#endif +ftnint +G77_iargc_0 (void) { -extern int f__xargc; -return ( f__xargc - 1 ); + extern int f__xargc; + return (f__xargc - 1); } diff --git a/contrib/libf2c/libF77/l_ge.c b/contrib/libf2c/libF77/l_ge.c index 86b4a1f..78af8d0 100644 --- a/contrib/libf2c/libF77/l_ge.c +++ b/contrib/libf2c/libF77/l_ge.c @@ -1,12 +1,8 @@ #include "f2c.h" -#ifdef KR_headers -extern integer s_cmp(); -logical l_ge(a,b,la,lb) char *a, *b; ftnlen la, lb; -#else -extern integer s_cmp(char *, char *, ftnlen, ftnlen); -logical l_ge(char *a, char *b, ftnlen la, ftnlen lb) -#endif +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); + return (s_cmp (a, b, la, lb) >= 0); } diff --git a/contrib/libf2c/libF77/l_gt.c b/contrib/libf2c/libF77/l_gt.c index c4b52f5..be7e489 100644 --- a/contrib/libf2c/libF77/l_gt.c +++ b/contrib/libf2c/libF77/l_gt.c @@ -1,12 +1,8 @@ #include "f2c.h" -#ifdef KR_headers -extern integer s_cmp(); -logical l_gt(a,b,la,lb) char *a, *b; ftnlen la, lb; -#else -extern integer s_cmp(char *, char *, ftnlen, ftnlen); -logical l_gt(char *a, char *b, ftnlen la, ftnlen lb) -#endif +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); + return (s_cmp (a, b, la, lb) > 0); } diff --git a/contrib/libf2c/libF77/l_le.c b/contrib/libf2c/libF77/l_le.c index f2740a2..d2886fb 100644 --- a/contrib/libf2c/libF77/l_le.c +++ b/contrib/libf2c/libF77/l_le.c @@ -1,12 +1,8 @@ #include "f2c.h" -#ifdef KR_headers -extern integer s_cmp(); -logical l_le(a,b,la,lb) char *a, *b; ftnlen la, lb; -#else -extern integer s_cmp(char *, char *, ftnlen, ftnlen); -logical l_le(char *a, char *b, ftnlen la, ftnlen lb) -#endif +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); + return (s_cmp (a, b, la, lb) <= 0); } diff --git a/contrib/libf2c/libF77/l_lt.c b/contrib/libf2c/libF77/l_lt.c index c48dc94..ff151f8 100644 --- a/contrib/libf2c/libF77/l_lt.c +++ b/contrib/libf2c/libF77/l_lt.c @@ -1,12 +1,8 @@ #include "f2c.h" -#ifdef KR_headers -extern integer s_cmp(); -logical l_lt(a,b,la,lb) char *a, *b; ftnlen la, lb; -#else -extern integer s_cmp(char *, char *, ftnlen, ftnlen); -logical l_lt(char *a, char *b, ftnlen la, ftnlen lb) -#endif +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); + return (s_cmp (a, b, la, lb) < 0); } diff --git a/contrib/libf2c/libF77/lbitbits.c b/contrib/libf2c/libF77/lbitbits.c index 75e9f9c..3b28ae9 100644 --- a/contrib/libf2c/libF77/lbitbits.c +++ b/contrib/libf2c/libF77/lbitbits.c @@ -4,59 +4,55 @@ #define LONGBITS 32 #endif - integer -#ifdef KR_headers -lbit_bits(a, b, len) integer a, b, len; -#else -lbit_bits(integer a, integer b, integer len) -#endif +integer +lbit_bits (integer a, integer b, integer len) { - /* Assume 2's complement arithmetic */ + /* Assume 2's complement arithmetic */ - unsigned long x, y; + unsigned long x, y; - x = (unsigned long) a; - y = (unsigned long)-1L; - x >>= b; - y <<= len; - return (integer)(x & ~y); - } + x = (unsigned long) a; + y = (unsigned long) -1L; + x >>= b; + y <<= len; + return (integer) (x & ~y); +} - integer -#ifdef KR_headers -lbit_cshift(a, b, len) integer a, b, len; -#else -lbit_cshift(integer a, integer b, integer len) -#endif +integer +lbit_cshift (integer a, integer b, integer len) { - unsigned long x, y, z; + 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)); + 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)))); +} diff --git a/contrib/libf2c/libF77/lbitshft.c b/contrib/libf2c/libF77/lbitshft.c index 81b0fdb..bfbb7c0 100644 --- a/contrib/libf2c/libF77/lbitshft.c +++ b/contrib/libf2c/libF77/lbitshft.c @@ -1,11 +1,7 @@ #include "f2c.h" - integer -#ifdef KR_headers -lbit_shift(a, b) integer a; integer b; -#else -lbit_shift(integer a, integer b) -#endif +integer +lbit_shift (integer a, integer b) { - return b >= 0 ? a << b : (integer)((uinteger)a >> -b); - } + return b >= 0 ? a << b : (integer) ((uinteger) a >> -b); +} diff --git a/contrib/libf2c/libF77/main.c b/contrib/libf2c/libF77/main.c index 17bf449..a3955cb 100644 --- a/contrib/libf2c/libF77/main.c +++ b/contrib/libf2c/libF77/main.c @@ -3,66 +3,33 @@ #include <stdio.h> #include "signal1.h" -#ifndef KR_headers -#undef VOID #include <stdlib.h> -#endif - -#ifndef VOID -#define VOID void -#endif -#ifdef __cplusplus -extern "C" { -#endif - -#ifdef NO__STDC -#define ONEXIT onexit -extern VOID f_exit(); -#else -#ifndef KR_headers -extern void f_exit(void); +extern void f_exit (void); #ifndef NO_ONEXIT #define ONEXIT atexit -extern int atexit(void (*)(void)); -#endif -#else -#ifndef NO_ONEXIT -#define ONEXIT onexit -extern VOID f_exit(); -#endif -#endif -#endif - -#ifdef KR_headers -extern VOID f_init(); -extern int MAIN__(); -#else -extern void f_init(void); -extern int MAIN__(void); +extern int atexit (void (*)(void)); #endif -#ifdef __cplusplus - } -#endif +extern void f_init (void); +extern int MAIN__ (void); +extern void f_setarg (int, char **); +extern void f_setsig (void); -#ifdef KR_headers -main(argc, argv) int argc; char **argv; -#else -main(int argc, char **argv) -#endif +int +main (int argc, char **argv) { -f_setarg(argc, argv); -f_setsig(); -f_init(); + f_setarg (argc, argv); + f_setsig (); + f_init (); #ifndef NO_ONEXIT -ONEXIT(f_exit); + ONEXIT (f_exit); #endif -MAIN__(); + MAIN__ (); #ifdef NO_ONEXIT -f_exit(); + 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. */ + 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. */ } diff --git a/contrib/libf2c/libF77/pow_ci.c b/contrib/libf2c/libF77/pow_ci.c index 37e2ce0..1df3eb3 100644 --- a/contrib/libf2c/libF77/pow_ci.c +++ b/contrib/libf2c/libF77/pow_ci.c @@ -1,20 +1,16 @@ #include "f2c.h" -#ifdef KR_headers -VOID pow_ci(p, a, b) /* p = a**b */ - complex *p, *a; integer *b; -#else -extern void pow_zi(doublecomplex*, doublecomplex*, integer*); -void pow_ci(complex *p, complex *a, integer *b) /* p = a**b */ -#endif +extern void pow_zi (doublecomplex *, doublecomplex *, integer *); +void +pow_ci (complex * p, complex * a, integer * b) /* p = a**b */ { -doublecomplex p1, a1; + doublecomplex p1, a1; -a1.r = a->r; -a1.i = a->i; + a1.r = a->r; + a1.i = a->i; -pow_zi(&p1, &a1, b); + pow_zi (&p1, &a1, b); -p->r = p1.r; -p->i = p1.i; + p->r = p1.r; + p->i = p1.i; } diff --git a/contrib/libf2c/libF77/pow_dd.c b/contrib/libf2c/libF77/pow_dd.c index d0dd0ff..0ab208e 100644 --- a/contrib/libf2c/libF77/pow_dd.c +++ b/contrib/libf2c/libF77/pow_dd.c @@ -1,13 +1,9 @@ #include "f2c.h" -#ifdef KR_headers -double pow(); -double pow_dd(ap, bp) doublereal *ap, *bp; -#else #undef abs #include <math.h> -double pow_dd(doublereal *ap, doublereal *bp) -#endif +double +pow_dd (doublereal * ap, doublereal * bp) { -return(pow(*ap, *bp) ); + return (pow (*ap, *bp)); } diff --git a/contrib/libf2c/libF77/pow_di.c b/contrib/libf2c/libF77/pow_di.c index affed62..d2298a0 100644 --- a/contrib/libf2c/libF77/pow_di.c +++ b/contrib/libf2c/libF77/pow_di.c @@ -1,35 +1,32 @@ #include "f2c.h" -#ifdef KR_headers -double pow_di(ap, bp) doublereal *ap; integer *bp; -#else -double pow_di(doublereal *ap, integer *bp) -#endif +double +pow_di (doublereal * ap, integer * bp) { -double pow, x; -integer n; -unsigned long u; + double pow, x; + integer n; + unsigned long u; -pow = 1; -x = *ap; -n = *bp; + pow = 1; + x = *ap; + n = *bp; -if(n != 0) + if (n != 0) + { + 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; - } + n = -n; + x = 1 / x; } -return(pow); + for (u = n;;) + { + if (u & 01) + pow *= x; + if (u >>= 1) + x *= x; + else + break; + } + } + return (pow); } diff --git a/contrib/libf2c/libF77/pow_hh.c b/contrib/libf2c/libF77/pow_hh.c index 24a0197..3379d8a 100644 --- a/contrib/libf2c/libF77/pow_hh.c +++ b/contrib/libf2c/libF77/pow_hh.c @@ -1,33 +1,31 @@ #include "f2c.h" -#ifdef KR_headers -shortint pow_hh(ap, bp) shortint *ap, *bp; -#else -shortint pow_hh(shortint *ap, shortint *bp) -#endif +shortint +pow_hh (shortint * ap, shortint * bp) { - shortint pow, x, n; - unsigned u; + shortint pow, x, n; + unsigned u; - x = *ap; - n = *bp; + 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); - } + 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); +} diff --git a/contrib/libf2c/libF77/pow_ii.c b/contrib/libf2c/libF77/pow_ii.c index 84d1c7e..9234745 100644 --- a/contrib/libf2c/libF77/pow_ii.c +++ b/contrib/libf2c/libF77/pow_ii.c @@ -1,33 +1,31 @@ #include "f2c.h" -#ifdef KR_headers -integer pow_ii(ap, bp) integer *ap, *bp; -#else -integer pow_ii(integer *ap, integer *bp) -#endif +integer +pow_ii (integer * ap, integer * bp) { - integer pow, x, n; - unsigned long u; + integer pow, x, n; + unsigned long u; - x = *ap; - n = *bp; + 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); - } + 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); +} diff --git a/contrib/libf2c/libF77/pow_qq.c b/contrib/libf2c/libF77/pow_qq.c index 3bc80e0..0cec5ca 100644 --- a/contrib/libf2c/libF77/pow_qq.c +++ b/contrib/libf2c/libF77/pow_qq.c @@ -1,33 +1,31 @@ #include "f2c.h" -#ifdef KR_headers -longint pow_qq(ap, bp) longint *ap, *bp; -#else -longint pow_qq(longint *ap, longint *bp) -#endif +longint +pow_qq (longint * ap, longint * bp) { - longint pow, x, n; - unsigned long long u; /* system-dependent */ + longint pow, x, n; + unsigned long long u; /* system-dependent */ - x = *ap; - n = *bp; + 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); - } + 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); +} diff --git a/contrib/libf2c/libF77/pow_ri.c b/contrib/libf2c/libF77/pow_ri.c index 6e5816b..792db0c 100644 --- a/contrib/libf2c/libF77/pow_ri.c +++ b/contrib/libf2c/libF77/pow_ri.c @@ -1,35 +1,32 @@ #include "f2c.h" -#ifdef KR_headers -double pow_ri(ap, bp) real *ap; integer *bp; -#else -double pow_ri(real *ap, integer *bp) -#endif +double +pow_ri (real * ap, integer * bp) { -double pow, x; -integer n; -unsigned long u; + double pow, x; + integer n; + unsigned long u; -pow = 1; -x = *ap; -n = *bp; + pow = 1; + x = *ap; + n = *bp; -if(n != 0) + if (n != 0) + { + 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; - } + n = -n; + x = 1 / x; } -return(pow); + for (u = n;;) + { + if (u & 01) + pow *= x; + if (u >>= 1) + x *= x; + else + break; + } + } + return (pow); } diff --git a/contrib/libf2c/libF77/pow_zi.c b/contrib/libf2c/libF77/pow_zi.c index abb3cb2..214db3d 100644 --- a/contrib/libf2c/libF77/pow_zi.c +++ b/contrib/libf2c/libF77/pow_zi.c @@ -1,54 +1,50 @@ #include "f2c.h" -#ifdef KR_headers -VOID pow_zi(p, a, b) /* p = a**b */ - doublecomplex *p, *a; integer *b; -#else -extern void z_div(doublecomplex*, doublecomplex*, doublecomplex*); -void pow_zi(doublecomplex *p, doublecomplex *a, integer *b) /* p = a**b */ -#endif +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}; + 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; + 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; - } + 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; + 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; +} diff --git a/contrib/libf2c/libF77/pow_zz.c b/contrib/libf2c/libF77/pow_zz.c index 20faf29..d5cfbf3 100644 --- a/contrib/libf2c/libF77/pow_zz.c +++ b/contrib/libf2c/libF77/pow_zz.c @@ -1,23 +1,25 @@ #include "f2c.h" -#ifdef KR_headers -double log(), exp(), cos(), sin(), atan2(), f__cabs(); -VOID pow_zz(r,a,b) doublecomplex *r, *a, *b; -#else #undef abs #include <math.h> -extern double f__cabs(double,double); -void pow_zz(doublecomplex *r, doublecomplex *a, doublecomplex *b) -#endif +extern double f__cabs (double, double); +void +pow_zz (doublecomplex * r, doublecomplex * a, doublecomplex * b) { -double logr, logi, x, y; + double logr, logi, x, y; -logr = log( f__cabs(a->r, a->i) ); -logi = atan2(a->i, a->r); + 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; + 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); + r->r = x * cos (y); + r->i = x * sin (y); } diff --git a/contrib/libf2c/libF77/qbitbits.c b/contrib/libf2c/libF77/qbitbits.c index ad4ac96..f72858e 100644 --- a/contrib/libf2c/libF77/qbitbits.c +++ b/contrib/libf2c/libF77/qbitbits.c @@ -8,59 +8,55 @@ #define LONG8BITS (2*LONGBITS) #endif - integer -#ifdef KR_headers -qbit_bits(a, b, len) longint a; integer b, len; -#else -qbit_bits(longint a, integer b, integer len) -#endif +integer +qbit_bits (longint a, integer b, integer len) { - /* Assume 2's complement arithmetic */ + /* Assume 2's complement arithmetic */ - ulongint x, y; + ulongint x, y; - x = (ulongint) a; - y = (ulongint)-1L; - x >>= b; - y <<= len; - return (longint)(x & y); - } + x = (ulongint) a; + y = (ulongint) - 1L; + x >>= b; + y <<= len; + return (longint) (x & y); +} - longint -#ifdef KR_headers -qbit_cshift(a, b, len) longint a; integer b, len; -#else -qbit_cshift(longint a, integer b, integer len) -#endif +longint +qbit_cshift (longint a, integer b, integer len) { - ulongint x, y, z; + 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)); + 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)))); +} diff --git a/contrib/libf2c/libF77/qbitshft.c b/contrib/libf2c/libF77/qbitshft.c index 87fffb9..ce740ed 100644 --- a/contrib/libf2c/libF77/qbitshft.c +++ b/contrib/libf2c/libF77/qbitshft.c @@ -1,11 +1,7 @@ #include "f2c.h" - longint -#ifdef KR_headers -qbit_shift(a, b) longint a; integer b; -#else -qbit_shift(longint a, integer b) -#endif +longint +qbit_shift (longint a, integer b) { - return b >= 0 ? a << b : (longint)((ulongint)a >> -b); - } + return b >= 0 ? a << b : (longint) ((ulongint) a >> -b); +} diff --git a/contrib/libf2c/libF77/r_abs.c b/contrib/libf2c/libF77/r_abs.c index 7b22296..6f62724 100644 --- a/contrib/libf2c/libF77/r_abs.c +++ b/contrib/libf2c/libF77/r_abs.c @@ -1,12 +1,9 @@ #include "f2c.h" -#ifdef KR_headers -double r_abs(x) real *x; -#else -double r_abs(real *x) -#endif +double +r_abs (real * x) { -if(*x >= 0) - return(*x); -return(- *x); + if (*x >= 0) + return (*x); + return (-*x); } diff --git a/contrib/libf2c/libF77/r_acos.c b/contrib/libf2c/libF77/r_acos.c index 330f88a..d761cfd 100644 --- a/contrib/libf2c/libF77/r_acos.c +++ b/contrib/libf2c/libF77/r_acos.c @@ -1,13 +1,9 @@ #include "f2c.h" -#ifdef KR_headers -double acos(); -double r_acos(x) real *x; -#else #undef abs #include <math.h> -double r_acos(real *x) -#endif +double +r_acos (real * x) { -return( acos(*x) ); + return (acos (*x)); } diff --git a/contrib/libf2c/libF77/r_asin.c b/contrib/libf2c/libF77/r_asin.c index 45ece4b..b8c73c7 100644 --- a/contrib/libf2c/libF77/r_asin.c +++ b/contrib/libf2c/libF77/r_asin.c @@ -1,13 +1,9 @@ #include "f2c.h" -#ifdef KR_headers -double asin(); -double r_asin(x) real *x; -#else #undef abs #include <math.h> -double r_asin(real *x) -#endif +double +r_asin (real * x) { -return( asin(*x) ); + return (asin (*x)); } diff --git a/contrib/libf2c/libF77/r_atan.c b/contrib/libf2c/libF77/r_atan.c index 36479c9..33a6589 100644 --- a/contrib/libf2c/libF77/r_atan.c +++ b/contrib/libf2c/libF77/r_atan.c @@ -1,13 +1,9 @@ #include "f2c.h" -#ifdef KR_headers -double atan(); -double r_atan(x) real *x; -#else #undef abs #include <math.h> -double r_atan(real *x) -#endif +double +r_atan (real * x) { -return( atan(*x) ); + return (atan (*x)); } diff --git a/contrib/libf2c/libF77/r_atn2.c b/contrib/libf2c/libF77/r_atn2.c index 9347e1f..076d874 100644 --- a/contrib/libf2c/libF77/r_atn2.c +++ b/contrib/libf2c/libF77/r_atn2.c @@ -1,13 +1,9 @@ #include "f2c.h" -#ifdef KR_headers -double atan2(); -double r_atn2(x,y) real *x, *y; -#else #undef abs #include <math.h> -double r_atn2(real *x, real *y) -#endif +double +r_atn2 (real * x, real * y) { -return( atan2(*x,*y) ); + return (atan2 (*x, *y)); } diff --git a/contrib/libf2c/libF77/r_cnjg.c b/contrib/libf2c/libF77/r_cnjg.c index 756c694..5f84929 100644 --- a/contrib/libf2c/libF77/r_cnjg.c +++ b/contrib/libf2c/libF77/r_cnjg.c @@ -1,12 +1,9 @@ #include "f2c.h" -#ifdef KR_headers -VOID r_cnjg(r, z) complex *r, *z; -#else -VOID r_cnjg(complex *r, complex *z) -#endif +void +r_cnjg (complex * r, complex * z) { - real zi = z->i; - r->r = z->r; - r->i = -zi; - } + real zi = z->i; + r->r = z->r; + r->i = -zi; +} diff --git a/contrib/libf2c/libF77/r_cos.c b/contrib/libf2c/libF77/r_cos.c index 5bda158..ed556e8 100644 --- a/contrib/libf2c/libF77/r_cos.c +++ b/contrib/libf2c/libF77/r_cos.c @@ -1,13 +1,9 @@ #include "f2c.h" -#ifdef KR_headers -double cos(); -double r_cos(x) real *x; -#else #undef abs #include <math.h> -double r_cos(real *x) -#endif +double +r_cos (real * x) { -return( cos(*x) ); + return (cos (*x)); } diff --git a/contrib/libf2c/libF77/r_cosh.c b/contrib/libf2c/libF77/r_cosh.c index 7ae72cc..b22e0cf 100644 --- a/contrib/libf2c/libF77/r_cosh.c +++ b/contrib/libf2c/libF77/r_cosh.c @@ -1,13 +1,9 @@ #include "f2c.h" -#ifdef KR_headers -double cosh(); -double r_cosh(x) real *x; -#else #undef abs #include <math.h> -double r_cosh(real *x) -#endif +double +r_cosh (real * x) { -return( cosh(*x) ); + return (cosh (*x)); } diff --git a/contrib/libf2c/libF77/r_dim.c b/contrib/libf2c/libF77/r_dim.c index baca95c..48d2fc7 100644 --- a/contrib/libf2c/libF77/r_dim.c +++ b/contrib/libf2c/libF77/r_dim.c @@ -1,10 +1,7 @@ #include "f2c.h" -#ifdef KR_headers -double r_dim(a,b) real *a, *b; -#else -double r_dim(real *a, real *b) -#endif +double +r_dim (real * a, real * b) { -return( *a > *b ? *a - *b : 0); + return (*a > *b ? *a - *b : 0); } diff --git a/contrib/libf2c/libF77/r_exp.c b/contrib/libf2c/libF77/r_exp.c index d1dea75..7c1ceea 100644 --- a/contrib/libf2c/libF77/r_exp.c +++ b/contrib/libf2c/libF77/r_exp.c @@ -1,13 +1,9 @@ #include "f2c.h" -#ifdef KR_headers -double exp(); -double r_exp(x) real *x; -#else #undef abs #include <math.h> -double r_exp(real *x) -#endif +double +r_exp (real * x) { -return( exp(*x) ); + return (exp (*x)); } diff --git a/contrib/libf2c/libF77/r_imag.c b/contrib/libf2c/libF77/r_imag.c index d51252b..784abc8 100644 --- a/contrib/libf2c/libF77/r_imag.c +++ b/contrib/libf2c/libF77/r_imag.c @@ -1,10 +1,7 @@ #include "f2c.h" -#ifdef KR_headers -double r_imag(z) complex *z; -#else -double r_imag(complex *z) -#endif +double +r_imag (complex * z) { -return(z->i); + return (z->i); } diff --git a/contrib/libf2c/libF77/r_int.c b/contrib/libf2c/libF77/r_int.c index 8378e77..3c1b28e 100644 --- a/contrib/libf2c/libF77/r_int.c +++ b/contrib/libf2c/libF77/r_int.c @@ -1,13 +1,9 @@ #include "f2c.h" -#ifdef KR_headers -double floor(); -double r_int(x) real *x; -#else #undef abs #include <math.h> -double r_int(real *x) -#endif +double +r_int (real * x) { -return( (*x>0) ? floor(*x) : -floor(- *x) ); + return ((*x > 0) ? floor (*x) : -floor (-*x)); } diff --git a/contrib/libf2c/libF77/r_lg10.c b/contrib/libf2c/libF77/r_lg10.c index 51f84201..563e73c 100644 --- a/contrib/libf2c/libF77/r_lg10.c +++ b/contrib/libf2c/libF77/r_lg10.c @@ -2,14 +2,10 @@ #define log10e 0.43429448190325182765 -#ifdef KR_headers -double log(); -double r_lg10(x) real *x; -#else #undef abs #include <math.h> -double r_lg10(real *x) -#endif +double +r_lg10 (real * x) { -return( log10e * log(*x) ); + return (log10e * log (*x)); } diff --git a/contrib/libf2c/libF77/r_log.c b/contrib/libf2c/libF77/r_log.c index 4873fb4..eaaecc8 100644 --- a/contrib/libf2c/libF77/r_log.c +++ b/contrib/libf2c/libF77/r_log.c @@ -1,13 +1,9 @@ #include "f2c.h" -#ifdef KR_headers -double log(); -double r_log(x) real *x; -#else #undef abs #include <math.h> -double r_log(real *x) -#endif +double +r_log (real * x) { -return( log(*x) ); + return (log (*x)); } diff --git a/contrib/libf2c/libF77/r_mod.c b/contrib/libf2c/libF77/r_mod.c index faea344..9518d66 100644 --- a/contrib/libf2c/libF77/r_mod.c +++ b/contrib/libf2c/libF77/r_mod.c @@ -1,40 +1,33 @@ #include "f2c.h" -#ifdef KR_headers #ifdef IEEE_drem -double drem(); -#else -double floor(); -#endif -double r_mod(x,y) real *x, *y; -#else -#ifdef IEEE_drem -double drem(double, double); +double drem (double, double); #else #undef abs #include <math.h> #endif -double r_mod(real *x, real *y) -#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; + 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 ); + double quotient; + if ((quotient = (double) *x / *y) >= 0) + quotient = floor (quotient); + else + quotient = -floor (-quotient); + return (*x - (*y) * quotient); #endif } diff --git a/contrib/libf2c/libF77/r_nint.c b/contrib/libf2c/libF77/r_nint.c index f5382af..f2713d5 100644 --- a/contrib/libf2c/libF77/r_nint.c +++ b/contrib/libf2c/libF77/r_nint.c @@ -1,14 +1,9 @@ #include "f2c.h" -#ifdef KR_headers -double floor(); -double r_nint(x) real *x; -#else #undef abs #include <math.h> -double r_nint(real *x) -#endif +double +r_nint (real * x) { -return( (*x)>=0 ? - floor(*x + .5) : -floor(.5 - *x) ); + return ((*x) >= 0 ? floor (*x + .5) : -floor (.5 - *x)); } diff --git a/contrib/libf2c/libF77/r_sign.c b/contrib/libf2c/libF77/r_sign.c index df6d02a..f53c6bf 100644 --- a/contrib/libf2c/libF77/r_sign.c +++ b/contrib/libf2c/libF77/r_sign.c @@ -1,12 +1,9 @@ #include "f2c.h" -#ifdef KR_headers -double r_sign(a,b) real *a, *b; -#else -double r_sign(real *a, real *b) -#endif +double +r_sign (real * a, real * b) { -double x; -x = (*a >= 0 ? *a : - *a); -return( *b >= 0 ? x : -x); + double x; + x = (*a >= 0 ? *a : -*a); + return (*b >= 0 ? x : -x); } diff --git a/contrib/libf2c/libF77/r_sin.c b/contrib/libf2c/libF77/r_sin.c index 095b951..5a5ef13 100644 --- a/contrib/libf2c/libF77/r_sin.c +++ b/contrib/libf2c/libF77/r_sin.c @@ -1,13 +1,9 @@ #include "f2c.h" -#ifdef KR_headers -double sin(); -double r_sin(x) real *x; -#else #undef abs #include <math.h> -double r_sin(real *x) -#endif +double +r_sin (real * x) { -return( sin(*x) ); + return (sin (*x)); } diff --git a/contrib/libf2c/libF77/r_sinh.c b/contrib/libf2c/libF77/r_sinh.c index 3bf4bb1..723c7ab 100644 --- a/contrib/libf2c/libF77/r_sinh.c +++ b/contrib/libf2c/libF77/r_sinh.c @@ -1,13 +1,9 @@ #include "f2c.h" -#ifdef KR_headers -double sinh(); -double r_sinh(x) real *x; -#else #undef abs #include <math.h> -double r_sinh(real *x) -#endif +double +r_sinh (real * x) { -return( sinh(*x) ); + return (sinh (*x)); } diff --git a/contrib/libf2c/libF77/r_sqrt.c b/contrib/libf2c/libF77/r_sqrt.c index d0203d3..ed832ba 100644 --- a/contrib/libf2c/libF77/r_sqrt.c +++ b/contrib/libf2c/libF77/r_sqrt.c @@ -1,13 +1,9 @@ #include "f2c.h" -#ifdef KR_headers -double sqrt(); -double r_sqrt(x) real *x; -#else #undef abs #include <math.h> -double r_sqrt(real *x) -#endif +double +r_sqrt (real * x) { -return( sqrt(*x) ); + return (sqrt (*x)); } diff --git a/contrib/libf2c/libF77/r_tan.c b/contrib/libf2c/libF77/r_tan.c index fc0009e..4ef913e 100644 --- a/contrib/libf2c/libF77/r_tan.c +++ b/contrib/libf2c/libF77/r_tan.c @@ -1,13 +1,9 @@ #include "f2c.h" -#ifdef KR_headers -double tan(); -double r_tan(x) real *x; -#else #undef abs #include <math.h> -double r_tan(real *x) -#endif +double +r_tan (real * x) { -return( tan(*x) ); + return (tan (*x)); } diff --git a/contrib/libf2c/libF77/r_tanh.c b/contrib/libf2c/libF77/r_tanh.c index 818c6a8..6f2552a 100644 --- a/contrib/libf2c/libF77/r_tanh.c +++ b/contrib/libf2c/libF77/r_tanh.c @@ -1,13 +1,9 @@ #include "f2c.h" -#ifdef KR_headers -double tanh(); -double r_tanh(x) real *x; -#else #undef abs #include <math.h> -double r_tanh(real *x) -#endif +double +r_tanh (real * x) { -return( tanh(*x) ); + return (tanh (*x)); } diff --git a/contrib/libf2c/libF77/s_cat.c b/contrib/libf2c/libF77/s_cat.c index 77a94f6..4e8da1b 100644 --- a/contrib/libf2c/libF77/s_cat.c +++ b/contrib/libf2c/libF77/s_cat.c @@ -7,69 +7,64 @@ #ifndef NO_OVERWRITE #include <stdio.h> #undef abs -#ifdef KR_headers - extern char *F77_aloc(); - extern void free(); - extern void G77_exit_0 (); -#else #undef min #undef max #include <stdlib.h> - extern char *F77_aloc(ftnlen, char*); -#endif +extern char *F77_aloc (ftnlen, char *); #include <string.h> #endif /* NO_OVERWRITE */ - VOID -#ifdef KR_headers -s_cat(lp, rpp, rnp, np, ll) char *lp, *rpp[]; ftnint rnp[], *np; ftnlen ll; -#else -s_cat(char *lp, char *rpp[], ftnint rnp[], ftnint *np, ftnlen ll) -#endif +void +s_cat (char *lp, char *rpp[], ftnint rnp[], ftnint * np, ftnlen ll) { - ftnlen i, nc; - char *rp; - ftnlen n = *np; + ftnlen i, nc; + char *rp; + ftnlen n = *np; #ifndef NO_OVERWRITE - ftnlen L, m; - char *lp0, *lp1; + 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; + 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++ = ' '; + 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); - } + if (lp0) + { + memcpy (lp0, lp1, L); + free (lp1); + } #endif - } +} diff --git a/contrib/libf2c/libF77/s_cmp.c b/contrib/libf2c/libF77/s_cmp.c index 1e052f2..5b43c9e 100644 --- a/contrib/libf2c/libF77/s_cmp.c +++ b/contrib/libf2c/libF77/s_cmp.c @@ -2,43 +2,48 @@ /* compare two strings */ -#ifdef KR_headers -integer s_cmp(a0, b0, la, lb) char *a0, *b0; ftnlen la, lb; -#else -integer s_cmp(char *a0, char *b0, ftnlen la, ftnlen lb) -#endif +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; + 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; } + if (la <= lb) + { + while (a < aend) + if (*a != *b) + return (*a - *b); + else + { + ++a; + ++b; + } - while(b < bend) - if(*b != ' ') - return( ' ' - *b ); - else ++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); + else + { + while (b < bend) + if (*a == *b) + { + ++a; + ++b; + } + else + return (*a - *b); + while (a < aend) + if (*a != ' ') + return (*a - ' '); + else + ++a; + } + return (0); } diff --git a/contrib/libf2c/libF77/s_copy.c b/contrib/libf2c/libF77/s_copy.c index d167351..a91071e 100644 --- a/contrib/libf2c/libF77/s_copy.c +++ b/contrib/libf2c/libF77/s_copy.c @@ -8,44 +8,43 @@ /* assign strings: a = b */ -#ifdef KR_headers -VOID s_copy(a, b, la, lb) register char *a, *b; ftnlen la, lb; -#else -void s_copy(register char *a, register char *b, ftnlen la, ftnlen lb) -#endif +void +s_copy (register char *a, register char *b, ftnlen la, ftnlen lb) { - register char *aend, *bend; + register char *aend, *bend; - aend = a + la; + aend = a + la; - if(la <= lb) + if (la <= lb) #ifndef NO_OVERWRITE - if (a <= b || a >= b + la) + if (a <= b || a >= b + la) #endif - while(a < aend) - *a++ = *b++; + while (a < aend) + *a++ = *b++; #ifndef NO_OVERWRITE - else - for(b += la; a < aend; ) - *--aend = *--b; + else + for (b += la; a < aend;) + *--aend = *--b; #endif - else { - bend = b + lb; + else + { + bend = b + lb; #ifndef NO_OVERWRITE - if (a <= b || a >= bend) + if (a <= b || a >= bend) #endif - while(b < bend) - *a++ = *b++; + while (b < bend) + *a++ = *b++; #ifndef NO_OVERWRITE - else { - a += lb; - while(b < bend) - *--a = *--bend; - a += lb; - } -#endif - while(a < aend) - *a++ = ' '; - } + else + { + a += lb; + while (b < bend) + *--a = *--bend; + a += lb; } +#endif + while (a < aend) + *a++ = ' '; + } +} diff --git a/contrib/libf2c/libF77/s_paus.c b/contrib/libf2c/libF77/s_paus.c index a7733a5..7969136 100644 --- a/contrib/libf2c/libF77/s_paus.c +++ b/contrib/libf2c/libF77/s_paus.c @@ -3,86 +3,69 @@ #define PAUSESIG 15 #include "signal1.h" -#ifdef KR_headers -#define Void /* void */ -#define Int /* int */ -#else -#define Void void -#define Int int #undef abs #undef min #undef max #include <stdlib.h> -#ifdef __cplusplus -extern "C" { -#endif -extern int getpid(void), isatty(int), pause(void); -#endif +extern int getpid (void), isatty (int), pause (void); -extern VOID f_exit(Void); +extern void f_exit (void); - static VOID -waitpause(Sigarg) -{ Use_Sigarg; - return; - } +static void +waitpause (Sigarg) +{ + Use_Sigarg; + return; +} - static VOID -#ifdef KR_headers -s_1paus(fin) FILE *fin; -#else -s_1paus(FILE *fin) -#endif +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"); + 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(); + f_exit (); #endif - exit(0); - } - } + exit (0); + } +} - int -#ifdef KR_headers -s_paus(s, n) char *s; ftnlen n; -#else -s_paus(char *s, ftnlen n) -#endif +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 { + 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 */ -#ifdef __cplusplus + 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 */ } diff --git a/contrib/libf2c/libF77/s_rnge.c b/contrib/libf2c/libF77/s_rnge.c index 766889b..6c054c7 100644 --- a/contrib/libf2c/libF77/s_rnge.c +++ b/contrib/libf2c/libF77/s_rnge.c @@ -3,24 +3,20 @@ /* called when a subscript is out of range */ -#ifdef KR_headers -extern VOID sig_die(); -integer s_rnge(varn, offset, procn, line) char *varn, *procn; ftnint offset, line; -#else -extern VOID sig_die(char*,int); -integer s_rnge(char *varn, ftnint offset, char *procn, ftnint line) -#endif +extern void sig_die (char *, int); +integer +s_rnge (char *varn, ftnint offset, char *procn, ftnint line) { -register int i; + 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 */ + 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 */ } diff --git a/contrib/libf2c/libF77/s_stop.c b/contrib/libf2c/libF77/s_stop.c index 975edb7..571416b 100644 --- a/contrib/libf2c/libF77/s_stop.c +++ b/contrib/libf2c/libF77/s_stop.c @@ -1,42 +1,32 @@ #include <stdio.h> #include "f2c.h" -#ifdef KR_headers -extern void f_exit(); -VOID s_stop(s, n) char *s; ftnlen n; -#else #undef abs #undef min #undef max #include <stdlib.h> -#ifdef __cplusplus -extern "C" { -#endif -void f_exit(void); +void f_exit (void); -int s_stop(char *s, ftnlen n) -#endif +int +s_stop (char *s, ftnlen n) { -int i; + int i; -if(n > 0) - { - fprintf(stderr, "STOP "); - for(i = 0; i<n ; ++i) - putc(*s++, stderr); - fprintf(stderr, " statement executed\n"); - } + 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(); + f_exit (); #endif -exit(0); + 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 */ + return 0; /* NOT REACHED */ } -#ifdef __cplusplus -} -#endif diff --git a/contrib/libf2c/libF77/setarg.c b/contrib/libf2c/libF77/setarg.c index 929860a..4951574 100644 --- a/contrib/libf2c/libF77/setarg.c +++ b/contrib/libf2c/libF77/setarg.c @@ -1,29 +1,14 @@ /* Set up the global argc/argv info for use by getarg_, iargc_, and g77's inlined intrinsic equivalents. */ -#ifndef KR_headers -#undef VOID #include <stdlib.h> -#endif - -#ifndef VOID -#define VOID void -#endif int f__xargc; char **f__xargv; -#ifdef __cplusplus - } -#endif - - void -#ifdef KR_headers -f_setarg(argc, argv) int argc; char **argv; -#else -f_setarg(int argc, char **argv) -#endif +void +f_setarg (int argc, char **argv) { -f__xargc = argc; -f__xargv = argv; + f__xargc = argc; + f__xargv = argv; } diff --git a/contrib/libf2c/libF77/setsig.c b/contrib/libf2c/libF77/setsig.c index 8fde2fa..96826be 100644 --- a/contrib/libf2c/libF77/setsig.c +++ b/contrib/libf2c/libF77/setsig.c @@ -9,93 +9,78 @@ #endif #endif -#ifndef KR_headers -#undef VOID #include <stdlib.h> -#endif - -#ifndef VOID -#define VOID void -#endif - -#ifdef __cplusplus -extern "C" { -#endif -#ifdef KR_headers -extern VOID sig_die(); -#define Int /* int */ -#else -extern void sig_die(char*, int); -#define Int int -#endif +extern void sig_die (char *, int); -static VOID sigfdie(Sigarg) +static void +sigfdie (Sigarg) { -Use_Sigarg; -sig_die("Floating Exception", 1); + Use_Sigarg; + sig_die ("Floating Exception", 1); } -static VOID sigidie(Sigarg) +static void +sigidie (Sigarg) { -Use_Sigarg; -sig_die("IOT Trap", 1); + Use_Sigarg; + sig_die ("IOT Trap", 1); } #ifdef SIGQUIT -static VOID sigqdie(Sigarg) +static void +sigqdie (Sigarg) { -Use_Sigarg; -sig_die("Quit signal", 1); + Use_Sigarg; + sig_die ("Quit signal", 1); } #endif -static VOID sigindie(Sigarg) +static void +sigindie (Sigarg) { -Use_Sigarg; -sig_die("Interrupt", 0); + Use_Sigarg; + sig_die ("Interrupt", 0); } -static VOID sigtdie(Sigarg) +static void +sigtdie (Sigarg) { -Use_Sigarg; -sig_die("Killed", 0); + Use_Sigarg; + sig_die ("Killed", 0); } #ifdef SIGTRAP -static VOID sigtrdie(Sigarg) +static void +sigtrdie (Sigarg) { -Use_Sigarg; -sig_die("Trace trap", 1); + Use_Sigarg; + sig_die ("Trace trap", 1); } #endif -#ifdef __cplusplus - } -#endif - - void -f_setsig() +void +f_setsig () { -signal1(SIGFPE, sigfdie); /* ignore underflow, enable overflow */ + signal1 (SIGFPE, sigfdie); /* ignore underflow, enable overflow */ #ifdef SIGIOT -signal1(SIGIOT, sigidie); + signal1 (SIGIOT, sigidie); #endif #ifdef SIGTRAP -signal1(SIGTRAP, sigtrdie); + signal1 (SIGTRAP, sigtrdie); #endif #ifdef SIGQUIT -if(signal1(SIGQUIT,sigqdie) == SIG_IGN) - signal1(SIGQUIT, SIG_IGN); + if (signal1 (SIGQUIT, sigqdie) == SIG_IGN) + signal1 (SIGQUIT, SIG_IGN); #endif -if(signal1(SIGINT, sigindie) == SIG_IGN) - signal1(SIGINT, SIG_IGN); -signal1(SIGTERM,sigtdie); + if (signal1 (SIGINT, sigindie) == SIG_IGN) + signal1 (SIGINT, SIG_IGN); + signal1 (SIGTERM, sigtdie); #ifdef pdp11 - ldfps(01200); /* detect overflow as an exception */ + ldfps (01200); /* detect overflow as an exception */ #endif } diff --git a/contrib/libf2c/libF77/sig_die.c b/contrib/libf2c/libF77/sig_die.c index bebb1e7..622462e 100644 --- a/contrib/libf2c/libF77/sig_die.c +++ b/contrib/libf2c/libF77/sig_die.c @@ -7,39 +7,31 @@ #endif #endif -#ifdef KR_headers -void sig_die(s, kill) register char *s; int kill; -#else #include <stdlib.h> -#ifdef __cplusplus -extern "C" { -#endif - extern void f_exit(void); +extern void f_exit (void); -void sig_die(register char *s, int kill) -#endif +void +sig_die (register char *s, int kill) { - /* print error message, then clear buffers */ - fprintf(stderr, "%s\n", s); + /* print error message, then clear buffers */ + fprintf (stderr, "%s\n", s); - if(kill) - { - fflush(stderr); - f_exit(); - fflush(stderr); - /* now get a core */ + if (kill) + { + fflush (stderr); + f_exit (); + fflush (stderr); + /* now get a core */ #ifdef SIGIOT - signal(SIGIOT, SIG_DFL); + signal (SIGIOT, SIG_DFL); #endif - abort(); - } - else { + abort (); + } + else + { #ifdef NO_ONEXIT - f_exit(); + f_exit (); #endif - exit(1); - } - } -#ifdef __cplusplus + exit (1); + } } -#endif diff --git a/contrib/libf2c/libF77/signal1.h0 b/contrib/libf2c/libF77/signal1.h0 index a383774..0e2fcf2 100644 --- a/contrib/libf2c/libF77/signal1.h0 +++ b/contrib/libf2c/libF77/signal1.h0 @@ -11,25 +11,16 @@ #define Sigret_t void #endif #ifndef Sigarg_t -#ifdef KR_headers -#define Sigarg_t -#else #define Sigarg_t int -#endif -#endif /*Sigarg_t*/ +#endif /*Sigarg_t */ -#ifdef USE_SIG_PF /* compile with -DUSE_SIG_PF under IRIX */ +#ifdef USE_SIG_PF /* compile with -DUSE_SIG_PF under IRIX */ #define sig_pf SIG_PF #else -typedef Sigret_t (*sig_pf)(Sigarg_t); +typedef Sigret_t (*sig_pf) (Sigarg_t); #endif #define signal1(a,b) signal(a,(sig_pf)b) -#ifdef __cplusplus -#define Sigarg ... -#define Use_Sigarg -#else -#define Sigarg Int n +#define Sigarg int n #define Use_Sigarg n = n /* shut up compiler warning */ -#endif diff --git a/contrib/libf2c/libF77/signal_.c b/contrib/libf2c/libF77/signal_.c index b0d7ce6..f67831c 100644 --- a/contrib/libf2c/libF77/signal_.c +++ b/contrib/libf2c/libF77/signal_.c @@ -1,16 +1,11 @@ #include "f2c.h" #include "signal1.h" -#ifdef KR_headers void * -G77_signal_0 (sigp, proc) integer *sigp; sig_pf proc; -#else -void * -G77_signal_0 (integer *sigp, sig_pf proc) -#endif +G77_signal_0 (integer * sigp, sig_pf proc) { - int sig; - sig = (int)*sigp; + int sig; + sig = (int) *sigp; - return (void *) signal(sig, proc); - } + return (void *) signal (sig, proc); +} diff --git a/contrib/libf2c/libF77/system_.c b/contrib/libf2c/libF77/system_.c index ed024a1..dbbd0be 100644 --- a/contrib/libf2c/libF77/system_.c +++ b/contrib/libf2c/libF77/system_.c @@ -2,35 +2,27 @@ #include "f2c.h" -#ifdef KR_headers -extern char *F77_aloc(); - - integer -G77_system_0 (s, n) register char *s; ftnlen n; -#else #undef abs #undef min #undef max #include <stdlib.h> -extern char *F77_aloc(ftnlen, char*); +extern char *F77_aloc (ftnlen, char *); - integer +integer G77_system_0 (register char *s, ftnlen n) -#endif { - char buff0[256], *buff; - register char *bp, *blast; - integer rv; + char buff0[256], *buff; + register char *bp, *blast; + integer rv; - buff = bp = n < sizeof(buff0) - ? buff0 : F77_aloc(n+1, "system_"); - blast = bp + n; + 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; - } + while (bp < blast && *s) + *bp++ = *s++; + *bp = 0; + rv = system (buff); + if (buff != buff0) + free (buff); + return rv; +} diff --git a/contrib/libf2c/libF77/z_abs.c b/contrib/libf2c/libF77/z_abs.c index 7e67ad2..2419c0e 100644 --- a/contrib/libf2c/libF77/z_abs.c +++ b/contrib/libf2c/libF77/z_abs.c @@ -1,12 +1,8 @@ #include "f2c.h" -#ifdef KR_headers -double f__cabs(); -double z_abs(z) doublecomplex *z; -#else -double f__cabs(double, double); -double z_abs(doublecomplex *z) -#endif +double f__cabs (double, double); +double +z_abs (doublecomplex * z) { -return( f__cabs( z->r, z->i ) ); + return (f__cabs (z->r, z->i)); } diff --git a/contrib/libf2c/libF77/z_cos.c b/contrib/libf2c/libF77/z_cos.c index 2d4a24d..0f4cd71 100644 --- a/contrib/libf2c/libF77/z_cos.c +++ b/contrib/libf2c/libF77/z_cos.c @@ -1,15 +1,11 @@ #include "f2c.h" -#ifdef KR_headers -double sin(), cos(), sinh(), cosh(); -VOID z_cos(r, z) doublecomplex *r, *z; -#else #undef abs #include "math.h" -void z_cos(doublecomplex *r, doublecomplex *z) -#endif +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); - } + double zi = z->i, zr = z->r; + r->r = cos (zr) * cosh (zi); + r->i = -sin (zr) * sinh (zi); +} diff --git a/contrib/libf2c/libF77/z_div.c b/contrib/libf2c/libF77/z_div.c index e14df32..a5fc527 100644 --- a/contrib/libf2c/libF77/z_div.c +++ b/contrib/libf2c/libF77/z_div.c @@ -1,44 +1,41 @@ #include "f2c.h" -#ifdef KR_headers -extern VOID sig_die(); -VOID z_div(c, a, b) doublecomplex *a, *b, *c; -#else -extern void sig_die(char*, int); -void z_div(doublecomplex *c, doublecomplex *a, doublecomplex *b) -#endif +extern void sig_die (char *, int); +void +z_div (doublecomplex * c, doublecomplex * a, doublecomplex * b) { - double ratio, den; - double abr, abi, cr; + 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) { + 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; + if (a->i != 0 || a->r != 0) + abi = 1.; + c->i = c->r = abi / abr; + return; #else - sig_die("complex division by zero", 1); + 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; } + 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; +} diff --git a/contrib/libf2c/libF77/z_exp.c b/contrib/libf2c/libF77/z_exp.c index ecf8429..16f51e7 100644 --- a/contrib/libf2c/libF77/z_exp.c +++ b/contrib/libf2c/libF77/z_exp.c @@ -1,17 +1,13 @@ #include "f2c.h" -#ifdef KR_headers -double exp(), cos(), sin(); -VOID z_exp(r, z) doublecomplex *r, *z; -#else #undef abs #include "math.h" -void z_exp(doublecomplex *r, doublecomplex *z) -#endif +void +z_exp (doublecomplex * r, doublecomplex * z) { - double expx, zi = z->i; + double expx, zi = z->i; - expx = exp(z->r); - r->r = expx * cos(zi); - r->i = expx * sin(zi); - } + expx = exp (z->r); + r->r = expx * cos (zi); + r->i = expx * sin (zi); +} diff --git a/contrib/libf2c/libF77/z_log.c b/contrib/libf2c/libF77/z_log.c index 9dcc7f7..f56b12e 100644 --- a/contrib/libf2c/libF77/z_log.c +++ b/contrib/libf2c/libF77/z_log.c @@ -1,63 +1,59 @@ #include "f2c.h" -#ifdef KR_headers -double log(), f__cabs(), atan2(); -VOID z_log(r, z) doublecomplex *r, *z; -#else #undef abs #include "math.h" -extern double f__cabs(double, double); -void z_log(doublecomplex *r, doublecomplex *z) -#endif +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; + double s, s0, t, t2, u, v; + double zi = z->i, zr = z->r; - r->i = atan2(zi, zr); + r->i = atan2 (zi, zr); #ifdef Pre20000310 - r->r = log( f__cabs( zr, zi ) ); + 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 { + 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 + 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 +} diff --git a/contrib/libf2c/libF77/z_sin.c b/contrib/libf2c/libF77/z_sin.c index e24caff..8cb44cf 100644 --- a/contrib/libf2c/libF77/z_sin.c +++ b/contrib/libf2c/libF77/z_sin.c @@ -1,15 +1,11 @@ #include "f2c.h" -#ifdef KR_headers -double sin(), cos(), sinh(), cosh(); -VOID z_sin(r, z) doublecomplex *r, *z; -#else #undef abs #include "math.h" -void z_sin(doublecomplex *r, doublecomplex *z) -#endif +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); - } + double zi = z->i, zr = z->r; + r->r = sin (zr) * cosh (zi); + r->i = cos (zr) * sinh (zi); +} diff --git a/contrib/libf2c/libF77/z_sqrt.c b/contrib/libf2c/libF77/z_sqrt.c index c04e8f0..954c2fa 100644 --- a/contrib/libf2c/libF77/z_sqrt.c +++ b/contrib/libf2c/libF77/z_sqrt.c @@ -1,29 +1,25 @@ #include "f2c.h" -#ifdef KR_headers -double sqrt(), f__cabs(); -VOID z_sqrt(r, z) doublecomplex *r, *z; -#else #undef abs #include "math.h" -extern double f__cabs(double, double); -void z_sqrt(doublecomplex *r, doublecomplex *z) -#endif +extern double f__cabs (double, double); +void +z_sqrt (doublecomplex * r, doublecomplex * z) { - double mag, zi = z->i, zr = z->r; + 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; - } - } + 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; + } +} diff --git a/contrib/libf2c/libI77/Makefile.in b/contrib/libf2c/libI77/Makefile.in index ff0d8e1..d6abf70 100644 --- a/contrib/libf2c/libI77/Makefile.in +++ b/contrib/libf2c/libI77/Makefile.in @@ -38,12 +38,12 @@ CFLAGS = @CFLAGS@ CPPFLAGS = @CPPFLAGS@ @SET_MAKE@ -SHELL = /bin/sh +SHELL = @SHELL@ #### End of system configuration section. #### ALL_CFLAGS = -I. -I$(srcdir) -I$(G2C_H_DIR) -I$(F2C_H_DIR) $(CPPFLAGS) \ - $(DEFS) $(CFLAGS) + $(DEFS) $(WARN_CFLAGS) $(CFLAGS) .SUFFIXES: .SUFFIXES: .c .lo diff --git a/contrib/libf2c/libI77/Version.c b/contrib/libf2c/libI77/Version.c index 06177cf..f6b3d5d 100644 --- a/contrib/libf2c/libI77/Version.c +++ b/contrib/libf2c/libI77/Version.c @@ -1,9 +1,4 @@ -static char junk[] = "\n@(#) LIBI77 VERSION pjw,dmg-mods 20001205\n"; - -/* -*/ - -char __G77_LIBI77_VERSION__[] = "3.2.2 20030205 (release)"; +const char __LIBI77_VERSION__[] = "@(#) LIBI77 VERSION pjw,dmg-mods 20001205\n"; /* 2.01 $ format added @@ -324,17 +319,6 @@ wrtfmt.c: /* 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. */ - -#include <stdio.h> - -void -g77__ivers__ () -{ - fprintf (stderr, "__G77_LIBI77_VERSION__: %s", __G77_LIBI77_VERSION__); - fputs (junk, stderr); -} diff --git a/contrib/libf2c/libI77/backspace.c b/contrib/libf2c/libI77/backspace.c index 8489239..c31e711 100644 --- a/contrib/libf2c/libI77/backspace.c +++ b/contrib/libf2c/libI77/backspace.c @@ -2,73 +2,80 @@ #include <sys/types.h> #include "f2c.h" #include "fio.h" -#ifdef KR_headers -integer f_back(a) alist *a; -#else -integer f_back(alist *a) -#endif -{ unit *b; - off_t v, w, x, y, z; - uiolen n; - FILE *f; +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); - } + 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); + 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; } - 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; + err (a->aerr, (EOF), "backspace"); + } +break2: + FSEEK (f, z, SEEK_SET); + return 0; } diff --git a/contrib/libf2c/libI77/close.c b/contrib/libf2c/libI77/close.c index 79a3493..769c569 100644 --- a/contrib/libf2c/libI77/close.c +++ b/contrib/libf2c/libI77/close.c @@ -1,9 +1,7 @@ #include "config.h" #include "f2c.h" #include "fio.h" -#ifdef KR_headers -integer f_clos(a) cllist *a; -#else + #undef abs #undef min #undef max @@ -16,91 +14,88 @@ integer f_clos(a) cllist *a; #if defined (MSDOS) && !defined (GO32) #include "io.h" #else -#ifdef __cplusplus -extern "C" int unlink(const char*); -#else -extern int unlink(const char*); -#endif +extern int unlink (const char *); #endif #endif -integer f_clos(cllist *a) -#endif -{ unit *b; +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); + 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); } - void -#ifdef KR_headers -f_exit() -#else -f_exit(void) -#endif -{ 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); - } + 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); } - int -#ifdef KR_headers -G77_flush_0 () -#else + +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) -#endif -{ 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; +{ + 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; } diff --git a/contrib/libf2c/libI77/configure b/contrib/libf2c/libI77/configure index e064fba..ee4c73a 100755 --- a/contrib/libf2c/libI77/configure +++ b/contrib/libf2c/libI77/configure @@ -28,6 +28,7 @@ program_suffix=NONE program_transform_name=s,x,x, silent= site= +sitefile= srcdir= target=NONE verbose= @@ -142,6 +143,7 @@ Configuration: --help print this message --no-create do not create output files --quiet, --silent do not print \`checking...' messages + --site-file=FILE use FILE as the site file --version print the version of autoconf that created configure Directory and file names: --prefix=PREFIX install architecture-independent files in PREFIX @@ -312,6 +314,11 @@ EOF -site=* | --site=* | --sit=*) site="$ac_optarg" ;; + -site-file | --site-file | --site-fil | --site-fi | --site-f) + ac_prev=sitefile ;; + -site-file=* | --site-file=* | --site-fil=* | --site-fi=* | --site-f=*) + sitefile="$ac_optarg" ;; + -srcdir | --srcdir | --srcdi | --srcd | --src | --sr) ac_prev=srcdir ;; -srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*) @@ -477,12 +484,16 @@ fi srcdir=`echo "${srcdir}" | sed 's%\([^/]\)/*$%\1%'` # Prefer explicitly selected file to automatically selected ones. -if test -z "$CONFIG_SITE"; then - if test "x$prefix" != xNONE; then - CONFIG_SITE="$prefix/share/config.site $prefix/etc/config.site" - else - CONFIG_SITE="$ac_default_prefix/share/config.site $ac_default_prefix/etc/config.site" +if test -z "$sitefile"; then + if test -z "$CONFIG_SITE"; then + if test "x$prefix" != xNONE; then + CONFIG_SITE="$prefix/share/config.site $prefix/etc/config.site" + else + CONFIG_SITE="$ac_default_prefix/share/config.site $ac_default_prefix/etc/config.site" + fi fi +else + CONFIG_SITE="$sitefile" fi for ac_site_file in $CONFIG_SITE; do if test -r "$ac_site_file"; then @@ -523,32 +534,6 @@ fi -# These defines are necessary to get 64-bit file size support. - -cat >> confdefs.h <<\EOF -#define _XOPEN_SOURCE 500L -EOF - -# The following is needed by irix6.2 so that struct timeval is declared. -cat >> confdefs.h <<\EOF -#define _XOPEN_SOURCE_EXTENDED 1 -EOF - -# The following is needed by Solaris2.5.1 so that struct timeval is declared. -cat >> confdefs.h <<\EOF -#define __EXTENSIONS__ 1 -EOF - -cat >> confdefs.h <<\EOF -#define _FILE_OFFSET_BITS 64 -EOF - -cat >> confdefs.h <<\EOF -#define _LARGEFILE_SOURCE 1 -EOF - - - # For g77 we'll set CC to point at the built gcc, but this will get it into @@ -556,7 +541,7 @@ EOF # Extract the first word of "gcc", so it can be a program name with args. set dummy gcc; ac_word=$2 echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 -echo "configure:560: checking for $ac_word" >&5 +echo "configure:545: checking for $ac_word" >&5 if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else @@ -586,7 +571,7 @@ if test -z "$CC"; then # Extract the first word of "cc", so it can be a program name with args. set dummy cc; ac_word=$2 echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 -echo "configure:590: checking for $ac_word" >&5 +echo "configure:575: checking for $ac_word" >&5 if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else @@ -637,7 +622,7 @@ fi # Extract the first word of "cl", so it can be a program name with args. set dummy cl; ac_word=$2 echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 -echo "configure:641: checking for $ac_word" >&5 +echo "configure:626: checking for $ac_word" >&5 if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else @@ -670,7 +655,7 @@ fi echo $ac_n "checking whether we are using GNU C""... $ac_c" 1>&6 -echo "configure:674: checking whether we are using GNU C" >&5 +echo "configure:659: checking whether we are using GNU C" >&5 if eval "test \"`echo '$''{'ac_cv_prog_gcc'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else @@ -679,7 +664,7 @@ else yes; #endif EOF -if { ac_try='${CC-cc} -E conftest.c'; { (eval echo configure:683: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }; } | egrep yes >/dev/null 2>&1; then +if { ac_try='${CC-cc} -E conftest.c'; { (eval echo configure:668: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }; } | egrep yes >/dev/null 2>&1; then ac_cv_prog_gcc=yes else ac_cv_prog_gcc=no @@ -698,7 +683,7 @@ ac_test_CFLAGS="${CFLAGS+set}" ac_save_CFLAGS="$CFLAGS" CFLAGS= echo $ac_n "checking whether ${CC-cc} accepts -g""... $ac_c" 1>&6 -echo "configure:702: checking whether ${CC-cc} accepts -g" >&5 +echo "configure:687: checking whether ${CC-cc} accepts -g" >&5 if eval "test \"`echo '$''{'ac_cv_prog_cc_g'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else @@ -730,13 +715,64 @@ else fi +# 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. +echo $ac_n "checking whether _XOPEN_SOURCE may be defined""... $ac_c" 1>&6 +echo "configure:723: checking whether _XOPEN_SOURCE may be defined" >&5 +cat > conftest.$ac_ext <<EOF +#line 725 "configure" +#include "confdefs.h" +#define _XOPEN_SOURCE 600L +#include <unistd.h> +int main() { + +; return 0; } +EOF +if { (eval echo configure:733: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then + rm -rf conftest* + may_use_xopen_source=yes +else + echo "configure: failed program was:" >&5 + cat conftest.$ac_ext >&5 + rm -rf conftest* + may_use_xopen_source=no +fi +rm -f conftest* +echo "$ac_t""$may_use_xopen_source" 1>&6 +if test $may_use_xopen_source = yes; then + cat >> confdefs.h <<\EOF +#define _XOPEN_SOURCE 600L +EOF + + # The following is needed by irix6.2 so that struct timeval is declared. + cat >> confdefs.h <<\EOF +#define _XOPEN_SOURCE_EXTENDED 1 +EOF + + # The following is needed by Solaris2.5.1 so that struct timeval is declared. + cat >> confdefs.h <<\EOF +#define __EXTENSIONS__ 1 +EOF + + cat >> confdefs.h <<\EOF +#define _FILE_OFFSET_BITS 64 +EOF + + cat >> confdefs.h <<\EOF +#define _LARGEFILE_SOURCE 1 +EOF + +fi + + LIBTOOL='$(SHELL) ../libtool' test "$AR" || AR=ar echo $ac_n "checking whether ${MAKE-make} sets \${MAKE}""... $ac_c" 1>&6 -echo "configure:740: checking whether ${MAKE-make} sets \${MAKE}" >&5 +echo "configure:776: checking whether ${MAKE-make} sets \${MAKE}" >&5 set dummy ${MAKE-make}; ac_make=`echo "$2" | sed 'y%./+-%__p_%'` if eval "test \"`echo '$''{'ac_cv_prog_make_${ac_make}_set'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 @@ -766,7 +802,7 @@ fi # Sanity check for the cross-compilation case: echo $ac_n "checking how to run the C preprocessor""... $ac_c" 1>&6 -echo "configure:770: checking how to run the C preprocessor" >&5 +echo "configure:806: checking how to run the C preprocessor" >&5 # On Suns, sometimes $CPP names a directory. if test -n "$CPP" && test -d "$CPP"; then CPP= @@ -781,13 +817,13 @@ else # On the NeXT, cc -E runs the code through the compiler's parser, # not just through cpp. cat > conftest.$ac_ext <<EOF -#line 785 "configure" +#line 821 "configure" #include "confdefs.h" #include <assert.h> Syntax Error EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:791: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:827: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then : @@ -798,13 +834,13 @@ else rm -rf conftest* CPP="${CC-cc} -E -traditional-cpp" cat > conftest.$ac_ext <<EOF -#line 802 "configure" +#line 838 "configure" #include "confdefs.h" #include <assert.h> Syntax Error EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:808: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:844: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then : @@ -815,13 +851,13 @@ else rm -rf conftest* CPP="${CC-cc} -nologo -E" cat > conftest.$ac_ext <<EOF -#line 819 "configure" +#line 855 "configure" #include "confdefs.h" #include <assert.h> Syntax Error EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:825: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:861: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then : @@ -847,17 +883,17 @@ echo "$ac_t""$CPP" 1>&6 ac_safe=`echo "stdio.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for stdio.h""... $ac_c" 1>&6 -echo "configure:851: checking for stdio.h" >&5 +echo "configure:887: checking for stdio.h" >&5 if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <<EOF -#line 856 "configure" +#line 892 "configure" #include "confdefs.h" #include <stdio.h> EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:861: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:897: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then rm -rf conftest* @@ -885,12 +921,12 @@ fi echo $ac_n "checking for ANSI C header files""... $ac_c" 1>&6 -echo "configure:889: checking for ANSI C header files" >&5 +echo "configure:925: checking for ANSI C header files" >&5 if eval "test \"`echo '$''{'ac_cv_header_stdc'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <<EOF -#line 894 "configure" +#line 930 "configure" #include "confdefs.h" #include <stdlib.h> #include <stdarg.h> @@ -898,7 +934,7 @@ else #include <float.h> EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:902: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:938: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then rm -rf conftest* @@ -915,7 +951,7 @@ rm -f conftest* if test $ac_cv_header_stdc = yes; then # SunOS 4.x string.h does not declare mem*, contrary to ANSI. cat > conftest.$ac_ext <<EOF -#line 919 "configure" +#line 955 "configure" #include "confdefs.h" #include <string.h> EOF @@ -933,7 +969,7 @@ fi if test $ac_cv_header_stdc = yes; then # ISC 2.0.2 stdlib.h does not declare free, contrary to ANSI. cat > conftest.$ac_ext <<EOF -#line 937 "configure" +#line 973 "configure" #include "confdefs.h" #include <stdlib.h> EOF @@ -954,7 +990,7 @@ if test "$cross_compiling" = yes; then : else cat > conftest.$ac_ext <<EOF -#line 958 "configure" +#line 994 "configure" #include "confdefs.h" #include <ctype.h> #define ISLOWER(c) ('a' <= (c) && (c) <= 'z') @@ -965,7 +1001,7 @@ if (XOR (islower (i), ISLOWER (i)) || toupper (i) != TOUPPER (i)) exit(2); exit (0); } EOF -if { (eval echo configure:969: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null +if { (eval echo configure:1005: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null then : else @@ -988,14 +1024,13 @@ EOF fi - echo $ac_n "checking for posix""... $ac_c" 1>&6 -echo "configure:994: checking for posix" >&5 +echo "configure:1029: checking for posix" >&5 if eval "test \"`echo '$''{'g77_cv_header_posix'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <<EOF -#line 999 "configure" +#line 1034 "configure" #include "confdefs.h" #include <sys/types.h> #include <unistd.h> @@ -1021,12 +1056,12 @@ echo "$ac_t""$g77_cv_header_posix" 1>&6 # We can rely on the GNU library being posix-ish. I guess checking the # header isn't actually like checking the functions, though... echo $ac_n "checking for GNU library""... $ac_c" 1>&6 -echo "configure:1025: checking for GNU library" >&5 +echo "configure:1060: checking for GNU library" >&5 if eval "test \"`echo '$''{'g77_cv_lib_gnu'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <<EOF -#line 1030 "configure" +#line 1065 "configure" #include "confdefs.h" #include <stdio.h> #ifdef __GNU_LIBRARY__ @@ -1050,12 +1085,12 @@ echo "$ac_t""$g77_cv_lib_gnu" 1>&6 # Apparently cygwin needs to be special-cased. echo $ac_n "checking for cyg\`win'32""... $ac_c" 1>&6 -echo "configure:1054: checking for cyg\`win'32" >&5 +echo "configure:1089: checking for cyg\`win'32" >&5 if eval "test \"`echo '$''{'g77_cv_sys_cygwin32'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <<EOF -#line 1059 "configure" +#line 1094 "configure" #include "confdefs.h" #ifdef __CYGWIN32__ yes @@ -1078,12 +1113,12 @@ echo "$ac_t""$g77_cv_sys_cygwin32" 1>&6 # ditto for mingw32. echo $ac_n "checking for mingw32""... $ac_c" 1>&6 -echo "configure:1082: checking for mingw32" >&5 +echo "configure:1117: checking for mingw32" >&5 if eval "test \"`echo '$''{'g77_cv_sys_mingw32'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <<EOF -#line 1087 "configure" +#line 1122 "configure" #include "confdefs.h" #ifdef __MINGW32__ yes @@ -1106,12 +1141,12 @@ echo "$ac_t""$g77_cv_sys_mingw32" 1>&6 echo $ac_n "checking for working const""... $ac_c" 1>&6 -echo "configure:1110: checking for working const" >&5 +echo "configure:1145: checking for working const" >&5 if eval "test \"`echo '$''{'ac_cv_c_const'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <<EOF -#line 1115 "configure" +#line 1150 "configure" #include "confdefs.h" int main() { @@ -1160,7 +1195,7 @@ ccp = (char const *const *) p; ; return 0; } EOF -if { (eval echo configure:1164: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then +if { (eval echo configure:1199: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* ac_cv_c_const=yes else @@ -1181,12 +1216,12 @@ EOF fi echo $ac_n "checking for size_t""... $ac_c" 1>&6 -echo "configure:1185: checking for size_t" >&5 +echo "configure:1220: checking for size_t" >&5 if eval "test \"`echo '$''{'ac_cv_type_size_t'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <<EOF -#line 1190 "configure" +#line 1225 "configure" #include "confdefs.h" #include <sys/types.h> #if STDC_HEADERS @@ -1219,12 +1254,12 @@ fi # Apparently positive result on cygwin loses re. NON_UNIX_STDIO # (as of cygwin b18). Likewise on mingw. echo $ac_n "checking for fstat""... $ac_c" 1>&6 -echo "configure:1223: checking for fstat" >&5 +echo "configure:1258: checking for fstat" >&5 if eval "test \"`echo '$''{'ac_cv_func_fstat'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <<EOF -#line 1228 "configure" +#line 1263 "configure" #include "confdefs.h" /* System header to define __stub macros and hopefully few prototypes, which can conflict with char fstat(); below. */ @@ -1247,7 +1282,7 @@ fstat(); ; return 0; } EOF -if { (eval echo configure:1251: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:1286: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_func_fstat=yes" else @@ -1267,7 +1302,7 @@ else fi echo $ac_n "checking need for NON_UNIX_STDIO""... $ac_c" 1>&6 -echo "configure:1271: checking need for NON_UNIX_STDIO" >&5 +echo "configure:1306: checking need for NON_UNIX_STDIO" >&5 if test $g77_cv_sys_cygwin32 = yes \ || test $g77_cv_sys_mingw32 = yes \ || test $ac_cv_func_fstat = no; then @@ -1283,12 +1318,12 @@ fi for ac_func in fseeko do echo $ac_n "checking for $ac_func""... $ac_c" 1>&6 -echo "configure:1287: checking for $ac_func" >&5 +echo "configure:1322: checking for $ac_func" >&5 if eval "test \"`echo '$''{'ac_cv_func_$ac_func'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <<EOF -#line 1292 "configure" +#line 1327 "configure" #include "confdefs.h" /* System header to define __stub macros and hopefully few prototypes, which can conflict with char $ac_func(); below. */ @@ -1311,7 +1346,7 @@ $ac_func(); ; return 0; } EOF -if { (eval echo configure:1315: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:1350: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_func_$ac_func=yes" else @@ -1338,12 +1373,12 @@ done for ac_func in ftello do echo $ac_n "checking for $ac_func""... $ac_c" 1>&6 -echo "configure:1342: checking for $ac_func" >&5 +echo "configure:1377: checking for $ac_func" >&5 if eval "test \"`echo '$''{'ac_cv_func_$ac_func'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <<EOF -#line 1347 "configure" +#line 1382 "configure" #include "confdefs.h" /* System header to define __stub macros and hopefully few prototypes, which can conflict with char $ac_func(); below. */ @@ -1366,7 +1401,7 @@ $ac_func(); ; return 0; } EOF -if { (eval echo configure:1370: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:1405: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_func_$ac_func=yes" else @@ -1393,12 +1428,12 @@ done for ac_func in ftruncate do echo $ac_n "checking for $ac_func""... $ac_c" 1>&6 -echo "configure:1397: checking for $ac_func" >&5 +echo "configure:1432: checking for $ac_func" >&5 if eval "test \"`echo '$''{'ac_cv_func_$ac_func'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <<EOF -#line 1402 "configure" +#line 1437 "configure" #include "confdefs.h" /* System header to define __stub macros and hopefully few prototypes, which can conflict with char $ac_func(); below. */ @@ -1421,7 +1456,7 @@ $ac_func(); ; return 0; } EOF -if { (eval echo configure:1425: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:1460: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_func_$ac_func=yes" else @@ -1448,12 +1483,12 @@ done for ac_func in mkstemp do echo $ac_n "checking for $ac_func""... $ac_c" 1>&6 -echo "configure:1452: checking for $ac_func" >&5 +echo "configure:1487: checking for $ac_func" >&5 if eval "test \"`echo '$''{'ac_cv_func_$ac_func'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <<EOF -#line 1457 "configure" +#line 1492 "configure" #include "confdefs.h" /* System header to define __stub macros and hopefully few prototypes, which can conflict with char $ac_func(); below. */ @@ -1476,7 +1511,7 @@ $ac_func(); ; return 0; } EOF -if { (eval echo configure:1480: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:1515: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_func_$ac_func=yes" else @@ -1503,12 +1538,12 @@ done for ac_func in tempnam do echo $ac_n "checking for $ac_func""... $ac_c" 1>&6 -echo "configure:1507: checking for $ac_func" >&5 +echo "configure:1542: checking for $ac_func" >&5 if eval "test \"`echo '$''{'ac_cv_func_$ac_func'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <<EOF -#line 1512 "configure" +#line 1547 "configure" #include "confdefs.h" /* System header to define __stub macros and hopefully few prototypes, which can conflict with char $ac_func(); below. */ @@ -1531,7 +1566,7 @@ $ac_func(); ; return 0; } EOF -if { (eval echo configure:1535: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:1570: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_func_$ac_func=yes" else @@ -1558,12 +1593,12 @@ done for ac_func in tmpnam do echo $ac_n "checking for $ac_func""... $ac_c" 1>&6 -echo "configure:1562: checking for $ac_func" >&5 +echo "configure:1597: checking for $ac_func" >&5 if eval "test \"`echo '$''{'ac_cv_func_$ac_func'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <<EOF -#line 1567 "configure" +#line 1602 "configure" #include "confdefs.h" /* System header to define __stub macros and hopefully few prototypes, which can conflict with char $ac_func(); below. */ @@ -1586,7 +1621,7 @@ $ac_func(); ; return 0; } EOF -if { (eval echo configure:1590: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:1625: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_func_$ac_func=yes" else @@ -1616,19 +1651,19 @@ done # However, on my sunos4/gcc setup unistd.h leads us wrongly to believe # we're posix-conformant, so always do the test. echo $ac_n "checking for ansi/posix sprintf result""... $ac_c" 1>&6 -echo "configure:1620: checking for ansi/posix sprintf result" >&5 +echo "configure:1655: checking for ansi/posix sprintf result" >&5 if test "$cross_compiling" = yes; then g77_cv_sys_sprintf_ansi=no else cat > conftest.$ac_ext <<EOF -#line 1625 "configure" +#line 1660 "configure" #include "confdefs.h" #include <stdio.h> /* does sprintf return the number of chars transferred? */ main () {char foo[2]; (sprintf(foo, "1") == 1) ? exit(0) : exit(1);} EOF -if { (eval echo configure:1632: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null +if { (eval echo configure:1667: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null then g77_cv_sys_sprintf_ansi=yes else @@ -1659,9 +1694,9 @@ fi # define NON_ANSI_RW_MODES on unix (can't hurt) echo $ac_n "checking NON_ANSI_RW_MODES""... $ac_c" 1>&6 -echo "configure:1663: checking NON_ANSI_RW_MODES" >&5 +echo "configure:1698: checking NON_ANSI_RW_MODES" >&5 cat > conftest.$ac_ext <<EOF -#line 1665 "configure" +#line 1700 "configure" #include "confdefs.h" #ifdef unix yes @@ -1706,12 +1741,12 @@ EOF echo $ac_n "checking for off_t""... $ac_c" 1>&6 -echo "configure:1710: checking for off_t" >&5 +echo "configure:1745: checking for off_t" >&5 if eval "test \"`echo '$''{'ac_cv_type_off_t'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <<EOF -#line 1715 "configure" +#line 1750 "configure" #include "confdefs.h" #include <sys/types.h> #if STDC_HEADERS diff --git a/contrib/libf2c/libI77/configure.in b/contrib/libf2c/libI77/configure.in index 988a8e5..83f98fb 100644 --- a/contrib/libf2c/libI77/configure.in +++ b/contrib/libf2c/libI77/configure.in @@ -23,18 +23,6 @@ AC_PREREQ(2.12.1) AC_INIT(ftell_.c) AC_CONFIG_HEADER(config.h) -# These defines are necessary to get 64-bit file size support. - -AC_DEFINE(_XOPEN_SOURCE, 500L, [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.]) - -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],[]) @@ -43,6 +31,27 @@ define([AC_PROG_CC_WORKS],[]) # 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) @@ -62,17 +71,6 @@ the G77 runtime system. If necessary, install gcc now with \`LANGUAGES=c', then the target library, then build with \`LANGUAGES=f77'.])]) AC_HEADER_STDC -dnl We could do this if we didn't know we were using gcc -dnl AC_MSG_CHECKING(for prototype-savvy compiler) -dnl AC_CACHE_VAL(g77_cv_sys_proto, -dnl [AC_TRY_LINK(, -dnl dnl looks screwy because TRY_LINK expects a function body -dnl [return 0;} int foo (int * bar) {], -dnl g77_cv_sys_proto=yes, -dnl [g77_cv_sys_proto=no -dnl AC_DEFINE(KR_headers)])]) -dnl AC_MSG_RESULT($g77_cv_sys_proto) - AC_MSG_CHECKING(for posix) AC_CACHE_VAL(g77_cv_header_posix, AC_EGREP_CPP(yes, diff --git a/contrib/libf2c/libI77/dfe.c b/contrib/libf2c/libI77/dfe.c index 18edabc..5ce0b4c 100644 --- a/contrib/libf2c/libI77/dfe.c +++ b/contrib/libf2c/libI77/dfe.c @@ -3,145 +3,154 @@ #include "fio.h" #include "fmt.h" -y_rsk(Void) +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; + 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; } -y_getc(Void) + +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"); + 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) +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); + 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) +static int +y_err (void) { - err(f__elist->cierr, 110, "dfe"); + err (f__elist->cierr, 110, "dfe"); } - static int -y_newrec(Void) +static int +y_newrec (void) { - y_rev(); - f__hiwater = f__cursor = 0; - return(1); + y_rev (); + f__hiwater = f__cursor = 0; + return (1); } -#ifdef KR_headers -c_dfe(a) cilist *a; -#else -c_dfe(cilist *a) -#endif +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); + 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); } -#ifdef KR_headers -integer s_rdfe(a) cilist *a; -#else -integer s_rdfe(cilist *a) -#endif + +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); + 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); } -#ifdef KR_headers -integer s_wdfe(a) cilist *a; -#else -integer s_wdfe(cilist *a) -#endif + +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); + 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) + +integer +e_rdfe (void) { - f__init = 1; - en_fio(); - return(0); + f__init = 1; + en_fio (); + return (0); } -integer e_wdfe(Void) +integer +e_wdfe (void) { - f__init = 1; - return en_fio(); + f__init = 1; + return en_fio (); } diff --git a/contrib/libf2c/libI77/dolio.c b/contrib/libf2c/libI77/dolio.c index 1e0c377..e50e900 100644 --- a/contrib/libf2c/libI77/dolio.c +++ b/contrib/libf2c/libI77/dolio.c @@ -1,21 +1,10 @@ #include "config.h" #include "f2c.h" -#ifdef __cplusplus -extern "C" { -#endif -#ifdef KR_headers -extern int (*f__lioproc)(); +extern int (*f__lioproc) (ftnint *, char *, ftnlen, ftnint); -integer do_lio(type,number,ptr,len) ftnint *number,*type; char *ptr; ftnlen len; -#else -extern int (*f__lioproc)(ftnint*, char*, ftnlen, ftnint); - -integer do_lio(ftnint *type, ftnint *number, char *ptr, ftnlen len) -#endif +integer +do_lio (ftnint * type, ftnint * number, char *ptr, ftnlen len) { - return((*f__lioproc)(number,ptr,len,*type)); + return ((*f__lioproc) (number, ptr, len, *type)); } -#ifdef __cplusplus - } -#endif diff --git a/contrib/libf2c/libI77/due.c b/contrib/libf2c/libI77/due.c index f7d6941..7c6a801 100644 --- a/contrib/libf2c/libI77/due.c +++ b/contrib/libf2c/libI77/due.c @@ -2,75 +2,79 @@ #include "f2c.h" #include "fio.h" -#ifdef KR_headers -c_due(a) cilist *a; -#else -c_due(cilist *a) -#endif +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); + 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); } -#ifdef KR_headers -integer s_rdue(a) cilist *a; -#else -integer s_rdue(cilist *a) -#endif + +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); + 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); } -#ifdef KR_headers -integer s_wdue(a) cilist *a; -#else -integer s_wdue(cilist *a) -#endif + +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); + 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) + +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); + 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) + +integer +e_wdue (void) { - f__init = 1; + f__init = 1; #ifdef ALWAYS_FLUSH - if (fflush(f__cf)) - err(f__elist->cierr,errno,"write end"); + if (fflush (f__cf)) + err (f__elist->cierr, errno, "write end"); #endif - return(e_rdue()); + return (e_rdue ()); } diff --git a/contrib/libf2c/libI77/endfile.c b/contrib/libf2c/libI77/endfile.c index 4c5a9dd..513f210 100644 --- a/contrib/libf2c/libI77/endfile.c +++ b/contrib/libf2c/libI77/endfile.c @@ -5,136 +5,126 @@ #include <sys/types.h> #include <unistd.h> -#ifdef KR_headers -extern char *strcpy(); -extern FILE *tmpfile(); -#else #undef abs #undef min #undef max #include <stdlib.h> #include <string.h> -#endif extern char *f__r_mode[], *f__w_mode[]; -#ifdef KR_headers -integer f_end(a) alist *a; -#else -integer f_end(alist *a) -#endif +integer +f_end (alist * a) { - unit *b; - FILE *tf; + 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); + 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 -#ifdef KR_headers -copy(from, len, to) FILE *from, *to; register long len; -#else -copy(FILE *from, register long len, FILE *to) -#endif +static int +copy (FILE * from, register long len, FILE * to) { - int len1; - char buf[BUFSIZ]; + 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; - } + 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 -#ifdef KR_headers -t_runc(a) alist *a; -#else -t_runc(alist *a) -#endif +int +t_runc (alist * a) { - off_t loc, len; - unit *b; - int rc; - FILE *bf; + off_t loc, len; + unit *b; + int rc; + FILE *bf; #ifndef HAVE_FTRUNCATE - FILE *tf; + 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); + 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())) { + 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: + 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; + 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; - } + 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); + 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); + 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; - } + if (rc) + err (a->aerr, 111, "endfile"); + return 0; +} diff --git a/contrib/libf2c/libI77/err.c b/contrib/libf2c/libI77/err.c index 1c21f19..1a204e8 100644 --- a/contrib/libf2c/libI77/err.c +++ b/contrib/libf2c/libI77/err.c @@ -6,285 +6,274 @@ #include <sys/stat.h> #endif #include "f2c.h" -#ifdef KR_headers -extern char *malloc(); -#else #undef abs #undef min #undef max #include <stdlib.h> -#endif #include "fio.h" -#include "fmt.h" /* for struct syl */ +#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; +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 */ -#ifdef KR_headers -int (*f__doed)(),(*f__doned)(); -int (*f__doend)(),(*f__donewrec)(),(*f__dorevert)(); -int (*f__getn)(); /* for formatted input */ -void (*f__putn)(); /* for formatted output */ -#else -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); -#endif -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*/ +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 */ +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) -#ifdef KR_headers -f__canseek(f) FILE *f; /*SYSDEP*/ -#else -f__canseek(FILE *f) /*SYSDEP*/ -#endif +int +f__canseek (FILE * f) /*SYSDEP*/ { #ifdef NON_UNIX_STDIO - return !isatty(fileno(f)); + return !isatty (fileno (f)); #else - struct stat x; + struct stat x; - if (fstat(fileno(f),&x) < 0) - return(0); + 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); + 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); + 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); + /* 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? + Help ! How does fstat work on this system ? #endif #endif - return(0); /* who knows what it is? */ + return (0); /* who knows what it is? */ #endif } - void -#ifdef KR_headers -f__fatal(n,s) char *s; -#else -f__fatal(int n, char *s) -#endif +void +f__fatal (int n, char *s) { - static int dead = 0; + 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); + 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 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); + 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; +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; + 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; } -#ifdef KR_headers -f__nowreading(x) unit *x; -#else -f__nowreading(unit *x) -#endif + +int +f__nowreading (unit * x) { - off_t loc; - int ufmt, urw; - extern char *f__r_mode[], *f__w_mode[]; + 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; + 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; } -#ifdef KR_headers -f__nowwriting(x) unit *x; -#else -f__nowwriting(unit *x) -#endif + +int +f__nowwriting (unit * x) { - off_t loc; - int ufmt; - extern char *f__w_mode[]; + 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; + 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 -#ifdef KR_headers -err__fl(f, m, s) int f, m; char *s; -#else -err__fl(int f, int m, char *s) -#endif +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; - } + if (!f) + f__fatal (m, s); + if (f__doend) + (*f__doend) (); + f__init &= ~2; + return errno = m; +} diff --git a/contrib/libf2c/libI77/f2ch.add b/contrib/libf2c/libI77/f2ch.add index a2acc17..04b13e8 100644 --- a/contrib/libf2c/libI77/f2ch.add +++ b/contrib/libf2c/libI77/f2ch.add @@ -2,161 +2,162 @@ 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 *); - } +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 diff --git a/contrib/libf2c/libI77/fio.h b/contrib/libf2c/libI77/fio.h index 8c6d274..7734f0c 100644 --- a/contrib/libf2c/libI77/fio.h +++ b/contrib/libf2c/libI77/fio.h @@ -39,65 +39,48 @@ typedef long uiolen; /*units*/ typedef struct -{ FILE *ufd; /*0=unconnected*/ - char *ufnm; +{ + FILE *ufd; /*0=unconnected */ + char *ufnm; #if !(defined (MSDOS) && !defined (GO32)) - long uinode; - int udev; + 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; + 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; -#undef Void -#ifdef KR_headers -#define Void /*void*/ -extern int (*f__getn)(); /* for formatted input */ -extern void (*f__putn)(); /* for formatted output */ -extern void x_putc(); -extern long f__inode(); -extern VOID sig_die(); -extern int (*f__donewrec)(), t_putc(), x_wSL(); -extern int c_sfe(), err__fl(), xrd_SL(), f__putbuf(); -#else -#define Void void -#ifdef __cplusplus -extern "C" { -#endif -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); -#ifdef __cplusplus - } -#endif -#endif -extern int (*f__doend)(Void); -extern FILE *f__cf; /*current file*/ -extern unit *f__curunit; /*current unit*/ +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) @@ -105,9 +88,9 @@ extern unit f__units[]; /*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 */ +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 diff --git a/contrib/libf2c/libI77/fmt.c b/contrib/libf2c/libI77/fmt.c index 793dceb..fa9b73c 100644 --- a/contrib/libf2c/libI77/fmt.c +++ b/contrib/libf2c/libI77/fmt.c @@ -17,528 +17,586 @@ #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*/ +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; +int f__parenlvl, f__pc, f__revloc; - static -#ifdef KR_headers -char *ap_end(s) char *s; -#else -char *ap_end(char *s) -#endif -{ 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 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 -#ifdef KR_headers -op_gen(a,b,c,d) -#else -op_gen(int a, int b, int c, int d) -#endif -{ 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 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++); } -#ifdef KR_headers -static char *f_list(); -static char *gt_num(s,n,n1) char *s; int *n, n1; -#else -static char *f_list(char*); -static char *gt_num(char *s, int *n, int n1) -#endif -{ 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++; +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(f__cnt==0) { - if (!n1) - s = 0; - *n=n1; - } - else *n=m; - return(s); + 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 -#ifdef KR_headers -char *f_s(s,curloc) char *s; -#else -char *f_s(char *s, int curloc) -#endif +static char * +f_s (char *s, int curloc) { - skip(s); - if(*s++!='(') + 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') { - return(NULL); + x = SS; + s++; } - if(f__parenlvl++ ==1) f__revloc=curloc; - if(op_gen(RET1,curloc,0,0)<0 || - (s=f_list(s))==NULL) + else if (*(s + 1) == 'p' || *(s + 1) == 'P') { - return(NULL); + x = SP; + s++; } - return(s); -} - - static -#ifdef KR_headers -ne_d(s,p) char *s,**p; -#else -ne_d(char *s, char **p) -#endif -{ int n,x,sign=0; - struct syl *sp; - switch(*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 ':': (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; + return (0); case 'P': - case 'p': (void) op_gen(P,1,0,0); break; + 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; } - s++; - *p=s; - return(1); + 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 -#ifdef KR_headers -e_d(s,p) char *s,**p; -#else -e_d(char *s, char **p) -#endif -{ 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++) +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))) { - 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; + bad: + *p = 0; + return 1; } - if(found==0) - { f__pc--; /*unSTACK*/ - *p=sv; - return(0); + if (w == 0) + break; + if (*s == '.') + { + if (!(s = gt_num (s + 1, &d, 0))) + goto bad; } - *p=s; - return(1); + 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 -#ifdef KR_headers -char *i_tem(s) char *s; -#else -char *i_tem(char *s) -#endif -{ 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 * +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 -#ifdef KR_headers -char *f_list(s) char *s; -#else -char *f_list(char *s) -#endif +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); - } + 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); + } + return (NULL); } -#ifdef KR_headers -pars_f(s) char *s; -#else -pars_f(char *s) -#endif +int +pars_f (char *s) { - char *e; + 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. */ + 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; + 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); + for (f__fmtlen = 0; + ((*s != ')') || (--level > 0)) + && (*s != '\0') && (f__fmtlen < 80); ++s, ++f__fmtlen) + { + if (*s == '(') + ++level; } - f__fmtlen = e - s; - return(0); + 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; +int f__cnt[STKSZ], f__ret[STKSZ], f__cp, f__rp; flag f__workdone, f__nonl; - static -#ifdef KR_headers -type_f(n) -#else -type_f(int n) -#endif +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); - } + 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); + } } -#ifdef KR_headers -integer do_fio(number,ptr,len) ftnint *number; ftnlen len; char *ptr; -#else -integer do_fio(ftnint *number, char *ptr, ftnlen len) -#endif -{ struct syl *p; - int n,i; - for(i=0;i<*number;i++,ptr+=len) - { -loop: switch(type_f((p= &f__syl[f__pc])->op)) +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"); + 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; + 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; + 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; + f__cnt[++f__cp] = p->p1; + f__pc++; + goto loop; case RET1: - f__ret[++f__rp]=p->p1; - f__pc++; - goto loop; + 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; + 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; + 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; + if (ptr == NULL) + return ((*f__doend) ()); + f__pc++; + goto loop; case NONL: - f__nonl = 1; - f__pc++; - goto loop; + f__nonl = 1; + f__pc++; + goto loop; case S: case SS: - f__cplus=0; - f__pc++; - goto loop; + 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; + 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; + f__cblank = 0; + f__pc++; + goto loop; case BZ: - f__cblank=1; - f__pc++; - goto loop; - } + f__cblank = 1; + f__pc++; + goto loop; } - return(0); + } + return (0); } -en_fio(Void) -{ ftnint one=1; - return(do_fio(&one,(char *)NULL,(ftnint)0)); + +int +en_fio (void) +{ + ftnint one = 1; + return (do_fio (&one, (char *) NULL, (ftnint) 0)); } - VOID -fmt_bg(Void) + +void +fmt_bg (void) { - f__workdone=f__cp=f__rp=f__pc=f__cursor=0; - f__cnt[0]=f__ret[0]=0; + f__workdone = f__cp = f__rp = f__pc = f__cursor = 0; + f__cnt[0] = f__ret[0] = 0; } diff --git a/contrib/libf2c/libI77/fmt.h b/contrib/libf2c/libI77/fmt.h index 6197e76..bcd84cee 100644 --- a/contrib/libf2c/libI77/fmt.h +++ b/contrib/libf2c/libI77/fmt.h @@ -1,8 +1,14 @@ struct syl -{ int op; - int p1; - union { int i[2]; char *s;} p2; - }; +{ + int op; + int p1; + union + { + int i[2]; + char *s; + } + p2; +}; #define RET1 1 #define REVERT 2 #define GOTO 3 @@ -39,45 +45,34 @@ struct syl #define OM 34 #define Z 35 #define ZM 36 -extern int f__pc,f__parenlvl,f__revloc; +extern int f__pc, f__parenlvl, f__revloc; typedef union -{ real pf; - doublereal pd; -} ufloat; +{ + real pf; + doublereal pd; +} +ufloat; typedef union -{ short is; -#ifndef KR_headers - signed -#endif - char ic; - integer il; +{ + short is; + signed char ic; + integer il; #ifdef Allow_TYQUAD - longint ili; -#endif -} Uint; -#ifdef KR_headers -extern int (*f__doed)(),(*f__doned)(); -extern int (*f__dorevert)(); -extern int rd_ed(),rd_ned(); -extern int w_ed(),w_ned(); -#else -#ifdef __cplusplus -extern "C" { -#endif -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); -#ifdef __cplusplus - } + longint ili; #endif -#endif -extern flag f__cblank,f__cplus,f__workdone, f__nonl; +} +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; @@ -94,8 +89,4 @@ extern int f__cursor; #define TYQUAD 14 #endif -#ifdef KR_headers -extern char *f__icvt(); -#else -extern char *f__icvt(longint, int*, int*, int); -#endif +extern char *f__icvt (longint, int *, int *, int); diff --git a/contrib/libf2c/libI77/fmtlib.c b/contrib/libf2c/libI77/fmtlib.c index 69c0d9b..3d2a299 100644 --- a/contrib/libf2c/libI77/fmtlib.c +++ b/contrib/libf2c/libI77/fmtlib.c @@ -10,37 +10,37 @@ #define ulongint unsigned long #endif -#ifdef KR_headers -char *f__icvt(value,ndigit,sign, base) longint value; int *ndigit,*sign; - register int base; -#else -char *f__icvt(longint value, int *ndigit, int *sign, int base) -#endif +char * +f__icvt (longint value, int *ndigit, int *sign, int base) { - static char buf[MAXINTLENGTH+1]; - register int i; - ulongint uvalue; + 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]; - } + 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]; +} diff --git a/contrib/libf2c/libI77/fp.h b/contrib/libf2c/libI77/fp.h index 40743d7..2b78ef9 100644 --- a/contrib/libf2c/libI77/fp.h +++ b/contrib/libf2c/libI77/fp.h @@ -4,7 +4,7 @@ /* FMAX = max number of nonzero digits passed to atof() */ /* EXPMAX = 10^EXPMAXDIGS - 1 = largest allowed exponent absolute value */ -#ifdef V10 /* Research Tenth-Edition Unix */ +#ifdef V10 /* Research Tenth-Edition Unix */ #include "local.h" #endif diff --git a/contrib/libf2c/libI77/ftell_.c b/contrib/libf2c/libI77/ftell_.c index 250a0cc..6315342 100644 --- a/contrib/libf2c/libI77/ftell_.c +++ b/contrib/libf2c/libI77/ftell_.c @@ -2,46 +2,34 @@ #include "f2c.h" #include "fio.h" - static FILE * -#ifdef KR_headers -unit_chk(Unit, who) integer Unit; char *who; -#else -unit_chk(integer Unit, char *who) -#endif +static FILE * +unit_chk (integer Unit, char *who) { - if (Unit >= MXUNIT || Unit < 0) - f__fatal(101, who); - return f__units[Unit].ufd; - } + if (Unit >= MXUNIT || Unit < 0) + f__fatal (101, who); + return f__units[Unit].ufd; +} - integer -#ifdef KR_headers -G77_ftell_0 (Unit) integer *Unit; -#else -G77_ftell_0 (integer *Unit) -#endif +integer +G77_ftell_0 (integer * Unit) { - FILE *f; - return (f = unit_chk(*Unit, "ftell")) ? (integer) FTELL(f) : -1L; - } + FILE *f; + return (f = unit_chk (*Unit, "ftell")) ? (integer) FTELL (f) : -1L; +} - integer -#ifdef KR_headers -G77_fseek_0 (Unit, offset, xwhence) integer *Unit, *offset, *xwhence; -#else -G77_fseek_0 (integer *Unit, integer *offset, integer *xwhence) -#endif +integer +G77_fseek_0 (integer * Unit, integer * offset, integer * xwhence) { - FILE *f; - int w = (int)*xwhence; + FILE *f; + int w = (int) *xwhence; #ifdef SEEK_SET - static int wohin[3] = { SEEK_SET, SEEK_CUR, SEEK_END }; + static int wohin[3] = { SEEK_SET, SEEK_CUR, SEEK_END }; #endif - if (w < 0 || w > 2) - w = 0; + if (w < 0 || w > 2) + w = 0; #ifdef SEEK_SET - w = wohin[w]; + w = wohin[w]; #endif - return !(f = unit_chk(*Unit, "fseek")) - || FSEEK(f, (off_t) *offset, w) ? 1 : 0; - } + return !(f = unit_chk (*Unit, "fseek")) + || FSEEK (f, (off_t) * offset, w) ? 1 : 0; +} diff --git a/contrib/libf2c/libI77/iio.c b/contrib/libf2c/libI77/iio.c index 931f15a..940cbf8 100644 --- a/contrib/libf2c/libI77/iio.c +++ b/contrib/libf2c/libI77/iio.c @@ -6,149 +6,152 @@ char *f__icend; extern icilist *f__svic; int f__icnum; extern int f__hiwater; -z_getc(Void) +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'; + 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 -#ifdef KR_headers -z_putc(c) -#else -z_putc(int c) -#endif +void +z_putc (int c) { - if (f__icptr < f__icend && f__recpos++ < f__svic->icirlen) - *f__icptr++ = c; + if (f__recpos++ < f__svic->icirlen && f__icptr < f__icend) + *f__icptr++ = c; } -z_rnew(Void) +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; + 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) +static int +z_endp (void) { - (*f__donewrec)(); - return 0; - } + (*f__donewrec) (); + return 0; +} -#ifdef KR_headers -c_si(a) icilist *a; -#else -c_si(icilist *a) -#endif +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); + 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) +int +iw_rev (void) { - if(f__workdone) - z_endp(); - f__hiwater = f__recpos = f__cursor = 0; - return(f__workdone=0); - } + if (f__workdone) + z_endp (); + f__hiwater = f__recpos = f__cursor = 0; + return (f__workdone = 0); +} -#ifdef KR_headers -integer s_rsfi(a) icilist *a; -#else -integer s_rsfi(icilist *a) -#endif -{ 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); +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); } -z_wnew(Void) +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; + 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; } -#ifdef KR_headers -integer s_wsfi(a) icilist *a; -#else -integer s_wsfi(icilist *a) -#endif -{ 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 +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_rsfi (void) +{ + int n; + f__init &= ~2; + n = en_fio (); + f__fmtbuf = NULL; + return (n); } -integer e_wsfi(Void) + +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; + 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; } diff --git a/contrib/libf2c/libI77/ilnw.c b/contrib/libf2c/libI77/ilnw.c index 58fca0d..0a92a0c 100644 --- a/contrib/libf2c/libI77/ilnw.c +++ b/contrib/libf2c/libI77/ilnw.c @@ -6,78 +6,65 @@ extern char *f__icptr; extern char *f__icend; extern icilist *f__svic; extern int f__icnum; -#ifdef KR_headers -extern void z_putc(); -#else -extern void z_putc(int); -#endif +extern void z_putc (int); - static int -z_wSL(Void) +static int +z_wSL (void) { - while(f__recpos < f__svic->icirlen) - z_putc(' '); - return z_rnew(); - } + while (f__recpos < f__svic->icirlen) + z_putc (' '); + return z_rnew (); +} - static void -#ifdef KR_headers -c_liw(a) icilist *a; -#else -c_liw(icilist *a) -#endif +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; - } + 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 -#ifdef KR_headers -s_wsni(a) icilist *a; -#else -s_wsni(icilist *a) -#endif +integer +s_wsni (icilist * a) { - cilist ca; + 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; - } + if (f__init != 1) + f_init (); + f__init = 3; + c_liw (a); + ca.cifmt = a->icifmt; + x_wsne (&ca); + z_wSL (); + return 0; +} - integer -#ifdef KR_headers -s_wsli(a) icilist *a; -#else -s_wsli(icilist *a) -#endif +integer +s_wsli (icilist * a) { - if(f__init != 1) f_init(); - f__init = 3; - f__lioproc = l_write; - c_liw(a); - return(0); - } + if (f__init != 1) + f_init (); + f__init = 3; + f__lioproc = l_write; + c_liw (a); + return (0); +} -integer e_wsli(Void) +integer +e_wsli (void) { - f__init = 1; - z_wSL(); - return(0); - } + f__init = 1; + z_wSL (); + return (0); +} diff --git a/contrib/libf2c/libI77/inquire.c b/contrib/libf2c/libI77/inquire.c index 5c5575a..dae869c 100644 --- a/contrib/libf2c/libI77/inquire.c +++ b/contrib/libf2c/libI77/inquire.c @@ -2,108 +2,142 @@ #include "f2c.h" #include "fio.h" #include <string.h> -#ifdef KR_headers -integer f_inqu(a) inlist *a; -#else #if defined (MSDOS) && !defined (GO32) #undef abs #undef min #undef max #include "io.h" #endif -integer f_inqu(inlist *a) -#endif -{ 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); +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; - } + 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; - } + 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 + else { - byfile=0; - if(a->inunit<MXUNIT && a->inunit>=0) - { - p= &f__units[a->inunit]; - } - else - { - p=NULL; - } + 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); + } + 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); } diff --git a/contrib/libf2c/libI77/lio.h b/contrib/libf2c/libI77/lio.h index 0123172..4e17115 100644 --- a/contrib/libf2c/libI77/lio.h +++ b/contrib/libf2c/libI77/lio.h @@ -43,32 +43,22 @@ typedef union { - char flchar; - short flshort; - ftnint flint; + signed char flchar; + short flshort; + ftnint flint; #ifdef Allow_TYQUAD - longint fllongint; + longint fllongint; #endif - real flreal; - doublereal fldouble; -} flex; + real flreal; + doublereal fldouble; +} +flex; extern int f__scale; -#ifdef KR_headers -extern int (*f__lioproc)(), (*l_getc)(), (*l_ungetc)(); -extern int l_read(), l_write(); -#else -#ifdef __cplusplus -extern "C" { -#endif -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); -#ifdef __cplusplus - } -#endif -#endif +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; diff --git a/contrib/libf2c/libI77/lread.c b/contrib/libf2c/libI77/lread.c index d546efc..b926367 100644 --- a/contrib/libf2c/libI77/lread.c +++ b/contrib/libf2c/libI77/lread.c @@ -13,28 +13,19 @@ extern int f__fmtlen; #ifdef Allow_TYQUAD static longint f__llx; -static int quad_read; #endif -#ifdef KR_headers -extern double atof(); -extern char *malloc(), *realloc(); -int (*f__lioproc)(), (*l_getc)(), (*l_ungetc)(); -#else #undef abs #undef min #undef max #include <stdlib.h> -#endif #include "fmt.h" #include "lio.h" #include "fp.h" -#ifndef KR_headers -int (*f__lioproc)(ftnint*, char*, ftnlen, ftnint), (*l_getc)(void), - (*l_ungetc)(int,FILE*); -#endif +int (*f__lioproc) (ftnint *, char *, ftnlen, ftnint), (*l_getc) (void), + (*l_ungetc) (int, FILE *); int l_eof; @@ -50,749 +41,805 @@ int l_eof; #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 +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 -#ifdef KR_headers -un_getc(x,f__cf) int x; FILE *f__cf; -#else -un_getc(int x, FILE *f__cf) -#endif -{ return ungetc(x,f__cf); } +static int +un_getc (int x, FILE * f__cf) +{ + return ungetc (x, f__cf); +} #else #define un_getc ungetc -#ifdef KR_headers - extern int ungetc(); -#else -extern int ungetc(int, FILE*); /* for systems with a buggy stdio.h */ -#endif +extern int ungetc (int, FILE *); /* for systems with a buggy stdio.h */ #endif -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); +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) + +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); + 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; +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);} +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 -#ifdef KR_headers -l_R(poststar, reqint) int poststar, reqint; -#else -l_R(int poststar, int reqint) -#endif +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; - } + 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; + f__llx = 0; #endif - f__ltype = 0; - exp = 0; - havestar = 0; + 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 == '.') { + 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"); + 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)) { + 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"); + 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; + GETC (ch); + if (issign (ch)) + { + signonly: + if (ch == '-') + se = 1; + GETC (ch); + } + if (!isdigit (ch)) + { + bad: + errfl (f__elist->cierr, 112, "exponent field"); } - static int -#ifdef KR_headers -rd_count(ch) register int ch; -#else -rd_count(register int ch) + 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; - } + 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!='(') +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')) { - 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); - } + Ungetc (ch, f__cf); + f__lquit = 2; + 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"); + 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"); } - 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; + 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; + f__llx = 0; #endif - nml_read = nml_save; - return(0); + nml_read = nml_save; + return (0); } - static char nmLbuf[256], *nmL_next; - static int (*nmL_getc_save)(Void); -#ifdef KR_headers - static int (*nmL_ungetc_save)(/* int, FILE* */); -#else - static int (*nmL_ungetc_save)(int, FILE*); -#endif +static char nmLbuf[256], *nmL_next; +static int (*nmL_getc_save) (void); +static int (*nmL_ungetc_save) (int, FILE *); - static int -nmL_getc(Void) +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)(); - } + int rv; + if ((rv = *nmL_next++)) + return rv; + l_getc = nmL_getc_save; + l_ungetc = nmL_ungetc_save; + return (*l_getc) (); +} - static int -#ifdef KR_headers -nmL_ungetc(x, f) int x; FILE *f; -#else -nmL_ungetc(int x, FILE *f) -#endif +static int +nmL_ungetc (int x, FILE * f) { - f = f; /* banish non-use warning */ - return *--nmL_next = x; - } + f = f; /* banish non-use warning */ + return *--nmL_next = x; +} - static int -#ifdef KR_headers -Lfinish(ch, dot, rvp) int ch, dot, *rvp; -#else -Lfinish(int ch, int dot, int *rvp) -#endif +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; + 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) +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)) + 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) { - 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); + (void) Ungetc (ch, f__cf); + return (0); } - sawdot = 0; - if(ch == '.') { - sawdot = 1; - GETC(ch); - } - switch(ch) + if (nml_read > 1) { - 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"); + Ungetc (ch, f__cf); + f__lquit = 2; + return 0; } - f__ltype=TYLONG; - while(!issep(GETC(ch)) && ch!=EOF); - (void) Ungetc(ch, f__cf); - 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; +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) { - no_quote: - errfl(f__elist->cierr,112, - "undelimited character string"); - } + if (nml_read) + goto no_quote; #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; + 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 - 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) + if (nml_read) { - 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); + 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; + } } -} -#ifdef KR_headers -c_le(a) cilist *a; -#else -c_le(cilist *a) + } + 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); + 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); } -#ifdef KR_headers -l_read(number,ptr,len,type) ftnint *number,type; char *ptr; ftnlen len; -#else -l_read(ftnint *number, char *ptr, ftnlen len, ftnint type) -#endif + +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++) + 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) { - 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) + f__ltype = 0; + for (;;) + { + GETC (ch); + switch (ch) { - case TYINT1: - case TYSHORT: - case TYLONG: + 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; + ERR (l_R (0, 1)); + break; #endif - case TYREAL: - case TYDREAL: - ERR(l_R(0,0)); - break; + case TYREAL: + case TYDREAL: + ERR (l_R (0, 0)); + break; #ifdef TYQUAD - case TYQUAD: - n = l_R(0,2); - if (n) - return n; - break; + 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; + 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; + 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++; + 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; } - return(0); + bump: + if (f__lcount > 0) + f__lcount--; + ptr += len; + if (nml_read) + nml_read++; + } + return (0); #undef Ptr } -#ifdef KR_headers -integer s_rsle(a) cilist *a; -#else -integer s_rsle(cilist *a) -#endif + +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); + 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); } diff --git a/contrib/libf2c/libI77/lwrite.c b/contrib/libf2c/libI77/lwrite.c index bf209f4..b910ab1 100644 --- a/contrib/libf2c/libI77/lwrite.c +++ b/contrib/libf2c/libI77/lwrite.c @@ -6,297 +6,272 @@ ftnint L_len; int f__Aquote; - static VOID -donewrec(Void) +static void +donewrec (void) { - if (f__recpos) - (*f__donewrec)(); - } + if (f__recpos) + (*f__donewrec) (); +} - static VOID -#ifdef KR_headers -lwrt_I(n) longint n; -#else -lwrt_I(longint n) -#endif +static void +lwrt_I (longint n) { - char *p; - int ndigit, sign; + 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++); + p = f__icvt (n, &ndigit, &sign, 10); + if (f__recpos + ndigit >= L_len) + donewrec (); + PUT (' '); + if (sign) + PUT ('-'); + while (*p) + PUT (*p++); } - static VOID -#ifdef KR_headers -lwrt_L(n, len) ftnint n; ftnlen len; -#else -lwrt_L(ftnint n, ftnlen len) -#endif +static void +lwrt_L (ftnint n, ftnlen len) { - if(f__recpos+LLOGW>=L_len) - donewrec(); - wrt_L((Uint *)&n,LLOGW, len); + if (f__recpos + LLOGW >= L_len) + donewrec (); + wrt_L ((Uint *) & n, LLOGW, len); } - static VOID -#ifdef KR_headers -lwrt_A(p,len) char *p; ftnlen len; -#else -lwrt_A(char *p, ftnlen len) -#endif +static void +lwrt_A (char *p, ftnlen len) { - int a; - char *p1, *pe; + 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 + 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 + || !f__recpos #endif - ) - PUT(' '); - if (a) { - PUT('\''); - while(p < pe) { - if (*p == '\'') - PUT('\''); - PUT(*p++); - } - PUT('\''); - } - else - while(p < pe) - PUT(*p++); + ) + PUT (' '); + if (a) + { + PUT ('\''); + while (p < pe) + { + if (*p == '\'') + PUT ('\''); + PUT (*p++); + } + PUT ('\''); + } + else + while (p < pe) + PUT (*p++); } - static int -#ifdef KR_headers -l_g(buf, n) char *buf; double n; -#else -l_g(char *buf, double n) -#endif +static int +l_g (char *buf, double n) { #ifdef Old_list_output - doublereal absn; - char *fmt; + doublereal absn; + char *fmt; - absn = n; - if (absn < 0) - absn = -absn; - fmt = LLOW <= absn && absn < LHIGH ? LFFMT : LEFMT; + absn = n; + if (absn < 0) + absn = -absn; + fmt = LLOW <= absn && absn < LHIGH ? LFFMT : LEFMT; #ifdef USE_STRLEN - sprintf(buf, fmt, n); - return strlen(buf); + sprintf (buf, fmt, n); + return strlen (buf); #else - return sprintf(buf, fmt, n); + return sprintf (buf, fmt, n); #endif #else - register char *b, c, c1; + 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) { + 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; + case '0': + while (b[0] = b[1]) + b++; + break; #endif - case 'i': - case 'I': - /* Infinity */ - case 'n': - case 'N': - /* NaN */ - while(*++b); - break; + 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; + 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 -#ifdef KR_headers -l_put(s) register char *s; -#else -l_put(register char *s) -#endif +static void +l_put (register char *s) { -#ifdef KR_headers - register void (*pn)() = f__putn; -#else - register void (*pn)(int) = f__putn; -#endif - register int c; + register void (*pn) (int) = f__putn; + register int c; - while(c = *s++) - (*pn)(c); - } + while ((c = *s++)) + (*pn) (c); +} - static VOID -#ifdef KR_headers -lwrt_F(n) double n; -#else -lwrt_F(double n) -#endif +static void +lwrt_F (double n) { - char buf[LEFBL]; + char buf[LEFBL]; - if(f__recpos + l_g(buf,n) >= L_len) - donewrec(); - l_put(buf); + if (f__recpos + l_g (buf, n) >= L_len) + donewrec (); + l_put (buf); } - static VOID -#ifdef KR_headers -lwrt_C(a,b) double a,b; -#else -lwrt_C(double a, double b) -#endif +static void +lwrt_C (double a, double b) { - char *ba, *bb, bufa[LEFBL], bufb[LEFBL]; - int al, bl; + 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(); + 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 + else #endif - PUT(' '); - PUT('('); - l_put(ba); - PUT(','); - if (f__recpos + bl >= L_len) { - (*f__donewrec)(); + PUT (' '); + PUT ('('); + l_put (ba); + PUT (','); + if (f__recpos + bl >= L_len) + { + (*f__donewrec) (); #ifndef OMIT_BLANK_CC - PUT(' '); + PUT (' '); #endif - } - l_put(bb); - PUT(')'); + } + l_put (bb); + PUT (')'); } -#ifdef KR_headers -l_write(number,ptr,len,type) ftnint *number,type; char *ptr; ftnlen len; -#else -l_write(ftnint *number, char *ptr, ftnlen len, ftnint type) -#endif + +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++) + int i; + longint x; + double y, z; + real *xx; + doublereal *yy; + for (i = 0; i < *number; i++) + { + switch ((int) type) { - 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; + 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; + 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; + 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; } - return(0); + ptr += len; + } + return (0); } diff --git a/contrib/libf2c/libI77/open.c b/contrib/libf2c/libI77/open.c index 9457ccc..ac1e00e 100644 --- a/contrib/libf2c/libI77/open.c +++ b/contrib/libf2c/libI77/open.c @@ -1,6 +1,3 @@ -/* Define _XOPEN_SOURCE to get tempnam prototype with glibc et al -- - more general than _INCLUDE_XOPEN_SOURCE used elsewhere `for HP-UX'. */ -#define _XOPEN_SOURCE 1 #include "config.h" #include "f2c.h" #include "fio.h" @@ -9,307 +6,296 @@ #ifdef MSDOS #include "io.h" #else -#include "unistd.h" /* for access */ +#include "unistd.h" /* for access */ #endif #endif -#ifdef KR_headers -extern char *malloc(); -#ifdef NON_ANSI_STDIO -extern char *mktemp(); -#endif -extern integer f_clos(); -#else #undef abs #undef min #undef max #include <stdlib.h> -extern int f__canseek(FILE*); -extern integer f_clos(cllist*); -#endif +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"}; +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+"}; +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 char f__buf0[400], *f__buf = f__buf0; +int f__buflen = (int) sizeof (f__buf0); - static void -#ifdef KR_headers -f__bufadj(n, c) int n, c; -#else -f__bufadj(int n, int c) -#endif +static void +f__bufadj (int n, int c) { - unsigned int len; - char *nbuf, *s, *t, *te; + 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; - } + 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 -#ifdef KR_headers -f__putbuf(c) int c; -#else -f__putbuf(int c) -#endif +int +f__putbuf (int c) { - char *s, *se; - int n; + 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; - } + 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 -#ifdef KR_headers -x_putc(c) -#else -x_putc(int c) -#endif +void +x_putc (int c) { - if (f__recpos >= f__buflen) - f__bufadj(f__recpos, f__buflen); - f__buf[f__recpos++] = 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 -#ifdef KR_headers -opn_err(m, s, a) int m; char *s; olist *a; -#else -opn_err(int m, char *s, olist *a) -#endif +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); - } + 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); +} -#ifdef KR_headers -integer f_open(a) olist *a; -#else -integer f_open(olist *a) -#endif -{ unit *b; - integer rv; - char buf[256], *s, *env; - cllist x; - int ufmt; - FILE *tf; - int fd, len; +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; + 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); - } + 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; + 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; + 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(b->url>0) 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; + 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); + 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': + 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); + if (!(tf = fopen (buf, "r"))) + opnerr (a->oerr, errno, "open"); + fclose (tf); #else - if (access(buf,0)) - opnerr(a->oerr,errno,"open"); + 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 - 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"); + 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); + 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); + tmpnam (buf); #else - (void) strcpy(buf,"tmp.FXXXXXX"); - (void) mktemp(buf); + (void) strcpy (buf, "tmp.FXXXXXX"); + (void) mktemp (buf); #endif #endif /* ! defined (HAVE_TEMPNAM) */ #endif /* ! defined (HAVE_MKSTEMP) */ - goto replace; - case 'n': - case 'N': + 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"); - } + 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"); + 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); - } + /* 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); + 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"); + 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); + 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); } -#ifdef KR_headers -fk_open(seq,fmt,n) ftnint n; -#else -fk_open(int seq, int fmt, ftnint n) -#endif -{ 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; +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; } diff --git a/contrib/libf2c/libI77/rdfmt.c b/contrib/libf2c/libI77/rdfmt.c index 81426ae..8a8818a 100644 --- a/contrib/libf2c/libI77/rdfmt.c +++ b/contrib/libf2c/libI77/rdfmt.c @@ -4,543 +4,612 @@ #include "fio.h" extern int f__cursor; -#ifdef KR_headers -extern double atof(); -#else #undef abs #undef min #undef max #include <stdlib.h> -#endif #include "fmt.h" #include "fp.h" - static int -#ifdef KR_headers -rd_Z(n,w,len) Uint *n; ftnlen len; -#else -rd_Z(Uint *n, int w, ftnlen len) -#endif +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; + 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*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; + 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 -#ifdef KR_headers -rd_I(n,w,len, base) Uint *n; int w; ftnlen len; register int base; -#else -rd_I(Uint *n, int w, ftnlen len, register int base) -#endif +static int +rd_I (Uint * n, int w, ftnlen len, register int base) { - int bad, ch, sign; - longint x = 0; + 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; + 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; + 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; + else + n->is = (short) x; + if (w) + { + while (--w) + GET (ch); + return errno = 115; + } + return 0; } - static int -#ifdef KR_headers -rd_L(n,w,len) ftnint *n; ftnlen len; -#else -rd_L(ftnint *n, int w, ftnlen len) -#endif -{ int ch, dot, lv; +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; + 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 -#ifdef KR_headers -rd_F(p, w, d, len) ufloat *p; ftnlen len; -#else -rd_F(ufloat *p, int w, int d, ftnlen len) -#endif +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; + 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.; + 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; + 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; + e = ch - '0'; + for (;;) + { + if (!w--) + { + ch = '\n'; + break; + } + GET (ch); + if (!isdigit (ch)) + { + if (ch == ' ') + { + if (f__cblank) + ch = '0'; + else + continue; } - switch(ch) { - case '\n': - case ',': + else break; - default: -bad: - return (errno = 115); - } + } + 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); - } + 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); - } + if (len == sizeof (real)) + p->pf = x; + else + p->pd = x; + return (0); +} - static int -#ifdef KR_headers -rd_A(p,len) char *p; ftnlen len; -#else -rd_A(char *p, ftnlen len) -#endif -{ int i,ch; - for(i=0;i<len;i++) - { GET(ch); - *p++=VAL(ch); - } - 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 -#ifdef KR_headers -rd_AW(p,w,len) char *p; ftnlen len; -#else -rd_AW(char *p, int w, ftnlen len) -#endif -{ 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); +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); } - for(i=0;i<len-w;i++) *p++=' '; - return(0); + 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 -#ifdef KR_headers -rd_H(n,s) char *s; -#else -rd_H(int n, char *s) -#endif -{ 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_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 -#ifdef KR_headers -rd_POS(s) char *s; -#else -rd_POS(char *s) -#endif -{ 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); +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); } -#ifdef KR_headers -rd_ed(p,ptr,len) struct syl *p; char *ptr; ftnlen len; -#else -rd_ed(struct syl *p, char *ptr, ftnlen len) -#endif -{ 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) + +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) { - 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; + 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. */ + /* 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; + 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. */ + /* 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); + 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); } -#ifdef KR_headers -rd_ned(p) struct syl *p; -#else -rd_ned(struct syl *p) -#endif + +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); - } + 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); + } } diff --git a/contrib/libf2c/libI77/rewind.c b/contrib/libf2c/libI77/rewind.c index 0691519..d7a9b76 100644 --- a/contrib/libf2c/libI77/rewind.c +++ b/contrib/libf2c/libI77/rewind.c @@ -1,27 +1,25 @@ #include "config.h" #include "f2c.h" #include "fio.h" -#ifdef KR_headers -integer f_rew(a) alist *a; -#else -integer f_rew(alist *a) -#endif +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); + 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); } diff --git a/contrib/libf2c/libI77/rsfe.c b/contrib/libf2c/libI77/rsfe.c index 1be4531..0dcda39 100644 --- a/contrib/libf2c/libI77/rsfe.c +++ b/contrib/libf2c/libI77/rsfe.c @@ -4,78 +4,94 @@ #include "fio.h" #include "fmt.h" -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); -} -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); +int +xrd_SL (void) +{ + int ch; + if (!f__curunit->uend) + while ((ch = getc (f__cf)) != '\n') + if (ch == EOF) + { + f__curunit->uend = 1; + break; } - return(-1); + f__cursor = f__recpos = 0; + return (1); } -x_endp(Void) + +int +x_getc (void) { - xrd_SL(); - return f__curunit->uend == 1 ? EOF : 0; + 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); } -x_rev(Void) + +int +x_endp (void) { - (void) xrd_SL(); - return(0); + xrd_SL (); + return f__curunit->uend == 1 ? EOF : 0; } -#ifdef KR_headers -integer s_rsfe(a) cilist *a; /* start */ -#else -integer s_rsfe(cilist *a) /* start */ -#endif -{ 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); + +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); } diff --git a/contrib/libf2c/libI77/rsli.c b/contrib/libf2c/libI77/rsli.c index baf2ba5..c07632a 100644 --- a/contrib/libf2c/libI77/rsli.c +++ b/contrib/libf2c/libI77/rsli.c @@ -1,7 +1,7 @@ #include "f2c.h" #include "fio.h" #include "lio.h" -#include "fmt.h" /* for f__doend */ +#include "fmt.h" /* for f__doend */ extern flag f__lquit; extern int f__lcount; @@ -10,96 +10,90 @@ extern char *f__icend; extern icilist *f__svic; extern int f__icnum, f__recpos; -static int i_getc(Void) +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++); - } + 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 -#ifdef KR_headers -int i_ungetc(ch, f) int ch; FILE *f; -#else -int i_ungetc(int ch, FILE *f) -#endif +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 */; - } + 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 -#ifdef KR_headers -c_lir(a) icilist *a; -#else -c_lir(icilist *a) -#endif +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; - } + 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; +} -#ifdef KR_headers -integer s_rsli(a) icilist *a; -#else -integer s_rsli(icilist *a) -#endif +integer +s_rsli (icilist * a) { - f__lioproc = l_read; - f__lquit = 0; - f__lcount = 0; - c_lir(a); - f__doend = 0; - return(0); - } + 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; } +integer +e_rsli (void) +{ + f__init = 1; + return 0; +} -#ifdef KR_headers -integer s_rsni(a) icilist *a; -#else -extern int x_rsne(cilist*); +extern int x_rsne (cilist *); -integer s_rsni(icilist *a) -#endif +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; - } + 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; +} diff --git a/contrib/libf2c/libI77/rsne.c b/contrib/libf2c/libI77/rsne.c index a0d0bfe..f233a4a 100644 --- a/contrib/libf2c/libI77/rsne.c +++ b/contrib/libf2c/libI77/rsne.c @@ -3,55 +3,45 @@ #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 */ +#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; +struct dimen +{ + ftnlen extent; + ftnlen curval; + ftnlen delta; + ftnlen stride; +}; +typedef struct dimen dimen; - static hashtab *nl_cache; - static int n_nlcache; - static hashentry **zot; - static int colonseen; - extern ftnlen f__typesize[]; +struct hashentry +{ + struct hashentry *next; + char *name; + Vardesc *vd; +}; +typedef struct hashentry hashentry; - extern flag f__lquit; - extern int f__lcount, nml_read; - extern t_getc(Void); +struct hashtab +{ + struct hashtab *next; + Namelist *nl; + int htsize; + hashentry *tab[1]; +}; +typedef struct hashtab hashtab; -#ifdef KR_headers - extern char *malloc(), *memset(); +static hashtab *nl_cache; +static int n_nlcache; +static hashentry **zot; +static int colonseen; +extern ftnlen f__typesize[]; -#ifdef ungetc - static int -un_getc(x,f__cf) int x; FILE *f__cf; -{ return ungetc(x,f__cf); } -#else -#define un_getc ungetc - extern int ungetc(); -#endif +extern flag f__lquit; +extern int f__lcount, nml_read; +extern int t_getc (void); -#else #undef abs #undef min #undef max @@ -59,550 +49,551 @@ un_getc(x,f__cf) int x; FILE *f__cf; #include <string.h> #ifdef ungetc - static int -un_getc(int x, FILE *f__cf) -{ return ungetc(x,f__cf); } +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 +extern int ungetc (int, FILE *); /* for systems with a buggy stdio.h */ #endif - static Vardesc * -#ifdef KR_headers -hash(ht, s) hashtab *ht; register char *s; -#else -hash(hashtab *ht, register char *s) -#endif +static Vardesc * +hash (hashtab * ht, register char *s) { - register int c, x; - register hashentry *h; - char *s0 = 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; - } + 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 * -#ifdef KR_headers -mk_hashtab(nl) Namelist *nl; -#else -mk_hashtab(Namelist *nl) -#endif +hashtab * +mk_hashtab (Namelist * nl) { - int nht, nv; - hashtab *ht; - Vardesc *v, **vd, **vde; - hashentry *he; + 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; + 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; +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; - } + 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 -#ifdef KR_headers -getname(s, slen) register char *s; int slen; -#else -getname(register char *s, int slen) -#endif +static int +getname (register char *s, int slen) { - register char *se = s + slen - 1; - register int ch; + 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; - } + 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 -#ifdef KR_headers -getnum(chp, val) int *chp; ftnlen *val; -#else -getnum(int *chp, ftnlen *val) -#endif +static int +getnum (int *chp, ftnlen * val) { - register int ch, sign; - register ftnlen x; + 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; - } + 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 -#ifdef KR_headers -getdimen(chp, d, delta, extent, x1) - int *chp; dimen *d; ftnlen delta, extent, *x1; -#else -getdimen(int *chp, dimen *d, ftnlen delta, ftnlen extent, ftnlen *x1) -#endif +static int +getdimen (int *chp, dimen * d, ftnlen delta, ftnlen extent, ftnlen * x1) { - register int k; - ftnlen x2, x3; + 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; + 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 -#ifdef KR_headers -print_ne(a) cilist *a; -#else -print_ne(cilist *a) -#endif +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; - } + 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 "; +static char where0[] = "namelist read start "; -#ifdef KR_headers -x_rsne(a) cilist *a; -#else -x_rsne(cilist *a) -#endif +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; + 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; + 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; + case '?': + print_ne (a); + continue; #endif - default: - if (ch <= ' ' && ch >= 0) - continue; + default: + if (ch <= ' ' && ch >= 0) + continue; #ifndef No_Namelist_Comments - while(GETC(ch) != '\n') - if (ch == EOF) - goto eof; + while (GETC (ch) != '\n') + if (ch == EOF) + goto eof; #else - errfl(a->cierr, 115, where0); + 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)) + } +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); + 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 == '(' /*) */ ) { - 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; - } + 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; } -#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) { - no1 = (ivae - iva)/size; - if (no1 > f__lcount) - no1 = f__lcount; - if (k = l_read(&no1, vaddr + iva, - size, type)) - return k; - iva += no1 * 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; - } + } + 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 -#ifdef KR_headers -s_rsne(a) cilist *a; -#else -s_rsne(cilist *a) -#endif +integer +s_rsne (cilist * a) { - extern int l_eof; - int n; + 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(); - } + 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 (); +} diff --git a/contrib/libf2c/libI77/sfe.c b/contrib/libf2c/libI77/sfe.c index b67d823..8f05e48 100644 --- a/contrib/libf2c/libI77/sfe.c +++ b/contrib/libf2c/libI77/sfe.c @@ -5,35 +5,40 @@ extern char *f__fmtbuf; -integer e_rsfe(Void) -{ int n; - f__init = 1; - n=en_fio(); - f__fmtbuf=NULL; - return(n); +integer +e_rsfe (void) +{ + int n; + f__init = 1; + n = en_fio (); + f__fmtbuf = NULL; + return (n); } -#ifdef KR_headers -c_sfe(a) cilist *a; /* check */ -#else -c_sfe(cilist *a) /* check */ -#endif -{ 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); + +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) + +integer +e_wsfe (void) { - int n; - f__init = 1; - n = en_fio(); - f__fmtbuf=NULL; + 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"); + if (!n && fflush (f__cf)) + err (f__elist->cierr, errno, "write end"); #endif - return n; + return n; } diff --git a/contrib/libf2c/libI77/sue.c b/contrib/libf2c/libI77/sue.c index 8865054..a20df66 100644 --- a/contrib/libf2c/libI77/sue.c +++ b/contrib/libf2c/libI77/sue.c @@ -4,85 +4,90 @@ extern uiolen f__reclen; off_t f__recloc; -#ifdef KR_headers -c_sue(a) cilist *a; -#else -c_sue(cilist *a) -#endif +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); + 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); } -#ifdef KR_headers -integer s_rsue(a) cilist *a; -#else -integer s_rsue(cilist *a) -#endif + +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"); + 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"); } - return(0); + clearerr (f__cf); + err (a->cierr, errno, "start"); + } + return (0); } -#ifdef KR_headers -integer s_wsue(a) cilist *a; -#else -integer s_wsue(cilist *a) -#endif + +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); + 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); + +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"); + 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); + 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) + +integer +e_rsue (void) { - f__init = 1; - FSEEK(f__cf,(off_t)(f__reclen-f__recpos+sizeof(uiolen)),SEEK_CUR); - return(0); + f__init = 1; + FSEEK (f__cf, (off_t) (f__reclen - f__recpos + sizeof (uiolen)), SEEK_CUR); + return (0); } diff --git a/contrib/libf2c/libI77/typesize.c b/contrib/libf2c/libI77/typesize.c index 7f42aa1..8e2a74a 100644 --- a/contrib/libf2c/libI77/typesize.c +++ b/contrib/libf2c/libI77/typesize.c @@ -1,13 +1,14 @@ #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), +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), + sizeof (longint), #endif - 0}; + 0 +}; diff --git a/contrib/libf2c/libI77/uio.c b/contrib/libf2c/libI77/uio.c index ea733ce..706b5dd 100644 --- a/contrib/libf2c/libI77/uio.c +++ b/contrib/libf2c/libI77/uio.c @@ -1,69 +1,60 @@ +#include "config.h" #include "f2c.h" #include "fio.h" #include <sys/types.h> uiolen f__reclen; -#ifdef KR_headers -do_us(number,ptr,len) ftnint *number; char *ptr; ftnlen len; -#else -do_us(ftnint *number, char *ptr, ftnlen len) -#endif +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) != *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); - } + 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); + } } -#ifdef KR_headers -integer do_ud(number,ptr,len) ftnint *number; char *ptr; ftnlen len; -#else -integer do_ud(ftnint *number, char *ptr, ftnlen len) -#endif +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) - { + 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 -#ifdef KR_headers - int i; + 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 - size_t i; + if (fread (ptr, (size_t) len, (size_t) (*number), f__cf) != *number) + err (f__elist->cierr, EOF, "do_ud"); + else + return (0); #endif - 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 < *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); + } + (void) fwrite (ptr, (size_t) len, (size_t) (*number), f__cf); + return (0); } -#ifdef KR_headers -integer do_uio(number,ptr,len) ftnint *number; char *ptr; ftnlen len; -#else -integer do_uio(ftnint *number, char *ptr, ftnlen len) -#endif + +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)); + if (f__sequential) + return (do_us (number, ptr, len)); + else + return (do_ud (number, ptr, len)); } diff --git a/contrib/libf2c/libI77/util.c b/contrib/libf2c/libI77/util.c index 8280ac0..6e7c52b 100644 --- a/contrib/libf2c/libI77/util.c +++ b/contrib/libf2c/libI77/util.c @@ -8,47 +8,45 @@ #include "f2c.h" #include "fio.h" - VOID -#ifdef KR_headers -g_char(a,alen,b) char *a,*b; ftnlen alen; -#else -g_char(char *a, ftnlen alen, char *b) -#endif +void +g_char (char *a, ftnlen alen, char *b) { - char *x = a + alen, *y = b + alen; + 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); + for (;; y--) + { + if (x <= a) + { + *b = 0; + return; } + if (*--x != ' ') + break; + } + *y-- = 0; + do + *y-- = *x; + while (x-- > a); +} - VOID -#ifdef KR_headers -b_char(a,b,blen) char *a,*b; ftnlen blen; -#else -b_char(char *a, char *b, ftnlen blen) -#endif -{ int i; - for(i=0;i<blen && *a!=0;i++) *b++= *a++; - for(;i<blen;i++) *b++=' '; +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 -#ifdef KR_headers -long f__inode(a, dev) char *a; int *dev; -#else -long f__inode(char *a, int *dev) -#endif -{ struct stat x; - if(stat(a,&x)<0) return(-1); - *dev = x.st_dev; - return(x.st_ino); +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 diff --git a/contrib/libf2c/libI77/wref.c b/contrib/libf2c/libI77/wref.c index a10bcaa..0dc3091 100644 --- a/contrib/libf2c/libI77/wref.c +++ b/contrib/libf2c/libI77/wref.c @@ -4,273 +4,303 @@ #include <ctype.h> #endif -#ifndef KR_headers #undef abs #undef min #undef max #include <stdlib.h> #include <string.h> -#endif #include "fmt.h" #include "fp.h" -#ifdef KR_headers -wrt_E(p,w,d,e,len) ufloat *p; ftnlen len; -#else -wrt_E(ufloat *p, int w, int d, int e, ftnlen len) -#endif +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; + char buf[FMAX + EXPMAXDIGS + 4], *s, *se; + int d1, delta, e1, i, sign, signspace; + double dd; #ifdef WANT_LEAD_0 - int insert0 = 0; + int insert0 = 0; #endif #ifndef VAX - int e0 = e; + 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; + 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 */ + if (!dd) + dd = 0.; /* avoid -0 */ #endif - } - delta = w - (2 /* for the . and the d adjustment above */ - + 2 /* for the E+ */ + signspace + d + e); + } + 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 + 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); + 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(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; - } + /* 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); + 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"); + 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; - } + s = ++se; + if (e < 2) + { + if (*s != '0') + goto nogood; + } #ifndef VAX - /* accommodate 3 significant digits in exponent */ - if (s[2]) { + /* 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++); + 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. */ + /* 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++) + if (!e0) + { + for (s -= 2, e1 = 2; (s[0] = s[1]); s++) #ifdef CRAY - delta--; - if ((delta += 4) < 0) - goto nogood + delta--; + if ((delta += 4) < 0) + goto nogood #endif - ; - } + ; + } #endif - else if (e0 >= 0) - goto shift; - else - e1 = e; - } - else - shift: + 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) { + 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'); + 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; - } + 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; +} -#ifdef KR_headers -wrt_F(p,w,d,len) ufloat *p; ftnlen len; -#else -wrt_F(ufloat *p, int w, int d, ftnlen len) -#endif +int +wrt_F (ufloat * p, int w, int d, ftnlen len) { - int d1, sign, n; - double x; - char *b, buf[MAXINTDIGS+MAXFRACDIGS+4], *s; + 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; + 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.; + 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); + 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; + sprintf (b = buf, "%#.*f", d, x); + n = strlen (b) + d1; #else - n = sprintf(b = buf, "%#.*f", d, x) + d1; + n = sprintf (b = buf, "%#.*f", d, x) + d1; #endif #ifndef WANT_LEAD_0 - if (buf[0] == '0' && d) - { ++b; --n; } + 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) { + 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 + 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; + { + 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; +} diff --git a/contrib/libf2c/libI77/wrtfmt.c b/contrib/libf2c/libI77/wrtfmt.c index 37006ba..0190f71 100644 --- a/contrib/libf2c/libI77/wrtfmt.c +++ b/contrib/libf2c/libI77/wrtfmt.c @@ -6,361 +6,396 @@ extern icilist *f__svic; extern char *f__icptr; - static int -mv_cur(Void) /* shouldn't use fseek because it insists on calling fflush */ +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); + 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"); } - 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 (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; + } } - else if (cursor < 0) + return (0); + } + if (cursor > 0) + { + if (f__hiwater <= f__recpos) + for (; cursor > 0; cursor--) + (*f__putn) (' '); + else if (f__hiwater <= f__recpos + cursor) { - if(cursor + f__recpos < 0) - err(f__elist->cierr,110,"left off"); - if(f__hiwater < f__recpos) - f__hiwater = f__recpos; - f__recpos += cursor; + cursor -= f__hiwater - f__recpos; + f__recpos = f__hiwater; + for (; cursor > 0; cursor--) + (*f__putn) (' '); } - return(0); + 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 -#ifdef KR_headers -wrt_Z(n,w,minlen,len) Uint *n; int w, minlen; ftnlen len; -#else -wrt_Z(Uint *n, int w, int minlen, ftnlen len) -#endif +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; + 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 -#ifdef KR_headers -wrt_I(n,w,len, base) Uint *n; ftnlen len; register int base; -#else -wrt_I(Uint *n, int w, ftnlen len, register int base) -#endif -{ int ndigit,sign,spare,i; - longint x; - char *ans; - if(len==sizeof(integer)) x=n->il; - else if(len == sizeof(char)) x = n->ic; +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; + 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); + 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 -#ifdef KR_headers -wrt_IM(n,w,m,len,base) Uint *n; ftnlen len; int base; -#else -wrt_IM(Uint *n, int w, int m, ftnlen len, int base) -#endif -{ 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; +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; + 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); + 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 -#ifdef KR_headers -wrt_AP(s) char *s; -#else -wrt_AP(char *s) -#endif -{ char quote; - int i; +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); + 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 -#ifdef KR_headers -wrt_H(a,s) char *s; -#else -wrt_H(int a, char *s) -#endif +static int +wrt_H (int a, char *s) { - int i; + int i; - if(f__cursor && (i = mv_cur())) - return i; - while(a--) (*f__putn)(*s++); - return(1); + if (f__cursor && (i = mv_cur ())) + return i; + while (a--) + (*f__putn) (*s++); + return (1); } -#ifdef KR_headers -wrt_L(n,len, sz) Uint *n; ftnlen sz; -#else -wrt_L(Uint *n, int len, ftnlen sz) -#endif -{ 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); + +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 -#ifdef KR_headers -wrt_A(p,len) char *p; ftnlen len; -#else -wrt_A(char *p, ftnlen len) -#endif +static int +wrt_A (char *p, ftnlen len) { - while(len-- > 0) (*f__putn)(*p++); - return(0); + while (len-- > 0) + (*f__putn) (*p++); + return (0); } - static int -#ifdef KR_headers -wrt_AW(p,w,len) char * p; ftnlen len; -#else -wrt_AW(char * p, int w, ftnlen len) -#endif +static int +wrt_AW (char *p, int w, ftnlen len) { - while(w>len) - { w--; - (*f__putn)(' '); - } - while(w-- > 0) - (*f__putn)(*p++); - return(0); + while (w > len) + { + w--; + (*f__putn) (' '); + } + while (w-- > 0) + (*f__putn) (*p++); + return (0); } - static int -#ifdef KR_headers -wrt_G(p,w,d,e,len) ufloat *p; ftnlen len; -#else -wrt_G(ufloat *p, int w, int d, int e, ftnlen len) -#endif -{ 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)); +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)); } -#ifdef KR_headers -w_ed(p,ptr,len) struct syl *p; char *ptr; ftnlen len; -#else -w_ed(struct syl *p, char *ptr, ftnlen len) -#endif + +int +w_ed (struct syl * p, char *ptr, ftnlen len) { - int i; + 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)); + 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. */ + /* 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)); + 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. */ + /* 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)); - } + 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)); + } } -#ifdef KR_headers -w_ned(p) struct syl *p; -#else -w_ned(struct syl *p) -#endif + +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)); - } + 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)); + } } diff --git a/contrib/libf2c/libI77/wsfe.c b/contrib/libf2c/libI77/wsfe.c index 490231a..46f7a8f 100644 --- a/contrib/libf2c/libI77/wsfe.c +++ b/contrib/libf2c/libI77/wsfe.c @@ -5,72 +5,75 @@ #include "fmt.h" extern int f__hiwater; - int -x_wSL(Void) +int +x_wSL (void) { - int n = f__putbuf('\n'); - f__hiwater = f__recpos = f__cursor = 0; - return(n == 0); + int n = f__putbuf ('\n'); + f__hiwater = f__recpos = f__cursor = 0; + return (n == 0); } - static int -xw_end(Void) +static int +xw_end (void) { - int n; + 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; + 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) +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; + int n = 0; + if (f__workdone) + { + n = f__putbuf ('\n'); + f__workdone = 0; + } + f__hiwater = f__recpos = f__cursor = 0; + return n; } -#ifdef KR_headers -integer s_wsfe(a) cilist *a; /*start*/ -#else -integer s_wsfe(cilist *a) /*start*/ -#endif -{ 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); +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); } diff --git a/contrib/libf2c/libI77/wsle.c b/contrib/libf2c/libI77/wsle.c index 386e867..e9ef172 100644 --- a/contrib/libf2c/libI77/wsle.c +++ b/contrib/libf2c/libI77/wsle.c @@ -5,35 +5,34 @@ #include "lio.h" #include "string.h" -#ifdef KR_headers -integer s_wsle(a) cilist *a; -#else -integer s_wsle(cilist *a) -#endif +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); - } + 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) +integer +e_wsle (void) { - int n; - f__init = 1; - n = f__putbuf('\n'); - f__recpos=0; + 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"); + if (!n && fflush (f__cf)) + err (f__elist->cierr, errno, "write end"); #endif - return(n); - } + return (n); +} diff --git a/contrib/libf2c/libI77/wsne.c b/contrib/libf2c/libI77/wsne.c index ae3f817..bcf0826 100644 --- a/contrib/libf2c/libI77/wsne.c +++ b/contrib/libf2c/libI77/wsne.c @@ -2,25 +2,21 @@ #include "fio.h" #include "lio.h" - integer -#ifdef KR_headers -s_wsne(a) cilist *a; -#else -s_wsne(cilist *a) -#endif +integer +s_wsne (cilist * a) { - int n; + 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(); - } + 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 (); +} diff --git a/contrib/libf2c/libI77/xwsne.c b/contrib/libf2c/libI77/xwsne.c index 96fdd02..68b606c 100644 --- a/contrib/libf2c/libI77/xwsne.c +++ b/contrib/libf2c/libI77/xwsne.c @@ -6,67 +6,66 @@ extern int f__Aquote; - static VOID -nl_donewrec(Void) +static void +nl_donewrec (void) { - (*f__donewrec)(); - PUT(' '); - } + (*f__donewrec) (); + PUT (' '); +} -#ifdef KR_headers -x_wsne(a) cilist *a; -#else #include <string.h> - VOID -x_wsne(cilist *a) -#endif +void +x_wsne (cilist * a) { - Namelist *nl; - char *s; - Vardesc *v, **vd, **vde; - ftnint number, type; - ftnlen *dims; - ftnlen size; - extern ftnlen f__typesize[]; + 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; + 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) + 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('/'); + 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 ('/'); +} diff --git a/contrib/libf2c/libU77/Makefile.in b/contrib/libf2c/libU77/Makefile.in index 1994511..6830d8b 100644 --- a/contrib/libf2c/libU77/Makefile.in +++ b/contrib/libf2c/libU77/Makefile.in @@ -37,13 +37,13 @@ CFLAGS = @CFLAGS@ CPPFLAGS = @CPPFLAGS@ @SET_MAKE@ -SHELL = /bin/sh +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) $(CFLAGS) + -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. diff --git a/contrib/libf2c/libU77/Version.c b/contrib/libf2c/libU77/Version.c index 94e8050..45b68a6 100644 --- a/contrib/libf2c/libU77/Version.c +++ b/contrib/libf2c/libU77/Version.c @@ -1,12 +1 @@ -static char junk[] = "\n@(#) LIBU77 VERSION 19980709\n"; - -char __G77_LIBU77_VERSION__[] = "3.2.2 20030205 (release)"; - -#include <stdio.h> - -void -g77__uvers__ () -{ - fprintf (stderr, "__G77_LIBU77_VERSION__: %s", __G77_LIBU77_VERSION__); - fputs (junk, stderr); -} +const char __LIBU77_VERSION__[] = "@(#) LIBU77 VERSION 19980709\n"; diff --git a/contrib/libf2c/libU77/access_.c b/contrib/libf2c/libU77/access_.c index fefdebb..0a2dbce 100644 --- a/contrib/libf2c/libU77/access_.c +++ b/contrib/libf2c/libU77/access_.c @@ -45,35 +45,39 @@ Boston, MA 02111-1307, USA. */ # define F_OK 0 #endif -#ifdef KR_headers -void g_char (); +void g_char (const char *a, ftnlen alen, char *b); -integer G77_access_0 (name, mode, Lname, Lmode) - char *name, *mode; - ftnlen Lname, Lmode; -#else -void g_char(const char *a, ftnlen alen, char *b); - -integer G77_access_0 (const char *name, const char *mode, ftnlen Lname, ftnlen Lmode) -#endif +integer +G77_access_0 (const char *name, const char *mode, ftnlen Lname, ftnlen Lmode) { char *buff; - char *bp, *blast; int amode, i; - buff = malloc (Lname+1); - if (!buff) return -1; + 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; + 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; diff --git a/contrib/libf2c/libU77/alarm_.c b/contrib/libf2c/libU77/alarm_.c index e7f9c2d..d2c9382 100644 --- a/contrib/libf2c/libU77/alarm_.c +++ b/contrib/libf2c/libU77/alarm_.c @@ -29,36 +29,23 @@ Boston, MA 02111-1307, USA. */ #ifndef RETSIGTYPE /* we shouldn't rely on this... */ -#ifdef KR_headers -#define RETSIGTYPE int -#else #define RETSIGTYPE void #endif -#endif -typedef RETSIGTYPE (*sig_type)(); +typedef RETSIGTYPE (*sig_type) (); -#ifdef KR_headers -extern sig_type signal(); -#else #include <signal.h> -typedef int (*sig_proc)(int); -#endif +typedef int (*sig_proc) (int); #ifndef SIG_ERR #define SIG_ERR ((sig_type) -1) #endif -#ifdef KR_headers -integer G77_alarm_0 (seconds, proc) - integer *seconds; - sig_type proc; -#else -integer G77_alarm_0 (integer *seconds, sig_proc proc) -#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) + if (signal (SIGALRM, (sig_type) proc) == SIG_ERR) status = -1; else status = alarm (*seconds); diff --git a/contrib/libf2c/libU77/bes.c b/contrib/libf2c/libU77/bes.c index 442337f..73373fd 100644 --- a/contrib/libf2c/libU77/bes.c +++ b/contrib/libf2c/libU77/bes.c @@ -16,31 +16,43 @@ 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. */ -#if 0 /* Don't include these unless necessary -- jcb. */ +#if 0 /* Don't include these unless necessary -- jcb. */ #include "f2c.h" #include <math.h> -double G77_besj0_0 (const real *x) { - return j0 (*x); +double +G77_besj0_0 (const real * x) +{ + return j0 (*x); } -double G77_besj1_0 (const real *x) { - return j1 (*x); +double +G77_besj1_0 (const real * x) +{ + return j1 (*x); } -double G77_besjn_0 (const integer *n, real *x) { - return jn (*n, *x); - } +double +G77_besjn_0 (const integer * n, real * x) +{ + return jn (*n, *x); +} -double G77_besy0_0 (const real *x) { - return y0 (*x); +double +G77_besy0_0 (const real * x) +{ + return y0 (*x); } -double G77_besy1_0 (const real *x) { - return y1 (*x); +double +G77_besy1_0 (const real * x) +{ + return y1 (*x); } -double G77_besyn_0 (const integer *n, real *x) { - return yn (*n, *x); +double +G77_besyn_0 (const integer * n, real * x) +{ + return yn (*n, *x); } #endif diff --git a/contrib/libf2c/libU77/chdir_.c b/contrib/libf2c/libU77/chdir_.c index 9bd53fb..bebdeb0 100644 --- a/contrib/libf2c/libU77/chdir_.c +++ b/contrib/libf2c/libU77/chdir_.c @@ -32,24 +32,17 @@ Boston, MA 02111-1307, USA. */ #include "f2c.h" -#ifdef KR_headers -void g_char (); +void g_char (const char *a, ftnlen alen, char *b); -integer G77_chdir_0 (name, Lname) - char *name; - ftnlen Lname; -#else -void g_char(const char *a, ftnlen alen, char *b); - -integer G77_chdir_0 (const char *name, const ftnlen Lname) -#endif +integer +G77_chdir_0 (const char *name, const ftnlen Lname) { char *buff; - char *bp, *blast; int i; - buff = malloc (Lname+1); - if (!buff) return -1; + buff = malloc (Lname + 1); + if (!buff) + return -1; g_char (name, Lname, buff); i = chdir (buff); free (buff); diff --git a/contrib/libf2c/libU77/chmod_.c b/contrib/libf2c/libU77/chmod_.c index d482d9e..86e620c 100644 --- a/contrib/libf2c/libU77/chmod_.c +++ b/contrib/libf2c/libU77/chmod_.c @@ -41,41 +41,41 @@ Boston, MA 02111-1307, USA. */ #define CHMOD_PATH "/bin/chmod" #endif -#ifdef KR_headers -extern void s_cat (); -void g_char (); +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 (name, mode, Lname, Lmode) - char *name, *mode; - ftnlen Lname, Lmode; -#else -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) -#endif +integer +G77_chmod_0 ( /* const */ char *name, /* const */ char *mode, + const ftnlen Lname, const ftnlen Lmode) { char *buff; - char *bp, *blast; int i; ftnlen l, l2; ftnlen six = 6; address a[6]; ftnlen ii[6]; - char chmod_path [] = CHMOD_PATH; + 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] == ' '); ) + 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'; + 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; diff --git a/contrib/libf2c/libU77/config.hin b/contrib/libf2c/libU77/config.hin index 2f20872..9848d06 100644 --- a/contrib/libf2c/libU77/config.hin +++ b/contrib/libf2c/libU77/config.hin @@ -33,6 +33,12 @@ /* Define as the path of the `chmod' program. */ #undef CHMOD_PATH +/* Define if your gettimeofday takes only one argument. */ +#undef GETTIMEOFDAY_ONE_ARGUMENT + +/* Define if your gettimeofday takes a time zome argument. */ +#undef HAVE_TIMEZONE + /* Define if you have the alarm function. */ #undef HAVE_ALARM @@ -54,6 +60,9 @@ /* Define if you have the getrusage function. */ #undef HAVE_GETRUSAGE +/* Define if you have the gettimeofday function. */ +#undef HAVE_GETTIMEOFDAY + /* Define if you have the getuid function. */ #undef HAVE_GETUID diff --git a/contrib/libf2c/libU77/configure b/contrib/libf2c/libU77/configure index f25748f..29a5f13 100755 --- a/contrib/libf2c/libU77/configure +++ b/contrib/libf2c/libU77/configure @@ -28,6 +28,7 @@ program_suffix=NONE program_transform_name=s,x,x, silent= site= +sitefile= srcdir= target=NONE verbose= @@ -142,6 +143,7 @@ Configuration: --help print this message --no-create do not create output files --quiet, --silent do not print \`checking...' messages + --site-file=FILE use FILE as the site file --version print the version of autoconf that created configure Directory and file names: --prefix=PREFIX install architecture-independent files in PREFIX @@ -312,6 +314,11 @@ EOF -site=* | --site=* | --sit=*) site="$ac_optarg" ;; + -site-file | --site-file | --site-fil | --site-fi | --site-f) + ac_prev=sitefile ;; + -site-file=* | --site-file=* | --site-fil=* | --site-fi=* | --site-f=*) + sitefile="$ac_optarg" ;; + -srcdir | --srcdir | --srcdi | --srcd | --src | --sr) ac_prev=srcdir ;; -srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*) @@ -477,12 +484,16 @@ fi srcdir=`echo "${srcdir}" | sed 's%\([^/]\)/*$%\1%'` # Prefer explicitly selected file to automatically selected ones. -if test -z "$CONFIG_SITE"; then - if test "x$prefix" != xNONE; then - CONFIG_SITE="$prefix/share/config.site $prefix/etc/config.site" - else - CONFIG_SITE="$ac_default_prefix/share/config.site $ac_default_prefix/etc/config.site" +if test -z "$sitefile"; then + if test -z "$CONFIG_SITE"; then + if test "x$prefix" != xNONE; then + CONFIG_SITE="$prefix/share/config.site $prefix/etc/config.site" + else + CONFIG_SITE="$ac_default_prefix/share/config.site $ac_default_prefix/etc/config.site" + fi fi +else + CONFIG_SITE="$sitefile" fi for ac_site_file in $CONFIG_SITE; do if test -r "$ac_site_file"; then @@ -523,28 +534,6 @@ fi -# These defines are necessary to get 64-bit file size support. - -cat >> confdefs.h <<\EOF -#define _XOPEN_SOURCE 500L -EOF - -# The following is needed by irix6.2 so that struct timeval is declared. -cat >> confdefs.h <<\EOF -#define _XOPEN_SOURCE_EXTENDED 1 -EOF - -# The following is needed by Solaris2.5.1 so that struct timeval is declared. -cat >> confdefs.h <<\EOF -#define __EXTENSIONS__ 1 -EOF - -cat >> confdefs.h <<\EOF -#define _FILE_OFFSET_BITS 64 -EOF - - - # For g77 we'll set CC to point at the built gcc, but this will get it into @@ -552,7 +541,7 @@ EOF # Extract the first word of "gcc", so it can be a program name with args. set dummy gcc; ac_word=$2 echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 -echo "configure:556: checking for $ac_word" >&5 +echo "configure:545: checking for $ac_word" >&5 if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else @@ -582,7 +571,7 @@ if test -z "$CC"; then # Extract the first word of "cc", so it can be a program name with args. set dummy cc; ac_word=$2 echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 -echo "configure:586: checking for $ac_word" >&5 +echo "configure:575: checking for $ac_word" >&5 if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else @@ -633,7 +622,7 @@ fi # Extract the first word of "cl", so it can be a program name with args. set dummy cl; ac_word=$2 echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 -echo "configure:637: checking for $ac_word" >&5 +echo "configure:626: checking for $ac_word" >&5 if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else @@ -666,7 +655,7 @@ fi echo $ac_n "checking whether we are using GNU C""... $ac_c" 1>&6 -echo "configure:670: checking whether we are using GNU C" >&5 +echo "configure:659: checking whether we are using GNU C" >&5 if eval "test \"`echo '$''{'ac_cv_prog_gcc'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else @@ -675,7 +664,7 @@ else yes; #endif EOF -if { ac_try='${CC-cc} -E conftest.c'; { (eval echo configure:679: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }; } | egrep yes >/dev/null 2>&1; then +if { ac_try='${CC-cc} -E conftest.c'; { (eval echo configure:668: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }; } | egrep yes >/dev/null 2>&1; then ac_cv_prog_gcc=yes else ac_cv_prog_gcc=no @@ -694,7 +683,7 @@ ac_test_CFLAGS="${CFLAGS+set}" ac_save_CFLAGS="$CFLAGS" CFLAGS= echo $ac_n "checking whether ${CC-cc} accepts -g""... $ac_c" 1>&6 -echo "configure:698: checking whether ${CC-cc} accepts -g" >&5 +echo "configure:687: checking whether ${CC-cc} accepts -g" >&5 if eval "test \"`echo '$''{'ac_cv_prog_cc_g'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else @@ -726,6 +715,53 @@ else fi +# 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. +echo $ac_n "checking whether _XOPEN_SOURCE may be defined""... $ac_c" 1>&6 +echo "configure:723: checking whether _XOPEN_SOURCE may be defined" >&5 +cat > conftest.$ac_ext <<EOF +#line 725 "configure" +#include "confdefs.h" +#define _XOPEN_SOURCE 600L +#include <unistd.h> +int main() { + +; return 0; } +EOF +if { (eval echo configure:733: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then + rm -rf conftest* + may_use_xopen_source=yes +else + echo "configure: failed program was:" >&5 + cat conftest.$ac_ext >&5 + rm -rf conftest* + may_use_xopen_source=no +fi +rm -f conftest* +echo "$ac_t""$may_use_xopen_source" 1>&6 +if test $may_use_xopen_source = yes; then + cat >> confdefs.h <<\EOF +#define _XOPEN_SOURCE 600L +EOF + + # The following is needed by irix6.2 so that struct timeval is declared. + cat >> confdefs.h <<\EOF +#define _XOPEN_SOURCE_EXTENDED 1 +EOF + + # The following is needed by Solaris2.5.1 so that struct timeval is declared. + cat >> confdefs.h <<\EOF +#define __EXTENSIONS__ 1 +EOF + + cat >> confdefs.h <<\EOF +#define _FILE_OFFSET_BITS 64 +EOF + +fi + + LIBTOOL='$(SHELL) ../libtool' @@ -738,7 +774,7 @@ fi test "$AR" || AR=ar echo $ac_n "checking whether ${MAKE-make} sets \${MAKE}""... $ac_c" 1>&6 -echo "configure:742: checking whether ${MAKE-make} sets \${MAKE}" >&5 +echo "configure:778: checking whether ${MAKE-make} sets \${MAKE}" >&5 set dummy ${MAKE-make}; ac_make=`echo "$2" | sed 'y%./+-%__p_%'` if eval "test \"`echo '$''{'ac_cv_prog_make_${ac_make}_set'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 @@ -768,7 +804,7 @@ fi # Extract the first word of "chmod", so it can be a program name with args. set dummy chmod; ac_word=$2 echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 -echo "configure:772: checking for $ac_word" >&5 +echo "configure:808: checking for $ac_word" >&5 if eval "test \"`echo '$''{'ac_cv_path_ac_cv_prog_chmod'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else @@ -812,7 +848,7 @@ else fi echo $ac_n "checking how to run the C preprocessor""... $ac_c" 1>&6 -echo "configure:816: checking how to run the C preprocessor" >&5 +echo "configure:852: checking how to run the C preprocessor" >&5 # On Suns, sometimes $CPP names a directory. if test -n "$CPP" && test -d "$CPP"; then CPP= @@ -827,13 +863,13 @@ else # On the NeXT, cc -E runs the code through the compiler's parser, # not just through cpp. cat > conftest.$ac_ext <<EOF -#line 831 "configure" +#line 867 "configure" #include "confdefs.h" #include <assert.h> Syntax Error EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:837: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:873: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then : @@ -844,13 +880,13 @@ else rm -rf conftest* CPP="${CC-cc} -E -traditional-cpp" cat > conftest.$ac_ext <<EOF -#line 848 "configure" +#line 884 "configure" #include "confdefs.h" #include <assert.h> Syntax Error EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:854: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:890: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then : @@ -861,13 +897,13 @@ else rm -rf conftest* CPP="${CC-cc} -nologo -E" cat > conftest.$ac_ext <<EOF -#line 865 "configure" +#line 901 "configure" #include "confdefs.h" #include <assert.h> Syntax Error EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:871: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:907: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then : @@ -892,12 +928,12 @@ fi echo "$ac_t""$CPP" 1>&6 echo $ac_n "checking for ANSI C header files""... $ac_c" 1>&6 -echo "configure:896: checking for ANSI C header files" >&5 +echo "configure:932: checking for ANSI C header files" >&5 if eval "test \"`echo '$''{'ac_cv_header_stdc'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <<EOF -#line 901 "configure" +#line 937 "configure" #include "confdefs.h" #include <stdlib.h> #include <stdarg.h> @@ -905,7 +941,7 @@ else #include <float.h> EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:909: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:945: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then rm -rf conftest* @@ -922,7 +958,7 @@ rm -f conftest* if test $ac_cv_header_stdc = yes; then # SunOS 4.x string.h does not declare mem*, contrary to ANSI. cat > conftest.$ac_ext <<EOF -#line 926 "configure" +#line 962 "configure" #include "confdefs.h" #include <string.h> EOF @@ -940,7 +976,7 @@ fi if test $ac_cv_header_stdc = yes; then # ISC 2.0.2 stdlib.h does not declare free, contrary to ANSI. cat > conftest.$ac_ext <<EOF -#line 944 "configure" +#line 980 "configure" #include "confdefs.h" #include <stdlib.h> EOF @@ -961,7 +997,7 @@ if test "$cross_compiling" = yes; then : else cat > conftest.$ac_ext <<EOF -#line 965 "configure" +#line 1001 "configure" #include "confdefs.h" #include <ctype.h> #define ISLOWER(c) ('a' <= (c) && (c) <= 'z') @@ -972,7 +1008,7 @@ if (XOR (islower (i), ISLOWER (i)) || toupper (i) != TOUPPER (i)) exit(2); exit (0); } EOF -if { (eval echo configure:976: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null +if { (eval echo configure:1012: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null then : else @@ -995,14 +1031,13 @@ EOF fi - echo $ac_n "checking whether time.h and sys/time.h may both be included""... $ac_c" 1>&6 -echo "configure:1001: checking whether time.h and sys/time.h may both be included" >&5 +echo "configure:1036: checking whether time.h and sys/time.h may both be included" >&5 if eval "test \"`echo '$''{'ac_cv_header_time'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <<EOF -#line 1006 "configure" +#line 1041 "configure" #include "confdefs.h" #include <sys/types.h> #include <sys/time.h> @@ -1011,7 +1046,7 @@ int main() { struct tm *tp; ; return 0; } EOF -if { (eval echo configure:1015: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then +if { (eval echo configure:1050: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* ac_cv_header_time=yes else @@ -1036,17 +1071,17 @@ for ac_hdr in limits.h unistd.h sys/time.h string.h stdlib.h \ do ac_safe=`echo "$ac_hdr" | sed 'y%./+-%__p_%'` echo $ac_n "checking for $ac_hdr""... $ac_c" 1>&6 -echo "configure:1040: checking for $ac_hdr" >&5 +echo "configure:1075: checking for $ac_hdr" >&5 if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <<EOF -#line 1045 "configure" +#line 1080 "configure" #include "confdefs.h" #include <$ac_hdr> EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:1050: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:1085: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then rm -rf conftest* @@ -1074,12 +1109,12 @@ done echo $ac_n "checking for working const""... $ac_c" 1>&6 -echo "configure:1078: checking for working const" >&5 +echo "configure:1113: checking for working const" >&5 if eval "test \"`echo '$''{'ac_cv_c_const'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <<EOF -#line 1083 "configure" +#line 1118 "configure" #include "confdefs.h" int main() { @@ -1128,7 +1163,7 @@ ccp = (char const *const *) p; ; return 0; } EOF -if { (eval echo configure:1132: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then +if { (eval echo configure:1167: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* ac_cv_c_const=yes else @@ -1149,12 +1184,12 @@ EOF fi echo $ac_n "checking for size_t""... $ac_c" 1>&6 -echo "configure:1153: checking for size_t" >&5 +echo "configure:1188: checking for size_t" >&5 if eval "test \"`echo '$''{'ac_cv_type_size_t'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <<EOF -#line 1158 "configure" +#line 1193 "configure" #include "confdefs.h" #include <sys/types.h> #if STDC_HEADERS @@ -1182,12 +1217,12 @@ EOF fi echo $ac_n "checking for mode_t""... $ac_c" 1>&6 -echo "configure:1186: checking for mode_t" >&5 +echo "configure:1221: checking for mode_t" >&5 if eval "test \"`echo '$''{'ac_cv_type_mode_t'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <<EOF -#line 1191 "configure" +#line 1226 "configure" #include "confdefs.h" #include <sys/types.h> #if STDC_HEADERS @@ -1216,12 +1251,12 @@ fi echo $ac_n "checking for pid_t""... $ac_c" 1>&6 -echo "configure:1220: checking for pid_t" >&5 +echo "configure:1255: checking for pid_t" >&5 if eval "test \"`echo '$''{'ac_cv_type_pid_t'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <<EOF -#line 1225 "configure" +#line 1260 "configure" #include "confdefs.h" #include <sys/types.h> #if STDC_HEADERS @@ -1249,12 +1284,12 @@ EOF fi echo $ac_n "checking for st_blksize in struct stat""... $ac_c" 1>&6 -echo "configure:1253: checking for st_blksize in struct stat" >&5 +echo "configure:1288: checking for st_blksize in struct stat" >&5 if eval "test \"`echo '$''{'ac_cv_struct_st_blksize'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <<EOF -#line 1258 "configure" +#line 1293 "configure" #include "confdefs.h" #include <sys/types.h> #include <sys/stat.h> @@ -1262,7 +1297,7 @@ int main() { struct stat s; s.st_blksize; ; return 0; } EOF -if { (eval echo configure:1266: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then +if { (eval echo configure:1301: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* ac_cv_struct_st_blksize=yes else @@ -1283,12 +1318,12 @@ EOF fi echo $ac_n "checking for st_blocks in struct stat""... $ac_c" 1>&6 -echo "configure:1287: checking for st_blocks in struct stat" >&5 +echo "configure:1322: checking for st_blocks in struct stat" >&5 if eval "test \"`echo '$''{'ac_cv_struct_st_blocks'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <<EOF -#line 1292 "configure" +#line 1327 "configure" #include "confdefs.h" #include <sys/types.h> #include <sys/stat.h> @@ -1296,7 +1331,7 @@ int main() { struct stat s; s.st_blocks; ; return 0; } EOF -if { (eval echo configure:1300: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then +if { (eval echo configure:1335: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* ac_cv_struct_st_blocks=yes else @@ -1319,12 +1354,12 @@ else fi echo $ac_n "checking for st_rdev in struct stat""... $ac_c" 1>&6 -echo "configure:1323: checking for st_rdev in struct stat" >&5 +echo "configure:1358: checking for st_rdev in struct stat" >&5 if eval "test \"`echo '$''{'ac_cv_struct_st_rdev'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <<EOF -#line 1328 "configure" +#line 1363 "configure" #include "confdefs.h" #include <sys/types.h> #include <sys/stat.h> @@ -1332,7 +1367,7 @@ int main() { struct stat s; s.st_rdev; ; return 0; } EOF -if { (eval echo configure:1336: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then +if { (eval echo configure:1371: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* ac_cv_struct_st_rdev=yes else @@ -1353,12 +1388,12 @@ EOF fi echo $ac_n "checking whether struct tm is in sys/time.h or time.h""... $ac_c" 1>&6 -echo "configure:1357: checking whether struct tm is in sys/time.h or time.h" >&5 +echo "configure:1392: checking whether struct tm is in sys/time.h or time.h" >&5 if eval "test \"`echo '$''{'ac_cv_struct_tm'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <<EOF -#line 1362 "configure" +#line 1397 "configure" #include "confdefs.h" #include <sys/types.h> #include <time.h> @@ -1366,7 +1401,7 @@ int main() { struct tm *tp; tp->tm_sec; ; return 0; } EOF -if { (eval echo configure:1370: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then +if { (eval echo configure:1405: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* ac_cv_struct_tm=time.h else @@ -1388,7 +1423,7 @@ fi echo $ac_n "checking for gethostname in -lsocket""... $ac_c" 1>&6 -echo "configure:1392: checking for gethostname in -lsocket" >&5 +echo "configure:1427: checking for gethostname in -lsocket" >&5 ac_lib_var=`echo socket'_'gethostname | sed 'y%./+-%__p_%'` if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 @@ -1396,7 +1431,7 @@ else ac_save_LIBS="$LIBS" LIBS="-lsocket $LIBS" cat > conftest.$ac_ext <<EOF -#line 1400 "configure" +#line 1435 "configure" #include "confdefs.h" /* Override any gcc2 internal prototype to avoid an error. */ /* We use char because int might match the return type of a gcc2 @@ -1407,7 +1442,7 @@ int main() { gethostname() ; return 0; } EOF -if { (eval echo configure:1411: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:1446: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -1433,12 +1468,12 @@ for ac_func in symlink getcwd getwd lstat gethostname strerror clock \ getrusage times alarm getlogin getgid getuid kill link ttyname do echo $ac_n "checking for $ac_func""... $ac_c" 1>&6 -echo "configure:1437: checking for $ac_func" >&5 +echo "configure:1472: checking for $ac_func" >&5 if eval "test \"`echo '$''{'ac_cv_func_$ac_func'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <<EOF -#line 1442 "configure" +#line 1477 "configure" #include "confdefs.h" /* System header to define __stub macros and hopefully few prototypes, which can conflict with char $ac_func(); below. */ @@ -1461,7 +1496,7 @@ $ac_func(); ; return 0; } EOF -if { (eval echo configure:1465: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:1500: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_func_$ac_func=yes" else @@ -1490,12 +1525,12 @@ done for ac_func in gettimeofday do echo $ac_n "checking for $ac_func""... $ac_c" 1>&6 -echo "configure:1494: checking for $ac_func" >&5 +echo "configure:1529: checking for $ac_func" >&5 if eval "test \"`echo '$''{'ac_cv_func_$ac_func'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <<EOF -#line 1499 "configure" +#line 1534 "configure" #include "confdefs.h" /* System header to define __stub macros and hopefully few prototypes, which can conflict with char $ac_func(); below. */ @@ -1518,7 +1553,7 @@ $ac_func(); ; return 0; } EOF -if { (eval echo configure:1522: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:1557: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_func_$ac_func=yes" else @@ -1544,19 +1579,19 @@ done if test "$ac_cv_func_gettimeofday" = yes; then echo $ac_n "checking for struct timezone""... $ac_c" 1>&6 -echo "configure:1548: checking for struct timezone" >&5 +echo "configure:1583: checking for struct timezone" >&5 if eval "test \"`echo '$''{'g77_cv_struct_timezone'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <<EOF -#line 1553 "configure" +#line 1588 "configure" #include "confdefs.h" #include <sys/time.h> int main() { struct timezone tz; ; return 0; } EOF -if { (eval echo configure:1560: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then +if { (eval echo configure:1595: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* g77_cv_struct_timezone=yes else @@ -1577,7 +1612,7 @@ EOF else cat > conftest.$ac_ext <<EOF -#line 1581 "configure" +#line 1616 "configure" #include "confdefs.h" #ifdef TIME_WITH_SYS_TIME @@ -1600,7 +1635,7 @@ main () exit (0); } EOF -if { (eval echo configure:1604: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null +if { (eval echo configure:1639: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null then cat >> confdefs.h <<\EOF #define HAVE_TIMEZONE 1 @@ -1616,12 +1651,12 @@ fi fi echo $ac_n "checking whether gettimeofday can accept two arguments""... $ac_c" 1>&6 -echo "configure:1620: checking whether gettimeofday can accept two arguments" >&5 +echo "configure:1655: checking whether gettimeofday can accept two arguments" >&5 if eval "test \"`echo '$''{'emacs_cv_gettimeofday_two_arguments'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <<EOF -#line 1625 "configure" +#line 1660 "configure" #include "confdefs.h" #ifdef TIME_WITH_SYS_TIME @@ -1647,7 +1682,7 @@ int main() { gettimeofday (&time, DUMMY); ; return 0; } EOF -if { (eval echo configure:1651: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:1686: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* emacs_cv_gettimeofday_two_arguments=yes else diff --git a/contrib/libf2c/libU77/configure.in b/contrib/libf2c/libU77/configure.in index 13fa524..a56fc4c 100644 --- a/contrib/libf2c/libU77/configure.in +++ b/contrib/libf2c/libU77/configure.in @@ -23,17 +23,6 @@ AC_PREREQ(2.12.1) AC_INIT(access_.c) AC_CONFIG_HEADER(config.h:config.hin) -# These defines are necessary to get 64-bit file size support. - -AC_DEFINE(_XOPEN_SOURCE, 500L, [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]) - -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],[]) @@ -42,6 +31,26 @@ define([AC_PROG_CC_WORKS],[]) # 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]) +fi + +dnl Checks for programs. + LIBTOOL='$(SHELL) ../libtool' AC_SUBST(LIBTOOL) @@ -70,17 +79,6 @@ fi dnl Checks for header files. AC_HEADER_STDC -dnl We could do this if we didn't know we were using gcc -dnl AC_MSG_CHECKING(for prototype-savvy compiler) -dnl AC_CACHE_VAL(ac_cv_sys_proto, -dnl [AC_TRY_LINK(, -dnl dnl looks screwy because TRY_LINK expects a function body -dnl [return 0;} int foo (int * bar) {], -dnl ac_cv_sys_proto=yes, -dnl [ac_cv_sys_proto=no -dnl AC_DEFINE(KR_headers)])]) -dnl AC_MSG_RESULT($ac_cv_sys_proto) - AC_HEADER_TIME AC_CHECK_HEADERS(limits.h unistd.h sys/time.h string.h stdlib.h \ sys/param.h sys/times.h) diff --git a/contrib/libf2c/libU77/ctime_.c b/contrib/libf2c/libU77/ctime_.c index a855cb5..56e6605 100644 --- a/contrib/libf2c/libU77/ctime_.c +++ b/contrib/libf2c/libU77/ctime_.c @@ -39,16 +39,9 @@ Boston, MA 02111-1307, USA. */ /* may need sys/time.h & long arg for stime (bsd, svr1-3) */ -#ifdef KR_headers -/* Character */ void G77_ctime_0 (chtime, Lchtime, xstime) - char *chtime; - longint * xstime; - ftnlen Lchtime; -#else -/* Character */ void G77_ctime_0 (char *chtime, const ftnlen Lchtime, longint * xstime) -#endif +/* Character */ void +G77_ctime_0 (char *chtime, const ftnlen Lchtime, longint * xstime) { - int i, l; int s_copy (); time_t stime = *xstime; diff --git a/contrib/libf2c/libU77/date_.c b/contrib/libf2c/libU77/date_.c index c3cd55d..306cc5f 100644 --- a/contrib/libf2c/libU77/date_.c +++ b/contrib/libf2c/libU77/date_.c @@ -9,47 +9,48 @@ static integer c__5 = 5; -/* Subroutine */ int G77_date_y2kbug_0 (char *buf, ftnlen buf_len) +/* 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); + /* 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_ */ + 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."; + "Call to non Y2K compliant subroutine detected."; -int G77_date_y2kbuggy_0 (char *buf, ftnlen buf_len) +int +G77_date_y2kbuggy_0 (char *buf __attribute__ ((__unused__)), + ftnlen buf_len __attribute__ ((__unused__))) { - extern int G77_abort_0(); + extern int G77_abort_0 (); fprintf (stderr, "%s\n", G77_Non_Y2K_Compliance_Message); - G77_abort_0(); + G77_abort_0 (); } #endif - - diff --git a/contrib/libf2c/libU77/datetime_.c b/contrib/libf2c/libU77/datetime_.c index 62b06b6..cd7c7ca 100644 --- a/contrib/libf2c/libU77/datetime_.c +++ b/contrib/libf2c/libU77/datetime_.c @@ -31,40 +31,48 @@ Boston, MA 02111-1307, USA. */ # include <time.h> # endif #endif +#if defined (_WIN32) +#include <windows.h> +#undef min +#undef max +#endif #include "f2c.h" -#ifdef KR_headers -VOID s_copy (); -#else -void s_copy(register char *a, register char *b, ftnlen la, ftnlen lb); -#endif +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) +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(<); - struct tm ltime = *localtime(<), gtime = *gmtime(<); + time_t lt = time (<); + struct tm ltime = *localtime (<), gtime = *gmtime (<); 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))); + 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; - vals[7] = 0; /* no STDC/POSIX way to get this */ - /* GNUish way; maybe use `ftime' on other systems. */ #if HAVE_GETTIMEOFDAY { struct timeval tp; # if GETTIMEOFDAY_ONE_ARGUMENT - if (! gettimeofday (&tp)) + if (!gettimeofday (&tp)) # else # if HAVE_STRUCT_TIMEZONE struct timezone tzp; @@ -74,26 +82,28 @@ int G77_date_and_time_0 (char *date, char *fftime, char *zone, 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)) + if (!gettimeofday (&tp, &tzp)) # else - if (! gettimeofday (&tp, (void *) 0)) + if (!gettimeofday (&tp, (void *) 0)) # endif /* HAVE_STRUCT_TIMEZONE */ # endif /* GETTIMEOFDAY_ONE_ARGUMENT */ - vals[7] = tp.tv_usec/1000; + vals[7] = tp.tv_usec / 1000; } #endif /* HAVE_GETTIMEOFDAY */ if (values) /* null pointer for missing optional */ - for (i=0; i<=7; i++) + 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); - } + 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; } diff --git a/contrib/libf2c/libU77/dbes.c b/contrib/libf2c/libU77/dbes.c index 1ef5978..8a31746 100644 --- a/contrib/libf2c/libU77/dbes.c +++ b/contrib/libf2c/libU77/dbes.c @@ -16,31 +16,43 @@ 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. */ -#if 0 /* Don't include these unless necessary -- dnp. */ +#if 0 /* Don't include these unless necessary -- dnp. */ #include "f2c.h" #include <math.h> -double G77_dbesj0_0 (const double *x) { - return j0 (*x); +double +G77_dbesj0_0 (const double *x) +{ + return j0 (*x); } -double G77_dbesj1_0 (const double *x) { - return j1 (*x); +double +G77_dbesj1_0 (const double *x) +{ + return j1 (*x); } -double G77_dbesjn_0 (const integer *n, double *x) { - return jn (*n, *x); - } +double +G77_dbesjn_0 (const integer * n, double *x) +{ + return jn (*n, *x); +} -double G77_dbesy0_0 (const double *x) { - return y0 (*x); +double +G77_dbesy0_0 (const double *x) +{ + return y0 (*x); } -double G77_dbesy1_0 (const double *x) { - return y1 (*x); +double +G77_dbesy1_0 (const double *x) +{ + return y1 (*x); } -double G77_dbesyn_0 (const integer *n, double *x) { - return yn (*n, *x); +double +G77_dbesyn_0 (const integer * n, double *x) +{ + return yn (*n, *x); } #endif diff --git a/contrib/libf2c/libU77/dtime_.c b/contrib/libf2c/libU77/dtime_.c index 19100e6..dc9a863 100644 --- a/contrib/libf2c/libU77/dtime_.c +++ b/contrib/libf2c/libU77/dtime_.c @@ -44,19 +44,8 @@ Boston, MA 02111-1307, USA. */ #include <errno.h> /* for ENOSYS */ #include "f2c.h" -/* 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; - -#ifdef KR_headers -double G77_dtime_0 (tarray) - real tarray[2]; -#else -double G77_dtime_0 (real tarray[2]) -#endif +double +G77_dtime_0 (real tarray[2]) { #if defined (_WIN32) static int win32_platform = -1; @@ -68,7 +57,7 @@ double G77_dtime_0 (real tarray[2]) 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) @@ -82,7 +71,7 @@ double G77_dtime_0 (real tarray[2]) if (clock_freq == 0) { LARGE_INTEGER freq; - if (! QueryPerformanceFrequency (&freq)) + if (!QueryPerformanceFrequency (&freq)) { errno = ENOSYS; return 0.0; @@ -90,15 +79,15 @@ double G77_dtime_0 (real tarray[2]) else { clock_freq = ((unsigned long long) freq.HighPart << 32) - + ((unsigned) freq.LowPart); + + ((unsigned) freq.LowPart); } } - if (! QueryPerformanceCounter (&counter_val)) + if (!QueryPerformanceCounter (&counter_val)) return -1.0; count = ((unsigned long long) counter_val.HighPart << 32) - + (unsigned) counter_val.LowPart; + + (unsigned) counter_val.LowPart; delta = ((double) (count - old_count)) / clock_freq; tarray[0] = (float) delta; tarray[1] = 0.0; @@ -112,10 +101,10 @@ double G77_dtime_0 (real tarray[2]) 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; + 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; @@ -131,15 +120,21 @@ double G77_dtime_0 (real tarray[2]) 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; + 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 */ +#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; @@ -147,24 +142,31 @@ double G77_dtime_0 (real tarray[2]) /* 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); + if (!clk_tck) + clk_tck = sysconf (_SC_CLK_TCK); # elif defined CLOCKS_PER_SECOND - if (! clk_tck) clk_tck = CLOCKS_PER_SECOND; + if (!clk_tck) + clk_tck = CLOCKS_PER_SECOND; # elif defined CLK_TCK - if (! clk_tck) clk_tck = CLK_TCK; + if (!clk_tck) + clk_tck = CLK_TCK; # elif defined HZ - if (! clk_tck) clk_tck = HZ; + if (!clk_tck) + clk_tck = HZ; # elif defined HAVE_GETRUSAGE # else - #error Dont know clock tick length +#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; + 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]); + old_utime = utime; + old_stime = stime; + return (tarray[0] + tarray[1]); #else /* ! HAVE_GETRUSAGE && ! HAVE_TIMES */ errno = ENOSYS; return 0.0; diff --git a/contrib/libf2c/libU77/etime_.c b/contrib/libf2c/libU77/etime_.c index 88eead3..d0edb2f 100644 --- a/contrib/libf2c/libU77/etime_.c +++ b/contrib/libf2c/libU77/etime_.c @@ -44,19 +44,8 @@ Boston, MA 02111-1307, USA. */ #include <errno.h> /* for ENOSYS */ #include "f2c.h" -/* 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; - -#ifdef KR_headers -double G77_etime_0 (tarray) - real tarray[2]; -#else -double G77_etime_0 (real tarray[2]) -#endif +double +G77_etime_0 (real tarray[2]) { #if defined (_WIN32) static int win32_platform = -1; @@ -69,7 +58,7 @@ double G77_etime_0 (real tarray[2]) 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) @@ -82,7 +71,7 @@ double G77_etime_0 (real tarray[2]) if (clock_freq == 0) { LARGE_INTEGER freq; - if (! QueryPerformanceFrequency (&freq)) + if (!QueryPerformanceFrequency (&freq)) { errno = ENOSYS; return 0.0; @@ -90,19 +79,19 @@ double G77_etime_0 (real tarray[2]) else { clock_freq = ((unsigned long long) freq.HighPart << 32) - + ((unsigned) freq.LowPart); - if (! QueryPerformanceCounter (&counter_val)) + + ((unsigned) freq.LowPart); + if (!QueryPerformanceCounter (&counter_val)) return -1.0; old_count = ((unsigned long long) counter_val.HighPart << 32) - + (unsigned) counter_val.LowPart; + + (unsigned) counter_val.LowPart; } } - if (! QueryPerformanceCounter (&counter_val)) + if (!QueryPerformanceCounter (&counter_val)) return -1.0; count = ((unsigned long long) counter_val.HighPart << 32) - + (unsigned) counter_val.LowPart; + + (unsigned) counter_val.LowPart; tarray[0] = usertime = (double) (count - old_count) / clock_freq; tarray[1] = systime = 0.0; } @@ -114,13 +103,13 @@ double G77_etime_0 (real tarray[2]) GetProcessTimes (GetCurrentProcess (), &creation_time, &exit_time, &kernel_time, &user_time); utime = ((unsigned long long) user_time.dwHighDateTime << 32) - + (unsigned) user_time.dwLowDateTime; + + (unsigned) user_time.dwLowDateTime; stime = ((unsigned long long) kernel_time.dwHighDateTime << 32) - + (unsigned) kernel_time.dwLowDateTime; + + (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) @@ -128,34 +117,45 @@ double G77_etime_0 (real tarray[2]) #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 */ + 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); + if (!clk_tck) + clk_tck = sysconf (_SC_CLK_TCK); # elif defined CLOCKS_PER_SECOND - if (! clk_tck) clk_tck = CLOCKS_PER_SECOND; + if (!clk_tck) + clk_tck = CLOCKS_PER_SECOND; # elif defined CLK_TCK - if (! clk_tck) clk_tck = CLK_TCK; + if (!clk_tck) + clk_tck = CLK_TCK; # elif defined HZ - if (! clk_tck) clk_tck = HZ; + if (!clk_tck) + clk_tck = HZ; # elif defined HAVE_GETRUSAGE # else - #error Dont know clock tick length +#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; + 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]); + return (tarray[0] + tarray[1]); #else /* ! HAVE_GETRUSAGE && ! HAVE_TIMES */ errno = ENOSYS; return 0.0; diff --git a/contrib/libf2c/libU77/fdate_.c b/contrib/libf2c/libU77/fdate_.c index a0bc983..d710a5c 100644 --- a/contrib/libf2c/libU77/fdate_.c +++ b/contrib/libf2c/libU77/fdate_.c @@ -43,12 +43,13 @@ Boston, MA 02111-1307, USA. */ 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) +/* 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); + 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); } diff --git a/contrib/libf2c/libU77/fgetc_.c b/contrib/libf2c/libU77/fgetc_.c index 49f3983..ec94829 100644 --- a/contrib/libf2c/libU77/fgetc_.c +++ b/contrib/libf2c/libU77/fgetc_.c @@ -26,43 +26,36 @@ Boston, MA 02111-1307, USA. */ #include "f2c.h" #include "fio.h" -#ifdef KR_headers -integer G77_fgetc_0 (lunit, c, Lc) - integer *lunit; - ftnlen Lc; /* should be 1 */ - char *c; -#else -integer G77_fgetc_0 (const integer *lunit, char *c, ftnlen Lc) -#endif +integer +G77_fgetc_0 (const integer * lunit, char *c, ftnlen Lc) { int err; FILE *f = f__units[*lunit].ufd; - if (*lunit>=MXUNIT || *lunit<0) + 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) + 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; - - c[0] = err; - while (--Lc) - *++c = ' '; - return 0; } + } } -#ifdef KR_headers -integer G77_fget_0 (c, Lc) - ftnlen Lc; /* should be 1 */ - char *c; -#else -integer G77_fget_0 (char *c, const ftnlen Lc) -#endif +integer +G77_fget_0 (char *c, const ftnlen Lc) { integer five = 5; diff --git a/contrib/libf2c/libU77/flush1_.c b/contrib/libf2c/libU77/flush1_.c index 451915d..7327593 100644 --- a/contrib/libf2c/libU77/flush1_.c +++ b/contrib/libf2c/libU77/flush1_.c @@ -25,22 +25,16 @@ Boston, MA 02111-1307, USA. */ /* This flushes a single unit, c.f. libI77 version. */ -#ifdef KR_headers -extern integer G77_fnum_0 (); - -/* Subroutine */ int G77_flush1_0 (lunit) - integer *lunit; -#else extern integer G77_fnum_0 (integer *); -/* Subroutine */ int G77_flush1_0 (const integer *lunit) -#endif +/* Subroutine */ int +G77_flush1_0 (const integer * lunit) { - if (*lunit>=MXUNIT || *lunit<0) - err(1,101,"flush"); + 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); + fflush (f__units[*lunit].ufd); return 0; } diff --git a/contrib/libf2c/libU77/fnum_.c b/contrib/libf2c/libU77/fnum_.c index 0a3ba01..daf8f3d 100644 --- a/contrib/libf2c/libU77/fnum_.c +++ b/contrib/libf2c/libU77/fnum_.c @@ -22,17 +22,13 @@ Boston, MA 02111-1307, USA. */ #include "f2c.h" #include "fio.h" -#ifdef KR_headers -integer G77_fnum_0 (lunit) - integer *lunit; -#else -integer G77_fnum_0 (integer *lunit) -#endif +integer +G77_fnum_0 (integer * lunit) { - if (*lunit>=MXUNIT || *lunit<0) - err(1,101,"fnum"); + if (*lunit >= MXUNIT || *lunit < 0) + err (1, 101, "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); + return fileno (f__units[*lunit].ufd); } diff --git a/contrib/libf2c/libU77/fputc_.c b/contrib/libf2c/libU77/fputc_.c index 5a1109e..7e45dd4 100644 --- a/contrib/libf2c/libU77/fputc_.c +++ b/contrib/libf2c/libU77/fputc_.c @@ -26,38 +26,29 @@ Boston, MA 02111-1307, USA. */ #include "f2c.h" #include "fio.h" -#ifdef KR_headers -integer G77_fputc_0 (lunit, c, Lc) - integer *lunit; - ftnlen Lc; /* should be 1 */ - char *c; -#else -integer G77_fputc_0 (const integer *lunit, const char *c, const ftnlen Lc) -#endif +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) + 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); - } + if (err == EOF) + { + if (feof (f)) + return -1; + else + return ferror (f); + } else return 0; } -#ifdef KR_headers -integer G77_fput_0 (c, Lc) - ftnlen Lc; /* should be 1 */ - char *c; -#else -integer G77_fput_0 (const char *c, const ftnlen Lc) -#endif +integer +G77_fput_0 (const char *c, const ftnlen Lc) { integer six = 6; diff --git a/contrib/libf2c/libU77/fstat_.c b/contrib/libf2c/libU77/fstat_.c index da5434a..e978c6a 100644 --- a/contrib/libf2c/libU77/fstat_.c +++ b/contrib/libf2c/libU77/fstat_.c @@ -26,17 +26,10 @@ Boston, MA 02111-1307, USA. */ #include <sys/types.h> #include <sys/stat.h> -#ifdef KR_headers -extern integer G77_fnum_0 (); - -integer G77_fstat_0 (lunit, statb) - integer *lunit; - integer statb[13]; -#else extern integer G77_fnum_0 (const integer *); -integer G77_fstat_0 (const integer *lunit, integer statb[13]) -#endif +integer +G77_fstat_0 (const integer * lunit, integer statb[13]) { int err; struct stat buf; diff --git a/contrib/libf2c/libU77/gerror_.c b/contrib/libf2c/libU77/gerror_.c index 6f5943c..252440d 100644 --- a/contrib/libf2c/libU77/gerror_.c +++ b/contrib/libf2c/libU77/gerror_.c @@ -29,21 +29,16 @@ Boston, MA 02111-1307, USA. */ #include "f2c.h" #ifndef HAVE_STRERROR - extern char *sys_errlist []; +extern char *sys_errlist[]; # define strerror(i) (sys_errlist[i]) #endif -#ifdef KR_headers -extern void s_copy (); -/* Subroutine */ int G77_gerror_0 (str, Lstr) - char *str; ftnlen Lstr; -#else -extern void s_copy(register char *a, register char *b, ftnlen la, ftnlen lb); -/* Subroutine */ int G77_gerror_0 (char *str, ftnlen Lstr) -#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; + char *s; - s = strerror(errno); + s = strerror (errno); s_copy (str, s, Lstr, strlen (s)); return 0; } diff --git a/contrib/libf2c/libU77/getcwd_.c b/contrib/libf2c/libU77/getcwd_.c index e757803..75277af 100644 --- a/contrib/libf2c/libU77/getcwd_.c +++ b/contrib/libf2c/libU77/getcwd_.c @@ -34,26 +34,22 @@ Boston, MA 02111-1307, USA. */ #ifdef HAVE_UNISTD_H # include <unistd.h> #else - extern char *getcwd (); +extern char *getcwd (); #endif -#ifdef KR_headers -extern void s_copy (); -integer G77_getcwd_0 (str, Lstr) - char *str; ftnlen Lstr; -#else -extern void s_copy(register char *a, register char *b, ftnlen la, ftnlen lb); -integer G77_getcwd_0 (char *str, const ftnlen Lstr) -#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; + int i; + char *ret; - ret = getcwd (str, Lstr); - if (ret == NULL) return errno; - for (i=strlen(str); i<Lstr; i++) - str[i] = ' '; - return 0; + 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 */ @@ -61,37 +57,30 @@ integer G77_getcwd_0 (char *str, const ftnlen Lstr) /* getwd usage taken from SunOS4 man */ # include <sys/param.h> - extern char *getwd (); -#ifdef KR_headers -extern VOID s_copy (); -integer G77_getcwd_0 (str, Lstr) - char *str; ftnlen Lstr; -#else -extern void s_copy(register char *a, register char *b, ftnlen la, ftnlen lb); -integer G77_getcwd_0 (char *str, const ftnlen Lstr) -#endif +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; - } + if (getwd (pathname) == NULL) + { + return errno; + } + else + { + s_copy (str, pathname, Lstr, strlen (str)); + return 0; + } } -#else /* !HAVE_GETWD && !HAVE_GETCWD */ +#else /* !HAVE_GETWD && !HAVE_GETCWD */ -#ifdef KR_headers -extern VOID s_copy (); -integer G77_getcwd_0 (str, Lstr) - char *str; ftnlen Lstr; -#else -extern void s_copy(register char *a, register char *b, ftnlen la, ftnlen lb); -integer G77_getcwd_0 (char *str, const ftnlen Lstr) -#endif +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; } diff --git a/contrib/libf2c/libU77/getgid_.c b/contrib/libf2c/libU77/getgid_.c index b489bac..7dcbdf8 100644 --- a/contrib/libf2c/libU77/getgid_.c +++ b/contrib/libf2c/libU77/getgid_.c @@ -26,11 +26,8 @@ Boston, MA 02111-1307, USA. */ #include <errno.h> /* for ENOSYS */ #include "f2c.h" -#ifdef KR_headers -integer G77_getgid_0 () -#else -integer G77_getgid_0 (void) -#endif +integer +G77_getgid_0 (void) { #if defined (HAVE_GETGID) return getgid (); diff --git a/contrib/libf2c/libU77/getlog_.c b/contrib/libf2c/libU77/getlog_.c index 82cb564..94c5f41 100644 --- a/contrib/libf2c/libU77/getlog_.c +++ b/contrib/libf2c/libU77/getlog_.c @@ -41,14 +41,9 @@ Boston, MA 02111-1307, USA. */ /* SGI also has character*(*) function getlog() */ -#ifdef KR_headers -extern VOID s_copy (); -/* Subroutine */ int G77_getlog_0 (str, Lstr) - char *str; ftnlen Lstr; -#else -extern void s_copy(register char *a, register char *b, ftnlen la, ftnlen lb); -/* Subroutine */ int G77_getlog_0 (char *str, const ftnlen Lstr) -#endif +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; @@ -56,12 +51,15 @@ extern void s_copy(register char *a, register char *b, ftnlen la, ftnlen lb); #if defined (HAVE_GETLOGIN) p = getlogin (); - if (p != NULL) { - i = strlen (p); - s_copy (str, p, Lstr, i); - } else { - s_copy (str, " ", Lstr, 1); - } + if (p != NULL) + { + i = strlen (p); + s_copy (str, p, Lstr, i); + } + else + { + s_copy (str, " ", Lstr, 1); + } status = 0; #else errno = ENOSYS; diff --git a/contrib/libf2c/libU77/getpid_.c b/contrib/libf2c/libU77/getpid_.c index fa48478..6f1d8d7 100644 --- a/contrib/libf2c/libU77/getpid_.c +++ b/contrib/libf2c/libU77/getpid_.c @@ -25,11 +25,8 @@ Boston, MA 02111-1307, USA. */ #include <sys/types.h> #include "f2c.h" -#ifdef KR_headers -integer G77_getpid_0 () -#else -integer G77_getpid_0 (void) -#endif +integer +G77_getpid_0 (void) { return getpid (); } diff --git a/contrib/libf2c/libU77/getuid_.c b/contrib/libf2c/libU77/getuid_.c index 408ff0a..d88b8e2 100644 --- a/contrib/libf2c/libU77/getuid_.c +++ b/contrib/libf2c/libU77/getuid_.c @@ -26,11 +26,8 @@ Boston, MA 02111-1307, USA. */ #include <errno.h> /* for ENOSYS */ #include "f2c.h" -#ifdef KR_headers -integer G77_getuid_0 () -#else -integer G77_getuid_0 (void) -#endif +integer +G77_getuid_0 (void) { #if defined (HAVE_GETUID) return getuid (); diff --git a/contrib/libf2c/libU77/gmtime_.c b/contrib/libf2c/libU77/gmtime_.c index 8036b5a..9de3c5a 100644 --- a/contrib/libf2c/libU77/gmtime_.c +++ b/contrib/libf2c/libU77/gmtime_.c @@ -33,12 +33,8 @@ Boston, MA 02111-1307, USA. */ #endif #include "f2c.h" -#ifdef KR_headers -/* Subroutine */ int G77_gmtime_0 (xstime, tarray) - integer *xstime, tarray[9]; -#else -/* Subroutine */ int G77_gmtime_0 (const integer * xstime, integer tarray[9]) -#endif +/* Subroutine */ int +G77_gmtime_0 (const integer * xstime, integer tarray[9]) { struct tm *lt; time_t stime = *xstime; diff --git a/contrib/libf2c/libU77/hostnm_.c b/contrib/libf2c/libU77/hostnm_.c index fd717b9..7f511f4 100644 --- a/contrib/libf2c/libU77/hostnm_.c +++ b/contrib/libf2c/libU77/hostnm_.c @@ -30,20 +30,22 @@ Boston, MA 02111-1307, USA. */ #include <errno.h> /* for ENOSYS */ #include "f2c.h" -integer G77_hostnm_0 (char *name, ftnlen Lname) +integer +G77_hostnm_0 (char *name, ftnlen Lname) { - int ret, i; + 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] = ' '; + 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; + return ret; #else - return errno = ENOSYS; + return errno = ENOSYS; #endif } diff --git a/contrib/libf2c/libU77/idate_.c b/contrib/libf2c/libU77/idate_.c index 572efd9..f2bea12 100644 --- a/contrib/libf2c/libU77/idate_.c +++ b/contrib/libf2c/libU77/idate_.c @@ -37,17 +37,13 @@ Boston, MA 02111-1307, USA. */ /* libU77 one: */ -#ifdef KR_headers -/* Subroutine */ int G77_idate_0 (iarray) - int iarray[3]; -#else -/* Subroutine */ int G77_idate_0 (int iarray[3]) -#endif +/* Subroutine */ int +G77_idate_0 (int iarray[3]) { struct tm *lt; time_t tim; - tim = time(NULL); - lt = localtime(&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 diff --git a/contrib/libf2c/libU77/ierrno_.c b/contrib/libf2c/libU77/ierrno_.c index 557b53a..0dc76b0 100644 --- a/contrib/libf2c/libU77/ierrno_.c +++ b/contrib/libf2c/libU77/ierrno_.c @@ -22,11 +22,8 @@ Boston, MA 02111-1307, USA. */ #include <errno.h> #include "f2c.h" -#ifdef KR_headers -integer G77_ierrno_0 () -#else -integer G77_ierrno_0 (void) -#endif +integer +G77_ierrno_0 (void) { return errno; } diff --git a/contrib/libf2c/libU77/irand_.c b/contrib/libf2c/libU77/irand_.c index 2bf14cc..a905431 100644 --- a/contrib/libf2c/libU77/irand_.c +++ b/contrib/libf2c/libU77/irand_.c @@ -31,27 +31,18 @@ Boston, MA 02111-1307, USA. */ /* Note this is per SunOS -- other s may have no arg. */ -#ifdef KR_headers -integer G77_irand_0 (flag) - integer *flag; -#else -integer G77_irand_0 (integer *flag) -#endif +integer +G77_irand_0 (integer * flag) { - switch (*flag) { - case 0: - break; - case 1: - srand (0); /* Arbitrary choice of initialiser. */ - break; - default: - srand (*flag); - } + switch (*flag) + { + case 0: + break; + case 1: + srand (0); /* Arbitrary choice of initialiser. */ + break; + default: + srand (*flag); + } return rand (); } - - - - - - diff --git a/contrib/libf2c/libU77/isatty_.c b/contrib/libf2c/libU77/isatty_.c index 92c3346..fa2f56d 100644 --- a/contrib/libf2c/libU77/isatty_.c +++ b/contrib/libf2c/libU77/isatty_.c @@ -25,20 +25,14 @@ Boston, MA 02111-1307, USA. */ #include "f2c.h" #include "fio.h" -#ifdef KR_headers -extern integer G77_fnum_0 (); - -logical G77_isatty_0 (lunit) - integer *lunit; -#else extern integer G77_fnum_0 (integer *); -logical G77_isatty_0 (integer *lunit) -#endif +logical +G77_isatty_0 (integer * lunit) { - if (*lunit>=MXUNIT || *lunit<0) - err(1,101,"isatty"); + 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_); + return (isatty (G77_fnum_0 (lunit)) ? TRUE_ : FALSE_); } diff --git a/contrib/libf2c/libU77/itime_.c b/contrib/libf2c/libU77/itime_.c index ad47872..12a7864 100644 --- a/contrib/libf2c/libU77/itime_.c +++ b/contrib/libf2c/libU77/itime_.c @@ -33,18 +33,14 @@ Boston, MA 02111-1307, USA. */ #endif #include "f2c.h" -#ifdef KR_headers -/* Subroutine */ int G77_itime_0 (tarray) - integer tarray[3]; -#else -/* Subroutine */ int G77_itime_0 (integer tarray[3]) -#endif +/* Subroutine */ int +G77_itime_0 (integer tarray[3]) { struct tm *lt; time_t tim; - tim = time(NULL); - lt = localtime(&tim); + tim = time (NULL); + lt = localtime (&tim); tarray[0] = lt->tm_hour; tarray[1] = lt->tm_min; tarray[2] = lt->tm_sec; diff --git a/contrib/libf2c/libU77/kill_.c b/contrib/libf2c/libU77/kill_.c index 99197bd..41eab15 100644 --- a/contrib/libf2c/libU77/kill_.c +++ b/contrib/libf2c/libU77/kill_.c @@ -26,15 +26,11 @@ Boston, MA 02111-1307, USA. */ /* fixme: bsd, svr1-3 use int, not pid_t */ -#ifdef KR_headers -integer G77_kill_0 (pid, signum) - integer *pid, *signum; -#else -integer G77_kill_0 (const integer *pid, const integer *signum) -#endif +integer +G77_kill_0 (const integer * pid, const integer * signum) { #if defined (HAVE_KILL) - return kill ((pid_t) *pid, *signum) ? errno : 0; + return kill ((pid_t) * pid, *signum) ? errno : 0; #else errno = ENOSYS; return -1; diff --git a/contrib/libf2c/libU77/link_.c b/contrib/libf2c/libU77/link_.c index 003fac8..f3070e4 100644 --- a/contrib/libf2c/libU77/link_.c +++ b/contrib/libf2c/libU77/link_.c @@ -34,30 +34,27 @@ Boston, MA 02111-1307, USA. */ #include <errno.h> /* for ENOSYS */ #include "f2c.h" -#ifdef KR_headers -void g_char (); +void g_char (const char *a, ftnlen alen, char *b); -integer G77_link_0 (path1, path2, Lpath1, Lpath2) - char *path1, *path2; ftnlen Lpath1, Lpath2; -#else -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) -#endif +integer +G77_link_0 (const char *path1, const char *path2, const ftnlen Lpath1, + const ftnlen Lpath2) { #if defined (HAVE_LINK) char *buff1, *buff2; - char *bp, *blast; int i; - buff1 = malloc (Lpath1+1); - if (buff1 == NULL) return -1; + buff1 = malloc (Lpath1 + 1); + if (buff1 == NULL) + return -1; g_char (path1, Lpath1, buff1); - buff2 = malloc (Lpath2+1); - if (buff2 == NULL) return -1; + buff2 = malloc (Lpath2 + 1); + if (buff2 == NULL) + return -1; g_char (path2, Lpath2, buff2); i = link (buff1, buff2); - free (buff1); free (buff2); + free (buff1); + free (buff2); return i ? errno : 0; #else /* ! HAVE_LINK */ errno = ENOSYS; diff --git a/contrib/libf2c/libU77/lnblnk_.c b/contrib/libf2c/libU77/lnblnk_.c index 806eca2..f21ac42 100644 --- a/contrib/libf2c/libU77/lnblnk_.c +++ b/contrib/libf2c/libU77/lnblnk_.c @@ -21,15 +21,18 @@ Boston, MA 02111-1307, USA. */ #include "f2c.h" -integer G77_lnblnk_0 (char *str, ftnlen str_len) +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; + 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; + return ret_val; } diff --git a/contrib/libf2c/libU77/lstat_.c b/contrib/libf2c/libU77/lstat_.c index 801f6aa..3914cc6 100644 --- a/contrib/libf2c/libU77/lstat_.c +++ b/contrib/libf2c/libU77/lstat_.c @@ -30,27 +30,19 @@ Boston, MA 02111-1307, USA. */ /* lstat isn't posix */ -#ifdef KR_headers -void g_char(); +void g_char (const char *a, ftnlen alen, char *b); -integer G77_lstat_0 (name, statb, Lname) - char *name; - integer statb[13]; - ftnlen Lname; -#else -void g_char(const char *a, ftnlen alen, char *b); - -integer G77_lstat_0 (const char *name, integer statb[13], const ftnlen Lname) -#endif +integer +G77_lstat_0 (const char *name, integer statb[13], const ftnlen Lname) { #if HAVE_LSTAT char *buff; - char *bp, *blast; int err; struct stat buf; - buff = malloc (Lname+1); - if (buff == NULL) return -1; + buff = malloc (Lname + 1); + if (buff == NULL) + return -1; g_char (name, Lname, buff); err = lstat (buff, &buf); free (buff); @@ -80,7 +72,7 @@ integer G77_lstat_0 (const char *name, integer statb[13], const ftnlen Lname) statb[12] = -1; #endif return err; -#else /* !HAVE_LSTAT */ +#else /* !HAVE_LSTAT */ return errno = ENOSYS; -#endif /* !HAVE_LSTAT */ +#endif /* !HAVE_LSTAT */ } diff --git a/contrib/libf2c/libU77/ltime_.c b/contrib/libf2c/libU77/ltime_.c index d4afa87..008df1d 100644 --- a/contrib/libf2c/libU77/ltime_.c +++ b/contrib/libf2c/libU77/ltime_.c @@ -33,12 +33,8 @@ Boston, MA 02111-1307, USA. */ #endif #include "f2c.h" -#ifdef KR_headers -/* Subroutine */ int G77_ltime_0 (xstime, tarray) - integer *xstime, tarray[9]; -#else -/* Subroutine */ int G77_ltime_0 (const integer * xstime, integer tarray[9]) -#endif +/* Subroutine */ int +G77_ltime_0 (const integer * xstime, integer tarray[9]) { struct tm *lt; time_t stime = *xstime; diff --git a/contrib/libf2c/libU77/mclock_.c b/contrib/libf2c/libU77/mclock_.c index 6b7e81b..686c4906 100644 --- a/contrib/libf2c/libU77/mclock_.c +++ b/contrib/libf2c/libU77/mclock_.c @@ -33,11 +33,8 @@ Boston, MA 02111-1307, USA. */ /* Reported by wd42ej@sgi83.wwb.noaa.gov (Russ Jones AUTO-Sun3) on AIX. */ -#ifdef KR_headers -longint G77_mclock_0 () -#else -longint G77_mclock_0 (void) -#endif +longint +G77_mclock_0 (void) { #if HAVE_CLOCK return clock (); diff --git a/contrib/libf2c/libU77/perror_.c b/contrib/libf2c/libU77/perror_.c index 26d8582..6fe96aa 100644 --- a/contrib/libf2c/libU77/perror_.c +++ b/contrib/libf2c/libU77/perror_.c @@ -28,19 +28,15 @@ Boston, MA 02111-1307, USA. */ #endif #include "f2c.h" -#ifdef KR_headers -/* Subroutine */ int G77_perror_0 (str, Lstr) - char *str; ftnlen Lstr; -#else -/* Subroutine */ int G77_perror_0 (const char *str, const ftnlen Lstr) -#endif +/* 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' ; ) + for (bp = buff; bp < blast && *str != '\0';) *bp++ = *str++; *bp = '\0'; perror (buff); diff --git a/contrib/libf2c/libU77/rand_.c b/contrib/libf2c/libU77/rand_.c index 165aee1..1592dc5 100644 --- a/contrib/libf2c/libU77/rand_.c +++ b/contrib/libf2c/libU77/rand_.c @@ -34,21 +34,18 @@ Boston, MA 02111-1307, USA. */ /* Note this is per SunOS -- other s may have no arg. */ -#ifdef KR_headers -double G77_rand_0 (flag) - integer *flag; -#else -double G77_rand_0 (integer *flag) -#endif +double +G77_rand_0 (integer * flag) { - switch (*flag) { - case 0: - break; - case 1: - srand (0); /* Arbitrary choice of initialiser. */ - break; - default: - srand (*flag); - } + switch (*flag) + { + case 0: + break; + case 1: + srand (0); /* Arbitrary choice of initialiser. */ + break; + default: + srand (*flag); + } return (float) rand () / RAND_MAX; } diff --git a/contrib/libf2c/libU77/rename_.c b/contrib/libf2c/libU77/rename_.c index 9583001..59759bc 100644 --- a/contrib/libf2c/libU77/rename_.c +++ b/contrib/libf2c/libU77/rename_.c @@ -29,28 +29,25 @@ Boston, MA 02111-1307, USA. */ #include <errno.h> #include "f2c.h" -#ifdef KR_headers -void g_char (); +void g_char (const char *a, ftnlen alen, char *b); -integer G77_rename_0 (path1, path2, Lpath1, Lpath2) - char *path1, *path2; ftnlen Lpath1, Lpath2; -#else -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) -#endif +integer +G77_rename_0 (const char *path1, const char *path2, const ftnlen Lpath1, + const ftnlen Lpath2) { char *buff1, *buff2; - char *bp, *blast; int i; - buff1 = malloc (Lpath1+1); - if (buff1 == NULL) return -1; + buff1 = malloc (Lpath1 + 1); + if (buff1 == NULL) + return -1; g_char (path1, Lpath1, buff1); - buff2 = malloc (Lpath2+1); - if (buff2 == NULL) return -1; + buff2 = malloc (Lpath2 + 1); + if (buff2 == NULL) + return -1; g_char (path2, Lpath2, buff2); i = rename (buff1, buff2); - free (buff1); free (buff2); + free (buff1); + free (buff2); return i ? errno : 0; } diff --git a/contrib/libf2c/libU77/secnds_.c b/contrib/libf2c/libU77/secnds_.c index 1942528..1d661a9 100644 --- a/contrib/libf2c/libU77/secnds_.c +++ b/contrib/libf2c/libU77/secnds_.c @@ -36,16 +36,16 @@ Boston, MA 02111-1307, USA. */ /* This is a VMS intrinsic. */ -double G77_secnds_0 (real *r) +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; + 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; } - diff --git a/contrib/libf2c/libU77/second_.c b/contrib/libf2c/libU77/second_.c index 41bb5a9..b40474a 100644 --- a/contrib/libf2c/libU77/second_.c +++ b/contrib/libf2c/libU77/second_.c @@ -18,7 +18,9 @@ Boston, MA 02111-1307, USA. */ #include "f2c.h" -double G77_second_0 () { +double +G77_second_0 () +{ extern double G77_etime_0 (); real tarray[2]; diff --git a/contrib/libf2c/libU77/sleep_.c b/contrib/libf2c/libU77/sleep_.c index 36e1b8d..fcf112a 100644 --- a/contrib/libf2c/libU77/sleep_.c +++ b/contrib/libf2c/libU77/sleep_.c @@ -25,12 +25,8 @@ Boston, MA 02111-1307, USA. */ #include "f2c.h" /* Subroutine */ -#ifdef KR_headers -int G77_sleep_0 (seconds) - integer *seconds; -#else -int G77_sleep_0 (const integer *seconds) -#endif +int +G77_sleep_0 (const integer * seconds) { (void) sleep ((unsigned int) *seconds); return 0; diff --git a/contrib/libf2c/libU77/srand_.c b/contrib/libf2c/libU77/srand_.c index 8edc62e..822d980 100644 --- a/contrib/libf2c/libU77/srand_.c +++ b/contrib/libf2c/libU77/srand_.c @@ -24,13 +24,9 @@ Boston, MA 02111-1307, USA. */ #endif #include "f2c.h" -/* Subroutine */ -#ifdef KR_headers -int G77_srand_0 (seed) - integer *seed; -#else -int G77_srand_0 (const integer *seed) -#endif +/* Subroutine */ +int +G77_srand_0 (const integer * seed) { srand ((unsigned int) *seed); return 0; diff --git a/contrib/libf2c/libU77/stat_.c b/contrib/libf2c/libU77/stat_.c index b24f389..65a63b7 100644 --- a/contrib/libf2c/libU77/stat_.c +++ b/contrib/libf2c/libU77/stat_.c @@ -27,26 +27,18 @@ Boston, MA 02111-1307, USA. */ #include <sys/stat.h> #include "f2c.h" -#ifdef KR_headers -void g_char (); +void g_char (const char *a, ftnlen alen, char *b); -integer G77_stat_0 (name, statb, Lname) - char *name; - integer statb[13]; - ftnlen Lname; -#else -void g_char(const char *a, ftnlen alen, char *b); - -integer G77_stat_0 (const char *name, integer statb[13], const ftnlen Lname) -#endif +integer +G77_stat_0 (const char *name, integer statb[13], const ftnlen Lname) { char *buff; - char *bp, *blast; int err; struct stat buf; - buff = malloc (Lname+1); - if (buff == NULL) return -1; + buff = malloc (Lname + 1); + if (buff == NULL) + return -1; g_char (name, Lname, buff); err = stat (buff, &buf); free (buff); diff --git a/contrib/libf2c/libU77/symlnk_.c b/contrib/libf2c/libU77/symlnk_.c index 4b0bf24..92ec605 100644 --- a/contrib/libf2c/libU77/symlnk_.c +++ b/contrib/libf2c/libU77/symlnk_.c @@ -33,32 +33,29 @@ Boston, MA 02111-1307, USA. */ #endif #include "f2c.h" -#ifdef KR_headers -void g_char (); +void g_char (const char *a, ftnlen alen, char *b); -integer G77_symlnk_0 (path1, path2, Lpath1, Lpath2) - char *path1, *path2; ftnlen Lpath1, Lpath2; -#else -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) -#endif +integer +G77_symlnk_0 (const char *path1, const char *path2, const ftnlen Lpath1, + const ftnlen Lpath2) { #if HAVE_SYMLINK char *buff1, *buff2; - char *bp, *blast; int i; - buff1 = (char *) malloc (Lpath1+1); - if (buff1 == NULL) return -1; + 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; + buff2 = (char *) malloc (Lpath2 + 1); + if (buff2 == NULL) + return -1; g_char (path2, Lpath2, buff2); i = symlink (buff1, buff2); - free (buff1); free (buff2); + free (buff1); + free (buff2); return i ? errno : 0; -#else /* !HAVE_SYMLINK */ +#else /* !HAVE_SYMLINK */ return errno = ENOSYS; -#endif /* !HAVE_SYMLINK */ +#endif /* !HAVE_SYMLINK */ } diff --git a/contrib/libf2c/libU77/sys_clock_.c b/contrib/libf2c/libU77/sys_clock_.c index 86ee2fd..ea39eea 100644 --- a/contrib/libf2c/libU77/sys_clock_.c +++ b/contrib/libf2c/libU77/sys_clock_.c @@ -43,31 +43,29 @@ Boston, MA 02111-1307, USA. */ #include <errno.h> /* for ENOSYS */ #include "f2c.h" -#ifdef KR_headers -int G77_system_clock_0 (count, count_rate, count_max) - integer *count, *count_rate, *count_max; -#else -int G77_system_clock_0 (integer *count, integer *count_rate, integer *count_max) -#endif +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) { + if (count_rate) + { #ifdef _SC_CLK_TCK - *count_rate = sysconf(_SC_CLK_TCK); + *count_rate = sysconf (_SC_CLK_TCK); #elif defined CLOCKS_PER_SECOND - *count_rate = CLOCKS_PER_SECOND; + *count_rate = CLOCKS_PER_SECOND; #elif defined CLK_TCK - *count_rate = CLK_TCK; + *count_rate = CLK_TCK; #elif defined HZ - *count_rate = HZ; + *count_rate = HZ; #else #error Dont know clock tick length #endif - } + } if (count_max) /* optional arg present? */ - *count_max = INT_MAX; /* dubious */ + *count_max = INT_MAX; /* dubious */ cnt = times (&buffer); if (cnt > (unsigned long) (INT_MAX)) *count = INT_MAX; /* also dubious */ diff --git a/contrib/libf2c/libU77/time_.c b/contrib/libf2c/libU77/time_.c index 73894b0..2eb8a41 100644 --- a/contrib/libf2c/libU77/time_.c +++ b/contrib/libf2c/libU77/time_.c @@ -35,11 +35,8 @@ Boston, MA 02111-1307, USA. */ /* As well as this external function some compilers have an intrinsic subroutine which fills a character argument (which is the VMS way) -- caveat emptor. */ -#ifdef KR_headers -longint G77_time_0 () -#else -longint G77_time_0 (void) -#endif +longint +G77_time_0 (void) { /* There are potential problems with the cast of the time_t here. */ return time (NULL); diff --git a/contrib/libf2c/libU77/ttynam_.c b/contrib/libf2c/libU77/ttynam_.c index c7610fb..ffdf5bf 100644 --- a/contrib/libf2c/libU77/ttynam_.c +++ b/contrib/libf2c/libU77/ttynam_.c @@ -35,28 +35,25 @@ Boston, MA 02111-1307, USA. */ #include <errno.h> /* for ENOSYS */ #include "f2c.h" -#ifdef KR_headers -extern void s_copy (); -extern integer G77_fnum_0 (); -/* Character */ void G77_ttynam_0 (ret_val, ret_val_len, lunit) - char *ret_val; ftnlen ret_val_len; integer *lunit -#else -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) -#endif +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); - } + 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); diff --git a/contrib/libf2c/libU77/umask_.c b/contrib/libf2c/libU77/umask_.c index 203acfa..5c4546a 100644 --- a/contrib/libf2c/libU77/umask_.c +++ b/contrib/libf2c/libU77/umask_.c @@ -23,12 +23,8 @@ Boston, MA 02111-1307, USA. */ #include <sys/stat.h> #include "f2c.h" -#ifdef KR_headers -integer G77_umask_0 (mask) - integer *mask; -#else -integer G77_umask_0 (integer *mask) -#endif +integer +G77_umask_0 (integer * mask) { - return umask ((mode_t) *mask); + return umask ((mode_t) * mask); } diff --git a/contrib/libf2c/libU77/unlink_.c b/contrib/libf2c/libU77/unlink_.c index cd00559..08222d9 100644 --- a/contrib/libf2c/libU77/unlink_.c +++ b/contrib/libf2c/libU77/unlink_.c @@ -33,23 +33,17 @@ Boston, MA 02111-1307, USA. */ #endif #include "f2c.h" -#ifdef KR_headers -void g_char (); +void g_char (const char *a, ftnlen alen, char *b); -integer G77_unlink_0 (str, Lstr) - char *str; ftnlen Lstr; -#else -void g_char(const char *a, ftnlen alen, char *b); - -integer G77_unlink_0 (const char *str, const ftnlen Lstr) -#endif +integer +G77_unlink_0 (const char *str, const ftnlen Lstr) { char *buff; - char *bp, *blast; int i; - buff = malloc (Lstr+1); - if (buff == NULL) return -1; + buff = malloc (Lstr + 1); + if (buff == NULL) + return -1; g_char (str, Lstr, buff); i = unlink (buff); free (buff); diff --git a/contrib/libf2c/libU77/vxtidate_.c b/contrib/libf2c/libU77/vxtidate_.c index e5963af..0563a91 100644 --- a/contrib/libf2c/libU77/vxtidate_.c +++ b/contrib/libf2c/libU77/vxtidate_.c @@ -38,34 +38,28 @@ Boston, MA 02111-1307, USA. */ /* VMS style: */ /* Subroutine */ -#ifdef KR_headers -int G77_vxtidate_y2kbug_0 (m, d, y) - integer *y, *m, *d; -#else -int G77_vxtidate_y2kbug_0 (integer *m, integer *d, integer *y) -#endif +int +G77_vxtidate_y2kbug_0 (integer * m, integer * d, integer * y) { struct tm *lt; time_t tim; - tim = time(NULL); - lt = localtime(&tim); + tim = time (NULL); + lt = localtime (&tim); *y = lt->tm_year % 100; - *m = lt->tm_mon+1; + *m = lt->tm_mon + 1; *d = lt->tm_mday; return 0; } #ifdef PIC extern const char *G77_Non_Y2K_Compliance_Message; -# ifdef KR_headers -int G77_vxtidate_y2kbuggy_0 (m, d, y) - integer *y, *m, *d; -# else -int G77_vxtidate_y2kbuggy_0 (integer *m, integer *d, integer *y) -# endif +int +G77_vxtidate_y2kbuggy_0 (integer * m __attribute__ ((__unused__)), + integer * d __attribute__ ((__unused__)), + integer * y __attribute__ ((__unused__))) { - extern int G77_abort_0(); + extern int G77_abort_0 (); fprintf (stderr, "%s\n", G77_Non_Y2K_Compliance_Message); - G77_abort_0(); + G77_abort_0 (); } #endif diff --git a/contrib/libf2c/libU77/vxttime_.c b/contrib/libf2c/libU77/vxttime_.c index e45cc05..5982748 100644 --- a/contrib/libf2c/libU77/vxttime_.c +++ b/contrib/libf2c/libU77/vxttime_.c @@ -39,17 +39,13 @@ Boston, MA 02111-1307, USA. */ #include "f2c.h" /* Subroutine */ -#ifdef KR_headers -void G77_vxttime_0 (chtime, Lchtime) - char chtime[8]; - ftnlen Lchtime; -#else -void G77_vxttime_0 (char chtime[8], const ftnlen Lchtime) -#endif +void +G77_vxttime_0 (char chtime[8], + const ftnlen Lchtime __attribute__ ((__unused__))) { time_t tim; char *ctim; - tim = time(NULL); + tim = time (NULL); ctim = ctime (&tim); - strncpy (chtime, ctim+11, 8); + strncpy (chtime, ctim + 11, 8); } |
