Commit 0dfb6849 by Richard Henderson Committed by Jeff Law

* runtime directory -- moved into "libfc2" in the toplevel

        directory.
        * Make-lang.in: Remove all runtime related stuff.
Starting libfc2 rearrangement.

From-SVN: r17567
parent 3464ce01
Sun Feb 1 02:26:58 1998 Richard Henderson <rth@cygnus.com>
* runtime directory -- moved into "libfc2" in the toplevel
directory.
* Make-lang.in: Remove all runtime related stuff.
Sun Jan 25 12:32:15 1998 Kaveh R. Ghazi <ghazi@caip.rutgers.edu>
* Make-lang.in (f77.stage1): Depend on stage1-start so parallel
......
......@@ -75,17 +75,6 @@ F77_FLAGS_TO_PASS = \
# you can just change it here if you like.
F77_INSTALL_FLAG = [ -f f77-install-ok -o -f $(srcdir)/f77-install-ok ]
# This flag is similar to F77_INSTALL_FLAG, but controls whether
# to install (ovewrite) f2c-related items on this system. Currently
# these are `include/f2c.h' and `lib/libf2c.a', though at some point
# `bin/f2c' itself might be added to the g77 distribution.
F2C_INSTALL_FLAG = [ -f f2c-install-ok -o -f $(srcdir)/f2c-install-ok ]
# This flag controls whether it is safe to install gcc's libf2c.a
# even when there's already a lib/libf2c.a installed (which, unless
# F2C_INSTALL_FLAG is set, will be left alone).
F2CLIBOK = [ -f f2c-exists-ok -o -f $(srcdir)/f2c-exists-ok ]
# Actual names to use when installing a native compiler.
F77_INSTALL_NAME = `t='$(program_transform_name)'; echo f77 | sed $$t`
G77_INSTALL_NAME = `t='$(program_transform_name)'; echo g77 | sed $$t`
......@@ -101,11 +90,11 @@ G77_CROSS_NAME = `t='$(program_transform_cross_name)'; echo g77 | sed $$t`
F77 f77: f771
# Tell GNU make to ignore these if they exist.
.PHONY: F77 f77 f77-runtime f77-runtime-unsafe f77.all.build f77.all.cross \
f77.start.encap f77.rest.encap f77.info f77.dvi maybe-f2c \
f77.install-normal install-libf77 install-f2c-all install-f2c-header \
install-f2c-lib f77.install-common f77.install-info f77.install-man \
f77.uninstall f77.mostlyclean f77.clean f77.distclean f77.extraclean \
.PHONY: F77 f77 f77.all.build f77.all.cross \
f77.start.encap f77.rest.encap f77.info f77.dvi \
f77.install-normal install-libf77 \
f77.install-common f77.install-info f77.install-man \
f77.uninstall f77.mostlyclean f77.clean f77.distclean \
f77.maintainer-clean f77.realclean f77.stage1 f77.stage2 f77.stage3 \
f77.stage4 f77.distdir f77.rebuilt
......@@ -245,99 +234,13 @@ f771: $(P) $(F77_SRCS) $(LIBDEPS) stamp-objlist f/Makefile
f/Makefile: $(srcdir)/f/Makefile.in $(srcdir)/configure
$(SHELL) config.status
# Note that the runtime is built in the top-level directory rather
# than in f/runtime a la the Cygnus CHILL example; then xgcc -B./ will
# find it. Use an absolute name for GCC_FOR_TARGET (so we don't have
# to keep stage? links around everywhere) unless this value has been
# overridden from the default "./xgcc -B./", hence the case statement.
# We depend on GCC_PASSES through f/runtime/Makefile.
stmp-headers = stmp-headers # to be overrideable in unsafe version
# Depend on stmp-headers, not stmp-int-hdrs, since libF77 needs float.h.
f77-runtime: f/runtime/Makefile include/f2c.h $(stmp-headers) \
f/runtime/libF77/Makefile f/runtime/libI77/Makefile f/runtime/libU77/Makefile
case "$(LANGUAGES)" in \
*f77*) top=`pwd`; \
cd f/runtime && $(MAKE) \
GCC_FOR_TARGET="`case '$(GCC_FOR_TARGET)' in \
'./xgcc -B./') echo $${top}/xgcc -B$${top}/;; \
*) echo '$(GCC_FOR_TARGET)';; esac`" \
GCC_FLAGS="$(GCC_FLAGS)" $(F77_FLAGS_TO_PASS) \
all ;; \
esac
# This one doesn't depend on cc1 etc. but f2c.h may not be found,
# in particular, at present...
f77-runtime-unsafe:
$(MAKE) stmp-headers= GCC_PARTS= f77-runtime
# The configuration of the runtime system relies on an autoconf-type
# configure, not a Cygnus-type one. It needs to be run *after* the
# appropriate (cross-)compiler has been built, thus depend on GCC_PARTS.
# NB, sh uses the *first* value of $a from `a=fred a=joe prog'.
stmp-f2c.h: \
$(srcdir)/f/runtime/f2c.h.in \
$(srcdir)/f/com.h $(srcdir)/f/proj.h \
$(srcdir)/f/runtime/Makefile.in \
$(srcdir)/f/runtime/libF77/Makefile.in \
$(srcdir)/f/runtime/libI77/Makefile.in \
$(srcdir)/f/runtime/libU77/Makefile.in \
$(srcdir)/f/runtime/configure \
$(srcdir)/f/runtime/libU77/configure \
$(GCC_PARTS)
# The make "stage?" in compiler spec. is fully qualified as above
rm -f stmp-f2c.h
case "$(LANGUAGES)" in \
*f77*) top=`pwd`; \
src=`cd $(srcdir); pwd`; \
cd f/runtime; \
$(F77_FLAGS_TO_PASS) \
CC="`case '$(GCC_FOR_TARGET)' in \
'./xgcc -B./') echo $${top}/xgcc -B$${top}/;; \
*) echo '$(GCC_FOR_TARGET)';; esac`" \
CONFIG_SITE=/dev/null $(SHELL) \
$${src}/f/runtime/configure --srcdir=$${src}/f/runtime ;; \
esac
case "$(LANGUAGES)" in \
*f77*) top=`pwd`; \
src=`cd $(srcdir); pwd`; \
cd f/runtime/libU77; \
$(F77_FLAGS_TO_PASS) \
CC="`case '$(GCC_FOR_TARGET)' in \
'./xgcc -B./') echo $${top}/xgcc -B$${top}/;; \
*) echo '$(GCC_FOR_TARGET)';; esac`" \
CONFIG_SITE=/dev/null $(SHELL) \
$${src}/f/runtime/libU77/configure --srcdir=$${src}/f/runtime/libU77 ;; \
esac
touch stmp-f2c.h
# Support parallel build.
include/f2c.h \
f/runtime/Makefile \
f/runtime/libF77/Makefile \
f/runtime/libI77/Makefile \
f/runtime/libU77/Makefile: stmp-f2c.h
#For now, omit f2c stuff. -- burley
#f2c: stmp-headers f/f2c/Makefile
# cd f/f2c; $(MAKE) all
#
#f/f2c/Makefile: $(srcdir)/f/f2c/Makefile.in $(GCC_PARTS) \
# $(srcdir)/config/$(xmake_file) $(srcdir)/config/$(tmake_file)
# top=`pwd`; cd f/f2c; \
# $${top}/f/f2c/configure --srcdir=$${top}/f/f2c
#
# Build hooks:
# I'm not sure there's a way of getting f2c into here conditionally on
# the --enable-f2c flag detected by config-lang.in so kluge it with the
# maybe-f2c target by looking at STAGESTUFF.
# We need to build the runtime after libgcc.a, so as to avoid a circular
# dependence on cplib2.ready. So instead of putting it in LANGUAGES (via
# the f77 rule), it goes at the end of each all.* build rule.
f77.all.build: g77$(exeext) maybe-f2c f77-runtime
f77.all.cross: g77-cross$(exeext) maybe-f2c f77-runtime
f77.start.encap: g77$(exeext) maybe-f2c
f77.rest.encap: f77-runtime
f77.all.build: g77$(exeext)
f77.all.cross: g77-cross$(exeext)
f77.start.encap: g77$(exeext)
f77.rest.encap:
f77.info: f/g77.info
f77.dvi: f/g77.dvi
......@@ -393,69 +296,14 @@ $(srcdir)/f/NEWS: f/news0.texi f/news.texi
cd $(srcdir)/f; $(MAKEINFO) -D NEWSONLY --no-header --no-split \
--no-validate news0.texi -o NEWS
$(srcdir)/f/runtime/configure: $(srcdir)/f/runtime/configure.in
cd $(srcdir)/f/runtime && $(MAKE) srcdir=. -f Makefile.in rebuilt
$(srcdir)/f/runtime/libU77/configure: $(srcdir)/f/runtime/libU77/configure.in
cd $(srcdir)/f/runtime && $(MAKE) srcdir=. -f Makefile.in rebuilt
f77.rebuilt: $(srcdir)/f/g77.info $(srcdir)/f/BUGS $(srcdir)/f/INSTALL \
$(srcdir)/f/NEWS $(srcdir)/f/runtime/configure \
$(srcdir)/f/runtime/libU77/configure
$(srcdir)/f/NEWS
maybe-f2c:
#For now, omit f2c stuff. -- burley
# case "$(STAGESTUFF)" in *f2c*) $(MAKE) f2c;; esac
#
# Install hooks:
# f771 is installed elsewhere as part of $(COMPILERS).
f77.install-normal: install-libf77 install-f2c-all
# Install the F77 run time library.
install-libf77: f77-runtime
# Check for the presence of other versions of the library and includes.
# Test libf2c.* in case of a shared version, for instance.
@if test -z "$(F2CLIBOK)" && \
test -z "$(F2C_INSTALL_FLAG)" && \
test "`echo $(libdir)/libf2c.*`" != "$(libdir)/libf2c.*"; then \
echo ; \
echo 'You already have a version of libf2c installed as' $(libdir)/libf2c.*; \
echo 'To use g77 this must be consistent with the one that will be built.'; \
echo 'You should probably delete it and/or install ./libf2c.a in its place.'; \
echo 'Resume the "make install" after removing the existing library or'; \
echo 'define the make variable F2CLIBOK to avoid this test.'; \
echo 'Check also for' $(includedir)/f2c.h 'per INSTALL instructions.'; \
echo '(Note that a quick and easy way to resume "make -k install" is to'; \
echo 'use "make install-libf77".)'; \
exit 1; else true; fi
if [ -f libf2c.a ] ; then \
$(INSTALL_DATA) libf2c.a $(libsubdir)/libf2c.a; \
if $(RANLIB_TEST) ; then \
(cd $(libsubdir); $(RANLIB) libf2c.a); else true; fi; \
chmod a-x $(libsubdir)/libf2c.a; \
else true; fi
if [ -f include/f2c.h ] ; then \
$(INSTALL_DATA) include/f2c.h $(libsubdir)/include/f2c.h; \
else true; fi
# Install the f2c-related stuff in the directories
# where f2c and vanilla ld might look for them.
install-f2c-all: install-f2c-header install-f2c-lib
install-f2c-header:
-if test -n "$(F2C_INSTALL_FLAG)" && test -f include/f2c.h; then \
$(INSTALL_DATA) include/f2c.h $(includedir)/f2c.h; \
chmod a+r $(includedir)/f2c.h; \
else true; fi
install-f2c-lib:
-if test -n "$(F2C_INSTALL_FLAG)" && test -f libf2c.a; then \
$(INSTALL_DATA) libf2c.a $(libdir)/libf2c.a; \
if $(RANLIB_TEST) ; then \
(cd $(libdir); $(RANLIB) libf2c.a); else true; fi; \
chmod a-x $(libdir)/libf2c.a; \
else true; fi
f77.install-normal: install-libf77
# Install the driver program as $(target)-g77
# and also as either g77 (if native) or $(tooldir)/bin/g77.
......@@ -523,11 +371,6 @@ f77.uninstall:
-rm -rf $(mandir)/$(G77_INSTALL_NAME)$(manext)
-rm -rf $(mandir)/$(G77_CROSS_NAME)$(manext)
-rm -rf $(infodir)/g77.info*
-rm -rf $(libsubdir)/libf2c.a
-if $(F2C_INSTALL_FLAG) ; then \
rm -rf include/f2c.h ; \
rm -rf $(libdir)/libf2c.a ; \
fi
#
# Clean hooks:
# A lot of the ancillary files are deleted by the main makefile.
......@@ -536,72 +379,27 @@ f77.uninstall:
f77.mostlyclean:
-rm -f f/*$(objext)
-rm -f f/fini f/f771 f/stamp-str f/str-*.h f/str-*.j f/intdoc f/ansify f/intdoc.h0
-cd f/runtime; $(MAKE) mostlyclean
-cd $(srcdir)/f/runtime; $(MAKE) -f Makefile.in mostlyclean
f77.clean:
-rm -f g77.c
-cd f/runtime; $(MAKE) clean
-cd $(srcdir)/f/runtime; $(MAKE) -f Makefile.in clean
f77.distclean:
-cd f/runtime; $(MAKE) distclean
-cd $(srcdir)/f/runtime; $(MAKE) -f Makefile.in distclean
-rm -f f/Makefile
# like gcc's extraclean, which does clean f/ for us, but not f/gbe,
# f/runtime, f/runtime/libF77, f/runtime/libI77, and f/runtime/libU77,
# so do those.
f77.extraclean: f77.distclean
-rm -f f/*/=* f/*/"#"* f/*/*~*
-rm -f f/*/patch* f/*/*.orig f/*/*.rej
-rm -f f/*/*.dvi f/*/*.oaux f/*/*.d f/*/*.[zZ] f/*/*.gz
-rm -f f/*/*.tar f/*/*.xtar f/*/*diff f/*/*.diff.* f/*/*.tar.* f/*/*.xtar.* f/*/*diffs
-rm -f f/*/*lose f/*/*.s f/*/*.s[0-9] f/*/*.i
-rm -f f/*/*/=* f/*/*/"#"* f/*/*/*~*
-rm -f f/*/*/patch* f/*/*/*.orig f/*/*/*.rej
-rm -f f/*/*/*.dvi f/*/*/*.oaux f/*/*/*.d f/*/*/*.[zZ] f/*/*/*.gz
-rm -f f/*/*/*.tar f/*/*/*.xtar f/*/*/*diff f/*/*/*.diff.* f/*/*/*.tar.* f/*/*/*.xtar.* f/*/*/*diffs
-rm -f f/*/*/*lose f/*/*/*.s f/*/*/*.s[0-9] f/*/*/*.i
# realclean is the pre-2.7.0 name for maintainer-clean
f77.maintainer-clean f77.realclean: f77.distclean
-cd f/runtime; $(MAKE) maintainer-clean
-cd $(srcdir)/f/runtime; $(MAKE) -f Makefile.in maintainer-clean;; \
-rm -f f/g77.info* f/g77.*aux f/TAGS f/BUGS f/INSTALL f/NEWS f/intdoc.texi
#
# Stage hooks:
# The main makefile has already created stage?/f.
G77STAGESTUFF = f/*$(objext) f/fini f/stamp-str f/str-*.h f/str-*.j
RUNTIMESTAGESTUFF = f/runtime/config.cache f/runtime/config.log \
f/runtime/config.status f/runtime/Makefile f/runtime/stamp-lib
LIBF77STAGESTUFF = f/runtime/libF77/*$(objext) f/runtime/libF77/Makefile
LIBI77STAGESTUFF = f/runtime/libI77/*$(objext) f/runtime/libI77/Makefile
LIBU77STAGESTUFF = f/runtime/libU77/*$(objext) f/runtime/libU77/Makefile \
f/runtime/libU77/config.cache f/runtime/libU77/config.log \
f/runtime/libU77/config.status
f77.stage1: stage1-start
-mv $(G77STAGESTUFF) stage1/f
-mv $(RUNTIMESTAGESTUFF) stage1/f/runtime
-mv $(LIBF77STAGESTUFF) stage1/f/runtime/libF77
-mv $(LIBI77STAGESTUFF) stage1/f/runtime/libI77
-mv $(LIBU77STAGESTUFF) stage1/f/runtime/libU77
f77.stage2: stage2-start
-mv $(G77STAGESTUFF) stage2/f
-mv $(RUNTIMESTAGESTUFF) stage2/f/runtime
-mv $(LIBF77STAGESTUFF) stage2/f/runtime/libF77
-mv $(LIBI77STAGESTUFF) stage2/f/runtime/libI77
-mv $(LIBU77STAGESTUFF) stage2/f/runtime/libU77
f77.stage3: stage3-start
-mv $(G77STAGESTUFF) stage3/f
-mv $(RUNTIMESTAGESTUFF) stage3/f/runtime
-mv $(LIBF77STAGESTUFF) stage3/f/runtime/libF77
-mv $(LIBI77STAGESTUFF) stage3/f/runtime/libI77
-mv $(LIBU77STAGESTUFF) stage3/f/runtime/libU77
f77.stage4: stage4-start
-mv $(G77STAGESTUFF) stage4/f
-mv $(RUNTIMESTAGESTUFF) stage4/f/runtime
-mv $(LIBF77STAGESTUFF) stage4/f/runtime/libF77
-mv $(LIBI77STAGESTUFF) stage4/f/runtime/libI77
-mv $(LIBU77STAGESTUFF) stage4/f/runtime/libU77
#
# Maintenance hooks:
......
Tue Sep 30 00:41:39 1997 Craig Burley <burley@gnu.ai.mit.edu>
Do a better job of printing the offending FORMAT string
when producing a diagnostic:
* libI77/err.c (f__fmtlen): New variable to hold operating
length of format string.
(f__fatal): Use new variable to limit length of printed string.
* libI77/fmt.c (f_s): Don't skip spaces after closing paren,
so nicer message results (and nested case already skips them).
(pars_f): Record operating length of format string as indicated
by a successful call to f_s, or ad-hoc-calculate it if failure,
limiting the length to 80 characters (and stopping at NUL).
(do_fio): Use new variable to limit length of printed string.
* libI77/fmt.h (f__fmtlen): Declare new variable.
* libI77/lread.c (c_le): Set new variable to known length.
Mon Sep 29 16:30:31 1997 Craig Burley <burley@gnu.ai.mit.edu>
Update to Netlib version of 1997-09-23:
* libF77/dtime_.c (dtime_), libF77/etime_.c (dtime_):
Return `double' instead of `float' (these are not used
in g77's version of libf2c).
* libI77/fmt.c, libI77/fmt.h, libI77/rdfmt.c, libI77/wrtfmt.c:
Support machines with 64-bit pointers and 32-bit ints (e.g.
Linux on DEC Alpha).
1997-09-19 Dave Love <d.love@dl.ac.uk>
* libU77/dtime_.c (G77_dtime_0): Fix types in HAVE_GETRUSAGE case
so as not to truncate results to integer values.
Tue Sep 9 00:33:24 1997 Craig Burley <burley@gnu.ai.mit.edu>
* Version 0.5.21 released.
Mon Sep 8 19:39:01 1997 Craig Burley <burley@gnu.ai.mit.edu>
* libI77/close.c (f_exit): Fix thinko, inverted test
of whether initialization done, so exiting now closes
open units again.
Tue Aug 26 01:42:21 1997 Craig Burley <burley@gnu.ai.mit.edu>
From Jim Wilson:
* configure.in: Make sure RANLIB_TEST is set also.
From Robert Lipe <robertl@dgii.com>:
* libU77/getcwd_.c, libU77/hostnm_.c, libU77/lstat_.c:
Also #include <errno.h>, to define ENOSYS.
Tue Aug 26 01:25:58 1997 Craig Burley <burley@gnu.ai.mit.edu>
* Makefile.in (stamp-lib): Put all f2cext.c objects in
a temp directory named libE77, then `ar' them all at
once into libf2c.a, to get the job done a bit faster.
Still remove the objects (and libE77 directory) afterward.
Sun Aug 24 05:04:35 1997 Craig Burley <burley@gnu.ai.mit.edu>
* libU77/rand_.c (G77_rand_0), libU77/dtime_.c (G77_dtime_0),
libU77/etime_.c (G77_etime_0), libU77/secnds_.c (G77_secnds_0),
libU77/second_.c (G77_second_0): Really return `double', not
`doublereal', since the result is cast to `float'.
* f2cext.c: (rand_, dtime_, etime_, secnds_, second_): Ditto.
(erf_, erfc_, besj0_, besj1_, besjn_, besy0_, besy1_,
besyn_, dbesj0_, dbesj1_, dbesjn_, dbesy0_, dbesy1_,
dbesyn_): All of these return `double', not `doublereal',
as they either have `float' or `double' results.
* libU77/bes.c (besj0_, besj1_, besjn_, besy0_, besy1_,
besyn_): Ditto.
* libU77/dbes.c (dbesj0_, dbesj1_, dbesjn_, dbesy0_, dbesy1_,
dbesyn_): Ditto.
Update to Netlib version of 1997-08-16:
* libI77/iio.c: Fix bug in internal writes to an array
of character strings.
* Makefile.in (UOBJ): Restore fixes made by Dan Pettet I
lost, which included the addition of mclock_.o already noted
below, plus adding symlnk_.o.
Thu Aug 21 03:58:34 1997 Craig Burley <burley@gnu.ai.mit.edu>
* Makefile.in (UOBJ): Add mclock_.o, thanks to Mumit Khan!
1997-08-21 Dave Love <d.love@dl.ac.uk>
* libU77/alarm_.c: Fix return type: `integer'.
Mon Aug 11 20:12:42 1997 Craig Burley <burley@gnu.ai.mit.edu>
* Makefile.in ($(lib), stamp-lib): Ensure that library
gets fully updated even if updating was aborted earlier.
* libU77/hostnm_.c (G77_hostnm_0): Return ENOSYS and stuff
in errno if system has no gethostname() function.
* libU77/lstat_.c (G77_lstat_0): Return ENOSYS and stuff
in errno if system has no lstat() function.
* libU77/getcwd_.c (G77_getcwd_0): Return ENOSYS and stuff
in errno if system has no getcwd() or getwd() function.
Test HAVE_GETCWD properly.
* libU77/symlnk_.c (G77_symlink_0): Return ENOSYS and stuff
in errno if system has no symlink() function.
* libU77/mclock_.c (G77_mclock_0): Return -1 if system
has no clock() function.
Mon Aug 11 01:55:36 1997 Craig Burley <burley@gnu.ai.mit.edu>
* Makefile.in (F2CEXT): Add `alarm' to this list.
* f2cext.c (alarm_): Fix some typos in this function.
Delete third `status' argument.
* libU77/alarm_.c: Delete third `status' argument,
as caller gets this from function result; return
status value as function result for caller.
* configure.in: Rename `ac_cv_struct_FILE' to
`g77_cv_struct_FILE' according to 1997-06-26 change.
1997-08-06 Dave Love <d.love@dl.ac.uk>
* libU77/vxtidate_.c: Correct day/month argument order.
* f2cext.c: Likewise.
1997-07-07 Dave Love <d.love@dl.ac.uk>
* f2cext.c: Add alarm_.
* Makefile.in, libU77/Makefile.in: Add alarm_.
* libU77/alarm_.c: New file.
1997-06-26 Dave Love <d.love@dl.ac.uk>
* configure.in: Generally use prefix `g77_' for cached values
we've invented, not `ac_'.
Tue Jun 24 18:50:06 1997 Craig Burley <burley@gnu.ai.mit.edu>
* libI77/ilnw.c (s_wsni): Call f_init() here.
(s_wsli): Ditto.
(e_wsli): Turn off "doing I/O" flag here.
1997-06-20 Dave Love <d.love@dl.ac.uk>
* runtime/configure.in: Check for cygwin32 after Mumit Khan (but
differently); if cygwin32 define NON_UNIX_STDIO and don't define
NON_ANSI_RW_MODES.
Tue Jun 01 06:26:29 1997 Craig Burley <burley@gnu.ai.mit.edu>
* libI77/rsne.c (nl_init): Don't call f_init() here,
since s_rsne() already does.
(c_lir): Call f_init() here instead.
* libI77/rsli.c (e_rsli): Turn off "doing I/O" flag here.
* libI77/sue.c (e_rsue): Ditto.
Sun Jun 22 23:27:22 1997 Craig Burley <burley@gnu.ai.mit.edu>
* libI77/fio.h (err): Mark I/O as no longer in progress
before returning a non-zero error indicator (since
that tells the caller to jump over the remaining I/O
calls, including the corresponding `e_whatever' call).
* libI77/err.c (endif): Ditto.
* libI77/sfe.c (e_wsfe): Ditto.
* libI77/lread.c (ERR): Ditto.
* libI77/lread.c (l_read): Ditto by having quad case
use ERR, not return, to return non-zero error code.
Sat Jun 21 12:31:28 1997 Craig Burley <burley@gnu.ai.mit.edu>
* libI77/open.c (fk_open): Temporarily turn off
"doing I/O" flag during f_open() call to avoid recursive
I/O error.
Tue Jun 17 22:40:47 1997 Craig Burley <burley@gnu.ai.mit.edu>
* err.c, close.c, rewind.c, inquire.c, backspace.c, endfile.c,
iio.c, open.c, Version.c, sfe.c, wsle.c, rsne.c, sue.c, rsfe.c,
lread.c, wsfe.c, fio.h, due.c, dfe.c: Change f__init from
`flag' to `int' and to signal not just whether initialization
has happened (bit 0), but also whether I/O is in progress
already (bit 1). Consistently produce a clear diagnostic
in cases of recursive I/O. Avoid infinite recursion in
f__fatal, in case sig_die triggers another error. Don't
output info on internals if not initialized in f__fatal. Don't
bother closing units in f_exit if initialization hasn't
happened.
Tue Jun 10 12:57:44 1997 Craig Burley <burley@gnu.ai.mit.edu>
Update to Netlib version of 1997-06-09:
* libI77/err.c, libI77/lread.c, libI77/rdfmt.c,
libI77/wref.c: Move some #include's around.
Mon Jun 9 18:11:56 1997 Craig Burley <burley@gnu.ai.mit.edu>
* libU77/kill_.c (kill_): KR_headers version needed
`*' in front of args in decls.
Sun May 25 03:16:53 1997 Craig Burley <burley@gnu.ai.mit.edu>
Update to Netlib version of 1997-05-24:
* libF77/README, libF77/Version.c, libF77/main.c,
libF77/makefile, libF77/s_paus.c, libF77/signal1.h,
libF77/signal_.c, libF77/z_div.c, libI77/Notice,
libI77/README, libI77/Version.c, libI77/dfe.c,
libI77/err.c, libI77/fmt.c, libI77/makefile,
libI77/rawio.h: Apply many, but not all, of the changes
made to libf2c since last update.
* libF77/Makefile.in (MISC), Makefile.in (MISC): Rename
exit.o to exit_.o to go along with Netlib.
* libF77/signal.c: Make the prologue much simpler than
Netlib has it.
Sun May 18 20:56:02 1997 Craig Burley <burley@gnu.ai.mit.edu>
* libU77/unlink_.c, libU77/stat_.c, libU77/symlnk_.c,
libU77/chmod_.c: g_char first arg is const.
* libU77/chmod_.c: s_cat expects ftnlen[], not int[] or
integer[], change types of array and variables
accordingly.
May 7 1997 Daniel Pettet <dan.pettet@bchydro.bc.ca>
* libU77/dbes_.c: Commented out the code in the
same way the bes* routines are commented out. This
was done because corresponding C routines are referenced
directly in com-rt.def.
Mon May 5 13:56:02 1997 Craig Burley <burley@gnu.ai.mit.edu>
* libU77/stat_.c: Reverse KR/ANSI decls of g_char().
Apr 18 1997 Daniel Pettet <dan.pettet@bchydro.bc.ca>
* libF77/F77_aloc.c, libF77/abort_.c, libF77/derf_.c,
libF77/derfc_.c, libF77/ef1asc_.c, libF77/ef1cmc_.c,
libF77/erf_.c, libF77/erfc_.c, libF77/exit.c,
libF77/getarg_.c, libF77/getenv_.c, libF77/iargc_.c,
libF77/s_cat.c, libF77/signal_.c, libF77/system_.c,
libI77/close.c, libI77/ftell_.c, libU77/access_.c,
libU77/bes.c, libU77/chdir_.c, libU77/chmod_.c, libU77/ctime_.c,
libU77/date_.c, libU77/dbes.c, libU77/dtime_.c, libU77/etime_.c,
libU77/fdate_.c, libU77/fgetc_.c, libU77/flush1_.c,
libU77/fnum_.c, libU77/fputc_.c, libU77/fstat_.c,
libU77/gerror_.c, libU77/getcwd_.c, libU77/getgid_.c,
libU77/getlog_.c, libU77/getpid_.c, libU77/getuid_.c,
libU77/gmtime_.c, libU77/hostnm_.c, libU77/idate_.c,
libU77/ierrno_.c, libU77/irand_.c, libU77/isatty_.c,
libU77/itime_.c, libU77/kill_.c, libU77/link_.c,
libU77/lnblnk_.c, libU77/ltime_.c, libU77/mclock_.c,
libU77/perror_.c, libU77/rand_.c, libU77/rename_.c,
libU77/secnds_.c, libU77/second_.c, libU77/sleep_.c,
libU77/srand_.c, libU77/stat_.c, libU77/symlnk_.c,
libU77/system_clock_.c, libU77/time_.c, libU77/ttynam_.c,
libU77/umask_.c, libU77/unlink_.c, libU77/vxtidate_.c,
libU77/vxttime_.c: Completed renaming routines that are directly
callable from g77 to internal names of the form
G77_xxxx_0 that are known as intrinsics by g77.
Apr 8 1997 Daniel Pettet <dan.pettet@bchydro.bc.ca>
* Makefile.in: Add libU77/mclock_.o and libU77/symlnk_.o to UOBJ.
* libU77/Makefile.in: Add mclock_.c to SRCS.
Add mclock_.o and symlnk_.o to OBJS.
Add mclock_.o dependency.
Apr 8 1997 Daniel Pettet <dan.pettet@bchydro.bc.ca>
* libU77/symlnk_.c: Added a couple of (char*) casts to malloc
to silence the compiler.
1997-03-17 Dave Love <d.love@dl.ac.uk>
* libU77/access_.c, libU77/chdir_.c, libU77/chmod_.c,
libU77/link_.c, libU77/lstat_.c, libU77/rename_.c, libU77/stat_.c,
libU77/symlnk_.c, libU77/u77-test.f, libU77/unlink_.c: Strip
trailing blanks from file names for consistency with other
implementations (notably Sun's).
* libU77/chmod_.c: Quote the file name given to the shell.
Mon Mar 10 00:19:17 1997 Craig Burley <burley@gnu.ai.mit.edu>
* libI77/uio.c (do_ud) [PAD_UDread]: Add semicolon to err()
invocation when macro not defined (from Mumit Khan
<khan@xraylith.wisc.edu>).
Fri Feb 28 13:16:50 1997 Craig Burley <burley@gnu.ai.mit.edu>
* Version 0.5.20 released.
Wed Feb 26 20:28:53 1997 Craig Burley <burley@gnu.ai.mit.edu>
* Makefile.in: $(MAKE) invocations now explicitly
specify `-f Makefile', just in case the `makefile's
from the netlib distribution would get used instead.
Mon Feb 24 16:43:39 1997 Craig Burley <burley@gnu.ai.mit.edu>
* libU77/Makefile.in (check): Specify driver, and
don't bother enabling already-enabled intrinsic groups.
Also, get the $(srcdir) version of u77-test.f.
Sat Feb 22 14:08:42 1997 Craig Burley <burley@gnu.ai.mit.edu>
* libU77/u77-test.f: Explicitly declare intrinsics, get
rid of useless CHARACTER declarations on intrinsics (maybe
someday appropriate to implement meaning of that in g77
and restore them?).
Add spin loop just to fatten up the timings a bit.
Clarify ETIME output as having three fields.
Call TIME with CHARACTER*8, not CHARACTER*6, argument.
Call new SECOND intrinsic subroutine, after calling
new DUMDUM subroutine just to ensure the correct value
doesn't get left around in a register or something.
Thu Feb 20 15:22:42 1997 Craig Burley <burley@gnu.ai.mit.edu>
* libU77/bes.c: Comment out all the code, as g77 avoids actually
calling it, going directly to the system's library instead.
Mon Feb 17 02:27:41 1997 Craig Burley <burley@gnu.ai.mit.edu>
* libU77/fgetc_.c (fgetc_): Allow return value to be
CHARACTER*(*), properly handle CHARACTER*0 and blank-pad
CHARACTER*n where n>1.
Tue Feb 11 14:12:19 1997 Craig Burley <burley@gnu.ai.mit.edu>
* Makefile.in: Clarify role of $(srcdir) here. Fix
various targets accordingly. Don't rely at all on
gcc/f/include/ being a link to gcc/include/ -- just
use it directly.
(${srcdir}/configure, ${srcdir}/libU77/configure):
Remove the config.cache files in build directory before
cd'ing to source directory as well.
* libF77/Makefile.in, libI77/Makefile.in (ALL_CFLAGS):
Include `-I.' to pick up build directory.
Use gcc/include/ directly.
* libU77/Makefile.in (ALL_CFLAGS): Include `-I$(srcdir)'
to pick up source directory.
(OBJS): Fix typo in `chmod_.o' (was `chmod.o').
Mon Feb 10 12:54:47 1997 Craig Burley <burley@gnu.ai.mit.edu>
* Makefile.in (UOBJ), libU77/Makefile.in (OBJS): Add
libU77/chmod_.o to list of objects.
* libU77/chmod_.c: Fix up headers.
Fix implementation to not prematurely truncate command
string and make room for trailing null.
* libU77/ctime_.c: Incoming xstime argument is now longint.
* libU77/mclock_.c: Now returns longint.
* libU77/time_.c: Now returns longint.
1997-02-10 Dave Love <d.love@dl.ac.uk>
* etime_.c, dtime_.c: Typo rounded times to seconds.
* date_.c: Add missing return.
* hostnm_.c: #include unistd.h.
Sat Feb 8 03:30:19 1997 Craig Burley <burley@gnu.ai.mit.edu>
INTEGER*8 support built in to f2c.h and libf2c (since
gcc will be used to compile relevant code anyway):
* Makefile.in, libF77/Makefile.in: Add pow_qq.o,
qbitbits.o, and qbitshft.o to $POW and $F90BIT macros,
as appropriate.
* f2c.h.in: Define appropriate types and macros.
Place #error directive correctly.
* configure.in: Determine appropriate types for long
integer (F2C_LONGINT).
Meanwhile, quote strings in #error, for consistency.
Fix restoring of ac_cpp macro.
* configure: Regenerated using autoconf-2.12.
* libF77/Version.c, libI77/Version.c, libU77/Version.c:
Update version numbers.
Change names and code for g77-specific version-printing
routines (shorter names should be safer to link on
weird, 8-char systems).
* libF77/c_cos.c, libF77/c_div.c, libF77/c_exp.c,
libF77/c_log.c, libF77/c_sin.c, libF77/c_sqrt.c,
libF77/d_cnjg.c, libF77/pow_zi.c, libF77/r_cnjg.c,
libF77/z_cos.c, libF77/z_div.c, libF77/z_exp.c,
libF77/z_log.c, libF77/z_sin.c, libF77/z_sqrt.c:
Changed to work properly even when result is aliased
with any inputs.
* libF77/makefile, libI77/makefile: Leave these in
the g77 distribution, so it is easier to track changes
to official libf2c.
* libF77/signal_.c: Eliminate redundant `return 0;'.
* libI77/fio.h (err, errfl): Fix these so they work
(and must be expressed) as statements.
Fix up many users of err() to include trailing semicolon.
* Incorporate changes by Bell Labs to libf2c through 1997-02-07.
1997-02-06 Dave Love <d.love@dl.ac.uk>
* libU77/etime_.c, libU77/dtime_.c: Fix getrusage stuff.
* libU77/config.h.in: Regenerate for HAVE_GETRUSAGE.
* libU77/Makefile.in, libI77/Makefile.in, libF77/Makefile.in:
Redo *clean targets; distclean and maintainer-clean remove the stage?
and include links. This probably want looking at further.
Wed Feb 5 00:21:23 1997 Craig Burley <burley@gnu.ai.mit.edu>
Add libU77 library from Dave Love <d.love@dl.ac.uk>:
* Makefile.in: Add libU77 directory, rules, etc.
* configure.in: New libU77 directory, Makefile, etc.
* Makefile.in, libF77/Makefile.in, libI77/Makefile.in,
libU77/Makefile.in: Reorganize these so $(AR) commands
handled by the top-level Makefile instead of the
subordinates. This permits it to do $(AR) only when
one or more object files actually change, instead of
having to force-update it as was necessary before.
And that had the disadvantage of requiring, e.g., user
root to have access to $(AR) to the library simply to
install g77, which might be problematic on an NFS setup.
(mostlyclean, clean, distclean, maintainer-clean):
Properly handle these rules.
* Makefile.in: Don't invoke config.status here -- let
compiler-level stuff handle all that.
* err.c [MISSING_FILE_ELEMS]: Declare malloc in this case
too, so it doesn't end up as an integer.
Sat Feb 1 02:43:48 1997 Craig Burley <burley@gnu.ai.mit.edu>
* libF77/Makefile.in: More fixup for $(F90BIT) -- wasn't
in list for ar command, and it wasn't correctly listed
in the list of things depending on f2c.h.
* f2c.h.in: Fix up #error directive.
1997-01-31 Dave Love <d.love@dl.ac.uk>
* libF77/Makefile.in ($(lib)): Add $(F90BIT); shouldn't exclude
stuff f2c needs so we can share the library.
Sat Jan 18 19:39:03 1997 Craig Burley <burley@gnu.ai.mit.edu>
* configure.in: No longer define ALWAYS_FLUSH, the
resulting performance is too low.
Wed Dec 18 12:06:02 1996 Craig Burley <burley@gnu.ai.mit.edu>
Patch from Mumit Khan <khan@xraylith.wisc.edu>:
* libF77/s_paus.c: Add __CYGWIN32__ to list of macros
controlling how to pause.
Sun Dec 1 21:25:27 1996 Craig Burley <burley@gnu.ai.mit.edu>
* configure: Regenerated using autoconf-2.12.
Mon Nov 25 21:16:15 1996 Craig Burley <burley@gnu.ai.mit.edu>
* configure: Regenerated using autoconf-2.11.
1996-11-19 Dave Love <d.love@dl.ac.uk>
* libI77/backspace.c: Include sys/types.h for size_t.
Wed Nov 6 14:17:27 1996 Craig Burley <burley@gnu.ai.mit.edu>
* f2c.h.in: Properly comment out the unsupported stuff so
we don't get build-time errors.
* libF77/Version.c, libI77/Version.c: Restore macro definition
of version information.
* libI77/Makefile.in (OBJ): Add ftell_.o to list of objects.
* libI77/uio.c (do_ud): Fix up casts in PAD_UDread case just
like they were fixed in the other case.
Thu Oct 31 22:27:45 1996 Craig Burley <burley@gnu.ai.mit.edu>
* libI77/ftell_.c (fseek_): Map incoming whence argument to
system's actual SEEK_CUR, SEEK_SET, or SEEK_END macro for
fseek(), and crash (gracefully) if the argument is invalid.
1996-10-19 Dave Love <d.love@dl.ac.uk>
* configure.in: Add check that we have the tools to cross-compile
if appropriate.
(NO_EOF_CHAR_CHECK,Skip_f2c_Undefs): Define.
* libF77/Makefile.in (F90BIT): New routines from Netlib.
* f2c.h.in:
Use more sanitary #error (indented for K&R compliance if necessary) if
f2c_i2 defined.
Sync with Netlib: Add `uninteger'. (Commented out) integer*8 stuff.
bit_{test,clear,set} macros.
1996-10-19 Dave Love <d.love@dl.ac.uk>
Update to Netlib version of 1996-09-26.
* libI77/Version.c: Use <stdio.h>, not "stdio.h".
* libF77/Version.c: Likewise.
Wed Aug 28 13:25:29 1996 Dave Love <d.love@dl.ac.uk>
* libI77/rsne.c (x_rsne): Use size_t instead of int.
* libI77/endfile.c (copy): Use size_t in place of int.
Wed Aug 28 13:22:20 1996 Dave Love <d.love@dl.ac.uk>
* libI77/backspace.c (f_back): Cast fread arg to size_t.
Tue Aug 27 19:11:30 1996 Dave Love <d.love@dl.ac.uk>
* libI77/Version.c: Supply */ to avoid apparent nested comment.
Tue Aug 20 09:21:43 1996 Dave Love <d.love@dl.ac.uk>
* libF77/Makefile.in (ALL_CFLAGS): Fix missing ../ for include.
* libI77/Makefile.in (ALL_CFLAGS): Likewise.
Sat Aug 17 13:00:47 1996 Dave Love <d.love@dl.ac.uk>
* (libF77/qbitshft.c, libF77/qbitbits.c, libF77/lbitshft.c,
libF77/lbitbits.c): New file from Netlib. qbit... not currently
compiled.
Sun Jul 7 18:06:33 1996 Dave Love <d.love@dl.ac.uk>
* libF77/z_sqrt.c, libF77/z_sin.c, libF77/z_exp.c, libF77/z_log.c,
libF77/system_.c, libF77/z_cos.c, libF77/signal_.c,
libF77/s_stop.c, libF77/sig_die.c, libF77/s_paus.c,
libF77/s_rnge.c, libF77/s_cat.c, libF77/r_tan.c, libF77/r_tanh.c,
libF77/r_sinh.c, libF77/r_sqrt.c, libF77/r_sin.c, libF77/r_mod.c,
libF77/r_nint.c, libF77/r_lg10.c, libF77/r_log.c, libF77/r_exp.c,
libF77/r_int.c, libF77/r_cosh.c, libF77/r_atn2.c, libF77/r_cos.c,
libF77/r_asin.c, libF77/r_atan.c, libF77/r_acos.c,
libF77/pow_dd.c, libF77/pow_zz.c, libF77/main.c, libF77/i_dnnt.c,
libF77/i_nint.c, libF77/h_dnnt.c, libF77/h_nint.c, libF77/exit.c,
libF77/d_tan.c, libF77/d_tanh.c, libF77/d_sqrt.c, libF77/d_sin.c,
libF77/d_sinh.c, libF77/d_mod.c, libF77/d_nint.c, libF77/d_log.c,
libF77/d_int.c, libF77/d_lg10.c, libF77/d_cosh.c, libF77/d_exp.c,
libF77/d_atn2.c, libF77/d_cos.c, libF77/d_atan.c, libF77/d_acos.c,
libF77/d_asin.c, libF77/c_sqrt.c, libF77/cabs.c, libF77/c_sin.c,
libF77/c_exp.c, libF77/c_log.c, libF77/c_cos.c, libF77/F77_aloc.c,
libF77/abort_.c, libI77/xwsne.c, libI77/wref.c, libI77/util.c,
libI77/uio.c, libI77/rsne.c, libI77/rdfmt.c, libI77/rawio.h,
libI77/open.c, libI77/lread.c, libI77/inquire.c, libI77/fio.h,
libI77/err.c, libI77/endfile.c, libI77/close.c:
Use #include <...>, not #include "..." for mkdeps
Sat Jul 6 21:39:21 1996 Dave Love <d.love@dl.ac.uk>
* libI77/ftell_.c: Added from Netlib distribution.
Sat Mar 30 20:57:24 1996 Dave Love <d.love@dl.ac.uk>
* configure.in: Eliminate explicit use of
{RANLIB,AR}_FOR_TARGET.
* Makefile.in: Likewise.
* libF77/Makefile.in: Likewise.
* libI77/Makefile.in: Likewise.
* configure: Regenerated.
Sat Mar 30 21:02:03 1996 Dave Love <d.love@dl.ac.uk>
* Makefile.in: Eliminate explicit use of
{RANLIB,AR}_FOR_TARGET.
Tue Mar 26 23:39:59 1996 Dave Love <d.love@dl.ac.uk>
* Makefile.in: Remove hardwired RANLIB and RANLIB_TEST (unnoted
change).
Mon Mar 25 21:04:56 1996 Craig Burley <burley@gnu.ai.mit.edu>
* Incorporate changes by Bell Labs to libf2c through 1996-03-23,
including changes to dmg and netlib email addresses.
Tue Mar 19 13:10:02 1996 Craig Burley <burley@gnu.ai.mit.edu>
* Incorporate changes by AT&T/Bellcore to libf2c through 1996-03-19.
* Makefile.in (rebuilt): New target.
* lib[FI]77/Makefile.in: Use $AR_FOR_TARGET, not $AR.
Tue Mar 19 12:53:19 1996 Dave Love <d.love@dl.ac.uk>
* configure.in (ac_cpp): #include <stdio.h> instead
of <features.h>.
Tue Mar 19 12:52:09 1996 Mumit Khan <khan@xraylith.wisc.edu>
* configure.in (ac_cpp): For f2c integer type,
add -I$srcdir/../.. to make it work on mips-ultrix4.2.
Sat Mar 9 17:37:15 1996 Craig Burley <burley@gnu.ai.mit.edu>
* libI77/Makefile.in (.c.o): Add -DAllow_TYQUAD, to enable
I/O support for INTEGER*8.
* f2c.h.in: Turn on longint type.
Fri Dec 29 18:22:01 1995 Craig Burley <burley@gnu.ai.mit.edu>
* Makefile.in: Reorganize the *clean rules to more closely
parallel gcc's.
* lib[FI]77/Makefile.in: Ignore error from $(AR) command,
in case just doing an install and installer has no write
access to library (this is a kludge fix -- perhaps install
targets should never try updating anything?).
Sat Nov 18 19:37:22 1995 Craig Burley (burley@gnu.ai.mit.edu)
* Version 0.5.17 released.
Thu Nov 16 07:20:35 1995 Craig Burley (burley@gnu.ai.mit.edu)
* Incorporate changes by AT&T/Bellcore to libf2c through 1995-11-15.
Fri Sep 22 02:19:59 1995 Craig Burley (burley@gnu.ai.mit.edu)
* libI77/backspace.c, libI77/close.c, libI77/endfile.c,
libI77/fio.h, libI77/inquire.c, libI77/rawio.h,
libF77/s_paus.c: Not an MSDOS system if GO32
is defined, in the sense that the run-time environment
is thus more UNIX-like.
Wed Sep 20 02:24:51 1995 Craig Burley (burley@gnu.ai.mit.edu)
* libF77/Makefile.in, libI77/Makefile.in: Comment out `ld -r -x'
and `mv' line pairs, since `-x' isn't supported on systems
such as Solaris, and these lines don't seem to do anything
useful after all.
Wed Aug 30 15:58:35 1995 Craig Burley (burley@gnu.ai.mit.edu)
* Version 0.5.16 released.
* Incorporate changes by AT&T/Bellcore to libf2c through 950829.
Mon Aug 28 12:50:34 1995 Craig Burley (burley@gnu.ai.mit.edu)
* libF77/Makefile.in, libI77/Makefile.in ($(lib)): Force ar'ing
and ranlib'ing of libf2c.a, else after rm'ing libf2c.a and
doing a make, only libI77 or libF77 would be added to
the newly created archive.
Also, instead of `$?' list all targets explicitly so all
objects are updated in libf2c.a even if only one actually
needs recompiling, for similar reason -- we can't easily tell
if a given object is really up-to-date in libf2c.a, or even
present there.
Sun Aug 27 14:54:24 1995 Craig Burley (burley@gnu.ai.mit.edu)
* libF77/Makefile.in, libI77/Makefile.in: Fix spacing so
initial tabs are present in all appropriate places.
Move identical $(AR) commands in if then/else clauses
to single command preceding if.
(.c.o, Version[FI].o): Use $@ instead of $* because AIX (RS/6000)
says $@ means source, not object, basename, and $@ seems to work
everywhere.
Wed Aug 23 15:44:25 1995 Craig Burley (burley@gnu.ai.mit.edu)
* libF77/system_.c (system_): Declare as returning `ftnint',
consistent with signal_, instead of defaulting to `int'.
Hope dmg@research.att.com agrees, else probably will
change to whatever he determines is correct (and change
g77 accordingly).
Thu Aug 17 08:46:17 1995 Craig Burley (burley@gnu.ai.mit.edu)
* libI77/rsne.c (s_rsne): Call f_init if not already done.
Thu Aug 17 04:35:28 1995 Craig Burley (burley@gnu.ai.mit.edu)
* Incorporate changes by Bellcore to libf2c through 950817.
And this text is for EMACS: (foo at bar).
Wed Aug 16 17:33:06 1995 Craig Burley (burley@gnu.ai.mit.edu)
* libF77/Makefile.in, libI77/Makefile.in (CFLAGS): Put -g1
after configured CFLAGS but before GCC_CFLAGS, so by default
the libraries are built with minimal debugging information.
Fri Jul 28 10:30:15 1995 Dave Love <d.love@dl.ac.uk>
* libI77/open.c (f_open): Call f_init if not already done.
Sat Jul 1 19:31:56 1995 Craig Burley (burley@gnu.ai.mit.edu)
* libF77/system_.c (system_): Make buff one byte bigger so
following byte doesn't get overwritten by call with large
string.
Tue Jun 27 23:28:16 1995 Craig Burley (burley@gnu.ai.mit.edu)
* Incorporate changes by Bellcore to libf2c through 950613.
* libF77/Version.c (__G77_LIBF77_VERSION__): Add this string
to track g77 mods to libf2c.
* libI77/Version.c (__G77_LIBI77_VERSION__): Add this string
to track g77 mods to libf2c.
* libI77/rawio.h: #include <rawio.h> only conditionally,
using macro intended for that purpose.
Fri May 19 11:20:00 1995 Craig Burley (burley@gnu.ai.mit.edu)
* configure.in: Incorporate change made by d.love,
* configure: Regenerated.
Wed Apr 26 21:08:57 BST 1995 Dave Love <d.love@dl.ac.uk>
* configure.in: Fix quoting problem in atexit check.
* configure: Regenerated (with current autoconf).
Wed Mar 15 12:49:58 1995 Craig Burley (burley@gnu.ai.mit.edu)
* Incorporate changes by Bellcore to libf2c through 950315.
Sun Mar 5 18:54:29 1995 Craig Burley (burley@gnu.ai.mit.edu)
* README: Tell people not to read lib[fi]77/README.
Wed Feb 15 14:30:58 1995 Craig Burley (burley@gnu.ai.mit.edu)
* configure.in: Update copyright notice at top of file.
* f2c.h.in (f2c_i2): Make sure defining this crashes compilations.
* libI77/Makefile.in (F2C_H): Fix typo in definition of this
symbol (was FF2C_H=...).
Sun Feb 12 13:39:36 1995 Craig Burley (burley@gnu.ai.mit.edu)
* README: Remove some obsolete items.
Add date.
* TODO: Add date.
Sat Feb 11 22:07:54 1995 Craig Burley (burley@gnu.ai.mit.edu)
* Makefile.in (libf77, libi77): Add rules to .PHONY list.
* f2c.h.in (flag): Make same type as friends.
* libF77/Makefile.in (libf77): Rename to $(lib), remove from
.PHONY list. Fix some typos.
* libI77/Makefile.in (libi77): Rename to $(lib), remove from
.PHONY list. Fix some typos.
Thu Feb 2 12:22:41 1995 Craig Burley (burley@gnu.ai.mit.edu)
* Makefile.in (libF77/Makefile): Fix typos in this rule's name
and dependencies.
* libF77/Makefile.in (libf77): Add rule to .PHONY list.
* libI77/Makefile.in (libi77): Add rule to .PHONY list.
Sun Jan 18 20:01:37 1998 Toon Moene <toon@moene.indiv.nluug.nl>
* libI77/backspace.c: (f_back): Use type `uiolen' to determine size
of record length specifier.
Sat Jan 17 22:40:31 1998 Mumit Khan <khan@xraylith.wisc.edu>
* libU77/configure.in (sys/param.h,sys/times.h): Check.
(times,alarm): Likewise.
* libU77/config.h.in (HAVE_SYS_PARAM_H, HAVE_SYS_TIMES_H,
HAVE_ALARM, HAVE_TIMES): New defs.
* libU77/alarm_.c: Conditionalize for target platform. Set errno
to ENOSYS if target libc doesn't have the function.
* libU77/dtime_.c: Likewise.
* libU77/etime_.c: Likewise.
* libU77/sys_clock_.c: Likewise.
* configure.in (NON_UNIX_STDIO): Define if MINGW32.
(NON_ANSI_RW_MODE): Do not define for CYGWIN32 or MINGW32.
* libI77/rawio.h: Don't providing conflicting declarations for
read() and write(). MINGW32 header files use "const" quals.
* libF77/s_paus.c: _WIN32 does not have pause().
Tue Nov 18 09:49:04 1997 Mumit Khan (khan@xraylith.wisc.edu)
* libI77/close.c (f_exit): Reset f__init so that f_clos does not
(incorrectly) think there is an I/O recursion when program is
interrupted.
Sat Nov 1 18:03:42 1997 Jeffrey A Law (law@cygnus.com)
* libF77/signal_.c: Undo last change until we can fix it right.
Wed Oct 15 10:06:29 1997 Richard Henderson <rth@cygnus.com>
* libF77/signal_.c (G77_signal_0): Make return type sig_pf as well.
* libI77/fio.h: Include <string.h> if STDC_HEADERS.
* libU77/chmod_.c: Likewise.
Tue Oct 7 18:22:10 1997 Richard Henderson <rth@cygnus.com>
* Makefile.in (CGFLAGS): Don't force -g0.
* libF77/Makefile.in, libI77/Makefile.in, libU77/Makefile.in: Likewise.
Mon Oct 6 14:16:46 1997 Jeffrey A Law (law@cygnus.com)
* Makefile.in (distclean): Do a better job at cleaning up.
Wed Oct 1 01:46:16 1997 Philippe De Muyter <phdm@info.ucl.ac.be>
* libU77/sys_clock_.c: File renamed from system_clock_.c.
libU77/Makefile.in, Makefile.in : Reference sys_clock_.*, not
system_clock_.*.
* libU77/dtime_.c (clk_tck): Try also HZ macro.
* libU77/access.c (G77_access_0): Check malloc return value against 0,
not NULL.
libU77/getlog_.c, libU77/ttynam_.c, libU77/chdir_.c: Ditto.
libU77/chmod_.c, libU77/rename_.c: Ditto.
1997-09-19 Dave Love <d.love@dl.ac.uk>
* libU77/dtime_.c (G77_dtime_0): Fix types in HAVE_GETRUSAGE case
so as not to truncate results to integer values.
* libU77/Version.c: Bump.
Thu Sep 18 16:58:46 1997 Jeffrey A Law (law@cygnus.com)
* Makefile.in (stamp-lib): Don't use '$?', explicitly
list the variables containing the object files to include
in libf2c.a
Fri Sep 5 00:18:17 1997 Jeffrey A Law (law@cygnus.com)
* Makefile.in (clean): Don't remove config.cache.
(distclean): Do it here instead.
Tue Aug 26 20:14:08 1997 Robert Lipe (robertl@dgii.com)
* hostnm_.c: Include errno.h
Mon Aug 25 23:26:05 1997 H.J. Lu (hjl@gnu.ai.mit.edu)
* Makefile.in (mostlyclean, clean): Check if Makefile exists
before using it. Remove stamp-*.
(stamp-libi77, stamp-libf77, stamp-libu77): New.
(stamp-lib): Only depend on stamp-libi77 stamp-libf77
stamp-libu77
# Makefile for GNU F77 compiler runtime.
# Copyright (C) 1995-1997 Free Software Foundation, Inc.
# Contributed by Dave Love (d.love@dl.ac.uk).
#
#This file is part of GNU Fortran.
#
#GNU Fortran is free software; you can redistribute it and/or modify
#it under the terms of the GNU General Public License as published by
#the Free Software Foundation; either version 2, or (at your option)
#any later version.
#
#GNU Fortran is distributed in the hope that it will be useful,
#but WITHOUT ANY WARRANTY; without even the implied warranty of
#MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
#GNU General Public License for more details.
#
#You should have received a copy of the GNU General Public License
#along with GNU Fortran; see the file COPYING. If not, write to
#the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
#02111-1307, USA.
#### Start of system configuration section. ####
# $(srcdir) must be set to the g77 runtime source directory
# (g77/f/runtime/).
srcdir = @srcdir@
VPATH = @srcdir@
top_srcdir = @top_srcdir@
INSTALL = @INSTALL@ # installs aren't actually done from here
INSTALL_PROGRAM = @INSTALL_PROGRAM@
INSTALL_DATA = @INSTALL_DATA@
RANLIB = @RANLIB@
RANLIB_TEST = @RANLIB_TEST@
CFLAGS = @CFLAGS@
CPPFLAGS = @CPPFLAGS@ @DEFS@
LDFLAGS = @LDFLAGS@
LIBS = @LIBS@
CGFLAGS = #-g0
GCC_FOR_TARGET = @CC@
CC = $(GCC_FOR_TARGET)
CROSS = @CROSS@
objext = .o
transform=@program_transform_name@
prefix = @prefix@
exec_prefix = @exec_prefix@
AR = ar
AR_FLAGS = rc
# Directory in which to install scripts.
bindir = $(exec_prefix)/bin
# Directory in which to install library files.
libdir = $(prefix)/lib
# Directory in which to install documentation info files.
infodir = $(prefix)/info
#### End of system configuration section. ####
SHELL = /bin/sh
lib = ../../libf2c.a
SUBDIRS = libI77 libF77 libU77
MISC = libF77/F77_aloc.o libF77/VersionF.o libF77/main.o libF77/s_rnge.o \
libF77/abort_.o libF77/getarg_.o libF77/iargc_.o libF77/getenv_.o \
libF77/signal_.o libF77/s_stop.o libF77/s_paus.o libF77/system_.o \
libF77/cabs.o libF77/derf_.o libF77/derfc_.o libF77/erf_.o \
libF77/erfc_.o libF77/sig_die.o libF77/exit_.o
POW = libF77/pow_ci.o libF77/pow_dd.o libF77/pow_di.o libF77/pow_hh.o \
libF77/pow_ii.o libF77/pow_ri.o libF77/pow_zi.o libF77/pow_zz.o \
libF77/pow_qq.o
CX = libF77/c_abs.o libF77/c_cos.o libF77/c_div.o libF77/c_exp.o \
libF77/c_log.o libF77/c_sin.o libF77/c_sqrt.o
DCX = libF77/z_abs.o libF77/z_cos.o libF77/z_div.o libF77/z_exp.o \
libF77/z_log.o libF77/z_sin.o libF77/z_sqrt.o
REAL = libF77/r_abs.o libF77/r_acos.o libF77/r_asin.o libF77/r_atan.o \
libF77/r_atn2.o libF77/r_cnjg.o libF77/r_cos.o libF77/r_cosh.o \
libF77/r_dim.o libF77/r_exp.o libF77/r_imag.o libF77/r_int.o \
libF77/r_lg10.o libF77/r_log.o libF77/r_mod.o libF77/r_nint.o \
libF77/r_sign.o libF77/r_sin.o libF77/r_sinh.o libF77/r_sqrt.o \
libF77/r_tan.o libF77/r_tanh.o
DBL = libF77/d_abs.o libF77/d_acos.o libF77/d_asin.o libF77/d_atan.o \
libF77/d_atn2.o libF77/d_cnjg.o libF77/d_cos.o libF77/d_cosh.o \
libF77/d_dim.o libF77/d_exp.o libF77/d_imag.o libF77/d_int.o \
libF77/d_lg10.o libF77/d_log.o libF77/d_mod.o libF77/d_nint.o \
libF77/d_prod.o libF77/d_sign.o libF77/d_sin.o libF77/d_sinh.o \
libF77/d_sqrt.o libF77/d_tan.o libF77/d_tanh.o
INT = libF77/i_abs.o libF77/i_dim.o libF77/i_dnnt.o libF77/i_indx.o \
libF77/i_len.o libF77/i_mod.o libF77/i_nint.o libF77/i_sign.o
HALF = libF77/h_abs.o libF77/h_dim.o libF77/h_dnnt.o libF77/h_indx.o \
libF77/h_len.o libF77/h_mod.o libF77/h_nint.o libF77/h_sign.o
CMP = libF77/l_ge.o libF77/l_gt.o libF77/l_le.o libF77/l_lt.o \
libF77/hl_ge.o libF77/hl_gt.o libF77/hl_le.o libF77/hl_lt.o
EFL = libF77/ef1asc_.o libF77/ef1cmc_.o
CHAR = libF77/s_cat.o libF77/s_cmp.o libF77/s_copy.o
F90BIT = libF77/lbitbits.o libF77/lbitshft.o libF77/qbitbits.o \
libF77/qbitshft.o
FOBJ = $(MISC) $(POW) $(CX) $(DCX) $(REAL) $(DBL) $(INT) $(HALF) $(CMP) \
$(EFL) $(CHAR) $(F90BIT)
IOBJ = libI77/VersionI.o libI77/backspace.o libI77/close.o libI77/dfe.o \
libI77/dolio.o libI77/due.o libI77/endfile.o libI77/err.o \
libI77/fmt.o libI77/fmtlib.o libI77/iio.o libI77/ilnw.o \
libI77/inquire.o libI77/lread.o libI77/lwrite.o libI77/open.o \
libI77/rdfmt.o libI77/rewind.o libI77/rsfe.o libI77/rsli.o \
libI77/rsne.o libI77/sfe.o libI77/sue.o libI77/typesize.o \
libI77/uio.o libI77/util.o libI77/wref.o libI77/wrtfmt.o \
libI77/wsfe.o libI77/wsle.o libI77/wsne.o libI77/xwsne.o \
libI77/ftell_.o
UOBJ = libU77/VersionU.o libU77/gerror_.o libU77/perror_.o libU77/ierrno_.o \
libU77/itime_.o libU77/time_.o libU77/unlink_.o libU77/fnum_.o \
libU77/getpid_.o libU77/getuid_.o libU77/getgid_.o libU77/kill_.o \
libU77/rand_.o libU77/srand_.o libU77/irand_.o libU77/sleep_.o \
libU77/idate_.o libU77/ctime_.o libU77/etime_.o libU77/dtime_.o \
libU77/isatty_.o libU77/ltime_.o libU77/fstat_.o libU77/stat_.o \
libU77/lstat_.o libU77/access_.o libU77/link_.o libU77/getlog_.o \
libU77/ttynam_.o libU77/getcwd_.o libU77/vxttime_.o \
libU77/vxtidate_.o libU77/gmtime_.o libU77/fdate_.o libU77/secnds_.o \
libU77/bes.o libU77/dbes.o libU77/chdir_.o libU77/chmod_.o \
libU77/lnblnk_.o libU77/hostnm_.o libU77/rename_.o libU77/fgetc_.o \
libU77/fputc_.o libU77/umask_.o libU77/sys_clock_.o libU77/date_.o \
libU77/second_.o libU77/flush1_.o libU77/alarm_.o libU77/mclock_.o \
libU77/symlnk_.o
F2CEXT = abort derf derfc ef1asc ef1cmc erf erfc exit getarg getenv iargc \
signal system flush ftell fseek access besj0 besj1 besjn besy0 besy1 \
besyn chdir chmod ctime date dbesj0 dbesj1 dbesjn dbesy0 dbesy1 dbesyn \
dtime etime fdate fgetc fget flush1 fnum fputc fput fstat gerror \
getcwd getgid getlog getpid getuid gmtime hostnm idate ierrno irand \
isatty itime kill link lnblnk lstat ltime mclock perror rand rename \
secnds second sleep srand stat symlnk sclock time ttynam umask unlink \
vxtidt vxttim alarm
# flags_to_pass to recursive makes & configure (hence the quoting style)
FLAGS_TO_PASS = \
CROSS="$(CROSS)" \
AR_FLAGS="$(AR_FLAGS)" \
AR="$(AR)" \
GCCFLAGS="$(GCCFLAGS)" \
GCC_FOR_TARGET="$(GCC_FOR_TARGET)" \
CC="$(GCC_FOR_TARGET)" \
LDFLAGS="$(LDFLAGS)" \
RANLIB="$(RANLIB)" \
RANLIB_TEST="$(RANLIB_TEST)" \
SHELL="$(SHELL)"
CROSS_FLAGS_TO_PASS = \
CROSS="$(CROSS)" \
AR_FLAGS="$(AR_FLAGS)" \
AR="$(AR)" \
GCCFLAGS="$(GCCFLAGS)" \
GCC_FOR_TARGET="$(GCC_FOR_TARGET)" \
CC="$(GCC_FOR_TARGET)" \
LDFLAGS="$(LDFLAGS)" \
RANLIB="$(RANLIB)" \
RANLIB_TEST="$(RANLIB_TEST)" \
SHELL="$(SHELL)"
all: ../../include/f2c.h $(lib)
$(lib): stamp-lib ; @true
stamp-lib: stamp-libf77 stamp-libi77 stamp-libu77
rm -f stamp-lib
$(AR) $(AR_FLAGS) $(lib) $(FOBJ) $(IOBJ) $(UOBJ)
rm -fr libE77
mkdir libE77
for name in $(F2CEXT); \
do \
echo $${name}; \
$(GCC_FOR_TARGET) -c -I. -I$(srcdir) -I../../include $(CPPFLAGS) $(CFLAGS) $(CGFLAGS) \
-DL$${name} $(srcdir)/f2cext.c -o libE77/L$${name}$(objext); \
if [ $$? -eq 0 ] ; then true; else exit 1; fi; \
done
$(AR) $(AR_FLAGS) $(lib) libE77/*$(object)
rm -fr libE77
if $(RANLIB_TEST); then $(RANLIB) $(lib); \
else true; fi
touch stamp-lib
stamp-libi77: libI77/Makefile
rm -f stamp-libi77
if test "$(CROSS)"; then \
cd libI77; $(MAKE) -f Makefile $(CROSS_FLAGS_TO_PASS) all ; \
else \
cd libI77; $(MAKE) -f Makefile $(FLAGS_TO_PASS) all ; \
fi
touch stamp-libi77
stamp-libf77: libF77/Makefile
rm -f stamp-libf77
if test "$(CROSS)"; then \
cd libF77; $(MAKE) -f Makefile $(CROSS_FLAGS_TO_PASS) all ; \
else \
cd libF77; $(MAKE) -f Makefile $(FLAGS_TO_PASS) all ; \
fi
touch stamp-libf77
stamp-libu77: libU77/Makefile
rm -f stamp-libu77
if test "$(CROSS)"; then \
cd libU77; $(MAKE) -f Makefile $(CROSS_FLAGS_TO_PASS) all ; \
else \
cd libU77; $(MAKE) -f Makefile $(FLAGS_TO_PASS) all ; \
fi
touch stamp-libu77
${srcdir}/configure: ${srcdir}/configure.in
rm -f config.cache && cd ${srcdir} && autoconf && rm -f config.cache
${srcdir}/libU77/configure: ${srcdir}/libU77/configure.in
rm -f libU77/config.cache && cd ${srcdir}/libU77 && autoconf && rm -f config.cache
#../include/f2c.h libI77/Makefile libF77/Makefile libU77/Makefile Makefile: ${srcdir}/Makefile.in \
# config.status libU77/config.status
# $(FLAGS_TO_PASS) CONFIG_SITE=/dev/null $(SHELL) config.status
# cd libU77; $(FLAGS_TO_PASS) CONFIG_SITE=/dev/null $(SHELL) config.status
# Extra dependencies for the targets above:
libI77/Makefile: $(srcdir)/libI77/Makefile.in
libF77/Makefile: $(srcdir)/libF77/Makefile.in
libU77/Makefile: $(srcdir)/libU77/Makefile.in
../../include/f2c.h: $(srcdir)/f2c.h.in
#config.status: ${srcdir}/configure
# $(FLAGS_TO_PASS) CONFIG_SITE=/dev/null $(SHELL) config.status --recheck
#libU77/config.status: ${srcdir}/libU77/configure
# cd libU77; $(FLAGS_TO_PASS) CONFIG_SITE=/dev/null $(SHELL) config.status --recheck
mostlyclean:
-rm -f stamp-*
for i in libI77 libF77 libU77; do \
if [ -f $$i/Makefile ]; then \
cd $$i; $(MAKE) -f Makefile mostlyclean; cd ..; \
fi; \
done
clean:
-rm -f config.log stamp-*
for i in libI77 libF77 libU77; do \
if [ -f $$i/Makefile ]; then \
cd $$i; $(MAKE) -f Makefile clean; cd ..; \
fi; \
done
distclean: clean
-rm -f Makefile config.cache lib?77/Makefile config.status lib?77/config.status lib?77/config.cache lib?77/config.h ../../include/f2c.h
maintainer-clean: distclean
-rm -f $(srcdir)/configure $(srcdir)/libU77/configure
uninstall:
rm ../../include/f2c.h
rebuilt: ${srcdir}/configure ${srcdir}/libU77/configure
.PHONY: libf77 libi77 libu77 rebuilt mostlyclean clean distclean maintainer-clean \
uninstall all
970811
This directory contains the f2c library packaged for use with g77 to configure
and build automatically (in principle!) as part of the top-level configure and
make steps. This depends on the makefile and configure fragments in ../f.
Some small changes have been made to the f2c distributions of lib[FI]77 which
come from <ftp:bell-labs.com/netlib/f2c/> and are maintained (excellently) by
David M. Gay <dmg@bell-labs.com>. See the Notice files for copyright
information. I'll try to get the changes rolled into the f2c distribution.
Files that come directly from netlib are either maintained in the
gcc/f/runtime/ directory under their original names or, if they
are not pertinent for g77's version of libf2c, under their original
names with `.netlib' appended. For example, gcc/f/runtime/permissions.netlib
is a copy of f2c's top-level`permissions' file in the netlib distribution.
In this case, it applies only to the relevant portions of the libF77/ and
libI77/ directories; it does not apply to the libU77/ directory, which is
distributed under different licensing arrangements. Similarly,
the `makefile.netlib' files in libF77/ and libI77/ are copies of
the respective `makefile' files in the netlib distribution, but
are not used when building g77's version of libf2c.
The `README.netlib' files in libF77/ and libI77/ thus might be
interesting, but should not be taken as guidelines for how to
configure and build libf2c in g77's distribution.
The packaging for auto-configuration was done by Dave Love <d.love@dl.ac.uk>.
Minor changes have been made by James Craig Burley <burley@gnu.ai.mit.edu>,
who probably broke things Dave had working. :-)
Among the user-visible changes (choices) g77 makes in its
version of libf2c:
- f2c.h configured to default to padding unformatted direct reads
(#define Pad_UDread), because that's the behavior most users
expect.
- f2c.h configured to default to outputting leading zeros before
decimal points in formatted and list-directed output, to be compatible
with many other compilers (#define WANT_LEAD_0). Either way is
standard-conforming, however, and you should try to avoid writing
code that assumes one format or another.
- dtime_() and etime_() are from Dave Love's libU77, not from
netlib's libF77.
970811
TODO list for the g77 library
* `Makefile.in's should be brought up to standard; I'm not sure they
have a complete set of targets at present.
* Investigate building shared libraries on systems we know about
(probably in 0.5.22, using libtool-1.0 from the FSF, which looks
quite useful).
* Test cases.
* Allow the library to be stripped to save space.
* An interface to IEEE maths functions from libc where this makes
sense.
This source diff could not be displayed because it is too large. You can view the blob instead.
#! /bin/sh
# Guess values for system-dependent variables and create Makefiles.
# Generated automatically using autoconf version 2.12.1
# Copyright (C) 1992, 93, 94, 95, 96 Free Software Foundation, Inc.
#
# This configure script is free software; the Free Software Foundation
# gives unlimited permission to copy, distribute and modify it.
# Defaults:
ac_help=
ac_default_prefix=/usr/local
# Any additions from configure.in:
# Initialize some variables set by options.
# The variables have the same names as the options, with
# dashes changed to underlines.
build=NONE
cache_file=./config.cache
exec_prefix=NONE
host=NONE
no_create=
nonopt=NONE
no_recursion=
prefix=NONE
program_prefix=NONE
program_suffix=NONE
program_transform_name=s,x,x,
silent=
site=
srcdir=
target=NONE
verbose=
x_includes=NONE
x_libraries=NONE
bindir='${exec_prefix}/bin'
sbindir='${exec_prefix}/sbin'
libexecdir='${exec_prefix}/libexec'
datadir='${prefix}/share'
sysconfdir='${prefix}/etc'
sharedstatedir='${prefix}/com'
localstatedir='${prefix}/var'
libdir='${exec_prefix}/lib'
includedir='${prefix}/include'
oldincludedir='/usr/include'
infodir='${prefix}/info'
mandir='${prefix}/man'
# Initialize some other variables.
subdirs=
MFLAGS= MAKEFLAGS=
SHELL=${CONFIG_SHELL-/bin/sh}
# Maximum number of lines to put in a shell here document.
ac_max_here_lines=12
ac_prev=
for ac_option
do
# If the previous option needs an argument, assign it.
if test -n "$ac_prev"; then
eval "$ac_prev=\$ac_option"
ac_prev=
continue
fi
case "$ac_option" in
-*=*) ac_optarg=`echo "$ac_option" | sed 's/[-_a-zA-Z0-9]*=//'` ;;
*) ac_optarg= ;;
esac
# Accept the important Cygnus configure options, so we can diagnose typos.
case "$ac_option" in
-bindir | --bindir | --bindi | --bind | --bin | --bi)
ac_prev=bindir ;;
-bindir=* | --bindir=* | --bindi=* | --bind=* | --bin=* | --bi=*)
bindir="$ac_optarg" ;;
-build | --build | --buil | --bui | --bu)
ac_prev=build ;;
-build=* | --build=* | --buil=* | --bui=* | --bu=*)
build="$ac_optarg" ;;
-cache-file | --cache-file | --cache-fil | --cache-fi \
| --cache-f | --cache- | --cache | --cach | --cac | --ca | --c)
ac_prev=cache_file ;;
-cache-file=* | --cache-file=* | --cache-fil=* | --cache-fi=* \
| --cache-f=* | --cache-=* | --cache=* | --cach=* | --cac=* | --ca=* | --c=*)
cache_file="$ac_optarg" ;;
-datadir | --datadir | --datadi | --datad | --data | --dat | --da)
ac_prev=datadir ;;
-datadir=* | --datadir=* | --datadi=* | --datad=* | --data=* | --dat=* \
| --da=*)
datadir="$ac_optarg" ;;
-disable-* | --disable-*)
ac_feature=`echo $ac_option|sed -e 's/-*disable-//'`
# Reject names that are not valid shell variable names.
if test -n "`echo $ac_feature| sed 's/[-a-zA-Z0-9_]//g'`"; then
{ echo "configure: error: $ac_feature: invalid feature name" 1>&2; exit 1; }
fi
ac_feature=`echo $ac_feature| sed 's/-/_/g'`
eval "enable_${ac_feature}=no" ;;
-enable-* | --enable-*)
ac_feature=`echo $ac_option|sed -e 's/-*enable-//' -e 's/=.*//'`
# Reject names that are not valid shell variable names.
if test -n "`echo $ac_feature| sed 's/[-_a-zA-Z0-9]//g'`"; then
{ echo "configure: error: $ac_feature: invalid feature name" 1>&2; exit 1; }
fi
ac_feature=`echo $ac_feature| sed 's/-/_/g'`
case "$ac_option" in
*=*) ;;
*) ac_optarg=yes ;;
esac
eval "enable_${ac_feature}='$ac_optarg'" ;;
-exec-prefix | --exec_prefix | --exec-prefix | --exec-prefi \
| --exec-pref | --exec-pre | --exec-pr | --exec-p | --exec- \
| --exec | --exe | --ex)
ac_prev=exec_prefix ;;
-exec-prefix=* | --exec_prefix=* | --exec-prefix=* | --exec-prefi=* \
| --exec-pref=* | --exec-pre=* | --exec-pr=* | --exec-p=* | --exec-=* \
| --exec=* | --exe=* | --ex=*)
exec_prefix="$ac_optarg" ;;
-gas | --gas | --ga | --g)
# Obsolete; use --with-gas.
with_gas=yes ;;
-help | --help | --hel | --he)
# Omit some internal or obsolete options to make the list less imposing.
# This message is too long to be a string in the A/UX 3.1 sh.
cat << EOF
Usage: configure [options] [host]
Options: [defaults in brackets after descriptions]
Configuration:
--cache-file=FILE cache test results in FILE
--help print this message
--no-create do not create output files
--quiet, --silent do not print \`checking...' messages
--version print the version of autoconf that created configure
Directory and file names:
--prefix=PREFIX install architecture-independent files in PREFIX
[$ac_default_prefix]
--exec-prefix=EPREFIX install architecture-dependent files in EPREFIX
[same as prefix]
--bindir=DIR user executables in DIR [EPREFIX/bin]
--sbindir=DIR system admin executables in DIR [EPREFIX/sbin]
--libexecdir=DIR program executables in DIR [EPREFIX/libexec]
--datadir=DIR read-only architecture-independent data in DIR
[PREFIX/share]
--sysconfdir=DIR read-only single-machine data in DIR [PREFIX/etc]
--sharedstatedir=DIR modifiable architecture-independent data in DIR
[PREFIX/com]
--localstatedir=DIR modifiable single-machine data in DIR [PREFIX/var]
--libdir=DIR object code libraries in DIR [EPREFIX/lib]
--includedir=DIR C header files in DIR [PREFIX/include]
--oldincludedir=DIR C header files for non-gcc in DIR [/usr/include]
--infodir=DIR info documentation in DIR [PREFIX/info]
--mandir=DIR man documentation in DIR [PREFIX/man]
--srcdir=DIR find the sources in DIR [configure dir or ..]
--program-prefix=PREFIX prepend PREFIX to installed program names
--program-suffix=SUFFIX append SUFFIX to installed program names
--program-transform-name=PROGRAM
run sed PROGRAM on installed program names
EOF
cat << EOF
Host type:
--build=BUILD configure for building on BUILD [BUILD=HOST]
--host=HOST configure for HOST [guessed]
--target=TARGET configure for TARGET [TARGET=HOST]
Features and packages:
--disable-FEATURE do not include FEATURE (same as --enable-FEATURE=no)
--enable-FEATURE[=ARG] include FEATURE [ARG=yes]
--with-PACKAGE[=ARG] use PACKAGE [ARG=yes]
--without-PACKAGE do not use PACKAGE (same as --with-PACKAGE=no)
--x-includes=DIR X include files are in DIR
--x-libraries=DIR X library files are in DIR
EOF
if test -n "$ac_help"; then
echo "--enable and --with options recognized:$ac_help"
fi
exit 0 ;;
-host | --host | --hos | --ho)
ac_prev=host ;;
-host=* | --host=* | --hos=* | --ho=*)
host="$ac_optarg" ;;
-includedir | --includedir | --includedi | --included | --include \
| --includ | --inclu | --incl | --inc)
ac_prev=includedir ;;
-includedir=* | --includedir=* | --includedi=* | --included=* | --include=* \
| --includ=* | --inclu=* | --incl=* | --inc=*)
includedir="$ac_optarg" ;;
-infodir | --infodir | --infodi | --infod | --info | --inf)
ac_prev=infodir ;;
-infodir=* | --infodir=* | --infodi=* | --infod=* | --info=* | --inf=*)
infodir="$ac_optarg" ;;
-libdir | --libdir | --libdi | --libd)
ac_prev=libdir ;;
-libdir=* | --libdir=* | --libdi=* | --libd=*)
libdir="$ac_optarg" ;;
-libexecdir | --libexecdir | --libexecdi | --libexecd | --libexec \
| --libexe | --libex | --libe)
ac_prev=libexecdir ;;
-libexecdir=* | --libexecdir=* | --libexecdi=* | --libexecd=* | --libexec=* \
| --libexe=* | --libex=* | --libe=*)
libexecdir="$ac_optarg" ;;
-localstatedir | --localstatedir | --localstatedi | --localstated \
| --localstate | --localstat | --localsta | --localst \
| --locals | --local | --loca | --loc | --lo)
ac_prev=localstatedir ;;
-localstatedir=* | --localstatedir=* | --localstatedi=* | --localstated=* \
| --localstate=* | --localstat=* | --localsta=* | --localst=* \
| --locals=* | --local=* | --loca=* | --loc=* | --lo=*)
localstatedir="$ac_optarg" ;;
-mandir | --mandir | --mandi | --mand | --man | --ma | --m)
ac_prev=mandir ;;
-mandir=* | --mandir=* | --mandi=* | --mand=* | --man=* | --ma=* | --m=*)
mandir="$ac_optarg" ;;
-nfp | --nfp | --nf)
# Obsolete; use --without-fp.
with_fp=no ;;
-no-create | --no-create | --no-creat | --no-crea | --no-cre \
| --no-cr | --no-c)
no_create=yes ;;
-no-recursion | --no-recursion | --no-recursio | --no-recursi \
| --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r)
no_recursion=yes ;;
-oldincludedir | --oldincludedir | --oldincludedi | --oldincluded \
| --oldinclude | --oldinclud | --oldinclu | --oldincl | --oldinc \
| --oldin | --oldi | --old | --ol | --o)
ac_prev=oldincludedir ;;
-oldincludedir=* | --oldincludedir=* | --oldincludedi=* | --oldincluded=* \
| --oldinclude=* | --oldinclud=* | --oldinclu=* | --oldincl=* | --oldinc=* \
| --oldin=* | --oldi=* | --old=* | --ol=* | --o=*)
oldincludedir="$ac_optarg" ;;
-prefix | --prefix | --prefi | --pref | --pre | --pr | --p)
ac_prev=prefix ;;
-prefix=* | --prefix=* | --prefi=* | --pref=* | --pre=* | --pr=* | --p=*)
prefix="$ac_optarg" ;;
-program-prefix | --program-prefix | --program-prefi | --program-pref \
| --program-pre | --program-pr | --program-p)
ac_prev=program_prefix ;;
-program-prefix=* | --program-prefix=* | --program-prefi=* \
| --program-pref=* | --program-pre=* | --program-pr=* | --program-p=*)
program_prefix="$ac_optarg" ;;
-program-suffix | --program-suffix | --program-suffi | --program-suff \
| --program-suf | --program-su | --program-s)
ac_prev=program_suffix ;;
-program-suffix=* | --program-suffix=* | --program-suffi=* \
| --program-suff=* | --program-suf=* | --program-su=* | --program-s=*)
program_suffix="$ac_optarg" ;;
-program-transform-name | --program-transform-name \
| --program-transform-nam | --program-transform-na \
| --program-transform-n | --program-transform- \
| --program-transform | --program-transfor \
| --program-transfo | --program-transf \
| --program-trans | --program-tran \
| --progr-tra | --program-tr | --program-t)
ac_prev=program_transform_name ;;
-program-transform-name=* | --program-transform-name=* \
| --program-transform-nam=* | --program-transform-na=* \
| --program-transform-n=* | --program-transform-=* \
| --program-transform=* | --program-transfor=* \
| --program-transfo=* | --program-transf=* \
| --program-trans=* | --program-tran=* \
| --progr-tra=* | --program-tr=* | --program-t=*)
program_transform_name="$ac_optarg" ;;
-q | -quiet | --quiet | --quie | --qui | --qu | --q \
| -silent | --silent | --silen | --sile | --sil)
silent=yes ;;
-sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb)
ac_prev=sbindir ;;
-sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \
| --sbi=* | --sb=*)
sbindir="$ac_optarg" ;;
-sharedstatedir | --sharedstatedir | --sharedstatedi \
| --sharedstated | --sharedstate | --sharedstat | --sharedsta \
| --sharedst | --shareds | --shared | --share | --shar \
| --sha | --sh)
ac_prev=sharedstatedir ;;
-sharedstatedir=* | --sharedstatedir=* | --sharedstatedi=* \
| --sharedstated=* | --sharedstate=* | --sharedstat=* | --sharedsta=* \
| --sharedst=* | --shareds=* | --shared=* | --share=* | --shar=* \
| --sha=* | --sh=*)
sharedstatedir="$ac_optarg" ;;
-site | --site | --sit)
ac_prev=site ;;
-site=* | --site=* | --sit=*)
site="$ac_optarg" ;;
-srcdir | --srcdir | --srcdi | --srcd | --src | --sr)
ac_prev=srcdir ;;
-srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*)
srcdir="$ac_optarg" ;;
-sysconfdir | --sysconfdir | --sysconfdi | --sysconfd | --sysconf \
| --syscon | --sysco | --sysc | --sys | --sy)
ac_prev=sysconfdir ;;
-sysconfdir=* | --sysconfdir=* | --sysconfdi=* | --sysconfd=* | --sysconf=* \
| --syscon=* | --sysco=* | --sysc=* | --sys=* | --sy=*)
sysconfdir="$ac_optarg" ;;
-target | --target | --targe | --targ | --tar | --ta | --t)
ac_prev=target ;;
-target=* | --target=* | --targe=* | --targ=* | --tar=* | --ta=* | --t=*)
target="$ac_optarg" ;;
-v | -verbose | --verbose | --verbos | --verbo | --verb)
verbose=yes ;;
-version | --version | --versio | --versi | --vers)
echo "configure generated by autoconf version 2.12.1"
exit 0 ;;
-with-* | --with-*)
ac_package=`echo $ac_option|sed -e 's/-*with-//' -e 's/=.*//'`
# Reject names that are not valid shell variable names.
if test -n "`echo $ac_package| sed 's/[-_a-zA-Z0-9]//g'`"; then
{ echo "configure: error: $ac_package: invalid package name" 1>&2; exit 1; }
fi
ac_package=`echo $ac_package| sed 's/-/_/g'`
case "$ac_option" in
*=*) ;;
*) ac_optarg=yes ;;
esac
eval "with_${ac_package}='$ac_optarg'" ;;
-without-* | --without-*)
ac_package=`echo $ac_option|sed -e 's/-*without-//'`
# Reject names that are not valid shell variable names.
if test -n "`echo $ac_package| sed 's/[-a-zA-Z0-9_]//g'`"; then
{ echo "configure: error: $ac_package: invalid package name" 1>&2; exit 1; }
fi
ac_package=`echo $ac_package| sed 's/-/_/g'`
eval "with_${ac_package}=no" ;;
--x)
# Obsolete; use --with-x.
with_x=yes ;;
-x-includes | --x-includes | --x-include | --x-includ | --x-inclu \
| --x-incl | --x-inc | --x-in | --x-i)
ac_prev=x_includes ;;
-x-includes=* | --x-includes=* | --x-include=* | --x-includ=* | --x-inclu=* \
| --x-incl=* | --x-inc=* | --x-in=* | --x-i=*)
x_includes="$ac_optarg" ;;
-x-libraries | --x-libraries | --x-librarie | --x-librari \
| --x-librar | --x-libra | --x-libr | --x-lib | --x-li | --x-l)
ac_prev=x_libraries ;;
-x-libraries=* | --x-libraries=* | --x-librarie=* | --x-librari=* \
| --x-librar=* | --x-libra=* | --x-libr=* | --x-lib=* | --x-li=* | --x-l=*)
x_libraries="$ac_optarg" ;;
-*) { echo "configure: error: $ac_option: invalid option; use --help to show usage" 1>&2; exit 1; }
;;
*)
if test -n "`echo $ac_option| sed 's/[-a-z0-9.]//g'`"; then
echo "configure: warning: $ac_option: invalid host type" 1>&2
fi
if test "x$nonopt" != xNONE; then
{ echo "configure: error: can only configure for one host and one target at a time" 1>&2; exit 1; }
fi
nonopt="$ac_option"
;;
esac
done
if test -n "$ac_prev"; then
{ echo "configure: error: missing argument to --`echo $ac_prev | sed 's/_/-/g'`" 1>&2; exit 1; }
fi
trap 'rm -fr conftest* confdefs* core core.* *.core $ac_clean_files; exit 1' 1 2 15
# File descriptor usage:
# 0 standard input
# 1 file creation
# 2 errors and warnings
# 3 some systems may open it to /dev/tty
# 4 used on the Kubota Titan
# 6 checking for... messages and results
# 5 compiler messages saved in config.log
if test "$silent" = yes; then
exec 6>/dev/null
else
exec 6>&1
fi
exec 5>./config.log
echo "\
This file contains any messages produced by compilers while
running configure, to aid debugging if configure makes a mistake.
" 1>&5
# Strip out --no-create and --no-recursion so they do not pile up.
# Also quote any args containing shell metacharacters.
ac_configure_args=
for ac_arg
do
case "$ac_arg" in
-no-create | --no-create | --no-creat | --no-crea | --no-cre \
| --no-cr | --no-c) ;;
-no-recursion | --no-recursion | --no-recursio | --no-recursi \
| --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r) ;;
*" "*|*" "*|*[\[\]\~\#\$\^\&\*\(\)\{\}\\\|\;\<\>\?]*)
ac_configure_args="$ac_configure_args '$ac_arg'" ;;
*) ac_configure_args="$ac_configure_args $ac_arg" ;;
esac
done
# NLS nuisances.
# Only set these to C if already set. These must not be set unconditionally
# because not all systems understand e.g. LANG=C (notably SCO).
# Fixing LC_MESSAGES prevents Solaris sh from translating var values in `set'!
# Non-C LC_CTYPE values break the ctype check.
if test "${LANG+set}" = set; then LANG=C; export LANG; fi
if test "${LC_ALL+set}" = set; then LC_ALL=C; export LC_ALL; fi
if test "${LC_MESSAGES+set}" = set; then LC_MESSAGES=C; export LC_MESSAGES; fi
if test "${LC_CTYPE+set}" = set; then LC_CTYPE=C; export LC_CTYPE; fi
# confdefs.h avoids OS command line length limits that DEFS can exceed.
rm -rf conftest* confdefs.h
# AIX cpp loses on an empty file, so make sure it contains at least a newline.
echo > confdefs.h
# A filename unique to this package, relative to the directory that
# configure is in, which we can look for to find out if srcdir is correct.
ac_unique_file=libF77/Version.c
# Find the source files, if location was not specified.
if test -z "$srcdir"; then
ac_srcdir_defaulted=yes
# Try the directory containing this script, then its parent.
ac_prog=$0
ac_confdir=`echo $ac_prog|sed 's%/[^/][^/]*$%%'`
test "x$ac_confdir" = "x$ac_prog" && ac_confdir=.
srcdir=$ac_confdir
if test ! -r $srcdir/$ac_unique_file; then
srcdir=..
fi
else
ac_srcdir_defaulted=no
fi
if test ! -r $srcdir/$ac_unique_file; then
if test "$ac_srcdir_defaulted" = yes; then
{ echo "configure: error: can not find sources in $ac_confdir or .." 1>&2; exit 1; }
else
{ echo "configure: error: can not find sources in $srcdir" 1>&2; exit 1; }
fi
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"
fi
fi
for ac_site_file in $CONFIG_SITE; do
if test -r "$ac_site_file"; then
echo "loading site script $ac_site_file"
. "$ac_site_file"
fi
done
if test -r "$cache_file"; then
echo "loading cache $cache_file"
. $cache_file
else
echo "creating cache $cache_file"
> $cache_file
fi
ac_ext=c
# CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options.
ac_cpp='$CPP $CPPFLAGS'
ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5'
ac_link='${CC-cc} -o conftest $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5'
cross_compiling=$ac_cv_prog_cc_cross
if (echo "testing\c"; echo 1,2,3) | grep c >/dev/null; then
# Stardent Vistra SVR4 grep lacks -e, says ghazi@caip.rutgers.edu.
if (echo -n testing; echo 1,2,3) | sed s/-n/xn/ | grep xn >/dev/null; then
ac_n= ac_c='
' ac_t=' '
else
ac_n=-n ac_c= ac_t=
fi
else
ac_n= ac_c='\c' ac_t=
fi
# From configure.in 1.10
# For g77 we'll set CC to point at the built gcc, but this will get it into
# the makefiles
# 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:531: 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
if test -n "$CC"; then
ac_cv_prog_CC="$CC" # Let the user override the test.
else
IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS="${IFS}:"
for ac_dir in $PATH; do
test -z "$ac_dir" && ac_dir=.
if test -f $ac_dir/$ac_word; then
ac_cv_prog_CC="gcc"
break
fi
done
IFS="$ac_save_ifs"
fi
fi
CC="$ac_cv_prog_CC"
if test -n "$CC"; then
echo "$ac_t""$CC" 1>&6
else
echo "$ac_t""no" 1>&6
fi
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:560: 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
if test -n "$CC"; then
ac_cv_prog_CC="$CC" # Let the user override the test.
else
IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS="${IFS}:"
ac_prog_rejected=no
for ac_dir in $PATH; do
test -z "$ac_dir" && ac_dir=.
if test -f $ac_dir/$ac_word; then
if test "$ac_dir/$ac_word" = "/usr/ucb/cc"; then
ac_prog_rejected=yes
continue
fi
ac_cv_prog_CC="cc"
break
fi
done
IFS="$ac_save_ifs"
if test $ac_prog_rejected = yes; then
# We found a bogon in the path, so make sure we never use it.
set dummy $ac_cv_prog_CC
shift
if test $# -gt 0; then
# We chose a different compiler from the bogus one.
# However, it has the same basename, so the bogon will be chosen
# first if we set CC to just the basename; use the full file name.
shift
set dummy "$ac_dir/$ac_word" "$@"
shift
ac_cv_prog_CC="$@"
fi
fi
fi
fi
CC="$ac_cv_prog_CC"
if test -n "$CC"; then
echo "$ac_t""$CC" 1>&6
else
echo "$ac_t""no" 1>&6
fi
test -z "$CC" && { echo "configure: error: no acceptable cc found in \$PATH" 1>&2; exit 1; }
fi
echo $ac_n "checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works""... $ac_c" 1>&6
echo "configure:608: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works" >&5
ac_ext=c
# CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options.
ac_cpp='$CPP $CPPFLAGS'
ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5'
ac_link='${CC-cc} -o conftest $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5'
cross_compiling=$ac_cv_prog_cc_cross
cat > conftest.$ac_ext <<EOF
#line 618 "configure"
#include "confdefs.h"
main(){return(0);}
EOF
if { (eval echo configure:622: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then
ac_cv_prog_cc_works=yes
# If we can't run a trivial program, we are probably using a cross compiler.
if (./conftest; exit) 2>/dev/null; then
ac_cv_prog_cc_cross=no
else
ac_cv_prog_cc_cross=yes
fi
else
echo "configure: failed program was:" >&5
cat conftest.$ac_ext >&5
ac_cv_prog_cc_works=no
fi
rm -fr conftest*
echo "$ac_t""$ac_cv_prog_cc_works" 1>&6
if test $ac_cv_prog_cc_works = no; then
{ echo "configure: error: installation or configuration problem: C compiler cannot create executables." 1>&2; exit 1; }
fi
echo $ac_n "checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler""... $ac_c" 1>&6
echo "configure:642: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler" >&5
echo "$ac_t""$ac_cv_prog_cc_cross" 1>&6
cross_compiling=$ac_cv_prog_cc_cross
echo $ac_n "checking whether we are using GNU C""... $ac_c" 1>&6
echo "configure:647: 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
cat > conftest.c <<EOF
#ifdef __GNUC__
yes;
#endif
EOF
if { ac_try='${CC-cc} -E conftest.c'; { (eval echo configure:656: \"$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
fi
fi
echo "$ac_t""$ac_cv_prog_gcc" 1>&6
if test $ac_cv_prog_gcc = yes; then
GCC=yes
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:671: 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
echo 'void f(){}' > conftest.c
if test -z "`${CC-cc} -g -c conftest.c 2>&1`"; then
ac_cv_prog_cc_g=yes
else
ac_cv_prog_cc_g=no
fi
rm -f conftest*
fi
echo "$ac_t""$ac_cv_prog_cc_g" 1>&6
if test "$ac_test_CFLAGS" = set; then
CFLAGS="$ac_save_CFLAGS"
elif test $ac_cv_prog_cc_g = yes; then
CFLAGS="-g -O2"
else
CFLAGS="-O2"
fi
else
GCC=
test "${CFLAGS+set}" = set || CFLAGS="-g"
fi
if test "$CROSS";then
ac_cv_c_cross=yes
else
ac_cv_c_cross=no
fi
test "$AR" || AR=ar
if test "$RANLIB"; then :
if test -z "$RANLIB_TEST"; then
RANLIB_TEST=true
fi
else
RANLIB_TEST=true
# 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:716: 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
if test -n "$RANLIB"; then
ac_cv_prog_RANLIB="$RANLIB" # Let the user override the test.
else
IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS="${IFS}:"
for ac_dir in $PATH; do
test -z "$ac_dir" && ac_dir=.
if test -f $ac_dir/$ac_word; then
ac_cv_prog_RANLIB="ranlib"
break
fi
done
IFS="$ac_save_ifs"
test -z "$ac_cv_prog_RANLIB" && ac_cv_prog_RANLIB=":"
fi
fi
RANLIB="$ac_cv_prog_RANLIB"
if test -n "$RANLIB"; then
echo "$ac_t""$RANLIB" 1>&6
else
echo "$ac_t""no" 1>&6
fi
fi
# Sanity check for the cross-compilation case:
echo $ac_n "checking how to run the C preprocessor""... $ac_c" 1>&6
echo "configure:749: checking how to run the C preprocessor" >&5
# On Suns, sometimes $CPP names a directory.
if test -n "$CPP" && test -d "$CPP"; then
CPP=
fi
if test -z "$CPP"; then
if eval "test \"`echo '$''{'ac_cv_prog_CPP'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
# This must be in double quotes, not single quotes, because CPP may get
# substituted into the Makefile and "${CC-cc}" will confuse make.
CPP="${CC-cc} -E"
# On the NeXT, cc -E runs the code through the compiler's parser,
# not just through cpp.
cat > conftest.$ac_ext <<EOF
#line 764 "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:770: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
ac_err=`grep -v '^ *+' conftest.out`
if test -z "$ac_err"; then
:
else
echo "$ac_err" >&5
echo "configure: failed program was:" >&5
cat conftest.$ac_ext >&5
rm -rf conftest*
CPP="${CC-cc} -E -traditional-cpp"
cat > conftest.$ac_ext <<EOF
#line 781 "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:787: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
ac_err=`grep -v '^ *+' conftest.out`
if test -z "$ac_err"; then
:
else
echo "$ac_err" >&5
echo "configure: failed program was:" >&5
cat conftest.$ac_ext >&5
rm -rf conftest*
CPP=/lib/cpp
fi
rm -f conftest*
fi
rm -f conftest*
ac_cv_prog_CPP="$CPP"
fi
CPP="$ac_cv_prog_CPP"
else
ac_cv_prog_CPP="$CPP"
fi
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:811: 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 816 "configure"
#include "confdefs.h"
#include <stdio.h>
EOF
ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
{ (eval echo configure:821: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
ac_err=`grep -v '^ *+' conftest.out`
if test -z "$ac_err"; then
rm -rf conftest*
eval "ac_cv_header_$ac_safe=yes"
else
echo "$ac_err" >&5
echo "configure: failed program was:" >&5
cat conftest.$ac_ext >&5
rm -rf conftest*
eval "ac_cv_header_$ac_safe=no"
fi
rm -f conftest*
fi
if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then
echo "$ac_t""yes" 1>&6
:
else
echo "$ac_t""no" 1>&6
{ echo "configure: error: Can't find stdio.h.
You must have a usable C system for the target already installed, at least
including headers and, preferably, the library, before you can configure
the G77 runtime system. If necessary, install gcc now with \`LANGUAGES=c',
then the target library, then build with \`LANGUAGES=f77'." 1>&2; exit 1; }
fi
echo $ac_n "checking for ANSI C header files""... $ac_c" 1>&6
echo "configure:849: 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 854 "configure"
#include "confdefs.h"
#include <stdlib.h>
#include <stdarg.h>
#include <string.h>
#include <float.h>
EOF
ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
{ (eval echo configure:862: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
ac_err=`grep -v '^ *+' conftest.out`
if test -z "$ac_err"; then
rm -rf conftest*
ac_cv_header_stdc=yes
else
echo "$ac_err" >&5
echo "configure: failed program was:" >&5
cat conftest.$ac_ext >&5
rm -rf conftest*
ac_cv_header_stdc=no
fi
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 879 "configure"
#include "confdefs.h"
#include <string.h>
EOF
if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
egrep "memchr" >/dev/null 2>&1; then
:
else
rm -rf conftest*
ac_cv_header_stdc=no
fi
rm -f conftest*
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 897 "configure"
#include "confdefs.h"
#include <stdlib.h>
EOF
if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
egrep "free" >/dev/null 2>&1; then
:
else
rm -rf conftest*
ac_cv_header_stdc=no
fi
rm -f conftest*
fi
if test $ac_cv_header_stdc = yes; then
# /bin/cc in Irix-4.0.5 gets non-ANSI ctype macros unless using -ansi.
if test "$cross_compiling" = yes; then
:
else
cat > conftest.$ac_ext <<EOF
#line 918 "configure"
#include "confdefs.h"
#include <ctype.h>
#define ISLOWER(c) ('a' <= (c) && (c) <= 'z')
#define TOUPPER(c) (ISLOWER(c) ? 'A' + ((c) - 'a') : (c))
#define XOR(e, f) (((e) && !(f)) || (!(e) && (f)))
int main () { int i; for (i = 0; i < 256; i++)
if (XOR (islower (i), ISLOWER (i)) || toupper (i) != TOUPPER (i)) exit(2);
exit (0); }
EOF
if { (eval echo configure:929: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>/dev/null
then
:
else
echo "configure: failed program was:" >&5
cat conftest.$ac_ext >&5
rm -fr conftest*
ac_cv_header_stdc=no
fi
rm -fr conftest*
fi
fi
fi
echo "$ac_t""$ac_cv_header_stdc" 1>&6
if test $ac_cv_header_stdc = yes; then
cat >> confdefs.h <<\EOF
#define STDC_HEADERS 1
EOF
fi
echo $ac_n "checking for posix""... $ac_c" 1>&6
echo "configure:955: 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 960 "configure"
#include "confdefs.h"
#include <sys/types.h>
#include <unistd.h>
#ifdef _POSIX_VERSION
yes
#endif
EOF
if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
egrep "yes" >/dev/null 2>&1; then
rm -rf conftest*
g77_cv_header_posix=yes
else
rm -rf conftest*
g77_cv_header_posix=no
fi
rm -f conftest*
fi
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:986: 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 991 "configure"
#include "confdefs.h"
#include <stdio.h>
#ifdef __GNU_LIBRARY__
yes
#endif
EOF
if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
egrep "yes" >/dev/null 2>&1; then
rm -rf conftest*
g77_cv_lib_gnu=yes
else
rm -rf conftest*
g77_cv_lib_gnu=no
fi
rm -f conftest*
fi
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:1015: 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 1020 "configure"
#include "confdefs.h"
#ifdef __CYGWIN32__
yes
#endif
EOF
if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
egrep "yes" >/dev/null 2>&1; then
rm -rf conftest*
g77_cv_sys_cygwin32=yes
else
rm -rf conftest*
g77_cv_sys_cygwin32=no
fi
rm -f conftest*
fi
echo "$ac_t""$g77_cv_sys_cygwin32" 1>&6
# ditto for mingw32.
echo $ac_n "checking for mingw32""... $ac_c" 1>&6
echo "configure:1043: 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 1048 "configure"
#include "confdefs.h"
#ifdef __MINGW32__
yes
#endif
EOF
if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
egrep "yes" >/dev/null 2>&1; then
rm -rf conftest*
g77_cv_sys_mingw32=yes
else
rm -rf conftest*
g77_cv_sys_mingw32=no
fi
rm -f conftest*
fi
echo "$ac_t""$g77_cv_sys_mingw32" 1>&6
ac_safe=`echo "fcntl.h" | sed 'y%./+-%__p_%'`
echo $ac_n "checking for fcntl.h""... $ac_c" 1>&6
echo "configure:1072: checking for fcntl.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 1077 "configure"
#include "confdefs.h"
#include <fcntl.h>
EOF
ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
{ (eval echo configure:1082: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
ac_err=`grep -v '^ *+' conftest.out`
if test -z "$ac_err"; then
rm -rf conftest*
eval "ac_cv_header_$ac_safe=yes"
else
echo "$ac_err" >&5
echo "configure: failed program was:" >&5
cat conftest.$ac_ext >&5
rm -rf conftest*
eval "ac_cv_header_$ac_safe=no"
fi
rm -f conftest*
fi
if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then
echo "$ac_t""yes" 1>&6
test $g77_cv_header_posix = yes && cat >> confdefs.h <<\EOF
#define _POSIX_SOURCE 1
EOF
else
echo "$ac_t""no" 1>&6
cat >> confdefs.h <<\EOF
#define NO_FCNTL 1
EOF
cat >> confdefs.h <<\EOF
#define OPEN_DECL 1
EOF
fi
echo $ac_n "checking for working const""... $ac_c" 1>&6
echo "configure:1115: 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 1120 "configure"
#include "confdefs.h"
int main() {
/* Ultrix mips cc rejects this. */
typedef int charset[2]; const charset x;
/* SunOS 4.1.1 cc rejects this. */
char const *const *ccp;
char **p;
/* NEC SVR4.0.2 mips cc rejects this. */
struct point {int x, y;};
static struct point const zero = {0,0};
/* AIX XL C 1.02.0.0 rejects this.
It does not let you subtract one const X* pointer from another in an arm
of an if-expression whose if-part is not a constant expression */
const char *g = "string";
ccp = &g + (g ? g-g : 0);
/* HPUX 7.0 cc rejects these. */
++ccp;
p = (char**) ccp;
ccp = (char const *const *) p;
{ /* SCO 3.2v4 cc rejects this. */
char *t;
char const *s = 0 ? (char *) 0 : (char const *) 0;
*t++ = 0;
}
{ /* Someone thinks the Sun supposedly-ANSI compiler will reject this. */
int x[] = {25, 17};
const int *foo = &x[0];
++foo;
}
{ /* Sun SC1.0 ANSI compiler rejects this -- but not the above. */
typedef const int *iptr;
iptr p = 0;
++p;
}
{ /* AIX XL C 1.02.0.0 rejects this saying
"k.c", line 2.27: 1506-025 (S) Operand must be a modifiable lvalue. */
struct s { int j; const int *ap[3]; };
struct s *b; b->j = 5;
}
{ /* ULTRIX-32 V3.1 (Rev 9) vcc rejects this */
const int foo = 10;
}
; return 0; }
EOF
if { (eval echo configure:1169: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
rm -rf conftest*
ac_cv_c_const=yes
else
echo "configure: failed program was:" >&5
cat conftest.$ac_ext >&5
rm -rf conftest*
ac_cv_c_const=no
fi
rm -f conftest*
fi
echo "$ac_t""$ac_cv_c_const" 1>&6
if test $ac_cv_c_const = no; then
cat >> confdefs.h <<\EOF
#define const
EOF
fi
echo $ac_n "checking for size_t""... $ac_c" 1>&6
echo "configure:1190: 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 1195 "configure"
#include "confdefs.h"
#include <sys/types.h>
#if STDC_HEADERS
#include <stdlib.h>
#include <stddef.h>
#endif
EOF
if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
egrep "size_t[^a-zA-Z_0-9]" >/dev/null 2>&1; then
rm -rf conftest*
ac_cv_type_size_t=yes
else
rm -rf conftest*
ac_cv_type_size_t=no
fi
rm -f conftest*
fi
echo "$ac_t""$ac_cv_type_size_t" 1>&6
if test $ac_cv_type_size_t = no; then
cat >> confdefs.h <<\EOF
#define size_t unsigned
EOF
fi
echo $ac_n "checking return type of signal handlers""... $ac_c" 1>&6
echo "configure:1224: 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 1229 "configure"
#include "confdefs.h"
#include <sys/types.h>
#include <signal.h>
#ifdef signal
#undef signal
#endif
#ifdef __cplusplus
extern "C" void (*signal (int, void (*)(int)))(int);
#else
void (*signal ()) ();
#endif
int main() {
int i;
; return 0; }
EOF
if { (eval echo configure:1246: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
rm -rf conftest*
ac_cv_type_signal=void
else
echo "configure: failed program was:" >&5
cat conftest.$ac_ext >&5
rm -rf conftest*
ac_cv_type_signal=int
fi
rm -f conftest*
fi
echo "$ac_t""$ac_cv_type_signal" 1>&6
cat >> confdefs.h <<EOF
#define RETSIGTYPE $ac_cv_type_signal
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:1267: 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 1272 "configure"
#include "confdefs.h"
/* System header to define __stub macros and hopefully few prototypes,
which can conflict with char atexit(); below. */
#include <assert.h>
/* Override any gcc2 internal prototype to avoid an error. */
/* We use char because int might match the return type of a gcc2
builtin and then its argument prototype would still apply. */
char atexit();
int main() {
/* The GNU C library defines this for functions which it implements
to always fail with ENOSYS. Some functions are actually named
something starting with __ and the normal name is an alias. */
#if defined (__stub_atexit) || defined (__stub___atexit)
choke me
#else
atexit();
#endif
; return 0; }
EOF
if { (eval echo configure:1295: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then
rm -rf conftest*
eval "ac_cv_func_atexit=yes"
else
echo "configure: failed program was:" >&5
cat conftest.$ac_ext >&5
rm -rf conftest*
eval "ac_cv_func_atexit=no"
fi
rm -f conftest*
fi
if eval "test \"`echo '$ac_cv_func_'atexit`\" = yes"; then
echo "$ac_t""yes" 1>&6
cat >> confdefs.h <<\EOF
#define onexit atexit
EOF
else
echo "$ac_t""no" 1>&6
cat >> confdefs.h <<\EOF
#define NO_ONEXIT 1
EOF
echo $ac_n "checking for onexit""... $ac_c" 1>&6
echo "configure:1320: 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 1325 "configure"
#include "confdefs.h"
/* System header to define __stub macros and hopefully few prototypes,
which can conflict with char onexit(); below. */
#include <assert.h>
/* Override any gcc2 internal prototype to avoid an error. */
/* We use char because int might match the return type of a gcc2
builtin and then its argument prototype would still apply. */
char onexit();
int main() {
/* The GNU C library defines this for functions which it implements
to always fail with ENOSYS. Some functions are actually named
something starting with __ and the normal name is an alias. */
#if defined (__stub_onexit) || defined (__stub___onexit)
choke me
#else
onexit();
#endif
; return 0; }
EOF
if { (eval echo configure:1348: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then
rm -rf conftest*
eval "ac_cv_func_onexit=yes"
else
echo "configure: failed program was:" >&5
cat conftest.$ac_ext >&5
rm -rf conftest*
eval "ac_cv_func_onexit=no"
fi
rm -f conftest*
fi
if eval "test \"`echo '$ac_cv_func_'onexit`\" = yes"; then
echo "$ac_t""yes" 1>&6
:
else
echo "$ac_t""no" 1>&6
echo $ac_n "checking for on_exit""... $ac_c" 1>&6
echo "configure:1366: 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 1371 "configure"
#include "confdefs.h"
/* System header to define __stub macros and hopefully few prototypes,
which can conflict with char on_exit(); below. */
#include <assert.h>
/* Override any gcc2 internal prototype to avoid an error. */
/* We use char because int might match the return type of a gcc2
builtin and then its argument prototype would still apply. */
char on_exit();
int main() {
/* The GNU C library defines this for functions which it implements
to always fail with ENOSYS. Some functions are actually named
something starting with __ and the normal name is an alias. */
#if defined (__stub_on_exit) || defined (__stub___on_exit)
choke me
#else
on_exit();
#endif
; return 0; }
EOF
if { (eval echo configure:1394: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then
rm -rf conftest*
eval "ac_cv_func_on_exit=yes"
else
echo "configure: failed program was:" >&5
cat conftest.$ac_ext >&5
rm -rf conftest*
eval "ac_cv_func_on_exit=no"
fi
rm -f conftest*
fi
if eval "test \"`echo '$ac_cv_func_'on_exit`\" = yes"; then
echo "$ac_t""yes" 1>&6
cat >> confdefs.h <<\EOF
#define onexit on_exit
EOF
else
echo "$ac_t""no" 1>&6
fi
fi
fi
else true
fi
# This should always succeed on unix.
# 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:1427: 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 1432 "configure"
#include "confdefs.h"
/* System header to define __stub macros and hopefully few prototypes,
which can conflict with char fstat(); below. */
#include <assert.h>
/* Override any gcc2 internal prototype to avoid an error. */
/* We use char because int might match the return type of a gcc2
builtin and then its argument prototype would still apply. */
char fstat();
int main() {
/* The GNU C library defines this for functions which it implements
to always fail with ENOSYS. Some functions are actually named
something starting with __ and the normal name is an alias. */
#if defined (__stub_fstat) || defined (__stub___fstat)
choke me
#else
fstat();
#endif
; return 0; }
EOF
if { (eval echo configure:1455: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then
rm -rf conftest*
eval "ac_cv_func_fstat=yes"
else
echo "configure: failed program was:" >&5
cat conftest.$ac_ext >&5
rm -rf conftest*
eval "ac_cv_func_fstat=no"
fi
rm -f conftest*
fi
if eval "test \"`echo '$ac_cv_func_'fstat`\" = yes"; then
echo "$ac_t""yes" 1>&6
:
else
echo "$ac_t""no" 1>&6
fi
echo $ac_n "checking need for NON_UNIX_STDIO""... $ac_c" 1>&6
echo "configure:1475: 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
echo "$ac_t""yes" 1>&6
cat >> confdefs.h <<\EOF
#define NON_UNIX_STDIO 1
EOF
else
echo "$ac_t""no" 1>&6
fi
# This is necessary for e.g. Linux:
echo $ac_n "checking for necessary members of struct FILE""... $ac_c" 1>&6
echo "configure:1490: checking for necessary members of struct FILE" >&5
if eval "test \"`echo '$''{'g77_cv_struct_FILE'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
#line 1495 "configure"
#include "confdefs.h"
#include <stdio.h>
int main() {
FILE s; s._ptr; s._base; s._flag;
; return 0; }
EOF
if { (eval echo configure:1502: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
rm -rf conftest*
g77_cv_struct_FILE=yes
else
echo "configure: failed program was:" >&5
cat conftest.$ac_ext >&5
rm -rf conftest*
g77_cv_struct_FILE=no
fi
rm -f conftest*
fi
echo "$ac_t""$g77_cv_struct_FILE" 1>&6
if test $g77_cv_struct_FILE = no; then
cat >> confdefs.h <<\EOF
#define MISSING_FILE_ELEMS 1
EOF
fi
echo $ac_n "checking for drem in -lm""... $ac_c" 1>&6
echo "configure:1522: 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
else
ac_save_LIBS="$LIBS"
LIBS="-lm $LIBS"
cat > conftest.$ac_ext <<EOF
#line 1530 "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
builtin and then its argument prototype would still apply. */
char drem();
int main() {
drem()
; return 0; }
EOF
if { (eval echo configure:1541: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then
rm -rf conftest*
eval "ac_cv_lib_$ac_lib_var=yes"
else
echo "configure: failed program was:" >&5
cat conftest.$ac_ext >&5
rm -rf conftest*
eval "ac_cv_lib_$ac_lib_var=no"
fi
rm -f conftest*
LIBS="$ac_save_LIBS"
fi
if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes"; then
echo "$ac_t""yes" 1>&6
cat >> confdefs.h <<\EOF
#define IEEE_drem 1
EOF
else
echo "$ac_t""no" 1>&6
fi
# posix will guarantee the right behaviour for sprintf, else we can't be
# sure; HEADER_STDC wouldn't be the right check in sunos4, for instance.
# However, on my sunos4/gcc setup unistd.h leads us wrongly to believe
# we're posix-conformant, so always do the test.
echo $ac_n "checking for ansi/posix sprintf result""... $ac_c" 1>&6
echo "configure:1571: 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 1576 "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:1583: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>/dev/null
then
g77_cv_sys_sprintf_ansi=yes
else
echo "configure: failed program was:" >&5
cat conftest.$ac_ext >&5
rm -fr conftest*
g77_cv_sys_sprintf_ansi=no
fi
rm -fr conftest*
fi
if eval "test \"`echo '$''{'g77_cv_sys_sprintf_ansi'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
g77_cv_sys_sprintf_ansi=$g77_cv_sys_sprintf_ansi
fi
if test $ac_cv_c_cross = no; then
echo "$ac_t""$g77_cv_sys_sprintf_ansi" 1>&6
else
echo "$ac_t""can't tell -- assuming no" 1>&6
fi
# The cygwin patch takes steps to avoid defining USE_STRLEN here -- I don't
# understand why.
if test $g77_cv_sys_sprintf_ansi != yes; then
cat >> confdefs.h <<\EOF
#define USE_STRLEN 1
EOF
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:1617: checking NON_ANSI_RW_MODES" >&5
cat > conftest.$ac_ext <<EOF
#line 1619 "configure"
#include "confdefs.h"
#ifdef unix
yes
#endif
#ifdef __unix
yes
#endif
#ifdef __unix__
yes
#endif
EOF
if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
egrep "yes" >/dev/null 2>&1; then
rm -rf conftest*
is_unix=yes
else
rm -rf conftest*
is_unix=no
fi
rm -f conftest*
if test $g77_cv_sys_cygwin32 = yes || test $g77_cv_sys_mingw32 = yes; then
echo "$ac_t""no" 1>&6
else
if test $is_unix = yes; then
cat >> confdefs.h <<\EOF
#define NON_ANSI_RW_MODES 1
EOF
echo "$ac_t""yes" 1>&6
else
echo "$ac_t""no" 1>&6
fi
fi
# We have to firkle with the info in hconfig.h to figure out suitable types
# (via com.h). proj.h and com.h are in $srcdir/.., config.h which they need
# is in ../.. and the config files are in $srcdir/../../config.
echo $ac_n "checking f2c integer type""... $ac_c" 1>&6
echo "configure:1660: checking f2c integer type" >&5
late_ac_cpp=$ac_cpp
ac_cpp="$late_ac_cpp -I$srcdir/.. -I../.. -I$srcdir/../.. -I$srcdir/../../config"
if eval "test \"`echo '$''{'g77_cv_sys_f2cinteger'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
#line 1667 "configure"
#include "confdefs.h"
#include "proj.h"
#define FFECOM_DETERMINE_TYPES 1
#include "com.h"
#if FFECOM_f2cINTEGER == FFECOM_f2ccodeLONG
F2C_INTEGER=long int
#elif FFECOM_f2cINTEGER == FFECOM_f2ccodeINT
F2C_INTEGER=int
#else
# error "Cannot find a suitable type for F2C_INTEGER"
#endif
EOF
if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
egrep "F2C_INTEGER=long int" >/dev/null 2>&1; then
rm -rf conftest*
g77_cv_sys_f2cinteger="long int"
fi
rm -f conftest*
if test "$g77_cv_sys_f2cinteger" = ""; then
cat > conftest.$ac_ext <<EOF
#line 1690 "configure"
#include "confdefs.h"
#include "proj.h"
#define FFECOM_DETERMINE_TYPES 1
#include "com.h"
#if FFECOM_f2cINTEGER == FFECOM_f2ccodeLONG
F2C_INTEGER=long int
#elif FFECOM_f2cINTEGER == FFECOM_f2ccodeINT
F2C_INTEGER=int
#else
# error "Cannot find a suitable type for F2C_INTEGER"
#endif
EOF
if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
egrep "F2C_INTEGER=int" >/dev/null 2>&1; then
rm -rf conftest*
g77_cv_sys_f2cinteger=int
fi
rm -f conftest*
fi
if test "$g77_cv_sys_f2cinteger" = ""; then
echo "$ac_t""""" 1>&6
{ echo "configure: error: Can't determine type for f2c integer; config.log may help." 1>&2; exit 1; }
fi
fi
echo "$ac_t""$g77_cv_sys_f2cinteger" 1>&6
F2C_INTEGER=$g77_cv_sys_f2cinteger
ac_cpp=$late_ac_cpp
echo $ac_n "checking f2c long int type""... $ac_c" 1>&6
echo "configure:1725: checking f2c long int type" >&5
late_ac_cpp=$ac_cpp
ac_cpp="$late_ac_cpp -I$srcdir/.. -I../.. -I$srcdir/../.. -I$srcdir/../../config"
if eval "test \"`echo '$''{'g77_cv_sys_f2clongint'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
#line 1732 "configure"
#include "confdefs.h"
#include "proj.h"
#define FFECOM_DETERMINE_TYPES 1
#include "com.h"
#if FFECOM_f2cLONGINT == FFECOM_f2ccodeLONG
F2C_LONGINT=long int
#elif FFECOM_f2cLONGINT == FFECOM_f2ccodeLONGLONG
F2C_LONGINT=long long int
#else
# error "Cannot find a suitable type for F2C_LONGINT"
#endif
EOF
if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
egrep "F2C_LONGINT=long int" >/dev/null 2>&1; then
rm -rf conftest*
g77_cv_sys_f2clongint="long int"
fi
rm -f conftest*
if test "$g77_cv_sys_f2clongint" = ""; then
cat > conftest.$ac_ext <<EOF
#line 1755 "configure"
#include "confdefs.h"
#include "proj.h"
#define FFECOM_DETERMINE_TYPES 1
#include "com.h"
#if FFECOM_f2cLONGINT == FFECOM_f2ccodeLONG
F2C_LONGINT=long int
#elif FFECOM_f2cLONGINT == FFECOM_f2ccodeLONGLONG
F2C_LONGINT=long long int
#else
# error "Cannot find a suitable type for F2C_LONGINT"
#endif
EOF
if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
egrep "F2C_LONGINT=long long int" >/dev/null 2>&1; then
rm -rf conftest*
g77_cv_sys_f2clongint="long long int"
fi
rm -f conftest*
fi
if test "$g77_cv_sys_f2clongint" = ""; then
echo "$ac_t""""" 1>&6
{ echo "configure: error: Can't determine type for f2c long int; config.log may help." 1>&2; exit 1; }
fi
fi
echo "$ac_t""$g77_cv_sys_f2clongint" 1>&6
F2C_LONGINT=$g77_cv_sys_f2clongint
ac_cpp=$late_ac_cpp
# This EOF_CHAR is a misfeature on unix.
cat >> confdefs.h <<\EOF
#define NO_EOF_CHAR_CHECK 1
EOF
cat >> confdefs.h <<\EOF
#define Skip_f2c_Undefs 1
EOF
cat >> confdefs.h <<\EOF
#define Pad_UDread 1
EOF
cat >> confdefs.h <<\EOF
#define WANT_LEAD_0 1
EOF
# avoid confusion in case the `makefile's from the f2c distribution have
# got put here
test -f libF77/makefile && mv libF77/makefile libF77/makefile.ori
test -f libI77/makefile && mv libI77/makefile libI77/makefile.ori
test -f libU77/makefile && mv libU77/makefile libU77/makefile.ori
trap '' 1 2 15
cat > confcache <<\EOF
# This file is a shell script that caches the results of configure
# tests run on this system so they can be shared between configure
# scripts and configure runs. It is not useful on other systems.
# If it contains results you don't want to keep, you may remove or edit it.
#
# By default, configure uses ./config.cache as the cache file,
# creating it if it does not exist already. You can give configure
# the --cache-file=FILE option to use a different cache file; that is
# what configure does when it calls configure scripts in
# subdirectories, so they share the cache.
# Giving --cache-file=/dev/null disables caching, for debugging configure.
# config.status only pays attention to the cache file if you give it the
# --recheck option to rerun configure.
#
EOF
# The following way of writing the cache mishandles newlines in values,
# but we know of no workaround that is simple, portable, and efficient.
# So, don't put newlines in cache variables' values.
# Ultrix sh set writes to stderr and can't be redirected directly,
# and sets the high bit in the cache file unless we assign to the vars.
(set) 2>&1 |
case `(ac_space=' '; set) 2>&1 | grep ac_space` in
*ac_space=\ *)
# `set' does not quote correctly, so add quotes (double-quote substitution
# turns \\\\ into \\, and sed turns \\ into \).
sed -n \
-e "s/'/'\\\\''/g" \
-e "s/^\\([a-zA-Z0-9_]*_cv_[a-zA-Z0-9_]*\\)=\\(.*\\)/\\1=\${\\1='\\2'}/p"
;;
*)
# `set' quotes correctly as required by POSIX, so do not add quotes.
sed -n -e 's/^\([a-zA-Z0-9_]*_cv_[a-zA-Z0-9_]*\)=\(.*\)/\1=${\1=\2}/p'
;;
esac >> confcache
if cmp -s $cache_file confcache; then
:
else
if test -w $cache_file; then
echo "updating cache $cache_file"
cat confcache > $cache_file
else
echo "not updating unwritable cache $cache_file"
fi
fi
rm -f confcache
trap 'rm -fr conftest* confdefs* core core.* *.core $ac_clean_files; exit 1' 1 2 15
test "x$prefix" = xNONE && prefix=$ac_default_prefix
# Let make expand exec_prefix.
test "x$exec_prefix" = xNONE && exec_prefix='${prefix}'
# Any assignment to VPATH causes Sun make to only execute
# the first set of double-colon rules, so remove it if not needed.
# If there is a colon in the path, we need to keep it.
if test "x$srcdir" = x.; then
ac_vpsub='/^[ ]*VPATH[ ]*=[^:]*$/d'
fi
trap 'rm -f $CONFIG_STATUS conftest*; exit 1' 1 2 15
# Transform confdefs.h into DEFS.
# Protect against shell expansion while executing Makefile rules.
# Protect against Makefile macro expansion.
cat > conftest.defs <<\EOF
s%#define \([A-Za-z_][A-Za-z0-9_]*\) *\(.*\)%-D\1=\2%g
s%[ `~#$^&*(){}\\|;'"<>?]%\\&%g
s%\[%\\&%g
s%\]%\\&%g
s%\$%$$%g
EOF
DEFS=`sed -f conftest.defs confdefs.h | tr '\012' ' '`
rm -f conftest.defs
# Without the "./", some shells look in PATH for config.status.
: ${CONFIG_STATUS=./config.status}
echo creating $CONFIG_STATUS
rm -f $CONFIG_STATUS
cat > $CONFIG_STATUS <<EOF
#! /bin/sh
# Generated automatically by configure.
# Run this file to recreate the current configuration.
# This directory was configured as follows,
# on host `(hostname || uname -n) 2>/dev/null | sed 1q`:
#
# $0 $ac_configure_args
#
# Compiler output produced by configure, useful for debugging
# configure, is in ./config.log if it exists.
ac_cs_usage="Usage: $CONFIG_STATUS [--recheck] [--version] [--help]"
for ac_option
do
case "\$ac_option" in
-recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r)
echo "running \${CONFIG_SHELL-/bin/sh} $0 $ac_configure_args --no-create --no-recursion"
exec \${CONFIG_SHELL-/bin/sh} $0 $ac_configure_args --no-create --no-recursion ;;
-version | --version | --versio | --versi | --vers | --ver | --ve | --v)
echo "$CONFIG_STATUS generated by autoconf version 2.12.1"
exit 0 ;;
-help | --help | --hel | --he | --h)
echo "\$ac_cs_usage"; exit 0 ;;
*) echo "\$ac_cs_usage"; exit 1 ;;
esac
done
ac_given_srcdir=$srcdir
trap 'rm -fr `echo "Makefile ../../include/f2c.h:f2c.h.in libI77/Makefile libF77/Makefile libU77/Makefile" | sed "s/:[^ ]*//g"` conftest*; exit 1' 1 2 15
EOF
cat >> $CONFIG_STATUS <<EOF
# Protect against being on the right side of a sed subst in config.status.
sed 's/%@/@@/; s/@%/@@/; s/%g\$/@g/; /@g\$/s/[\\\\&%]/\\\\&/g;
s/@@/%@/; s/@@/@%/; s/@g\$/%g/' > conftest.subs <<\\CEOF
$ac_vpsub
$extrasub
s%@SHELL@%$SHELL%g
s%@CFLAGS@%$CFLAGS%g
s%@CPPFLAGS@%$CPPFLAGS%g
s%@CXXFLAGS@%$CXXFLAGS%g
s%@DEFS@%$DEFS%g
s%@LDFLAGS@%$LDFLAGS%g
s%@LIBS@%$LIBS%g
s%@exec_prefix@%$exec_prefix%g
s%@prefix@%$prefix%g
s%@program_transform_name@%$program_transform_name%g
s%@bindir@%$bindir%g
s%@sbindir@%$sbindir%g
s%@libexecdir@%$libexecdir%g
s%@datadir@%$datadir%g
s%@sysconfdir@%$sysconfdir%g
s%@sharedstatedir@%$sharedstatedir%g
s%@localstatedir@%$localstatedir%g
s%@libdir@%$libdir%g
s%@includedir@%$includedir%g
s%@oldincludedir@%$oldincludedir%g
s%@infodir@%$infodir%g
s%@mandir@%$mandir%g
s%@CC@%$CC%g
s%@AR@%$AR%g
s%@RANLIB@%$RANLIB%g
s%@RANLIB_TEST@%$RANLIB_TEST%g
s%@CPP@%$CPP%g
s%@F2C_INTEGER@%$F2C_INTEGER%g
s%@F2C_LONGINT@%$F2C_LONGINT%g
s%@CROSS@%$CROSS%g
CEOF
EOF
cat >> $CONFIG_STATUS <<\EOF
# Split the substitutions into bite-sized pieces for seds with
# small command number limits, like on Digital OSF/1 and HP-UX.
ac_max_sed_cmds=90 # Maximum number of lines to put in a sed script.
ac_file=1 # Number of current file.
ac_beg=1 # First line for current file.
ac_end=$ac_max_sed_cmds # Line after last line for current file.
ac_more_lines=:
ac_sed_cmds=""
while $ac_more_lines; do
if test $ac_beg -gt 1; then
sed "1,${ac_beg}d; ${ac_end}q" conftest.subs > conftest.s$ac_file
else
sed "${ac_end}q" conftest.subs > conftest.s$ac_file
fi
if test ! -s conftest.s$ac_file; then
ac_more_lines=false
rm -f conftest.s$ac_file
else
if test -z "$ac_sed_cmds"; then
ac_sed_cmds="sed -f conftest.s$ac_file"
else
ac_sed_cmds="$ac_sed_cmds | sed -f conftest.s$ac_file"
fi
ac_file=`expr $ac_file + 1`
ac_beg=$ac_end
ac_end=`expr $ac_end + $ac_max_sed_cmds`
fi
done
if test -z "$ac_sed_cmds"; then
ac_sed_cmds=cat
fi
EOF
cat >> $CONFIG_STATUS <<EOF
CONFIG_FILES=\${CONFIG_FILES-"Makefile ../../include/f2c.h:f2c.h.in libI77/Makefile libF77/Makefile libU77/Makefile"}
EOF
cat >> $CONFIG_STATUS <<\EOF
for ac_file in .. $CONFIG_FILES; do if test "x$ac_file" != x..; then
# Support "outfile[:infile[:infile...]]", defaulting infile="outfile.in".
case "$ac_file" in
*:*) ac_file_in=`echo "$ac_file"|sed 's%[^:]*:%%'`
ac_file=`echo "$ac_file"|sed 's%:.*%%'` ;;
*) ac_file_in="${ac_file}.in" ;;
esac
# Adjust a relative srcdir, top_srcdir, and INSTALL for subdirectories.
# Remove last slash and all that follows it. Not all systems have dirname.
ac_dir=`echo $ac_file|sed 's%/[^/][^/]*$%%'`
if test "$ac_dir" != "$ac_file" && test "$ac_dir" != .; then
# The file is in a subdirectory.
test ! -d "$ac_dir" && mkdir "$ac_dir"
ac_dir_suffix="/`echo $ac_dir|sed 's%^\./%%'`"
# A "../" for each directory in $ac_dir_suffix.
ac_dots=`echo $ac_dir_suffix|sed 's%/[^/]*%../%g'`
else
ac_dir_suffix= ac_dots=
fi
case "$ac_given_srcdir" in
.) srcdir=.
if test -z "$ac_dots"; then top_srcdir=.
else top_srcdir=`echo $ac_dots|sed 's%/$%%'`; fi ;;
/*) srcdir="$ac_given_srcdir$ac_dir_suffix"; top_srcdir="$ac_given_srcdir" ;;
*) # Relative path.
srcdir="$ac_dots$ac_given_srcdir$ac_dir_suffix"
top_srcdir="$ac_dots$ac_given_srcdir" ;;
esac
echo creating "$ac_file"
rm -f "$ac_file"
configure_input="Generated automatically from `echo $ac_file_in|sed 's%.*/%%'` by configure."
case "$ac_file" in
*Makefile*) ac_comsub="1i\\
# $configure_input" ;;
*) ac_comsub= ;;
esac
ac_file_inputs=`echo $ac_file_in|sed -e "s%^%$ac_given_srcdir/%" -e "s%:% $ac_given_srcdir/%g"`
sed -e "$ac_comsub
s%@configure_input@%$configure_input%g
s%@srcdir@%$srcdir%g
s%@top_srcdir@%$top_srcdir%g
" $ac_file_inputs | (eval "$ac_sed_cmds") > $ac_file
fi; done
rm -f conftest.s*
EOF
cat >> $CONFIG_STATUS <<EOF
EOF
cat >> $CONFIG_STATUS <<\EOF
exit 0
EOF
chmod +x $CONFIG_STATUS
rm -fr confdefs* $ac_clean_files
test "$no_create" = yes || ${CONFIG_SHELL-/bin/sh} $CONFIG_STATUS || exit 1
# Process this file with autoconf to produce a configure script.
# Copyright (C) 1995, 1997 Free Software Foundation, Inc.
# Contributed by Dave Love (d.love@dl.ac.uk).
#
#This file is part of GNU Fortran.
#
#GNU Fortran is free software; you can redistribute it and/or modify
#it under the terms of the GNU General Public License as published by
#the Free Software Foundation; either version 2, or (at your option)
#any later version.
#
#GNU Fortran is distributed in the hope that it will be useful,
#but WITHOUT ANY WARRANTY; without even the implied warranty of
#MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
#GNU General Public License for more details.
#
#You should have received a copy of the GNU General Public License
#along with GNU Fortran; see the file COPYING. If not, write to
#the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
#02111-1307, USA.
AC_INIT(libF77/Version.c)
AC_REVISION(1.10)
dnl Checks for programs.
# For g77 we'll set CC to point at the built gcc, but this will get it into
# the makefiles
AC_PROG_CC
dnl AC_C_CROSS
dnl Gives misleading `(cached)' message from the check.
if test "$CROSS";then
ac_cv_c_cross=yes
else
ac_cv_c_cross=no
fi
dnl These should be inherited in the recursive make, but ensure they are
dnl defined:
test "$AR" || AR=ar
AC_SUBST(AR)
if test "$RANLIB"; then :
AC_SUBST(RANLIB)
dnl Make sure that RANLIB_TEST is set also.
if test -z "$RANLIB_TEST"; then
RANLIB_TEST=true
fi
else
RANLIB_TEST=true
AC_PROG_RANLIB
fi
AC_SUBST(RANLIB_TEST)
dnl not needed for g77?
dnl AC_PROG_MAKE_SET
dnl Checks for libraries.
dnl Checks for header files.
# Sanity check for the cross-compilation case:
AC_CHECK_HEADER(stdio.h,:,
[AC_MSG_ERROR([Can't find stdio.h.
You must have a usable C system for the target already installed, at least
including headers and, preferably, the library, before you can configure
the G77 runtime system. If necessary, install gcc now with \`LANGUAGES=c',
then the target library, then build with \`LANGUAGES=f77'.])])
AC_HEADER_STDC
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)
dnl for U77
dnl AC_CHECK_HEADERS(unistd.h)
AC_MSG_CHECKING(for posix)
AC_CACHE_VAL(g77_cv_header_posix,
AC_EGREP_CPP(yes,
[#include <sys/types.h>
#include <unistd.h>
#ifdef _POSIX_VERSION
yes
#endif
],
g77_cv_header_posix=yes,
g77_cv_header_posix=no))
AC_MSG_RESULT($g77_cv_header_posix)
# We can rely on the GNU library being posix-ish. I guess checking the
# header isn't actually like checking the functions, though...
AC_MSG_CHECKING(for GNU library)
AC_CACHE_VAL(g77_cv_lib_gnu,
AC_EGREP_CPP(yes,
[#include <stdio.h>
#ifdef __GNU_LIBRARY__
yes
#endif
],
g77_cv_lib_gnu=yes, g77_cv_lib_gnu=no))
AC_MSG_RESULT($g77_cv_lib_gnu)
# Apparently cygwin needs to be special-cased.
AC_MSG_CHECKING([for cyg\`win'32])
AC_CACHE_VAL(g77_cv_sys_cygwin32,
AC_EGREP_CPP(yes,
[#ifdef __CYGWIN32__
yes
#endif
],
g77_cv_sys_cygwin32=yes,
g77_cv_sys_cygwin32=no))
AC_MSG_RESULT($g77_cv_sys_cygwin32)
# ditto for mingw32.
AC_MSG_CHECKING([for mingw32])
AC_CACHE_VAL(g77_cv_sys_mingw32,
AC_EGREP_CPP(yes,
[#ifdef __MINGW32__
yes
#endif
],
g77_cv_sys_mingw32=yes,
g77_cv_sys_mingw32=no))
AC_MSG_RESULT($g77_cv_sys_mingw32)
AC_CHECK_HEADER(fcntl.h,
test $g77_cv_header_posix = yes && AC_DEFINE(_POSIX_SOURCE),
AC_DEFINE(NO_FCNTL) AC_DEFINE(OPEN_DECL))
dnl Checks for typedefs, structures, and compiler characteristics.
AC_C_CONST
AC_TYPE_SIZE_T
dnl Checks for library functions.
AC_TYPE_SIGNAL
# we'll get atexit by default
if test $ac_cv_header_stdc != yes; then
AC_CHECK_FUNC(atexit,
AC_DEFINE(onexit,atexit),dnl just in case
[AC_DEFINE(NO_ONEXIT)
AC_CHECK_FUNC(onexit,,
[AC_CHECK_FUNC(on_exit,
AC_DEFINE(onexit,on_exit),)])])
else true
fi
# This should always succeed on unix.
# Apparently positive result on cygwin loses re. NON_UNIX_STDIO
# (as of cygwin b18). Likewise on mingw.
AC_CHECK_FUNC(fstat)
AC_MSG_CHECKING([need for NON_UNIX_STDIO])
if test $g77_cv_sys_cygwin32 = yes \
|| test $g77_cv_sys_mingw32 = yes \
|| test $ac_cv_func_fstat = no; then
AC_MSG_RESULT(yes)
AC_DEFINE(NON_UNIX_STDIO)
else
AC_MSG_RESULT(no)
fi
# This is necessary for e.g. Linux:
AC_MSG_CHECKING([for necessary members of struct FILE])
AC_CACHE_VAL(g77_cv_struct_FILE,
[AC_TRY_COMPILE([#include <stdio.h>],
[FILE s; s._ptr; s._base; s._flag;],g77_cv_struct_FILE=yes,
g77_cv_struct_FILE=no)])dnl
AC_MSG_RESULT($g77_cv_struct_FILE)
if test $g77_cv_struct_FILE = no; then
AC_DEFINE(MISSING_FILE_ELEMS)
fi
dnl perhaps should check also for remainder
dnl Unfortunately, the message implies we're just checking for -lm...
AC_CHECK_LIB(m,drem,AC_DEFINE(IEEE_drem))
dnl for U77:
dnl AC_CHECK_FUNCS(symlink getcwd lstat)
dnl test $ac_cv_func_symlink = yes && SYMLNK=symlnk_.o
dnl test $ac_cv_func_lstat = yes && SYMLNK="$SYMLNK lstat_.o"
dnl AC_SUBST(SYMLNK)
# posix will guarantee the right behaviour for sprintf, else we can't be
# sure; HEADER_STDC wouldn't be the right check in sunos4, for instance.
# However, on my sunos4/gcc setup unistd.h leads us wrongly to believe
# we're posix-conformant, so always do the test.
AC_MSG_CHECKING(for ansi/posix sprintf result)
dnl This loses if included as an argument to AC_CACHE_VAL because the
dnl changequote doesn't take effect and the [] vanish.
dnl fixme: use cached value
AC_TRY_RUN(changequote(<<, >>)dnl
<<#include <stdio.h>
/* does sprintf return the number of chars transferred? */
main () {char foo[2]; (sprintf(foo, "1") == 1) ? exit(0) : exit(1);}
>>changequote([, ]),
g77_cv_sys_sprintf_ansi=yes,
g77_cv_sys_sprintf_ansi=no,
g77_cv_sys_sprintf_ansi=no)
AC_CACHE_VAL(g77_cv_sys_sprintf_ansi,
g77_cv_sys_sprintf_ansi=$g77_cv_sys_sprintf_ansi)
dnl We get a misleading `(cached)' message...
if test $ac_cv_c_cross = no; then
AC_MSG_RESULT($g77_cv_sys_sprintf_ansi)
else
AC_MSG_RESULT([can't tell -- assuming no])
fi
# The cygwin patch takes steps to avoid defining USE_STRLEN here -- I don't
# understand why.
if test $g77_cv_sys_sprintf_ansi != yes; then
AC_DEFINE(USE_STRLEN)
fi
# define NON_ANSI_RW_MODES on unix (can't hurt)
AC_MSG_CHECKING(NON_ANSI_RW_MODES)
AC_EGREP_CPP(yes,
[#ifdef unix
yes
#endif
#ifdef __unix
yes
#endif
#ifdef __unix__
yes
#endif
], is_unix=yes, is_unix=no)
if test $g77_cv_sys_cygwin32 = yes || test $g77_cv_sys_mingw32 = yes; then
AC_MSG_RESULT(no)
else
if test $is_unix = yes; then
AC_DEFINE(NON_ANSI_RW_MODES)
AC_MSG_RESULT(yes)
else
AC_MSG_RESULT(no)
fi
fi
# We have to firkle with the info in hconfig.h to figure out suitable types
# (via com.h). proj.h and com.h are in $srcdir/.., config.h which they need
# is in ../.. and the config files are in $srcdir/../../config.
AC_MSG_CHECKING(f2c integer type)
late_ac_cpp=$ac_cpp
ac_cpp="$late_ac_cpp -I$srcdir/.. -I../.. -I$srcdir/../.. -I$srcdir/../../config"
AC_CACHE_VAL(g77_cv_sys_f2cinteger,
AC_EGREP_CPP(F2C_INTEGER=long int,
[#include "proj.h"
#define FFECOM_DETERMINE_TYPES 1
#include "com.h"
#if FFECOM_f2cINTEGER == FFECOM_f2ccodeLONG
F2C_INTEGER=long int
#elif FFECOM_f2cINTEGER == FFECOM_f2ccodeINT
F2C_INTEGER=int
#else
# error "Cannot find a suitable type for F2C_INTEGER"
#endif
],
g77_cv_sys_f2cinteger="long int",)
if test "$g77_cv_sys_f2cinteger" = ""; then
AC_EGREP_CPP(F2C_INTEGER=int,
[#include "proj.h"
#define FFECOM_DETERMINE_TYPES 1
#include "com.h"
#if FFECOM_f2cINTEGER == FFECOM_f2ccodeLONG
F2C_INTEGER=long int
#elif FFECOM_f2cINTEGER == FFECOM_f2ccodeINT
F2C_INTEGER=int
#else
# error "Cannot find a suitable type for F2C_INTEGER"
#endif
],
g77_cv_sys_f2cinteger=int,)
fi
if test "$g77_cv_sys_f2cinteger" = ""; then
AC_MSG_RESULT("")
AC_MSG_ERROR([Can't determine type for f2c integer; config.log may help.])
fi
)
AC_MSG_RESULT($g77_cv_sys_f2cinteger)
F2C_INTEGER=$g77_cv_sys_f2cinteger
ac_cpp=$late_ac_cpp
AC_SUBST(F2C_INTEGER)
AC_MSG_CHECKING(f2c long int type)
late_ac_cpp=$ac_cpp
ac_cpp="$late_ac_cpp -I$srcdir/.. -I../.. -I$srcdir/../.. -I$srcdir/../../config"
AC_CACHE_VAL(g77_cv_sys_f2clongint,
AC_EGREP_CPP(F2C_LONGINT=long int,
[#include "proj.h"
#define FFECOM_DETERMINE_TYPES 1
#include "com.h"
#if FFECOM_f2cLONGINT == FFECOM_f2ccodeLONG
F2C_LONGINT=long int
#elif FFECOM_f2cLONGINT == FFECOM_f2ccodeLONGLONG
F2C_LONGINT=long long int
#else
# error "Cannot find a suitable type for F2C_LONGINT"
#endif
],
g77_cv_sys_f2clongint="long int",)
if test "$g77_cv_sys_f2clongint" = ""; then
AC_EGREP_CPP(F2C_LONGINT=long long int,
[#include "proj.h"
#define FFECOM_DETERMINE_TYPES 1
#include "com.h"
#if FFECOM_f2cLONGINT == FFECOM_f2ccodeLONG
F2C_LONGINT=long int
#elif FFECOM_f2cLONGINT == FFECOM_f2ccodeLONGLONG
F2C_LONGINT=long long int
#else
# error "Cannot find a suitable type for F2C_LONGINT"
#endif
],
g77_cv_sys_f2clongint="long long int",)
fi
if test "$g77_cv_sys_f2clongint" = ""; then
AC_MSG_RESULT("")
AC_MSG_ERROR([Can't determine type for f2c long int; config.log may help.])
fi
)
AC_MSG_RESULT($g77_cv_sys_f2clongint)
F2C_LONGINT=$g77_cv_sys_f2clongint
ac_cpp=$late_ac_cpp
AC_SUBST(F2C_LONGINT)
dnl maybe check for drem/remainder
AC_SUBST(CROSS)
# This EOF_CHAR is a misfeature on unix.
AC_DEFINE(NO_EOF_CHAR_CHECK)
AC_DEFINE(Skip_f2c_Undefs)
dnl Craig had these in f2c.h, but they're only relevant for building libf2c
dnl anyway.
dnl For GNU Fortran (g77), we always enable the following behaviors for
dnl libf2c, to make things easy on the programmer. The alternate
dnl behaviors have their uses, and g77 might provide them as compiler,
dnl rather than library, options, so only a single copy of a shared libf2c
dnl need be built for a system.
dnl This makes unformatted I/O more consistent in relation to other
dnl systems. It is not required by the F77 standard.
AC_DEFINE(Pad_UDread)
dnl This makes ERR= and IOSTAT= returns work properly in disk-full
dnl situations, making things work more as expected. It slows things
dnl down, so g77 will probably someday choose the original implementation
dnl on a case-by-case basis when it can be shown to not be necessary
dnl (e.g. no ERR= or IOSTAT=) or when it is given the appropriate
dnl compile-time option or, perhaps, source-code directive.
dnl AC_DEFINE(ALWAYS_FLUSH)
dnl Most Fortran implementations do this, so to make it easier
dnl to compare the output of g77-compiled programs to those compiled
dnl by most other compilers, tell libf2c to put leading zeros in
dnl appropriate places on output
AC_DEFINE(WANT_LEAD_0)
# avoid confusion in case the `makefile's from the f2c distribution have
# got put here
test -f libF77/makefile && mv libF77/makefile libF77/makefile.ori
test -f libI77/makefile && mv libI77/makefile libI77/makefile.ori
test -f libU77/makefile && mv libU77/makefile libU77/makefile.ori
AC_OUTPUT(Makefile ../../include/f2c.h:f2c.h.in libI77/Makefile libF77/Makefile libU77/Makefile)
dnl We might have configuration options to:
dnl * allow non-standard string concatenation (use libF77 s_catow.o,
dnl not s_cat.o)
dnl * change unit preconnexion in libI77/err.c (f_init.c)
dnl * -DALWAYS_FLUSH in libI77
dnl * -DOMIT_BLANK_CC in libI77
dnl Local Variables:
dnl comment-start: "dnl "
dnl comment-end: ""
dnl comment-start-skip: "\\bdnl\\b\\s *"
dnl End:
f2c is a Fortran to C converter under development since 1990 by
David M. Gay (then AT&T Bell Labs, now Bell Labs, Lucent Technologies)
Stu Feldman (then at Bellcore, now at IBM)
Mark Maimone (Carnegie-Mellon University)
Norm Schryer (then AT&T Bell Labs, now AT&T Labs)
Please send bug reports to dmg@research.bell-labs.com .
AT&T, Bellcore and Lucent disclaim all warranties with regard to this
software, including all implied warranties of merchantability
and fitness. In no event shall AT&T, Bellcore or Lucent be liable for
any special, indirect or consequential damages or any damages
whatsoever resulting from loss of use, data or profits, whether
in an action of contract, negligence or other tortious action,
arising out of or in connection with the use or performance of
this software.
/* f2c.h -- Standard Fortran to C header file */
/** barf [ba:rf] 2. "He suggested using FORTRAN, and everybody barfed."
- From The Shogakukan DICTIONARY OF NEW ENGLISH (Second edition) */
#ifndef F2C_INCLUDE
#define F2C_INCLUDE
/* F2C_INTEGER will normally be `int' but would be `long' on 16-bit systems */
/* we assume short, float are OK */
typedef @F2C_INTEGER@ /* long int */ integer;
typedef unsigned @F2C_INTEGER@ /* long */ uinteger;
typedef char *address;
typedef short int shortint;
typedef float real;
typedef double doublereal;
typedef struct { real r, i; } complex;
typedef struct { doublereal r, i; } doublecomplex;
typedef @F2C_INTEGER@ /* long int */ logical;
typedef short int shortlogical;
typedef char logical1;
typedef char integer1;
typedef @F2C_LONGINT@ /* long long */ longint; /* system-dependent */
typedef unsigned @F2C_LONGINT@ /* long long */ ulongint; /* system-dependent */
#define qbit_clear(a,b) ((a) & ~((ulongint)1 << (b)))
#define qbit_set(a,b) ((a) | ((ulongint)1 << (b)))
#define TRUE_ (1)
#define FALSE_ (0)
/* Extern is for use with -E */
#ifndef Extern
#define Extern extern
#endif
/* I/O stuff */
#ifdef f2c_i2
#error "f2c_i2 will not work with g77!!!!"
/* for -i2 */
typedef short flag;
typedef short ftnlen;
typedef short ftnint;
#else
typedef @F2C_INTEGER@ /* long int */ flag;
typedef @F2C_INTEGER@ /* long int */ ftnlen;
typedef @F2C_INTEGER@ /* long int */ ftnint;
#endif
/*external read, write*/
typedef struct
{ flag cierr;
ftnint ciunit;
flag ciend;
char *cifmt;
ftnint cirec;
} cilist;
/*internal read, write*/
typedef struct
{ flag icierr;
char *iciunit;
flag iciend;
char *icifmt;
ftnint icirlen;
ftnint icirnum;
} icilist;
/*open*/
typedef struct
{ flag oerr;
ftnint ounit;
char *ofnm;
ftnlen ofnmlen;
char *osta;
char *oacc;
char *ofm;
ftnint orl;
char *oblnk;
} olist;
/*close*/
typedef struct
{ flag cerr;
ftnint cunit;
char *csta;
} cllist;
/*rewind, backspace, endfile*/
typedef struct
{ flag aerr;
ftnint aunit;
} alist;
/* inquire */
typedef struct
{ flag inerr;
ftnint inunit;
char *infile;
ftnlen infilen;
ftnint *inex; /*parameters in standard's order*/
ftnint *inopen;
ftnint *innum;
ftnint *innamed;
char *inname;
ftnlen innamlen;
char *inacc;
ftnlen inacclen;
char *inseq;
ftnlen inseqlen;
char *indir;
ftnlen indirlen;
char *infmt;
ftnlen infmtlen;
char *inform;
ftnint informlen;
char *inunf;
ftnlen inunflen;
ftnint *inrecl;
ftnint *innrec;
char *inblank;
ftnlen inblanklen;
} inlist;
#define VOID void
union Multitype { /* for multiple entry points */
integer1 g;
shortint h;
integer i;
/* longint j; */
real r;
doublereal d;
complex c;
doublecomplex z;
};
typedef union Multitype Multitype;
/*typedef long int Long;*/ /* No longer used; formerly in Namelist */
struct Vardesc { /* for Namelist */
char *name;
char *addr;
ftnlen *dims;
int type;
};
typedef struct Vardesc Vardesc;
struct Namelist {
char *name;
Vardesc **vars;
int nvars;
};
typedef struct Namelist Namelist;
#define abs(x) ((x) >= 0 ? (x) : -(x))
#define dabs(x) (doublereal)abs(x)
#define min(a,b) ((a) <= (b) ? (a) : (b))
#define max(a,b) ((a) >= (b) ? (a) : (b))
#define dmin(a,b) (doublereal)min(a,b)
#define dmax(a,b) (doublereal)max(a,b)
#define bit_test(a,b) ((a) >> (b) & 1)
#define bit_clear(a,b) ((a) & ~((uinteger)1 << (b)))
#define bit_set(a,b) ((a) | ((uinteger)1 << (b)))
/* procedure parameter types for -A and -C++ */
#define F2C_proc_par_types 1
#ifdef __cplusplus
typedef int /* Unknown procedure type */ (*U_fp)(...);
typedef shortint (*J_fp)(...);
typedef integer (*I_fp)(...);
typedef real (*R_fp)(...);
typedef doublereal (*D_fp)(...), (*E_fp)(...);
typedef /* Complex */ VOID (*C_fp)(...);
typedef /* Double Complex */ VOID (*Z_fp)(...);
typedef logical (*L_fp)(...);
typedef shortlogical (*K_fp)(...);
typedef /* Character */ VOID (*H_fp)(...);
typedef /* Subroutine */ int (*S_fp)(...);
#else
typedef int /* Unknown procedure type */ (*U_fp)();
typedef shortint (*J_fp)();
typedef integer (*I_fp)();
typedef real (*R_fp)();
typedef doublereal (*D_fp)(), (*E_fp)();
typedef /* Complex */ VOID (*C_fp)();
typedef /* Double Complex */ VOID (*Z_fp)();
typedef logical (*L_fp)();
typedef shortlogical (*K_fp)();
typedef /* Character */ VOID (*H_fp)();
typedef /* Subroutine */ int (*S_fp)();
#endif
/* E_fp is for real functions when -R is not specified */
typedef VOID C_f; /* complex function */
typedef VOID H_f; /* character function */
typedef VOID Z_f; /* double complex function */
typedef doublereal E_f; /* real function with -R not specified */
/* undef any lower-case symbols that your C compiler predefines, e.g.: */
#ifndef Skip_f2c_Undefs
/* (No such symbols should be defined in a strict ANSI C compiler.
We can avoid trouble with f2c-translated code by using
gcc -ansi [-traditional].) */
#undef cray
#undef gcos
#undef mc68010
#undef mc68020
#undef mips
#undef pdp11
#undef sgi
#undef sparc
#undef sun
#undef sun2
#undef sun3
#undef sun4
#undef u370
#undef u3b
#undef u3b2
#undef u3b5
#undef unix
#undef vax
#endif
#endif
/* Copyright (C) 1997 Free Software Foundation, Inc.
This file is part of GNU Fortran run-time library.
This library is free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published
by the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
GNU Fortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with GNU Fortran; see the file COPYING.LIB. If
not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA. */
#include <f2c.h>
typedef int (*sig_proc)(int);
#ifdef Labort
int abort_ (void) {
extern int G77_abort_0 (void);
return G77_abort_0 ();
}
#endif
#ifdef Lderf
double derf_ (doublereal *x) {
extern double G77_derf_0 (doublereal *x);
return G77_derf_0 (x);
}
#endif
#ifdef Lderfc
double derfc_ (doublereal *x) {
extern double G77_derfc_0 (doublereal *x);
return G77_derfc_0 (x);
}
#endif
#ifdef Lef1asc
int ef1asc_ (ftnint *a, ftnlen *la, ftnint *b, ftnlen *lb) {
extern int G77_ef1asc_0 (ftnint *a, ftnlen *la, ftnint *b, ftnlen *lb);
return G77_ef1asc_0 (a, la, b, lb);
}
#endif
#ifdef Lef1cmc
integer ef1cmc_ (ftnint *a, ftnlen *la, ftnint *b, ftnlen *lb) {
extern integer G77_ef1cmc_0 (ftnint *a, ftnlen *la, ftnint *b, ftnlen *lb);
return G77_ef1cmc_0 (a, la, b, lb);
}
#endif
#ifdef Lerf
double erf_ (real *x) {
extern double G77_erf_0 (real *x);
return G77_erf_0 (x);
}
#endif
#ifdef Lerfc
double erfc_ (real *x) {
extern double G77_erfc_0 (real *x);
return G77_erfc_0 (x);
}
#endif
#ifdef Lexit
void exit_ (integer *rc) {
extern void G77_exit_0 (integer *rc);
G77_exit_0 (rc);
}
#endif
#ifdef Lgetarg
void getarg_ (ftnint *n, char *s, ftnlen ls) {
extern void G77_getarg_0 (ftnint *n, char *s, ftnlen ls);
G77_getarg_0 (n, s, ls);
}
#endif
#ifdef Lgetenv
void getenv_ (char *fname, char *value, ftnlen flen, ftnlen vlen) {
extern void G77_getenv_0 (char *fname, char *value, ftnlen flen, ftnlen vlen);
G77_getenv_0 (fname, value, flen, vlen);
}
#endif
#ifdef Liargc
ftnint iargc_ (void) {
extern ftnint G77_iargc_0 (void);
return G77_iargc_0 ();
}
#endif
#ifdef Lsignal
ftnint signal_ (integer *sigp, sig_proc proc) {
extern ftnint G77_signal_0 (integer *sigp, sig_proc proc);
return G77_signal_0 (sigp, proc);
}
#endif
#ifdef Lsystem
integer system_ (char *s, ftnlen n) {
extern integer G77_system_0 (char *s, ftnlen n);
return G77_system_0 (s, n);
}
#endif
#ifdef Lflush
int flush_ (void) {
extern int G77_flush_0 (void);
return G77_flush_0 ();
}
#endif
#ifdef Lftell
integer ftell_ (integer *Unit) {
extern integer G77_ftell_0 (integer *Unit);
return G77_ftell_0 (Unit);
}
#endif
#ifdef Lfseek
integer fseek_ (integer *Unit, integer *offset, integer *xwhence) {
extern integer G77_fseek_0 (integer *Unit, integer *offset, integer *xwhence);
return G77_fseek_0 (Unit, offset, xwhence);
}
#endif
#ifdef Laccess
integer access_ (const char *name, const char *mode, ftnlen Lname, ftnlen Lmode) {
extern integer G77_access_0 (const char *name, const char *mode, ftnlen Lname, ftnlen Lmode);
return G77_access_0 (name, mode, Lname, Lmode);
}
#endif
#ifdef Lalarm
integer alarm_ (integer *seconds, sig_proc proc, integer *status) {
extern integer G77_alarm_0 (integer *seconds, sig_proc proc);
return G77_alarm_0 (seconds, proc);
}
#endif
#ifdef Lbesj0
double besj0_ (const real *x) {
return j0 (*x);
}
#endif
#ifdef Lbesj1
double besj1_ (const real *x) {
return j1 (*x);
}
#endif
#ifdef Lbesjn
double besjn_ (const integer *n, real *x) {
return jn (*n, *x);
}
#endif
#ifdef Lbesy0
double besy0_ (const real *x) {
return y0 (*x);
}
#endif
#ifdef Lbesy1
double besy1_ (const real *x) {
return y1 (*x);
}
#endif
#ifdef Lbesyn
double besyn_ (const integer *n, real *x) {
return yn (*n, *x);
}
#endif
#ifdef Lchdir
integer chdir_ (const char *name, const ftnlen Lname) {
extern integer G77_chdir_0 (const char *name, const ftnlen Lname);
return G77_chdir_0 (name, Lname);
}
#endif
#ifdef Lchmod
integer chmod_ (const char *name, const char *mode, const ftnlen Lname, const ftnlen Lmode) {
extern integer G77_chmod_0 (const char *name, const char *mode, const ftnlen Lname, const ftnlen Lmode);
return G77_chmod_0 (name, mode, Lname, Lmode);
}
#endif
#ifdef Lctime
void ctime_ (char *chtime, const ftnlen Lchtime, longint *xstime) {
extern void G77_ctime_0 (char *chtime, const ftnlen Lchtime, longint *xstime);
G77_ctime_0 (chtime, Lchtime, xstime);
}
#endif
#ifdef Ldate
int date_ (char *buf, ftnlen buf_len) {
extern int G77_date_0 (char *buf, ftnlen buf_len);
return G77_date_0 (buf, buf_len);
}
#endif
#ifdef Ldbesj0
double dbesj0_ (const double *x) {
return j0 (*x);
}
#endif
#ifdef Ldbesj1
double dbesj1_ (const double *x) {
return j1 (*x);
}
#endif
#ifdef Ldbesjn
double dbesjn_ (const integer *n, double *x) {
return jn (*n, *x);
}
#endif
#ifdef Ldbesy0
double dbesy0_ (const double *x) {
return y0 (*x);
}
#endif
#ifdef Ldbesy1
double dbesy1_ (const double *x) {
return y1 (*x);
}
#endif
#ifdef Ldbesyn
double dbesyn_ (const integer *n, double *x) {
return yn (*n, *x);
}
#endif
#ifdef Ldtime
double dtime_ (real tarray[2]) {
extern double G77_dtime_0 (real tarray[2]);
return G77_dtime_0 (tarray);
}
#endif
#ifdef Letime
double etime_ (real tarray[2]) {
extern double G77_etime_0 (real tarray[2]);
return G77_etime_0 (tarray);
}
#endif
#ifdef Lfdate
void fdate_ (char *ret_val, ftnlen ret_val_len) {
extern void G77_fdate_0 (char *ret_val, ftnlen ret_val_len);
G77_fdate_0 (ret_val, ret_val_len);
}
#endif
#ifdef Lfgetc
integer fgetc_ (const integer *lunit, char *c, ftnlen Lc) {
extern integer G77_fgetc_0 (const integer *lunit, char *c, ftnlen Lc);
return G77_fgetc_0 (lunit, c, Lc);
}
#endif
#ifdef Lfget
integer fget_ (char *c, const ftnlen Lc) {
extern integer G77_fget_0 (char *c, const ftnlen Lc);
return G77_fget_0 (c, Lc);
}
#endif
#ifdef Lflush1
int flush1_ (const integer *lunit) {
extern int G77_flush1_0 (const integer *lunit);
return G77_flush1_0 (lunit);
}
#endif
#ifdef Lfnum
integer fnum_ (integer *lunit) {
extern integer G77_fnum_0 (integer *lunit);
return G77_fnum_0 (lunit);
}
#endif
#ifdef Lfputc
integer fputc_ (const integer *lunit, const char *c, const ftnlen Lc) {
extern integer G77_fputc_0 (const integer *lunit, const char *c, const ftnlen Lc);
return G77_fputc_0 (lunit, c, Lc);
}
#endif
#ifdef Lfput
integer fput_ (const char *c, const ftnlen Lc) {
extern integer G77_fput_0 (const char *c, const ftnlen Lc);
return G77_fput_0 (c, Lc);
}
#endif
#ifdef Lfstat
integer fstat_ (const integer *lunit, integer statb[13]) {
extern integer G77_fstat_0 (const integer *lunit, integer statb[13]);
return G77_fstat_0 (lunit, statb);
}
#endif
#ifdef Lgerror
int gerror_ (char *str, ftnlen Lstr) {
extern int G77_gerror_0 (char *str, ftnlen Lstr);
return G77_gerror_0 (str, Lstr);
}
#endif
#ifdef Lgetcwd
integer getcwd_ (char *str, const ftnlen Lstr) {
extern integer G77_getcwd_0 (char *str, const ftnlen Lstr);
return G77_getcwd_0 (str, Lstr);
}
#endif
#ifdef Lgetgid
integer getgid_ (void) {
extern integer G77_getgid_0 (void);
return G77_getgid_0 ();
}
#endif
#ifdef Lgetlog
int getlog_ (char *str, const ftnlen Lstr) {
extern int G77_getlog_0 (char *str, const ftnlen Lstr);
return G77_getlog_0 (str, Lstr);
}
#endif
#ifdef Lgetpid
integer getpid_ (void) {
extern integer G77_getpid_0 (void);
return G77_getpid_0 ();
}
#endif
#ifdef Lgetuid
integer getuid_ (void) {
extern integer G77_getuid_0 (void);
return G77_getuid_0 ();
}
#endif
#ifdef Lgmtime
int gmtime_ (const integer *stime, integer tarray[9]) {
extern int G77_gmtime_0 (const integer *stime, integer tarray[9]);
return G77_gmtime_0 (stime, tarray);
}
#endif
#ifdef Lhostnm
integer hostnm_ (char *name, ftnlen Lname) {
extern integer G77_hostnm_0 (char *name, ftnlen Lname);
return G77_hostnm_0 (name, Lname);
}
#endif
#ifdef Lidate
int idate_ (int iarray[3]) {
extern int G77_idate_0 (int iarray[3]);
return G77_idate_0 (iarray);
}
#endif
#ifdef Lierrno
integer ierrno_ (void) {
extern integer G77_ierrno_0 (void);
return G77_ierrno_0 ();
}
#endif
#ifdef Lirand
integer irand_ (integer *flag) {
extern integer G77_irand_0 (integer *flag);
return G77_irand_0 (flag);
}
#endif
#ifdef Lisatty
logical isatty_ (integer *lunit) {
extern logical G77_isatty_0 (integer *lunit);
return G77_isatty_0 (lunit);
}
#endif
#ifdef Litime
int itime_ (integer tarray[3]) {
extern int G77_itime_0 (integer tarray[3]);
return G77_itime_0 (tarray);
}
#endif
#ifdef Lkill
integer kill_ (const integer *pid, const integer *signum) {
extern integer G77_kill_0 (const integer *pid, const integer *signum);
return G77_kill_0 (pid, signum);
}
#endif
#ifdef Llink
integer link_ (const char *path1, const char *path2, const ftnlen Lpath1, const ftnlen Lpath2) {
extern integer G77_link_0 (const char *path1, const char *path2, const ftnlen Lpath1, const ftnlen Lpath2);
return G77_link_0 (path1, path2, Lpath1, Lpath2);
}
#endif
#ifdef Llnblnk
integer lnblnk_ (char *str, ftnlen str_len) {
extern integer G77_lnblnk_0 (char *str, ftnlen str_len);
return G77_lnblnk_0 (str, str_len);
}
#endif
#ifdef Llstat
integer lstat_ (const char *name, integer statb[13], const ftnlen Lname) {
extern integer G77_lstat_0 (const char *name, integer statb[13], const ftnlen Lname);
return G77_lstat_0 (name, statb, Lname);
}
#endif
#ifdef Lltime
int ltime_ (const integer *stime, integer tarray[9]) {
extern int G77_ltime_0 (const integer *stime, integer tarray[9]);
return G77_ltime_0 (stime, tarray);
}
#endif
#ifdef Lmclock
longint mclock_ (void) {
extern longint G77_mclock_0 (void);
return G77_mclock_0 ();
}
#endif
#ifdef Lperror
int perror_ (const char *str, const ftnlen Lstr) {
extern int G77_perror_0 (const char *str, const ftnlen Lstr);
return G77_perror_0 (str, Lstr);
}
#endif
#ifdef Lrand
double rand_ (integer *flag) {
extern double G77_rand_0 (integer *flag);
return G77_rand_0 (flag);
}
#endif
#ifdef Lrename
integer rename_ (const char *path1, const char *path2, const ftnlen Lpath1, const ftnlen Lpath2) {
extern integer G77_rename_0 (const char *path1, const char *path2, const ftnlen Lpath1, const ftnlen Lpath2);
return G77_rename_0 (path1, path2, Lpath1, Lpath2);
}
#endif
#ifdef Lsecnds
double secnds_ (real *r) {
extern double G77_secnds_0 (real *r);
return G77_secnds_0 (r);
}
#endif
#ifdef Lsecond
double second_ () {
extern double G77_second_0 ();
return G77_second_0 ();
}
#endif
#ifdef Lsleep
int sleep_ (const integer *seconds) {
extern int G77_sleep_0 (const integer *seconds);
return G77_sleep_0 (seconds);
}
#endif
#ifdef Lsrand
int srand_ (const integer *seed) {
extern int G77_srand_0 (const integer *seed);
return G77_srand_0 (seed);
}
#endif
#ifdef Lstat
integer stat_ (const char *name, integer statb[13], const ftnlen Lname) {
extern integer G77_stat_0 (const char *name, integer statb[13], const ftnlen Lname);
return G77_stat_0 (name, statb, Lname);
}
#endif
#ifdef Lsymlnk
integer symlnk_ (const char *path1, const char *path2, const ftnlen Lpath1, const ftnlen Lpath2) {
extern integer G77_symlnk_0 (const char *path1, const char *path2, const ftnlen Lpath1, const ftnlen Lpath2);
return G77_symlnk_0 (path1, path2, Lpath1, Lpath2);
}
#endif
#ifdef Lsclock
int system_clock_ (integer *count, integer *count_rate, integer *count_max) {
extern int G77_system_clock_0 (integer *count, integer *count_rate, integer *count_max);
return G77_system_clock_0 (count, count_rate, count_max);
}
#endif
#ifdef Ltime
longint time_ (void) {
extern longint G77_time_0 (void);
return G77_time_0 ();
}
#endif
#ifdef Lttynam
void ttynam_ (char *ret_val, ftnlen ret_val_len, integer *lunit) {
extern void G77_ttynam_0 (char *ret_val, ftnlen ret_val_len, integer *lunit);
G77_ttynam_0 (ret_val, ret_val_len, lunit);
}
#endif
#ifdef Lumask
integer umask_ (integer *mask) {
extern integer G77_umask_0 (integer *mask);
return G77_umask_0 (mask);
}
#endif
#ifdef Lunlink
integer unlink_ (const char *str, const ftnlen Lstr) {
extern integer G77_unlink_0 (const char *str, const ftnlen Lstr);
return G77_unlink_0 (str, Lstr);
}
#endif
#ifdef Lvxtidt
int vxtidate_ (integer *m, integer *d, integer *y) {
extern int G77_vxtidate_0 (integer *m, integer *d, integer *y);
return G77_vxtidate_0 (m, d, y);
}
#endif
#ifdef Lvxttim
void vxttime_ (char chtime[8], const ftnlen Lchtime) {
extern void G77_vxttime_0 (char chtime[8], const ftnlen Lchtime);
G77_vxttime_0 (chtime, Lchtime);
}
#endif
#include "f2c.h"
#undef abs
#undef min
#undef max
#include <stdio.h>
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>
extern void G77_exit_0 (integer*);
char *
F77_aloc(integer Len, char *whence)
#endif
{
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;
}
# Makefile for GNU F77 compiler runtime.
# Copyright 1990 - 1994 by AT&T Bell Laboratories and Bellcore (see the
# file `Notice').
# Portions of this file Copyright (C) 1995, 1996 Free Software Foundation, Inc.
# Contributed by Dave Love (d.love@dl.ac.uk).
#
#This file is part of GNU Fortran.
#
#GNU Fortran is free software; you can redistribute it and/or modify
#it under the terms of the GNU General Public License as published by
#the Free Software Foundation; either version 2, or (at your option)
#any later version.
#
#GNU Fortran is distributed in the hope that it will be useful,
#but WITHOUT ANY WARRANTY; without even the implied warranty of
#MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
#GNU General Public License for more details.
#
#You should have received a copy of the GNU General Public License
#along with GNU Fortran; see the file COPYING. If not, write to
#the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
#02111-1307, USA.
SHELL = /bin/sh
srcdir = @srcdir@
VPATH = @srcdir@
#### Start of system configuration section. ####
# The _FOR_TARGET things are appropriate for a cross-make, passed by the
# superior makefile
GCC_FOR_TARGET = @CC@
CC = $(GCC_FOR_TARGET)
CFLAGS = @CFLAGS@ $(GCC_FLAGS)
CPPFLAGS = @CPPFLAGS@
DEFS = @DEFS@
CGFLAGS = #-g0
# f2c.h should already be installed in xgcc's include directory but add that
# to -I anyhow in case not using xgcc.
ALL_CFLAGS = -I. -I$(srcdir) -I../../../include $(CPPFLAGS) $(DEFS) $(CFLAGS)
AR = @AR@
AR_FLAGS = rc
RANLIB = @RANLIB@
RANLIB_TEST = @RANLIB_TEST@
CROSS = @CROSS@
.SUFFIXES:
.SUFFIXES: .c .o
.c.o:
$(CC) -c -DSkip_f2c_Undefs $(ALL_CFLAGS) $(CGFLAGS) $<
MISC = F77_aloc.o VersionF.o main.o s_rnge.o abort_.o getarg_.o iargc_.o\
getenv_.o signal_.o s_stop.o s_paus.o system_.o cabs.o\
derf_.o derfc_.o erf_.o erfc_.o sig_die.o exit_.o
POW = pow_ci.o pow_dd.o pow_di.o pow_hh.o pow_ii.o pow_ri.o pow_zi.o pow_zz.o \
pow_qq.o
CX = c_abs.o c_cos.o c_div.o c_exp.o c_log.o c_sin.o c_sqrt.o
DCX = z_abs.o z_cos.o z_div.o z_exp.o z_log.o z_sin.o z_sqrt.o
REAL = r_abs.o r_acos.o r_asin.o r_atan.o r_atn2.o r_cnjg.o r_cos.o\
r_cosh.o r_dim.o r_exp.o r_imag.o r_int.o\
r_lg10.o r_log.o r_mod.o r_nint.o r_sign.o\
r_sin.o r_sinh.o r_sqrt.o r_tan.o r_tanh.o
DBL = d_abs.o d_acos.o d_asin.o d_atan.o d_atn2.o\
d_cnjg.o d_cos.o d_cosh.o d_dim.o d_exp.o\
d_imag.o d_int.o d_lg10.o d_log.o d_mod.o\
d_nint.o d_prod.o d_sign.o d_sin.o d_sinh.o\
d_sqrt.o d_tan.o d_tanh.o
INT = i_abs.o i_dim.o i_dnnt.o i_indx.o i_len.o i_mod.o i_nint.o i_sign.o
HALF = h_abs.o h_dim.o h_dnnt.o h_indx.o h_len.o h_mod.o h_nint.o h_sign.o
CMP = l_ge.o l_gt.o l_le.o l_lt.o hl_ge.o hl_gt.o hl_le.o hl_lt.o
EFL = ef1asc_.o ef1cmc_.o
CHAR = s_cat.o s_cmp.o s_copy.o
F90BIT = lbitbits.o lbitshft.o qbitbits.o qbitshft.o
F2C_H = ../../../include/f2c.h
all: $(MISC) $(POW) $(CX) $(DCX) $(REAL) $(DBL) $(INT) \
$(HALF) $(CMP) $(EFL) $(CHAR) $(F90BIT)
VersionF.o: Version.c
$(CC) -c $(CGFLAGS) -o $@ $(srcdir)/Version.c
mostlyclean clean:
-rm -f *.o
distclean maintainer-clean: clean
-rm -f stage? include Makefile
# Not quite all these actually do depend on f2c.h...
$(MISC) $(POW) $(CX) $(DCX) $(REAL) $(DBL) $(INT) \
$(HALF) $(CMP) $(EFL) $(CHAR) $(F90BIT): $(F2C_H)
.PHONY: mostlyclean clean distclean maintainer-clean all
/****************************************************************
Copyright 1990 - 1997 by AT&T, Lucent Technologies and Bellcore.
Permission to use, copy, modify, and distribute this software
and its documentation for any purpose and without fee is hereby
granted, provided that the above copyright notice appear in all
copies and that both that the copyright notice and this
permission notice and warranty disclaimer appear in supporting
documentation, and that the names of AT&T, Bell Laboratories,
Lucent or Bellcore or any of their entities not be used in
advertising or publicity pertaining to distribution of the
software without specific, written prior permission.
AT&T, Lucent and Bellcore disclaim all warranties with regard to
this software, including all implied warranties of
merchantability and fitness. In no event shall AT&T, Lucent or
Bellcore be liable for any special, indirect or consequential
damages or any damages whatsoever resulting from loss of use,
data or profits, whether in an action of contract, negligence or
other tortious action, arising out of or in connection with the
use or performance of this software.
****************************************************************/
If your compiler does not recognize ANSI C headers,
compile with KR_headers defined: either add -DKR_headers
to the definition of CFLAGS in the makefile, or insert
#define KR_headers
at the top of f2c.h , cabs.c , main.c , and sig_die.c .
Under MS-DOS, compile s_paus.c with -DMSDOS.
If you have a really ancient K&R C compiler that does not understand
void, add -Dvoid=int to the definition of CFLAGS in the makefile.
If you use a C++ compiler, first create a local f2c.h by appending
f2ch.add to the usual f2c.h, e.g., by issuing the command
make f2c.h
which assumes f2c.h is installed in /usr/include .
If your system lacks onexit() and you are not using an ANSI C
compiler, then you should compile main.c, s_paus.c, s_stop.c, and
sig_die.c with NO_ONEXIT defined. See the comments about onexit in
the makefile.
If your system has a double drem() function such that drem(a,b)
is the IEEE remainder function (with double a, b), then you may
wish to compile r_mod.c and d_mod.c with IEEE_drem defined.
On some systems, you may also need to compile with -Ddrem=remainder .
To check for transmission errors, issue the command
make check
This assumes you have the xsum program whose source, xsum.c,
is distributed as part of "all from f2c/src". If you do not
have xsum, you can obtain xsum.c by sending the following E-mail
message to netlib@netlib.bell-labs.com
send xsum.c from f2c/src
The makefile assumes you have installed f2c.h in a standard
place (and does not cause recompilation when f2c.h is changed);
f2c.h comes with "all from f2c" (the source for f2c) and is
available separately ("f2c.h from f2c").
Most of the routines in libF77 are support routines for Fortran
intrinsic functions or for operations that f2c chooses not
to do "in line". There are a few exceptions, summarized below --
functions and subroutines that appear to your program as ordinary
external Fortran routines.
1. CALL ABORT prints a message and causes a core dump.
2. ERF(r) and DERF(d) and the REAL and DOUBLE PRECISION
error functions (with x REAL and d DOUBLE PRECISION);
DERF must be declared DOUBLE PRECISION in your program.
Both ERF and DERF assume your C library provides the
underlying erf() function (which not all systems do).
3. ERFC(r) and DERFC(d) are the complementary error functions:
ERFC(r) = 1 - ERF(r) and DERFC(d) = 1.d0 - DERFC(d)
(except that their results may be more accurate than
explicitly evaluating the above formulae would give).
Again, ERFC and r are REAL, and DERFC and d are DOUBLE
PRECISION (and must be declared as such in your program),
and ERFC and DERFC rely on your system's erfc().
4. CALL GETARG(n,s), where n is an INTEGER and s is a CHARACTER
variable, sets s to the n-th command-line argument (or to
all blanks if there are fewer than n command-line arguments);
CALL GETARG(0,s) sets s to the name of the program (on systems
that support this feature). See IARGC below.
5. CALL GETENV(name, value), where name and value are of type
CHARACTER, sets value to the environment value, $name, of
name (or to blanks if $name has not been set).
6. NARGS = IARGC() sets NARGS to the number of command-line
arguments (an INTEGER value).
7. CALL SIGNAL(n,func), where n is an INTEGER and func is an
EXTERNAL procedure, arranges for func to be invoked when
signal n occurs (on systems where this makes sense).
8. CALL SYSTEM(cmd), where cmd is of type CHARACTER, passes
cmd to the system's command processor (on systems where
this can be done).
The makefile does not attempt to compile pow_qq.c, qbitbits.c,
and qbitshft.c, which are meant for use with INTEGER*8. To use
INTEGER*8, you must modify f2c.h to declare longint and ulongint
appropriately; then add pow_qq.o to the POW = line in the makefile,
and add " qbitbits.o qbitshft.o" to the makefile's F90BIT = line.
Following Fortran 90, s_cat.c and s_copy.c allow the target of a
(character string) assignment to be appear on its right-hand, at
the cost of some extra overhead for all run-time concatenations.
If you prefer the extra efficiency that comes with the Fortran 77
requirement that the left-hand side of a character assignment not
be involved in the right-hand side, compile s_cat.c and s_copy.c
with -DNO_OVERWRITE .
If your system lacks a ranlib command, you don't need it.
Either comment out the makefile's ranlib invocation, or install
a harmless "ranlib" command somewhere in your PATH, such as the
one-line shell script
exit 0
or (on some systems)
exec /usr/bin/ar lts $1 >/dev/null
static char junk[] = "\n@(#)LIBF77 VERSION 19970919\n";
/*
*/
char __G77_LIBF77_VERSION__[] = "0.5.21";
/*
2.00 11 June 1980. File version.c added to library.
2.01 31 May 1988. s_paus() flushes stderr; names of hl_* fixed
[ d]erf[c ] added
8 Aug. 1989: #ifdefs for f2c -i2 added to s_cat.c
29 Nov. 1989: s_cmp returns long (for f2c)
30 Nov. 1989: arg types from f2c.h
12 Dec. 1989: s_rnge allows long names
19 Dec. 1989: getenv_ allows unsorted environment
28 Mar. 1990: add exit(0) to end of main()
2 Oct. 1990: test signal(...) == SIG_IGN rather than & 01 in main
17 Oct. 1990: abort() calls changed to sig_die(...,1)
22 Oct. 1990: separate sig_die from main
25 Apr. 1991: minor, theoretically invisible tweaks to s_cat, sig_die
31 May 1991: make system_ return status
18 Dec. 1991: change long to ftnlen (for -i2) many places
28 Feb. 1992: repair z_sqrt.c (scribbled on input, gave wrong answer)
18 July 1992: for n < 0, repair handling of 0**n in pow_[dr]i.c
and m**n in pow_hh.c and pow_ii.c;
catch SIGTRAP in main() for error msg before abort
23 July 1992: switch to ANSI prototypes unless KR_headers is #defined
23 Oct. 1992: fix botch in signal_.c (erroneous deref of 2nd arg);
change Cabs to f__cabs.
12 March 1993: various tweaks for C++
2 June 1994: adjust so abnormal terminations invoke f_exit just once
16 Sept. 1994: s_cmp: treat characters as unsigned in comparisons.
19 Sept. 1994: s_paus: flush after end of PAUSE; add -DMSDOS
12 Jan. 1995: pow_[dhiqrz][hiq]: adjust x**i to work on machines
that sign-extend right shifts when i is the most
negative integer.
26 Jan. 1995: adjust s_cat.c, s_copy.c to permit the left-hand side
of character assignments to appear on the right-hand
side (unless compiled with -DNO_OVERWRITE).
27 Jan. 1995: minor tweak to s_copy.c: copy forward whenever
possible (for better cache behavior).
30 May 1995: added subroutine exit(rc) integer rc. Version not changed.
29 Aug. 1995: add F77_aloc.c; use it in s_cat.c and system_.c.
6 Sept. 1995: fix return type of system_ under -DKR_headers.
19 Dec. 1995: s_cat.c: fix bug when 2nd or later arg overlaps lhs.
19 Mar. 1996: s_cat.c: supply missing break after overlap detection.
13 May 1996: add [lq]bitbits.c and [lq]bitshft.c (f90 bit intrinsics).
19 June 1996: add casts to unsigned in [lq]bitshft.c.
26 Feb. 1997: adjust functions with a complex output argument
to permit aliasing it with input arguments.
(For now, at least, this is just for possible
benefit of g77.)
4 April 1997: [cz]_div.c: tweaks invisible on most systems (that may
affect systems using gratuitous extra precision).
19 Sept. 1997: [de]time_.c (Unix systems only): change return
type to double.
*/
#include <stdio.h>
void
g77__fvers__ ()
{
fprintf (stderr, "__G77_LIBF77_VERSION__: %s", __G77_LIBF77_VERSION__);
fputs (junk, stderr);
}
#include <stdio.h>
#include "f2c.h"
#ifdef KR_headers
extern VOID sig_die();
int G77_abort_0 ()
#else
extern void sig_die(char*,int);
int G77_abort_0 (void)
#endif
{
sig_die("Fortran abort routine called", 1);
#ifdef __cplusplus
return 0;
#endif
}
#include "f2c.h"
#ifdef KR_headers
extern double f__cabs();
double c_abs(z) complex *z;
#else
extern double f__cabs(double, double);
double c_abs(complex *z)
#endif
{
return( f__cabs( z->r, z->i ) );
}
#include "f2c.h"
#ifdef KR_headers
extern double sin(), cos(), sinh(), cosh();
VOID c_cos(resx, z) complex *resx, *z;
#else
#undef abs
#include <math.h>
void c_cos(complex *resx, complex *z)
#endif
{
complex res;
res.r = cos(z->r) * cosh(z->i);
res.i = - sin(z->r) * sinh(z->i);
resx->r = res.r;
resx->i = res.i;
}
#include "f2c.h"
#ifdef KR_headers
extern VOID sig_die();
VOID c_div(resx, a, b)
complex *a, *b, *resx;
#else
extern void sig_die(char*,int);
void c_div(complex *resx, complex *a, complex *b)
#endif
{
double ratio, den;
double abr, abi;
complex res;
if( (abr = b->r) < 0.)
abr = - abr;
if( (abi = b->i) < 0.)
abi = - abi;
if( abr <= abi )
{
if(abi == 0)
sig_die("complex division by zero", 1);
ratio = (double)b->r / b->i ;
den = b->i * (1 + ratio*ratio);
res.r = (a->r*ratio + a->i) / den;
res.i = (a->i*ratio - a->r) / den;
}
else
{
ratio = (double)b->i / b->r ;
den = b->r * (1 + ratio*ratio);
res.r = (a->r + a->i*ratio) / den;
res.i = (a->i - a->r*ratio) / den;
}
resx->r = res.r;
resx->i = res.i;
}
#include "f2c.h"
#ifdef KR_headers
extern double exp(), cos(), sin();
VOID c_exp(resx, z) complex *resx, *z;
#else
#undef abs
#include <math.h>
void c_exp(complex *resx, complex *z)
#endif
{
double expx;
complex res;
expx = exp(z->r);
res.r = expx * cos(z->i);
res.i = expx * sin(z->i);
resx->r = res.r;
resx->i = res.i;
}
#include "f2c.h"
#ifdef KR_headers
extern double log(), f__cabs(), atan2();
VOID c_log(resx, z) complex *resx, *z;
#else
#undef abs
#include <math.h>
extern double f__cabs(double, double);
void c_log(complex *resx, complex *z)
#endif
{
complex res;
res.i = atan2(z->i, z->r);
res.r = log( f__cabs(z->r, z->i) );
resx->r = res.r;
resx->i = res.i;
}
#include "f2c.h"
#ifdef KR_headers
extern double sin(), cos(), sinh(), cosh();
VOID c_sin(resx, z) complex *resx, *z;
#else
#undef abs
#include <math.h>
void c_sin(complex *resx, complex *z)
#endif
{
complex res;
res.r = sin(z->r) * cosh(z->i);
res.i = cos(z->r) * sinh(z->i);
resx->r = res.r;
resx->i = res.i;
}
#include "f2c.h"
#ifdef KR_headers
extern double sqrt(), f__cabs();
VOID c_sqrt(resx, z) complex *resx, *z;
#else
#undef abs
#include <math.h>
extern double f__cabs(double, double);
void c_sqrt(complex *resx, complex *z)
#endif
{
double mag, t;
complex res;
if( (mag = f__cabs(z->r, z->i)) == 0.)
res.r = res.i = 0.;
else if(z->r > 0)
{
res.r = t = sqrt(0.5 * (mag + z->r) );
t = z->i / t;
res.i = 0.5 * t;
}
else
{
t = sqrt(0.5 * (mag - z->r) );
if(z->i < 0)
t = -t;
res.i = t;
t = z->i / t;
res.r = 0.5 * t;
}
resx->r = res.r;
resx->i = res.i;
}
#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 temp;
if(real < 0)
real = -real;
if(imag < 0)
imag = -imag;
if(imag > real){
temp = real;
real = imag;
imag = temp;
}
if((real+imag) == real)
return(real);
temp = imag/real;
temp = real*sqrt(1.0 + temp*temp); /*overflow!!*/
return(temp);
}
#include "f2c.h"
#ifdef KR_headers
double d_abs(x) doublereal *x;
#else
double d_abs(doublereal *x)
#endif
{
if(*x >= 0)
return(*x);
return(- *x);
}
#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
{
return( acos(*x) );
}
#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
{
return( asin(*x) );
}
#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
{
return( atan(*x) );
}
#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
{
return( atan2(*x,*y) );
}
#include "f2c.h"
VOID
#ifdef KR_headers
d_cnjg(resx, z) doublecomplex *resx, *z;
#else
d_cnjg(doublecomplex *resx, doublecomplex *z)
#endif
{
doublecomplex res;
res.r = z->r;
res.i = - z->i;
resx->r = res.r;
resx->i = res.i;
}
#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
{
return( cos(*x) );
}
#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
{
return( cosh(*x) );
}
#include "f2c.h"
#ifdef KR_headers
double d_dim(a,b) doublereal *a, *b;
#else
double d_dim(doublereal *a, doublereal *b)
#endif
{
return( *a > *b ? *a - *b : 0);
}
#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
{
return( exp(*x) );
}
#include "f2c.h"
#ifdef KR_headers
double d_imag(z) doublecomplex *z;
#else
double d_imag(doublecomplex *z)
#endif
{
return(z->i);
}
#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
{
return( (*x>0) ? floor(*x) : -floor(- *x) );
}
#include "f2c.h"
#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
{
return( log10e * log(*x) );
}
#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
{
return( log(*x) );
}
#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);
#else
#undef abs
#include <math.h>
#endif
double d_mod(doublereal *x, doublereal *y)
#endif
{
#ifdef IEEE_drem
double xa, ya, z;
if ((ya = *y) < 0.)
ya = -ya;
z = drem(xa = *x, ya);
if (xa > 0) {
if (z < 0)
z += ya;
}
else if (z > 0)
z -= ya;
return z;
#else
double quotient;
if( (quotient = *x / *y) >= 0)
quotient = floor(quotient);
else
quotient = -floor(-quotient);
return(*x - (*y) * quotient );
#endif
}
#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
{
return( (*x)>=0 ?
floor(*x + .5) : -floor(.5 - *x) );
}
#include "f2c.h"
#ifdef KR_headers
double d_prod(x,y) real *x, *y;
#else
double d_prod(real *x, real *y)
#endif
{
return( (*x) * (*y) );
}
#include "f2c.h"
#ifdef KR_headers
double d_sign(a,b) doublereal *a, *b;
#else
double d_sign(doublereal *a, doublereal *b)
#endif
{
double x;
x = (*a >= 0 ? *a : - *a);
return( *b >= 0 ? x : -x);
}
#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
{
return( sin(*x) );
}
#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
{
return( sinh(*x) );
}
#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
{
return( sqrt(*x) );
}
#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
{
return( tan(*x) );
}
#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
{
return( tanh(*x) );
}
#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
{
return( erf(*x) );
}
#include "f2c.h"
#ifdef KR_headers
extern double erfc();
double G77_derfc_0 (x) doublereal *x;
#else
extern double erfc(double);
double G77_derfc_0 (doublereal *x)
#endif
{
return( erfc(*x) );
}
#include "time.h"
#ifndef USE_CLOCK
#include "sys/types.h"
#include "sys/times.h"
#endif
#undef Hz
#ifdef CLK_TCK
#define Hz CLK_TCK
#else
#ifdef HZ
#define Hz HZ
#else
#define Hz 60
#endif
#endif
double
#ifdef KR_headers
dtime_(tarray) float *tarray;
#else
dtime_(float *tarray)
#endif
{
#ifdef USE_CLOCK
#ifndef CLOCKS_PER_SECOND
#define CLOCKS_PER_SECOND Hz
#endif
static double t0;
double t = clock();
tarray[1] = 0;
tarray[0] = (t - t0) / CLOCKS_PER_SECOND;
t0 = t;
return tarray[0];
#else
struct tms t;
static struct tms t0;
times(&t);
tarray[0] = (t.tms_utime - t0.tms_utime) / Hz;
tarray[1] = (t.tms_stime - t0.tms_stime) / Hz;
t0 = t;
return tarray[0] + tarray[1];
#endif
}
/* EFL support routine to copy string b to string a */
#include "f2c.h"
#define M ( (long) (sizeof(long) - 1) )
#define EVEN(x) ( ( (x)+ M) & (~M) )
#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
{
s_copy( (char *)a, (char *)b, EVEN(*la), *lb );
#ifdef __cplusplus
return 0;
#endif
}
/* EFL support routine to compare two character strings */
#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
{
return( s_cmp( (char *)a, (char *)b, *la, *lb) );
}
#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
{
return( erf(*x) );
}
#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
{
return( erfc(*x) );
}
#include "time.h"
#ifndef USE_CLOCK
#include "sys/types.h"
#include "sys/times.h"
#endif
#undef Hz
#ifdef CLK_TCK
#define Hz CLK_TCK
#else
#ifdef HZ
#define Hz HZ
#else
#define Hz 60
#endif
#endif
double
#ifdef KR_headers
etime_(tarray) float *tarray;
#else
etime_(float *tarray)
#endif
{
#ifdef USE_CLOCK
#ifndef CLOCKS_PER_SECOND
#define CLOCKS_PER_SECOND Hz
#endif
double t = clock();
tarray[1] = 0;
return tarray[0] = t / CLOCKS_PER_SECOND;
#else
struct tms t;
times(&t);
return (tarray[0] = t.tms_utime/Hz) + (tarray[1] = t.tms_stime/Hz);
#endif
}
/* This gives the effect of
subroutine exit(rc)
integer*4 rc
stop
end
* with the added side effect of supplying rc as the program's exit code.
*/
#include "f2c.h"
#undef abs
#undef min
#undef max
#ifndef KR_headers
#include <stdlib.h>
#ifdef __cplusplus
extern "C" {
#endif
extern void f_exit(void);
#endif
void
#ifdef KR_headers
G77_exit_0 (rc) integer *rc;
#else
G77_exit_0 (integer *rc)
#endif
{
#ifdef NO_ONEXIT
f_exit();
#endif
exit(*rc);
}
#ifdef __cplusplus
}
#endif
/* If you are using a C++ compiler, append the following to f2c.h
for compiling libF77 and libI77. */
#ifdef __cplusplus
extern "C" {
extern int abort_(void);
extern double c_abs(complex *);
extern void c_cos(complex *, complex *);
extern void c_div(complex *, complex *, complex *);
extern void c_exp(complex *, complex *);
extern void c_log(complex *, complex *);
extern void c_sin(complex *, complex *);
extern void c_sqrt(complex *, complex *);
extern double d_abs(double *);
extern double d_acos(double *);
extern double d_asin(double *);
extern double d_atan(double *);
extern double d_atn2(double *, double *);
extern void d_cnjg(doublecomplex *, doublecomplex *);
extern double d_cos(double *);
extern double d_cosh(double *);
extern double d_dim(double *, double *);
extern double d_exp(double *);
extern double d_imag(doublecomplex *);
extern double d_int(double *);
extern double d_lg10(double *);
extern double d_log(double *);
extern double d_mod(double *, double *);
extern double d_nint(double *);
extern double d_prod(float *, float *);
extern double d_sign(double *, double *);
extern double d_sin(double *);
extern double d_sinh(double *);
extern double d_sqrt(double *);
extern double d_tan(double *);
extern double d_tanh(double *);
extern double derf_(double *);
extern double derfc_(double *);
extern integer do_fio(ftnint *, char *, ftnlen);
extern integer do_lio(ftnint *, ftnint *, char *, ftnlen);
extern integer do_uio(ftnint *, char *, ftnlen);
extern integer e_rdfe(void);
extern integer e_rdue(void);
extern integer e_rsfe(void);
extern integer e_rsfi(void);
extern integer e_rsle(void);
extern integer e_rsli(void);
extern integer e_rsue(void);
extern integer e_wdfe(void);
extern integer e_wdue(void);
extern integer e_wsfe(void);
extern integer e_wsfi(void);
extern integer e_wsle(void);
extern integer e_wsli(void);
extern integer e_wsue(void);
extern int ef1asc_(ftnint *, ftnlen *, ftnint *, ftnlen *);
extern integer ef1cmc_(ftnint *, ftnlen *, ftnint *, ftnlen *);
extern double erf(double);
extern double erf_(float *);
extern double erfc(double);
extern double erfc_(float *);
extern integer f_back(alist *);
extern integer f_clos(cllist *);
extern integer f_end(alist *);
extern void f_exit(void);
extern integer f_inqu(inlist *);
extern integer f_open(olist *);
extern integer f_rew(alist *);
extern int flush_(void);
extern void getarg_(integer *, char *, ftnlen);
extern void getenv_(char *, char *, ftnlen, ftnlen);
extern short h_abs(short *);
extern short h_dim(short *, short *);
extern short h_dnnt(double *);
extern short h_indx(char *, char *, ftnlen, ftnlen);
extern short h_len(char *, ftnlen);
extern short h_mod(short *, short *);
extern short h_nint(float *);
extern short h_sign(short *, short *);
extern short hl_ge(char *, char *, ftnlen, ftnlen);
extern short hl_gt(char *, char *, ftnlen, ftnlen);
extern short hl_le(char *, char *, ftnlen, ftnlen);
extern short hl_lt(char *, char *, ftnlen, ftnlen);
extern integer i_abs(integer *);
extern integer i_dim(integer *, integer *);
extern integer i_dnnt(double *);
extern integer i_indx(char *, char *, ftnlen, ftnlen);
extern integer i_len(char *, ftnlen);
extern integer i_mod(integer *, integer *);
extern integer i_nint(float *);
extern integer i_sign(integer *, integer *);
extern integer iargc_(void);
extern ftnlen l_ge(char *, char *, ftnlen, ftnlen);
extern ftnlen l_gt(char *, char *, ftnlen, ftnlen);
extern ftnlen l_le(char *, char *, ftnlen, ftnlen);
extern ftnlen l_lt(char *, char *, ftnlen, ftnlen);
extern void pow_ci(complex *, complex *, integer *);
extern double pow_dd(double *, double *);
extern double pow_di(double *, integer *);
extern short pow_hh(short *, shortint *);
extern integer pow_ii(integer *, integer *);
extern double pow_ri(float *, integer *);
extern void pow_zi(doublecomplex *, doublecomplex *, integer *);
extern void pow_zz(doublecomplex *, doublecomplex *, doublecomplex *);
extern double r_abs(float *);
extern double r_acos(float *);
extern double r_asin(float *);
extern double r_atan(float *);
extern double r_atn2(float *, float *);
extern void r_cnjg(complex *, complex *);
extern double r_cos(float *);
extern double r_cosh(float *);
extern double r_dim(float *, float *);
extern double r_exp(float *);
extern double r_imag(complex *);
extern double r_int(float *);
extern double r_lg10(float *);
extern double r_log(float *);
extern double r_mod(float *, float *);
extern double r_nint(float *);
extern double r_sign(float *, float *);
extern double r_sin(float *);
extern double r_sinh(float *);
extern double r_sqrt(float *);
extern double r_tan(float *);
extern double r_tanh(float *);
extern void s_cat(char *, char **, integer *, integer *, ftnlen);
extern integer s_cmp(char *, char *, ftnlen, ftnlen);
extern void s_copy(char *, char *, ftnlen, ftnlen);
extern int s_paus(char *, ftnlen);
extern integer s_rdfe(cilist *);
extern integer s_rdue(cilist *);
extern integer s_rnge(char *, integer, char *, integer);
extern integer s_rsfe(cilist *);
extern integer s_rsfi(icilist *);
extern integer s_rsle(cilist *);
extern integer s_rsli(icilist *);
extern integer s_rsne(cilist *);
extern integer s_rsni(icilist *);
extern integer s_rsue(cilist *);
extern int s_stop(char *, ftnlen);
extern integer s_wdfe(cilist *);
extern integer s_wdue(cilist *);
extern integer s_wsfe(cilist *);
extern integer s_wsfi(icilist *);
extern integer s_wsle(cilist *);
extern integer s_wsli(icilist *);
extern integer s_wsne(cilist *);
extern integer s_wsni(icilist *);
extern integer s_wsue(cilist *);
extern void sig_die(char *, int);
extern integer signal_(integer *, void (*)(int));
extern integer system_(char *, ftnlen);
extern double z_abs(doublecomplex *);
extern void z_cos(doublecomplex *, doublecomplex *);
extern void z_div(doublecomplex *, doublecomplex *, doublecomplex *);
extern void z_exp(doublecomplex *, doublecomplex *);
extern void z_log(doublecomplex *, doublecomplex *);
extern void z_sin(doublecomplex *, doublecomplex *);
extern void z_sqrt(doublecomplex *, doublecomplex *);
}
#endif
#include "f2c.h"
/*
* subroutine getarg(k, c)
* returns the kth unix command argument in fortran character
* 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
{
extern int xargc;
extern char **xargv;
register char *t;
register int i;
if(*n>=0 && *n<xargc)
t = xargv[*n];
else
t = "";
for(i = 0; i<ls && *t!='\0' ; ++i)
*s++ = *t++;
for( ; i<ls ; ++i)
*s++ = ' ';
}
#include "f2c.h"
/*
* getenv - f77 subroutine to return environment variables
*
* called by:
* call getenv (ENV_NAME, char_var)
* where:
* ENV_NAME is the name of an environment variable
* char_var is a character variable which will receive
* the current value of ENV_NAME, or all blanks
* if ENV_NAME is not defined
*/
#ifdef KR_headers
VOID G77_getenv_0 (fname, value, flen, vlen) char *value, *fname; ftnlen vlen, flen;
#else
void G77_getenv_0 (char *fname, char *value, ftnlen flen, ftnlen vlen)
#endif
{
extern char **environ;
register char *ep, *fp, *flast;
register char **env = environ;
flast = fname + flen;
for(fp = fname ; fp < flast ; ++fp)
if(*fp == ' ')
{
flast = fp;
break;
}
while (ep = *env++)
{
for(fp = fname; fp<flast ; )
if(*fp++ != *ep++)
goto endloop;
if(*ep++ == '=') { /* copy right hand side */
while( *ep && --vlen>=0 )
*value++ = *ep++;
goto blank;
}
endloop: ;
}
blank:
while( --vlen >= 0 )
*value++ = ' ';
}
#include "f2c.h"
#ifdef KR_headers
shortint h_abs(x) shortint *x;
#else
shortint h_abs(shortint *x)
#endif
{
if(*x >= 0)
return(*x);
return(- *x);
}
#include "f2c.h"
#ifdef KR_headers
shortint h_dim(a,b) shortint *a, *b;
#else
shortint h_dim(shortint *a, shortint *b)
#endif
{
return( *a > *b ? *a - *b : 0);
}
#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
{
return( (*x)>=0 ?
floor(*x + .5) : -floor(.5 - *x) );
}
#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
{
ftnlen i, n;
char *s, *t, *bend;
n = la - lb + 1;
bend = b + lb;
for(i = 0 ; i < n ; ++i)
{
s = a + i;
t = b;
while(t < bend)
if(*s++ != *t++)
goto no;
return((shortint)i+1);
no: ;
}
return(0);
}
#include "f2c.h"
#ifdef KR_headers
shortint h_len(s, n) char *s; ftnlen n;
#else
shortint h_len(char *s, ftnlen n)
#endif
{
return(n);
}
#include "f2c.h"
#ifdef KR_headers
shortint h_mod(a,b) short *a, *b;
#else
shortint h_mod(short *a, short *b)
#endif
{
return( *a % *b);
}
#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
{
return( (*x)>=0 ?
floor(*x + .5) : -floor(.5 - *x) );
}
#include "f2c.h"
#ifdef KR_headers
shortint h_sign(a,b) shortint *a, *b;
#else
shortint h_sign(shortint *a, shortint *b)
#endif
{
shortint x;
x = (*a >= 0 ? *a : - *a);
return( *b >= 0 ? x : -x);
}
#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
{
return(s_cmp(a,b,la,lb) >= 0);
}
#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
{
return(s_cmp(a,b,la,lb) > 0);
}
#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
{
return(s_cmp(a,b,la,lb) <= 0);
}
#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
{
return(s_cmp(a,b,la,lb) < 0);
}
#include "f2c.h"
#ifdef KR_headers
integer i_abs(x) integer *x;
#else
integer i_abs(integer *x)
#endif
{
if(*x >= 0)
return(*x);
return(- *x);
}
#include "f2c.h"
#ifdef KR_headers
integer i_dim(a,b) integer *a, *b;
#else
integer i_dim(integer *a, integer *b)
#endif
{
return( *a > *b ? *a - *b : 0);
}
#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
{
return( (*x)>=0 ?
floor(*x + .5) : -floor(.5 - *x) );
}
#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
{
ftnlen i, n;
char *s, *t, *bend;
n = la - lb + 1;
bend = b + lb;
for(i = 0 ; i < n ; ++i)
{
s = a + i;
t = b;
while(t < bend)
if(*s++ != *t++)
goto no;
return(i+1);
no: ;
}
return(0);
}
#include "f2c.h"
#ifdef KR_headers
integer i_len(s, n) char *s; ftnlen n;
#else
integer i_len(char *s, ftnlen n)
#endif
{
return(n);
}
#include "f2c.h"
#ifdef KR_headers
integer i_mod(a,b) integer *a, *b;
#else
integer i_mod(integer *a, integer *b)
#endif
{
return( *a % *b);
}
#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
{
return( (*x)>=0 ?
floor(*x + .5) : -floor(.5 - *x) );
}
#include "f2c.h"
#ifdef KR_headers
integer i_sign(a,b) integer *a, *b;
#else
integer i_sign(integer *a, integer *b)
#endif
{
integer x;
x = (*a >= 0 ? *a : - *a);
return( *b >= 0 ? x : -x);
}
#include "f2c.h"
#ifdef KR_headers
ftnint G77_iargc_0 ()
#else
ftnint G77_iargc_0 (void)
#endif
{
extern int xargc;
return ( xargc - 1 );
}
#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
{
return(s_cmp(a,b,la,lb) >= 0);
}
#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
{
return(s_cmp(a,b,la,lb) > 0);
}
#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
{
return(s_cmp(a,b,la,lb) <= 0);
}
#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
{
return(s_cmp(a,b,la,lb) < 0);
}
#include "f2c.h"
#ifndef LONGBITS
#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
{
/* Assume 2's complement arithmetic */
unsigned long x, y;
x = (unsigned long) a;
y = (unsigned long)-1L;
x >>= b;
y <<= len;
return (integer)(x & ~y);
}
integer
#ifdef KR_headers
lbit_cshift(a, b, len) integer a, b, len;
#else
lbit_cshift(integer a, integer b, integer len)
#endif
{
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));
}
#include "f2c.h"
integer
#ifdef KR_headers
lbit_shift(a, b) integer a; integer b;
#else
lbit_shift(integer a, integer b)
#endif
{
return b >= 0 ? a << b : (integer)((uinteger)a >> -b);
}
/* STARTUP PROCEDURE FOR UNIX FORTRAN PROGRAMS */
#include <stdio.h>
#include "signal1.h"
#ifndef SIGIOT
#ifdef SIGABRT
#define SIGIOT SIGABRT
#endif
#endif
#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);
#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(), sig_die();
extern int MAIN__();
#define Int /* int */
#else
extern void f_init(void), sig_die(char*, int);
extern int MAIN__(void);
#define Int int
#endif
static VOID sigfdie(Int n)
{
sig_die("Floating Exception", 1);
}
static VOID sigidie(Int n)
{
sig_die("IOT Trap", 1);
}
#ifdef SIGQUIT
static VOID sigqdie(Int n)
{
sig_die("Quit signal", 1);
}
#endif
static VOID sigindie(Int n)
{
sig_die("Interrupt", 0);
}
static VOID sigtdie(Int n)
{
sig_die("Killed", 0);
}
#ifdef SIGTRAP
static VOID sigtrdie(Int n)
{
sig_die("Trace trap", 1);
}
#endif
int xargc;
char **xargv;
#ifdef __cplusplus
}
#endif
#ifdef KR_headers
main(argc, argv) int argc; char **argv;
#else
main(int argc, char **argv)
#endif
{
xargc = argc;
xargv = argv;
signal1(SIGFPE, sigfdie); /* ignore underflow, enable overflow */
#ifdef SIGIOT
signal1(SIGIOT, sigidie);
#endif
#ifdef SIGTRAP
signal1(SIGTRAP, sigtrdie);
#endif
#ifdef SIGQUIT
if(signal1(SIGQUIT,sigqdie) == SIG_IGN)
signal1(SIGQUIT, SIG_IGN);
#endif
if(signal1(SIGINT, sigindie) == SIG_IGN)
signal1(SIGINT, SIG_IGN);
signal1(SIGTERM,sigtdie);
#ifdef pdp11
ldfps(01200); /* detect overflow as an exception */
#endif
f_init();
#ifndef NO_ONEXIT
ONEXIT(f_exit);
#endif
MAIN__();
#ifdef NO_ONEXIT
f_exit();
#endif
exit(0); /* exit(0) rather than return(0) to bypass Cray bug */
return 0; /* For compilers that complain of missing return values; */
/* others will complain that this is unreachable code. */
}
.SUFFIXES: .c .o
CC = cc
SHELL = /bin/sh
CFLAGS = -O
# If your system lacks onexit() and you are not using an
# ANSI C compiler, then you should add -DNO_ONEXIT to CFLAGS,
# e.g., by changing the above "CFLAGS =" line to
# CFLAGS = -O -DNO_ONEXIT
# On at least some Sun systems, it is more appropriate to change the
# "CFLAGS =" line to
# CFLAGS = -O -Donexit=on_exit
# compile, then strip unnecessary symbols
.c.o:
$(CC) -c -DSkip_f2c_Undefs $(CFLAGS) $*.c
ld -r -x -o $*.xxx $*.o
mv $*.xxx $*.o
## Under Solaris (and other systems that do not understand ld -x),
## omit -x in the ld line above.
## If your system does not have the ld command, comment out
## or remove both the ld and mv lines above.
MISC = F77_aloc.o Version.o main.o s_rnge.o abort_.o getarg_.o iargc_.o \
getenv_.o signal_.o s_stop.o s_paus.o system_.o cabs.o\
derf_.o derfc_.o erf_.o erfc_.o sig_die.o exit_.o
POW = pow_ci.o pow_dd.o pow_di.o pow_hh.o pow_ii.o pow_ri.o pow_zi.o pow_zz.o
CX = c_abs.o c_cos.o c_div.o c_exp.o c_log.o c_sin.o c_sqrt.o
DCX = z_abs.o z_cos.o z_div.o z_exp.o z_log.o z_sin.o z_sqrt.o
REAL = r_abs.o r_acos.o r_asin.o r_atan.o r_atn2.o r_cnjg.o r_cos.o\
r_cosh.o r_dim.o r_exp.o r_imag.o r_int.o\
r_lg10.o r_log.o r_mod.o r_nint.o r_sign.o\
r_sin.o r_sinh.o r_sqrt.o r_tan.o r_tanh.o
DBL = d_abs.o d_acos.o d_asin.o d_atan.o d_atn2.o\
d_cnjg.o d_cos.o d_cosh.o d_dim.o d_exp.o\
d_imag.o d_int.o d_lg10.o d_log.o d_mod.o\
d_nint.o d_prod.o d_sign.o d_sin.o d_sinh.o\
d_sqrt.o d_tan.o d_tanh.o
INT = i_abs.o i_dim.o i_dnnt.o i_indx.o i_len.o i_mod.o i_nint.o i_sign.o
HALF = h_abs.o h_dim.o h_dnnt.o h_indx.o h_len.o h_mod.o h_nint.o h_sign.o
CMP = l_ge.o l_gt.o l_le.o l_lt.o hl_ge.o hl_gt.o hl_le.o hl_lt.o
EFL = ef1asc_.o ef1cmc_.o
CHAR = F77_aloc.o s_cat.o s_cmp.o s_copy.o
F90BIT = lbitbits.o lbitshft.o
QINT = pow_qq.o qbitbits.o qbitshft.o
TIME = dtime_.o etime_.o
all: signal1.h libF77.a
# You may need to adjust signal1.h suitably for your system...
signal1.h: signal1.h0
cp signal1.h0 signal1.h
# If you get an error compiling dtime_.c or etime_.c, try adding
# -DUSE_CLOCK to the CFLAGS assignment above; if that does not work,
# omit $(TIME) from the dependency list for libF77.a below.
# For INTEGER*8 support (which requires system-dependent adjustments to
# f2c.h), add $(QINT) to the libf2c.a dependency list below...
libF77.a : $(MISC) $(POW) $(CX) $(DCX) $(REAL) $(DBL) $(INT) \
$(HALF) $(CMP) $(EFL) $(CHAR) $(F90BIT) $(TIME)
ar r libF77.a $?
-ranlib libF77.a
### If your system lacks ranlib, you don't need it; see README.
Version.o: Version.c
$(CC) -c Version.c
# To compile with C++, first "make f2c.h"
f2c.h: f2ch.add
cat /usr/include/f2c.h f2ch.add >f2c.h
install: libF77.a
mv libF77.a /usr/lib
ranlib /usr/lib/libF77.a
clean:
rm -f libF77.a *.o
check:
xsum F77_aloc.c Notice README Version.c abort_.c c_abs.c c_cos.c \
c_div.c c_exp.c c_log.c c_sin.c c_sqrt.c cabs.c d_abs.c d_acos.c \
d_asin.c d_atan.c d_atn2.c d_cnjg.c d_cos.c d_cosh.c d_dim.c \
d_exp.c d_imag.c d_int.c d_lg10.c d_log.c d_mod.c d_nint.c \
d_prod.c d_sign.c d_sin.c d_sinh.c d_sqrt.c d_tan.c d_tanh.c \
derf_.c derfc_.c dtime_.c \
ef1asc_.c ef1cmc_.c erf_.c erfc_.c etime_.c exit_.c f2ch.add \
getarg_.c getenv_.c h_abs.c h_dim.c h_dnnt.c h_indx.c h_len.c \
h_mod.c h_nint.c h_sign.c hl_ge.c hl_gt.c hl_le.c hl_lt.c \
i_abs.c i_dim.c i_dnnt.c i_indx.c i_len.c i_mod.c i_nint.c \
i_sign.c iargc_.c l_ge.c l_gt.c l_le.c l_lt.c lbitbits.c lbitshft.c \
main.c makefile pow_ci.c pow_dd.c pow_di.c pow_hh.c pow_ii.c \
pow_qq.c pow_ri.c pow_zi.c pow_zz.c qbitbits.c qbitshft.c \
r_abs.c r_acos.c r_asin.c r_atan.c r_atn2.c \
r_cnjg.c r_cos.c r_cosh.c r_dim.c r_exp.c r_imag.c r_int.c r_lg10.c \
r_log.c r_mod.c r_nint.c r_sign.c r_sin.c r_sinh.c r_sqrt.c \
r_tan.c r_tanh.c s_cat.c s_cmp.c s_copy.c \
s_paus.c s_rnge.c s_stop.c sig_die.c signal1.h0 signal_.c system_.c \
z_abs.c z_cos.c z_div.c z_exp.c z_log.c z_sin.c z_sqrt.c >zap
cmp zap libF77.xsum && rm zap || diff libF77.xsum zap
#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
{
doublecomplex p1, a1;
a1.r = a->r;
a1.i = a->i;
pow_zi(&p1, &a1, b);
p->r = p1.r;
p->i = p1.i;
}
#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
{
return(pow(*ap, *bp) );
}
#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, x;
integer n;
unsigned long u;
pow = 1;
x = *ap;
n = *bp;
if(n != 0)
{
if(n < 0)
{
n = -n;
x = 1/x;
}
for(u = n; ; )
{
if(u & 01)
pow *= x;
if(u >>= 1)
x *= x;
else
break;
}
}
return(pow);
}
#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, x, n;
unsigned u;
x = *ap;
n = *bp;
if (n <= 0) {
if (n == 0 || x == 1)
return 1;
if (x != -1)
return x == 0 ? 1/x : 0;
n = -n;
}
u = n;
for(pow = 1; ; )
{
if(u & 01)
pow *= x;
if(u >>= 1)
x *= x;
else
break;
}
return(pow);
}
#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, x, n;
unsigned long u;
x = *ap;
n = *bp;
if (n <= 0) {
if (n == 0 || x == 1)
return 1;
if (x != -1)
return x == 0 ? 1/x : 0;
n = -n;
}
u = n;
for(pow = 1; ; )
{
if(u & 01)
pow *= x;
if(u >>= 1)
x *= x;
else
break;
}
return(pow);
}
#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, x, n;
unsigned long long u; /* system-dependent */
x = *ap;
n = *bp;
if (n <= 0) {
if (n == 0 || x == 1)
return 1;
if (x != -1)
return x == 0 ? 1/x : 0;
n = -n;
}
u = n;
for(pow = 1; ; )
{
if(u & 01)
pow *= x;
if(u >>= 1)
x *= x;
else
break;
}
return(pow);
}
#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, x;
integer n;
unsigned long u;
pow = 1;
x = *ap;
n = *bp;
if(n != 0)
{
if(n < 0)
{
n = -n;
x = 1/x;
}
for(u = n; ; )
{
if(u & 01)
pow *= x;
if(u >>= 1)
x *= x;
else
break;
}
}
return(pow);
}
#include "f2c.h"
#ifdef KR_headers
VOID pow_zi(resx, a, b) /* p = a**b */
doublecomplex *resx, *a; integer *b;
#else
extern void z_div(doublecomplex*, doublecomplex*, doublecomplex*);
void pow_zi(doublecomplex *resx, doublecomplex *a, integer *b) /* p = a**b */
#endif
{
integer n;
unsigned long u;
double t;
doublecomplex x;
doublecomplex res;
static doublecomplex one = {1.0, 0.0};
n = *b;
if(n == 0)
{
resx->r = 1;
resx->i = 0;
return;
}
res.r = 1;
res.i = 0;
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 = res.r * x.r - res.i * x.i;
res.i = res.r * x.i + res.i * x.r;
res.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;
}
resx->r = res.r;
resx->i = res.i;
}
#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
{
double logr, logi, x, y;
logr = log( f__cabs(a->r, a->i) );
logi = atan2(a->i, a->r);
x = exp( logr * b->r - logi * b->i );
y = logr * b->i + logi * b->r;
r->r = x * cos(y);
r->i = x * sin(y);
}
#include "f2c.h"
#ifndef LONGBITS
#define LONGBITS 32
#endif
#ifndef LONG8BITS
#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
{
/* Assume 2's complement arithmetic */
ulongint 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
{
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));
}
#include "f2c.h"
longint
#ifdef KR_headers
qbit_shift(a, b) longint a; integer b;
#else
qbit_shift(longint a, integer b)
#endif
{
return b >= 0 ? a << b : (longint)((ulongint)a >> -b);
}
#include "f2c.h"
#ifdef KR_headers
double r_abs(x) real *x;
#else
double r_abs(real *x)
#endif
{
if(*x >= 0)
return(*x);
return(- *x);
}
#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
{
return( acos(*x) );
}
#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
{
return( asin(*x) );
}
#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
{
return( atan(*x) );
}
#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
{
return( atan2(*x,*y) );
}
#include "f2c.h"
#ifdef KR_headers
VOID r_cnjg(resx, z) complex *resx, *z;
#else
VOID r_cnjg(complex *resx, complex *z)
#endif
{
complex res;
res.r = z->r;
res.i = - z->i;
resx->r = res.r;
resx->i = res.i;
}
#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
{
return( cos(*x) );
}
#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
{
return( cosh(*x) );
}
#include "f2c.h"
#ifdef KR_headers
double r_dim(a,b) real *a, *b;
#else
double r_dim(real *a, real *b)
#endif
{
return( *a > *b ? *a - *b : 0);
}
#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
{
return( exp(*x) );
}
#include "f2c.h"
#ifdef KR_headers
double r_imag(z) complex *z;
#else
double r_imag(complex *z)
#endif
{
return(z->i);
}
#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
{
return( (*x>0) ? floor(*x) : -floor(- *x) );
}
#include "f2c.h"
#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
{
return( log10e * log(*x) );
}
#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
{
return( log(*x) );
}
#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);
#else
#undef abs
#include <math.h>
#endif
double r_mod(real *x, real *y)
#endif
{
#ifdef IEEE_drem
double xa, ya, z;
if ((ya = *y) < 0.)
ya = -ya;
z = drem(xa = *x, ya);
if (xa > 0) {
if (z < 0)
z += ya;
}
else if (z > 0)
z -= ya;
return z;
#else
double quotient;
if( (quotient = (double)*x / *y) >= 0)
quotient = floor(quotient);
else
quotient = -floor(-quotient);
return(*x - (*y) * quotient );
#endif
}
#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
{
return( (*x)>=0 ?
floor(*x + .5) : -floor(.5 - *x) );
}
#include "f2c.h"
#ifdef KR_headers
double r_sign(a,b) real *a, *b;
#else
double r_sign(real *a, real *b)
#endif
{
double x;
x = (*a >= 0 ? *a : - *a);
return( *b >= 0 ? x : -x);
}
#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
{
return( sin(*x) );
}
#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
{
return( sinh(*x) );
}
#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
{
return( sqrt(*x) );
}
#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
{
return( tan(*x) );
}
#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
{
return( tanh(*x) );
}
/* Unless compiled with -DNO_OVERWRITE, this variant of s_cat allows the
* target of a concatenation to appear on its right-hand side (contrary
* to the Fortran 77 Standard, but in accordance with Fortran 90).
*/
#include "f2c.h"
#ifndef NO_OVERWRITE
#include <stdio.h>
#undef abs
#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
#include <string.h>
#endif /* NO_OVERWRITE */
VOID
#ifdef KR_headers
s_cat(lp, rpp, rnp, np, ll) char *lp, *rpp[]; ftnlen rnp[], *np, ll;
#else
s_cat(char *lp, char *rpp[], ftnlen rnp[], ftnlen *np, ftnlen ll)
#endif
{
ftnlen i, nc;
char *rp;
ftnlen n = *np;
#ifndef NO_OVERWRITE
ftnlen L, m;
char *lp0, *lp1;
lp0 = 0;
lp1 = lp;
L = ll;
i = 0;
while(i < n) {
rp = rpp[i];
m = rnp[i++];
if (rp >= lp1 || rp + m <= lp) {
if ((L -= m) <= 0) {
n = i;
break;
}
lp1 += m;
continue;
}
lp0 = lp;
lp = lp1 = F77_aloc(L = ll, "s_cat");
break;
}
lp1 = lp;
#endif /* NO_OVERWRITE */
for(i = 0 ; i < n ; ++i) {
nc = ll;
if(rnp[i] < nc)
nc = rnp[i];
ll -= nc;
rp = rpp[i];
while(--nc >= 0)
*lp++ = *rp++;
}
while(--ll >= 0)
*lp++ = ' ';
#ifndef NO_OVERWRITE
if (lp0) {
memcpy(lp0, lp1, L);
free(lp1);
}
#endif
}
#include "f2c.h"
/* 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
{
register unsigned char *a, *aend, *b, *bend;
a = (unsigned char *)a0;
b = (unsigned char *)b0;
aend = a + la;
bend = b + lb;
if(la <= lb)
{
while(a < aend)
if(*a != *b)
return( *a - *b );
else
{ ++a; ++b; }
while(b < bend)
if(*b != ' ')
return( ' ' - *b );
else ++b;
}
else
{
while(b < bend)
if(*a == *b)
{ ++a; ++b; }
else
return( *a - *b );
while(a < aend)
if(*a != ' ')
return(*a - ' ');
else ++a;
}
return(0);
}
/* Unless compiled with -DNO_OVERWRITE, this variant of s_copy allows the
* target of an assignment to appear on its right-hand side (contrary
* to the Fortran 77 Standard, but in accordance with Fortran 90),
* as in a(2:5) = a(4:7) .
*/
#include "f2c.h"
/* assign strings: a = b */
#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
{
register char *aend, *bend;
aend = a + la;
if(la <= lb)
#ifndef NO_OVERWRITE
if (a <= b || a >= b + la)
#endif
while(a < aend)
*a++ = *b++;
#ifndef NO_OVERWRITE
else
for(b += la; a < aend; )
*--aend = *--b;
#endif
else {
bend = b + lb;
#ifndef NO_OVERWRITE
if (a <= b || a >= bend)
#endif
while(b < bend)
*a++ = *b++;
#ifndef NO_OVERWRITE
else {
a += lb;
while(b < bend)
*--a = *--bend;
a += lb;
}
#endif
while(a < aend)
*a++ = ' ';
}
}
#include <stdio.h>
#include "f2c.h"
#define PAUSESIG 15
#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>
#include "signal1.h"
#ifdef __cplusplus
extern "C" {
#endif
extern int getpid(void), isatty(int), pause(void);
#endif
extern VOID f_exit(Void);
static VOID
waitpause(Int n)
{ n = n; /* shut up compiler warning */
return;
}
static VOID
#ifdef KR_headers
s_1paus(fin) FILE *fin;
#else
s_1paus(FILE *fin)
#endif
{
fprintf(stderr,
"To resume execution, type go. Other input will terminate the job.\n");
fflush(stderr);
if( getc(fin)!='g' || getc(fin)!='o' || getc(fin)!='\n' ) {
fprintf(stderr, "STOP\n");
#ifdef NO_ONEXIT
f_exit();
#endif
exit(0);
}
}
int
#ifdef KR_headers
s_paus(s, n) char *s; ftnlen n;
#else
s_paus(char *s, ftnlen n)
#endif
{
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
}
#endif
}
#include <stdio.h>
#include "f2c.h"
/* 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
{
register int i;
fprintf(stderr, "Subscript out of range on file line %ld, procedure ", line);
while((i = *procn) && i != '_' && i != ' ')
putc(*procn++, stderr);
fprintf(stderr, ".\nAttempt to access the %ld-th element of variable ", offset+1);
while((i = *varn) && i != ' ')
putc(*varn++, stderr);
sig_die(".", 1);
#ifdef __cplusplus
return 0;
#endif
}
#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);
int s_stop(char *s, ftnlen n)
#endif
{
int i;
if(n > 0)
{
fprintf(stderr, "STOP ");
for(i = 0; i<n ; ++i)
putc(*s++, stderr);
fprintf(stderr, " statement executed\n");
}
#ifdef NO_ONEXIT
f_exit();
#endif
exit(0);
#ifdef __cplusplus
return 0; /* NOT REACHED */
}
#endif
}
#include <stdio.h>
#include <signal.h>
#ifndef SIGIOT
#ifdef SIGABRT
#define SIGIOT SIGABRT
#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);
void sig_die(register char *s, int kill)
#endif
{
/* print error message, then clear buffers */
fprintf(stderr, "%s\n", s);
if(kill)
{
fflush(stderr);
f_exit();
fflush(stderr);
/* now get a core */
#ifdef SIGIOT
signal(SIGIOT, SIG_DFL);
#endif
abort();
}
else {
#ifdef NO_ONEXIT
f_exit();
#endif
exit(1);
}
}
#ifdef __cplusplus
}
#endif
/* The g77 implementation of libf2c directly includes signal1.h0,
instead of copying it to signal1.h, since that seems easier to
cope with at this point. */
#include "signal1.h0"
/* You may need to adjust the definition of signal1 to supply a */
/* cast to the correct argument type. This detail is system- and */
/* compiler-dependent. The #define below assumes signal.h declares */
/* type SIG_PF for the signal function's second argument. */
#include <signal.h>
#ifndef Sigret_t
#define Sigret_t void
#endif
#ifndef Sigarg_t
#ifdef KR_headers
#define Sigarg_t
#else
#define Sigarg_t int
#endif
#endif /*Sigarg_t*/
#ifdef USE_SIG_PF /* compile with -DUSE_SIG_PF under IRIX */
#define sig_pf SIG_PF
#else
typedef Sigret_t (*sig_pf)(Sigarg_t);
#endif
#define signal1(a,b) signal(a,(sig_pf)b)
#include "f2c.h"
#include "signal1.h"
#ifdef KR_headers
ftnint G77_signal_0 (sigp, proc) integer *sigp; sig_pf proc;
#else
ftnint G77_signal_0 (integer *sigp, sig_pf proc)
#endif
{
int sig;
sig = (int)*sigp;
return (ftnint)signal(sig, proc);
}
/* f77 interface to system routine */
#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*);
integer
G77_system_0 (register char *s, ftnlen n)
#endif
{
char buff0[256], *buff;
register char *bp, *blast;
integer rv;
buff = bp = n < 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;
}
#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
{
return( f__cabs( z->r, z->i ) );
}
#include "f2c.h"
#ifdef KR_headers
double sin(), cos(), sinh(), cosh();
VOID z_cos(resx, z) doublecomplex *resx, *z;
#else
#undef abs
#include <math.h>
void z_cos(doublecomplex *resx, doublecomplex *z)
#endif
{
doublecomplex res;
res.r = cos(z->r) * cosh(z->i);
res.i = - sin(z->r) * sinh(z->i);
resx->r = res.r;
resx->i = res.i;
}
#include "f2c.h"
#ifdef KR_headers
extern VOID sig_die();
VOID z_div(resx, a, b) doublecomplex *a, *b, *resx;
#else
extern void sig_die(char*, int);
void z_div(doublecomplex *resx, doublecomplex *a, doublecomplex *b)
#endif
{
double ratio, den;
double abr, abi;
doublecomplex res;
if( (abr = b->r) < 0.)
abr = - abr;
if( (abi = b->i) < 0.)
abi = - abi;
if( abr <= abi )
{
if(abi == 0)
sig_die("complex division by zero", 1);
ratio = b->r / b->i ;
den = b->i * (1 + ratio*ratio);
res.r = (a->r*ratio + a->i) / den;
res.i = (a->i*ratio - a->r) / den;
}
else
{
ratio = b->i / b->r ;
den = b->r * (1 + ratio*ratio);
res.r = (a->r + a->i*ratio) / den;
res.i = (a->i - a->r*ratio) / den;
}
resx->r = res.r;
resx->i = res.i;
}
#include "f2c.h"
#ifdef KR_headers
double exp(), cos(), sin();
VOID z_exp(resx, z) doublecomplex *resx, *z;
#else
#undef abs
#include <math.h>
void z_exp(doublecomplex *resx, doublecomplex *z)
#endif
{
double expx;
doublecomplex res;
expx = exp(z->r);
res.r = expx * cos(z->i);
res.i = expx * sin(z->i);
resx->r = res.r;
resx->i = res.i;
}
#include "f2c.h"
#ifdef KR_headers
double log(), f__cabs(), atan2();
VOID z_log(resx, z) doublecomplex *resx, *z;
#else
#undef abs
#include <math.h>
extern double f__cabs(double, double);
void z_log(doublecomplex *resx, doublecomplex *z)
#endif
{
doublecomplex res;
res.i = atan2(z->i, z->r);
res.r = log( f__cabs( z->r, z->i ) );
resx->r = res.r;
resx->i = res.i;
}
#include "f2c.h"
#ifdef KR_headers
double sin(), cos(), sinh(), cosh();
VOID z_sin(resx, z) doublecomplex *resx, *z;
#else
#undef abs
#include <math.h>
void z_sin(doublecomplex *resx, doublecomplex *z)
#endif
{
doublecomplex res;
res.r = sin(z->r) * cosh(z->i);
res.i = cos(z->r) * sinh(z->i);
resx->r = res.r;
resx->i = res.i;
}
#include "f2c.h"
#ifdef KR_headers
double sqrt(), f__cabs();
VOID z_sqrt(resx, z) doublecomplex *resx, *z;
#else
#undef abs
#include <math.h>
extern double f__cabs(double, double);
void z_sqrt(doublecomplex *resx, doublecomplex *z)
#endif
{
double mag;
doublecomplex res;
if( (mag = f__cabs(z->r, z->i)) == 0.)
res.r = res.i = 0.;
else if(z->r > 0)
{
res.r = sqrt(0.5 * (mag + z->r) );
res.i = z->i / res.r / 2;
}
else
{
res.i = sqrt(0.5 * (mag - z->r) );
if(z->i < 0)
res.i = - res.i;
res.r = z->i / res.i / 2;
}
resx->r = res.r;
resx->i = res.i;
}
# Makefile for GNU F77 compiler runtime.
# Copyright 1990 - 1994 by AT&T Bell Laboratories and Bellcore (see the
# file `Notice').
# Portions of this file Copyright (C) 1995, 1996 Free Software Foundation, Inc.
# Contributed by Dave Love (d.love@dl.ac.uk).
#
#This file is part of GNU Fortran.
#
#GNU Fortran is free software; you can redistribute it and/or modify
#it under the terms of the GNU General Public License as published by
#the Free Software Foundation; either version 2, or (at your option)
#any later version.
#
#GNU Fortran is distributed in the hope that it will be useful,
#but WITHOUT ANY WARRANTY; without even the implied warranty of
#MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
#GNU General Public License for more details.
#
#You should have received a copy of the GNU General Public License
#along with GNU Fortran; see the file COPYING. If not, write to
#the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
#02111-1307, USA.
SHELL = /bin/sh
srcdir = @srcdir@
VPATH = @srcdir@
#### Start of system configuration section. ####
# The _FOR_TARGET things are appropriate for a cross-make, passed by the
# superior makefile
GCC_FOR_TARGET = @CC@
CC = $(GCC_FOR_TARGET)
CFLAGS = @CFLAGS@ $(GCC_FLAGS)
CPPFLAGS = @CPPFLAGS@
DEFS = @DEFS@
CGFLAGS = #-g0
# f2c.h should already be installed in xgcc's include directory but add that
# to -I anyhow in case not using xgcc.
ALL_CFLAGS = -I. -I$(srcdir) -I../../../include $(CPPFLAGS) $(DEFS) $(CFLAGS)
AR = @AR@
AR_FLAGS = rc
RANLIB = @RANLIB@
RANLIB_TEST = @RANLIB_TEST@
CROSS = @CROSS@
.SUFFIXES:
.SUFFIXES: .c .o
.c.o:
$(CC) -c -DSkip_f2c_Undefs -DAllow_TYQUAD $(ALL_CFLAGS) $(CGFLAGS) $<
OBJ = VersionI.o backspace.o close.o dfe.o dolio.o due.o endfile.o err.o \
fmt.o fmtlib.o iio.o ilnw.o inquire.o lread.o lwrite.o open.o \
rdfmt.o rewind.o rsfe.o rsli.o rsne.o sfe.o sue.o typesize.o uio.o \
util.o wref.o wrtfmt.o wsfe.o wsle.o wsne.o xwsne.o \
ftell_.o
F2C_H = ../../../include/f2c.h
all: $(OBJ)
VersionI.o: Version.c
$(CC) -c $(CGFLAGS) -o $@ $(srcdir)/Version.c
mostlyclean clean:
-rm -f $(OBJ)
distclean maintainer-clean: mostlyclean
-rm -f stage? include Makefile
backspace.o: fio.h
close.o: fio.h
dfe.o: fio.h
dfe.o: fmt.h
due.o: fio.h
endfile.o: fio.h rawio.h
err.o: fio.h rawio.h
fmt.o: fio.h
fmt.o: fmt.h
ftell_.o: fio.h
iio.o: fio.h
iio.o: fmt.h
ilnw.o: fio.h
ilnw.o: lio.h
inquire.o: fio.h
lread.o: fio.h
lread.o: fmt.h
lread.o: lio.h
lread.o: fp.h
lwrite.o: fio.h
lwrite.o: fmt.h
lwrite.o: lio.h
open.o: fio.h rawio.h
rdfmt.o: fio.h
rdfmt.o: fmt.h
rdfmt.o: fp.h
rewind.o: fio.h
rsfe.o: fio.h
rsfe.o: fmt.h
rsli.o: fio.h
rsli.o: lio.h
rsne.o: fio.h
rsne.o: lio.h
sfe.o: fio.h
sue.o: fio.h
uio.o: fio.h
util.o: fio.h
wref.o: fio.h
wref.o: fmt.h
wref.o: fp.h
wrtfmt.o: fio.h
wrtfmt.o: fmt.h
wsfe.o: fio.h
wsfe.o: fmt.h
wsle.o: fio.h
wsle.o: fmt.h
wsle.o: lio.h
wsne.o: fio.h
wsne.o: lio.h
xwsne.o: fio.h
xwsne.o: lio.h
xwsne.o: fmt.h
# May be pessimistic:
$(OBJ): $(F2C_H)
.PHONY: mostlyclean clean distclean maintainer-clean all
/****************************************************************
Copyright 1990 - 1997 by AT&T, Lucent Technologies and Bellcore.
Permission to use, copy, modify, and distribute this software
and its documentation for any purpose and without fee is hereby
granted, provided that the above copyright notice appear in all
copies and that both that the copyright notice and this
permission notice and warranty disclaimer appear in supporting
documentation, and that the names of AT&T, Bell Laboratories,
Lucent or Bellcore or any of their entities not be used in
advertising or publicity pertaining to distribution of the
software without specific, written prior permission.
AT&T, Lucent and Bellcore disclaim all warranties with regard to
this software, including all implied warranties of
merchantability and fitness. In no event shall AT&T, Lucent or
Bellcore be liable for any special, indirect or consequential
damages or any damages whatsoever resulting from loss of use,
data or profits, whether in an action of contract, negligence or
other tortious action, arising out of or in connection with the
use or performance of this software.
****************************************************************/
If your compiler does not recognize ANSI C headers,
compile with KR_headers defined: either add -DKR_headers
to the definition of CFLAGS in the makefile, or insert
#define KR_headers
at the top of f2c.h and fmtlib.c .
If you have a really ancient K&R C compiler that does not understand
void, add -Dvoid=int to the definition of CFLAGS in the makefile.
If you use a C++ compiler, first create a local f2c.h by appending
f2ch.add to the usual f2c.h, e.g., by issuing the command
make f2c.h
which assumes f2c.h is installed in /usr/include .
If your system lacks /usr/include/fcntl.h , then you
should simply create an empty fcntl.h in this directory.
If your compiler then complains about creat and open not
having a prototype, compile with OPEN_DECL defined.
On many systems, open and creat are declared in fcntl.h .
If your system has /usr/include/fcntl.h, you may need to add
-D_POSIX_SOURCE to the makefile's definition of CFLAGS.
If your system's sprintf does not work the way ANSI C
specifies -- specifically, if it does not return the
number of characters transmitted -- then insert the line
#define USE_STRLEN
at the end of fmt.h . This is necessary with
at least some versions of Sun and DEC software.
In particular, if you get a warning about an improper
pointer/integer combination in compiling wref.c, then
you need to compile with -DUSE_STRLEN .
If your system's fopen does not like the ANSI binary
reading and writing modes "rb" and "wb", then you should
compile open.c with NON_ANSI_RW_MODES #defined.
If you get error messages about references to cf->_ptr
and cf->_base when compiling wrtfmt.c and wsfe.c or to
stderr->_flag when compiling err.c, then insert the line
#define NON_UNIX_STDIO
at the beginning of fio.h, and recompile everything (or
at least those modules that contain NON_UNIX_STDIO).
Unformatted sequential records consist of a length of record
contents, the record contents themselves, and the length of
record contents again (for backspace). Prior to 17 Oct. 1991,
the length was of type int; now it is of type long, but you
can change it back to int by inserting
#define UIOLEN_int
at the beginning of fio.h. This affects only sue.c and uio.c .
On VAX, Cray, or Research Tenth-Edition Unix systems, you may
need to add -DVAX, -DCRAY, or -DV10 (respectively) to CFLAGS
to make fp.h work correctly. Alternatively, you may need to
edit fp.h to suit your machine.
You may need to supply the following non-ANSI routines:
fstat(int fileds, struct stat *buf) is similar
to stat(char *name, struct stat *buf), except that
the first argument, fileds, is the file descriptor
returned by open rather than the name of the file.
fstat is used in the system-dependent routine
canseek (in the libI77 source file err.c), which
is supposed to return 1 if it's possible to issue
seeks on the file in question, 0 if it's not; you may
need to suitably modify err.c . On non-UNIX systems,
you can avoid references to fstat and stat by compiling
with NON_UNIX_STDIO defined; in that case, you may need
to supply access(char *Name,0), which is supposed to
return 0 if file Name exists, nonzero otherwise.
char * mktemp(char *buf) is supposed to replace the
6 trailing X's in buf with a unique number and then
return buf. The idea is to get a unique name for
a temporary file.
On non-UNIX systems, you may need to change a few other,
e.g.: the form of name computed by mktemp() in endfile.c and
open.c; the use of the open(), close(), and creat() system
calls in endfile.c, err.c, open.c; and the modes in calls on
fopen() and fdopen() (and perhaps the use of fdopen() itself
-- it's supposed to return a FILE* corresponding to a given
an integer file descriptor) in err.c and open.c (component ufmt
of struct unit is 1 for formatted I/O -- text mode on some systems
-- and 0 for unformatted I/O -- binary mode on some systems).
Compiling with -DNON_UNIX_STDIO omits all references to creat()
and almost all references to open() and close(), the exception
being in the function f__isdev() (in open.c).
For MS-DOS, compile all of libI77 with -DMSDOS (which implies
-DNON_UNIX_STDIO). You may need to make other compiler-dependent
adjustments; for example, for Turbo C++ you need to adjust the mktemp
invocations and to #undef ungetc in lread.c and rsne.c .
If you want to be able to load against libI77 but not libF77,
then you will need to add sig_die.o (from libF77) to libI77.
If you wish to use translated Fortran that has funny notions
of record length for direct unformatted I/O (i.e., that assumes
RECL= values in OPEN statements are not bytes but rather counts
of some other units -- e.g., 4-character words for VMS), then you
should insert an appropriate #define for url_Adjust at the
beginning of open.c . For VMS Fortran, for example,
#define url_Adjust(x) x *= 4
would suffice.
To check for transmission errors, issue the command
make check
This assumes you have the xsum program whose source, xsum.c,
is distributed as part of "all from f2c/src". If you do not
have xsum, you can obtain xsum.c by sending the following E-mail
message to netlib@netlib.bell-labs.com
send xsum.c from f2c/src
The makefile assumes you have installed f2c.h in a standard
place (and does not cause recompilation when f2c.h is changed);
f2c.h comes with "all from f2c" (the source for f2c) and is
available separately ("f2c.h from f2c").
By default, Fortran I/O units 5, 6, and 0 are pre-connected to
stdin, stdout, and stderr, respectively. You can change this
behavior by changing f_init() in err.c to suit your needs.
Note that f2c assumes READ(*... means READ(5... and WRITE(*...
means WRITE(6... . Moreover, an OPEN(n,... statement that does
not specify a file name (and does not specify STATUS='SCRATCH')
assumes FILE='fort.n' . You can change this by editing open.c
and endfile.c suitably.
Unless you adjust the "#define MXUNIT" line in fio.h, Fortran units
0, 1, ..., 99 are available, i.e., the highest allowed unit number
is MXUNIT - 1.
Lines protected from compilation by #ifdef Allow_TYQUAD
are for a possible extension to 64-bit integers in which
integer = int = 32 bits and longint = long = 64 bits.
Extensions (Feb. 1993) to NAMELIST processing:
1. Reading a ? instead of &name (the start of a namelist) causes
the namelist being sought to be written to stdout (unit 6);
to omit this feature, compile rsne.c with -DNo_Namelist_Questions.
2. Reading the wrong namelist name now leads to an error message
and an attempt to skip input until the right namelist name is found;
to omit this feature, compile rsne.c with -DNo_Bad_Namelist_Skip.
3. Namelist writes now insert newlines before each variable; to omit
this feature, compile xwsne.c with -DNo_Extra_Namelist_Newlines.
4. (Sept. 1995) When looking for the &name that starts namelist
input, lines whose first non-blank character is something other
than &, $, or ? are treated as comment lines and ignored, unless
rsne.c is compiled with -DNo_Namelist_Comments.
Nonstandard extension (Feb. 1993) to open: for sequential files,
ACCESS='APPEND' (or access='anything else starting with "A" or "a"')
causes the file to be positioned at end-of-file, so a write will
append to the file.
Some buggy Fortran programs use unformatted direct I/O to write
an incomplete record and later read more from that record than
they have written. For records other than the last, the unwritten
portion of the record reads as binary zeros. The last record is
a special case: attempting to read more from it than was written
gives end-of-file -- which may help one find a bug. Some other
Fortran I/O libraries treat the last record no differently than
others and thus give no help in finding the bug of reading more
than was written. If you wish to have this behavior, compile
uio.c with -DPad_UDread .
If you want to be able to catch write failures (e.g., due to a
disk being full) with an ERR= specifier, compile dfe.c, due.c,
sfe.c, sue.c, and wsle.c with -DALWAYS_FLUSH. This will lead to
slower execution and more I/O, but should make ERR= work as
expected, provided fflush returns an error return when its
physical write fails.
Carriage controls are meant to be interpreted by the UNIX col
program (or a similar program). Sometimes it's convenient to use
only ' ' as the carriage control character (normal single spacing).
If you compile lwrite.c and wsfe.c with -DOMIT_BLANK_CC, formatted
external output lines will have an initial ' ' quietly omitted,
making use of the col program unnecessary with output that only
has ' ' for carriage control.
The Fortran 77 Standard leaves it up to the implementation whether
formatted writes of floating-point numbers of absolute value < 1 have
a zero before the decimal point. By default, libI77 omits such
superfluous zeros, but you can cause them to appear by compiling
lwrite.c, wref.c, and wrtfmt.c with -DWANT_LEAD_0 .
If your system lacks a ranlib command, you don't need it.
Either comment out the makefile's ranlib invocation, or install
a harmless "ranlib" command somewhere in your PATH, such as the
one-line shell script
exit 0
or (on some systems)
exec /usr/bin/ar lts $1 >/dev/null
Most of the routines in libI77 are support routines for Fortran
I/O. There are a few exceptions, summarized below -- I/O related
functions and subroutines that appear to your program as ordinary
external Fortran routines.
1. CALL FLUSH flushes all buffers.
2. FTELL(i) is an INTEGER function that returns the current
offset of Fortran unit i (or -1 if unit i is not open).
3. CALL FSEEK(i, offset, whence, *errlab) attemps to move
Fortran unit i to the specified offset: absolute offset
if whence = 0; relative to the current offset if whence = 1;
relative to the end of the file if whence = 2. It branches
to label errlab if unit i is not open or if the call
otherwise fails.
static char junk[] = "\n@(#) LIBI77 VERSION pjw,dmg-mods 19970916\n";
/*
*/
char __G77_LIBI77_VERSION__[] = "0.5.22-19970930";
/*
2.01 $ format added
2.02 Coding bug in open.c repaired
2.03 fixed bugs in lread.c (read * with negative f-format) and lio.c
and lio.h (e-format conforming to spec)
2.04 changed open.c and err.c (fopen and freopen respectively) to
update to new c-library (append mode)
2.05 added namelist capability
2.06 allow internal list and namelist I/O
*/
/*
close.c:
allow upper-case STATUS= values
endfile.c
create fort.nnn if unit nnn not open;
else if (file length == 0) use creat() rather than copy;
use local copy() rather than forking /bin/cp;
rewind, fseek to clear buffer (for no reading past EOF)
err.c
use neither setbuf nor setvbuf; make stderr buffered
fio.h
#define _bufend
inquire.c
upper case responses;
omit byfile test from SEQUENTIAL=
answer "YES" to DIRECT= for unopened file (open to debate)
lio.c
flush stderr, stdout at end of each stmt
space before character strings in list output only at line start
lio.h
adjust LEW, LED consistent with old libI77
lread.c
use atof()
allow "nnn*," when reading complex constants
open.c
try opening for writing when open for read fails, with
special uwrt value (2) delaying creat() to first write;
set curunit so error messages don't drop core;
no file name ==> fort.nnn except for STATUS='SCRATCH'
rdfmt.c
use atof(); trust EOF == end-of-file (so don't read past
end-of-file after endfile stmt)
sfe.c
flush stderr, stdout at end of each stmt
wrtfmt.c:
use upper case
put wrt_E and wrt_F into wref.c, use sprintf()
rather than ecvt() and fcvt() [more accurate on VAX]
*/
/* 16 Oct. 1988: uwrt = 3 after write, rewind, so close won't zap the file. */
/* 10 July 1989: change _bufend to buf_end in fio.h, wsfe.c, wrtfmt.c */
/* 28 Nov. 1989: corrections for IEEE and Cray arithmetic */
/* 29 Nov. 1989: change various int return types to long for f2c */
/* 30 Nov. 1989: various types from f2c.h */
/* 6 Dec. 1989: types corrected various places */
/* 19 Dec. 1989: make iostat= work right for internal I/O */
/* 8 Jan. 1990: add rsne, wsne -- routines for handling NAMELIST */
/* 28 Jan. 1990: have NAMELIST read treat $ as &, general white
space as blank */
/* 27 Mar. 1990: change an = to == in rd_L(rdfmt.c) so formatted reads
of logical values reject letters other than fFtT;
have nowwriting reset cf */
/* 14 Aug. 1990: adjust lread.c to treat tabs as spaces in list input */
/* 17 Aug. 1990: adjust open.c to recognize blank='Z...' as well as
blank='z...' when reopening an open file */
/* 30 Aug. 1990: prevent embedded blanks in list output of complex values;
omit exponent field in list output of values of
magnitude between 10 and 1e8; prevent writing stdin
and reading stdout or stderr; don't close stdin, stdout,
or stderr when reopening units 5, 6, 0. */
/* 18 Sep. 1990: add component udev to unit and consider old == new file
iff uinode and udev values agree; use stat rather than
access to check existence of file (when STATUS='OLD')*/
/* 2 Oct. 1990: adjust rewind.c so two successive rewinds after a write
don't clobber the file. */
/* 9 Oct. 1990: add #include "fcntl.h" to endfile.c, err.c, open.c;
adjust g_char in util.c for segmented memories. */
/* 17 Oct. 1990: replace abort() and _cleanup() with calls on
sig_die(...,1) (defined in main.c). */
/* 5 Nov. 1990: changes to open.c: complain if new= is specified and the
file already exists; allow file= to be omitted in open stmts
and allow status='replace' (Fortran 90 extensions). */
/* 11 Dec. 1990: adjustments for POSIX. */
/* 15 Jan. 1991: tweak i_ungetc in rsli.c to allow reading from
strings in read-only memory. */
/* 25 Apr. 1991: adjust namelist stuff to work with f2c -i2 */
/* 26 Apr. 1991: fix some bugs with NAMELIST read of multi-dim. arrays */
/* 16 May 1991: increase LEFBL in lio.h to bypass NeXT bug */
/* 17 Oct. 1991: change type of length field in sequential unformatted
records from int to long (for systems where sizeof(int)
can vary, depending on the compiler or compiler options). */
/* 14 Nov. 1991: change uint to Uint in fmt.h, rdfmt.c, wrtfmt.c. */
/* 25 Nov. 1991: change uint to Uint in lwrite.c; change sizeof(int) to
sizeof(uioint) in fseeks in sue.c (missed on 17 Oct.). */
/* 1 Dec. 1991: uio.c: add test for read failure (seq. unformatted reads);
adjust an error return from EOF to off end of record */
/* 12 Dec. 1991: rsli.c: fix bug with internal list input that caused
the last character of each record to be ignored.
iio.c: adjust error message in internal formatted
input from "end-of-file" to "off end of record" if
the format specifies more characters than the
record contains. */
/* 17 Jan. 1992: lread.c, rsne.c: in list and namelist input,
treat "r* ," and "r*," alike (where r is a
positive integer constant), and fix a bug in
handling null values following items with repeat
counts (e.g., 2*1,,3); for namelist reading
of a numeric array, allow a new name-value subsequence
to terminate the current one (as though the current
one ended with the right number of null values).
lio.h, lwrite.c: omit insignificant zeros in
list and namelist output. To get the old
behavior, compile with -DOld_list_output . */
/* 18 Jan. 1992: make list output consistent with F format by
printing .1 rather than 0.1 (introduced yesterday). */
/* 3 Feb. 1992: rsne.c: fix namelist read bug that caused the
character following a comma to be ignored. */
/* 19 May 1992: adjust iio.c, ilnw.c, rdfmt.c and rsli.c to make err=
work with internal list and formatted I/O. */
/* 18 July 1992: adjust rsne.c to allow namelist input to stop at
an & (e.g. &end). */
/* 23 July 1992: switch to ANSI prototypes unless KR_headers is #defined ;
recognize Z format (assuming 8-bit bytes). */
/* 14 Aug. 1992: tweak wrt_E in wref.c to avoid -NaN */
/* 23 Oct. 1992: Supply missing l_eof = 0 assignment to s_rsne() in rsne.c
(so end-of-file on other files won't confuse namelist
reads of external files). Prepend f__ to external
names that are only of internal interest to lib[FI]77. */
/* 1 Feb. 1993: backspace.c: fix bug that bit when last char of 2nd
buffer == '\n'.
endfile.c: guard against tiny L_tmpnam; close and reopen
files in t_runc().
lio.h: lengthen LINTW (buffer size in lwrite.c).
err.c, open.c: more prepending of f__ (to [rw]_mode). */
/* 5 Feb. 1993: tweaks to NAMELIST: rsne.c: ? prints the namelist being
sought; namelists of the wrong name are skipped (after
an error message; xwsne.c: namelist writes have a
newline before each new variable.
open.c: ACCESS='APPEND' positions sequential files
at EOF (nonstandard extension -- that doesn't require
changing data structures). */
/* 9 Feb. 1993: Change some #ifdef MSDOS lines to #ifdef NON_UNIX_STDIO.
err.c: under NON_UNIX_STDIO, avoid close(creat(name,0666))
when the unit has another file descriptor for name. */
/* 4 March 1993: err.c, open.c: take declaration of fdopen from rawio.h;
open.c: always give f__w_mode[] 4 elements for use
in t_runc (in endfile.c -- for change of 1 Feb. 1993). */
/* 6 March 1993: uio.c: adjust off-end-of-record test for sequential
unformatted reads to respond to err= rather than end=. */
/* 12 March 1993: various tweaks for C++ */
/* 6 April 1993: adjust error returns for formatted inputs to flush
the current input line when err=label is specified.
To restore the old behavior (input left mid-line),
either adjust the #definition of errfl in fio.h or
omit the invocation of f__doend in err__fl (in err.c). */
/* 23 June 1993: iio.c: fix bug in format reversions for internal writes. */
/* 5 Aug. 1993: lread.c: fix bug in handling repetition counts for
logical data (during list or namelist input).
Change struct f__syl to struct syl (for buggy compilers). */
/* 7 Aug. 1993: lread.c: fix bug in namelist reading of incomplete
logical arrays. */
/* 9 Aug. 1993: lread.c: fix bug in namelist reading of an incomplete
array of numeric data followed by another namelist
item whose name starts with 'd', 'D', 'e', or 'E'. */
/* 8 Sept. 1993: open.c: protect #include "sys/..." with
#ifndef NON_UNIX_STDIO; Version date not changed. */
/* 10 Nov. 1993: backspace.c: add nonsense for #ifdef MSDOS */
/* 8 Dec. 1993: iio.c: adjust internal formatted reads to treat
short records as though padded with blanks
(rather than causing an "off end of record" error). */
/* 22 Feb. 1994: lread.c: check that realloc did not return NULL. */
/* 6 June 1994: Under NON_UNIX_STDIO, use binary mode for direct
formatted files (avoiding any confusion regarding \n). */
/* 5 July 1994: Fix bug (introduced 6 June 1994?) in reopening files
under NON_UNIX_STDIO. */
/* 6 July 1994: wref.c: protect with #ifdef GOOD_SPRINTF_EXPONENT an
optimization that requires exponents to have 2 digits
when 2 digits suffice.
lwrite.c wsfe.c (list and formatted external output):
omit ' ' carriage-control when compiled with
-DOMIT_BLANK_CC . Off-by-one bug fixed in character
count for list output of character strings.
Omit '.' in list-directed printing of Nan, Infinity. */
/* 12 July 1994: wrtfmt.c: under G11.4, write 0. as " .0000 " rather
than " .0000E+00". */
/* 3 Aug. 1994: lwrite.c: do not insert a newline when appending an
oversize item to an empty line. */
/* 12 Aug. 1994: rsli.c rsne.c: fix glitch (reset nml_read) that kept
ERR= (in list- or format-directed input) from working
after a NAMELIST READ. */
/* 7 Sept. 1994: typesize.c: adjust to allow types LOGICAL*1, LOGICAL*2,
INTEGER*1, and (under -DAllow_TYQUAD) INTEGER*8
in NAMELISTs. */
/* 6 Oct. 1994: util.c: omit f__mvgbt, as it is never used. */
/* 2 Nov. 1994: add #ifdef ALWAYS_FLUSH logic. */
/* 26 Jan. 1995: wref.c: fix glitch in printing the exponent of 0 when
GOOD_SPRINTF_EXPONENT is not #defined. */
/* 24 Feb. 1995: iio.c: z_getc: insert (unsigned char *) to allow
internal reading of characters with high-bit set
(on machines that sign-extend characters). */
/* 14 March 1995:lread.c and rsfe.c: adjust s_rsle and s_rsfe to
check for end-of-file (to prevent infinite loops
with empty read statements). */
/* 26 May 1995: iio.c: z_wnew: fix bug in handling T format items
in internal writes whose last item is written to
an earlier position than some previous item. */
/* 29 Aug. 1995: backspace.c: adjust MSDOS logic. */
/* 6 Sept. 1995: Adjust namelist input to treat a subscripted name
whose subscripts do not involve colons similarly
to the name without a subscript: accept several
values, stored in successive elements starting at
the indicated subscript. Adjust namelist output
to quote character strings (avoiding confusion with
arrays of character strings). Adjust f_init calls
for people who don't use libF77's main(); now open and
namelist read statements invoke f_init if needed. */
/* 7 Sept. 1995: Fix some bugs with -DAllow_TYQUAD (for integer*8).
Add -DNo_Namelist_Comments lines to rsne.c. */
/* 5 Oct. 1995: wrtfmt.c: fix bug with t editing (f__cursor was not
always zeroed in mv_cur). */
/* 11 Oct. 1995: move defs of f__hiwater, f__svic, f__icptr from wrtfmt.c
to err.c */
/* 15 Mar. 1996: lread.c, rsfe.c: honor END= in READ stmt with empty iolist */
/* 13 May 1996: add ftell_.c and fseek_.c */
/* 9 June 1996: Adjust rsli.c and lread.c so internal list input with
too few items in the input string will honor end= . */
/* 12 Sept. 1995:fmtlib.c: fix glitch in printing the most negative integer. */
/* 25 Sept. 1995:fmt.h: for formatted writes of negative integer*1 values,
make ic signed on ANSI systems. If formatted writes of
integer*1 values trouble you when using a K&R C compiler,
switch to an ANSI compiler or use a compiler flag that
makes characters signed. */
/* 9 Dec. 1996: d[fu]e.c, err.c: complain about non-positive rec=
in direct read and write statements.
ftell_.c: change param "unit" to "Unit" for -DKR_headers. */
/* 26 Feb. 1997: ftell_.c: on systems that define SEEK_SET, etc., use
SEEK_SET, SEEK_CUR, SEEK_END for *whence = 0, 1, 2. */
/* 7 Apr. 1997: fmt.c: adjust to complain at missing numbers in formats
(but still treat missing ".nnn" as ".0"). */
/* 11 Apr. 1997: err.c: attempt to make stderr line buffered rather
than fully buffered. (Buffering is needed for format
items T and TR.) */
/* 27 May 1997: ftell_.c: fix typo (that caused the third argument to be
treated as 2 on some systems). */
/* 5 Aug. 1997: lread.c: adjust to accord with a change to the Fortran 8X
draft (in 1990 or 1991) that rescinded permission to elide
quote marks in namelist input of character data; compile
with -DF8X_NML_ELIDE_QUOTES to get the old behavior.
wrtfmt.o: wrt_G: tweak to print the right number of 0's
for zero under G format. */
/* 16 Aug. 1997: iio.c: fix bug in internal writes to an array of character
strings that sometimes caused one more array element than
required by the format to be blank-filled. Example:
format(1x). */
/* 16 Sept. 1997:fmt.[ch] rdfmt.c wrtfmt.c: tweak struct syl for machines
with 64-bit pointers and 32-bit ints that did not 64-bit
align struct syl (e.g., Linux on the DEC Alpha). */
/* 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);
}
#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;
int i, ndec;
uiolen n;
#if defined (MSDOS) && !defined (GO32)
int j, k;
long w, z;
#endif
long x, y;
char buf[32];
if (f__init & 2)
f__fatal (131, "I/O recursion");
if(a->aunit >= MXUNIT || a->aunit < 0)
err(a->aerr,101,"backspace");
b= &f__units[a->aunit];
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) {
(void) t_runc(a);
if (f__nowreading(b))
err(a->aerr,errno,"backspace");
}
if(b->url>0)
{
x=ftell(b->ufd);
y = x % b->url;
if(y == 0) x--;
x /= b->url;
x *= b->url;
(void) fseek(b->ufd,x,SEEK_SET);
return(0);
}
if(b->ufmt==0)
{ (void) fseek(b->ufd,-(long)sizeof(uiolen),SEEK_CUR);
(void) fread((char *)&n,sizeof(uiolen),1,b->ufd);
(void) fseek(b->ufd,-(long)n-2*sizeof(uiolen),SEEK_CUR);
return(0);
}
#if defined (MSDOS) && !defined (GO32)
w = -1;
#endif
for(ndec = 1;; ndec = 0)
{
y = x = ftell(b->ufd);
if(x < sizeof(buf))
x = 0;
else
x -= sizeof(buf);
(void) fseek(b->ufd,x,SEEK_SET);
n=fread(buf,1,(size_t)(y-x), b->ufd);
for(i = n - ndec; --i >= 0; )
{
if(buf[i]!='\n') continue;
#if defined (MSDOS) && !defined (GO32)
for(j = k = 0; j <= i; j++)
if (buf[j] == '\n')
k++;
fseek(b->ufd,x,SEEK_SET);
for(;;)
if (getc(b->ufd) == '\n') {
if ((z = ftell(b->ufd)) >= y && ndec) {
if (w == -1)
goto break2;
break;
}
if (--k <= 0)
return 0;
w = z;
}
fseek(b->ufd, w, SEEK_SET);
#else
fseek(b->ufd,(long)(i+1-n),SEEK_CUR);
#endif
return(0);
}
#if defined (MSDOS) && !defined (GO32)
break2:
#endif
if(x==0)
{
(void) fseek(b->ufd, 0L, SEEK_SET);
return(0);
}
else if(n<=0) err(a->aerr,(EOF),"backspace");
(void) fseek(b->ufd, x, SEEK_SET);
}
}
#include "f2c.h"
#include "fio.h"
#ifdef KR_headers
integer f_clos(a) cllist *a;
#else
#undef abs
#undef min
#undef max
#include <stdlib.h>
#ifdef NON_UNIX_STDIO
#ifndef unlink
#define unlink remove
#endif
#else
#if defined (MSDOS) && !defined (GO32)
#include "io.h"
#else
#ifdef __cplusplus
extern "C" int unlink(const char*);
#else
extern int unlink(const char*);
#endif
#endif
#endif
integer f_clos(cllist *a)
#endif
{ 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 (!a->csta)
if (b->uscrtch == 1)
goto Delete;
else
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:
if(b->ufnm) {
fclose(b->ufd);
unlink(b->ufnm); /*SYSDEP*/
free(b->ufnm);
}
}
b->ufd=NULL;
done:
b->uend=0;
b->ufnm=NULL;
return(0);
}
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. */
/* no more I/O to be done. If this is not done, then if the
program is interrupted during I/O, f_clos thinks, incorrectly,
that there is an I/O recursion. */
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
#ifdef KR_headers
G77_flush_0 ()
#else
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;
}
#include "f2c.h"
#include "fio.h"
#include "fmt.h"
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;
}
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");
}
#ifdef KR_headers
y_putc(c)
#else
y_putc(int c)
#endif
{
f__recpos++;
if(f__recpos <= f__curunit->url || f__curunit->url==1)
putc(c,f__cf);
else
err(f__elist->cierr,110,"dout");
return(0);
}
y_rev(Void)
{ /*what about work done?*/
if(f__curunit->url==1 || f__recpos==f__curunit->url)
return(0);
while(f__recpos<f__curunit->url)
(*f__putn)(' ');
f__recpos=0;
return(0);
}
y_err(Void)
{
err(f__elist->cierr, 110, "dfe");
}
y_newrec(Void)
{
if(f__curunit->url == 1 || f__recpos == f__curunit->url) {
f__hiwater = f__recpos = f__cursor = 0;
return(1);
}
if(f__hiwater > f__recpos)
f__recpos = f__hiwater;
y_rev();
f__hiwater = f__cursor = 0;
return(1);
}
#ifdef KR_headers
c_dfe(a) cilist *a;
#else
c_dfe(cilist *a)
#endif
{
f__sequential=0;
f__formatted=f__external=1;
f__elist=a;
f__cursor=f__scale=f__recpos=0;
if(a->ciunit>MXUNIT || a->ciunit<0)
err(a->cierr,101,"startchk");
f__curunit = &f__units[a->ciunit];
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");
(void) fseek(f__cf,(long)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
{
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
{
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 = y_putc;
f__doed = w_ed;
f__doned= w_ned;
f__dorevert = y_err;
f__donewrec = y_newrec;
f__doend = y_rev;
if(pars_f(f__fmtbuf)<0)
err(a->cierr,100,"startwrt");
fmt_bg();
return(0);
}
integer e_rdfe(Void)
{
f__init = 1;
(void) en_fio();
return(0);
}
integer e_wdfe(Void)
{
f__init = 1;
return en_fio();
}
#include "f2c.h"
#ifdef __cplusplus
extern "C" {
#endif
#ifdef KR_headers
extern int (*f__lioproc)();
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
{
return((*f__lioproc)(number,ptr,len,*type));
}
#ifdef __cplusplus
}
#endif
#include "f2c.h"
#include "fio.h"
#ifdef KR_headers
c_due(a) cilist *a;
#else
c_due(cilist *a)
#endif
{
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];
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");
(void) fseek(f__cf,(long)(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
{
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
{
int n;
f__reading=0;
if(n=c_due(a)) return(n);
if(f__curunit->uwrt != 1 && f__nowwriting(f__curunit))
err(a->cierr,errno,"write start");
return(0);
}
integer e_rdue(Void)
{
f__init = 1;
if(f__curunit->url==1 || f__recpos==f__curunit->url)
return(0);
(void) fseek(f__cf,(long)(f__curunit->url-f__recpos),SEEK_CUR);
if(ftell(f__cf)%f__curunit->url)
err(f__elist->cierr,200,"syserr");
return(0);
}
integer e_wdue(Void)
{
f__init = 1;
#ifdef ALWAYS_FLUSH
if (fflush(f__cf))
err(f__elist->cierr,errno,"write end");
#endif
return(e_rdue());
}
#include "f2c.h"
#include "fio.h"
#include <sys/types.h>
#include "rawio.h"
#ifdef KR_headers
extern char *strcpy();
#else
#undef abs
#undef min
#undef max
#include <stdlib.h>
#include <string.h>
#endif
#ifdef NON_UNIX_STDIO
#ifndef unlink
#define unlink remove
#endif
#else
#if defined (MSDOS) && !defined (GO32)
#include "io.h"
#endif
#endif
#ifdef NON_UNIX_STDIO
extern char *f__r_mode[], *f__w_mode[];
#endif
#ifdef KR_headers
integer f_end(a) alist *a;
#else
integer f_end(alist *a)
#endif
{
unit *b;
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];
(void) sprintf(nbuf,"fort.%ld",a->aunit);
#ifdef NON_UNIX_STDIO
{ FILE *tf;
if (tf = fopen(nbuf, f__w_mode[0]))
fclose(tf);
}
#else
close(creat(nbuf, 0666));
#endif
return(0);
}
b->uend=1;
return(b->useek ? t_runc(a) : 0);
}
static int
#ifdef NON_UNIX_STDIO
#ifdef KR_headers
copy(from, len, to) char *from, *to; register long len;
#else
copy(FILE *from, register long len, FILE *to)
#endif
{
int k, 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;
}
#else
#ifdef KR_headers
copy(from, len, to) char *from, *to; register long len;
#else
copy(char *from, register long len, char *to)
#endif
{
register size_t n;
int k, rc = 0, tmp;
char buf[BUFSIZ];
if ((k = open(from, O_RDONLY)) < 0)
return 1;
if ((tmp = creat(to,0666)) < 0)
return 1;
while((n = read(k, buf, (size_t) (len > BUFSIZ ? BUFSIZ : (int)len))) > 0) {
if (write(tmp, buf, n) != n)
{ rc = 1; break; }
if ((len -= n) <= 0)
break;
}
close(k);
close(tmp);
return n < 0 ? 1 : rc;
}
#endif
#ifndef L_tmpnam
#define L_tmpnam 16
#endif
int
#ifdef KR_headers
t_runc(a) alist *a;
#else
t_runc(alist *a)
#endif
{
char nm[L_tmpnam+12]; /* extra space in case L_tmpnam is tiny */
long loc, len;
unit *b;
#ifdef NON_UNIX_STDIO
FILE *bf, *tf;
#else
FILE *bf;
#endif
int rc = 0;
b = &f__units[a->aunit];
if(b->url)
return(0); /*don't truncate direct files*/
loc=ftell(bf = b->ufd);
fseek(bf,0L,SEEK_END);
len=ftell(bf);
if (loc >= len || b->useek == 0 || b->ufnm == NULL)
return(0);
#ifdef NON_UNIX_STDIO
fclose(b->ufd);
#else
rewind(b->ufd); /* empty buffer */
#endif
if (!loc) {
#ifdef NON_UNIX_STDIO
if (!(bf = fopen(b->ufnm, f__w_mode[b->ufmt])))
#else
if (close(creat(b->ufnm,0666)))
#endif
rc = 1;
if (b->uwrt)
b->uwrt = 1;
goto done;
}
#ifdef _POSIX_SOURCE
tmpnam(nm);
#else
strcpy(nm,"tmp.FXXXXXX");
mktemp(nm);
#endif
#ifdef NON_UNIX_STDIO
if (!(bf = fopen(b->ufnm, f__r_mode[0]))) {
bad:
rc = 1;
goto done;
}
if (!(tf = fopen(nm, f__w_mode[0])))
goto bad;
if (copy(bf, loc, tf)) {
bad1:
rc = 1;
goto done1;
}
if (!(bf = freopen(b->ufnm, f__w_mode[0], bf)))
goto bad1;
if (!(tf = freopen(nm, f__r_mode[0], tf)))
goto bad1;
if (copy(tf, loc, bf))
goto bad1;
if (f__w_mode[0] != f__w_mode[b->ufmt]) {
if (!(bf = freopen(b->ufnm, f__w_mode[b->ufmt|2], bf)))
goto bad1;
fseek(bf, loc, SEEK_SET);
}
done1:
fclose(tf);
unlink(nm);
done:
f__cf = b->ufd = bf;
#else
if (copy(b->ufnm, loc, nm)
|| copy(nm, loc, b->ufnm))
rc = 1;
unlink(nm);
fseek(b->ufd, loc, SEEK_SET);
done:
#endif
if (rc)
err(a->aerr,111,"endfile");
return 0;
}
#ifndef NON_UNIX_STDIO
#include <sys/types.h>
#include <sys/stat.h>
#endif
#include "f2c.h"
#if defined (NON_UNIX_STDIO) || defined (MISSING_FILE_ELEMS)
#ifdef KR_headers
extern char *malloc();
#else
#undef abs
#undef min
#undef max
#include <stdlib.h>
#endif
#endif
#include "fio.h"
#include "fmt.h" /* for struct syl */
#include "rawio.h" /* for fcntl.h, fdopen */
/*global definitions*/
unit f__units[MXUNIT]; /*unit table*/
int f__init; /*bit 0: set after initializations;
bit 1: set during I/O involving returns to
caller of library (or calls to user code)*/
cilist *f__elist; /*active external io list*/
icilist *f__svic; /*active internal io list*/
flag f__reading; /*1 if reading, 0 if writing*/
flag f__cplus,f__cblank;
char *f__fmtbuf;
int f__fmtlen;
flag f__external; /*1 if external io, 0 if internal */
#ifdef KR_headers
int (*f__doed)(),(*f__doned)();
int (*f__doend)(),(*f__donewrec)(),(*f__dorevert)();
int (*f__getn)(),(*f__putn)(); /*for formatted io*/
#else
int (*f__getn)(void),(*f__putn)(int); /*for formatted io*/
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*/
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 */
};
#define MAXERR (sizeof(F_err)/sizeof(char *)+100)
#ifdef KR_headers
f__canseek(f) FILE *f; /*SYSDEP*/
#else
f__canseek(FILE *f) /*SYSDEP*/
#endif
{
#ifdef NON_UNIX_STDIO
return !isatty(fileno(f));
#else
struct stat x;
if (fstat(fileno(f),&x) < 0)
return(0);
#ifdef S_IFMT
switch(x.st_mode & S_IFMT) {
case S_IFDIR:
case S_IFREG:
if(x.st_nlink > 0) /* !pipe */
return(1);
else
return(0);
case S_IFCHR:
if(isatty(fileno(f)))
return(0);
return(1);
#ifdef S_IFBLK
case S_IFBLK:
return(1);
#endif
}
#else
#ifdef S_ISDIR
/* POSIX version */
if (S_ISREG(x.st_mode) || S_ISDIR(x.st_mode)) {
if(x.st_nlink > 0) /* !pipe */
return(1);
else
return(0);
}
if (S_ISCHR(x.st_mode)) {
if(isatty(fileno(f)))
return(0);
return(1);
}
if (S_ISBLK(x.st_mode))
return(1);
#else
Help! How does fstat work on this system?
#endif
#endif
return(0); /* who knows what it is? */
#endif
}
void
#ifdef KR_headers
f__fatal(n,s) char *s;
#else
f__fatal(int n, char *s)
#endif
{
static int dead = 0;
if(n<100 && n>=0) perror(s); /*SYSDEP*/
else if(n >= (int)MAXERR || n < -1)
{ fprintf(stderr,"%s: illegal error number %d\n",s,n);
}
else if(n == -1) fprintf(stderr,"%s: end of file\n",s);
else
fprintf(stderr,"%s: %s\n",s,F_err[n-100]);
if (dead) {
fprintf (stderr, "(libf2c f__fatal already called, aborting.)");
abort();
}
dead = 1;
if (f__init & 1) {
if (f__curunit) {
fprintf(stderr,"apparent state: unit %d ",f__curunit-f__units);
fprintf(stderr, f__curunit->ufnm ? "named %s\n" : "(unnamed)\n",
f__curunit->ufnm);
}
else
fprintf(stderr,"apparent state: internal I/O\n");
if (f__fmtbuf)
fprintf(stderr,"last format: %.*s\n",f__fmtlen,f__fmtbuf);
fprintf(stderr,"lately %s %s %s %s",f__reading?"reading":"writing",
f__sequential?"sequential":"direct",f__formatted?"formatted":"unformatted",
f__external?"external":"internal");
}
f__init &= ~2; /* No longer doing I/O (no more user code to be called). */
sig_die(" IO", 1);
}
/*initialization routine*/
VOID
f_init(Void)
{ unit *p;
if (f__init & 2)
f__fatal (131, "I/O recursion");
f__init = 1;
p= &f__units[0];
p->ufd=stderr;
p->useek=f__canseek(stderr);
#ifdef _IOLBF
setvbuf(stderr, (char*)malloc(BUFSIZ+8), _IOLBF, BUFSIZ+8);
#else
#if defined (NON_UNIX_STDIO) || defined (MISSING_FILE_ELEMS)
setbuf(stderr, (char *)malloc(BUFSIZ+8));
#else
stderr->_flag &= ~_IONBF;
#endif
#endif
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
{
long loc;
int ufmt;
extern char *f__r_mode[];
if (!x->ufnm)
goto cantread;
ufmt = x->ufmt;
loc=ftell(x->ufd);
if(freopen(x->ufnm,f__r_mode[ufmt],x->ufd) == NULL) {
cantread:
errno = 126;
return(1);
}
x->uwrt=0;
(void) fseek(x->ufd,loc,SEEK_SET);
return(0);
}
#ifdef KR_headers
f__nowwriting(x) unit *x;
#else
f__nowwriting(unit *x)
#endif
{
long loc;
int ufmt;
extern char *f__w_mode[];
#ifndef NON_UNIX_STDIO
int k;
#endif
if (!x->ufnm)
goto cantwrite;
ufmt = x->ufmt;
#ifdef NON_UNIX_STDIO
ufmt |= 2;
#endif
if (x->uwrt == 3) { /* just did write, rewind */
#ifdef NON_UNIX_STDIO
if (!(f__cf = x->ufd =
freopen(x->ufnm,f__w_mode[ufmt],x->ufd)))
#else
if (close(creat(x->ufnm,0666)))
#endif
goto cantwrite;
}
else {
loc=ftell(x->ufd);
#ifdef NON_UNIX_STDIO
if (!(f__cf = x->ufd =
freopen(x->ufnm, f__w_mode[ufmt], x->ufd)))
#else
if (fclose(x->ufd) < 0
|| (k = x->uwrt == 2 ? creat(x->ufnm,0666)
: open(x->ufnm,O_WRONLY)) < 0
|| (f__cf = x->ufd = fdopen(k,f__w_mode[ufmt])) == NULL)
#endif
{
x->ufd = NULL;
cantwrite:
errno = 127;
return(1);
}
(void) fseek(x->ufd,loc,SEEK_SET);
}
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
{
if (!f)
f__fatal(m, s);
if (f__doend)
(*f__doend)();
f__init &= ~2;
return errno = m;
}
/* If you are using a C++ compiler, append the following to f2c.h
for compiling libF77 and libI77. */
#ifdef __cplusplus
extern "C" {
extern int abort_(void);
extern double c_abs(complex *);
extern void c_cos(complex *, complex *);
extern void c_div(complex *, complex *, complex *);
extern void c_exp(complex *, complex *);
extern void c_log(complex *, complex *);
extern void c_sin(complex *, complex *);
extern void c_sqrt(complex *, complex *);
extern double d_abs(double *);
extern double d_acos(double *);
extern double d_asin(double *);
extern double d_atan(double *);
extern double d_atn2(double *, double *);
extern void d_cnjg(doublecomplex *, doublecomplex *);
extern double d_cos(double *);
extern double d_cosh(double *);
extern double d_dim(double *, double *);
extern double d_exp(double *);
extern double d_imag(doublecomplex *);
extern double d_int(double *);
extern double d_lg10(double *);
extern double d_log(double *);
extern double d_mod(double *, double *);
extern double d_nint(double *);
extern double d_prod(float *, float *);
extern double d_sign(double *, double *);
extern double d_sin(double *);
extern double d_sinh(double *);
extern double d_sqrt(double *);
extern double d_tan(double *);
extern double d_tanh(double *);
extern double derf_(double *);
extern double derfc_(double *);
extern integer do_fio(ftnint *, char *, ftnlen);
extern integer do_lio(ftnint *, ftnint *, char *, ftnlen);
extern integer do_uio(ftnint *, char *, ftnlen);
extern integer e_rdfe(void);
extern integer e_rdue(void);
extern integer e_rsfe(void);
extern integer e_rsfi(void);
extern integer e_rsle(void);
extern integer e_rsli(void);
extern integer e_rsue(void);
extern integer e_wdfe(void);
extern integer e_wdue(void);
extern integer e_wsfe(void);
extern integer e_wsfi(void);
extern integer e_wsle(void);
extern integer e_wsli(void);
extern integer e_wsue(void);
extern int ef1asc_(ftnint *, ftnlen *, ftnint *, ftnlen *);
extern integer ef1cmc_(ftnint *, ftnlen *, ftnint *, ftnlen *);
extern double erf(double);
extern double erf_(float *);
extern double erfc(double);
extern double erfc_(float *);
extern integer f_back(alist *);
extern integer f_clos(cllist *);
extern integer f_end(alist *);
extern void f_exit(void);
extern integer f_inqu(inlist *);
extern integer f_open(olist *);
extern integer f_rew(alist *);
extern int flush_(void);
extern void getarg_(integer *, char *, ftnlen);
extern void getenv_(char *, char *, ftnlen, ftnlen);
extern short h_abs(short *);
extern short h_dim(short *, short *);
extern short h_dnnt(double *);
extern short h_indx(char *, char *, ftnlen, ftnlen);
extern short h_len(char *, ftnlen);
extern short h_mod(short *, short *);
extern short h_nint(float *);
extern short h_sign(short *, short *);
extern short hl_ge(char *, char *, ftnlen, ftnlen);
extern short hl_gt(char *, char *, ftnlen, ftnlen);
extern short hl_le(char *, char *, ftnlen, ftnlen);
extern short hl_lt(char *, char *, ftnlen, ftnlen);
extern integer i_abs(integer *);
extern integer i_dim(integer *, integer *);
extern integer i_dnnt(double *);
extern integer i_indx(char *, char *, ftnlen, ftnlen);
extern integer i_len(char *, ftnlen);
extern integer i_mod(integer *, integer *);
extern integer i_nint(float *);
extern integer i_sign(integer *, integer *);
extern integer iargc_(void);
extern ftnlen l_ge(char *, char *, ftnlen, ftnlen);
extern ftnlen l_gt(char *, char *, ftnlen, ftnlen);
extern ftnlen l_le(char *, char *, ftnlen, ftnlen);
extern ftnlen l_lt(char *, char *, ftnlen, ftnlen);
extern void pow_ci(complex *, complex *, integer *);
extern double pow_dd(double *, double *);
extern double pow_di(double *, integer *);
extern short pow_hh(short *, shortint *);
extern integer pow_ii(integer *, integer *);
extern double pow_ri(float *, integer *);
extern void pow_zi(doublecomplex *, doublecomplex *, integer *);
extern void pow_zz(doublecomplex *, doublecomplex *, doublecomplex *);
extern double r_abs(float *);
extern double r_acos(float *);
extern double r_asin(float *);
extern double r_atan(float *);
extern double r_atn2(float *, float *);
extern void r_cnjg(complex *, complex *);
extern double r_cos(float *);
extern double r_cosh(float *);
extern double r_dim(float *, float *);
extern double r_exp(float *);
extern double r_imag(complex *);
extern double r_int(float *);
extern double r_lg10(float *);
extern double r_log(float *);
extern double r_mod(float *, float *);
extern double r_nint(float *);
extern double r_sign(float *, float *);
extern double r_sin(float *);
extern double r_sinh(float *);
extern double r_sqrt(float *);
extern double r_tan(float *);
extern double r_tanh(float *);
extern void s_cat(char *, char **, integer *, integer *, ftnlen);
extern integer s_cmp(char *, char *, ftnlen, ftnlen);
extern void s_copy(char *, char *, ftnlen, ftnlen);
extern int s_paus(char *, ftnlen);
extern integer s_rdfe(cilist *);
extern integer s_rdue(cilist *);
extern integer s_rnge(char *, integer, char *, integer);
extern integer s_rsfe(cilist *);
extern integer s_rsfi(icilist *);
extern integer s_rsle(cilist *);
extern integer s_rsli(icilist *);
extern integer s_rsne(cilist *);
extern integer s_rsni(icilist *);
extern integer s_rsue(cilist *);
extern int s_stop(char *, ftnlen);
extern integer s_wdfe(cilist *);
extern integer s_wdue(cilist *);
extern integer s_wsfe(cilist *);
extern integer s_wsfi(icilist *);
extern integer s_wsle(cilist *);
extern integer s_wsli(icilist *);
extern integer s_wsne(cilist *);
extern integer s_wsni(icilist *);
extern integer s_wsue(cilist *);
extern void sig_die(char *, int);
extern integer signal_(integer *, void (*)(int));
extern integer system_(char *, ftnlen);
extern double z_abs(doublecomplex *);
extern void z_cos(doublecomplex *, doublecomplex *);
extern void z_div(doublecomplex *, doublecomplex *, doublecomplex *);
extern void z_exp(doublecomplex *, doublecomplex *);
extern void z_log(doublecomplex *, doublecomplex *);
extern void z_sin(doublecomplex *, doublecomplex *);
extern void z_sqrt(doublecomplex *, doublecomplex *);
}
#endif
#include <stdio.h>
#include <errno.h>
#ifndef NULL
/* ANSI C */
#include <stddef.h>
#endif
#ifdef STDC_HEADERS
#include <string.h>
#endif
#ifndef SEEK_SET
#define SEEK_SET 0
#define SEEK_CUR 1
#define SEEK_END 2
#endif
#if defined (MSDOS) && !defined (GO32)
#ifndef NON_UNIX_STDIO
#define NON_UNIX_STDIO
#endif
#endif
#ifdef UIOLEN_int
typedef int uiolen;
#else
typedef long uiolen;
#endif
/*units*/
typedef struct
{ FILE *ufd; /*0=unconnected*/
char *ufnm;
#if !(defined (MSDOS) && !defined (GO32))
long uinode;
int udev;
#endif
int url; /*0=sequential*/
flag useek; /*true=can backspace, use dir, ...*/
flag ufmt;
flag uprnt;
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)(),(*f__putn)(); /*for formatted io*/
extern long f__inode();
extern VOID sig_die();
extern int (*f__donewrec)(), t_putc(), x_wSL();
extern int c_sfe(), err__fl(), xrd_SL();
#else
#define Void void
#ifdef __cplusplus
extern "C" {
#endif
extern int (*f__getn)(void),(*f__putn)(int); /*for formatted io*/
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);
#ifdef __cplusplus
}
#endif
#endif
extern int (*f__doend)(Void);
extern FILE *f__cf; /*current file*/
extern unit *f__curunit; /*current unit*/
extern unit f__units[];
#define err(f,m,s) do {if(f) {f__init &= ~2; errno= m;} else f__fatal(m,s); return(m);} while(0)
#define errfl(f,m,s) do {return err__fl((int)f,m,s);} while(0)
/*Table sizes*/
#define MXUNIT 100
extern int f__recpos; /*position in current record*/
extern int f__cursor; /* offset to move to */
extern int f__hiwater; /* so TL doesn't confuse us */
#define WRITE 1
#define READ 2
#define SEQ 3
#define DIR 4
#define FMT 5
#define UNF 6
#define EXT 7
#define INT 8
#define buf_end(x) (x->_flag & _IONBF ? x->_ptr : x->_base + BUFSIZ)
#include "f2c.h"
#include "fio.h"
#include "fmt.h"
#define skip(s) while(*s==' ') s++
#ifdef interdata
#define SYLMX 300
#endif
#ifdef pdp11
#define SYLMX 300
#endif
#ifdef vax
#define SYLMX 300
#endif
#ifndef SYLMX
#define SYLMX 300
#endif
#define GLITCH '\2'
/* special quote character for stu */
extern int f__cursor,f__scale;
extern flag f__cblank,f__cplus; /*blanks in I and compulsory plus*/
static struct syl f__syl[SYLMX];
int f__parenlvl,f__pc,f__revloc;
static
#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
#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++);
}
#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++;
}
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
{
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
#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)
{
default:
return(0);
case ':': (void) op_gen(COLON,0,0,0); break;
case '$':
(void) op_gen(NONL, 0, 0, 0); break;
case 'B':
case 'b':
if(*++s=='z' || *s == 'Z') (void) op_gen(BZ,0,0,0);
else (void) op_gen(BN,0,0,0);
break;
case 'S':
case 's':
if(*(s+1)=='s' || *(s+1) == 'S')
{ x=SS;
s++;
}
else if(*(s+1)=='p' || *(s+1) == 'P')
{ x=SP;
s++;
}
else x=S;
(void) op_gen(x,0,0,0);
break;
case '/': (void) op_gen(SLASH,0,0,0); break;
case '-': sign=1;
case '+': s++; /*OUTRAGEOUS CODING TRICK*/
case '0': case '1': case '2': case '3': case '4':
case '5': case '6': case '7': case '8': case '9':
if (!(s=gt_num(s,&n,0))) {
bad: *p = 0;
return 1;
}
switch(*s)
{
default:
return(0);
case 'P':
case 'p': if(sign) n= -n; (void) op_gen(P,n,0,0); break;
case 'X':
case 'x': (void) op_gen(X,n,0,0); break;
case 'H':
case 'h':
sp = &f__syl[op_gen(H,n,0,0)];
sp->p2.s = s + 1;
s+=n;
break;
}
break;
case GLITCH:
case '"':
case '\'':
sp = &f__syl[op_gen(APOS,0,0,0)];
sp->p2.s = s;
if((*p = ap_end(s)) == NULL)
return(0);
return(1);
case 'T':
case 't':
if(*(s+1)=='l' || *(s+1) == 'L')
{ x=TL;
s++;
}
else if(*(s+1)=='r'|| *(s+1) == 'R')
{ x=TR;
s++;
}
else x=T;
if (!(s=gt_num(s+1,&n,0)))
goto bad;
s--;
(void) op_gen(x,n,0,0);
break;
case 'X':
case 'x': (void) op_gen(X,1,0,0); break;
case 'P':
case 'p': (void) op_gen(P,1,0,0); break;
}
s++;
*p=s;
return(1);
}
static
#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++)
{
default: break;
case 'E':
case 'e': x=1;
case 'G':
case 'g':
found=1;
if (!(s=gt_num(s,&w,0))) {
bad:
*p = 0;
return 1;
}
if(w==0) break;
if(*s=='.') {
if (!(s=gt_num(s+1,&d,0)))
goto bad;
}
else d=0;
if(*s!='E' && *s != 'e')
(void) op_gen(x==1?E:G,w,d,0); /* default is Ew.dE2 */
else {
if (!(s=gt_num(s+1,&e,0)))
goto bad;
(void) op_gen(x==1?EE:GE,w,d,e);
}
break;
case 'O':
case 'o':
i = O;
im = OM;
goto finish_I;
case 'Z':
case 'z':
i = Z;
im = ZM;
goto finish_I;
case 'L':
case 'l':
found=1;
if (!(s=gt_num(s,&w,0)))
goto bad;
if(w==0) break;
(void) op_gen(L,w,0,0);
break;
case 'A':
case 'a':
found=1;
skip(s);
if(*s>='0' && *s<='9')
{ s=gt_num(s,&w,1);
if(w==0) break;
(void) op_gen(AW,w,0,0);
break;
}
(void) op_gen(A,0,0,0);
break;
case 'F':
case 'f':
if (!(s=gt_num(s,&w,0)))
goto bad;
found=1;
if(w==0) break;
if(*s=='.') {
if (!(s=gt_num(s+1,&d,0)))
goto bad;
}
else d=0;
(void) op_gen(F,w,d,0);
break;
case 'D':
case 'd':
found=1;
if (!(s=gt_num(s,&w,0)))
goto bad;
if(w==0) break;
if(*s=='.') {
if (!(s=gt_num(s+1,&d,0)))
goto bad;
}
else d=0;
(void) op_gen(D,w,d,0);
break;
case 'I':
case 'i':
i = I;
im = IM;
finish_I:
if (!(s=gt_num(s,&w,0)))
goto bad;
found=1;
if(w==0) break;
if(*s!='.')
{ (void) op_gen(i,w,0,0);
break;
}
if (!(s=gt_num(s+1,&d,0)))
goto bad;
(void) op_gen(im,w,d,0);
break;
}
if(found==0)
{ f__pc--; /*unSTACK*/
*p=sv;
return(0);
}
*p=s;
return(1);
}
static
#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
#ifdef KR_headers
char *f_list(s) char *s;
#else
char *f_list(char *s)
#endif
{
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);
}
#ifdef KR_headers
pars_f(s) char *s;
#else
pars_f(char *s)
#endif
{
char *e;
f__parenlvl=f__revloc=f__pc=0;
if((e=f_s(s,0)) == NULL)
{
/* Try and delimit the format string. Parens within
hollerith and quoted strings have to match for this
to work, but it's probably adequate for most needs.
Note that this is needed because a valid CHARACTER
variable passed for FMT= can contain '(I)garbage',
where `garbage' is billions and billions of junk
characters, and it's up to the run-time library to
know where the format string ends by counting parens.
Meanwhile, still treat NUL byte as "hard stop", since
f2c still appends that at end of FORMAT-statement
strings. */
int level=0;
for (f__fmtlen=0;
((*s!=')') || (--level > 0))
&& (*s!='\0')
&& (f__fmtlen<80);
++s, ++f__fmtlen)
{
if (*s=='(')
++level;
}
if (*s==')')
++f__fmtlen;
return(-1);
}
f__fmtlen = e - s;
return(0);
}
#define STKSZ 10
int f__cnt[STKSZ],f__ret[STKSZ],f__cp,f__rp;
flag f__workdone, f__nonl;
static
#ifdef KR_headers
type_f(n)
#else
type_f(int n)
#endif
{
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))
{
default:
fprintf(stderr,"unknown code in do_fio: %d\n%.*s\n",
p->op,f__fmtlen,f__fmtbuf);
err(f__elist->cierr,100,"do_fio");
case NED:
if((*f__doned)(p))
{ f__pc++;
goto loop;
}
f__pc++;
continue;
case ED:
if(f__cnt[f__cp]<=0)
{ f__cp--;
f__pc++;
goto loop;
}
if(ptr==NULL)
return((*f__doend)());
f__cnt[f__cp]--;
f__workdone=1;
if((n=(*f__doed)(p,ptr,len))>0)
errfl(f__elist->cierr,errno,"fmt");
if(n<0)
err(f__elist->ciend,(EOF),"fmt");
continue;
case STACK:
f__cnt[++f__cp]=p->p1;
f__pc++;
goto loop;
case RET1:
f__ret[++f__rp]=p->p1;
f__pc++;
goto loop;
case GOTO:
if(--f__cnt[f__cp]<=0)
{ f__cp--;
f__rp--;
f__pc++;
goto loop;
}
f__pc=1+f__ret[f__rp--];
goto loop;
case REVERT:
f__rp=f__cp=0;
f__pc = p->p1;
if(ptr==NULL)
return((*f__doend)());
if(!f__workdone) return(0);
if((n=(*f__dorevert)()) != 0) return(n);
goto loop;
case COLON:
if(ptr==NULL)
return((*f__doend)());
f__pc++;
goto loop;
case NONL:
f__nonl = 1;
f__pc++;
goto loop;
case S:
case SS:
f__cplus=0;
f__pc++;
goto loop;
case SP:
f__cplus = 1;
f__pc++;
goto loop;
case P: f__scale=p->p1;
f__pc++;
goto loop;
case BN:
f__cblank=0;
f__pc++;
goto loop;
case BZ:
f__cblank=1;
f__pc++;
goto loop;
}
}
return(0);
}
en_fio(Void)
{ ftnint one=1;
return(do_fio(&one,(char *)NULL,(ftnint)0));
}
VOID
fmt_bg(Void)
{
f__workdone=f__cp=f__rp=f__pc=f__cursor=0;
f__cnt[0]=f__ret[0]=0;
}
struct syl
{ int op;
int p1;
union { int i[2]; char *s;} p2;
};
#define RET1 1
#define REVERT 2
#define GOTO 3
#define X 4
#define SLASH 5
#define STACK 6
#define I 7
#define ED 8
#define NED 9
#define IM 10
#define APOS 11
#define H 12
#define TL 13
#define TR 14
#define T 15
#define COLON 16
#define S 17
#define SP 18
#define SS 19
#define P 20
#define BN 21
#define BZ 22
#define F 23
#define E 24
#define EE 25
#define D 26
#define G 27
#define GE 28
#define L 29
#define A 30
#define AW 31
#define O 32
#define NONL 33
#define OM 34
#define Z 35
#define ZM 36
extern int f__pc,f__parenlvl,f__revloc;
typedef union
{ real pf;
doublereal pd;
} ufloat;
typedef union
{ short is;
#ifndef KR_headers
signed
#endif
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
}
#endif
#endif
extern flag f__cblank,f__cplus,f__workdone, f__nonl;
extern char *f__fmtbuf;
extern int f__fmtlen;
extern int f__scale;
#define GET(x) if((x=(*f__getn)())<0) return(x)
#define VAL(x) (x!='\n'?x:' ')
#define PUT(x) (*f__putn)(x)
extern int f__cursor;
#undef TYQUAD
#ifndef Allow_TYQUAD
#undef longint
#define longint long
#else
#define TYQUAD 14
#endif
#ifdef KR_headers
extern char *f__icvt();
#else
extern char *f__icvt(longint, int*, int*, int);
#endif
/* @(#)fmtlib.c 1.2 */
#define MAXINTLENGTH 23
#include "f2c.h"
#ifndef Allow_TYQUAD
#undef longint
#define longint long
#undef ulongint
#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
{
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];
}
#define FMAX 40
#define EXPMAXDIGS 8
#define EXPMAX 99999999
/* FMAX = max number of nonzero digits passed to atof() */
/* EXPMAX = 10^EXPMAXDIGS - 1 = largest allowed exponent absolute value */
#ifdef V10 /* Research Tenth-Edition Unix */
#include "local.h"
#endif
/* MAXFRACDIGS and MAXINTDIGS are for wrt_F -- bounds (not necessarily
tight) on the maximum number of digits to the right and left of
* the decimal point.
*/
#ifdef VAX
#define MAXFRACDIGS 56
#define MAXINTDIGS 38
#else
#ifdef CRAY
#define MAXFRACDIGS 9880
#define MAXINTDIGS 9864
#else
/* values that suffice for IEEE double */
#define MAXFRACDIGS 344
#define MAXINTDIGS 308
#endif
#endif
#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
{
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
{
FILE *f;
return (f = unit_chk(*Unit, "ftell")) ? 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
{
FILE *f;
int w = (int)*xwhence;
#ifdef SEEK_SET
static int wohin[3] = { SEEK_SET, SEEK_CUR, SEEK_END };
#endif
if (w < 0 || w > 2)
w = 0;
#ifdef SEEK_SET
w = wohin[w];
#endif
return !(f = unit_chk(*Unit, "fseek"))
|| fseek(f, *offset, w) ? 1 : 0;
}
#include "f2c.h"
#include "fio.h"
#include "fmt.h"
extern char *f__icptr;
char *f__icend;
extern icilist *f__svic;
int f__icnum;
extern int f__hiwater;
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';
}
#ifdef KR_headers
z_putc(c)
#else
z_putc(int c)
#endif
{
if(f__icptr >= f__icend) err(f__svic->icierr,110,"inwrite");
if(f__recpos++ < f__svic->icirlen)
*f__icptr++ = c;
else err(f__svic->icierr,110,"recend");
return 0;
}
z_rnew(Void)
{
f__icptr = f__svic->iciunit + (++f__icnum)*f__svic->icirlen;
f__recpos = 0;
f__cursor = 0;
f__hiwater = 0;
return 1;
}
static int
z_endp(Void)
{
(*f__donewrec)();
return 0;
}
#ifdef KR_headers
c_si(a) icilist *a;
#else
c_si(icilist *a)
#endif
{
if (f__init & 2)
f__fatal (131, "I/O recursion");
f__init |= 2;
f__elist = (cilist *)a;
f__fmtbuf=a->icifmt;
if(pars_f(f__fmtbuf)<0)
err(a->icierr,100,"startint");
fmt_bg();
f__sequential=f__formatted=1;
f__external=0;
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__curunit = 0;
f__cf = 0;
return(0);
}
int
iw_rev(Void)
{
if(f__workdone)
z_endp();
f__hiwater = f__recpos = f__cursor = 0;
return(f__workdone=0);
}
#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);
}
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;
}
#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 e_rsfi(Void)
{ int n;
f__init &= ~2;
n = en_fio();
f__fmtbuf = NULL;
return(n);
}
integer e_wsfi(Void)
{
int n;
f__init &= ~2;
n = en_fio();
f__fmtbuf = NULL;
if(f__icnum >= f__svic->icirnum
|| !f__recpos && f__icnum)
return(n);
while(f__recpos++ < f__svic->icirlen)
*f__icptr++ = ' ';
return(n);
}
#include "f2c.h"
#include "fio.h"
#include "lio.h"
extern char *f__icptr;
extern char *f__icend;
extern icilist *f__svic;
extern int f__icnum;
#ifdef KR_headers
extern int z_putc();
#else
extern int z_putc(int);
#endif
static int
z_wSL(Void)
{
while(f__recpos < f__svic->icirlen)
z_putc(' ');
return z_rnew();
}
VOID
#ifdef KR_headers
c_liw(a) icilist *a;
#else
c_liw(icilist *a)
#endif
{
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
{
cilist ca;
if(f__init != 1) f_init();
f__init = 3;
c_liw(a);
ca.cifmt = a->icifmt;
x_wsne(&ca);
z_wSL();
return 0;
}
integer
#ifdef KR_headers
s_wsli(a) icilist *a;
#else
s_wsli(icilist *a)
#endif
{
if(f__init != 1) f_init();
f__init = 3;
f__lioproc = l_write;
c_liw(a);
return(0);
}
integer e_wsli(Void)
{
f__init = 1;
z_wSL();
return(0);
}
#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);
#ifdef NON_UNIX_STDIO
x = access(buf,0) ? -1 : 0;
for(i=0,p=NULL;i<MXUNIT;i++)
if(f__units[i].ufd != NULL
&& f__units[i].ufnm != NULL
&& !strcmp(f__units[i].ufnm,buf)) {
p = &f__units[i];
break;
}
#else
x=f__inode(buf, &n);
for(i=0,p=NULL;i<MXUNIT;i++)
if(f__units[i].uinode==x
&& f__units[i].ufd!=NULL
&& f__units[i].udev == n) {
p = &f__units[i];
break;
}
#endif
}
else
{
byfile=0;
if(a->inunit<MXUNIT && a->inunit>=0)
{
p= &f__units[a->inunit];
}
else
{
p=NULL;
}
}
if(a->inex!=NULL)
if(byfile && x != -1 || !byfile && p!=NULL)
*a->inex=1;
else *a->inex=0;
if(a->inopen!=NULL)
if(byfile) *a->inopen=(p!=NULL);
else *a->inopen=(p!=NULL && p->ufd!=NULL);
if(a->innum!=NULL) *a->innum= p-f__units;
if(a->innamed!=NULL)
if(byfile || p!=NULL && p->ufnm!=NULL)
*a->innamed=1;
else *a->innamed=0;
if(a->inname!=NULL)
if(byfile)
b_char(buf,a->inname,a->innamlen);
else if(p!=NULL && p->ufnm!=NULL)
b_char(p->ufnm,a->inname,a->innamlen);
if(a->inacc!=NULL && p!=NULL && p->ufd!=NULL)
if(p->url)
b_char("DIRECT",a->inacc,a->inacclen);
else b_char("SEQUENTIAL",a->inacc,a->inacclen);
if(a->inseq!=NULL)
if(p!=NULL && p->url)
b_char("NO",a->inseq,a->inseqlen);
else b_char("YES",a->inseq,a->inseqlen);
if(a->indir!=NULL)
if(p==NULL || p->url)
b_char("YES",a->indir,a->indirlen);
else b_char("NO",a->indir,a->indirlen);
if(a->infmt!=NULL)
if(p!=NULL && p->ufmt==0)
b_char("UNFORMATTED",a->infmt,a->infmtlen);
else b_char("FORMATTED",a->infmt,a->infmtlen);
if(a->inform!=NULL)
if(p!=NULL && p->ufmt==0)
b_char("NO",a->inform,a->informlen);
else b_char("YES",a->inform,a->informlen);
if(a->inunf)
if(p!=NULL && p->ufmt==0)
b_char("YES",a->inunf,a->inunflen);
else if (p!=NULL) b_char("NO",a->inunf,a->inunflen);
else b_char("UNKNOWN",a->inunf,a->inunflen);
if(a->inrecl!=NULL && p!=NULL)
*a->inrecl=p->url;
if(a->innrec!=NULL && p!=NULL && p->url>0)
*a->innrec=ftell(p->ufd)/p->url+1;
if(a->inblank && p!=NULL && p->ufmt)
if(p->ublnk)
b_char("ZERO",a->inblank,a->inblanklen);
else b_char("NULL",a->inblank,a->inblanklen);
return(0);
}
/* copy of ftypes from the compiler */
/* variable types
* numeric assumptions:
* int < reals < complexes
* TYDREAL-TYREAL = TYDCOMPLEX-TYCOMPLEX
*/
/* 0-10 retain their old (pre LOGICAL*1, etc.) */
/* values to allow mixing old and new objects. */
#define TYUNKNOWN 0
#define TYADDR 1
#define TYSHORT 2
#define TYLONG 3
#define TYREAL 4
#define TYDREAL 5
#define TYCOMPLEX 6
#define TYDCOMPLEX 7
#define TYLOGICAL 8
#define TYCHAR 9
#define TYSUBR 10
#define TYINT1 11
#define TYLOGICAL1 12
#define TYLOGICAL2 13
#ifdef Allow_TYQUAD
#undef TYQUAD
#define TYQUAD 14
#endif
#define LINTW 24
#define LINE 80
#define LLOGW 2
#ifdef Old_list_output
#define LLOW 1.0
#define LHIGH 1.e9
#define LEFMT " %# .8E"
#define LFFMT " %# .9g"
#else
#define LGFMT "%.9G"
#endif
/* LEFBL 20 should suffice; 24 overcomes a NeXT bug. */
#define LEFBL 24
typedef union
{
char flchar;
short flshort;
ftnint flint;
#ifdef Allow_TYQUAD
longint fllongint;
#endif
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 ftnint L_len;
#include <ctype.h>
#include "f2c.h"
#include "fio.h"
/* Compile with -DF8X_NML_ELIDE_QUOTES to permit eliding quotation */
/* marks in namelist input a la the Fortran 8X Draft published in */
/* the May 1989 issue of Fortran Forum. */
extern char *f__fmtbuf;
extern int f__fmtlen;
#ifdef Allow_TYQUAD
static longint f__llx;
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>
int (*f__lioproc)(ftnint*, char*, ftnlen, ftnint), (*l_getc)(void),
(*l_ungetc)(int,FILE*);
#endif
#include "fmt.h"
#include "lio.h"
#include "fp.h"
int l_eof;
#define isblnk(x) (f__ltab[x+1]&B)
#define issep(x) (f__ltab[x+1]&SX)
#define isapos(x) (f__ltab[x+1]&AX)
#define isexp(x) (f__ltab[x+1]&EX)
#define issign(x) (f__ltab[x+1]&SG)
#define iswhit(x) (f__ltab[x+1]&WH)
#define SX 1
#define B 2
#define AX 4
#define EX 8
#define SG 16
#define WH 32
char f__ltab[128+1] = { /* offset one for EOF */
0,
0,0,AX,0,0,0,0,0,0,WH|B,SX|WH,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
SX|B|WH,0,AX,0,0,0,0,AX,0,0,0,SG,SX,SG,0,SX,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,EX,EX,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
AX,0,0,0,EX,EX,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
};
#ifdef ungetc
static int
#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); }
#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
#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);
}
integer e_rsle(Void)
{
int ch;
f__init = 1;
if(f__curunit->uend) return(0);
while((ch=t_getc())!='\n')
if (ch == EOF) {
if(feof(f__cf))
f__curunit->uend = l_eof = 1;
return EOF;
}
return(0);
}
flag f__lquit;
int f__lcount,f__ltype,nml_read;
char *f__lchar;
double f__lx,f__ly;
#define ERR(x) if(n=(x)) {f__init &= ~2; return(n);}
#define GETC(x) (x=(*l_getc)())
#define Ungetc(x,y) (*l_ungetc)(x,y)
#ifdef KR_headers
l_R(poststar) int poststar;
#else
l_R(int poststar)
#endif
{
char s[FMAX+EXPMAXDIGS+4];
register int ch;
register char *sp, *spe, *sp1;
long e, exp;
int havenum, havestar, se;
if (!poststar) {
if (f__lcount > 0)
return(0);
f__lcount = 1;
}
#ifdef Allow_TYQUAD
f__llx = 0;
#endif
f__ltype = 0;
exp = 0;
havestar = 0;
retry:
sp1 = sp = s;
spe = sp + FMAX;
havenum = 0;
switch(GETC(ch)) {
case '-': *sp++ = ch; sp1++; spe++;
case '+':
GETC(ch);
}
while(ch == '0') {
++havenum;
GETC(ch);
}
while(isdigit(ch)) {
if (sp < spe) *sp++ = ch;
else ++exp;
GETC(ch);
}
if (ch == '*' && !poststar) {
if (sp == sp1 || exp || *s == '-') {
errfl(f__elist->cierr,112,"bad repetition count");
}
poststar = havestar = 1;
*sp = 0;
f__lcount = atoi(s);
goto retry;
}
if (ch == '.') {
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 (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 (quad_read && (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
#ifdef KR_headers
rd_count(ch) register int ch;
#else
rd_count(register int ch)
#endif
{
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;
}
l_C(Void)
{ int ch, nml_save;
double lz;
if(f__lcount>0) return(0);
f__ltype=0;
GETC(ch);
if(ch!='(')
{
if (nml_read > 1 && (ch < '0' || ch > '9')) {
Ungetc(ch,f__cf);
f__lquit = 2;
return 0;
}
if (rd_count(ch))
if(!f__cf || !feof(f__cf))
errfl(f__elist->cierr,112,"complex format");
else
err(f__elist->cierr,(EOF),"lread");
if(GETC(ch)!='*')
{
if(!f__cf || !feof(f__cf))
errfl(f__elist->cierr,112,"no star");
else
err(f__elist->cierr,(EOF),"lread");
}
if(GETC(ch)!='(')
{ Ungetc(ch,f__cf);
return(0);
}
}
else
f__lcount = 1;
while(iswhit(GETC(ch)));
Ungetc(ch,f__cf);
nml_save = nml_read;
nml_read = 0;
if (ch = l_R(1))
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))
return ch;
if (!f__ltype)
errfl(f__elist->cierr,112,"no imaginary part");
while(iswhit(GETC(ch)));
if(ch!=')') errfl(f__elist->cierr,112,"no )");
f__ly = f__lx;
f__lx = lz;
#ifdef Allow_TYQUAD
f__llx = 0;
#endif
nml_read = nml_save;
return(0);
}
l_L(Void)
{
int ch;
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);
}
if(ch == '.') GETC(ch);
switch(ch)
{
case 't':
case 'T':
f__lx=1;
break;
case 'f':
case 'F':
f__lx=0;
break;
default:
if(isblnk(ch) || issep(ch) || ch==EOF)
{ (void) Ungetc(ch,f__cf);
return(0);
}
if (nml_read > 1) {
Ungetc(ch,f__cf);
f__lquit = 2;
return 0;
}
errfl(f__elist->cierr,112,"logical");
}
f__ltype=TYLONG;
while(!issep(GETC(ch)) && ch!=EOF);
(void) Ungetc(ch, f__cf);
return(0);
}
#define BUFSIZE 128
l_CHAR(Void)
{ int ch,size,i;
static char rafail[] = "realloc failure";
char quote,*p;
if(f__lcount>0) return(0);
f__ltype=0;
if(f__lchar!=NULL) free(f__lchar);
size=BUFSIZE;
p=f__lchar = (char *)malloc((unsigned int)size);
if(f__lchar == NULL)
errfl(f__elist->cierr,113,"no space");
GETC(ch);
if(isdigit(ch)) {
/* allow Fortran 8x-style unquoted string... */
/* either find a repetition count or the string */
f__lcount = ch - '0';
*p++ = ch;
for(i = 1;;) {
switch(GETC(ch)) {
case '*':
if (f__lcount == 0) {
f__lcount = 1;
#ifndef F8X_NML_ELIDE_QUOTES
if (nml_read)
goto no_quote;
#endif
goto noquote;
}
p = f__lchar;
goto have_lcount;
case ',':
case ' ':
case '\t':
case '\n':
case '/':
Ungetc(ch,f__cf);
/* no break */
case EOF:
f__lcount = 1;
f__ltype = TYCHAR;
return *p = 0;
}
if (!isdigit(ch)) {
f__lcount = 1;
#ifndef F8X_NML_ELIDE_QUOTES
if (nml_read) {
no_quote:
errfl(f__elist->cierr,112,
"undelimited character string");
}
#endif
goto noquote;
}
*p++ = ch;
f__lcount = 10*f__lcount + ch - '0';
if (++i == size) {
f__lchar = (char *)realloc(f__lchar,
(unsigned int)(size += BUFSIZE));
if(f__lchar == NULL)
errfl(f__elist->cierr,113,rafail);
p = f__lchar + i;
}
}
}
else (void) Ungetc(ch,f__cf);
have_lcount:
if(GETC(ch)=='\'' || ch=='"') quote=ch;
else if(isblnk(ch) || (issep(ch) && ch != '\n') || ch==EOF) {
Ungetc(ch,f__cf);
return 0;
}
#ifndef F8X_NML_ELIDE_QUOTES
else if (nml_read > 1) {
Ungetc(ch,f__cf);
f__lquit = 2;
return 0;
}
#endif
else {
/* Fortran 8x-style unquoted string */
*p++ = ch;
for(i = 1;;) {
switch(GETC(ch)) {
case ',':
case ' ':
case '\t':
case '\n':
case '/':
Ungetc(ch,f__cf);
/* no break */
case EOF:
f__ltype = TYCHAR;
return *p = 0;
}
noquote:
*p++ = ch;
if (++i == size) {
f__lchar = (char *)realloc(f__lchar,
(unsigned int)(size += BUFSIZE));
if(f__lchar == NULL)
errfl(f__elist->cierr,113,rafail);
p = f__lchar + i;
}
}
}
f__ltype=TYCHAR;
for(i=0;;)
{ while(GETC(ch)!=quote && ch!='\n'
&& ch!=EOF && ++i<size) *p++ = ch;
if(i==size)
{
newone:
f__lchar= (char *)realloc(f__lchar,
(unsigned int)(size += BUFSIZE));
if(f__lchar == NULL)
errfl(f__elist->cierr,113,rafail);
p=f__lchar+i-1;
*p++ = ch;
}
else if(ch==EOF) return(EOF);
else if(ch=='\n')
{ if(*(p-1) != '\\') continue;
i--;
p--;
if(++i<size) *p++ = ch;
else goto newone;
}
else if(GETC(ch)==quote)
{ if(++i<size) *p++ = ch;
else goto newone;
}
else
{ (void) Ungetc(ch,f__cf);
*p = 0;
return(0);
}
}
}
#ifdef KR_headers
c_le(a) cilist *a;
#else
c_le(cilist *a)
#endif
{
if(f__init != 1) f_init();
f__init = 3;
f__fmtbuf="list io";
f__fmtlen=7;
if(a->ciunit>=MXUNIT || a->ciunit<0)
err(a->cierr,101,"stler");
f__scale=f__recpos=0;
f__elist=a;
f__curunit = &f__units[a->ciunit];
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
{
#define Ptr ((flex *)ptr)
int i,n,ch;
doublereal *yy;
real *xx;
for(i=0;i<*number;i++)
{
if(f__lquit) return(0);
if(l_eof)
err(f__elist->ciend, EOF, "list in");
if(f__lcount == 0) {
f__ltype = 0;
for(;;) {
GETC(ch);
switch(ch) {
case EOF:
err(f__elist->ciend,(EOF),"list in");
case ' ':
case '\t':
case '\n':
continue;
case '/':
f__lquit = 1;
goto loopend;
case ',':
f__lcount = 1;
goto loopend;
default:
(void) Ungetc(ch, f__cf);
goto rddata;
}
}
}
rddata:
switch((int)type)
{
case TYINT1:
case TYSHORT:
case TYLONG:
case TYREAL:
case TYDREAL:
ERR(l_R(0));
break;
#ifdef TYQUAD
case TYQUAD:
quad_read = 1;
n = l_R(0);
quad_read = 0;
ERR(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=f__lx;
break;
#ifdef Allow_TYQUAD
case TYQUAD:
if (!(Ptr->fllongint = f__llx))
Ptr->fllongint = f__lx;
break;
#endif
case TYREAL:
Ptr->flreal=f__lx;
break;
case TYDREAL:
Ptr->fldouble=f__lx;
break;
case TYCOMPLEX:
xx=(real *)ptr;
*xx++ = f__lx;
*xx = f__ly;
break;
case TYDCOMPLEX:
yy=(doublereal *)ptr;
*yy++ = f__lx;
*yy = f__ly;
break;
case TYCHAR:
b_char(f__lchar,ptr,len);
break;
}
bump:
if(f__lcount>0) f__lcount--;
ptr += len;
if (nml_read)
nml_read++;
}
return(0);
#undef Ptr
}
#ifdef KR_headers
integer s_rsle(a) cilist *a;
#else
integer s_rsle(cilist *a)
#endif
{
int n;
if(n=c_le(a)) return(n);
f__reading=1;
f__external=1;
f__formatted=1;
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);
}
#include "f2c.h"
#include "fio.h"
#include "fmt.h"
#include "lio.h"
ftnint L_len;
int f__Aquote;
static VOID
donewrec(Void)
{
if (f__recpos)
(*f__donewrec)();
}
#ifdef KR_headers
t_putc(c)
#else
t_putc(int c)
#endif
{
f__recpos++;
putc(c,f__cf);
return(0);
}
static VOID
#ifdef KR_headers
lwrt_I(n) longint n;
#else
lwrt_I(longint n)
#endif
{
char *p;
int ndigit, sign;
p = f__icvt(n, &ndigit, &sign, 10);
if(f__recpos + ndigit >= L_len)
donewrec();
PUT(' ');
if (sign)
PUT('-');
while(*p)
PUT(*p++);
}
static VOID
#ifdef KR_headers
lwrt_L(n, len) ftnint n; ftnlen len;
#else
lwrt_L(ftnint n, ftnlen len)
#endif
{
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
{
int a;
char *p1, *pe;
a = 0;
pe = p + len;
if (f__Aquote) {
a = 3;
if (len > 1 && p[len-1] == ' ') {
while(--len > 1 && p[len-1] == ' ');
pe = p + len;
}
p1 = p;
while(p1 < pe)
if (*p1++ == '\'')
a++;
}
if(f__recpos+len+a >= L_len)
donewrec();
if (a
#ifndef OMIT_BLANK_CC
|| !f__recpos
#endif
)
PUT(' ');
if (a) {
PUT('\'');
while(p < pe) {
if (*p == '\'')
PUT('\'');
PUT(*p++);
}
PUT('\'');
}
else
while(p < pe)
PUT(*p++);
}
static int
#ifdef KR_headers
l_g(buf, n) char *buf; double n;
#else
l_g(char *buf, double n)
#endif
{
#ifdef Old_list_output
doublereal absn;
char *fmt;
absn = n;
if (absn < 0)
absn = -absn;
fmt = LLOW <= absn && absn < LHIGH ? LFFMT : LEFMT;
#ifdef USE_STRLEN
sprintf(buf, fmt, n);
return strlen(buf);
#else
return sprintf(buf, fmt, n);
#endif
#else
register char *b, c, c1;
b = buf;
*b++ = ' ';
if (n < 0) {
*b++ = '-';
n = -n;
}
else
*b++ = ' ';
if (n == 0) {
*b++ = '0';
*b++ = '.';
*b = 0;
goto f__ret;
}
sprintf(b, LGFMT, n);
switch(*b) {
#ifndef WANT_LEAD_0
case '0':
while(b[0] = b[1])
b++;
break;
#endif
case 'i':
case 'I':
/* Infinity */
case 'n':
case 'N':
/* NaN */
while(*++b);
break;
default:
/* Fortran 77 insists on having a decimal point... */
for(;; b++)
switch(*b) {
case 0:
*b++ = '.';
*b = 0;
goto f__ret;
case '.':
while(*++b);
goto f__ret;
case 'E':
for(c1 = '.', c = 'E'; *b = c1;
c1 = c, c = *++b);
goto f__ret;
}
}
f__ret:
return b - buf;
#endif
}
static VOID
#ifdef KR_headers
l_put(s) register char *s;
#else
l_put(register char *s)
#endif
{
#ifdef KR_headers
register int c, (*pn)() = f__putn;
#else
register int c, (*pn)(int) = f__putn;
#endif
while(c = *s++)
(*pn)(c);
}
static VOID
#ifdef KR_headers
lwrt_F(n) double n;
#else
lwrt_F(double n)
#endif
{
char buf[LEFBL];
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
{
char *ba, *bb, bufa[LEFBL], bufb[LEFBL];
int al, bl;
al = l_g(bufa, a);
for(ba = bufa; *ba == ' '; ba++)
--al;
bl = l_g(bufb, b) + 1; /* intentionally high by 1 */
for(bb = bufb; *bb == ' '; bb++)
--bl;
if(f__recpos + al + bl + 3 >= L_len)
donewrec();
#ifdef OMIT_BLANK_CC
else
#endif
PUT(' ');
PUT('(');
l_put(ba);
PUT(',');
if (f__recpos + bl >= L_len) {
(*f__donewrec)();
#ifndef OMIT_BLANK_CC
PUT(' ');
#endif
}
l_put(bb);
PUT(')');
}
#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
{
#define Ptr ((flex *)ptr)
int i;
longint x;
double y,z;
real *xx;
doublereal *yy;
for(i=0;i< *number; i++)
{
switch((int)type)
{
default: f__fatal(204,"unknown type in lio");
case TYINT1:
x = Ptr->flchar;
goto xint;
case TYSHORT:
x=Ptr->flshort;
goto xint;
#ifdef Allow_TYQUAD
case TYQUAD:
x = Ptr->fllongint;
goto xint;
#endif
case TYLONG:
x=Ptr->flint;
xint: lwrt_I(x);
break;
case TYREAL:
y=Ptr->flreal;
goto xfloat;
case TYDREAL:
y=Ptr->fldouble;
xfloat: lwrt_F(y);
break;
case TYCOMPLEX:
xx= &Ptr->flreal;
y = *xx++;
z = *xx;
goto xcomplex;
case TYDCOMPLEX:
yy = &Ptr->fldouble;
y= *yy++;
z = *yy;
xcomplex:
lwrt_C(y,z);
break;
case TYLOGICAL1:
x = Ptr->flchar;
goto xlog;
case TYLOGICAL2:
x = Ptr->flshort;
goto xlog;
case TYLOGICAL:
x = Ptr->flint;
xlog: lwrt_L(Ptr->flint, len);
break;
case TYCHAR:
lwrt_A(ptr,len);
break;
}
ptr += len;
}
return(0);
}
.SUFFIXES: .c .o
CC = cc
CFLAGS = -O
SHELL = /bin/sh
# compile, then strip unnecessary symbols
.c.o:
$(CC) -c -DSkip_f2c_Undefs $(CFLAGS) $*.c
ld -r -x -o $*.xxx $*.o
mv $*.xxx $*.o
## Under Solaris (and other systems that do not understand ld -x),
## omit -x in the ld line above.
## If your system does not have the ld command, comment out
## or remove both the ld and mv lines above.
OBJ = Version.o backspace.o close.o dfe.o dolio.o due.o endfile.o err.o \
fmt.o fmtlib.o ftell_.o iio.o ilnw.o inquire.o lread.o lwrite.o \
open.o rdfmt.o rewind.o rsfe.o rsli.o rsne.o sfe.o sue.o typesize.o \
uio.o util.o wref.o wrtfmt.o wsfe.o wsle.o wsne.o xwsne.o
libI77.a: $(OBJ)
ar r libI77.a $?
-ranlib libI77.a
### If your system lacks ranlib, you don't need it; see README.
install: libI77.a
cp libI77.a /usr/lib/libI77.a
ranlib /usr/lib/libI77.a
Version.o: Version.c
$(CC) -c Version.c
# To compile with C++, first "make f2c.h"
f2c.h: f2ch.add
cat /usr/include/f2c.h f2ch.add >f2c.h
clean:
rm -f $(OBJ) libI77.a
clobber: clean
rm -f libI77.a
backspace.o: fio.h
close.o: fio.h
dfe.o: fio.h
dfe.o: fmt.h
due.o: fio.h
endfile.o: fio.h rawio.h
err.o: fio.h rawio.h
fmt.o: fio.h
fmt.o: fmt.h
ftell_.o: fio.h
iio.o: fio.h
iio.o: fmt.h
ilnw.o: fio.h
ilnw.o: lio.h
inquire.o: fio.h
lread.o: fio.h
lread.o: fmt.h
lread.o: lio.h
lread.o: fp.h
lwrite.o: fio.h
lwrite.o: fmt.h
lwrite.o: lio.h
open.o: fio.h rawio.h
rdfmt.o: fio.h
rdfmt.o: fmt.h
rdfmt.o: fp.h
rewind.o: fio.h
rsfe.o: fio.h
rsfe.o: fmt.h
rsli.o: fio.h
rsli.o: lio.h
rsne.o: fio.h
rsne.o: lio.h
sfe.o: fio.h
sue.o: fio.h
uio.o: fio.h
util.o: fio.h
wref.o: fio.h
wref.o: fmt.h
wref.o: fp.h
wrtfmt.o: fio.h
wrtfmt.o: fmt.h
wsfe.o: fio.h
wsfe.o: fmt.h
wsle.o: fio.h
wsle.o: fmt.h
wsle.o: lio.h
wsne.o: fio.h
wsne.o: lio.h
xwsne.o: fio.h
xwsne.o: lio.h
xwsne.o: fmt.h
check:
xsum Notice README Version.c backspace.c close.c dfe.c dolio.c \
due.c endfile.c err.c f2ch.add fio.h fmt.c fmt.h fmtlib.c fp.h \
ftell_.c iio.c ilnw.c inquire.c lio.h lread.c lwrite.c makefile \
open.c rawio.h rdfmt.c rewind.c rsfe.c rsli.c rsne.c sfe.c sue.c \
typesize.c uio.c util.c wref.c wrtfmt.c wsfe.c wsle.c wsne.c \
xwsne.c >zap
cmp zap libI77.xsum && rm zap || diff libI77.xsum zap
#ifndef NON_UNIX_STDIO
#include <sys/types.h>
#include <sys/stat.h>
#endif
#include "f2c.h"
#include "fio.h"
#include <string.h>
#include "rawio.h"
#ifdef KR_headers
extern char *malloc(), *mktemp();
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
#ifdef NON_ANSI_RW_MODES
char *f__r_mode[2] = {"r", "r"};
char *f__w_mode[4] = {"w", "w", "r+w", "r+w"};
#else
char *f__r_mode[2] = {"rb", "r"};
char *f__w_mode[4] = {"wb", "w", "r+b", "r+"};
#endif
#ifdef KR_headers
f__isdev(s) char *s;
#else
f__isdev(char *s)
#endif
{
#ifdef NON_UNIX_STDIO
int i, j;
i = open(s,O_RDONLY);
if (i == -1)
return 0;
j = isatty(i);
close(i);
return j;
#else
struct stat x;
if(stat(s, &x) == -1) return(0);
#ifdef S_IFMT
switch(x.st_mode&S_IFMT) {
case S_IFREG:
case S_IFDIR:
return(0);
}
#else
#ifdef S_ISREG
/* POSIX version */
if(S_ISREG(x.st_mode) || S_ISDIR(x.st_mode))
return(0);
else
#else
Help! How does stat work on this system?
#endif
#endif
return(1);
#endif
}
#ifdef KR_headers
integer f_open(a) olist *a;
#else
integer f_open(olist *a)
#endif
{ unit *b;
integer rv;
char buf[256], *s;
cllist x;
int ufmt;
#ifdef NON_UNIX_STDIO
FILE *tf;
#else
int n;
struct stat stb;
#endif
if(f__init != 1) f_init();
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, b->ufnm, (unsigned)a->ofnmlen))
goto same;
#else
g_char(a->ofnm,a->ofnmlen,buf);
if (f__inode(buf,&n) == b->uinode && n == b->udev)
goto same;
#endif
x.cunit=a->ounit;
x.csta=0;
x.cerr=a->oerr;
if ((rv = f_clos(&x)) != 0)
return rv;
}
b->url = (int)a->orl;
b->ublnk = a->oblnk && (*a->oblnk == 'z' || *a->oblnk == 'Z');
if(a->ofm==0)
{ if(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;
#ifdef url_Adjust
if (b->url && !ufmt)
url_Adjust(b->url);
#endif
if (a->ofnm) {
g_char(a->ofnm,a->ofnmlen,buf);
if (!buf[0])
err(a->oerr,107,"open");
}
else
sprintf(buf, "fort.%ld", a->ounit);
b->uscrtch = 0;
switch(a->osta ? *a->osta : 'u')
{
case 'o':
case 'O':
#ifdef NON_UNIX_STDIO
if(access(buf,0))
#else
if(stat(buf,&stb))
#endif
err(a->oerr,errno,"open");
break;
case 's':
case 'S':
b->uscrtch=1;
#ifdef _POSIX_SOURCE
tmpnam(buf);
#else
(void) strcpy(buf,"tmp.FXXXXXX");
(void) mktemp(buf);
#endif
goto replace;
case 'n':
case 'N':
#ifdef NON_UNIX_STDIO
if(!access(buf,0))
#else
if(!stat(buf,&stb))
#endif
err(a->oerr,128,"open");
/* no break */
case 'r': /* Fortran 90 replace option */
case 'R':
replace:
#ifdef NON_UNIX_STDIO
if (tf = fopen(buf,f__w_mode[0]))
fclose(tf);
#else
(void) close(creat(buf, 0666));
#endif
}
b->ufnm=(char *) malloc((unsigned int)(strlen(buf)+1));
if(b->ufnm==NULL) err(a->oerr,113,"no space");
(void) strcpy(b->ufnm,buf);
b->uend=0;
b->uwrt = 0;
#ifdef NON_UNIX_STDIO
if ((s = a->oacc) && (*s == 'd' || *s == 'D'))
ufmt = 0;
#endif
if(f__isdev(buf))
{ b->ufd = fopen(buf,f__r_mode[ufmt]);
if(b->ufd==NULL) err(a->oerr,errno,buf);
}
else {
if(!(b->ufd = fopen(buf, f__r_mode[ufmt]))) {
#ifdef NON_UNIX_STDIO
if (b->ufd = fopen(buf, f__w_mode[ufmt|2]))
b->uwrt = 2;
else if (b->ufd = fopen(buf, f__w_mode[ufmt]))
b->uwrt = 1;
else
#else
if ((n = open(buf,O_WRONLY)) >= 0)
b->uwrt = 2;
else {
n = creat(buf, 0666);
b->uwrt = 1;
}
if (n < 0
|| (b->ufd = fdopen(n, f__w_mode[ufmt])) == NULL)
#endif
err(a->oerr, errno, "open");
}
}
b->useek=f__canseek(b->ufd);
#ifndef NON_UNIX_STDIO
if((b->uinode=f__inode(buf,&b->udev))==-1)
err(a->oerr,108,"open");
#endif
if(b->useek)
if (a->orl)
rewind(b->ufd);
else if ((s = a->oacc) && (*s == 'a' || *s == 'A')
&& fseek(b->ufd, 0L, SEEK_END))
err(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",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;
}
#ifdef KR_headers
extern FILE *fdopen();
#else
#if defined (MSDOS) && !defined (GO32)
#include "io.h"
#ifndef WATCOM
#define close _close
#define creat _creat
#define open _open
#define read _read
#define write _write
#endif /*WATCOM*/
#endif /*MSDOS*/
#ifdef __cplusplus
extern "C" {
#endif
#if !(defined (MSDOS) && !defined (GO32))
#ifdef OPEN_DECL
extern int creat(const char*,int), open(const char*,int);
#endif
extern int close(int);
#if !(defined(_WIN32) && !defined(__CYGWIN32__))
extern int read(int,void*,size_t), write(int,void*,size_t);
#endif
extern int unlink(const char*);
#ifndef _POSIX_SOURCE
#ifndef NON_UNIX_STDIO
extern FILE *fdopen(int, const char*);
#endif
#endif
#endif /*KR_HEADERS*/
extern char *mktemp(char*);
#ifdef __cplusplus
}
#endif
#endif
#ifndef NO_FCNTL
#include <fcntl.h>
#endif
#ifndef O_WRONLY
#define O_RDONLY 0
#define O_WRONLY 1
#endif
#include <ctype.h>
#include "f2c.h"
#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
{
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;
}
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
{ longint x;
int sign,ch;
char s[84], *ps;
ps=s; x=0;
while (w)
{
GET(ch);
if (ch==',' || ch=='\n') break;
*ps=ch; ps++; w--;
}
*ps='\0';
ps=s;
while (*ps==' ') ps++;
if (*ps=='-') { sign=1; ps++; }
else { sign=0; if (*ps=='+') ps++; }
loop: while (*ps>='0' && *ps<='9') { x=x*base+(*ps-'0'); ps++; }
if (*ps==' ') {if (f__cblank) x *= base; ps++; goto loop;}
if(sign) x = -x;
if(len==sizeof(integer)) n->il=x;
else if(len == sizeof(char)) n->ic = (char)x;
#ifdef Allow_TYQUAD
else if (len == sizeof(longint)) n->ili = x;
#endif
else n->is = (short)x;
if (*ps) return(errno=115); else 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, lv;
char s[84], *ps;
ps=s;
while (w) {
GET(ch);
if (ch==','||ch=='\n') break;
*ps=ch;
ps++; w--;
}
*ps='\0';
ps=s; while (*ps==' ') ps++;
if (*ps=='.') ps++;
if (*ps=='t' || *ps == 'T')
lv = 1;
else if (*ps == 'f' || *ps == 'F')
lv = 0;
else return(errno=116);
switch(len) {
case sizeof(char): *(char *)n = (char)lv; break;
case sizeof(short): *(short *)n = (short)lv; break;
default: *n = lv;
}
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
{
char s[FMAX+EXPMAXDIGS+4];
register int ch;
register char *sp, *spe, *sp1;
double x;
int scale1, se;
long e, exp;
sp1 = sp = s;
spe = sp + FMAX;
exp = -d;
x = 0.;
do {
GET(ch);
w--;
} while (ch == ' ' && w);
switch(ch) {
case '-': *sp++ = ch; sp1++; spe++;
case '+':
if (!w) goto zero;
--w;
GET(ch);
}
while(ch == ' ') {
blankdrop:
if (!w--) goto zero; GET(ch); }
while(ch == '0')
{ if (!w--) goto zero; GET(ch); }
if (ch == ' ' && f__cblank)
goto blankdrop;
scale1 = f__scale;
while(isdigit(ch)) {
digloop1:
if (sp < spe) *sp++ = ch;
else ++exp;
digloop1e:
if (!w--) goto done;
GET(ch);
}
if (ch == ' ') {
if (f__cblank)
{ ch = '0'; goto digloop1; }
goto digloop1e;
}
if (ch == '.') {
exp += d;
if (!w--) goto done;
GET(ch);
if (sp == sp1) { /* no digits yet */
while(ch == '0') {
skip01:
--exp;
skip0:
if (!w--) goto done;
GET(ch);
}
if (ch == ' ') {
if (f__cblank) goto skip01;
goto skip0;
}
}
while(isdigit(ch)) {
digloop2:
if (sp < spe)
{ *sp++ = ch; --exp; }
digloop2e:
if (!w--) goto done;
GET(ch);
}
if (ch == ' ') {
if (f__cblank)
{ ch = '0'; goto digloop2; }
goto digloop2e;
}
}
switch(ch) {
default:
break;
case '-': se = 1; goto signonly;
case '+': se = 0; goto signonly;
case 'e':
case 'E':
case 'd':
case 'D':
if (!w--)
goto bad;
GET(ch);
while(ch == ' ') {
if (!w--)
goto bad;
GET(ch);
}
se = 0;
switch(ch) {
case '-': se = 1;
case '+':
signonly:
if (!w--)
goto bad;
GET(ch);
}
while(ch == ' ') {
if (!w--)
goto bad;
GET(ch);
}
if (!isdigit(ch))
goto bad;
e = ch - '0';
for(;;) {
if (!w--)
{ ch = '\n'; break; }
GET(ch);
if (!isdigit(ch)) {
if (ch == ' ') {
if (f__cblank)
ch = '0';
else continue;
}
else
break;
}
e = 10*e + ch - '0';
if (e > EXPMAX && sp > sp1)
goto bad;
}
if (se)
exp -= e;
else
exp += e;
scale1 = 0;
}
switch(ch) {
case '\n':
case ',':
break;
default:
bad:
return (errno = 115);
}
done:
if (sp > sp1) {
while(*--sp == '0')
++exp;
if (exp -= scale1)
sprintf(sp+1, "e%ld", exp);
else
sp[1] = 0;
x = atof(s);
}
zero:
if (len == sizeof(real))
p->pf = x;
else
p->pd = x;
return(0);
}
static int
#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
#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);
}
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
#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);
}
#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)
(void) fseek(f__cf,(long) f__cursor,SEEK_CUR);
else
err(f__elist->cierr,106,"fmt");
f__recpos += f__cursor;
f__cursor=0;
}
switch(p->op)
{
default: fprintf(stderr,"rd_ed, unexpected code: %d\n", p->op);
sig_die(f__fmtbuf, 1);
case IM:
case I: ch = rd_I((Uint *)ptr,p->p1,len, 10);
break;
/* O and OM don't work right for character, double, complex, */
/* or doublecomplex, and they differ from Fortran 90 in */
/* showing a minus sign for negative values. */
case OM:
case O: ch = rd_I((Uint *)ptr, p->p1, len, 8);
break;
case L: ch = rd_L((ftnint *)ptr,p->p1,len);
break;
case A: ch = rd_A(ptr,len);
break;
case AW:
ch = rd_AW(ptr,p->p1,len);
break;
case E: case EE:
case D:
case G:
case GE:
case F: ch = rd_F((ufloat *)ptr,p->p1,p->p2.i[0],len);
break;
/* Z and ZM assume 8-bit bytes. */
case ZM:
case Z:
ch = rd_Z((Uint *)ptr, p->p1, len);
break;
}
if(ch == 0) return(ch);
else if(ch == EOF) return(EOF);
if (f__cf)
clearerr(f__cf);
return(errno);
}
#ifdef KR_headers
rd_ned(p) struct syl *p;
#else
rd_ned(struct syl *p)
#endif
{
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);
}
}
#include "f2c.h"
#include "fio.h"
#ifdef KR_headers
integer f_rew(a) alist *a;
#else
integer f_rew(alist *a)
#endif
{
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;
}
rewind(b->ufd);
b->uend=0;
return(0);
}
/* read sequential formatted external */
#include "f2c.h"
#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);
}
return(-1);
}
x_endp(Void)
{
xrd_SL();
return f__curunit->uend == 1 ? EOF : 0;
}
x_rev(Void)
{
(void) xrd_SL();
return(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;
if(n=c_sfe(a)) return(n);
f__reading=1;
f__sequential=1;
f__formatted=1;
f__external=1;
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);
}
#include "f2c.h"
#include "fio.h"
#include "lio.h"
#include "fmt.h" /* for f__doend */
extern flag f__lquit;
extern int f__lcount;
extern char *f__icptr;
extern char *f__icend;
extern icilist *f__svic;
extern int f__icnum, f__recpos;
static int i_getc(Void)
{
if(f__recpos >= f__svic->icirlen) {
if (f__recpos++ == f__svic->icirlen)
return '\n';
z_rnew();
}
f__recpos++;
if(f__icptr >= f__icend)
return EOF;
return(*f__icptr++);
}
static
#ifdef KR_headers
int i_ungetc(ch, f) int ch; FILE *f;
#else
int i_ungetc(int ch, FILE *f)
#endif
{
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
{
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
{
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; }
#ifdef KR_headers
integer s_rsni(a) icilist *a;
#else
extern int x_rsne(cilist*);
integer s_rsni(icilist *a)
#endif
{
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;
}
#include "f2c.h"
#include "fio.h"
#include "lio.h"
#define MAX_NL_CACHE 3 /* maximum number of namelist hash tables to cache */
#define MAXDIM 20 /* maximum number of subscripts */
struct dimen {
ftnlen extent;
ftnlen curval;
ftnlen delta;
ftnlen stride;
};
typedef struct dimen dimen;
struct hashentry {
struct hashentry *next;
char *name;
Vardesc *vd;
};
typedef struct hashentry hashentry;
struct hashtab {
struct hashtab *next;
Namelist *nl;
int htsize;
hashentry *tab[1];
};
typedef struct hashtab hashtab;
static hashtab *nl_cache;
static int n_nlcache;
static hashentry **zot;
static int colonseen;
extern ftnlen f__typesize[];
extern flag f__lquit;
extern int f__lcount, nml_read;
extern t_getc(Void);
#ifdef KR_headers
extern char *malloc(), *memset();
#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
#else
#undef abs
#undef min
#undef max
#include <stdlib.h>
#include <string.h>
#ifdef ungetc
static int
un_getc(int x, FILE *f__cf)
{ return ungetc(x,f__cf); }
#else
#define un_getc ungetc
extern int ungetc(int, FILE*); /* for systems with a buggy stdio.h */
#endif
#endif
static Vardesc *
#ifdef KR_headers
hash(ht, s) hashtab *ht; register char *s;
#else
hash(hashtab *ht, register char *s)
#endif
{
register int c, x;
register hashentry *h;
char *s0 = s;
for(x = 0; c = *s++; x = x & 0x4000 ? ((x << 1) & 0x7fff) + 1 : x << 1)
x += c;
for(h = *(zot = ht->tab + x % ht->htsize); h; h = h->next)
if (!strcmp(s0, h->name))
return h->vd;
return 0;
}
hashtab *
#ifdef KR_headers
mk_hashtab(nl) Namelist *nl;
#else
mk_hashtab(Namelist *nl)
#endif
{
int nht, nv;
hashtab *ht;
Vardesc *v, **vd, **vde;
hashentry *he;
hashtab **x, **x0, *y;
for(x = &nl_cache; y = *x; x0 = x, x = &y->next)
if (nl == y->nl)
return y;
if (n_nlcache >= MAX_NL_CACHE) {
/* discard least recently used namelist hash table */
y = *x0;
free((char *)y->next);
y->next = 0;
}
else
n_nlcache++;
nv = nl->nvars;
if (nv >= 0x4000)
nht = 0x7fff;
else {
for(nht = 1; nht < nv; nht <<= 1);
nht += nht - 1;
}
ht = (hashtab *)malloc(sizeof(hashtab) + (nht-1)*sizeof(hashentry *)
+ nv*sizeof(hashentry));
if (!ht)
return 0;
he = (hashentry *)&ht->tab[nht];
ht->nl = nl;
ht->htsize = nht;
ht->next = nl_cache;
nl_cache = ht;
memset((char *)ht->tab, 0, nht*sizeof(hashentry *));
vd = nl->vars;
vde = vd + nv;
while(vd < vde) {
v = *vd++;
if (!hash(ht, v->name)) {
he->next = *zot;
*zot = he;
he->name = v->name;
he->vd = v;
he++;
}
}
return ht;
}
static char Alpha[256], Alphanum[256];
static VOID
nl_init(Void) {
register char *s;
register int c;
for(s = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"; c = *s++; )
Alpha[c]
= Alphanum[c]
= Alpha[c + 'a' - 'A']
= Alphanum[c + 'a' - 'A']
= c;
for(s = "0123456789_"; c = *s++; )
Alphanum[c] = c;
}
#define GETC(x) (x=(*l_getc)())
#define Ungetc(x,y) (*l_ungetc)(x,y)
static int
#ifdef KR_headers
getname(s, slen) register char *s; int slen;
#else
getname(register char *s, int slen)
#endif
{
register char *se = s + slen - 1;
register int ch;
GETC(ch);
if (!(*s++ = Alpha[ch & 0xff])) {
if (ch != EOF)
ch = 115;
errfl(f__elist->cierr, ch, "namelist read");
}
while(*s = Alphanum[GETC(ch) & 0xff])
if (s < se)
s++;
if (ch == EOF)
err(f__elist->cierr, EOF, "namelist read");
if (ch > ' ')
Ungetc(ch,f__cf);
return *s = 0;
}
static int
#ifdef KR_headers
getnum(chp, val) int *chp; ftnlen *val;
#else
getnum(int *chp, ftnlen *val)
#endif
{
register int ch, sign;
register ftnlen x;
while(GETC(ch) <= ' ' && ch >= 0);
if (ch == '-') {
sign = 1;
GETC(ch);
}
else {
sign = 0;
if (ch == '+')
GETC(ch);
}
x = ch - '0';
if (x < 0 || x > 9)
return 115;
while(GETC(ch) >= '0' && ch <= '9')
x = 10*x + ch - '0';
while(ch <= ' ' && ch >= 0)
GETC(ch);
if (ch == EOF)
return EOF;
*val = sign ? -x : x;
*chp = ch;
return 0;
}
static int
#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
{
register int k;
ftnlen x2, x3;
if (k = getnum(chp, x1))
return k;
x3 = 1;
if (*chp == ':') {
if (k = getnum(chp, &x2))
return k;
x2 -= *x1;
if (*chp == ':') {
if (k = getnum(chp, &x3))
return k;
if (!x3)
return 123;
x2 /= x3;
colonseen = 1;
}
if (x2 < 0 || x2 >= extent)
return 123;
d->extent = x2 + 1;
}
else
d->extent = 1;
d->curval = 0;
d->delta = delta;
d->stride = x3;
return 0;
}
#ifndef No_Namelist_Questions
static Void
#ifdef KR_headers
print_ne(a) cilist *a;
#else
print_ne(cilist *a)
#endif
{
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 ";
#ifdef KR_headers
x_rsne(a) cilist *a;
#else
x_rsne(cilist *a)
#endif
{
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, no1, nomax, size, span;
ftnint type;
char *vaddr;
long iva, ivae;
dimen dimens[MAXDIM], substr;
if (!Alpha['a'])
nl_init();
f__reading=1;
f__formatted=1;
got1 = 0;
top:
for(;;) switch(GETC(ch)) {
case EOF:
eof:
err(a->ciend,(EOF),where0);
case '&':
case '$':
goto have_amp;
#ifndef No_Namelist_Questions
case '?':
print_ne(a);
continue;
#endif
default:
if (ch <= ' ' && ch >= 0)
continue;
#ifndef No_Namelist_Comments
while(GETC(ch) != '\n')
if (ch == EOF)
goto eof;
#else
errfl(a->cierr, 115, where0);
#endif
}
have_amp:
if (ch = getname(buf,(int) sizeof(buf)))
return ch;
nl = (Namelist *)a->cifmt;
if (strcmp(buf, nl->name))
#ifdef No_Bad_Namelist_Skip
errfl(a->cierr, 118, where0);
#else
{
fprintf(stderr,
"Skipping namelist \"%s\": seeking namelist \"%s\".\n",
buf, nl->name);
fflush(stderr);
for(;;) switch(GETC(ch)) {
case EOF:
err(a->ciend, EOF, where0);
case '/':
case '&':
case '$':
if (f__external)
e_rsle();
else
z_rnew();
goto top;
case '"':
case '\'':
quote = ch;
more_quoted:
while(GETC(ch) != quote)
if (ch == EOF)
err(a->ciend, EOF, where0);
if (GETC(ch) == quote)
goto more_quoted;
Ungetc(ch,f__cf);
default:
continue;
}
}
#endif
ht = mk_hashtab(nl);
if (!ht)
errfl(f__elist->cierr, 113, where0);
for(;;) {
for(;;) switch(GETC(ch)) {
case EOF:
if (got1)
return 0;
err(a->ciend, EOF, where0);
case '/':
case '$':
case '&':
return 0;
default:
if (ch <= ' ' && ch >= 0 || ch == ',')
continue;
Ungetc(ch,f__cf);
if (ch = getname(buf,(int) 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;
iva += no1 * dn0->delta;
if (k = l_read(&no1, vaddr + iva,
size, type))
return k;
}
}
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
{
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();
}
/* sequential formatted external common routines*/
#include "f2c.h"
#include "fio.h"
extern char *f__fmtbuf;
integer e_rsfe(Void)
{ int n;
f__init = 1;
n=en_fio();
if (f__cf == stdout)
fflush(stdout);
else if (f__cf == stderr)
fflush(stderr);
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);
}
integer e_wsfe(Void)
{
#ifdef ALWAYS_FLUSH
int n;
f__init = 1;
n = en_fio();
f__fmtbuf=NULL;
if (!n && fflush(f__cf))
err(f__elist->cierr, errno, "write end");
return n;
#else
return(e_rsfe());
#endif
}
#include "f2c.h"
#include "fio.h"
extern uiolen f__reclen;
long f__recloc;
#ifdef KR_headers
c_sue(a) cilist *a;
#else
c_sue(cilist *a)
#endif
{
if(a->ciunit >= MXUNIT || a->ciunit < 0)
err(a->cierr,101,"startio");
f__external=f__sequential=1;
f__formatted=0;
f__curunit = &f__units[a->ciunit];
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
{
int n;
if(f__init != 1) f_init();
f__init = 3;
f__reading=1;
if(n=c_sue(a)) return(n);
f__recpos=0;
if(f__curunit->uwrt && f__nowreading(f__curunit))
err(a->cierr, errno, "read start");
if(fread((char *)&f__reclen,sizeof(uiolen),1,f__cf)
!= 1)
{ if(feof(f__cf))
{ f__curunit->uend = 1;
err(a->ciend, EOF, "start");
}
clearerr(f__cf);
err(a->cierr, errno, "start");
}
return(0);
}
#ifdef KR_headers
integer s_wsue(a) cilist *a;
#else
integer s_wsue(cilist *a)
#endif
{
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);
(void) fseek(f__cf,(long)sizeof(uiolen),SEEK_CUR);
return(0);
}
integer e_wsue(Void)
{ long loc;
f__init = 1;
fwrite((char *)&f__reclen,sizeof(uiolen),1,f__cf);
#ifdef ALWAYS_FLUSH
if (fflush(f__cf))
err(f__elist->cierr, errno, "write end");
#endif
loc=ftell(f__cf);
fseek(f__cf,f__recloc,SEEK_SET);
fwrite((char *)&f__reclen,sizeof(uiolen),1,f__cf);
fseek(f__cf,loc,SEEK_SET);
return(0);
}
integer e_rsue(Void)
{
f__init = 1;
(void) fseek(f__cf,(long)(f__reclen-f__recpos+sizeof(uiolen)),SEEK_CUR);
return(0);
}
#include "f2c.h"
ftnlen f__typesize[] = { 0, 0, sizeof(shortint), sizeof(integer),
sizeof(real), sizeof(doublereal),
sizeof(complex), sizeof(doublecomplex),
sizeof(logical), sizeof(char),
0, sizeof(integer1),
sizeof(logical1), sizeof(shortlogical),
#ifdef Allow_TYQUAD
sizeof(longint),
#endif
0};
#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
{
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);
}
}
#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
{
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;
#else
size_t i;
#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);
}
#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
{
if(f__sequential)
return(do_us(number,ptr,len));
else return(do_ud(number,ptr,len));
}
#ifndef NON_UNIX_STDIO
#include <sys/types.h>
#include <sys/stat.h>
#endif
#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
{
char *x = a + alen, *y = b + alen;
for(;; y--) {
if (x <= a) {
*b = 0;
return;
}
if (*--x != ' ')
break;
}
*y-- = 0;
do *y-- = *x;
while(x-- > a);
}
VOID
#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++=' ';
}
#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);
}
#endif
#include "f2c.h"
#include "fio.h"
#ifndef VAX
#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
{
char buf[FMAX+EXPMAXDIGS+4], *s, *se;
int d1, delta, e1, i, sign, signspace;
double dd;
#ifdef WANT_LEAD_0
int insert0 = 0;
#endif
#ifndef VAX
int e0 = e;
#endif
if(e <= 0)
e = 2;
if(f__scale) {
if(f__scale >= d + 2 || f__scale <= -d)
goto nogood;
}
if(f__scale <= 0)
--d;
if (len == sizeof(real))
dd = p->pf;
else
dd = p->pd;
if (dd < 0.) {
signspace = sign = 1;
dd = -dd;
}
else {
sign = 0;
signspace = (int)f__cplus;
#ifndef VAX
if (!dd)
dd = 0.; /* avoid -0 */
#endif
}
delta = w - (2 /* for the . and the d adjustment above */
+ 2 /* for the E+ */ + signspace + d + e);
#ifdef WANT_LEAD_0
if (f__scale <= 0 && delta > 0) {
delta--;
insert0 = 1;
}
else
#endif
if (delta < 0) {
nogood:
while(--w >= 0)
PUT('*');
return(0);
}
if (f__scale < 0)
d += f__scale;
if (d > FMAX) {
d1 = d - FMAX;
d = FMAX;
}
else
d1 = 0;
sprintf(buf,"%#.*E", d, dd);
#ifndef VAX
/* check for NaN, Infinity */
if (!isdigit(buf[0])) {
switch(buf[0]) {
case 'n':
case 'N':
signspace = 0; /* no sign for NaNs */
}
delta = w - strlen(buf) - signspace;
if (delta < 0)
goto nogood;
while(--delta >= 0)
PUT(' ');
if (signspace)
PUT(sign ? '-' : '+');
for(s = buf; *s; s++)
PUT(*s);
return 0;
}
#endif
se = buf + d + 3;
#ifdef GOOD_SPRINTF_EXPONENT /* When possible, exponent has 2 digits. */
if (f__scale != 1 && dd)
sprintf(se, "%+.2d", atoi(se) + 1 - f__scale);
#else
if (dd)
sprintf(se, "%+.2d", atoi(se) + 1 - f__scale);
else
strcpy(se, "+00");
#endif
s = ++se;
if (e < 2) {
if (*s != '0')
goto nogood;
}
#ifndef VAX
/* accommodate 3 significant digits in exponent */
if (s[2]) {
#ifdef Pedantic
if (!e0 && !s[3])
for(s -= 2, e1 = 2; s[0] = s[1]; s++);
/* Pedantic gives the behavior that Fortran 77 specifies, */
/* i.e., requires that E be specified for exponent fields */
/* of more than 3 digits. With Pedantic undefined, we get */
/* the behavior that Cray displays -- you get a bigger */
/* exponent field if it fits. */
#else
if (!e0) {
for(s -= 2, e1 = 2; s[0] = s[1]; s++)
#ifdef CRAY
delta--;
if ((delta += 4) < 0)
goto nogood
#endif
;
}
#endif
else if (e0 >= 0)
goto shift;
else
e1 = e;
}
else
shift:
#endif
for(s += 2, e1 = 2; *s; ++e1, ++s)
if (e1 >= e)
goto nogood;
while(--delta >= 0)
PUT(' ');
if (signspace)
PUT(sign ? '-' : '+');
s = buf;
i = f__scale;
if (f__scale <= 0) {
#ifdef WANT_LEAD_0
if (insert0)
PUT('0');
#endif
PUT('.');
for(; i < 0; ++i)
PUT('0');
PUT(*s);
s += 2;
}
else if (f__scale > 1) {
PUT(*s);
s += 2;
while(--i > 0)
PUT(*s++);
PUT('.');
}
if (d1) {
se -= 2;
while(s < se) PUT(*s++);
se += 2;
do PUT('0'); while(--d1 > 0);
}
while(s < se)
PUT(*s++);
if (e < 2)
PUT(s[1]);
else {
while(++e1 <= e)
PUT('0');
while(*s)
PUT(*s++);
}
return 0;
}
#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 d1, sign, n;
double x;
char *b, buf[MAXINTDIGS+MAXFRACDIGS+4], *s;
x= (len==sizeof(real)?p->pf:p->pd);
if (d < MAXFRACDIGS)
d1 = 0;
else {
d1 = d - MAXFRACDIGS;
d = MAXFRACDIGS;
}
if (x < 0.)
{ x = -x; sign = 1; }
else {
sign = 0;
#ifndef VAX
if (!x)
x = 0.;
#endif
}
if (n = f__scale)
if (n > 0)
do x *= 10.; while(--n > 0);
else
do x *= 0.1; while(++n < 0);
#ifdef USE_STRLEN
sprintf(b = buf, "%#.*f", d, x);
n = strlen(b) + d1;
#else
n = sprintf(b = buf, "%#.*f", d, x) + d1;
#endif
#ifndef WANT_LEAD_0
if (buf[0] == '0' && d)
{ ++b; --n; }
#endif
if (sign) {
/* check for all zeros */
for(s = b;;) {
while(*s == '0') s++;
switch(*s) {
case '.':
s++; continue;
case 0:
sign = 0;
}
break;
}
}
if (sign || f__cplus)
++n;
if (n > w) {
#ifdef WANT_LEAD_0
if (buf[0] == '0' && --n == w)
++b;
else
#endif
{
while(--w >= 0)
PUT('*');
return 0;
}
}
for(w -= n; --w >= 0; )
PUT(' ');
if (sign)
PUT('-');
else if (f__cplus)
PUT('+');
while(n = *b++)
PUT(n);
while(--d1 >= 0)
PUT('0');
return 0;
}
#include "f2c.h"
#include "fio.h"
#include "fmt.h"
extern icilist *f__svic;
extern char *f__icptr;
static int
mv_cur(Void) /* shouldn't use fseek because it insists on calling fflush */
/* instead we know too much about stdio */
{
int cursor = f__cursor;
f__cursor = 0;
if(f__external == 0) {
if(cursor < 0) {
if(f__hiwater < f__recpos)
f__hiwater = f__recpos;
f__recpos += cursor;
f__icptr += cursor;
if(f__recpos < 0)
err(f__elist->cierr, 110, "left off");
}
else if(cursor > 0) {
if(f__recpos + cursor >= f__svic->icirlen)
err(f__elist->cierr, 110, "recend");
if(f__hiwater <= f__recpos)
for(; cursor > 0; cursor--)
(*f__putn)(' ');
else if(f__hiwater <= f__recpos + cursor) {
cursor -= f__hiwater - f__recpos;
f__icptr += f__hiwater - f__recpos;
f__recpos = f__hiwater;
for(; cursor > 0; cursor--)
(*f__putn)(' ');
}
else {
f__icptr += cursor;
f__recpos += cursor;
}
}
return(0);
}
if(cursor > 0) {
if(f__hiwater <= f__recpos)
for(;cursor>0;cursor--) (*f__putn)(' ');
else if(f__hiwater <= f__recpos + cursor) {
#if ! defined (NON_UNIX_STDIO) && ! defined (MISSING_FILE_ELEMS)
if(f__cf->_ptr + f__hiwater - f__recpos < buf_end(f__cf))
f__cf->_ptr += f__hiwater - f__recpos;
else
#endif
(void) fseek(f__cf, (long) (f__hiwater - f__recpos), SEEK_CUR);
cursor -= f__hiwater - f__recpos;
f__recpos = f__hiwater;
for(; cursor > 0; cursor--)
(*f__putn)(' ');
}
else {
#if ! defined (NON_UNIX_STDIO) && ! defined (MISSING_FILE_ELEMS)
if(f__cf->_ptr + cursor < buf_end(f__cf))
f__cf->_ptr += cursor;
else
#endif
(void) fseek(f__cf, (long)cursor, SEEK_CUR);
f__recpos += cursor;
}
}
if(cursor<0)
{
if(cursor+f__recpos<0) err(f__elist->cierr,110,"left off");
#if ! defined (NON_UNIX_STDIO) && ! defined (MISSING_FILE_ELEMS)
if(f__cf->_ptr + cursor >= f__cf->_base)
f__cf->_ptr += cursor;
else
#endif
if(f__curunit && f__curunit->useek)
(void) fseek(f__cf,(long)cursor,SEEK_CUR);
else
err(f__elist->cierr,106,"fmt");
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
{
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;
#ifdef Allow_TYQUAD
else if (len == sizeof(longint)) x = n->ili;
#endif
else x=n->is;
ans=f__icvt(x,&ndigit,&sign, base);
spare=w-ndigit;
if(sign || f__cplus) spare--;
if(spare<0)
for(i=0;i<w;i++) (*f__putn)('*');
else
{ for(i=0;i<spare;i++) (*f__putn)(' ');
if(sign) (*f__putn)('-');
else if(f__cplus) (*f__putn)('+');
for(i=0;i<ndigit;i++) (*f__putn)(*ans++);
}
return(0);
}
static int
#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;
#ifdef Allow_TYQUAD
else if (len == sizeof(longint)) x = n->ili;
#endif
else x=n->is;
ans=f__icvt(x,&ndigit,&sign, base);
if(sign || f__cplus) xsign=1;
else xsign=0;
if(ndigit+xsign>w || m+xsign>w)
{ for(i=0;i<w;i++) (*f__putn)('*');
return(0);
}
if(x==0 && m==0)
{ for(i=0;i<w;i++) (*f__putn)(' ');
return(0);
}
if(ndigit>=m)
spare=w-ndigit-xsign;
else
spare=w-m-xsign;
for(i=0;i<spare;i++) (*f__putn)(' ');
if(sign) (*f__putn)('-');
else if(f__cplus) (*f__putn)('+');
for(i=0;i<m-ndigit;i++) (*f__putn)('0');
for(i=0;i<ndigit;i++) (*f__putn)(*ans++);
return(0);
}
static int
#ifdef KR_headers
wrt_AP(s) char *s;
#else
wrt_AP(char *s)
#endif
{ char quote;
int i;
if(f__cursor && (i = mv_cur()))
return i;
quote = *s++;
for(;*s;s++)
{ if(*s!=quote) (*f__putn)(*s);
else if(*++s==quote) (*f__putn)(*s);
else return(1);
}
return(1);
}
static int
#ifdef KR_headers
wrt_H(a,s) char *s;
#else
wrt_H(int a, char *s)
#endif
{
int i;
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);
}
static int
#ifdef KR_headers
wrt_A(p,len) char *p; ftnlen len;
#else
wrt_A(char *p, ftnlen len)
#endif
{
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
{
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));
}
#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 i;
if(f__cursor && (i = mv_cur()))
return i;
switch(p->op)
{
default:
fprintf(stderr,"w_ed, unexpected code: %d\n", p->op);
sig_die(f__fmtbuf, 1);
case I: return(wrt_I((Uint *)ptr,p->p1,len, 10));
case IM:
return(wrt_IM((Uint *)ptr,p->p1,p->p2.i[0],len,10));
/* O and OM don't work right for character, double, complex, */
/* or doublecomplex, and they differ from Fortran 90 in */
/* showing a minus sign for negative values. */
case O: return(wrt_I((Uint *)ptr, p->p1, len, 8));
case OM:
return(wrt_IM((Uint *)ptr,p->p1,p->p2.i[0],len,8));
case L: return(wrt_L((Uint *)ptr,p->p1, len));
case A: return(wrt_A(ptr,len));
case AW:
return(wrt_AW(ptr,p->p1,len));
case D:
case E:
case EE:
return(wrt_E((ufloat *)ptr,p->p1,p->p2.i[0],p->p2.i[1],len));
case G:
case GE:
return(wrt_G((ufloat *)ptr,p->p1,p->p2.i[0],p->p2.i[1],len));
case F: return(wrt_F((ufloat *)ptr,p->p1,p->p2.i[0],len));
/* Z and ZM assume 8-bit bytes. */
case Z: return(wrt_Z((Uint *)ptr,p->p1,0,len));
case ZM:
return(wrt_Z((Uint *)ptr,p->p1,p->p2.i[0],len));
}
}
#ifdef KR_headers
w_ned(p) struct syl *p;
#else
w_ned(struct syl *p)
#endif
{
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));
}
}
/*write sequential formatted external*/
#include "f2c.h"
#include "fio.h"
#include "fmt.h"
extern int f__hiwater;
#ifdef KR_headers
x_putc(c)
#else
x_putc(int c)
#endif
{
/* this uses \n as an indicator of record-end */
if(c == '\n' && f__recpos < f__hiwater) { /* fseek calls fflush, a loss */
#if ! defined (NON_UNIX_STDIO) && ! defined (MISSING_FILE_ELEMS)
if(f__cf->_ptr + f__hiwater - f__recpos < buf_end(f__cf))
f__cf->_ptr += f__hiwater - f__recpos;
else
#endif
(void) fseek(f__cf, (long)(f__hiwater - f__recpos), SEEK_CUR);
}
#ifdef OMIT_BLANK_CC
if (!f__recpos++ && c == ' ')
return c;
#else
f__recpos++;
#endif
return putc(c,f__cf);
}
x_wSL(Void)
{
(*f__putn)('\n');
f__recpos=0;
f__cursor = 0;
f__hiwater = 0;
return(1);
}
xw_end(Void)
{
if(f__nonl == 0)
(*f__putn)('\n');
f__hiwater = f__recpos = f__cursor = 0;
return(0);
}
xw_rev(Void)
{
if(f__workdone) (*f__putn)('\n');
f__hiwater = f__recpos = f__cursor = 0;
return(f__workdone=0);
}
#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;
if(n=c_sfe(a)) return(n);
f__reading=0;
f__sequential=1;
f__formatted=1;
f__external=1;
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);
}
#include "f2c.h"
#include "fio.h"
#include "fmt.h"
#include "lio.h"
#ifdef KR_headers
integer s_wsle(a) cilist *a;
#else
integer s_wsle(cilist *a)
#endif
{
int n;
if(n=c_le(a)) return(n);
f__reading=0;
f__external=1;
f__formatted=1;
f__putn = t_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)
{
f__init = 1;
t_putc('\n');
f__recpos=0;
#ifdef ALWAYS_FLUSH
if (fflush(f__cf))
err(f__elist->cierr, errno, "write end");
#else
if (f__cf == stdout)
fflush(stdout);
else if (f__cf == stderr)
fflush(stderr);
#endif
return(0);
}
#include "f2c.h"
#include "fio.h"
#include "lio.h"
integer
#ifdef KR_headers
s_wsne(a) cilist *a;
#else
s_wsne(cilist *a)
#endif
{
int n;
if(n=c_le(a))
return(n);
f__reading=0;
f__external=1;
f__formatted=1;
f__putn = t_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();
}
#include "f2c.h"
#include "fio.h"
#include "lio.h"
#include "fmt.h"
extern int f__Aquote;
static VOID
nl_donewrec(Void)
{
(*f__donewrec)();
PUT(' ');
}
#ifdef KR_headers
x_wsne(a) cilist *a;
#else
#include <string.h>
VOID
x_wsne(cilist *a)
#endif
{
Namelist *nl;
char *s;
Vardesc *v, **vd, **vde;
ftnint *number, type;
ftnlen *dims;
ftnlen size;
static ftnint one = 1;
extern ftnlen f__typesize[];
nl = (Namelist *)a->cifmt;
PUT('&');
for(s = nl->name; *s; s++)
PUT(*s);
PUT(' ');
f__Aquote = 1;
vd = nl->vars;
vde = vd + nl->nvars;
while(vd < vde) {
v = *vd++;
s = v->name;
#ifdef No_Extra_Namelist_Newlines
if (f__recpos+strlen(s)+2 >= L_len)
#endif
nl_donewrec();
while(*s)
PUT(*s++);
PUT(' ');
PUT('=');
number = (dims = v->dims) ? dims + 1 : &one;
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('/');
}
GNU LIBRARY GENERAL PUBLIC LICENSE
Version 2, June 1991
Copyright (C) 1991 Free Software Foundation, Inc.
675 Mass Ave, Cambridge, MA 02139, USA
Everyone is permitted to copy and distribute verbatim copies
of this license document, but changing it is not allowed.
[This is the first released version of the library GPL. It is
numbered 2 because it goes with version 2 of the ordinary GPL.]
Preamble
The licenses for most software are designed to take away your
freedom to share and change it. By contrast, the GNU General Public
Licenses are intended to guarantee your freedom to share and change
free software--to make sure the software is free for all its users.
This license, the Library General Public License, applies to some
specially designated Free Software Foundation software, and to any
other libraries whose authors decide to use it. You can use it for
your libraries, too.
When we speak of free software, we are referring to freedom, not
price. Our General Public Licenses are designed to make sure that you
have the freedom to distribute copies of free software (and charge for
this service if you wish), that you receive source code or can get it
if you want it, that you can change the software or use pieces of it
in new free programs; and that you know you can do these things.
To protect your rights, we need to make restrictions that forbid
anyone to deny you these rights or to ask you to surrender the rights.
These restrictions translate to certain responsibilities for you if
you distribute copies of the library, or if you modify it.
For example, if you distribute copies of the library, whether gratis
or for a fee, you must give the recipients all the rights that we gave
you. You must make sure that they, too, receive or can get the source
code. If you link a program with the library, you must provide
complete object files to the recipients so that they can relink them
with the library, after making changes to the library and recompiling
it. And you must show them these terms so they know their rights.
Our method of protecting your rights has two steps: (1) copyright
the library, and (2) offer you this license which gives you legal
permission to copy, distribute and/or modify the library.
Also, for each distributor's protection, we want to make certain
that everyone understands that there is no warranty for this free
library. If the library is modified by someone else and passed on, we
want its recipients to know that what they have is not the original
version, so that any problems introduced by others will not reflect on
the original authors' reputations.
Finally, any free program is threatened constantly by software
patents. We wish to avoid the danger that companies distributing free
software will individually obtain patent licenses, thus in effect
transforming the program into proprietary software. To prevent this,
we have made it clear that any patent must be licensed for everyone's
free use or not licensed at all.
Most GNU software, including some libraries, is covered by the ordinary
GNU General Public License, which was designed for utility programs. This
license, the GNU Library General Public License, applies to certain
designated libraries. This license is quite different from the ordinary
one; be sure to read it in full, and don't assume that anything in it is
the same as in the ordinary license.
The reason we have a separate public license for some libraries is that
they blur the distinction we usually make between modifying or adding to a
program and simply using it. Linking a program with a library, without
changing the library, is in some sense simply using the library, and is
analogous to running a utility program or application program. However, in
a textual and legal sense, the linked executable is a combined work, a
derivative of the original library, and the ordinary General Public License
treats it as such.
Because of this blurred distinction, using the ordinary General
Public License for libraries did not effectively promote software
sharing, because most developers did not use the libraries. We
concluded that weaker conditions might promote sharing better.
However, unrestricted linking of non-free programs would deprive the
users of those programs of all benefit from the free status of the
libraries themselves. This Library General Public License is intended to
permit developers of non-free programs to use free libraries, while
preserving your freedom as a user of such programs to change the free
libraries that are incorporated in them. (We have not seen how to achieve
this as regards changes in header files, but we have achieved it as regards
changes in the actual functions of the Library.) The hope is that this
will lead to faster development of free libraries.
The precise terms and conditions for copying, distribution and
modification follow. Pay close attention to the difference between a
"work based on the library" and a "work that uses the library". The
former contains code derived from the library, while the latter only
works together with the library.
Note that it is possible for a library to be covered by the ordinary
General Public License rather than by this special one.
GNU LIBRARY GENERAL PUBLIC LICENSE
TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
0. This License Agreement applies to any software library which
contains a notice placed by the copyright holder or other authorized
party saying it may be distributed under the terms of this Library
General Public License (also called "this License"). Each licensee is
addressed as "you".
A "library" means a collection of software functions and/or data
prepared so as to be conveniently linked with application programs
(which use some of those functions and data) to form executables.
The "Library", below, refers to any such software library or work
which has been distributed under these terms. A "work based on the
Library" means either the Library or any derivative work under
copyright law: that is to say, a work containing the Library or a
portion of it, either verbatim or with modifications and/or translated
straightforwardly into another language. (Hereinafter, translation is
included without limitation in the term "modification".)
"Source code" for a work means the preferred form of the work for
making modifications to it. For a library, complete source code means
all the source code for all modules it contains, plus any associated
interface definition files, plus the scripts used to control compilation
and installation of the library.
Activities other than copying, distribution and modification are not
covered by this License; they are outside its scope. The act of
running a program using the Library is not restricted, and output from
such a program is covered only if its contents constitute a work based
on the Library (independent of the use of the Library in a tool for
writing it). Whether that is true depends on what the Library does
and what the program that uses the Library does.
1. You may copy and distribute verbatim copies of the Library's
complete source code as you receive it, in any medium, provided that
you conspicuously and appropriately publish on each copy an
appropriate copyright notice and disclaimer of warranty; keep intact
all the notices that refer to this License and to the absence of any
warranty; and distribute a copy of this License along with the
Library.
You may charge a fee for the physical act of transferring a copy,
and you may at your option offer warranty protection in exchange for a
fee.
2. You may modify your copy or copies of the Library or any portion
of it, thus forming a work based on the Library, and copy and
distribute such modifications or work under the terms of Section 1
above, provided that you also meet all of these conditions:
a) The modified work must itself be a software library.
b) You must cause the files modified to carry prominent notices
stating that you changed the files and the date of any change.
c) You must cause the whole of the work to be licensed at no
charge to all third parties under the terms of this License.
d) If a facility in the modified Library refers to a function or a
table of data to be supplied by an application program that uses
the facility, other than as an argument passed when the facility
is invoked, then you must make a good faith effort to ensure that,
in the event an application does not supply such function or
table, the facility still operates, and performs whatever part of
its purpose remains meaningful.
(For example, a function in a library to compute square roots has
a purpose that is entirely well-defined independent of the
application. Therefore, Subsection 2d requires that any
application-supplied function or table used by this function must
be optional: if the application does not supply it, the square
root function must still compute square roots.)
These requirements apply to the modified work as a whole. If
identifiable sections of that work are not derived from the Library,
and can be reasonably considered independent and separate works in
themselves, then this License, and its terms, do not apply to those
sections when you distribute them as separate works. But when you
distribute the same sections as part of a whole which is a work based
on the Library, the distribution of the whole must be on the terms of
this License, whose permissions for other licensees extend to the
entire whole, and thus to each and every part regardless of who wrote
it.
Thus, it is not the intent of this section to claim rights or contest
your rights to work written entirely by you; rather, the intent is to
exercise the right to control the distribution of derivative or
collective works based on the Library.
In addition, mere aggregation of another work not based on the Library
with the Library (or with a work based on the Library) on a volume of
a storage or distribution medium does not bring the other work under
the scope of this License.
3. You may opt to apply the terms of the ordinary GNU General Public
License instead of this License to a given copy of the Library. To do
this, you must alter all the notices that refer to this License, so
that they refer to the ordinary GNU General Public License, version 2,
instead of to this License. (If a newer version than version 2 of the
ordinary GNU General Public License has appeared, then you can specify
that version instead if you wish.) Do not make any other change in
these notices.
Once this change is made in a given copy, it is irreversible for
that copy, so the ordinary GNU General Public License applies to all
subsequent copies and derivative works made from that copy.
This option is useful when you wish to copy part of the code of
the Library into a program that is not a library.
4. You may copy and distribute the Library (or a portion or
derivative of it, under Section 2) in object code or executable form
under the terms of Sections 1 and 2 above provided that you accompany
it with the complete corresponding machine-readable source code, which
must be distributed under the terms of Sections 1 and 2 above on a
medium customarily used for software interchange.
If distribution of object code is made by offering access to copy
from a designated place, then offering equivalent access to copy the
source code from the same place satisfies the requirement to
distribute the source code, even though third parties are not
compelled to copy the source along with the object code.
5. A program that contains no derivative of any portion of the
Library, but is designed to work with the Library by being compiled or
linked with it, is called a "work that uses the Library". Such a
work, in isolation, is not a derivative work of the Library, and
therefore falls outside the scope of this License.
However, linking a "work that uses the Library" with the Library
creates an executable that is a derivative of the Library (because it
contains portions of the Library), rather than a "work that uses the
library". The executable is therefore covered by this License.
Section 6 states terms for distribution of such executables.
When a "work that uses the Library" uses material from a header file
that is part of the Library, the object code for the work may be a
derivative work of the Library even though the source code is not.
Whether this is true is especially significant if the work can be
linked without the Library, or if the work is itself a library. The
threshold for this to be true is not precisely defined by law.
If such an object file uses only numerical parameters, data
structure layouts and accessors, and small macros and small inline
functions (ten lines or less in length), then the use of the object
file is unrestricted, regardless of whether it is legally a derivative
work. (Executables containing this object code plus portions of the
Library will still fall under Section 6.)
Otherwise, if the work is a derivative of the Library, you may
distribute the object code for the work under the terms of Section 6.
Any executables containing that work also fall under Section 6,
whether or not they are linked directly with the Library itself.
6. As an exception to the Sections above, you may also compile or
link a "work that uses the Library" with the Library to produce a
work containing portions of the Library, and distribute that work
under terms of your choice, provided that the terms permit
modification of the work for the customer's own use and reverse
engineering for debugging such modifications.
You must give prominent notice with each copy of the work that the
Library is used in it and that the Library and its use are covered by
this License. You must supply a copy of this License. If the work
during execution displays copyright notices, you must include the
copyright notice for the Library among them, as well as a reference
directing the user to the copy of this License. Also, you must do one
of these things:
a) Accompany the work with the complete corresponding
machine-readable source code for the Library including whatever
changes were used in the work (which must be distributed under
Sections 1 and 2 above); and, if the work is an executable linked
with the Library, with the complete machine-readable "work that
uses the Library", as object code and/or source code, so that the
user can modify the Library and then relink to produce a modified
executable containing the modified Library. (It is understood
that the user who changes the contents of definitions files in the
Library will not necessarily be able to recompile the application
to use the modified definitions.)
b) Accompany the work with a written offer, valid for at
least three years, to give the same user the materials
specified in Subsection 6a, above, for a charge no more
than the cost of performing this distribution.
c) If distribution of the work is made by offering access to copy
from a designated place, offer equivalent access to copy the above
specified materials from the same place.
d) Verify that the user has already received a copy of these
materials or that you have already sent this user a copy.
For an executable, the required form of the "work that uses the
Library" must include any data and utility programs needed for
reproducing the executable from it. However, as a special exception,
the source code distributed need not include anything that is normally
distributed (in either source or binary form) with the major
components (compiler, kernel, and so on) of the operating system on
which the executable runs, unless that component itself accompanies
the executable.
It may happen that this requirement contradicts the license
restrictions of other proprietary libraries that do not normally
accompany the operating system. Such a contradiction means you cannot
use both them and the Library together in an executable that you
distribute.
7. You may place library facilities that are a work based on the
Library side-by-side in a single library together with other library
facilities not covered by this License, and distribute such a combined
library, provided that the separate distribution of the work based on
the Library and of the other library facilities is otherwise
permitted, and provided that you do these two things:
a) Accompany the combined library with a copy of the same work
based on the Library, uncombined with any other library
facilities. This must be distributed under the terms of the
Sections above.
b) Give prominent notice with the combined library of the fact
that part of it is a work based on the Library, and explaining
where to find the accompanying uncombined form of the same work.
8. You may not copy, modify, sublicense, link with, or distribute
the Library except as expressly provided under this License. Any
attempt otherwise to copy, modify, sublicense, link with, or
distribute the Library is void, and will automatically terminate your
rights under this License. However, parties who have received copies,
or rights, from you under this License will not have their licenses
terminated so long as such parties remain in full compliance.
9. You are not required to accept this License, since you have not
signed it. However, nothing else grants you permission to modify or
distribute the Library or its derivative works. These actions are
prohibited by law if you do not accept this License. Therefore, by
modifying or distributing the Library (or any work based on the
Library), you indicate your acceptance of this License to do so, and
all its terms and conditions for copying, distributing or modifying
the Library or works based on it.
10. Each time you redistribute the Library (or any work based on the
Library), the recipient automatically receives a license from the
original licensor to copy, distribute, link with or modify the Library
subject to these terms and conditions. You may not impose any further
restrictions on the recipients' exercise of the rights granted herein.
You are not responsible for enforcing compliance by third parties to
this License.
11. If, as a consequence of a court judgment or allegation of patent
infringement or for any other reason (not limited to patent issues),
conditions are imposed on you (whether by court order, agreement or
otherwise) that contradict the conditions of this License, they do not
excuse you from the conditions of this License. If you cannot
distribute so as to satisfy simultaneously your obligations under this
License and any other pertinent obligations, then as a consequence you
may not distribute the Library at all. For example, if a patent
license would not permit royalty-free redistribution of the Library by
all those who receive copies directly or indirectly through you, then
the only way you could satisfy both it and this License would be to
refrain entirely from distribution of the Library.
If any portion of this section is held invalid or unenforceable under any
particular circumstance, the balance of the section is intended to apply,
and the section as a whole is intended to apply in other circumstances.
It is not the purpose of this section to induce you to infringe any
patents or other property right claims or to contest validity of any
such claims; this section has the sole purpose of protecting the
integrity of the free software distribution system which is
implemented by public license practices. Many people have made
generous contributions to the wide range of software distributed
through that system in reliance on consistent application of that
system; it is up to the author/donor to decide if he or she is willing
to distribute software through any other system and a licensee cannot
impose that choice.
This section is intended to make thoroughly clear what is believed to
be a consequence of the rest of this License.
12. If the distribution and/or use of the Library is restricted in
certain countries either by patents or by copyrighted interfaces, the
original copyright holder who places the Library under this License may add
an explicit geographical distribution limitation excluding those countries,
so that distribution is permitted only in or among countries not thus
excluded. In such case, this License incorporates the limitation as if
written in the body of this License.
13. The Free Software Foundation may publish revised and/or new
versions of the Library General Public License from time to time.
Such new versions will be similar in spirit to the present version,
but may differ in detail to address new problems or concerns.
Each version is given a distinguishing version number. If the Library
specifies a version number of this License which applies to it and
"any later version", you have the option of following the terms and
conditions either of that version or of any later version published by
the Free Software Foundation. If the Library does not specify a
license version number, you may choose any version ever published by
the Free Software Foundation.
14. If you wish to incorporate parts of the Library into other free
programs whose distribution conditions are incompatible with these,
write to the author to ask for permission. For software which is
copyrighted by the Free Software Foundation, write to the Free
Software Foundation; we sometimes make exceptions for this. Our
decision will be guided by the two goals of preserving the free status
of all derivatives of our free software and of promoting the sharing
and reuse of software generally.
NO WARRANTY
15. BECAUSE THE LIBRARY IS LICENSED FREE OF CHARGE, THERE IS NO
WARRANTY FOR THE LIBRARY, TO THE EXTENT PERMITTED BY APPLICABLE LAW.
EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR
OTHER PARTIES PROVIDE THE LIBRARY "AS IS" WITHOUT WARRANTY OF ANY
KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE
IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE
LIBRARY IS WITH YOU. SHOULD THE LIBRARY PROVE DEFECTIVE, YOU ASSUME
THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION.
16. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN
WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY
AND/OR REDISTRIBUTE THE LIBRARY AS PERMITTED ABOVE, BE LIABLE TO YOU
FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR
CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE
LIBRARY (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING
RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A
FAILURE OF THE LIBRARY TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF
SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH
DAMAGES.
END OF TERMS AND CONDITIONS
Appendix: How to Apply These Terms to Your New Libraries
If you develop a new library, and you want it to be of the greatest
possible use to the public, we recommend making it free software that
everyone can redistribute and change. You can do so by permitting
redistribution under these terms (or, alternatively, under the terms of the
ordinary General Public License).
To apply these terms, attach the following notices to the library. It is
safest to attach them to the start of each source file to most effectively
convey the exclusion of warranty; and each file should have at least the
"copyright" line and a pointer to where the full notice is found.
<one line to give the library's name and a brief idea of what it does.>
Copyright (C) <year> <name of author>
This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Library General Public
License as published by the Free Software Foundation; either
version 2 of the License, or (at your option) any later version.
This library is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with this library; if not, write to the Free
Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
Also add information on how to contact you by electronic and paper mail.
You should also get your employer (if you work as a programmer) or your
school, if any, to sign a "copyright disclaimer" for the library, if
necessary. Here is a sample; alter the names:
Yoyodyne, Inc., hereby disclaims all copyright interest in the
library `Frob' (a library for tweaking knobs) written by James Random Hacker.
<signature of Ty Coon>, 1 April 1990
Ty Coon, President of Vice
That's all there is to it!
# Makefile for GNU F77 compiler runtime, libc interface.
# Copyright (C) 1995-1997 Free Software Foundation, Inc.
# Contributed by Dave Love (d.love@dl.ac.uk).
#
#This file is part of GNU Fortran libU77 library.
#
#This library is free software; you can redistribute it and/or modify
#it under the terms of the GNU Library General Public License as
#published by the Free Software Foundation; either version 2, or (at
#your option) any later version.
#
#GNU Fortran is distributed in the hope that it will be useful, but
#WITHOUT ANY WARRANTY; without even the implied warranty of
#MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
#Library General Public License for more details.
#
#You should have received a copy of the GNU General Public License
#along with GNU Fortran; see the file COPYING. If not, write to
#Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
SHELL = /bin/sh
srcdir = @srcdir@
VPATH = @srcdir@
#### Start of system configuration section. ####
CPPFLAGS = @CPPFLAGS@
DEFS = @DEFS@
# f2c.h should already be installed in xgcc's include directory but add that
# to -I anyhow in case not using xgcc. fio.h is in libI77. We need config.h
# from `.'.
ALL_CFLAGS = -I. -I$(srcdir) -I$(srcdir)/../libI77 -I.. $(CPPFLAGS) $(DEFS) $(CFLAGS)
CROSS = @CROSS@
.SUFFIXES:
.SUFFIXES: .c .o
.c.o:
$(CC) -c -DSkip_f2c_Undefs $(ALL_CFLAGS) $<
OBJS = VersionU.o gerror_.o perror_.o ierrno_.o itime_.o time_.o \
unlink_.o fnum_.o getpid_.o getuid_.o getgid_.o kill_.o rand_.o \
srand_.o irand_.o sleep_.o idate_.o ctime_.o etime_.o \
dtime_.o isatty_.o ltime_.o fstat_.o stat_.o \
lstat_.o access_.o link_.o getlog_.o ttynam_.o getcwd_.o symlnk_.o \
vxttime_.o vxtidate_.o gmtime_.o fdate_.o secnds_.o \
bes.o dbes.o \
chdir_.o chmod_.o lnblnk_.o hostnm_.o rename_.o fgetc_.o fputc_.o \
umask_.o sys_clock_.o date_.o second_.o flush1_.o mclock_.o \
alarm_.o
SRCS = Version.c gerror_.c perror_.c ierrno_.c itime_.c time_.c \
unlink_.c fnum_.c getpid_.c getuid_.c getgid_.c kill_.c rand_.c \
srand_.c irand_.c sleep_.c idate_.c ctime_.c etime_.c \
dtime_.c isatty_.c ltime_.c fstat_.c stat_.c \
lstat_.c access_.c link_.c getlog_.c ttynam_.c getcwd_.c symlnk_.c \
vxttime_.c vxtidate_.c gmtime_.c fdate_.c secnds_.c \
bes.c dbes.c \
chdir_.c chmod_.c lnblnk_.c hostnm_.c rename_.c fgetc_.c fputc_.c \
umask_.c sys_clock_.c date_.c second_.c flush1_.c mclock_.c \
alarm_.c
F2C_H = ../f2c.h
all: $(OBJS)
VersionU.o: Version.c
$(CC) -c $(CGFLAGS) -o $@ $(srcdir)/Version.c
lint:
lint $(CFLAGS) $(SRCS)
mostlyclean:
-rm -f $(OBJS)
clean: mostlyclean
-rm -f config.log a.out
distclean realclean maintainer-clean: clean
-rm -f config.h Makefile config.status config.cache stage? include
$(OBJS): $(F2C_H) config.h
check:
-$(G77DIR)g77 -B$(G77DIR) -g $(srcdir)/u77-test.f $(lib) && ./a.out
rm -f a.out
access_.o: access_.c
ctime_.o: ctime_.c
dtime_.o: dtime_.c
etime_.o: etime_.c
fnum_.o: fnum_.c $(srcdir)/../libI77/fio.h
fstat_.o: fstat_.c
gerror_.o: gerror_.c
getcwd_.o: getcwd_.c
getgid_.o: getgid_.c
getlog_.o: getlog_.c
getpid_.o: getpid_.c
getuid_.o: getuid_.c
idate_.o: idate_.c
ierrno_.o: ierrno_.c
irand_.o: irand_.c
isatty_.o: isatty_.c $(srcdir)/../libI77/fio.h
itime_.o: itime_.c
kill_.o: kill_.c
link_.o: link_.c
loc_.o: loc_.c
lstat_.o: lstat_.c
ltime_.o: ltime_.c
perror_.o: perror_.c
qsort.o: qsort.c
qsort_.o: qsort_.c
rand_.o: rand_.c
rename_.o: rename_.c
second_.o: second_.c
sleep_.o: sleep_.c
srand_.o: srand_.c
stat_.o: stat_.c
symlnk_.o: symlnk_.c
time_.o: time_.c
ttynam_.o: ttynam_.c
unlink_.o: unlink_.c
wait_.o: wait_.c
vxttime_.o: vxttime_.c
vtxidate_.o: vxtidate_.c
fdate_.o: fdate_.c
gmtime_.o: gmtime_.c
secnds_.o: secnds_.c
bes.o: bes.c
dbes.o: dbes.c
lnblnk_.o: lnblnk_.c
chmod_.o: chmod_.c
chdir_.o: chdir_.c
hostnm_.o: hostnm_.c
rename_.o: rename_.c
fputc_.o: fputc_.c
fgetc_.o: fgetc_.c
sys_clock_.o: sys_clock_.c
umask_.o: umask_.c
flush1_.o: flush1_.c
mclock_.o: mclock_.c
alarm_.o: alarm_.c
.PHONY: mostlyclean clean distclean maintainer-clean lint check all
-*- indented-text-*-
* Interface to strget
* Non-blocking (`asynchronous') i/o (per c.l.f. discussion)
* `ioinit'-type routine for various i/o options
* IEEE/VAX/... number format conversion (or XDR interface). This
might be made optionally transparent per logical unit a la DECtran.
19970811 -*-text-*-
g77 libU77
----------
This directory contains an implementation of most of the `traditional'
Unix libU77 routines, mostly an interface to libc and libm routines
and some extra ones for time and date etc. It's intended for use with
g77, to whose configuration procedure it's currently tied, but should
be compatible with f2c otherwise, if using the same f2c.h.
The contents of libU77 and its interfaces aren't consistent across
implementations. This one is mostly taken from documentation for (an
old version of) the Convex implementation and the v2 SunPro one.
As of g77 version 0.5.20, most of these routines have been made
into g77 intrinsics. Some routines have a version with a name prefixed
by `vxt', corresponding to the VMS Fortran versions, and these should
be integrated with g77's intrinsics visibility control.
A few routines are currently missing; in the case of `fork', for
instance, because they're probably not useful, and in the case of
`qsort' and those for stream-based i/o handling, because they need
more effort/research. The configuration should weed out those few
which correspond to facilities which may not be present on some Unix
systems, such as symbolic links. It's unclear whether the interfaces
to the native library random number routines should be retained, since
their implementation is likely to be something one should avoid
assiduously.
This library has been tested it under SunOS4.1.3 and Irix5.2 and there
has been some feedback from Linux; presumably potential problems lie
mainly with systems with impoverished native C library support which
haven't been properly taken care of with autoconf.
There's another GPL'd implementation of this stuff which I only found
out about recently (despite having looked) and I haven't yet checked
how they should be amalgamated.
Dave Love <d.love@dl.ac.uk> Aug '95
(minor changes by Craig Burley <burley@gnu.ai.mit.edu> Aug '97)
static char junk[] = "\n@(#) LIBU77 VERSION 19970919\n";
char __G77_LIBU77_VERSION__[] = "0.5.22-970919";
#include <stdio.h>
void
g77__uvers__ ()
{
fprintf (stderr, "__G77_LIBU77_VERSION__: %s", __G77_LIBU77_VERSION__);
fputs (junk, stderr);
}
/* Copyright (C) 1995, 1997 Free Software Foundation, Inc.
This file is part of GNU Fortran libU77 library.
This library is free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published
by the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
GNU Fortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with GNU Fortran; see the file COPYING.LIB. If
not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA. */
#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
#if HAVE_UNISTD_H
# include <unistd.h>
#endif
#if HAVE_STDLIB_H
# include <stdlib.h>
#else
# include <stdio.h>
#endif
#include <errno.h>
#include <limits.h>
#include "f2c.h"
#ifndef R_OK /* for SVR1-2 */
# define R_OK 4
#endif
#ifndef W_OK
# define W_OK 2
#endif
#ifndef X_OK
# define X_OK 1
#endif
#ifndef F_OK
# define F_OK 0
#endif
#ifdef KR_headers
void g_char ();
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
{
char *buff;
char *bp, *blast;
int amode, i;
buff = malloc (Lname+1);
if (!buff) return -1;
g_char (name, Lname, buff);
amode = 0;
for (i=0;i<Lmode;i++) {
switch (mode[i]) {
case 'r': amode |= R_OK; break;
case 'w': amode |= W_OK; break;
case 'x': amode |= X_OK; break;
case ' ': amode |= F_OK; break; /* as per Sun, at least */
default: return EINVAL;
}
}
i = access (buff, amode);
free (buff);
return i;
}
/* Define as the path of the `chmod' program. */
#undef CHMOD_PATH
/* Copyright (C) 1997 Free Software Foundation, Inc.
This file is part of GNU Fortran libU77 library.
This library is free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published
by the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
GNU Fortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with GNU Fortran; see the file COPYING.LIB. If
not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA. */
#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
#if HAVE_UNISTD_H
# include <unistd.h>
#endif
#include <errno.h> /* for ENOSYS */
#include "f2c.h"
#ifndef RETSIGTYPE
/* we shouldn't rely on this... */
#ifdef KR_headers
#define RETSIGTYPE int
#else
#define RETSIGTYPE void
#endif
#endif
typedef RETSIGTYPE (*sig_type)();
#ifdef KR_headers
extern sig_type signal();
integer G77_alarm_0 (seconds, proc)
integer *seconds;
sig_type proc;
#else
#include <signal.h>
typedef int (*sig_proc)(int);
integer G77_alarm_0 (integer *seconds, sig_proc proc)
#endif
{
int status;
#if defined (HAVE_ALARM) && defined (SIGALRM)
if (signal(SIGALRM, (sig_type)proc) == SIG_ERR)
status = -1;
else
status = alarm (*seconds);
#else /* ! HAVE_ALARM || ! SIGALRM */
errno = ENOSYS;
status = -1;
#endif
return status;
}
/* Copyright (C) 1995, 1996 Free Software Foundation, Inc.
This file is part of GNU Fortran libU77 library.
This library is free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published
by the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
GNU Fortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with GNU Fortran; see the file COPYING.LIB. If
not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA. */
#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_besj1_0 (const real *x) {
return j1 (*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_besy1_0 (const real *x) {
return y1 (*x);
}
double G77_besyn_0 (const integer *n, real *x) {
return yn (*n, *x);
}
#endif
/* Copyright (C) 1995, 1997 Free Software Foundation, Inc.
This file is part of GNU Fortran libU77 library.
This library is free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published
by the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
GNU Fortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with GNU Fortran; see the file COPYING.LIB. If
not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA. */
#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
#if HAVE_UNISTD_H
# include <unistd.h>
#endif
#if HAVE_STDLIB_H
# include <stdlib.h>
#else
# include <stdio.h>
#endif
#include <errno.h>
#include "f2c.h"
#ifdef KR_headers
void g_char ();
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
{
char *buff;
char *bp, *blast;
int i;
buff = malloc (Lname+1);
if (!buff) return -1;
g_char (name, Lname, buff);
i = chdir (buff);
free (buff);
return i ? errno : 0;
}
/* Copyright (C) 1995, 1997 Free Software Foundation, Inc.
This file is part of GNU Fortran libU77 library.
This library is free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published
by the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
GNU Fortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with GNU Fortran; see the file COPYING.LIB. If
not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA. */
/* This definitely shouldn't be done this way -- should canibalise
chmod(1) from GNU or BSD. */
#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
#if HAVE_UNISTD_H
# include <unistd.h>
#endif
#if HAVE_STDLIB_H
# include <stdlib.h>
#else
# include <stdio.h>
#endif
#if STDC_HEADERS
# include <string.h>
#endif
#include "f2c.h"
#ifndef CHMOD_PATH
#define CHMOD_PATH "/bin/chmod"
#endif
#ifdef KR_headers
extern void s_cat ();
void g_char ();
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
{
char *buff;
char *bp, *blast;
int i;
ftnlen l, l2;
ftnlen six = 6;
address a[6];
ftnlen ii[6];
char chmod_path [] = CHMOD_PATH;
l = strlen (chmod_path);
buff = malloc (Lname+Lmode+l+3+13+1);
if (!buff) return -1;
ii[0] = l; a[0] = chmod_path;
ii[1] = 1; a[1] = " ";
ii[2] = Lmode; a[2] = mode;
ii[3] = 2; a[3] = " '";
for (l2=Lname; (l2 > 1) && (name[l2-1] == ' '); )
l2--;
ii[4] = l2; a[4] = name;
ii[5] = 13; a[5] = "' 2>/dev/null";
s_cat (buff, a, ii, &six, Lname+Lmode+l+3+13);
buff[Lname+Lmode+l+3+13] = '\0';
i = system (buff);
free (buff);
return i;
}
/* config.h.in. Generated automatically from configure.in by autoheader. */
/* Define to empty if the keyword does not work. */
#undef const
/* Define if your struct stat has st_blksize. */
#undef HAVE_ST_BLKSIZE
/* Define if your struct stat has st_blocks. */
#undef HAVE_ST_BLOCKS
/* Define if your struct stat has st_rdev. */
#undef HAVE_ST_RDEV
/* Define to `int' if <sys/types.h> doesn't define. */
#undef mode_t
/* Define to `int' if <sys/types.h> doesn't define. */
#undef pid_t
/* Define to `unsigned' if <sys/types.h> doesn't define. */
#undef size_t
/* Define if you have the ANSI C header files. */
#undef STDC_HEADERS
/* Define if you can safely include both <sys/time.h> and <time.h>. */
#undef TIME_WITH_SYS_TIME
/* Define if your <sys/time.h> declares struct tm. */
#undef TM_IN_SYS_TIME
/* Define as the path of the `chmod' program. */
#undef CHMOD_PATH
/* Define if you have the clock function. */
#undef HAVE_CLOCK
/* Define if you have the getcwd function. */
#undef HAVE_GETCWD
/* Define if you have the gethostname function. */
#undef HAVE_GETHOSTNAME
/* Define if you have the getrusage function. */
#undef HAVE_GETRUSAGE
/* Define if you have the getwd function. */
#undef HAVE_GETWD
/* Define if you have the lstat function. */
#undef HAVE_LSTAT
/* Define if you have the strerror function. */
#undef HAVE_STRERROR
/* Define if you have the symlink function. */
#undef HAVE_SYMLINK
/* Define if you have the <limits.h> header file. */
#undef HAVE_LIMITS_H
/* Define if you have the <stdlib.h> header file. */
#undef HAVE_STDLIB_H
/* Define if you have the <string.h> header file. */
#undef HAVE_STRING_H
/* Define if you have the <sys/time.h> header file. */
#undef HAVE_SYS_TIME_H
/* Define if you have the <unistd.h> header file. */
#undef HAVE_UNISTD_H
/* Define if you have the <sys/param.h> header file. */
#undef HAVE_SYS_PARAM_H
/* Define if you have the <sys/times.h> header file. */
#undef HAVE_SYS_TIMES_H
/* Define if you have the alarm function. */
#undef HAVE_ALARM
/* Define if you have the times function. */
#undef HAVE_TIMES
/* Define if you have the getlogin function. */
#undef HAVE_GETLOGIN
/* Define if you have the getgid function. */
#undef HAVE_GETGID
/* Define if you have the getuid function. */
#undef HAVE_GETUID
/* Define if you have the kill function. */
#undef HAVE_KILL
/* Define if you have the link function. */
#undef HAVE_LINK
/* Define if you have the ttyname function. */
#undef HAVE_TTYNAME
#! /bin/sh
# Guess values for system-dependent variables and create Makefiles.
# Generated automatically using autoconf version 2.12.1
# Copyright (C) 1992, 93, 94, 95, 96 Free Software Foundation, Inc.
#
# This configure script is free software; the Free Software Foundation
# gives unlimited permission to copy, distribute and modify it.
# Defaults:
ac_help=
ac_default_prefix=/usr/local
# Any additions from configure.in:
# Initialize some variables set by options.
# The variables have the same names as the options, with
# dashes changed to underlines.
build=NONE
cache_file=./config.cache
exec_prefix=NONE
host=NONE
no_create=
nonopt=NONE
no_recursion=
prefix=NONE
program_prefix=NONE
program_suffix=NONE
program_transform_name=s,x,x,
silent=
site=
srcdir=
target=NONE
verbose=
x_includes=NONE
x_libraries=NONE
bindir='${exec_prefix}/bin'
sbindir='${exec_prefix}/sbin'
libexecdir='${exec_prefix}/libexec'
datadir='${prefix}/share'
sysconfdir='${prefix}/etc'
sharedstatedir='${prefix}/com'
localstatedir='${prefix}/var'
libdir='${exec_prefix}/lib'
includedir='${prefix}/include'
oldincludedir='/usr/include'
infodir='${prefix}/info'
mandir='${prefix}/man'
# Initialize some other variables.
subdirs=
MFLAGS= MAKEFLAGS=
SHELL=${CONFIG_SHELL-/bin/sh}
# Maximum number of lines to put in a shell here document.
ac_max_here_lines=12
ac_prev=
for ac_option
do
# If the previous option needs an argument, assign it.
if test -n "$ac_prev"; then
eval "$ac_prev=\$ac_option"
ac_prev=
continue
fi
case "$ac_option" in
-*=*) ac_optarg=`echo "$ac_option" | sed 's/[-_a-zA-Z0-9]*=//'` ;;
*) ac_optarg= ;;
esac
# Accept the important Cygnus configure options, so we can diagnose typos.
case "$ac_option" in
-bindir | --bindir | --bindi | --bind | --bin | --bi)
ac_prev=bindir ;;
-bindir=* | --bindir=* | --bindi=* | --bind=* | --bin=* | --bi=*)
bindir="$ac_optarg" ;;
-build | --build | --buil | --bui | --bu)
ac_prev=build ;;
-build=* | --build=* | --buil=* | --bui=* | --bu=*)
build="$ac_optarg" ;;
-cache-file | --cache-file | --cache-fil | --cache-fi \
| --cache-f | --cache- | --cache | --cach | --cac | --ca | --c)
ac_prev=cache_file ;;
-cache-file=* | --cache-file=* | --cache-fil=* | --cache-fi=* \
| --cache-f=* | --cache-=* | --cache=* | --cach=* | --cac=* | --ca=* | --c=*)
cache_file="$ac_optarg" ;;
-datadir | --datadir | --datadi | --datad | --data | --dat | --da)
ac_prev=datadir ;;
-datadir=* | --datadir=* | --datadi=* | --datad=* | --data=* | --dat=* \
| --da=*)
datadir="$ac_optarg" ;;
-disable-* | --disable-*)
ac_feature=`echo $ac_option|sed -e 's/-*disable-//'`
# Reject names that are not valid shell variable names.
if test -n "`echo $ac_feature| sed 's/[-a-zA-Z0-9_]//g'`"; then
{ echo "configure: error: $ac_feature: invalid feature name" 1>&2; exit 1; }
fi
ac_feature=`echo $ac_feature| sed 's/-/_/g'`
eval "enable_${ac_feature}=no" ;;
-enable-* | --enable-*)
ac_feature=`echo $ac_option|sed -e 's/-*enable-//' -e 's/=.*//'`
# Reject names that are not valid shell variable names.
if test -n "`echo $ac_feature| sed 's/[-_a-zA-Z0-9]//g'`"; then
{ echo "configure: error: $ac_feature: invalid feature name" 1>&2; exit 1; }
fi
ac_feature=`echo $ac_feature| sed 's/-/_/g'`
case "$ac_option" in
*=*) ;;
*) ac_optarg=yes ;;
esac
eval "enable_${ac_feature}='$ac_optarg'" ;;
-exec-prefix | --exec_prefix | --exec-prefix | --exec-prefi \
| --exec-pref | --exec-pre | --exec-pr | --exec-p | --exec- \
| --exec | --exe | --ex)
ac_prev=exec_prefix ;;
-exec-prefix=* | --exec_prefix=* | --exec-prefix=* | --exec-prefi=* \
| --exec-pref=* | --exec-pre=* | --exec-pr=* | --exec-p=* | --exec-=* \
| --exec=* | --exe=* | --ex=*)
exec_prefix="$ac_optarg" ;;
-gas | --gas | --ga | --g)
# Obsolete; use --with-gas.
with_gas=yes ;;
-help | --help | --hel | --he)
# Omit some internal or obsolete options to make the list less imposing.
# This message is too long to be a string in the A/UX 3.1 sh.
cat << EOF
Usage: configure [options] [host]
Options: [defaults in brackets after descriptions]
Configuration:
--cache-file=FILE cache test results in FILE
--help print this message
--no-create do not create output files
--quiet, --silent do not print \`checking...' messages
--version print the version of autoconf that created configure
Directory and file names:
--prefix=PREFIX install architecture-independent files in PREFIX
[$ac_default_prefix]
--exec-prefix=EPREFIX install architecture-dependent files in EPREFIX
[same as prefix]
--bindir=DIR user executables in DIR [EPREFIX/bin]
--sbindir=DIR system admin executables in DIR [EPREFIX/sbin]
--libexecdir=DIR program executables in DIR [EPREFIX/libexec]
--datadir=DIR read-only architecture-independent data in DIR
[PREFIX/share]
--sysconfdir=DIR read-only single-machine data in DIR [PREFIX/etc]
--sharedstatedir=DIR modifiable architecture-independent data in DIR
[PREFIX/com]
--localstatedir=DIR modifiable single-machine data in DIR [PREFIX/var]
--libdir=DIR object code libraries in DIR [EPREFIX/lib]
--includedir=DIR C header files in DIR [PREFIX/include]
--oldincludedir=DIR C header files for non-gcc in DIR [/usr/include]
--infodir=DIR info documentation in DIR [PREFIX/info]
--mandir=DIR man documentation in DIR [PREFIX/man]
--srcdir=DIR find the sources in DIR [configure dir or ..]
--program-prefix=PREFIX prepend PREFIX to installed program names
--program-suffix=SUFFIX append SUFFIX to installed program names
--program-transform-name=PROGRAM
run sed PROGRAM on installed program names
EOF
cat << EOF
Host type:
--build=BUILD configure for building on BUILD [BUILD=HOST]
--host=HOST configure for HOST [guessed]
--target=TARGET configure for TARGET [TARGET=HOST]
Features and packages:
--disable-FEATURE do not include FEATURE (same as --enable-FEATURE=no)
--enable-FEATURE[=ARG] include FEATURE [ARG=yes]
--with-PACKAGE[=ARG] use PACKAGE [ARG=yes]
--without-PACKAGE do not use PACKAGE (same as --with-PACKAGE=no)
--x-includes=DIR X include files are in DIR
--x-libraries=DIR X library files are in DIR
EOF
if test -n "$ac_help"; then
echo "--enable and --with options recognized:$ac_help"
fi
exit 0 ;;
-host | --host | --hos | --ho)
ac_prev=host ;;
-host=* | --host=* | --hos=* | --ho=*)
host="$ac_optarg" ;;
-includedir | --includedir | --includedi | --included | --include \
| --includ | --inclu | --incl | --inc)
ac_prev=includedir ;;
-includedir=* | --includedir=* | --includedi=* | --included=* | --include=* \
| --includ=* | --inclu=* | --incl=* | --inc=*)
includedir="$ac_optarg" ;;
-infodir | --infodir | --infodi | --infod | --info | --inf)
ac_prev=infodir ;;
-infodir=* | --infodir=* | --infodi=* | --infod=* | --info=* | --inf=*)
infodir="$ac_optarg" ;;
-libdir | --libdir | --libdi | --libd)
ac_prev=libdir ;;
-libdir=* | --libdir=* | --libdi=* | --libd=*)
libdir="$ac_optarg" ;;
-libexecdir | --libexecdir | --libexecdi | --libexecd | --libexec \
| --libexe | --libex | --libe)
ac_prev=libexecdir ;;
-libexecdir=* | --libexecdir=* | --libexecdi=* | --libexecd=* | --libexec=* \
| --libexe=* | --libex=* | --libe=*)
libexecdir="$ac_optarg" ;;
-localstatedir | --localstatedir | --localstatedi | --localstated \
| --localstate | --localstat | --localsta | --localst \
| --locals | --local | --loca | --loc | --lo)
ac_prev=localstatedir ;;
-localstatedir=* | --localstatedir=* | --localstatedi=* | --localstated=* \
| --localstate=* | --localstat=* | --localsta=* | --localst=* \
| --locals=* | --local=* | --loca=* | --loc=* | --lo=*)
localstatedir="$ac_optarg" ;;
-mandir | --mandir | --mandi | --mand | --man | --ma | --m)
ac_prev=mandir ;;
-mandir=* | --mandir=* | --mandi=* | --mand=* | --man=* | --ma=* | --m=*)
mandir="$ac_optarg" ;;
-nfp | --nfp | --nf)
# Obsolete; use --without-fp.
with_fp=no ;;
-no-create | --no-create | --no-creat | --no-crea | --no-cre \
| --no-cr | --no-c)
no_create=yes ;;
-no-recursion | --no-recursion | --no-recursio | --no-recursi \
| --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r)
no_recursion=yes ;;
-oldincludedir | --oldincludedir | --oldincludedi | --oldincluded \
| --oldinclude | --oldinclud | --oldinclu | --oldincl | --oldinc \
| --oldin | --oldi | --old | --ol | --o)
ac_prev=oldincludedir ;;
-oldincludedir=* | --oldincludedir=* | --oldincludedi=* | --oldincluded=* \
| --oldinclude=* | --oldinclud=* | --oldinclu=* | --oldincl=* | --oldinc=* \
| --oldin=* | --oldi=* | --old=* | --ol=* | --o=*)
oldincludedir="$ac_optarg" ;;
-prefix | --prefix | --prefi | --pref | --pre | --pr | --p)
ac_prev=prefix ;;
-prefix=* | --prefix=* | --prefi=* | --pref=* | --pre=* | --pr=* | --p=*)
prefix="$ac_optarg" ;;
-program-prefix | --program-prefix | --program-prefi | --program-pref \
| --program-pre | --program-pr | --program-p)
ac_prev=program_prefix ;;
-program-prefix=* | --program-prefix=* | --program-prefi=* \
| --program-pref=* | --program-pre=* | --program-pr=* | --program-p=*)
program_prefix="$ac_optarg" ;;
-program-suffix | --program-suffix | --program-suffi | --program-suff \
| --program-suf | --program-su | --program-s)
ac_prev=program_suffix ;;
-program-suffix=* | --program-suffix=* | --program-suffi=* \
| --program-suff=* | --program-suf=* | --program-su=* | --program-s=*)
program_suffix="$ac_optarg" ;;
-program-transform-name | --program-transform-name \
| --program-transform-nam | --program-transform-na \
| --program-transform-n | --program-transform- \
| --program-transform | --program-transfor \
| --program-transfo | --program-transf \
| --program-trans | --program-tran \
| --progr-tra | --program-tr | --program-t)
ac_prev=program_transform_name ;;
-program-transform-name=* | --program-transform-name=* \
| --program-transform-nam=* | --program-transform-na=* \
| --program-transform-n=* | --program-transform-=* \
| --program-transform=* | --program-transfor=* \
| --program-transfo=* | --program-transf=* \
| --program-trans=* | --program-tran=* \
| --progr-tra=* | --program-tr=* | --program-t=*)
program_transform_name="$ac_optarg" ;;
-q | -quiet | --quiet | --quie | --qui | --qu | --q \
| -silent | --silent | --silen | --sile | --sil)
silent=yes ;;
-sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb)
ac_prev=sbindir ;;
-sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \
| --sbi=* | --sb=*)
sbindir="$ac_optarg" ;;
-sharedstatedir | --sharedstatedir | --sharedstatedi \
| --sharedstated | --sharedstate | --sharedstat | --sharedsta \
| --sharedst | --shareds | --shared | --share | --shar \
| --sha | --sh)
ac_prev=sharedstatedir ;;
-sharedstatedir=* | --sharedstatedir=* | --sharedstatedi=* \
| --sharedstated=* | --sharedstate=* | --sharedstat=* | --sharedsta=* \
| --sharedst=* | --shareds=* | --shared=* | --share=* | --shar=* \
| --sha=* | --sh=*)
sharedstatedir="$ac_optarg" ;;
-site | --site | --sit)
ac_prev=site ;;
-site=* | --site=* | --sit=*)
site="$ac_optarg" ;;
-srcdir | --srcdir | --srcdi | --srcd | --src | --sr)
ac_prev=srcdir ;;
-srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*)
srcdir="$ac_optarg" ;;
-sysconfdir | --sysconfdir | --sysconfdi | --sysconfd | --sysconf \
| --syscon | --sysco | --sysc | --sys | --sy)
ac_prev=sysconfdir ;;
-sysconfdir=* | --sysconfdir=* | --sysconfdi=* | --sysconfd=* | --sysconf=* \
| --syscon=* | --sysco=* | --sysc=* | --sys=* | --sy=*)
sysconfdir="$ac_optarg" ;;
-target | --target | --targe | --targ | --tar | --ta | --t)
ac_prev=target ;;
-target=* | --target=* | --targe=* | --targ=* | --tar=* | --ta=* | --t=*)
target="$ac_optarg" ;;
-v | -verbose | --verbose | --verbos | --verbo | --verb)
verbose=yes ;;
-version | --version | --versio | --versi | --vers)
echo "configure generated by autoconf version 2.12.1"
exit 0 ;;
-with-* | --with-*)
ac_package=`echo $ac_option|sed -e 's/-*with-//' -e 's/=.*//'`
# Reject names that are not valid shell variable names.
if test -n "`echo $ac_package| sed 's/[-_a-zA-Z0-9]//g'`"; then
{ echo "configure: error: $ac_package: invalid package name" 1>&2; exit 1; }
fi
ac_package=`echo $ac_package| sed 's/-/_/g'`
case "$ac_option" in
*=*) ;;
*) ac_optarg=yes ;;
esac
eval "with_${ac_package}='$ac_optarg'" ;;
-without-* | --without-*)
ac_package=`echo $ac_option|sed -e 's/-*without-//'`
# Reject names that are not valid shell variable names.
if test -n "`echo $ac_package| sed 's/[-a-zA-Z0-9_]//g'`"; then
{ echo "configure: error: $ac_package: invalid package name" 1>&2; exit 1; }
fi
ac_package=`echo $ac_package| sed 's/-/_/g'`
eval "with_${ac_package}=no" ;;
--x)
# Obsolete; use --with-x.
with_x=yes ;;
-x-includes | --x-includes | --x-include | --x-includ | --x-inclu \
| --x-incl | --x-inc | --x-in | --x-i)
ac_prev=x_includes ;;
-x-includes=* | --x-includes=* | --x-include=* | --x-includ=* | --x-inclu=* \
| --x-incl=* | --x-inc=* | --x-in=* | --x-i=*)
x_includes="$ac_optarg" ;;
-x-libraries | --x-libraries | --x-librarie | --x-librari \
| --x-librar | --x-libra | --x-libr | --x-lib | --x-li | --x-l)
ac_prev=x_libraries ;;
-x-libraries=* | --x-libraries=* | --x-librarie=* | --x-librari=* \
| --x-librar=* | --x-libra=* | --x-libr=* | --x-lib=* | --x-li=* | --x-l=*)
x_libraries="$ac_optarg" ;;
-*) { echo "configure: error: $ac_option: invalid option; use --help to show usage" 1>&2; exit 1; }
;;
*)
if test -n "`echo $ac_option| sed 's/[-a-z0-9.]//g'`"; then
echo "configure: warning: $ac_option: invalid host type" 1>&2
fi
if test "x$nonopt" != xNONE; then
{ echo "configure: error: can only configure for one host and one target at a time" 1>&2; exit 1; }
fi
nonopt="$ac_option"
;;
esac
done
if test -n "$ac_prev"; then
{ echo "configure: error: missing argument to --`echo $ac_prev | sed 's/_/-/g'`" 1>&2; exit 1; }
fi
trap 'rm -fr conftest* confdefs* core core.* *.core $ac_clean_files; exit 1' 1 2 15
# File descriptor usage:
# 0 standard input
# 1 file creation
# 2 errors and warnings
# 3 some systems may open it to /dev/tty
# 4 used on the Kubota Titan
# 6 checking for... messages and results
# 5 compiler messages saved in config.log
if test "$silent" = yes; then
exec 6>/dev/null
else
exec 6>&1
fi
exec 5>./config.log
echo "\
This file contains any messages produced by compilers while
running configure, to aid debugging if configure makes a mistake.
" 1>&5
# Strip out --no-create and --no-recursion so they do not pile up.
# Also quote any args containing shell metacharacters.
ac_configure_args=
for ac_arg
do
case "$ac_arg" in
-no-create | --no-create | --no-creat | --no-crea | --no-cre \
| --no-cr | --no-c) ;;
-no-recursion | --no-recursion | --no-recursio | --no-recursi \
| --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r) ;;
*" "*|*" "*|*[\[\]\~\#\$\^\&\*\(\)\{\}\\\|\;\<\>\?]*)
ac_configure_args="$ac_configure_args '$ac_arg'" ;;
*) ac_configure_args="$ac_configure_args $ac_arg" ;;
esac
done
# NLS nuisances.
# Only set these to C if already set. These must not be set unconditionally
# because not all systems understand e.g. LANG=C (notably SCO).
# Fixing LC_MESSAGES prevents Solaris sh from translating var values in `set'!
# Non-C LC_CTYPE values break the ctype check.
if test "${LANG+set}" = set; then LANG=C; export LANG; fi
if test "${LC_ALL+set}" = set; then LC_ALL=C; export LC_ALL; fi
if test "${LC_MESSAGES+set}" = set; then LC_MESSAGES=C; export LC_MESSAGES; fi
if test "${LC_CTYPE+set}" = set; then LC_CTYPE=C; export LC_CTYPE; fi
# confdefs.h avoids OS command line length limits that DEFS can exceed.
rm -rf conftest* confdefs.h
# AIX cpp loses on an empty file, so make sure it contains at least a newline.
echo > confdefs.h
# A filename unique to this package, relative to the directory that
# configure is in, which we can look for to find out if srcdir is correct.
ac_unique_file=access_.c
# Find the source files, if location was not specified.
if test -z "$srcdir"; then
ac_srcdir_defaulted=yes
# Try the directory containing this script, then its parent.
ac_prog=$0
ac_confdir=`echo $ac_prog|sed 's%/[^/][^/]*$%%'`
test "x$ac_confdir" = "x$ac_prog" && ac_confdir=.
srcdir=$ac_confdir
if test ! -r $srcdir/$ac_unique_file; then
srcdir=..
fi
else
ac_srcdir_defaulted=no
fi
if test ! -r $srcdir/$ac_unique_file; then
if test "$ac_srcdir_defaulted" = yes; then
{ echo "configure: error: can not find sources in $ac_confdir or .." 1>&2; exit 1; }
else
{ echo "configure: error: can not find sources in $srcdir" 1>&2; exit 1; }
fi
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"
fi
fi
for ac_site_file in $CONFIG_SITE; do
if test -r "$ac_site_file"; then
echo "loading site script $ac_site_file"
. "$ac_site_file"
fi
done
if test -r "$cache_file"; then
echo "loading cache $cache_file"
. $cache_file
else
echo "creating cache $cache_file"
> $cache_file
fi
ac_ext=c
# CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options.
ac_cpp='$CPP $CPPFLAGS'
ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5'
ac_link='${CC-cc} -o conftest $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5'
cross_compiling=$ac_cv_prog_cc_cross
if (echo "testing\c"; echo 1,2,3) | grep c >/dev/null; then
# Stardent Vistra SVR4 grep lacks -e, says ghazi@caip.rutgers.edu.
if (echo -n testing; echo 1,2,3) | sed s/-n/xn/ | grep xn >/dev/null; then
ac_n= ac_c='
' ac_t=' '
else
ac_n=-n ac_c= ac_t=
fi
else
ac_n= ac_c='\c' ac_t=
fi
# For g77 we'll set CC to point at the built gcc, but this will get it into
# the makefiles
# 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:530: 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
if test -n "$CC"; then
ac_cv_prog_CC="$CC" # Let the user override the test.
else
IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS="${IFS}:"
for ac_dir in $PATH; do
test -z "$ac_dir" && ac_dir=.
if test -f $ac_dir/$ac_word; then
ac_cv_prog_CC="gcc"
break
fi
done
IFS="$ac_save_ifs"
fi
fi
CC="$ac_cv_prog_CC"
if test -n "$CC"; then
echo "$ac_t""$CC" 1>&6
else
echo "$ac_t""no" 1>&6
fi
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:559: 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
if test -n "$CC"; then
ac_cv_prog_CC="$CC" # Let the user override the test.
else
IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS="${IFS}:"
ac_prog_rejected=no
for ac_dir in $PATH; do
test -z "$ac_dir" && ac_dir=.
if test -f $ac_dir/$ac_word; then
if test "$ac_dir/$ac_word" = "/usr/ucb/cc"; then
ac_prog_rejected=yes
continue
fi
ac_cv_prog_CC="cc"
break
fi
done
IFS="$ac_save_ifs"
if test $ac_prog_rejected = yes; then
# We found a bogon in the path, so make sure we never use it.
set dummy $ac_cv_prog_CC
shift
if test $# -gt 0; then
# We chose a different compiler from the bogus one.
# However, it has the same basename, so the bogon will be chosen
# first if we set CC to just the basename; use the full file name.
shift
set dummy "$ac_dir/$ac_word" "$@"
shift
ac_cv_prog_CC="$@"
fi
fi
fi
fi
CC="$ac_cv_prog_CC"
if test -n "$CC"; then
echo "$ac_t""$CC" 1>&6
else
echo "$ac_t""no" 1>&6
fi
test -z "$CC" && { echo "configure: error: no acceptable cc found in \$PATH" 1>&2; exit 1; }
fi
echo $ac_n "checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works""... $ac_c" 1>&6
echo "configure:607: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works" >&5
ac_ext=c
# CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options.
ac_cpp='$CPP $CPPFLAGS'
ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5'
ac_link='${CC-cc} -o conftest $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5'
cross_compiling=$ac_cv_prog_cc_cross
cat > conftest.$ac_ext <<EOF
#line 617 "configure"
#include "confdefs.h"
main(){return(0);}
EOF
if { (eval echo configure:621: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then
ac_cv_prog_cc_works=yes
# If we can't run a trivial program, we are probably using a cross compiler.
if (./conftest; exit) 2>/dev/null; then
ac_cv_prog_cc_cross=no
else
ac_cv_prog_cc_cross=yes
fi
else
echo "configure: failed program was:" >&5
cat conftest.$ac_ext >&5
ac_cv_prog_cc_works=no
fi
rm -fr conftest*
echo "$ac_t""$ac_cv_prog_cc_works" 1>&6
if test $ac_cv_prog_cc_works = no; then
{ echo "configure: error: installation or configuration problem: C compiler cannot create executables." 1>&2; exit 1; }
fi
echo $ac_n "checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler""... $ac_c" 1>&6
echo "configure:641: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler" >&5
echo "$ac_t""$ac_cv_prog_cc_cross" 1>&6
cross_compiling=$ac_cv_prog_cc_cross
echo $ac_n "checking whether we are using GNU C""... $ac_c" 1>&6
echo "configure:646: 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
cat > conftest.c <<EOF
#ifdef __GNUC__
yes;
#endif
EOF
if { ac_try='${CC-cc} -E conftest.c'; { (eval echo configure:655: \"$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
fi
fi
echo "$ac_t""$ac_cv_prog_gcc" 1>&6
if test $ac_cv_prog_gcc = yes; then
GCC=yes
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:670: 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
echo 'void f(){}' > conftest.c
if test -z "`${CC-cc} -g -c conftest.c 2>&1`"; then
ac_cv_prog_cc_g=yes
else
ac_cv_prog_cc_g=no
fi
rm -f conftest*
fi
echo "$ac_t""$ac_cv_prog_cc_g" 1>&6
if test "$ac_test_CFLAGS" = set; then
CFLAGS="$ac_save_CFLAGS"
elif test $ac_cv_prog_cc_g = yes; then
CFLAGS="-g -O2"
else
CFLAGS="-O2"
fi
else
GCC=
test "${CFLAGS+set}" = set || CFLAGS="-g"
fi
if test "$CROSS";then
ac_cv_c_cross=yes
else
ac_cv_c_cross=no
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:706: 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
case "$ac_cv_prog_chmod" in
/*)
ac_cv_path_ac_cv_prog_chmod="$ac_cv_prog_chmod" # Let the user override the test with a path.
;;
?:/*)
ac_cv_path_ac_cv_prog_chmod="$ac_cv_prog_chmod" # Let the user override the test with a dos path.
;;
*)
IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS="${IFS}:"
for ac_dir in $PATH; do
test -z "$ac_dir" && ac_dir=.
if test -f $ac_dir/$ac_word; then
ac_cv_path_ac_cv_prog_chmod="$ac_dir/$ac_word"
break
fi
done
IFS="$ac_save_ifs"
test -z "$ac_cv_path_ac_cv_prog_chmod" && ac_cv_path_ac_cv_prog_chmod="no"
;;
esac
fi
ac_cv_prog_chmod="$ac_cv_path_ac_cv_prog_chmod"
if test -n "$ac_cv_prog_chmod"; then
echo "$ac_t""$ac_cv_prog_chmod" 1>&6
else
echo "$ac_t""no" 1>&6
fi
if test "$ac_cv_prog_chmod" != no || test "$CROSS"; then
MAYBES=chmod_.o
cat >> confdefs.h <<EOF
#define CHMOD_PATH "$ac_cv_prog_chmod"
EOF
else
MAYBES=""
fi
if test "$ac_cv_c_cross" = yes; then
RANLIB=$RANLIB_FOR_TARGET
AR=$AR_FOR_TARGET
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:756: 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
if test -n "$RANLIB"; then
ac_cv_prog_RANLIB="$RANLIB" # Let the user override the test.
else
IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS="${IFS}:"
for ac_dir in $PATH; do
test -z "$ac_dir" && ac_dir=.
if test -f $ac_dir/$ac_word; then
ac_cv_prog_RANLIB="ranlib"
break
fi
done
IFS="$ac_save_ifs"
test -z "$ac_cv_prog_RANLIB" && ac_cv_prog_RANLIB=":"
fi
fi
RANLIB="$ac_cv_prog_RANLIB"
if test -n "$RANLIB"; then
echo "$ac_t""$RANLIB" 1>&6
else
echo "$ac_t""no" 1>&6
fi
AR=ar
RANLIB_TEST=true
fi
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
# On Suns, sometimes $CPP names a directory.
if test -n "$CPP" && test -d "$CPP"; then
CPP=
fi
if test -z "$CPP"; then
if eval "test \"`echo '$''{'ac_cv_prog_CPP'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
# This must be in double quotes, not single quotes, because CPP may get
# substituted into the Makefile and "${CC-cc}" will confuse make.
CPP="${CC-cc} -E"
# 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"
#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; }
ac_err=`grep -v '^ *+' conftest.out`
if test -z "$ac_err"; then
:
else
echo "$ac_err" >&5
echo "configure: failed program was:" >&5
cat conftest.$ac_ext >&5
rm -rf conftest*
CPP="${CC-cc} -E -traditional-cpp"
cat > conftest.$ac_ext <<EOF
#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:827: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
ac_err=`grep -v '^ *+' conftest.out`
if test -z "$ac_err"; then
:
else
echo "$ac_err" >&5
echo "configure: failed program was:" >&5
cat conftest.$ac_ext >&5
rm -rf conftest*
CPP=/lib/cpp
fi
rm -f conftest*
fi
rm -f conftest*
ac_cv_prog_CPP="$CPP"
fi
CPP="$ac_cv_prog_CPP"
else
ac_cv_prog_CPP="$CPP"
fi
echo "$ac_t""$CPP" 1>&6
echo $ac_n "checking for ANSI C header files""... $ac_c" 1>&6
echo "configure:850: 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 855 "configure"
#include "confdefs.h"
#include <stdlib.h>
#include <stdarg.h>
#include <string.h>
#include <float.h>
EOF
ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
{ (eval echo configure:863: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
ac_err=`grep -v '^ *+' conftest.out`
if test -z "$ac_err"; then
rm -rf conftest*
ac_cv_header_stdc=yes
else
echo "$ac_err" >&5
echo "configure: failed program was:" >&5
cat conftest.$ac_ext >&5
rm -rf conftest*
ac_cv_header_stdc=no
fi
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 880 "configure"
#include "confdefs.h"
#include <string.h>
EOF
if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
egrep "memchr" >/dev/null 2>&1; then
:
else
rm -rf conftest*
ac_cv_header_stdc=no
fi
rm -f conftest*
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 898 "configure"
#include "confdefs.h"
#include <stdlib.h>
EOF
if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
egrep "free" >/dev/null 2>&1; then
:
else
rm -rf conftest*
ac_cv_header_stdc=no
fi
rm -f conftest*
fi
if test $ac_cv_header_stdc = yes; then
# /bin/cc in Irix-4.0.5 gets non-ANSI ctype macros unless using -ansi.
if test "$cross_compiling" = yes; then
:
else
cat > conftest.$ac_ext <<EOF
#line 919 "configure"
#include "confdefs.h"
#include <ctype.h>
#define ISLOWER(c) ('a' <= (c) && (c) <= 'z')
#define TOUPPER(c) (ISLOWER(c) ? 'A' + ((c) - 'a') : (c))
#define XOR(e, f) (((e) && !(f)) || (!(e) && (f)))
int main () { int i; for (i = 0; i < 256; i++)
if (XOR (islower (i), ISLOWER (i)) || toupper (i) != TOUPPER (i)) exit(2);
exit (0); }
EOF
if { (eval echo configure:930: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>/dev/null
then
:
else
echo "configure: failed program was:" >&5
cat conftest.$ac_ext >&5
rm -fr conftest*
ac_cv_header_stdc=no
fi
rm -fr conftest*
fi
fi
fi
echo "$ac_t""$ac_cv_header_stdc" 1>&6
if test $ac_cv_header_stdc = yes; then
cat >> confdefs.h <<\EOF
#define STDC_HEADERS 1
EOF
fi
echo $ac_n "checking whether time.h and sys/time.h may both be included""... $ac_c" 1>&6
echo "configure:955: 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 960 "configure"
#include "confdefs.h"
#include <sys/types.h>
#include <sys/time.h>
#include <time.h>
int main() {
struct tm *tp;
; return 0; }
EOF
if { (eval echo configure:969: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
rm -rf conftest*
ac_cv_header_time=yes
else
echo "configure: failed program was:" >&5
cat conftest.$ac_ext >&5
rm -rf conftest*
ac_cv_header_time=no
fi
rm -f conftest*
fi
echo "$ac_t""$ac_cv_header_time" 1>&6
if test $ac_cv_header_time = yes; then
cat >> confdefs.h <<\EOF
#define TIME_WITH_SYS_TIME 1
EOF
fi
for ac_hdr in limits.h unistd.h sys/time.h string.h stdlib.h \
sys/param.h sys/times.h
do
ac_safe=`echo "$ac_hdr" | sed 'y%./+-%__p_%'`
echo $ac_n "checking for $ac_hdr""... $ac_c" 1>&6
echo "configure:994: 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 999 "configure"
#include "confdefs.h"
#include <$ac_hdr>
EOF
ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
{ (eval echo configure:1004: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
ac_err=`grep -v '^ *+' conftest.out`
if test -z "$ac_err"; then
rm -rf conftest*
eval "ac_cv_header_$ac_safe=yes"
else
echo "$ac_err" >&5
echo "configure: failed program was:" >&5
cat conftest.$ac_ext >&5
rm -rf conftest*
eval "ac_cv_header_$ac_safe=no"
fi
rm -f conftest*
fi
if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then
echo "$ac_t""yes" 1>&6
ac_tr_hdr=HAVE_`echo $ac_hdr | sed 'y%abcdefghijklmnopqrstuvwxyz./-%ABCDEFGHIJKLMNOPQRSTUVWXYZ___%'`
cat >> confdefs.h <<EOF
#define $ac_tr_hdr 1
EOF
else
echo "$ac_t""no" 1>&6
fi
done
echo $ac_n "checking for working const""... $ac_c" 1>&6
echo "configure:1032: 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 1037 "configure"
#include "confdefs.h"
int main() {
/* Ultrix mips cc rejects this. */
typedef int charset[2]; const charset x;
/* SunOS 4.1.1 cc rejects this. */
char const *const *ccp;
char **p;
/* NEC SVR4.0.2 mips cc rejects this. */
struct point {int x, y;};
static struct point const zero = {0,0};
/* AIX XL C 1.02.0.0 rejects this.
It does not let you subtract one const X* pointer from another in an arm
of an if-expression whose if-part is not a constant expression */
const char *g = "string";
ccp = &g + (g ? g-g : 0);
/* HPUX 7.0 cc rejects these. */
++ccp;
p = (char**) ccp;
ccp = (char const *const *) p;
{ /* SCO 3.2v4 cc rejects this. */
char *t;
char const *s = 0 ? (char *) 0 : (char const *) 0;
*t++ = 0;
}
{ /* Someone thinks the Sun supposedly-ANSI compiler will reject this. */
int x[] = {25, 17};
const int *foo = &x[0];
++foo;
}
{ /* Sun SC1.0 ANSI compiler rejects this -- but not the above. */
typedef const int *iptr;
iptr p = 0;
++p;
}
{ /* AIX XL C 1.02.0.0 rejects this saying
"k.c", line 2.27: 1506-025 (S) Operand must be a modifiable lvalue. */
struct s { int j; const int *ap[3]; };
struct s *b; b->j = 5;
}
{ /* ULTRIX-32 V3.1 (Rev 9) vcc rejects this */
const int foo = 10;
}
; return 0; }
EOF
if { (eval echo configure:1086: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
rm -rf conftest*
ac_cv_c_const=yes
else
echo "configure: failed program was:" >&5
cat conftest.$ac_ext >&5
rm -rf conftest*
ac_cv_c_const=no
fi
rm -f conftest*
fi
echo "$ac_t""$ac_cv_c_const" 1>&6
if test $ac_cv_c_const = no; then
cat >> confdefs.h <<\EOF
#define const
EOF
fi
echo $ac_n "checking for size_t""... $ac_c" 1>&6
echo "configure:1107: 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 1112 "configure"
#include "confdefs.h"
#include <sys/types.h>
#if STDC_HEADERS
#include <stdlib.h>
#include <stddef.h>
#endif
EOF
if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
egrep "size_t[^a-zA-Z_0-9]" >/dev/null 2>&1; then
rm -rf conftest*
ac_cv_type_size_t=yes
else
rm -rf conftest*
ac_cv_type_size_t=no
fi
rm -f conftest*
fi
echo "$ac_t""$ac_cv_type_size_t" 1>&6
if test $ac_cv_type_size_t = no; then
cat >> confdefs.h <<\EOF
#define size_t unsigned
EOF
fi
echo $ac_n "checking for mode_t""... $ac_c" 1>&6
echo "configure:1140: 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 1145 "configure"
#include "confdefs.h"
#include <sys/types.h>
#if STDC_HEADERS
#include <stdlib.h>
#include <stddef.h>
#endif
EOF
if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
egrep "mode_t[^a-zA-Z_0-9]" >/dev/null 2>&1; then
rm -rf conftest*
ac_cv_type_mode_t=yes
else
rm -rf conftest*
ac_cv_type_mode_t=no
fi
rm -f conftest*
fi
echo "$ac_t""$ac_cv_type_mode_t" 1>&6
if test $ac_cv_type_mode_t = no; then
cat >> confdefs.h <<\EOF
#define mode_t int
EOF
fi
echo $ac_n "checking for pid_t""... $ac_c" 1>&6
echo "configure:1174: 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 1179 "configure"
#include "confdefs.h"
#include <sys/types.h>
#if STDC_HEADERS
#include <stdlib.h>
#include <stddef.h>
#endif
EOF
if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
egrep "pid_t[^a-zA-Z_0-9]" >/dev/null 2>&1; then
rm -rf conftest*
ac_cv_type_pid_t=yes
else
rm -rf conftest*
ac_cv_type_pid_t=no
fi
rm -f conftest*
fi
echo "$ac_t""$ac_cv_type_pid_t" 1>&6
if test $ac_cv_type_pid_t = no; then
cat >> confdefs.h <<\EOF
#define pid_t int
EOF
fi
echo $ac_n "checking for st_blksize in struct stat""... $ac_c" 1>&6
echo "configure:1207: 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 1212 "configure"
#include "confdefs.h"
#include <sys/types.h>
#include <sys/stat.h>
int main() {
struct stat s; s.st_blksize;
; return 0; }
EOF
if { (eval echo configure:1220: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
rm -rf conftest*
ac_cv_struct_st_blksize=yes
else
echo "configure: failed program was:" >&5
cat conftest.$ac_ext >&5
rm -rf conftest*
ac_cv_struct_st_blksize=no
fi
rm -f conftest*
fi
echo "$ac_t""$ac_cv_struct_st_blksize" 1>&6
if test $ac_cv_struct_st_blksize = yes; then
cat >> confdefs.h <<\EOF
#define HAVE_ST_BLKSIZE 1
EOF
fi
echo $ac_n "checking for st_blocks in struct stat""... $ac_c" 1>&6
echo "configure:1241: 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 1246 "configure"
#include "confdefs.h"
#include <sys/types.h>
#include <sys/stat.h>
int main() {
struct stat s; s.st_blocks;
; return 0; }
EOF
if { (eval echo configure:1254: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
rm -rf conftest*
ac_cv_struct_st_blocks=yes
else
echo "configure: failed program was:" >&5
cat conftest.$ac_ext >&5
rm -rf conftest*
ac_cv_struct_st_blocks=no
fi
rm -f conftest*
fi
echo "$ac_t""$ac_cv_struct_st_blocks" 1>&6
if test $ac_cv_struct_st_blocks = yes; then
cat >> confdefs.h <<\EOF
#define HAVE_ST_BLOCKS 1
EOF
else
LIBOBJS="$LIBOBJS fileblocks.o"
fi
echo $ac_n "checking for st_rdev in struct stat""... $ac_c" 1>&6
echo "configure:1277: 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 1282 "configure"
#include "confdefs.h"
#include <sys/types.h>
#include <sys/stat.h>
int main() {
struct stat s; s.st_rdev;
; return 0; }
EOF
if { (eval echo configure:1290: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
rm -rf conftest*
ac_cv_struct_st_rdev=yes
else
echo "configure: failed program was:" >&5
cat conftest.$ac_ext >&5
rm -rf conftest*
ac_cv_struct_st_rdev=no
fi
rm -f conftest*
fi
echo "$ac_t""$ac_cv_struct_st_rdev" 1>&6
if test $ac_cv_struct_st_rdev = yes; then
cat >> confdefs.h <<\EOF
#define HAVE_ST_RDEV 1
EOF
fi
echo $ac_n "checking whether struct tm is in sys/time.h or time.h""... $ac_c" 1>&6
echo "configure:1311: 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 1316 "configure"
#include "confdefs.h"
#include <sys/types.h>
#include <time.h>
int main() {
struct tm *tp; tp->tm_sec;
; return 0; }
EOF
if { (eval echo configure:1324: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
rm -rf conftest*
ac_cv_struct_tm=time.h
else
echo "configure: failed program was:" >&5
cat conftest.$ac_ext >&5
rm -rf conftest*
ac_cv_struct_tm=sys/time.h
fi
rm -f conftest*
fi
echo "$ac_t""$ac_cv_struct_tm" 1>&6
if test $ac_cv_struct_tm = sys/time.h; then
cat >> confdefs.h <<\EOF
#define TM_IN_SYS_TIME 1
EOF
fi
for ac_func in symlink getcwd getwd lstat gethostname strerror clock \
getrusage times alarm
do
echo $ac_n "checking for $ac_func""... $ac_c" 1>&6
echo "configure:1350: 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 1355 "configure"
#include "confdefs.h"
/* System header to define __stub macros and hopefully few prototypes,
which can conflict with char $ac_func(); below. */
#include <assert.h>
/* Override any gcc2 internal prototype to avoid an error. */
/* We use char because int might match the return type of a gcc2
builtin and then its argument prototype would still apply. */
char $ac_func();
int main() {
/* The GNU C library defines this for functions which it implements
to always fail with ENOSYS. Some functions are actually named
something starting with __ and the normal name is an alias. */
#if defined (__stub_$ac_func) || defined (__stub___$ac_func)
choke me
#else
$ac_func();
#endif
; return 0; }
EOF
if { (eval echo configure:1378: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then
rm -rf conftest*
eval "ac_cv_func_$ac_func=yes"
else
echo "configure: failed program was:" >&5
cat conftest.$ac_ext >&5
rm -rf conftest*
eval "ac_cv_func_$ac_func=no"
fi
rm -f conftest*
fi
if eval "test \"`echo '$ac_cv_func_'$ac_func`\" = yes"; then
echo "$ac_t""yes" 1>&6
ac_tr_func=HAVE_`echo $ac_func | tr 'abcdefghijklmnopqrstuvwxyz' 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'`
cat >> confdefs.h <<EOF
#define $ac_tr_func 1
EOF
else
echo "$ac_t""no" 1>&6
fi
done
test $ac_cv_func_symlink = yes && MAYBES="$MAYBES symlnk_.o"
test $ac_cv_func_lstat = yes && MAYBES="$MAYBES lstat_.o"
test $ac_cv_func_gethostname = yes && MAYBES="$MAYBES hostnm_.o"
test $ac_cv_func_clock = yes && MAYBES="$MAYBES mclock_.o"
trap '' 1 2 15
cat > confcache <<\EOF
# This file is a shell script that caches the results of configure
# tests run on this system so they can be shared between configure
# scripts and configure runs. It is not useful on other systems.
# If it contains results you don't want to keep, you may remove or edit it.
#
# By default, configure uses ./config.cache as the cache file,
# creating it if it does not exist already. You can give configure
# the --cache-file=FILE option to use a different cache file; that is
# what configure does when it calls configure scripts in
# subdirectories, so they share the cache.
# Giving --cache-file=/dev/null disables caching, for debugging configure.
# config.status only pays attention to the cache file if you give it the
# --recheck option to rerun configure.
#
EOF
# The following way of writing the cache mishandles newlines in values,
# but we know of no workaround that is simple, portable, and efficient.
# So, don't put newlines in cache variables' values.
# Ultrix sh set writes to stderr and can't be redirected directly,
# and sets the high bit in the cache file unless we assign to the vars.
(set) 2>&1 |
case `(ac_space=' '; set) 2>&1 | grep ac_space` in
*ac_space=\ *)
# `set' does not quote correctly, so add quotes (double-quote substitution
# turns \\\\ into \\, and sed turns \\ into \).
sed -n \
-e "s/'/'\\\\''/g" \
-e "s/^\\([a-zA-Z0-9_]*_cv_[a-zA-Z0-9_]*\\)=\\(.*\\)/\\1=\${\\1='\\2'}/p"
;;
*)
# `set' quotes correctly as required by POSIX, so do not add quotes.
sed -n -e 's/^\([a-zA-Z0-9_]*_cv_[a-zA-Z0-9_]*\)=\(.*\)/\1=${\1=\2}/p'
;;
esac >> confcache
if cmp -s $cache_file confcache; then
:
else
if test -w $cache_file; then
echo "updating cache $cache_file"
cat confcache > $cache_file
else
echo "not updating unwritable cache $cache_file"
fi
fi
rm -f confcache
trap 'rm -fr conftest* confdefs* core core.* *.core $ac_clean_files; exit 1' 1 2 15
test "x$prefix" = xNONE && prefix=$ac_default_prefix
# Let make expand exec_prefix.
test "x$exec_prefix" = xNONE && exec_prefix='${prefix}'
# Any assignment to VPATH causes Sun make to only execute
# the first set of double-colon rules, so remove it if not needed.
# If there is a colon in the path, we need to keep it.
if test "x$srcdir" = x.; then
ac_vpsub='/^[ ]*VPATH[ ]*=[^:]*$/d'
fi
trap 'rm -f $CONFIG_STATUS conftest*; exit 1' 1 2 15
DEFS=-DHAVE_CONFIG_H
# Without the "./", some shells look in PATH for config.status.
: ${CONFIG_STATUS=./config.status}
echo creating $CONFIG_STATUS
rm -f $CONFIG_STATUS
cat > $CONFIG_STATUS <<EOF
#! /bin/sh
# Generated automatically by configure.
# Run this file to recreate the current configuration.
# This directory was configured as follows,
# on host `(hostname || uname -n) 2>/dev/null | sed 1q`:
#
# $0 $ac_configure_args
#
# Compiler output produced by configure, useful for debugging
# configure, is in ./config.log if it exists.
ac_cs_usage="Usage: $CONFIG_STATUS [--recheck] [--version] [--help]"
for ac_option
do
case "\$ac_option" in
-recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r)
echo "running \${CONFIG_SHELL-/bin/sh} $0 $ac_configure_args --no-create --no-recursion"
exec \${CONFIG_SHELL-/bin/sh} $0 $ac_configure_args --no-create --no-recursion ;;
-version | --version | --versio | --versi | --vers | --ver | --ve | --v)
echo "$CONFIG_STATUS generated by autoconf version 2.12.1"
exit 0 ;;
-help | --help | --hel | --he | --h)
echo "\$ac_cs_usage"; exit 0 ;;
*) echo "\$ac_cs_usage"; exit 1 ;;
esac
done
ac_given_srcdir=$srcdir
trap 'rm -fr `echo "Makefile config.h" | sed "s/:[^ ]*//g"` conftest*; exit 1' 1 2 15
EOF
cat >> $CONFIG_STATUS <<EOF
# Protect against being on the right side of a sed subst in config.status.
sed 's/%@/@@/; s/@%/@@/; s/%g\$/@g/; /@g\$/s/[\\\\&%]/\\\\&/g;
s/@@/%@/; s/@@/@%/; s/@g\$/%g/' > conftest.subs <<\\CEOF
$ac_vpsub
$extrasub
s%@SHELL@%$SHELL%g
s%@CFLAGS@%$CFLAGS%g
s%@CPPFLAGS@%$CPPFLAGS%g
s%@CXXFLAGS@%$CXXFLAGS%g
s%@DEFS@%$DEFS%g
s%@LDFLAGS@%$LDFLAGS%g
s%@LIBS@%$LIBS%g
s%@exec_prefix@%$exec_prefix%g
s%@prefix@%$prefix%g
s%@program_transform_name@%$program_transform_name%g
s%@bindir@%$bindir%g
s%@sbindir@%$sbindir%g
s%@libexecdir@%$libexecdir%g
s%@datadir@%$datadir%g
s%@sysconfdir@%$sysconfdir%g
s%@sharedstatedir@%$sharedstatedir%g
s%@localstatedir@%$localstatedir%g
s%@libdir@%$libdir%g
s%@includedir@%$includedir%g
s%@oldincludedir@%$oldincludedir%g
s%@infodir@%$infodir%g
s%@mandir@%$mandir%g
s%@CC@%$CC%g
s%@ac_cv_prog_chmod@%$ac_cv_prog_chmod%g
s%@RANLIB@%$RANLIB%g
s%@AR@%$AR%g
s%@CPP@%$CPP%g
s%@LIBOBJS@%$LIBOBJS%g
s%@MAYBES@%$MAYBES%g
s%@CROSS@%$CROSS%g
s%@RANLIB_TEST@%$RANLIB_TEST%g
CEOF
EOF
cat >> $CONFIG_STATUS <<\EOF
# Split the substitutions into bite-sized pieces for seds with
# small command number limits, like on Digital OSF/1 and HP-UX.
ac_max_sed_cmds=90 # Maximum number of lines to put in a sed script.
ac_file=1 # Number of current file.
ac_beg=1 # First line for current file.
ac_end=$ac_max_sed_cmds # Line after last line for current file.
ac_more_lines=:
ac_sed_cmds=""
while $ac_more_lines; do
if test $ac_beg -gt 1; then
sed "1,${ac_beg}d; ${ac_end}q" conftest.subs > conftest.s$ac_file
else
sed "${ac_end}q" conftest.subs > conftest.s$ac_file
fi
if test ! -s conftest.s$ac_file; then
ac_more_lines=false
rm -f conftest.s$ac_file
else
if test -z "$ac_sed_cmds"; then
ac_sed_cmds="sed -f conftest.s$ac_file"
else
ac_sed_cmds="$ac_sed_cmds | sed -f conftest.s$ac_file"
fi
ac_file=`expr $ac_file + 1`
ac_beg=$ac_end
ac_end=`expr $ac_end + $ac_max_sed_cmds`
fi
done
if test -z "$ac_sed_cmds"; then
ac_sed_cmds=cat
fi
EOF
cat >> $CONFIG_STATUS <<EOF
CONFIG_FILES=\${CONFIG_FILES-"Makefile"}
EOF
cat >> $CONFIG_STATUS <<\EOF
for ac_file in .. $CONFIG_FILES; do if test "x$ac_file" != x..; then
# Support "outfile[:infile[:infile...]]", defaulting infile="outfile.in".
case "$ac_file" in
*:*) ac_file_in=`echo "$ac_file"|sed 's%[^:]*:%%'`
ac_file=`echo "$ac_file"|sed 's%:.*%%'` ;;
*) ac_file_in="${ac_file}.in" ;;
esac
# Adjust a relative srcdir, top_srcdir, and INSTALL for subdirectories.
# Remove last slash and all that follows it. Not all systems have dirname.
ac_dir=`echo $ac_file|sed 's%/[^/][^/]*$%%'`
if test "$ac_dir" != "$ac_file" && test "$ac_dir" != .; then
# The file is in a subdirectory.
test ! -d "$ac_dir" && mkdir "$ac_dir"
ac_dir_suffix="/`echo $ac_dir|sed 's%^\./%%'`"
# A "../" for each directory in $ac_dir_suffix.
ac_dots=`echo $ac_dir_suffix|sed 's%/[^/]*%../%g'`
else
ac_dir_suffix= ac_dots=
fi
case "$ac_given_srcdir" in
.) srcdir=.
if test -z "$ac_dots"; then top_srcdir=.
else top_srcdir=`echo $ac_dots|sed 's%/$%%'`; fi ;;
/*) srcdir="$ac_given_srcdir$ac_dir_suffix"; top_srcdir="$ac_given_srcdir" ;;
*) # Relative path.
srcdir="$ac_dots$ac_given_srcdir$ac_dir_suffix"
top_srcdir="$ac_dots$ac_given_srcdir" ;;
esac
echo creating "$ac_file"
rm -f "$ac_file"
configure_input="Generated automatically from `echo $ac_file_in|sed 's%.*/%%'` by configure."
case "$ac_file" in
*Makefile*) ac_comsub="1i\\
# $configure_input" ;;
*) ac_comsub= ;;
esac
ac_file_inputs=`echo $ac_file_in|sed -e "s%^%$ac_given_srcdir/%" -e "s%:% $ac_given_srcdir/%g"`
sed -e "$ac_comsub
s%@configure_input@%$configure_input%g
s%@srcdir@%$srcdir%g
s%@top_srcdir@%$top_srcdir%g
" $ac_file_inputs | (eval "$ac_sed_cmds") > $ac_file
fi; done
rm -f conftest.s*
# These sed commands are passed to sed as "A NAME B NAME C VALUE D", where
# NAME is the cpp macro being defined and VALUE is the value it is being given.
#
# ac_d sets the value in "#define NAME VALUE" lines.
ac_dA='s%^\([ ]*\)#\([ ]*define[ ][ ]*\)'
ac_dB='\([ ][ ]*\)[^ ]*%\1#\2'
ac_dC='\3'
ac_dD='%g'
# ac_u turns "#undef NAME" with trailing blanks into "#define NAME VALUE".
ac_uA='s%^\([ ]*\)#\([ ]*\)undef\([ ][ ]*\)'
ac_uB='\([ ]\)%\1#\2define\3'
ac_uC=' '
ac_uD='\4%g'
# ac_e turns "#undef NAME" without trailing blanks into "#define NAME VALUE".
ac_eA='s%^\([ ]*\)#\([ ]*\)undef\([ ][ ]*\)'
ac_eB='$%\1#\2define\3'
ac_eC=' '
ac_eD='%g'
if test "${CONFIG_HEADERS+set}" != set; then
EOF
cat >> $CONFIG_STATUS <<EOF
CONFIG_HEADERS="config.h"
EOF
cat >> $CONFIG_STATUS <<\EOF
fi
for ac_file in .. $CONFIG_HEADERS; do if test "x$ac_file" != x..; then
# Support "outfile[:infile[:infile...]]", defaulting infile="outfile.in".
case "$ac_file" in
*:*) ac_file_in=`echo "$ac_file"|sed 's%[^:]*:%%'`
ac_file=`echo "$ac_file"|sed 's%:.*%%'` ;;
*) ac_file_in="${ac_file}.in" ;;
esac
echo creating $ac_file
rm -f conftest.frag conftest.in conftest.out
ac_file_inputs=`echo $ac_file_in|sed -e "s%^%$ac_given_srcdir/%" -e "s%:% $ac_given_srcdir/%g"`
cat $ac_file_inputs > conftest.in
EOF
# Transform confdefs.h into a sed script conftest.vals that substitutes
# the proper values into config.h.in to produce config.h. And first:
# Protect against being on the right side of a sed subst in config.status.
# Protect against being in an unquoted here document in config.status.
rm -f conftest.vals
cat > conftest.hdr <<\EOF
s/[\\&%]/\\&/g
s%[\\$`]%\\&%g
s%#define \([A-Za-z_][A-Za-z0-9_]*\) *\(.*\)%${ac_dA}\1${ac_dB}\1${ac_dC}\2${ac_dD}%gp
s%ac_d%ac_u%gp
s%ac_u%ac_e%gp
EOF
sed -n -f conftest.hdr confdefs.h > conftest.vals
rm -f conftest.hdr
# This sed command replaces #undef with comments. This is necessary, for
# example, in the case of _POSIX_SOURCE, which is predefined and required
# on some systems where configure will not decide to define it.
cat >> conftest.vals <<\EOF
s%^[ ]*#[ ]*undef[ ][ ]*[a-zA-Z_][a-zA-Z_0-9]*%/* & */%
EOF
# Break up conftest.vals because some shells have a limit on
# the size of here documents, and old seds have small limits too.
rm -f conftest.tail
while :
do
ac_lines=`grep -c . conftest.vals`
# grep -c gives empty output for an empty file on some AIX systems.
if test -z "$ac_lines" || test "$ac_lines" -eq 0; then break; fi
# Write a limited-size here document to conftest.frag.
echo ' cat > conftest.frag <<CEOF' >> $CONFIG_STATUS
sed ${ac_max_here_lines}q conftest.vals >> $CONFIG_STATUS
echo 'CEOF
sed -f conftest.frag conftest.in > conftest.out
rm -f conftest.in
mv conftest.out conftest.in
' >> $CONFIG_STATUS
sed 1,${ac_max_here_lines}d conftest.vals > conftest.tail
rm -f conftest.vals
mv conftest.tail conftest.vals
done
rm -f conftest.vals
cat >> $CONFIG_STATUS <<\EOF
rm -f conftest.frag conftest.h
echo "/* $ac_file. Generated automatically by configure. */" > conftest.h
cat conftest.in >> conftest.h
rm -f conftest.in
if cmp -s $ac_file conftest.h 2>/dev/null; then
echo "$ac_file is unchanged"
rm -f conftest.h
else
# Remove last slash and all that follows it. Not all systems have dirname.
ac_dir=`echo $ac_file|sed 's%/[^/][^/]*$%%'`
if test "$ac_dir" != "$ac_file" && test "$ac_dir" != .; then
# The file is in a subdirectory.
test ! -d "$ac_dir" && mkdir "$ac_dir"
fi
rm -f $ac_file
mv conftest.h $ac_file
fi
fi; done
EOF
cat >> $CONFIG_STATUS <<EOF
EOF
cat >> $CONFIG_STATUS <<\EOF
exit 0
EOF
chmod +x $CONFIG_STATUS
rm -fr confdefs* $ac_clean_files
test "$no_create" = yes || ${CONFIG_SHELL-/bin/sh} $CONFIG_STATUS || exit 1
# Process this file with autoconf to produce a configure script.
# Copyright (C) 1995 Free Software Foundation, Inc.
# Contributed by Dave Love (d.love@dl.ac.uk).
#
#This file is part of the GNU Fortran libU77 library.
#
#This library is free software; you can redistribute it and/or modify
#it under the terms of the GNU General Public License as published by
#the Free Software Foundation; either version 2, or (at your option)
#any later version.
#
#GNU Fortran is distributed in the hope that it will be useful,
#but WITHOUT ANY WARRANTY; without even the implied warranty of
#MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
#GNU Library General Public License for more details.
#
#You should have received a copy of the GNU Library General Public
#License along with GNU Fortran; see the file COPYING. If not, write
#to Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307,
#USA.
AC_INIT(access_.c)
AC_CONFIG_HEADER(config.h)
dnl Checks for programs.
# For g77 we'll set CC to point at the built gcc, but this will get it into
# the makefiles
AC_PROG_CC
dnl AC_C_CROSS
dnl Gives misleading `(cached)' message from the check.
if test "$CROSS";then
ac_cv_c_cross=yes
else
ac_cv_c_cross=no
fi
dnl This is only because we (horribly) punt the chmod job to the program at
dnl present. Note that the result of this test could be wrong in the cross
dnl case.
AC_PATH_PROG(ac_cv_prog_chmod, chmod, no)
if test "$ac_cv_prog_chmod" != no || test "$CROSS"; then
MAYBES=chmod_.o
AC_DEFINE_UNQUOTED(CHMOD_PATH,"$ac_cv_prog_chmod")
else
MAYBES=""
fi
dnl for g77 build maybe use $(RANLIB_FOR_TARGET) always (like wise AR)
if test "$ac_cv_c_cross" = yes; then
RANLIB=$RANLIB_FOR_TARGET
AR=$AR_FOR_TARGET
AC_SUBST(RANLIB)
else
AC_PROG_RANLIB
AR=ar
RANLIB_TEST=true
fi
AC_SUBST(AR)
dnl not needed for g77
dnl AC_SUBST(AR_FOR_TARGET)
dnl AC_SUBST(RANLIB_FOR_TARGET)
dnl AC_SUBST(RANLIB_TEST_FOR_TARGET)
dnl not needed for g77?
dnl AC_PROG_MAKE_SET
dnl Checks for libraries.
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)
dnl Checks for typedefs, structures, and compiler characteristics.
AC_C_CONST
AC_TYPE_SIZE_T
AC_TYPE_MODE_T
AC_TYPE_PID_T
dnl The next 3 demand a dummy fileblocks.o (added to LIBOJS). We don't use
dnl LIBOJS, though.
AC_STRUCT_ST_BLKSIZE
AC_STRUCT_ST_BLOCKS
AC_STRUCT_ST_RDEV
AC_STRUCT_TM
dnl Checks for library functions.
AC_CHECK_FUNCS(symlink getcwd getwd lstat gethostname strerror clock \
getrusage times alarm getlogin getgid getuid kill link ttyname)
test $ac_cv_func_symlink = yes && MAYBES="$MAYBES symlnk_.o"
test $ac_cv_func_lstat = yes && MAYBES="$MAYBES lstat_.o"
test $ac_cv_func_gethostname = yes && MAYBES="$MAYBES hostnm_.o"
test $ac_cv_func_clock = yes && MAYBES="$MAYBES mclock_.o"
AC_SUBST(MAYBES)
AC_SUBST(CROSS)
AC_SUBST(RANLIB)
AC_SUBST(RANLIB_TEST)
AC_OUTPUT(Makefile)
/* Copyright (C) 1995, 1996 Free Software Foundation, Inc.
This file is part of GNU Fortran libU77 library.
This library is free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published
by the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
GNU Fortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with GNU Fortran; see the file COPYING.LIB. If
not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA. */
#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
#if TIME_WITH_SYS_TIME
# include <sys/time.h>
# include <time.h>
#else
# if HAVE_SYS_TIME_H
# include <sys/time.h>
# else
# include <time.h>
# endif
#endif
#if HAVE_STRING_H
# include <string.h>
#else
# include <strings.h>
#endif
#include "f2c.h"
/* may need sys/time.h & long arg for stime (bsd, svr1-3) */
#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
{
int i, l;
int s_copy ();
time_t stime = *xstime;
/* Allow a length other than 24 for compatibility with what other
systems do, despite it being documented as 24. */
s_copy (chtime, ctime (&stime), Lchtime, 24);
}
/* date_.f -- translated by f2c (version 19961001).
You must link the resulting object file with the libraries:
-lf2c -lm (in that order)
*/
#include "f2c.h"
/* Table of constant values */
static integer c__5 = 5;
/* Subroutine */ int G77_date_0 (char *buf, ftnlen buf_len)
{
/* System generated locals */
address a__1[5];
integer i__1, i__2[5];
char ch__1[24];
/* Builtin functions */
/* Subroutine */ int s_copy(), s_cat();
/* Local variables */
static char cbuf[24];
extern integer 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_ */
/* Copyright (C) 1995, 1996 Free Software Foundation, Inc.
This file is part of GNU Fortran libU77 library.
This library is free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published
by the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
GNU Fortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with GNU Fortran; see the file COPYING.LIB. If
not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA. */
#include "f2c.h"
#include <math.h>
#if 0 /* Don't include these unless necessary -- dnp. */
double G77_dbesj0_0 (const double *x) {
return j0 (*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_dbesy0_0 (const double *x) {
return y0 (*x);
}
double G77_dbesy1_0 (const double *x) {
return y1 (*x);
}
double G77_dbesyn_0 (const integer *n, double *x) {
return yn (*n, *x);
}
#endif
/* Copyright (C) 1995, 1996 Free Software Foundation, Inc.
This file is part of GNU Fortran libU77 library.
This library is free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published
by the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
GNU Fortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with GNU Fortran; see the file COPYING.LIB. If
not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA. */
#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
#if HAVE_UNISTD_H
# include <unistd.h>
#endif
#include <sys/types.h>
#if HAVE_SYS_TIMES_H
# include <sys/times.h>
#endif
#if HAVE_SYS_PARAM_H
# include <sys/param.h>
#endif
#if HAVE_GETRUSAGE
# include <sys/time.h>
# include <sys/resource.h>
#endif
#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
{
#if defined (HAVE_GETRUSAGE) || defined (HAVE_TIMES)
/* The getrusage version is only the default for convenience. */
#ifdef HAVE_GETRUSAGE
float utime, stime;
static float old_utime = 0.0, old_stime = 0.0;
struct rusage rbuff;
if (getrusage (RUSAGE_SELF, &rbuff) != 0)
abort ();
utime = (float) (rbuff.ru_utime).tv_sec +
(float) (rbuff.ru_utime).tv_usec/1000000.0;
tarray[0] = utime - (float) old_utime;
stime = (float) (rbuff.ru_stime).tv_sec +
(float) (rbuff.ru_stime).tv_usec/1000000.0;
tarray[1] = stime - old_stime;
#else /* HAVE_GETRUSAGE */
time_t utime, stime;
static time_t old_utime = 0, old_stime = 0;
struct tms buffer;
/* NeXTStep seems to define _SC_CLK_TCK but not to have sysconf;
fixme: does using _POSIX_VERSION help? */
# if defined _SC_CLK_TCK && defined _POSIX_VERSION
if (! clk_tck) clk_tck = sysconf(_SC_CLK_TCK);
# elif defined CLOCKS_PER_SECOND
if (! clk_tck) clk_tck = CLOCKS_PER_SECOND;
# elif defined CLK_TCK
if (! clk_tck) clk_tck = CLK_TCK;
# elif defined HZ
if (! clk_tck) clk_tck = HZ;
# elif defined HAVE_GETRUSAGE
# else
#error Dont know clock tick length
# endif
if (times(&buffer) < 0) return -1.0;
utime = buffer.tms_utime; stime = buffer.tms_stime;
tarray[0] = ((float)(utime - old_utime)) / (float)clk_tck;
tarray[1] = ((float)(stime - old_stime)) / (float)clk_tck;
#endif /* HAVE_GETRUSAGE */
old_utime = utime; old_stime = stime;
return (tarray[0]+tarray[1]);
#else /* ! HAVE_GETRUSAGE && ! HAVE_TIMES */
errno = ENOSYS;
return 0.0;
#endif /* ! HAVE_GETRUSAGE && ! HAVE_TIMES */
}
/* Copyright (C) 1995, 1996 Free Software Foundation, Inc.
This file is part of GNU Fortran libU77 library.
This library is free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published
by the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
GNU Fortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with GNU Fortran; see the file COPYING.LIB. If
not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA. */
#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
#if HAVE_UNISTD_H
# include <unistd.h>
#endif
#include <sys/types.h>
#if HAVE_SYS_TIMES_H
# include <sys/times.h>
#endif
#if HAVE_SYS_PARAM_H
# include <sys/param.h>
#endif
#if HAVE_GETRUSAGE
# include <sys/time.h>
# include <sys/resource.h>
#endif
#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
{
#if defined (HAVE_GETRUSAGE) || defined (HAVE_TIMES)
/* The getrusage version is only the default for convenience. */
#ifdef HAVE_GETRUSAGE
struct rusage rbuff;
if (getrusage (RUSAGE_SELF, &rbuff) != 0)
abort ();
tarray[0] = ((float) (rbuff.ru_utime).tv_sec +
(float) (rbuff.ru_utime).tv_usec/1000000.0);
tarray[1] = ((float) (rbuff.ru_stime).tv_sec +
(float) (rbuff.ru_stime).tv_usec/1000000.0);
#else /* HAVE_GETRUSAGE */
struct tms buffer;
/* NeXTStep seems to define _SC_CLK_TCK but not to have sysconf;
fixme: does using _POSIX_VERSION help? */
# if defined _SC_CLK_TCK && defined _POSIX_VERSION
if (! clk_tck) clk_tck = sysconf(_SC_CLK_TCK);
# elif defined CLOCKS_PER_SECOND
if (! clk_tck) clk_tck = CLOCKS_PER_SECOND;
# elif defined CLK_TCK
if (! clk_tck) clk_tck = CLK_TCK;
# elif defined HZ
if (! clk_tck) clk_tck = HZ;
# elif defined HAVE_GETRUSAGE
# else
#error Dont know clock tick length
# endif
if (times(&buffer) < 0) return -1.0;
tarray[0] = (float) buffer.tms_utime / (float)clk_tck;
tarray[1] = (float) buffer.tms_stime / (float)clk_tck;
#endif /* HAVE_GETRUSAGE */
return (tarray[0]+tarray[1]);
#else /* ! HAVE_GETRUSAGE && ! HAVE_TIMES */
errno = ENOSYS;
return 0.0;
#endif /* ! HAVE_GETRUSAGE && ! HAVE_TIMES */
}
/* Copyright (C) 1995, 1996 Free Software Foundation, Inc.
This file is part of GNU Fortran libU77 library.
This library is free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published
by the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
GNU Fortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with GNU Fortran; see the file COPYING.LIB. If
not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA. */
#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
#include <stdio.h>
#if TIME_WITH_SYS_TIME
# include <sys/time.h>
# include <time.h>
#else
# if HAVE_SYS_TIME_H
# include <sys/time.h>
# else
# include <time.h>
# endif
#endif
#if HAVE_STRING_H
# include <string.h>
#else
# include <strings.h>
#endif
#include "f2c.h"
/* NB. this implementation is for a character*24 function. There's
also a subroutine version. Of course, the calling convention is
essentially the same for both. */
/* Character *24 */ void G77_fdate_0 (char *ret_val, ftnlen ret_val_len)
{
int s_copy ();
time_t tloc;
tloc = time (NULL);
/* Allow a length other than 24 for compatibility with what other
systems do, despite it being documented as 24. */
s_copy (ret_val, ctime ((time_t *) &tloc), ret_val_len, 24);
}
/* Copyright (C) 1996 Free Software Foundation, Inc.
This file is part of GNU Fortran libU77 library.
This library is free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published
by the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
GNU Fortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with GNU Fortran; see the file COPYING.LIB. If
not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA. */
#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
#include <stdio.h>
#include "f2c.h"
#include "fio.h"
#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
{
int err;
FILE *f = f__units[*lunit].ufd;
if (*lunit>=MXUNIT || *lunit<0)
return 101; /* bad unit error */
err = getc (f);
if (err == EOF) {
if (feof (f))
return -1;
else
return ferror (f); }
else {
if (Lc == 0)
return 0;
c[0] = err;
while (--Lc)
*++c = ' ';
return 0; }
}
#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 five = 5;
return G77_fgetc_0 (&five, c, Lc);
}
/* Copyright (C) 1995 Free Software Foundation, Inc.
This file is part of GNU Fortran libU77 library.
This library is free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published
by the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
GNU Fortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with GNU Fortran; see the file COPYING.LIB. If
not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA. */
#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
#include <stdio.h>
#include "f2c.h"
#include "fio.h"
/* This flushes a single unit, c.f. libI77 version. */
#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
{
if (*lunit>=MXUNIT || *lunit<0)
err(1,101,"flush");
/* f__units is a table of descriptions for the unit numbers (defined
in io.h) with file descriptors rather than streams */
if (f__units[*lunit].ufd != NULL && f__units[*lunit].uwrt)
fflush(f__units[*lunit].ufd);
return 0;
}
/* Copyright (C) 1995 Free Software Foundation, Inc.
This file is part of GNU Fortran libU77 library.
This library is free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published
by the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
GNU Fortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with GNU Fortran; see the file COPYING.LIB. If
not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA. */
#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
#include "f2c.h"
#include "fio.h"
#ifdef KR_headers
integer G77_fnum_0 (lunit)
integer *lunit;
#else
integer G77_fnum_0 (integer *lunit)
#endif
{
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);
}
/* Copyright (C) 1996 Free Software Foundation, Inc.
This file is part of GNU Fortran libU77 library.
This library is free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published
by the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
GNU Fortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with GNU Fortran; see the file COPYING.LIB. If
not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA. */
#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
#include <stdio.h>
#include "f2c.h"
#include "fio.h"
#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
{
int err;
FILE *f = f__units[*lunit].ufd;
if (*lunit>=MXUNIT || *lunit<0)
return 101; /* bad unit error */
err = putc (c[0], f);
if (err == EOF) {
if (feof (f))
return -1;
else
return ferror (f);
}
else
return 0;
}
#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 six = 6;
return G77_fputc_0 (&six, c, Lc);
}
/* Copyright (C) 1995 Free Software Foundation, Inc.
This file is part of GNU Fortran libU77 library.
This library is free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published
by the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
GNU Fortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with GNU Fortran; see the file COPYING.LIB. If
not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA. */
#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
#include "f2c.h"
#include <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
{
int err;
struct stat buf;
err = fstat (G77_fnum_0 (lunit), &buf);
statb[0] = buf.st_dev;
statb[1] = buf.st_ino;
statb[2] = buf.st_mode;
statb[3] = buf.st_nlink;
statb[4] = buf.st_uid;
statb[5] = buf.st_gid;
#if HAVE_ST_RDEV
statb[6] = buf.st_rdev; /* not posix */
#else
statb[6] = 0;
#endif
statb[7] = buf.st_size;
statb[8] = buf.st_atime;
statb[9] = buf.st_mtime;
statb[10] = buf.st_ctime;
#if HAVE_ST_BLKSIZE
statb[11] = buf.st_blksize; /* not posix */
#else
statb[11] = -1;
#endif
#if HAVE_ST_BLOCKS
statb[12] = buf.st_blocks; /* not posix */
#else
statb[12] = -1;
#endif
return err;
}
/* Copyright (C) 1995 Free Software Foundation, Inc.
This file is part of GNU Fortran libU77 library.
This library is free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published
by the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
GNU Fortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with GNU Fortran; see the file COPYING.LIB. If
not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA. */
#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
#include <errno.h>
#include <stddef.h>
#if HAVE_STRING_H
# include <string.h>
#else
# include <strings.h>
#endif
#include "f2c.h"
#ifndef HAVE_STRERROR
extern char *sys_errlist [];
# define strerror(i) (sys_errlist[i])
#endif
#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
{
char * s;
s = strerror(errno);
s_copy (str, s, Lstr, strlen (s));
return 0;
}
/* Copyright (C) 1995, 1996 Free Software Foundation, Inc.
This file is part of GNU Fortran libU77 library.
This library is free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published
by the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
GNU Fortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with GNU Fortran; see the file COPYING.LIB. If
not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA. */
#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
#include <errno.h>
#if HAVE_STRING_H
# include <string.h>
#else
# include <strings.h>
#endif
#include <stdio.h> /* for NULL */
#include <errno.h> /* for ENOSYS */
#include "f2c.h"
#if HAVE_GETCWD
#ifdef HAVE_UNISTD_H
# include <unistd.h>
#else
extern char *getcwd ();
#endif
#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
{
int i;
char *ret;
ret = getcwd (str, Lstr);
if (ret == NULL) return errno;
for (i=strlen(str); i<Lstr; i++)
str[i] = ' ';
return 0;
}
#elif HAVE_GETWD /* HAVE_GETCWD */
/* getwd usage taken from SunOS4 man */
# include <sys/param.h>
extern char *getwd ();
#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
{
char pathname[MAXPATHLEN];
size_t l;
if (getwd (pathname) == NULL) {
return errno;
} else {
s_copy (str, pathname, Lstr, strlen (str));
return 0;
}
}
#else /* !HAVE_GETWD && !HAVE_GETCWD */
#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
{
return errno = ENOSYS;
}
#endif
/* Copyright (C) 1995 Free Software Foundation, Inc.
This file is part of GNU Fortran libU77 library.
This library is free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published
by the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
GNU Fortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with GNU Fortran; see the file COPYING.LIB. If
not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA. */
#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
#if HAVE_UNISTD_H
#include <unistd.h>
#endif
#include <sys/types.h>
#include <errno.h> /* for ENOSYS */
#include "f2c.h"
#ifdef KR_headers
integer G77_getgid_0 ()
#else
integer G77_getgid_0 (void)
#endif
{
#if defined (HAVE_GETGID)
return getgid ();
#else
errno = ENOSYS;
return -1;
#endif
}
/* Copyright (C) 1995 Free Software Foundation, Inc.
This file is part of GNU Fortran libU77 library.
This library is free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published
by the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
GNU Fortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with GNU Fortran; see the file COPYING.LIB. If
not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA. */
#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
#include <sys/types.h>
#if HAVE_STDLIB_H
# include <stdlib.h>
#else
# include <stdio.h>
#endif
#include <stdio.h>
#if HAVE_UNISTD_H
# include <unistd.h>
#endif
#if HAVE_STRING_H
# include <string.h>
#else
# include <strings.h>
#endif
#include <errno.h> /* for ENOSYS */
#include "f2c.h"
/* getlogin not in svr1-3 */
/* SGI also has character*(*) function getlog() */
#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
{
size_t i;
char *p;
int status;
#if defined (HAVE_GETLOGIN)
p = getlogin ();
if (p != NULL) {
i = strlen (p);
s_copy (str, p, Lstr, i);
} else {
s_copy (str, " ", Lstr, 1);
}
status = 0;
#else
errno = ENOSYS;
status = -1;
#endif
return status;
}
/* Copyright (C) 1995 Free Software Foundation, Inc.
This file is part of GNU Fortran libU77 library.
This library is free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published
by the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
GNU Fortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with GNU Fortran; see the file COPYING.LIB. If
not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA. */
#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
#if HAVE_UNISTD_H
#include <unistd.h>
#endif
#include <sys/types.h>
#include "f2c.h"
#ifdef KR_headers
integer G77_getpid_0 ()
#else
integer G77_getpid_0 (void)
#endif
{
return getpid ();
}
/* Copyright (C) 1995 Free Software Foundation, Inc.
This file is part of GNU Fortran libU77 library.
This library is free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published
by the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
GNU Fortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with GNU Fortran; see the file COPYING.LIB. If
not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA. */
#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
#if HAVE_UNISTD_H
#include <unistd.h>
#endif
#include <sys/types.h>
#include <errno.h> /* for ENOSYS */
#include "f2c.h"
#ifdef KR_headers
integer G77_getuid_0 ()
#else
integer G77_getuid_0 (void)
#endif
{
#if defined (HAVE_GETUID)
return getuid ();
#else
errno = ENOSYS;
return -1;
#endif
}
/* Copyright (C) 1995 Free Software Foundation, Inc.
This file is part of GNU Fortran libU77 library.
This library is free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published
by the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
GNU Fortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with GNU Fortran; see the file COPYING.LIB. If
not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA. */
#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
/* fixme: do we need to use TM_IN_SYS_TIME? */
#if TIME_WITH_SYS_TIME
# include <sys/time.h>
# include <time.h>
#else
# if HAVE_SYS_TIME_H
# include <sys/time.h>
# else
# include <time.h>
# endif
#endif
#include "f2c.h"
#ifdef KR_headers
/* Subroutine */ int G77_gmtime_0 (stime, tarray)
integer *stime, tarray[9];
#else
/* Subroutine */ int G77_gmtime_0 (const integer * stime, integer tarray[9])
#endif
{
struct tm *lt;
lt = gmtime ((time_t *) stime);
tarray[0] = lt->tm_sec;
tarray[1] = lt->tm_min;
tarray[2] = lt->tm_hour;
tarray[3] = lt->tm_mday;
tarray[4] = lt->tm_mon;
tarray[5] = lt->tm_year;
tarray[6] = lt->tm_wday;
tarray[7] = lt->tm_yday;
tarray[8] = lt->tm_isdst;
return 0;
}
/* Copyright (C) 1995 Free Software Foundation, Inc.
This file is part of GNU Fortran libU77 library.
This library is free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published
by the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
GNU Fortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with GNU Fortran; see the file COPYING.LIB. If
not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA. */
#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
#if HAVE_STRING_H
# include <string.h>
#else
# include <strings.h>
#endif
#if HAVE_UNISTD_H
# include <unistd.h>
#endif
#include <errno.h> /* for ENOSYS */
#include "f2c.h"
integer G77_hostnm_0 (char *name, ftnlen Lname)
{
int ret, i;
#if HAVE_GETHOSTNAME
ret = gethostname (name, Lname);
if (ret==0) {
/* Pad with blanks (assuming gethostname will make an error
return if it can't fit in the null). */
for (i=strlen(name); i<=Lname; i++)
name[i] = ' ';
}
return ret;
#else
return errno = ENOSYS;
#endif
}
/* Copyright (C) 1995, 1996 Free Software Foundation, Inc.
This file is part of GNU Fortran libU77 library.
This library is free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published
by the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
GNU Fortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with GNU Fortran; see the file COPYING.LIB. If
not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA. */
#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
#include <stdio.h>
#if TIME_WITH_SYS_TIME
# include <sys/time.h>
# include <time.h>
#else
# if HAVE_SYS_TIME_H
# include <sys/time.h>
# else
# include <time.h>
# endif
#endif
#include "f2c.h"
/* VMS and Irix versions (at least) differ from libU77 elsewhere */
/* libU77 one: */
#ifdef KR_headers
/* Subroutine */ int G77_idate_0 (iarray)
int iarray[3];
#else
/* Subroutine */ int G77_idate_0 (int iarray[3])
#endif
{
struct tm *lt;
time_t tim;
tim = time(NULL);
lt = localtime(&tim);
iarray[0] = lt->tm_mday;
iarray[1] = lt->tm_mon + 1; /* in range 1-12 in SunOS (experimentally) */
/* The `+1900' is consistent with SunOS and Irix, but they don't say
it's added. I think I've seen a system where tm_year was since
1970, but can't now verify that, so assume the ANSI definition. */
iarray[2] = lt->tm_year + 1900;
return 0;
}
/* Copyright (C) 1995 Free Software Foundation, Inc.
This file is part of GNU Fortran libU77 library.
This library is free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published
by the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
GNU Fortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with GNU Fortran; see the file COPYING.LIB. If
not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA. */
#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
#include <errno.h>
#include "f2c.h"
#ifdef KR_headers
integer G77_ierrno_0 ()
#else
integer G77_ierrno_0 (void)
#endif
{
return errno;
}
/* Copyright (C) 1995 Free Software Foundation, Inc.
This file is part of GNU Fortran libU77 library.
This library is free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published
by the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
GNU Fortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with GNU Fortran; see the file COPYING.LIB. If
not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA. */
#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
#if HAVE_STDLIB_H
# include <stdlib.h>
#endif
#include "f2c.h"
/* We could presumably do much better than the traditional libc
version, though at least the glibc one is reasonable, it seems.
For the sake of the innocent, I'm not sure we should really do
this... */
/* Note this is per SunOS -- other s may have no arg. */
#ifdef KR_headers
integer G77_irand_0 (flag)
integer *flag;
#else
integer G77_irand_0 (integer *flag)
#endif
{
switch (*flag) {
case 0:
break;
case 1:
srand (0); /* Arbitrary choice of initialiser. */
break;
default:
srand (*flag);
}
return rand ();
}
/* Copyright (C) 1995 Free Software Foundation, Inc.
This file is part of GNU Fortran libU77 library.
This library is free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published
by the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
GNU Fortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with GNU Fortran; see the file COPYING.LIB. If
not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA. */
#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
#if HAVE_UNISTD_H
# include <unistd.h>
#endif
#include "f2c.h"
#include "fio.h"
#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
{
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_);
}
/* Copyright (C) 1995 Free Software Foundation, Inc.
This file is part of GNU Fortran libU77 library.
This library is free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published
by the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
GNU Fortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with GNU Fortran; see the file COPYING.LIB. If
not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA. */
#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
#include <stdio.h>
#if TIME_WITH_SYS_TIME
# include <sys/time.h>
# include <time.h>
#else
# if HAVE_SYS_TIME_H
# include <sys/time.h>
# else
# include <time.h>
# endif
#endif
#include "f2c.h"
#ifdef KR_headers
/* Subroutine */ int G77_itime_0 (tarray)
integer tarray[3];
#else
/* Subroutine */ int G77_itime_0 (integer tarray[3])
#endif
{
struct tm *lt;
time_t tim;
tim = time(NULL);
lt = localtime(&tim);
tarray[0] = lt->tm_hour;
tarray[1] = lt->tm_min;
tarray[2] = lt->tm_sec;
return 0;
}
/* Copyright (C) 1995 Free Software Foundation, Inc.
This file is part of GNU Fortran libU77 library.
This library is free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published
by the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
GNU Fortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with GNU Fortran; see the file COPYING.LIB. If
not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA. */
#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
#include <sys/types.h>
#include <signal.h>
#include <errno.h>
#include "f2c.h"
/* fixme: bsd, svr1-3 use int, not pid_t */
#ifdef KR_headers
integer G77_kill_0 (pid, signum)
integer *pid, *signum;
#else
integer G77_kill_0 (const integer *pid, const integer *signum)
#endif
{
#if defined (HAVE_KILL)
return kill ((pid_t) *pid, *signum) ? errno : 0;
#else
errno = ENOSYS;
return -1;
#endif
}
/* Copyright (C) 1995, 1997 Free Software Foundation, Inc.
This file is part of GNU Fortran libU77 library.
This library is free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published
by the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
GNU Fortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with GNU Fortran; see the file COPYING.LIB. If
not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA. */
#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
#if HAVE_STDLIB_H
# include <stdlib.h>
#else
# include <stdio.h>
#endif
#if HAVE_UNISTD_H
# include <unistd.h>
#endif
#include <errno.h>
#if HAVE_SYS_PARAM_H
# include <sys/param.h>
#endif
#include <errno.h> /* for ENOSYS */
#include "f2c.h"
#ifdef KR_headers
void g_char ();
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
{
#if defined (HAVE_LINK)
char *buff1, *buff2;
char *bp, *blast;
int i;
buff1 = malloc (Lpath1+1);
if (buff1 == NULL) return -1;
g_char (path1, Lpath1, buff1);
buff2 = malloc (Lpath2+1);
if (buff2 == NULL) return -1;
g_char (path2, Lpath2, buff2);
i = link (buff1, buff2);
free (buff1); free (buff2);
return i ? errno : 0;
#else /* ! HAVE_LINK */
errno = ENOSYS;
return -1;
#endif
}
/* Copyright (C) 1995, 1997 Free Software Foundation, Inc.
This file is part of GNU Fortran libU77 library.
This library is free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published
by the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
GNU Fortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with GNU Fortran; see the file COPYING.LIB. If
not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA. */
/* via f2c from Fortran */
#include "f2c.h"
integer G77_lnblnk_0 (char *str, ftnlen str_len)
{
integer ret_val;
integer i_len();
for (ret_val = str_len; ret_val >= 1; --ret_val) {
if (*(unsigned char *)&str[ret_val - 1] != ' ') {
return ret_val;
}
}
return ret_val;
}
/* Copyright (C) 1995, 1997 Free Software Foundation, Inc.
This file is part of GNU Fortran libU77 library.
This library is free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published
by the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
GNU Fortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with GNU Fortran; see the file COPYING.LIB. If
not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA. */
#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
#include <stdio.h>
#if HAVE_STDLIB_H
# include <stdlib.h>
#endif
#include <sys/types.h>
#include <sys/stat.h>
#include <errno.h> /* for ENOSYS */
#include "f2c.h"
/* lstat isn't posix */
#ifdef KR_headers
void g_char();
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
{
#if HAVE_LSTAT
char *buff;
char *bp, *blast;
int err;
struct stat buf;
buff = malloc (Lname+1);
if (buff == NULL) return -1;
g_char (name, Lname, buff);
err = lstat (buff, &buf);
free (buff);
statb[0] = buf.st_dev;
statb[1] = buf.st_ino;
statb[2] = buf.st_mode;
statb[3] = buf.st_nlink;
statb[4] = buf.st_uid;
statb[5] = buf.st_gid;
#if HAVE_ST_RDEV
statb[6] = buf.st_rdev;
#else
statb[6] = 0;
#endif
statb[7] = buf.st_size;
statb[8] = buf.st_atime;
statb[9] = buf.st_mtime;
statb[10] = buf.st_ctime;
statb[6] = 0;
#if HAVE_ST_BLKSIZE
statb[11] = buf.st_blksize;
#else
statb[11] = -1;
#endif
#if HAVE_ST_BLOCKS
statb[12] = buf.st_blocks;
#else
statb[12] = -1;
#endif
return err;
#else /* !HAVE_LSTAT */
return errno = ENOSYS;
#endif /* !HAVE_LSTAT */
}
/* Copyright (C) 1995 Free Software Foundation, Inc.
This file is part of GNU Fortran libU77 library.
This library is free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published
by the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
GNU Fortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with GNU Fortran; see the file COPYING.LIB. If
not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA. */
#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
/* fixme: do we need to use TM_IN_SYS_TIME? */
#if TIME_WITH_SYS_TIME
# include <sys/time.h>
# include <time.h>
#else
# if HAVE_SYS_TIME_H
# include <sys/time.h>
# else
# include <time.h>
# endif
#endif
#include "f2c.h"
#ifdef KR_headers
/* Subroutine */ int G77_ltime_0 (stime, tarray)
integer *stime, tarray[9];
#else
/* Subroutine */ int G77_ltime_0 (const integer * stime, integer tarray[9])
#endif
{
struct tm *lt;
lt = localtime ((time_t *) stime);
tarray[0] = lt->tm_sec;
tarray[1] = lt->tm_min;
tarray[2] = lt->tm_hour;
tarray[3] = lt->tm_mday;
tarray[4] = lt->tm_mon;
tarray[5] = lt->tm_year;
tarray[6] = lt->tm_wday;
tarray[7] = lt->tm_yday;
tarray[8] = lt->tm_isdst;
return 0;
}
/* Copyright (C) 1996 Free Software Foundation, Inc.
This file is part of GNU Fortran libU77 library.
This library is free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published
by the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
GNU Fortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with GNU Fortran; see the file COPYING.LIB. If
not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA. */
#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
#if TIME_WITH_SYS_TIME
# include <sys/time.h>
# include <time.h>
#else
# if HAVE_SYS_TIME_H
# include <sys/time.h>
# else
# include <time.h>
# endif
#endif
#include "f2c.h"
/* Reported by wd42ej@sgi83.wwb.noaa.gov (Russ Jones AUTO-Sun3) on AIX. */
#ifdef KR_headers
longint G77_mclock_0 ()
#else
longint G77_mclock_0 (void)
#endif
{
#if HAVE_CLOCK
return clock ();
#else
return -1;
#endif
}
/* Copyright (C) 1995 Free Software Foundation, Inc.
This file is part of GNU Fortran libU77 library.
This library is free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published
by the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
GNU Fortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with GNU Fortran; see the file COPYING.LIB. If
not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA. */
#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
#include <stdio.h>
#include <errno.h>
#if HAVE_STRING_H
# include <string.h>
#else
# include <strings.h>
#endif
#include "f2c.h"
#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
{
char buff[1000];
char *bp, *blast;
/* same technique as `system' -- what's wrong with malloc? */
blast = buff + (Lstr < 1000 ? Lstr : 1000);
for (bp = buff ; bp<blast && *str!='\0' ; )
*bp++ = *str++;
*bp = '\0';
perror (buff);
return 0;
}
/* Copyright (C) 1995 Free Software Foundation, Inc.
This file is part of GNU Fortran libU77 library.
This library is free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published
by the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
GNU Fortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with GNU Fortran; see the file COPYING.LIB. If
not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA. */
#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
#if HAVE_STDLIB_H
# include <stdlib.h>
#endif
#include "f2c.h"
#ifndef RAND_MAX
# define RAND_MAX 2147483647 /* from SunOS */
#endif
/* We could presumably do much better than the traditional libc
version, though at least the glibc one is reasonable, it seems.
For the sake of the innocent, I'm not sure we should really do
this... */
/* Note this is per SunOS -- other s may have no arg. */
#ifdef KR_headers
double G77_rand_0 (flag)
integer *flag;
#else
double G77_rand_0 (integer *flag)
#endif
{
switch (*flag) {
case 0:
break;
case 1:
srand (0); /* Arbitrary choice of initialiser. */
break;
default:
srand (*flag);
}
return (float) rand () / RAND_MAX;
}
/* Copyright (C) 1995, 1997 Free Software Foundation, Inc.
This file is part of GNU Fortran libU77 library.
This library is free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published
by the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
GNU Fortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with GNU Fortran; see the file COPYING.LIB. If
not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA. */
#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
#if HAVE_UNISTD_H
# include <unistd.h>
#endif
#if HAVE_STDLIB_H
# include <stdlib.h>
#endif
#include <stdio.h>
#include <errno.h>
#include "f2c.h"
#ifdef KR_headers
void g_char ();
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
{
char *buff1, *buff2;
char *bp, *blast;
int i;
buff1 = malloc (Lpath1+1);
if (buff1 == NULL) return -1;
g_char (path1, Lpath1, buff1);
buff2 = malloc (Lpath2+1);
if (buff2 == NULL) return -1;
g_char (path2, Lpath2, buff2);
i = rename (buff1, buff2);
free (buff1); free (buff2);
return i ? errno : 0;
}
/* Copyright (C) 1995 Free Software Foundation, Inc.
This file is part of GNU Fortran libU77 library.
This library is free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published
by the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
GNU Fortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with GNU Fortran; see the file COPYING.LIB. If
not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA. */
#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
#include <stdio.h>
#if TIME_WITH_SYS_TIME
# include <sys/time.h>
# include <time.h>
#else
# if HAVE_SYS_TIME_H
# include <sys/time.h>
# else
# include <time.h>
# endif
#endif
#include <sys/types.h>
#include "f2c.h"
/* This is a VMS intrinsic. */
double G77_secnds_0 (real *r)
{
struct tm *lt;
time_t clock;
float f;
clock = time (NULL);
lt = localtime (&clock);
f= (3600.0*((real)lt->tm_hour) + 60.0*((real)lt->tm_min) +
(real)lt->tm_sec - *r);
return f;
}
/* Copyright (C) 1996 Free Software Foundation, Inc.
This file is part of GNU Fortran libU77 library.
This library is free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published
by the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
GNU Fortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with GNU Fortran; see the file COPYING.LIB. If
not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA. */
#include "f2c.h"
double G77_second_0 () {
extern double G77_etime_0 ();
real tarray[2];
return G77_etime_0 (tarray);
}
/* Copyright (C) 1995 Free Software Foundation, Inc.
This file is part of GNU Fortran libU77 library.
This library is free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published
by the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
GNU Fortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with GNU Fortran; see the file COPYING.LIB. If
not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA. */
#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
#if HAVE_UNISTD_H
# include <unistd.h>
#endif
#include "f2c.h"
/* Subroutine */
#ifdef KR_headers
int G77_sleep_0 (seconds)
integer *seconds;
#else
int G77_sleep_0 (const integer *seconds)
#endif
{
(void) sleep ((unsigned int) *seconds);
return 0;
}
/* Copyright (C) 1995 Free Software Foundation, Inc.
This file is part of GNU Fortran libU77 library.
This library is free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published
by the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
GNU Fortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with GNU Fortran; see the file COPYING.LIB. If
not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA. */
#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
#if STDC_HEADERS
# include <stdlib.h>
#endif
#include "f2c.h"
/* Subroutine */
#ifdef KR_headers
int G77_srand_0 (seed)
integer *seed;
#else
int G77_srand_0 (const integer *seed)
#endif
{
srand ((unsigned int) *seed);
return 0;
}
/* Copyright (C) 1995, 1997 Free Software Foundation, Inc.
This file is part of GNU Fortran libU77 library.
This library is free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published
by the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
GNU Fortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with GNU Fortran; see the file COPYING.LIB. If
not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA. */
#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
#include <stdio.h>
#if HAVE_STDLIB_H
# include <stdlib.h>
#endif
#include <sys/types.h>
#include <sys/stat.h>
#include "f2c.h"
#ifdef KR_headers
void g_char ();
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
{
char *buff;
char *bp, *blast;
int err;
struct stat buf;
buff = malloc (Lname+1);
if (buff == NULL) return -1;
g_char (name, Lname, buff);
err = stat (buff, &buf);
free (buff);
statb[0] = buf.st_dev;
statb[1] = buf.st_ino;
statb[2] = buf.st_mode;
statb[3] = buf.st_nlink;
statb[4] = buf.st_uid;
statb[5] = buf.st_gid;
#if HAVE_ST_RDEV
statb[6] = buf.st_rdev; /* not posix */
#else
statb[6] = 0;
#endif
statb[7] = buf.st_size;
statb[8] = buf.st_atime;
statb[9] = buf.st_mtime;
statb[10] = buf.st_ctime;
#if HAVE_ST_BLKSIZE
statb[11] = buf.st_blksize; /* not posix */
#else
statb[11] = -1;
#endif
#if HAVE_ST_BLOCKS
statb[12] = buf.st_blocks; /* not posix */
#else
statb[12] = -1;
#endif
return err;
}
/* Copyright (C) 1995, 1997 Free Software Foundation, Inc.
This file is part of GNU Fortran.
GNU Fortran is free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published
by the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
GNU Fortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with GNU Fortran; see the file COPYING.LIB. If
not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA. */
#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
#if HAVE_STDLIB_H
# include <stdlib.h>
#else
# include <stdio.h>
#endif
#if HAVE_UNISTD_H
# include <unistd.h>
#endif
#include <errno.h>
#if HAVE_SYS_PARAM_H
# include <sys/param.h>
#endif
#include "f2c.h"
#ifdef KR_headers
void g_char ();
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
{
#if HAVE_SYMLINK
char *buff1, *buff2;
char *bp, *blast;
int i;
buff1 = (char *) malloc (Lpath1+1);
if (buff1 == NULL) return -1;
g_char (path1, Lpath1, buff1);
buff2 = (char *) malloc (Lpath2+1);
if (buff2 == NULL) return -1;
g_char (path2, Lpath2, buff2);
i = symlink (buff1, buff2);
free (buff1); free (buff2);
return i ? errno : 0;
#else /* !HAVE_SYMLINK */
return errno = ENOSYS;
#endif /* !HAVE_SYMLINK */
}
/* Copyright (C) 1996 Free Software Foundation, Inc.
This file is part of GNU Fortran libU77 library.
This library is free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published
by the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
GNU Fortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with GNU Fortran; see the file COPYING.LIB. If
not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA. */
#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
#if TIME_WITH_SYS_TIME
# include <sys/time.h>
# include <time.h>
#else
# if HAVE_SYS_TIME_H
# include <sys/time.h>
# else
# include <time.h>
# endif
#endif
#if HAVE_SYS_TIMES_H
# include <sys/times.h>
#endif
#include <limits.h>
#if HAVE_UNISTD_H
# include <unistd.h>
#endif
#include <errno.h> /* for ENOSYS */
#include "f2c.h"
#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
{
#if defined (HAVE_TIMES)
struct tms buffer;
unsigned long cnt;
#ifdef _SC_CLK_TCK
*count_rate = sysconf(_SC_CLK_TCK);
#elif defined CLOCKS_PER_SECOND
*count_rate = CLOCKS_PER_SECOND;
#elif defined CLK_TCK
*count_rate = CLK_TCK;
#elif defined HZ
*count_rate = HZ;
#else
#error Dont know clock tick length
#endif
*count_max = INT_MAX; /* dubious */
cnt = times (&buffer);
if (cnt > (unsigned long) (*count_max))
*count = *count_max; /* also dubious */
else
*count = cnt;
return 0;
#else /* ! HAVE_TIMES */
errno = ENOSYS;
return -1;
#endif /* ! HAVE_TIMES */
}
/* Copyright (C) 1995 Free Software Foundation, Inc.
This file is part of GNU Fortran libU77 library.
This library is free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published
by the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
GNU Fortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with GNU Fortran; see the file COPYING.LIB. If
not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA. */
#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
#include <stdio.h>
#if TIME_WITH_SYS_TIME
# include <sys/time.h>
# include <time.h>
#else
# if HAVE_SYS_TIME_H
# include <sys/time.h>
# else
# include <time.h>
# endif
#endif
#include "f2c.h"
/* As well as this external function some compilers have an intrinsic
subroutine which fills a character argument (which is the VMS way)
-- caveat emptor. */
#ifdef KR_headers
longint G77_time_0 ()
#else
longint G77_time_0 (void)
#endif
{
/* There are potential problems with the cast of the time_t here. */
return time (NULL);
}
/* Copyright (C) 1995, 1996 Free Software Foundation, Inc.
This file is part of GNU Fortran libU77 library.
This library is free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published
by the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
GNU Fortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with GNU Fortran; see the file COPYING.LIB. If
not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA. */
#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
#include <sys/types.h>
#if STDC_HEADERS
# include <stdlib.h>
#endif
#if HAVE_UNISTD_H
# include <unistd.h> /* POSIX for ttyname */
#endif
#include <stdio.h>
#if HAVE_STRING_H
# include <string.h>
#else
# include <strings.h>
#endif
#include <errno.h> /* for ENOSYS */
#include "f2c.h"
#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
{
#if defined (HAVE_TTYNAME)
size_t i;
char *p;
p = ttyname (G77_fnum_0 (lunit));
if (p != NULL) {
i = strlen (p);
s_copy (ret_val, p, ret_val_len, i);
} else {
s_copy (ret_val, " ", ret_val_len, 1);
}
#else
errno = ENOSYS;
return -1;
#endif
}
*** Some random stuff for testing libU77. Should be done better. It's
* hard to test things where you can't guarantee the result. Have a
* good squint at what it prints, though detected errors will cause
* starred messages.
integer i, j, k, ltarray (9), idat (3), count, rate, count_max,
+ pid
real tarray1(2), tarray2(2), r1, r2, etime
intrinsic getpid, getuid, getgid, ierrno, gerror,
+ fnum, isatty, getarg, access, unlink, fstat,
+ stat, lstat, getcwd, gmtime, hostnm, etime, chmod,
+ chdir, fgetc, fputc, system_clock, second, idate, secnds,
+ time, ctime, fdate, ttynam
external lenstr
logical l
character gerr*80, c*1
character ctim*25, line*80, lognam*20, wd*100, line2*80
integer fstatb (13), statb (13)
integer *2 i2zero
ctim = ctime(time())
WRITE (6,'(A/)') '1 GNU libU77 test at: ' // ctim
write (6,'(A,I3,'', '',I3)')
+ ' Logical units 5 and 6 correspond (FNUM) to'
+ // ' Unix i/o units ', fnum(5), fnum(6)
if (lnblnk('foo ').ne.3 .or. len_trim('foo ').ne.3) then
print *, 'LNBLNK or LEN_TRIM failed'
call exit(1)
end if
l= isatty(6)
line2 = ttynam(6)
if (l) then
line = 'and 6 is a tty device (ISATTY) named '//line2
else
line = 'and 6 isn''t a tty device (ISATTY)'
end if
write (6,'(1X,A)') line(:lenstr(line))
pid = getpid()
WRITE (6,'(A,I10)') ' Process id (GETPID): ', pid
WRITE (6,'(A,I10)') ' User id (GETUID): ', GETUID ()
WRITE (6,'(A,I10)') ' Group id (GETGID): ', GETGID ()
WRITE (6,*) 'If you have the `id'' program, the following call of'
+ // ' SYSTEM should agree with the above'
call flush(6)
CALL SYSTEM ('echo " " `id`')
call flush
call getlog (lognam)
write (6,*) 'Login name (GETLOG): ', lognam
call umask(0, mask)
write(6,*) 'UMASK returns', mask
call umask(mask)
ctim = fdate()
write (6,*) 'FDATE returns: ', ctim
j=time()
call ltime (j, ltarray)
write (6,'(1x,a,9i4)') 'LTIME returns:', ltarray
call gmtime (j, ltarray)
write (6,'(1x,a,9i4)') 'GMTIME returns:', ltarray
call system_clock(count, rate, count_max)
write(6,*) 'SYSTEM_CLOCK returns: ', count, rate, count_max
write (6,*) 'Sleeping for 1 second (SLEEP) ...'
call sleep (1)
write (6,*) 'Looping 10,000,000 times ...'
do i=1,10*1000*1000
end do
r1= etime (tarray1)
if (r1.ne.tarray1(1)+tarray1(2))
+ write (6,*) '*** ETIME didn''t return sum of the array: ',
+ r1, ' /= ', tarray1
r2= dtime (tarray2)
if (abs (r1-r2).gt.1.0) write (6,*)
+ 'Results of ETIME and DTIME differ by more than a second:',
+ i, j
write (6,'(A,3F10.3)')
+ ' Elapsed total, user, system time (ETIME): ',
+ r1, tarray1
call idate(i,j,k)
call idate (idat)
write (6,*) 'IDATE d,m,y: ',idat
print *, '... and the VXT version: ', i,j,k
call time(line(:8))
print *, line(:8)
write (6,*) 'SECNDS(0.0) returns: ',secnds(0.0)
write (6,*) 'SECOND returns: ', second()
call dumdum(r1)
call second(r1)
write (6,*) 'CALL SECOND returns: ', r1
i = getcwd(wd)
if (i.ne.0) then
call perror ('*** getcwd')
else
write (6,*) 'Current directory is "'//wd(:lenstr(wd))//'"'
end if
call chdir ('.',i)
if (i.ne.0) write (6,*) '***CHDIR to ".": ', i
i=hostnm(wd)
if(i.ne.0) then
call perror ('*** hostnm')
else
write (6,*) 'Host name is ', wd(:lenstr(wd))
end if
i = access('/dev/null ', 'rw')
if (i.ne.0) write (6,*) '***Read/write ACCESS to /dev/null: ', i
write (6,*) 'Creating file "foo" for testing...'
open (3,file='foo',status='UNKNOWN')
rewind 3
call fputc(3, 'c',i)
call fputc(3, 'd',j)
if (i+j.ne.0) write(6,*) '***FPUTC: ', i
C why is it necessary to reopen?
close(3)
open(3,file='foo',status='old')
call fseek(3,0,0,*10)
go to 20
10 write(6,*) '***FSEEK failed'
20 call fgetc(3, c,i)
if (i.ne.0) write(6,*) '***FGETC: ', i
if (c.ne.'c') write(6,*) '***FGETC read the wrong thing: ',
+ ichar(c)
i= ftell(3)
if (i.ne.1) write(6,*) '***FTELL offset: ', i
call chmod ('foo', 'a+w',i)
if (i.ne.0) write (6,*) '***CHMOD of "foo": ', i
i = fstat (3, fstatb)
if (i.ne.0) write (6,*) '***FSTAT of "foo": ', i
i = stat ('foo', statb)
if (i.ne.0) write (6,*) '***STAT of "foo": ', i
write (6,*) ' with stat array ', statb
if (statb(5).ne.getuid () .or. statb(6).ne.getgid() .or. statb(4)
+ .ne. 1) write (6,*) '*** FSTAT uid, gid or nlink is wrong'
do i=1,13
if (fstatb (i) .ne. statb (i))
+ write (6,*) '*** FSTAT and STAT don''t agree on '// '
+ array element ', i, ' value ', fstatb (i), statb (i)
end do
i = lstat ('foo', fstatb)
do i=1,13
if (fstatb (i) .ne. statb (i))
+ write (6,*) '*** LSTAT and STAT don''t agree on '// '
+ array element ', i, ' value ', fstatb (i), statb (i)
end do
C in case it exists already:
call unlink ('bar',i)
call link ('foo ', 'bar ',i)
if (i.ne.0)
+ write (6,*) '***LINK "foo" to "bar" failed: ', i
call unlink ('foo',i)
if (i.ne.0) write (6,*) '***UNLINK "foo" failed: ', i
call unlink ('foo',i)
if (i.eq.0) write (6,*) '***UNLINK "foo" again: ', i
call gerror (gerr)
i = ierrno()
write (6,'(A,I3,A/1X,A)') ' The current error number is: ',
+ i,
+ ' and the corresponding message is:', gerr(:lenstr(gerr))
write (6,*) 'This is sent to stderr prefixed by the program name'
call getarg (0, line)
call perror (line (:lenstr (line)))
call unlink ('bar')
WRITE (6,*) 'You should see exit status 1'
CALL EXIT(1)
99 END
integer function lenstr (str)
C return length of STR not including trailing blanks, but always
C return >0
character *(*) str
if (str.eq.' ') then
lenstr=1
else
lenstr = lnblnk (str)
end if
end
* just make sure SECOND() doesn't "magically" work the second time.
subroutine dumdum(r)
r = 3.14159
end
/* Copyright (C) 1996 Free Software Foundation, Inc.
This file is part of GNU Fortran libU77 library.
This library is free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published
by the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
GNU Fortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with GNU Fortran; see the file COPYING.LIB. If
not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA. */
#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
#include <sys/types.h>
#include <sys/stat.h>
#include "f2c.h"
#ifdef KR_headers
integer G77_umask_0 (mask)
integer *mask;
#else
integer G77_umask_0 (integer *mask)
#endif
{
return umask ((mode_t) *mask);
}
/* Copyright (C) 1995, 1997 Free Software Foundation, Inc.
This file is part of GNU Fortran libU77 library.
This library is free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published
by the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
GNU Fortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with GNU Fortran; see the file COPYING.LIB. If
not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA. */
#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
#if HAVE_STDLIB_H
# include <stdlib.h>
#else
# include <stdio.h>
#endif
#if HAVE_UNISTD_H
# include <unistd.h>
#endif
#include <errno.h>
#if HAVE_SYS_PARAM_H
# include <sys/param.h>
#endif
#include "f2c.h"
#ifdef KR_headers
void g_char ();
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
{
char *buff;
char *bp, *blast;
int i;
buff = malloc (Lstr+1);
if (buff == NULL) return -1;
g_char (str, Lstr, buff);
i = unlink (buff);
free (buff);
return i ? errno : 0; /* SGI version returns -1 on failure. */
}
/* Copyright (C) 1995, 1996 Free Software Foundation, Inc.
This file is part of GNU Fortran libU77 library.
This library is free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published
by the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
GNU Fortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with GNU Fortran; see the file COPYING.LIB. If
not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA. */
#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
#include <stdio.h>
#if TIME_WITH_SYS_TIME
# include <sys/time.h>
# include <time.h>
#else
# if HAVE_SYS_TIME_H
# include <sys/time.h>
# else
# include <time.h>
# endif
#endif
#include "f2c.h"
/* VMS and Irix versions (at least) differ from libU77 elsewhere */
/* VMS style: */
/* Subroutine */
#ifdef KR_headers
int G77_vxtidate_0 (m, d, y)
integer *y, *m, *d;
#else
int G77_vxtidate_0 (integer *m, integer *d, integer *y)
#endif
{
struct tm *lt;
time_t tim;
tim = time(NULL);
lt = localtime(&tim);
*y = lt->tm_year;
*m = lt->tm_mon+1;
*d = lt->tm_mday;
return 0;
}
/* Copyright (C) 1995 Free Software Foundation, Inc.
This file is part of GNU Fortran libU77 library.
This library is free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published
by the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
GNU Fortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with GNU Fortran; see the file COPYING.LIB. If
not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA. */
#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
#include <stdio.h>
#if TIME_WITH_SYS_TIME
# include <sys/time.h>
# include <time.h>
#else
# if HAVE_SYS_TIME_H
# include <sys/time.h>
# else
# include <time.h>
# endif
#endif
#if HAVE_STRING_H
# include <string.h>
#else
# include <strings.h>
#endif
#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
{
time_t tim;
char *ctim;
tim = time(NULL);
ctim = ctime (&tim);
strncpy (chtime, ctim+11, 8);
}
/****************************************************************
Copyright 1990 - 1997 by AT&T, Lucent Technologies and Bellcore.
Permission to use, copy, modify, and distribute this software
and its documentation for any purpose and without fee is hereby
granted, provided that the above copyright notice appear in all
copies and that both that the copyright notice and this
permission notice and warranty disclaimer appear in supporting
documentation, and that the names of AT&T, Bell Laboratories,
Lucent or Bellcore or any of their entities not be used in
advertising or publicity pertaining to distribution of the
software without specific, written prior permission.
AT&T, Lucent and Bellcore disclaim all warranties with regard to
this software, including all implied warranties of
merchantability and fitness. In no event shall AT&T, Lucent or
Bellcore be liable for any special, indirect or consequential
damages or any damages whatsoever resulting from loss of use,
data or profits, whether in an action of contract, negligence or
other tortious action, arising out of or in connection with the
use or performance of this software.
****************************************************************/
====== old index for f2c, now "readme from f2c" ============
FILES:
f2c.h Include file necessary for compiling output of the converter.
See the second NOTE below.
f2c.1 Man page for f2c.
f2c.1t Source for f2c.1 (to be processed by troff -man or nroff -man).
libf77 Library of non I/O support routines the generated C may need.
Fortran main programs result in a C function named MAIN__ that
is meant to be invoked by the main() in libf77.
libi77 Library of Fortran I/O routines the generated C may need.
Note that some vendors (e.g., BSD, Sun and MIPS) provide a
libF77 and libI77 that are incompatible with f2c -- they
provide some differently named routines or routines with the
names that f2c expects, but with different calling sequences.
On such systems, the recommended procedure is to merge
libf77 and libi77 into a single library, say libf2c, and to
install it where you can access it by specifying -lf2c . The
definition of link_msg in sysdep.c assumes this arrangement.
Both libf77 and libi77 are bundles, meant to be unpacked by the
Bourne (or Korn) shell. MS-DOS users can use the MKS Toolkit
to unpack libf77 and libi77.
libf2c.zip
Only available by ftp: combination of libf77 and libi77, with
Unix and PC makefiles.
f2c.ps Postscript for a technical report on f2c. After you strip the
mail header, the first line should be "%!PS".
fixes The complete change log, reporting bug fixes and other changes.
(Some recent change-log entries are given below).
fc A shell script that uses f2c and imitates much of the behavior
of commonly found f77 commands. You will almost certainly
need to adjust some of the shell-variable assignments to make
this script work on your system.
SUBDIRECTORY:
f2c/src Source for the converter itself, including a file of checksums
and source for a program to compute the checksums (to verify
correct transmission of the source), is available: ask netlib
(e.g., netlib@netlib.bell-labs.com) to
send all from f2c/src
If the checksums show damage to just a few source files, or if
the change log file (see "fixes" below) reports corrections to
some source files, you can request those files individually
"from f2c/src". For example, to get defs.h and xsum0.out, you
would ask netlib to
send defs.h xsum0.out from f2c/src
"all from f2c/src" is about 640 kilobytes long; for convenience
(and checksums), it includes copies of f2c.h, f2c.1, and f2c.1t.
Tip: if asked to send over 99,000 bytes in one request, netlib
breaks the shipment into 1000 line pieces and sends each piece
separately (since otherwise some mailers might gag). To avoid
the hassle of reassembling the pieces, try to keep each request
under 99,000 bytes long. The final number in each line of
xsum0.out gives the length of each file in f2c/src. For
example,
send exec.c expr.c from f2c/src
send format.c format_data.c from f2c/src
will give you slightly less hassle than
send exec.c expr.c format.c format_data.c from f2c/src
Alternatively, if all the mailers in your return path allow
long messages, you can supply an appropriate mailsize line in
your netlib request, e.g.
mailsize 200k
send exec.c expr.c format.c format_data.c from f2c/src
If you have trouble generating gram.c, you can ask netlib to
send gram.c from f2c/src
Then `xsum gram.c` should report
gram.c 5529f4f 58745
Alternatively, if you have bison, you might get a working
gram.c by saying
make gram.c YACC=bison YFLAGS=-y
(but please do not complain if this gives a bad gram.c).
NOTE: For now, you may exercise f2c by sending netlib a message whose
first line is "execute f2c" and whose remaining lines are
the Fortran 77 source that you wish to have converted.
Return mail brings you the resulting C, with f2c's error
messages between #ifdef uNdEfInEd and #endif at the end.
(To understand line numbers in the error messages, regard
the "execute f2c" line as line 0. It is stripped away by
the netlib software before f2c sees your Fortran input.)
Options described in the man page may be transmitted to
netlib by having the first line of input be a comment
whose first 6 characters are "c$f2c " and whose remaining
characters are the desired options, e.g., "c$f2c -R -u".
You may say "execute f2c" in the Subject line instead of (but
*not* in addition to) in the first line of the message body.
The incoming Fortran is saved, at least for a while. Don't
send any secrets!
BUGS: Please send bug reports (including the shortest example
you can find that illustrates the bug) to research!dmg
or dmg@bell-labs.com . You might first check whether
the bug goes away when you turn optimization off.
NOTE: f2c.h defines several types, e.g., real, integer, doublereal.
The definitions in f2c.h are suitable for most machines, but if
your machine has sizeof(double) > 2*sizeof(long), you may need
to adjust f2c.h appropriately. f2c assumes
sizeof(doublecomplex) = 2*sizeof(doublereal)
sizeof(doublereal) = sizeof(complex)
sizeof(doublereal) = 2*sizeof(real)
sizeof(real) = sizeof(integer)
sizeof(real) = sizeof(logical)
sizeof(real) = 2*sizeof(shortint)
EQUIVALENCEs may not be translated correctly if these
assumptions are violated.
On machines, such as those using a DEC Alpha processor, on
which sizeof(short) == 2, sizeof(int) == sizeof(float) == 4,
and sizeof(long) == sizeof(double) == 8, it suffices to
modify f2c.h by removing the first occurrence of "long "
on each line containing "long ", e.g., by issuing the
commands
mv f2c.h f2c.h0
sed 's/long //' f2c.h0 >f2c.h
On such machines, one can enable INTEGER*8 by uncommenting
the typedef of longint in f2c.h, so it reads
typedef long longint;
by compiling libI77 with -DAllow_TYQUAD, and by adjusting
libF77/makefile as described in libF77/README.
Some machines may have sizeof(int) == 4 and
sizeof(long long) == 8. On such machines, adjust f2c.h
by changing "long int " to "long long ", e.g., by saying
mv f2c.h f2c.h0
sed 's/long int /long long /' f2c.h0 >f2c.h
One can enable INTEGER*8 on such machines as described
above, but with
typedef long long longint;
There exists a C compiler that objects to the lines
typedef VOID C_f; /* complex function */
typedef VOID H_f; /* character function */
typedef VOID Z_f; /* double complex function */
in f2c.h . If yours is such a compiler, do two things:
1. Complain to your vendor about this compiler bug.
2. Find the line
#define VOID void
in f2c.h and change it to
#define VOID int
(For readability, the f2c.h lines shown above have had two
tabs inserted before their first character.)
FTP: All the material described above is now available by anonymous
ftp from netlib.bell-labs.com (login: anonymous; Password: your
E-mail address; cd netlib/f2c). Note that you can say, e.g.,
cd /netlib/f2c/src
binary
prompt
mget *.Z
to get all the .Z files in src. You must uncompress the .Z
files once you have a copy of them, e.g., by
uncompress *.Z
Subdirectory msdos contains two PC versions of f2c,
f2c.exe.Z and f2cx.exe.Z; the latter uses extended memory.
The README in that directory provides more details.
Changes appear first in the f2c files available by E-mail
from netlib@netlib.bell-labs.com. If the deamons work right,
changed files are available the next day by ftp from
netlib.bell-labs.com. In due course, they reach other netlib servers.
CHANGE NOTIFICATION:
Send the E-mail message
subscribe f2c
to netlib@netlib.bell-labs.com to request notification of new and
changed f2c files. (Beware that automatically sent change
notifications may reach you before changes have reached
ftp://netlib.bell-labs.com/netlib/f2c or to other netlib servers.)
Send the E-mail message
unsubscribe f2c
to recant your notification request.
-----------------
Recent change log (partial)
-----------------
Mon May 13 23:35:26 EDT 1996
Recognize Fortran 90's /= as a synonym for .NE.. (<> remains a
synonym for .NE..)
Emit an empty int function of no arguments to supply an external
name to named block data subprograms (so they can be called somewhere
to force them to be loaded from a library).
Fix bug (memory fault) in handling the following illegal Fortran:
parameter(i=1)
equivalence(i,j)
end
Treat cdabs, cdcos, cdexp, cdlog, cdsin, and cdsqrt as synonyms for
the double complex intrinsics zabs, zcos, zexp, zlog, zsin, and zsqrt,
respectively, unless -cd is specified.
Recognize the Fortran 90 bit-manipulation intrinsics btest, iand,
ibclr, ibits, ibset, ieor, ior, ishft, and ishftc, unless -i90 is
specified. Note that iand, ieor, and ior are thus now synonyms for
"and", "xor", and "or", respectively.
Add three macros (bit_test, bit_clear, bit_set) to f2c.h for use
with btest, ibclr, and ibset, respectively. Add new functions
[lq]bit_bits, [lq]bit_shift, and [lq]_bit_cshift to libF77 for
use with ibits, ishft, and ishftc, respectively.
Add integer function ftell(unit) (returning -1 on error) and
subroutine fseek(unit, offset, whence, *) to libI77 (with branch to
label * on error).
Tue May 14 23:21:12 EDT 1996
Fix glitch (possible memory fault, or worse) in handling multiple
entry points with names over 28 characters long.
Mon Jun 10 01:20:16 EDT 1996
Update netlib E-mail and ftp addresses in f2c/readme and
f2c/src/readme (which are different files) -- to reflect the upcoming
breakup of AT&T.
libf77: trivial tweaks to F77_aloc.c and system_.c; Version.c not
changed.
libi77: Adjust rsli.c and lread.c so internal list input with too
few items in the input string will honor end= .
Mon Jun 10 22:59:57 EDT 1996
Add Bits_per_Byte to sysdep.h and adjust definition of Table_size
to depend on Bits_per_Byte (forcing Table_size to be a power of 2); in
lex.c, change "comstart[c & 0xfff]" to "comstart[c & (Table_size-1)]"
to avoid an out-of-range subscript on end-of-file.
Wed Jun 12 00:24:28 EDT 1996
Fix bug in output.c (dereferencing a freed pointer) revealed in
print * !np in out_call in output.c clobbered by free
end !during out_expr.
Wed Jun 19 08:12:47 EDT 1996
f2c.h: add types uinteger, ulongint (for libF77); add qbit_clear
and qbit_set macros (in a commented-out section) for integer*8.
For integer*8, use qbit_clear and qbit_set for ibclr and ibset.
libf77: add casts to unsigned in [lq]bitshft.c.
Thu Jun 20 13:30:43 EDT 1996
Complain at character*(*) in common (rather than faulting).
Fix bug in recognizing hex constants that start with "16#" (e.g.,
16#1234abcd, which is a synonym for z'1234abcd').
Fix bugs in constant folding of expressions involving btest, ibclr,
and ibset.
Fix bug in constant folding of rshift(16#80000000, -31) (on a 32-bit
machine; more generally, the bug was in constant folding of
rshift(ibset(0,NBITS-1), 1-NBITS) when f2c runs on a machine with
long ints having NBITS bits.
Mon Jun 24 07:58:53 EDT 1996
Adjust struct Literal and newlabel() function to accommodate huge
source files (with more than 32767 newlabel() invocations).
Omit .c file when the .f file has a missing final end statement.
Wed Jun 26 14:00:02 EDT 1996
libi77: Add discussion of MXUNIT (highest allowed Fortran unit number)
to libI77/README.
Fri Jun 28 14:16:11 EDT 1996
Fix glitch with -onetrip: the temporary variable used for nonconstant
initial loop variable values was recycled too soon. Example:
do i = j+1, k
call foo(i+1) ! temp for j+1 was reused here
enddo
end
Tue Jul 2 16:11:27 EDT 1996
formatdata.c: add a 0 to the end of the basetype array (for TYBLANK)
(an omission that was harmless on most machines).
expr.c: fix a dereference of NULL that was only possible with buggy
input, such as
subroutine $sub(s) ! the '$' is erroneous
character s*(*)
s(1:) = ' '
end
Sat Jul 6 00:44:56 EDT 1996
Fix glitch in the intrinsic "real" function when applied to a
complex (or double complex) variable and passed as an argument to
some intrinsic functions. Example:
complex a
b = sqrt(real(a))
end
Fix glitch (only visible if you do not use f2c's malloc and the
malloc you do use is defective in the sense that malloc(0) returns 0)
in handling include files that end with another include (perhaps
followed by comments).
Fix glitch with character*(*) arguments named "h" and "i" when
the body of the subroutine invokes the intrinsic LEN function.
Arrange that after a previous "f2c -P foo.f" has produced foo.P,
running "f2c foo.P foo.f" will produce valid C when foo.f contains
call sub('1234')
end
subroutine sub(msg)
end
Specifically, the length argument in "call sub" is now suppressed.
With or without foo.P, it is also now suppressed when the order of
subprograms in file foo.f is reversed:
subroutine sub(msg)
end
call sub('1234')
end
Adjust copyright notices to reflect AT&T breakup.
Wed Jul 10 09:25:49 EDT 1996
Fix bug (possible memory fault) in handling erroneously placed
and inconsistent declarations. Example that faulted:
character*1 w(8)
call foo(w)
end
subroutine foo(m)
data h /0.5/
integer m(2) ! should be before data
end
Fix bug (possible fault) in handling illegal "if" constructions.
Example (that faulted):
subroutine foo(i,j)
if (i) then ! bug: i is integer, not logical
else if (j) then ! bug: j is integer, not logical
endif
end
Fix glitch with character*(*) argument named "ret_len" to a
character*(*) function.
Wed Jul 10 23:04:16 EDT 1996
Fix more glitches in the intrinsic "real" function when applied to a
complex (or double complex) variable and passed as an argument to
some intrinsic functions. Example:
complex a, b
r = sqrt(real(conjg(a))) + sqrt(real(a*b))
end
Thu Jul 11 17:27:16 EDT 1996
Fix a memory fault associated with complicated, illegal input.
Example:
subroutine goo
character a
call foo(a) ! inconsistent with subsequent def and call
end
subroutine foo(a)
end
call foo(a)
end
Wed Jul 17 19:18:28 EDT 1996
Fix yet another case of intrinsic "real" applied to a complex
argument. Example:
complex a(3)
x = sqrt(real(a(2))) ! gave error message about bad tag
end
Mon Aug 26 11:28:57 EDT 1996
Tweak sysdep.c for non-Unix systems in which process ID's can be
over 5 digits long.
Tue Aug 27 08:31:32 EDT 1996
Adjust the ishft intrinsic to use unsigned right shifts. (Previously,
a negative constant second operand resulted in a possibly signed shift.)
Thu Sep 12 14:04:07 EDT 1996
equiv.c: fix glitch with -DKR_headers.
libi77: fmtlib.c: fix bug in printing the most negative integer.
Fri Sep 13 08:54:40 EDT 1996
Diagnose some illegal appearances of substring notation.
Tue Sep 17 17:48:09 EDT 1996
Fix fault in handling some complex parameters. Example:
subroutine foo(a)
double complex a, b
parameter(b = (0,1))
a = b ! f2c faulted here
end
Thu Sep 26 07:47:10 EDT 1996
libi77: fmt.h: for formatted writes of negative integer*1 values,
make ic signed on ANSI systems. If formatted writes of integer*1
values trouble you when using a K&R C compiler, switch to an ANSI
compiler or use a compiler flag that makes characters signed.
Tue Oct 1 14:41:36 EDT 1996
Give a better error message when dummy arguments appear in data
statements.
Thu Oct 17 13:37:22 EDT 1996
Fix bug in typechecking arguments to character and complex (or
double complex) functions; the bug could cause length arguments
for character arguments to be omitted on invocations appearing
textually after the first invocation. For example, in
subroutine foo
character c
complex zot
call goo(zot(c), zot(c))
end
the length was omitted from the second invocation of zot, and
there was an erroneous error message about inconsistent calling
sequences.
Wed Dec 4 13:59:14 EST 1996
Fix bug revealed by
subroutine test(cdum,rdum)
complex cdum
rdum=cos(real(cdum)) ! "Unexpected tag 3 in opconv_fudge"
end
Fix glitch in parsing "DO 10 D0 = 1, 10".
Fix glitch in parsing
real*8 x
real*8 x ! erroneous "incompatible type" message
call foo(x)
end
lib[FI]77/makefile: add comment about omitting -x under Solaris.
Mon Dec 9 23:15:02 EST 1996
Fix glitch in parameter adjustments for arrays whose lower
bound depends on a scalar argument. Example:
subroutine bug(p,z,m,n)
integer z(*),m,n
double precision p(z(m):z(m) + n) ! p_offset botched
call foo(p(0), p(n))
end
libi77: complain about non-positive rec= in direct read and write
statements.
libf77: trivial adjustments; Version.c not changed.
Wed Feb 12 00:18:03 EST 1997
output.c: fix (seldom problematic) glitch in out_call: put parens
around the ... in a test of the form "if (q->tag == TADDR && ...)".
vax.c: fix bug revealed in the "psi_offset =" assignment in the
following example:
subroutine foo(psi,m)
integer z(100),m
common /a/ z
double precision psi(z(m):z(m) + 10)
call foo(m+1, psi(0),psi(10))
end
Mon Feb 24 23:44:54 EST 1997
For consistency with f2c's current treatment of adjacent character
strings in FORMAT statements, recognize a Hollerith string following
a string (and merge adjacent strings in FORMAT statements).
Wed Feb 26 13:41:11 EST 1997
New libf2c.zip, a combination of the libf77 and libi77 bundles (and
available only by ftp).
libf77: adjust functions with a complex output argument to permit
aliasing it with input arguments. (For now, at least, this is just
for possible benefit of g77.)
libi77: tweak to ftell_.c for systems with strange definitions of
SEEK_SET, etc.
Tue Apr 8 20:57:08 EDT 1997
libf77: [cz]_div.c: tweaks invisible on most systems (that may
improve things slightly with optimized compilation on systems that use
gratuitous extra precision).
libi77: fmt.c: adjust to complain at missing numbers in formats
(but still treat missing ".nnn" as ".0").
Fri Apr 11 14:05:57 EDT 1997
libi77: err.c: attempt to make stderr line buffered rather than
fully buffered. (Buffering is needed for format items T and TR.)
Thu Apr 17 22:42:43 EDT 1997
libf77: add F77_aloc.o to makefile (and makefile.u in libf2c.zip).
Fri Apr 25 19:32:09 EDT 1997
libf77: add [de]time_.c (which may give trouble on some systems).
Tue May 27 09:18:52 EDT 1997
libi77: ftell_.c: fix typo that caused the third argument to be
treated as 2 on some systems.
Mon Jun 9 00:04:37 EDT 1997
libi77 (and libf2c.zip): adjust include order in err.c lread.c wref.c
rdfmt.c to include fmt.h (etc.) after system includes. Version.c not
changed.
Mon Jun 9 14:29:13 EDT 1997
src/gram.c updated; somehow it did not reflect the change of
19961001 to gram.dcl.
Mon Jul 21 16:04:54 EDT 1997
proc.c: fix glitch in logic for "nonpositive dimension" message.
libi77: inquire.c: always include string.h (for possible use with
-DNON_UNIX_STDIO); Version.c not changed.
Thu Jul 24 17:11:23 EDT 1997
Tweak "Notice" to reflect the AT&T breakup -- we missed it when
updating the copyright notices in the source files last summer.
Adjust src/makefile so malloc.o is not used by default, but can
be specified with "make MALLOC=malloc.o".
Add comments to src/README about the "CRAY" T3E.
Tue Aug 5 14:53:25 EDT 1997
Add definition of calloc to malloc.c; this makes f2c's malloc
work on some systems where trouble hitherto arose because references
to calloc brought in the system's malloc. (On sensible systems,
calloc is defined separately from malloc. To avoid confusion on
other systems, f2c/malloc.c now defines calloc.)
libi77: lread.c: adjust to accord with a change to the Fortran 8X
draft (in 1990 or 1991) that rescinded permission to elide quote marks
in namelist input of character data; to get the old behavior, compile
with F8X_NML_ELIDE_QUOTES #defined. wrtfmt.o: wrt_G: tweak to print
the right number of 0's for zero under G format.
Sat Aug 16 05:45:32 EDT 1997
libi77: iio.c: fix bug in internal writes to an array of character
strings that sometimes caused one more array element than required by
the format to be blank-filled. Example: format(1x).
Wed Sep 17 00:39:29 EDT 1997
libi77: fmt.[ch] rdfmt.c wrtfmt.c: tweak struct syl for machines
with 64-bit pointers and 32-bit ints that did not 64-bit align
struct syl (e.g., Linux on the DEC Alpha). This change should be
invisible on other machines.
Sun Sep 21 22:05:19 EDT 1997
libf77: [de]time_.c (Unix systems only): change return type to double.
Current timestamps of files in "all from f2c/src", sorted by time,
appear below (mm/dd/year hh:mm:ss). To bring your source up to date,
obtain source files with a timestamp later than the time shown in your
version.c. Note that the time shown in the current version.c is the
timestamp of the source module that immediately follows version.c below:
8/05/1997 14:51:56 xsum0.out
8/05/1997 14:42:48 version.c
8/05/1997 10:31:26 malloc.c
7/24/1997 17:10:55 README
7/24/1997 17:00:57 makefile
7/24/1997 16:06:19 Notice
7/21/1997 12:58:44 proc.c
2/19/1997 13:34:09 lex.c
2/11/1997 23:39:14 vax.c
12/22/1996 11:51:22 output.c
12/04/1996 13:07:53 gram.exec
10/17/1996 13:10:40 putpcc.c
10/01/1996 14:36:18 gram.dcl
10/01/1996 14:36:18 init.c
10/01/1996 14:36:18 defs.h
10/01/1996 14:36:17 data.c
9/17/1996 17:29:44 expr.c
9/12/1996 12:12:46 equiv.c
8/27/1996 8:30:32 intr.c
8/26/1996 9:41:13 sysdep.c
7/09/1996 10:41:13 format.c
7/09/1996 10:40:45 names.c
7/04/1996 9:58:31 formatdata.c
7/04/1996 9:55:45 sysdep.h
7/04/1996 9:55:43 put.c
7/04/1996 9:55:41 pread.c
7/04/1996 9:55:40 parse_args.c
7/04/1996 9:55:40 p1output.c
7/04/1996 9:55:38 niceprintf.c
7/04/1996 9:55:37 misc.c
7/04/1996 9:55:36 memset.c
7/04/1996 9:55:36 mem.c
7/04/1996 9:55:35 main.c
7/04/1996 9:55:33 io.c
7/04/1996 9:55:30 exec.c
7/04/1996 9:55:29 error.c
7/04/1996 9:55:27 cds.c
7/03/1996 15:47:49 xsum.c
6/19/1996 7:04:27 f2c.h
6/19/1996 2:52:05 defines.h
5/13/1996 0:40:32 gram.head
5/12/1996 23:37:11 f2c.1
5/12/1996 23:37:02 f2c.1t
2/25/1994 2:07:19 parse.h
2/22/1994 19:07:20 iob.h
2/22/1994 18:56:53 p1defs.h
2/22/1994 18:53:46 output.h
2/22/1994 18:51:14 names.h
2/22/1994 18:30:41 format.h
1/18/1994 18:12:52 tokens
3/06/1993 14:13:58 gram.expr
1/28/1993 9:03:16 ftypes.h
4/06/1990 0:00:57 gram.io
2/03/1990 0:58:26 niceprintf.h
1/07/1990 1:20:01 usignal.h
11/27/1989 8:27:37 machdefs.h
7/01/1989 11:59:44 pccdefs.h
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment