diff --git a/com.oracle.truffle.r.native/gnur/patch/Makeconf.in b/com.oracle.truffle.r.native/gnur/patch/Makeconf.in new file mode 100644 index 0000000000000000000000000000000000000000..0e1b82437bf862a713ccee67addbb742d6ab4b73 --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/Makeconf.in @@ -0,0 +1,154 @@ +PACKAGE = @PACKAGE@ +VERSION = @VERSION@ + +abs_top_srcdir = @abs_top_srcdir@ +abs_top_builddir = @abs_top_builddir@ + +include $(top_srcdir)/share/make/vars.mk + +AR = @AR@ +ACLOCAL = @ACLOCAL@ +AUTOCONF = @AUTOCONF@ +AUTOMAKE = @AUTOMAKE@ +AUTOHEADER = @AUTOHEADER@ +BLAS_LIBS = @BLAS_LIBS@ +BUILDDIR_IS_SRCDIR = @BUILDDIR_IS_SRCDIR@ +CC = @CC@ +CFLAGS = @CFLAGS@ @LTO@ +CPICFLAGS = @CPICFLAGS@ +CPPFLAGS = @CPPFLAGS@ +CURL_CPPFLAGS = @CURL_CPPFLAGS@ +CURL_LIBS = @CURL_LIBS@ +## in case we want to link with this for UBSAN checks +CXX = @CXX@ +DEFS = @DEFS@ @R_DEFS@ +DISTDIR_TAR_EXCLUDE = --exclude=.svn --exclude=Makefile --exclude="*.o" --exclude="*$(SHLIB_EXT)" --exclude="*~" +DYLIB_EXT = @DYLIB_EXT@ +DYLIB_LD = @DYLIB_LD@ +DYLIB_LDFLAGS = @DYLIB_LDFLAGS@@BUILD_LTO_TRUE@ $(DYLIBS_LTO) +DYLIB_LINK = $(DYLIB_LD) $(DYLIB_LDFLAGS) $(LDFLAGS) +DYLIBS_LTO = $(CFLAGS) $(CPICFLAGS) +ECHO = echo +ECHO_C = @ECHO_C@ +ECHO_N = @ECHO_N@ +ECHO_T = @ECHO_T@ +FFLAGS = @FFLAGS@ @LTO@ +FLIBS = @FLIBS@ +## needed for some earlier Solaris compilers +FLIBS_IN_SO = @FLIBS_IN_SO@ +FPICFLAGS = @FPICFLAGS@ +F77 = @F77@ +GETWD = @GETWD@ +GZIP = --best +INSTALL = @INSTALL@ +INSTALL_DATA = @INSTALL_DATA@ +INSTALL_PROGRAM = @INSTALL_PROGRAM@ +INSTALL_SCRIPT = @INSTALL_SCRIPT@ +INSTALL_DIR = ${INSTALL} -d +LDFLAGS = @LDFLAGS@ +LIBINTL= @LIBINTL@ +LIBM = @LIBM@ +LIBR0 = @LIBR0@ +LIBR1 = @LIBR1@ +LIBR = @LIBR0@ @LIBR1@ +## These are the libs which the final R.bin/libR is linked against. +## Many of these used to be optional: ICU libs still are. +## There may be platform-specific ones, e.g. +## -lrt -ldl on Linux, -lnsl -lsocket -lrt -lsunmath -ldl -liconv on Solaris. +LIBS = @LIBS@ +LIBnn = @LIBnn@ +LIBTOOL = @LIBTOOL@ +## AFAICS unused +LN_S = @LN_S@ +MAIN_CFLAGS = @MAIN_CFLAGS@ +MAIN_FFLAGS = @MAIN_FFLAGS@ +MAIN_LD = @MAIN_LD@@BUILD_LTO_TRUE@ $(CFLAGS) +MAIN_LDFLAGS = @MAIN_LDFLAGS@ @WANT_R_SHLIB_FALSE@ @USE_EXPORTFILES_TRUE@ -Wl,-bE:$(top_builddir)/etc/R.exp +MAIN_LINK = $(MAIN_LD) $(MAIN_LDFLAGS) $(LIBR0) $(LDFLAGS) +## need this for bootstrapping +MKINSTALLDIRS = @R_SHELL@ $(top_srcdir)/src/scripts/mkinstalldirs.in +NOTANGLE = @NOTANGLE@ +R_ARCH = @R_ARCH@ +R_DYLIB_EXT = @R_DYLIB_EXT@ +R_FRAMEWORK_DIR = $(prefix)/R.framework +R_GZIPCMD = @R_GZIPCMD@ +## needed for AIX only +@USE_EXPORTFILES_TRUE@ R_HOME = $(top_builddir) +R_OPENMP_CFLAGS = @R_OPENMP_CFLAGS@ +## if ever used, need to check that this is compatible with C OpenMP +R_OPENMP_FFLAGS = @R_OPENMP_FFLAGS@ +R_OSTYPE = @R_OSTYPE@ +R_PKGS = $(R_PKGS_BASE) @USE_RECOMMENDED_PACKAGES_TRUE@ $(R_PKGS_RECOMMENDED) +R_PLATFORM = @R_PLATFORM@ +R_XTRA_CFLAGS = @R_XTRA_CFLAGS@ +R_XTRA_CPPFLAGS = @R_XTRA_CPPFLAGS@ -I. -I$(top_builddir)/src/include -I$(top_srcdir)/src/include +R_XTRA_FFLAGS = @R_XTRA_FFLAGS@ +R_XTRA_LIBS = @R_XTRA_LIBS@ +RANLIB = @RANLIB@ +READLINE_LIBS = @READLINE_LIBS@ +SED = @SED@ +SHELL = @R_SHELL@ +SHLIB_EXT = @SHLIB_EXT@ +SHLIB_CFLAGS = @SHLIB_CFLAGS@ +SHLIB_FFLAGS = @SHLIB_FFLAGS@ +SHLIB_LD = @SHLIB_LD@ +SHLIB_LDFLAGS = @SHLIB_LDFLAGS@@BUILD_LTO_TRUE@ $(SHLIB_LTO) +SHLIB_LINK = $(SHLIB_LD) $(SHLIB_LDFLAGS) $(LIBR0) $(LDFLAGS) +SHLIB_LTO = $(CFLAGS) $(CPICFLAGS) +STRIP_LIBS = @striplib@ +STRIP_STATIC_LIBS = @stripstaticlib@ +TAR = @TAR@ +USE_NLS = @USE_NLS@ +X_CFLAGS = @X_CFLAGS@ +X_LIBS = @X_LIBS@ +X_PRE_LIBS = @X_PRE_LIBS@ +X_EXTRA_LIBS = @X_EXTRA_LIBS@ +YACC = @YACC@ + +ALL_CFLAGS = $(R_XTRA_CFLAGS) $(R_OPENMP_CFLAGS) $(MAIN_CFLAGS) $(CFLAGS) +ALL_CPPFLAGS = $(R_XTRA_CPPFLAGS) $(CPPFLAGS) $(DEFS) +## R_OPENMP_FFLAGS should not really be here: see above +ALL_FFLAGS = $(R_XTRA_FFLAGS) $(R_OPENMP_FFLAGS) $(MAIN_FFLAGS) $(FFLAGS) +ALL_CFLAGS_LO = $(R_XTRA_CFLAGS) $(R_OPENMP_CFLAGS) $(CPICFLAGS) $(SHLIB_CFLAGS) $(CFLAGS) +ALL_FFLAGS_LO = $(R_XTRA_FFLAGS) $(R_OPENMP_FFLAGS) $(FPICFLAGS) $(SHLIB_FFLAGS) $(FFLAGS) + +.SUFFIXES: +.SUFFIXES: .c .f .m .d .o + +@r_cc_rules_frag@ +.f.o: + $(F77) $(ALL_FFLAGS) -c $< -o $@ + +prefix = @prefix@ +exec_prefix = @exec_prefix@ +datarootdir = @datarootdir@ +## only used for installing 'R'. +bindir = @bindir@ +## not used +datadir = @datadir@ +## used for 'rhome' and installation of standalone Rmath +libdir = @libdir@ +## used for man page +mandir = @mandir@ +## used for installation of standalone Rmath headers +includedir = @includedir@ + +rhome = ${libdir}/R +rsharedir = @rsharedir@ +rincludedir = @rincludedir@ +rdocdir = @rdocdir@ + +## Overrides for installing R as a framework (macOS). +@WANT_R_FRAMEWORK_TRUE@FW_VERSION = @FW_VERSION@ +@WANT_R_FRAMEWORK_TRUE@rhome = $(R_FRAMEWORK_DIR)/Versions/$(FW_VERSION)/Resources +@WANT_R_FRAMEWORK_TRUE@bindir = $(rhome) +@WANT_R_FRAMEWORK_TRUE@mandir = $(rhome) + +Rexecbindir = $(rhome)/bin +Rexecbindir2 = $(rhome)/bin/exec$(R_ARCH) +Rexeclibdir = $(rhome)/lib$(R_ARCH) +## FIXME: +## Alternatively, we could try to set pkglibdir = $(rhome)/lib when +## switching to automake. +## </FIXME> +Rexecmodulesdir = $(rhome)/modules$(R_ARCH) diff --git a/com.oracle.truffle.r.native/gnur/patch/Makefile.in b/com.oracle.truffle.r.native/gnur/patch/Makefile.in new file mode 100644 index 0000000000000000000000000000000000000000..505effd94aa5bd3398aa275a039304071d57c5d0 --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/Makefile.in @@ -0,0 +1,244 @@ +# +# ${R_HOME}/Makefile + +VPATH = @srcdir@ +srcdir = @srcdir@ +top_srcdir = @top_srcdir@ + +top_builddir = . + +include $(top_builddir)/Makeconf + +GIT = `if [ -d "$(top_builddir)/.git" ]; then echo "git"; fi` + +distdir = $(PACKAGE)-$(VERSION) +INSTFILES = COPYING +NON_SVN_INSTFILES = SVN-REVISION +DISTFILES = $(INSTFILES) \ + ChangeLog INSTALL README VERSION VERSION-NICK \ + Makeconf.in Makefile.in Makefile.fw \ + config.site configure configure.ac +SUBDIRS = m4 tools doc etc share src tests +SUBDIRS_WITH_NO_BUILD = po + +all: Makefile Makeconf R docs recommended vignettes javaconf +recommended: @USE_RECOMMENDED_PACKAGES_TRUE@ stamp-recommended + +Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status + @cd $(top_builddir) && $(SHELL) ./config.status $@ +Makeconf: $(srcdir)/Makeconf.in $(top_builddir)/config.status + @cd $(top_builddir) && $(SHELL) ./config.status $@ + +ACLOCAL_M4 = aclocal.m4 +## NB: this is duplicated in m4/Makefile.in +ACINCLUDE_DEPENDENCIES = \ + m4/R.m4 \ + m4/bigendian.m4 \ + m4/cairo.m4 \ + m4/clibs.m4 \ + m4/codeset.m4 \ + m4/cxx_11.m4 \ + m4/gettext.m4 m4/gettext-lib.m4 \ + m4/libtool.m4 m4/ltoptions.m4 m4/ltversion.m4 m4/ltsugar.m4 m4/lt~obsolete.m4 \ + m4/openmp.m4 \ + m4/stat-time.m4 +CONFIGURE_DEPENDENCIES = $(srcdir)/VERSION +config.status: $(srcdir)/configure + @$(SHELL) ./config.status --recheck +$(srcdir)/configure: @MAINTAINER_MODE_TRUE@ $(srcdir)/configure.ac $(ACLOCAL_M4) $(CONFIGURE_DEPENDENCIES) + @BD=`pwd`; cd $(srcdir) && $(AUTOCONF) -B $${BD} +$(ACLOCAL_M4): $(srcdir)/configure.ac acinclude.m4 + @BD=`pwd`; cd $(srcdir) && $(ACLOCAL) --output=$${BD}/$@ -I $${BD} +acinclude.m4: $(srcdir)/configure.ac $(ACINCLUDE_DEPENDENCIES) + @(cd $(srcdir) && cat $(ACINCLUDE_DEPENDENCIES)) > $@ + +LIBTOOL_DEPS = @LIBTOOL_DEPS@ +libtool: $(LIBTOOL_DEPS) + $(SHELL) ./config.status --recheck + +R: Makefile svnonly + @if test "$(BUILDDIR_IS_SRCDIR)" = no ; then \ + for f in $(INSTFILES); do \ + $(INSTALL_DATA) $(srcdir)/$${f} $(top_builddir); \ + done; \ + fi + @for d in $(SUBDIRS); do \ + (cd $${d} && $(MAKE) R) || exit 1; \ + done + @test -f src/library/stamp-docs || \ + $(ECHO) "you should 'make docs' now ..." + +docs: R FORCE + -@(cd doc && $(MAKE) $@) + -@(cd src/library && $(MAKE) $@) +FORCE: + +stamp-recommended: R docs + @(cd src/library/Recommended && $(MAKE)) + +## One of the grid vignettes requires lattice +vignettes: stamp-recommended + @(cd src/library && $(MAKE) $@) + +## This needs packages built, hence 'R' dependence on 'javaconf' +## javareconf gets remade often. +stamp-java : etc/javaconf $(srcdir)/src/scripts/javareconf.in +@WANT_JAVA_TRUE@ @$(ECHO) "configuring Java ..." +@WANT_JAVA_TRUE@ @-bin/R CMD javareconf + @touch stamp-java + +javaconf: R + @$(MAKE) stamp-java + + +install install-strip: installdirs svnonly + @for d in $(SUBDIRS); do \ + (cd $${d} && $(MAKE) $@) || exit 1; \ + done + @for f in $(INSTFILES); do \ + $(INSTALL_DATA) $(srcdir)/$${f} "$(DESTDIR)$(rhome)"; \ + done + @for f in $(NON_SVN_INSTFILES); do \ + $(INSTALL_DATA) $${f} "$(DESTDIR)$(rhome)"; \ + done +@WANT_R_FRAMEWORK_TRUE@ $(MAKE) -f $(srcdir)/Makefile.fw top_srcdir=$(top_srcdir) $@ + +svnonly: + @if test ! -f "$(srcdir)/doc/FAQ" || test -f non-tarball ; then \ + (cd doc/manual && $(MAKE) front-matter html-non-svn) ; \ + touch non-tarball ; \ + (cd $(srcdir); LC_ALL=C TZ=GMT $(GIT) svn info || $(ECHO) "Revision: -99") 2> /dev/null \ + | sed -n -e '/^Revision/p' -e '/^Last Changed Date/'p \ + | cut -d' ' -f1,2,3,4 > SVN-REVISION-tmp ; \ + if test "`cat SVN-REVISION-tmp`" = "Revision: -99"; then \ + $(ECHO) "ERROR: not an svn checkout"; \ + exit 1; \ + fi; \ + $(SHELL) $(top_srcdir)/tools/move-if-change SVN-REVISION-tmp SVN-REVISION ; \ + rm -f SVN-REVISION-tmp ; \ + else \ + if test "$(BUILDDIR_IS_SRCDIR)" = no ; then \ + for f in $(NON_SVN_INSTFILES); do \ + $(INSTALL_DATA) $(srcdir)/$${f} $(top_builddir); \ + done \ + fi \ + fi + +@WANT_R_STATIC_FALSE@libR_la = libR$(R_DYLIB_EXT) +@WANT_R_STATIC_TRUE@libR_la = libR.a +install-libR: + @if test -f lib$(R_ARCH)/$(libR_la); then $(MAKE) install-libR-exists; fi +install-libR-exists: + @$(MKINSTALLDIRS) "$(DESTDIR)${libdir}" + @$(INSTALL_DATA) -m755 lib$(R_ARCH)/$(libR_la) "$(DESTDIR)${libdir}" +uninstall-libR: + @rm -f "$(DESTDIR)${libdir}/$(libR_la)" + +installdirs: + @$(MKINSTALLDIRS) "$(DESTDIR)$(rhome)" +uninstall: + @(for d in $(SUBDIRS); do rsd="$${d} $${rsd}"; done; \ + for d in $${rsd}; do (cd $${d} && $(MAKE) $@); done) + @for f in $(INSTFILES) $(NON_SVN_INSTFILES); do \ + rm -f "$(DESTDIR)$(rhome)/$${f}"; \ + done + @rm -rf "$(DESTDIR)$(Rexecbindir)" "$(DESTDIR)$(rhome)/lib" + @rmdir "$(DESTDIR)$(rhome)" 2>/dev/null \ + || $(ECHO) " dir $(DESTDIR)$(rhome) not removed" + @rm -f "$(DESTDIR)${libdir}/libR$(R_DYLIB_EXT)" + +mostlyclean: clean +clean: + @(for d in $(SUBDIRS); do rsd="$${d} $${rsd}"; done; \ + for d in $${rsd}; do (cd $${d} && $(MAKE) $@); done) + @if test "$(BUILDDIR_IS_SRCDIR)" = no ; then \ + rm -f $(INSTFILES); \ + fi +distclean: clean + @(for d in $(SUBDIRS); do rsd="$${d} $${rsd}"; done; \ + for d in $${rsd}; do (cd $${d} && $(MAKE) $@); done) + @rm -f po/Makefile + -@rm -rf bin include lib library modules gnome + @if test -f non-tarball ; then \ + rm -f $(NON_SVN_INSTFILES) non-tarball doc/FAQ doc/RESOURCES doc/html/resources.html doc/html/NEWS.html; \ + fi + @if test "$(BUILDDIR_IS_SRCDIR)" = no ; then \ + rm -f $(NON_SVN_INSTFILES); \ + rm -rf $(SUBDIRS) $(SUBDIRS_WITH_NO_BUILD); \ + fi + -@rm -rf libconftest.dSYM + -@rm -f Makeconf Makefile Makefile.bak Makefrag.* \ + config.cache config.log config.status libtool stamp-java \ + $(ACLOCAL_M4) acinclude.m4 $(distdir).tar.gz +maintainer-clean: distclean + @$(ECHO) "This command is intended for maintainers to use; it" + @$(ECHO) "deletes files that may need special rules to rebuild" + @(for d in $(SUBDIRS); do rsd="$${d} $${rsd}"; done; \ + for d in $${rsd}; do (cd $${d} && $(MAKE) $@); done) + -@(cd $(srcdir) && rm -rf autom4te.cache) + +dist: dist-unix +dist-unix: distdir + -chmod -R a+r $(distdir) + -chmod -R go-w $(distdir) + distname=`$(srcdir)/tools/GETDISTNAME`; \ + dirname=`$(ECHO) $${distname} | sed -e s/_.*//`; \ + if test $(distdir) != $${dirname} ; then \ + mv $(distdir) $${dirname}; \ + fi ; \ + GZIP=$(GZIP) $(TAR) czf $${distname}.tar.gz $${dirname}; \ + rm -rf $${dirname} +dist-win: +distdir: $(DISTFILES) vignettes + @rm -rf $(distdir) + @mkdir $(distdir) + @-chmod 755 $(distdir) + @for f in $(DISTFILES); do \ + test -f $(distdir)/$${f} \ + || ln $(srcdir)/$${f} $(distdir)/$${f} 2>/dev/null \ + || cp -p $(srcdir)/$${f} $(distdir)/$${f}; \ + done + @for f in $(NON_SVN_INSTFILES) ; do \ + cp -p $${f} $(distdir)/$${f}; \ + done + @for d in $(SUBDIRS); do \ + test -d $(distdir)/$${d} \ + || mkdir $(distdir)/$${d} \ + || exit 1; \ + chmod 755 $(distdir)/$${d}; \ + (cd $${d} && $(MAKE) distdir) \ + || exit 1; \ + done + @for d in $(SUBDIRS_WITH_NO_BUILD); do \ + ((cd $(srcdir); $(TAR) -c -f - $(DISTDIR_TAR_EXCLUDE) $${d}) \ + | (cd $(distdir); $(TAR) -x -f -)) \ + || exit 1; \ + done + @for d in grid parallel utils; do \ + mkdir -p $(distdir)/src/library/$${d}/inst/doc; \ + cp library/$${d}/doc/*.pdf $(distdir)/src/library/$${d}/inst/doc; \ + done + @(cd $(distdir); tools/link-recommended) + +info pdf: + -@(cd doc && $(MAKE) $@) +install-info install-pdf: + -@(cd doc/manual && $(MAKE) $@) +uninstall-info uninstall-pdf: + -@(cd doc/manual && $(MAKE) $@) + +install-tests: + -@(cd tests && $(MAKE) $@) + -@(cd src/library && $(MAKE) $@) + +uninstall-tests: + -@(cd src/library && $(MAKE) $@) + -@(cd tests && $(MAKE) $@) + +check check-devel check-all check-recommended: + @(cd tests && $(MAKE) $@) + +reset-recommended: + @(cd src/library/Recommended && $(MAKE) clean) + +TAGS: diff --git a/com.oracle.truffle.r.native/gnur/patch/SVN-REVISION b/com.oracle.truffle.r.native/gnur/patch/SVN-REVISION new file mode 100644 index 0000000000000000000000000000000000000000..4d423707afdb5cef3a699f3d1d7984001a41274d --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/SVN-REVISION @@ -0,0 +1,2 @@ +Revision: 72570 +Last Changed Date: 2017-04-21 diff --git a/com.oracle.truffle.r.native/gnur/patch/VERSION b/com.oracle.truffle.r.native/gnur/patch/VERSION new file mode 100644 index 0000000000000000000000000000000000000000..18091983f59ddde8105e566545a0d9e4a12a4f1c --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/VERSION @@ -0,0 +1 @@ +3.4.0 diff --git a/com.oracle.truffle.r.native/gnur/patch/VERSION-NICK b/com.oracle.truffle.r.native/gnur/patch/VERSION-NICK new file mode 100644 index 0000000000000000000000000000000000000000..8ee68dfb4fc1b77ab665155abb84c97a462135d8 --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/VERSION-NICK @@ -0,0 +1 @@ +You Stupid Darkness diff --git a/com.oracle.truffle.r.native/gnur/patch/configure b/com.oracle.truffle.r.native/gnur/patch/configure new file mode 100755 index 0000000000000000000000000000000000000000..1337780363cd9679a91bc605b70c3e1e57e92e47 --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/configure @@ -0,0 +1,54219 @@ +#! /bin/sh +# Guess values for system-dependent variables and create Makefiles. +# Generated by GNU Autoconf 2.69 for R 3.4.0. +# +# Report bugs to <https://bugs.r-project.org>. +# +# +# Copyright (C) 1992-1996, 1998-2012 Free Software Foundation, Inc. +# +# +# This configure script is free software; the Free Software Foundation +# gives unlimited permission to copy, distribute and modify it. +## -------------------- ## +## M4sh Initialization. ## +## -------------------- ## + +# Be more Bourne compatible +DUALCASE=1; export DUALCASE # for MKS sh +if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then : + emulate sh + NULLCMD=: + # Pre-4.2 versions of Zsh do word splitting on ${1+"$@"}, which + # is contrary to our usage. Disable this feature. + alias -g '${1+"$@"}'='"$@"' + setopt NO_GLOB_SUBST +else + case `(set -o) 2>/dev/null` in #( + *posix*) : + set -o posix ;; #( + *) : + ;; +esac +fi + + +as_nl=' +' +export as_nl +# Printing a long string crashes Solaris 7 /usr/bin/printf. +as_echo='\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\' +as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo +as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo$as_echo +# Prefer a ksh shell builtin over an external printf program on Solaris, +# but without wasting forks for bash or zsh. +if test -z "$BASH_VERSION$ZSH_VERSION" \ + && (test "X`print -r -- $as_echo`" = "X$as_echo") 2>/dev/null; then + as_echo='print -r --' + as_echo_n='print -rn --' +elif (test "X`printf %s $as_echo`" = "X$as_echo") 2>/dev/null; then + as_echo='printf %s\n' + as_echo_n='printf %s' +else + if test "X`(/usr/ucb/echo -n -n $as_echo) 2>/dev/null`" = "X-n $as_echo"; then + as_echo_body='eval /usr/ucb/echo -n "$1$as_nl"' + as_echo_n='/usr/ucb/echo -n' + else + as_echo_body='eval expr "X$1" : "X\\(.*\\)"' + as_echo_n_body='eval + arg=$1; + case $arg in #( + *"$as_nl"*) + expr "X$arg" : "X\\(.*\\)$as_nl"; + arg=`expr "X$arg" : ".*$as_nl\\(.*\\)"`;; + esac; + expr "X$arg" : "X\\(.*\\)" | tr -d "$as_nl" + ' + export as_echo_n_body + as_echo_n='sh -c $as_echo_n_body as_echo' + fi + export as_echo_body + as_echo='sh -c $as_echo_body as_echo' +fi + +# The user is always right. +if test "${PATH_SEPARATOR+set}" != set; then + PATH_SEPARATOR=: + (PATH='/bin;/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 && { + (PATH='/bin:/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 || + PATH_SEPARATOR=';' + } +fi + + +# IFS +# We need space, tab and new line, in precisely that order. Quoting is +# there to prevent editors from complaining about space-tab. +# (If _AS_PATH_WALK were called with IFS unset, it would disable word +# splitting by setting IFS to empty value.) +IFS=" "" $as_nl" + +# Find who we are. Look in the path if we contain no directory separator. +as_myself= +case $0 in #(( + *[\\/]* ) as_myself=$0 ;; + *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break + done +IFS=$as_save_IFS + + ;; +esac +# We did not find ourselves, most probably we were run as `sh COMMAND' +# in which case we are not to be found in the path. +if test "x$as_myself" = x; then + as_myself=$0 +fi +if test ! -f "$as_myself"; then + $as_echo "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2 + exit 1 +fi + +# Unset variables that we do not need and which cause bugs (e.g. in +# pre-3.0 UWIN ksh). But do not cause bugs in bash 2.01; the "|| exit 1" +# suppresses any "Segmentation fault" message there. '((' could +# trigger a bug in pdksh 5.2.14. +for as_var in BASH_ENV ENV MAIL MAILPATH +do eval test x\${$as_var+set} = xset \ + && ( (unset $as_var) || exit 1) >/dev/null 2>&1 && unset $as_var || : +done +PS1='$ ' +PS2='> ' +PS4='+ ' + +# NLS nuisances. +LC_ALL=C +export LC_ALL +LANGUAGE=C +export LANGUAGE + +# CDPATH. +(unset CDPATH) >/dev/null 2>&1 && unset CDPATH + +# Use a proper internal environment variable to ensure we don't fall + # into an infinite loop, continuously re-executing ourselves. + if test x"${_as_can_reexec}" != xno && test "x$CONFIG_SHELL" != x; then + _as_can_reexec=no; export _as_can_reexec; + # We cannot yet assume a decent shell, so we have to provide a +# neutralization value for shells without unset; and this also +# works around shells that cannot unset nonexistent variables. +# Preserve -v and -x to the replacement shell. +BASH_ENV=/dev/null +ENV=/dev/null +(unset BASH_ENV) >/dev/null 2>&1 && unset BASH_ENV ENV +case $- in # (((( + *v*x* | *x*v* ) as_opts=-vx ;; + *v* ) as_opts=-v ;; + *x* ) as_opts=-x ;; + * ) as_opts= ;; +esac +exec $CONFIG_SHELL $as_opts "$as_myself" ${1+"$@"} +# Admittedly, this is quite paranoid, since all the known shells bail +# out after a failed `exec'. +$as_echo "$0: could not re-execute with $CONFIG_SHELL" >&2 +as_fn_exit 255 + fi + # We don't want this to propagate to other subprocesses. + { _as_can_reexec=; unset _as_can_reexec;} +if test "x$CONFIG_SHELL" = x; then + as_bourne_compatible="if test -n \"\${ZSH_VERSION+set}\" && (emulate sh) >/dev/null 2>&1; then : + emulate sh + NULLCMD=: + # Pre-4.2 versions of Zsh do word splitting on \${1+\"\$@\"}, which + # is contrary to our usage. Disable this feature. + alias -g '\${1+\"\$@\"}'='\"\$@\"' + setopt NO_GLOB_SUBST +else + case \`(set -o) 2>/dev/null\` in #( + *posix*) : + set -o posix ;; #( + *) : + ;; +esac +fi +" + as_required="as_fn_return () { (exit \$1); } +as_fn_success () { as_fn_return 0; } +as_fn_failure () { as_fn_return 1; } +as_fn_ret_success () { return 0; } +as_fn_ret_failure () { return 1; } + +exitcode=0 +as_fn_success || { exitcode=1; echo as_fn_success failed.; } +as_fn_failure && { exitcode=1; echo as_fn_failure succeeded.; } +as_fn_ret_success || { exitcode=1; echo as_fn_ret_success failed.; } +as_fn_ret_failure && { exitcode=1; echo as_fn_ret_failure succeeded.; } +if ( set x; as_fn_ret_success y && test x = \"\$1\" ); then : + +else + exitcode=1; echo positional parameters were not saved. +fi +test x\$exitcode = x0 || exit 1 +test -x / || exit 1" + as_suggested=" as_lineno_1=";as_suggested=$as_suggested$LINENO;as_suggested=$as_suggested" as_lineno_1a=\$LINENO + as_lineno_2=";as_suggested=$as_suggested$LINENO;as_suggested=$as_suggested" as_lineno_2a=\$LINENO + eval 'test \"x\$as_lineno_1'\$as_run'\" != \"x\$as_lineno_2'\$as_run'\" && + test \"x\`expr \$as_lineno_1'\$as_run' + 1\`\" = \"x\$as_lineno_2'\$as_run'\"' || exit 1 +test \$(( 1 + 1 )) = 2 || exit 1 + + test -n \"\${ZSH_VERSION+set}\${BASH_VERSION+set}\" || ( + ECHO='\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\' + ECHO=\$ECHO\$ECHO\$ECHO\$ECHO\$ECHO + ECHO=\$ECHO\$ECHO\$ECHO\$ECHO\$ECHO\$ECHO + PATH=/empty FPATH=/empty; export PATH FPATH + test \"X\`printf %s \$ECHO\`\" = \"X\$ECHO\" \\ + || test \"X\`print -r -- \$ECHO\`\" = \"X\$ECHO\" ) || exit 1" + if (eval "$as_required") 2>/dev/null; then : + as_have_required=yes +else + as_have_required=no +fi + if test x$as_have_required = xyes && (eval "$as_suggested") 2>/dev/null; then : + +else + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +as_found=false +for as_dir in /bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + as_found=: + case $as_dir in #( + /*) + for as_base in sh bash ksh sh5; do + # Try only shells that exist, to save several forks. + as_shell=$as_dir/$as_base + if { test -f "$as_shell" || test -f "$as_shell.exe"; } && + { $as_echo "$as_bourne_compatible""$as_required" | as_run=a "$as_shell"; } 2>/dev/null; then : + CONFIG_SHELL=$as_shell as_have_required=yes + if { $as_echo "$as_bourne_compatible""$as_suggested" | as_run=a "$as_shell"; } 2>/dev/null; then : + break 2 +fi +fi + done;; + esac + as_found=false +done +$as_found || { if { test -f "$SHELL" || test -f "$SHELL.exe"; } && + { $as_echo "$as_bourne_compatible""$as_required" | as_run=a "$SHELL"; } 2>/dev/null; then : + CONFIG_SHELL=$SHELL as_have_required=yes +fi; } +IFS=$as_save_IFS + + + if test "x$CONFIG_SHELL" != x; then : + export CONFIG_SHELL + # We cannot yet assume a decent shell, so we have to provide a +# neutralization value for shells without unset; and this also +# works around shells that cannot unset nonexistent variables. +# Preserve -v and -x to the replacement shell. +BASH_ENV=/dev/null +ENV=/dev/null +(unset BASH_ENV) >/dev/null 2>&1 && unset BASH_ENV ENV +case $- in # (((( + *v*x* | *x*v* ) as_opts=-vx ;; + *v* ) as_opts=-v ;; + *x* ) as_opts=-x ;; + * ) as_opts= ;; +esac +exec $CONFIG_SHELL $as_opts "$as_myself" ${1+"$@"} +# Admittedly, this is quite paranoid, since all the known shells bail +# out after a failed `exec'. +$as_echo "$0: could not re-execute with $CONFIG_SHELL" >&2 +exit 255 +fi + + if test x$as_have_required = xno; then : + $as_echo "$0: This script requires a shell more modern than all" + $as_echo "$0: the shells that I found on your system." + if test x${ZSH_VERSION+set} = xset ; then + $as_echo "$0: In particular, zsh $ZSH_VERSION has bugs and should" + $as_echo "$0: be upgraded to zsh 4.3.4 or later." + else + $as_echo "$0: Please tell bug-autoconf@gnu.org and +$0: https://bugs.r-project.org about your system, including +$0: any error possibly output before this message. Then +$0: install a modern shell, or manually run the script +$0: under such a shell if you do have one." + fi + exit 1 +fi +fi +fi +SHELL=${CONFIG_SHELL-/bin/sh} +export SHELL +# Unset more variables known to interfere with behavior of common tools. +CLICOLOR_FORCE= GREP_OPTIONS= +unset CLICOLOR_FORCE GREP_OPTIONS + +## --------------------- ## +## M4sh Shell Functions. ## +## --------------------- ## +# as_fn_unset VAR +# --------------- +# Portably unset VAR. +as_fn_unset () +{ + { eval $1=; unset $1;} +} +as_unset=as_fn_unset + +# as_fn_set_status STATUS +# ----------------------- +# Set $? to STATUS, without forking. +as_fn_set_status () +{ + return $1 +} # as_fn_set_status + +# as_fn_exit STATUS +# ----------------- +# Exit the shell with STATUS, even in a "trap 0" or "set -e" context. +as_fn_exit () +{ + set +e + as_fn_set_status $1 + exit $1 +} # as_fn_exit + +# as_fn_mkdir_p +# ------------- +# Create "$as_dir" as a directory, including parents if necessary. +as_fn_mkdir_p () +{ + + case $as_dir in #( + -*) as_dir=./$as_dir;; + esac + test -d "$as_dir" || eval $as_mkdir_p || { + as_dirs= + while :; do + case $as_dir in #( + *\'*) as_qdir=`$as_echo "$as_dir" | sed "s/'/'\\\\\\\\''/g"`;; #'( + *) as_qdir=$as_dir;; + esac + as_dirs="'$as_qdir' $as_dirs" + as_dir=`$as_dirname -- "$as_dir" || +$as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ + X"$as_dir" : 'X\(//\)[^/]' \| \ + X"$as_dir" : 'X\(//\)$' \| \ + X"$as_dir" : 'X\(/\)' \| . 2>/dev/null || +$as_echo X"$as_dir" | + sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ + s//\1/ + q + } + /^X\(\/\/\)[^/].*/{ + s//\1/ + q + } + /^X\(\/\/\)$/{ + s//\1/ + q + } + /^X\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q'` + test -d "$as_dir" && break + done + test -z "$as_dirs" || eval "mkdir $as_dirs" + } || test -d "$as_dir" || as_fn_error $? "cannot create directory $as_dir" + + +} # as_fn_mkdir_p + +# as_fn_executable_p FILE +# ----------------------- +# Test if FILE is an executable regular file. +as_fn_executable_p () +{ + test -f "$1" && test -x "$1" +} # as_fn_executable_p +# as_fn_append VAR VALUE +# ---------------------- +# Append the text in VALUE to the end of the definition contained in VAR. Take +# advantage of any shell optimizations that allow amortized linear growth over +# repeated appends, instead of the typical quadratic growth present in naive +# implementations. +if (eval "as_var=1; as_var+=2; test x\$as_var = x12") 2>/dev/null; then : + eval 'as_fn_append () + { + eval $1+=\$2 + }' +else + as_fn_append () + { + eval $1=\$$1\$2 + } +fi # as_fn_append + +# as_fn_arith ARG... +# ------------------ +# Perform arithmetic evaluation on the ARGs, and store the result in the +# global $as_val. Take advantage of shells that can avoid forks. The arguments +# must be portable across $(()) and expr. +if (eval "test \$(( 1 + 1 )) = 2") 2>/dev/null; then : + eval 'as_fn_arith () + { + as_val=$(( $* )) + }' +else + as_fn_arith () + { + as_val=`expr "$@" || test $? -eq 1` + } +fi # as_fn_arith + + +# as_fn_error STATUS ERROR [LINENO LOG_FD] +# ---------------------------------------- +# Output "`basename $0`: error: ERROR" to stderr. If LINENO and LOG_FD are +# provided, also output the error to LOG_FD, referencing LINENO. Then exit the +# script with STATUS, using 1 if that was 0. +as_fn_error () +{ + as_status=$1; test $as_status -eq 0 && as_status=1 + if test "$4"; then + as_lineno=${as_lineno-"$3"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + $as_echo "$as_me:${as_lineno-$LINENO}: error: $2" >&$4 + fi + $as_echo "$as_me: error: $2" >&2 + as_fn_exit $as_status +} # as_fn_error + +if expr a : '\(a\)' >/dev/null 2>&1 && + test "X`expr 00001 : '.*\(...\)'`" = X001; then + as_expr=expr +else + as_expr=false +fi + +if (basename -- /) >/dev/null 2>&1 && test "X`basename -- / 2>&1`" = "X/"; then + as_basename=basename +else + as_basename=false +fi + +if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then + as_dirname=dirname +else + as_dirname=false +fi + +as_me=`$as_basename -- "$0" || +$as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \ + X"$0" : 'X\(//\)$' \| \ + X"$0" : 'X\(/\)' \| . 2>/dev/null || +$as_echo X/"$0" | + sed '/^.*\/\([^/][^/]*\)\/*$/{ + s//\1/ + q + } + /^X\/\(\/\/\)$/{ + s//\1/ + q + } + /^X\/\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q'` + +# Avoid depending upon Character Ranges. +as_cr_letters='abcdefghijklmnopqrstuvwxyz' +as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ' +as_cr_Letters=$as_cr_letters$as_cr_LETTERS +as_cr_digits='0123456789' +as_cr_alnum=$as_cr_Letters$as_cr_digits + + + as_lineno_1=$LINENO as_lineno_1a=$LINENO + as_lineno_2=$LINENO as_lineno_2a=$LINENO + eval 'test "x$as_lineno_1'$as_run'" != "x$as_lineno_2'$as_run'" && + test "x`expr $as_lineno_1'$as_run' + 1`" = "x$as_lineno_2'$as_run'"' || { + # Blame Lee E. McMahon (1931-1989) for sed's syntax. :-) + sed -n ' + p + /[$]LINENO/= + ' <$as_myself | + sed ' + s/[$]LINENO.*/&-/ + t lineno + b + :lineno + N + :loop + s/[$]LINENO\([^'$as_cr_alnum'_].*\n\)\(.*\)/\2\1\2/ + t loop + s/-\n.*// + ' >$as_me.lineno && + chmod +x "$as_me.lineno" || + { $as_echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2; as_fn_exit 1; } + + # If we had to re-execute with $CONFIG_SHELL, we're ensured to have + # already done that, so ensure we don't try to do so again and fall + # in an infinite loop. This has already happened in practice. + _as_can_reexec=no; export _as_can_reexec + # Don't try to exec as it changes $[0], causing all sort of problems + # (the dirname of $[0] is not the place where we might find the + # original and so on. Autoconf is especially sensitive to this). + . "./$as_me.lineno" + # Exit status is that of the last command. + exit +} + +ECHO_C= ECHO_N= ECHO_T= +case `echo -n x` in #((((( +-n*) + case `echo 'xy\c'` in + *c*) ECHO_T=' ';; # ECHO_T is single tab character. + xy) ECHO_C='\c';; + *) echo `echo ksh88 bug on AIX 6.1` > /dev/null + ECHO_T=' ';; + esac;; +*) + ECHO_N='-n';; +esac + +rm -f conf$$ conf$$.exe conf$$.file +if test -d conf$$.dir; then + rm -f conf$$.dir/conf$$.file +else + rm -f conf$$.dir + mkdir conf$$.dir 2>/dev/null +fi +if (echo >conf$$.file) 2>/dev/null; then + if ln -s conf$$.file conf$$ 2>/dev/null; then + as_ln_s='ln -s' + # ... but there are two gotchas: + # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail. + # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable. + # In both cases, we have to default to `cp -pR'. + ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe || + as_ln_s='cp -pR' + elif ln conf$$.file conf$$ 2>/dev/null; then + as_ln_s=ln + else + as_ln_s='cp -pR' + fi +else + as_ln_s='cp -pR' +fi +rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file +rmdir conf$$.dir 2>/dev/null + +if mkdir -p . 2>/dev/null; then + as_mkdir_p='mkdir -p "$as_dir"' +else + test -d ./-p && rmdir ./-p + as_mkdir_p=false +fi + +as_test_x='test -x' +as_executable_p=as_fn_executable_p + +# Sed expression to map a string onto a valid CPP name. +as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'" + +# Sed expression to map a string onto a valid variable name. +as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'" + +SHELL=${CONFIG_SHELL-/bin/sh} + + +test -n "$DJDIR" || exec 7<&0 </dev/null +exec 6>&1 + +# Name of the host. +# hostname on some systems (SVR3.2, old GNU/Linux) returns a bogus exit status, +# so uname gets run too. +ac_hostname=`(hostname || uname -n) 2>/dev/null | sed 1q` + +# +# Initializations. +# +ac_default_prefix=/usr/local +ac_clean_files= +ac_config_libobj_dir=. +LIBOBJS= +cross_compiling=no +subdirs= +MFLAGS= +MAKEFLAGS= + +# Identity of this package. +PACKAGE_NAME='R' +PACKAGE_TARNAME='R' +PACKAGE_VERSION='3.4.0' +PACKAGE_STRING='R 3.4.0' +PACKAGE_BUGREPORT='https://bugs.r-project.org' +PACKAGE_URL='https://www.r-project.org' + +ac_unique_file="src/include/Defn.h" +# Factoring default headers for most tests. +ac_includes_default="\ +#include <stdio.h> +#ifdef HAVE_SYS_TYPES_H +# include <sys/types.h> +#endif +#ifdef HAVE_SYS_STAT_H +# include <sys/stat.h> +#endif +#ifdef STDC_HEADERS +# include <stdlib.h> +# include <stddef.h> +#else +# ifdef HAVE_STDLIB_H +# include <stdlib.h> +# endif +#endif +#ifdef HAVE_STRING_H +# if !defined STDC_HEADERS && defined HAVE_MEMORY_H +# include <memory.h> +# endif +# include <string.h> +#endif +#ifdef HAVE_STRINGS_H +# include <strings.h> +#endif +#ifdef HAVE_INTTYPES_H +# include <inttypes.h> +#endif +#ifdef HAVE_STDINT_H +# include <stdint.h> +#endif +#ifdef HAVE_UNISTD_H +# include <unistd.h> +#endif" + +ac_header_list= +gt_needs= +ac_subst_vars='LTLIBOBJS +BUILD_LIBINTL_FALSE +BUILD_LIBINTL_TRUE +USE_NLS_FALSE +USE_NLS_TRUE +XTRA_INTL_CPPFLAGS +POSUB +LTLIBINTL +LIBINTL +INTLLIBS +INTL_LIBTOOL_SUFFIX_PREFIX +INTLOBJS +GENCAT +INSTOBJEXT +DATADIRNAME +CATOBJEXT +USE_INCLUDED_LIBINTL +BUILD_INCLUDED_LIBINTL +WOE32DLL +HAVE_WPRINTF +HAVE_SNPRINTF +HAVE_ASPRINTF +HAVE_POSIX_PRINTF +INTL_MACOSX_LIBS +GLIBC21 +INTLBISON +LTLIBMULTITHREAD +LIBMULTITHREAD +LTLIBTHREAD +LIBTHREAD +LIBPTH_PREFIX +LTLIBPTH +LIBPTH +PRI_MACROS_BROKEN +HAVE_VISIBILITY +CFLAG_VISIBILITY +GLIBC2 +mkdir_p +MKDIR_P +USE_NLS +USE_RECOMMENDED_PACKAGES_FALSE +USE_RECOMMENDED_PACKAGES_TRUE +R_LD_LIBRARY_PATH +SHLIB_OPENMP_FFLAGS +SHLIB_OPENMP_FCFLAGS +SHLIB_OPENMP_CXXFLAGS +SHLIB_OPENMP_CFLAGS +FCLIBS +OPENMP_FCFLAGS +FCFLAGS_f95 +FCFLAGS_f90 +ac_ct_FC +FCFLAGS +FC +R_JAVA_LD_LIBRARY_PATH +JAVA_CPPFLAGS0 +JAVA_LIBS0 +JAVA_LD_LIBRARY_PATH +JAR +JAVAH +JAVAC +JAVA +custom_JAVA_LD_LIBRARY_PATH +custom_JAVA_LIBS +custom_JAVA_CPPFLAGS +custom_JAVA_HOME +PAPERCONF +BUILD_TZONE_FALSE +BUILD_TZONE_TRUE +R_PROFILING +BITMAP_LIBS +BITMAP_CPPFLAGS +CURL_LIBS +CURL_CPPFLAGS +CURL_CONFIG +BUILD_TRE_FALSE +BUILD_TRE_TRUE +USE_MMAP_ZLIB_FALSE +USE_MMAP_ZLIB_TRUE +TIRPC_CPPFLAGS +BUILD_XDR_FALSE +BUILD_XDR_TRUE +use_tcltk +TK_CONFIG +TCL_CONFIG +BUILD_AQUA_FALSE +BUILD_AQUA_TRUE +BUILD_DEVCAIRO_FALSE +BUILD_DEVCAIRO_TRUE +CAIROX11_LIBS +CAIRO_LIBS +CAIROX11_CPPFLAGS +CAIRO_CPPFLAGS +BUILD_X11_FALSE +BUILD_X11_TRUE +X_EXTRA_LIBS +X_LIBS +X_PRE_LIBS +X_CFLAGS +USE_ICU_APPLE +USE_ICU +LTLIBICONV +LIBICONV +USE_EXTERNAL_LAPACK_FALSE +USE_EXTERNAL_LAPACK_TRUE +USE_EXTERNAL_BLAS_FALSE +USE_EXTERNAL_BLAS_TRUE +USE_VECLIB_G95FIX_FALSE +USE_VECLIB_G95FIX_TRUE +BLAS_LIBS0 +LIBR1 +LIBR0 +BLAS_SHLIB_FALSE +BLAS_SHLIB_TRUE +RMATH_HAVE_WORKING_LOG1P +LIBOBJS +RMATH_HAVE_LOG1P +RMATH_HAVE_HYPOT +RMATH_HAVE_EXPM1 +ALLOCA +R_OPENMP_FFLAGS +R_OPENMP_CFLAGS +SHLIB_CXX17LDFLAGS +SHLIB_CXX17LD +CXX17PICFLAGS +CXX17FLAGS +CXX17STD +CXX17 +HAVE_CXX17 +SHLIB_CXX14LDFLAGS +SHLIB_CXX14LD +CXX14PICFLAGS +CXX14FLAGS +CXX14STD +CXX14 +HAVE_CXX14 +SHLIB_CXX11LDFLAGS +SHLIB_CXX11LD +CXX11PICFLAGS +CXX11FLAGS +CXX11STD +CXX11 +HAVE_CXX11 +SHLIB_CXX98LDFLAGS +SHLIB_CXX98LD +CXX98PICFLAGS +CXX98FLAGS +CXX98STD +CXX98 +HAVE_CXX98 +R_DYLIB_EXT +STATICR2 +STATICR1 +FW_VERSION +LAPACK_LDFLAGS +RLAPACK_LDFLAGS +RBLAS_LDFLAGS +LIBR_LDFLAGS +DYLIB_EXT +USE_EXPORTFILES_FALSE +USE_EXPORTFILES_TRUE +SHLIB_EXT +SHLIB_LIBADD +DYLIB_UNDEFINED_ALLOWED_FALSE +DYLIB_UNDEFINED_ALLOWED_TRUE +INTERNET_LIBS +XMKMF +R_SYSTEM_ABI +OBJCXXFLAGS +OBJC_LIBS +R_XTRA_LIBS +R_XTRA_FFLAGS +R_XTRA_CXXFLAGS +R_XTRA_CPPFLAGS +R_XTRA_CFLAGS +SHLIB_CXXFLAGS +CXXSTD +FOUNDATION_LIBS +FOUNDATION_CPPFLAGS +OPENMP_CXXFLAGS +OPENMP_FFLAGS +COMPILE_FORTRAN_DOUBLE_COMPLEX_FALSE +COMPILE_FORTRAN_DOUBLE_COMPLEX_TRUE +HAVE_FORTRAN_DOUBLE_COMPLEX +FLIBS_IN_SO +FLIBS +OPENMP_CFLAGS +READLINE_LIBS +LIBM +stripstaticlib +striplib +Rshlibpath_var +shlibpath_var +CROSS_COMPILING_FALSE +CROSS_COMPILING_TRUE +BUILD_R +BUILD_CC +LIBTOOL_DEPS +LT_SYS_LIBRARY_PATH +OTOOL64 +OTOOL +LIPO +NMEDIT +DSYMUTIL +MANIFEST_TOOL +AWK +RANLIB +STRIP +ac_ct_AR +DLLTOOL +OBJDUMP +NM +ac_ct_DUMPBIN +DUMPBIN +LD +FGREP +LIBTOOL +R_DEFS +OBJCXX +ac_ct_OBJC +OBJCFLAGS +OBJC +F77_VISIBILITY +C_VISIBILITY +CXXCPP0 +CXXCPP +ac_ct_CXX +CXXFLAGS +CXX +ac_ct_F77 +FFLAGS +F77 +EGREP +GREP +CPP +OBJEXT +EXEEXT +ac_ct_CC +CPPFLAGS +LDFLAGS +CFLAGS +CC +PKG_CONFIG_LIBDIR +PKG_CONFIG_PATH +PKGCONF +REALPATH +NOTANGLE +R_BZIPCMD +R_GZIPCMD +R_ZIPCMD +R_UNZIPCMD +R_RD4PDF +KPSEWHICH +TEXI2DVICMD +TEXI2DVI +INSTALL_INFO +MAKEINFO +MAKEINDEX +PDFLATEX +PDFTEX +TEX +PAGER +WHICH +SED +INSTALL_DATA +INSTALL_SCRIPT +INSTALL_PROGRAM +ARFLAGS +AR +YFLAGS +YACC +LN_S +AUTOHEADER +AUTOMAKE +AUTOCONF +ACLOCAL +BUILDDIR_IS_SRCDIR +GETWD +R_XTRA_CPPFLAGS2 +R_ARCH +R_SHELL +JAVA_HOME +r_arch +SAFE_FFLAGS +LAPACK_LIBS +BLAS_LIBS +R_PDFVIEWER +R_BROWSER +TAR +MAKE +TCLTK_CPPFLAGS +TCLTK_LIBS +SHLIB_FCLDFLAGS +SHLIB_FCLD +SHLIB_CXXLDFLAGS +SHLIB_CXXLD +CXXPICFLAGS +DYLIB_LDFLAGS +DYLIB_LD +SHLIB_LDFLAGS +SHLIB_LD +FCPICFLAGS +FPICFLAGS +CPICFLAGS +MAIN_LDFLAGS +MAIN_LD +SHLIB_FFLAGS +MAIN_FFLAGS +SHLIB_CFLAGS +MAIN_CFLAGS +R_BATCHSAVE +R_PAPERSIZE +R_PRINTCMD +BYTE_COMPILE_PACKAGES_FALSE +BYTE_COMPILE_PACKAGES_TRUE +WANT_JAVA_FALSE +WANT_JAVA_TRUE +BUILD_LTO_FALSE +BUILD_LTO_TRUE +LTOALL +LTO +BUILD_HTML_FALSE +BUILD_HTML_TRUE +MAINTAINER_MODE_FALSE +MAINTAINER_MODE_TRUE +WANT_R_STATIC_FALSE +WANT_R_STATIC_TRUE +WANT_R_SHLIB_FALSE +WANT_R_SHLIB_TRUE +WANT_R_FRAMEWORK_FALSE +WANT_R_FRAMEWORK_TRUE +config_opts +rsharedir +rincludedir +rdocdir +LIBnn +R_CONFIG_ARGS +R_OSTYPE +R_OS +R_PLATFORM +host_os +host_vendor +host_cpu +host +build_os +build_vendor +build_cpu +build +MAJ_MIN_VERSION +VERSION +PACKAGE +target_alias +host_alias +build_alias +LIBS +ECHO_T +ECHO_N +ECHO_C +DEFS +mandir +localedir +libdir +psdir +pdfdir +dvidir +htmldir +infodir +docdir +oldincludedir +includedir +localstatedir +sharedstatedir +sysconfdir +datadir +datarootdir +libexecdir +sbindir +bindir +program_transform_name +prefix +exec_prefix +PACKAGE_URL +PACKAGE_BUGREPORT +PACKAGE_STRING +PACKAGE_VERSION +PACKAGE_TARNAME +PACKAGE_NAME +PATH_SEPARATOR +SHELL' +ac_subst_files='r_cc_rules_frag +r_cc_lo_rules_frag +r_cxx_rules_frag +r_objc_rules_frag' +ac_user_opts=' +enable_option_checking +enable_R_profiling +enable_memory_profiling +enable_R_framework +enable_R_shlib +enable_R_static_lib +enable_BLAS_shlib +enable_maintainer_mode +enable_strict_barrier +enable_prebuilt_html +enable_lto +enable_java +with_blas +with_lapack +with_readline +with_aqua +with_tcltk +with_tcl_config +with_tk_config +with_cairo +with_libpng +with_jpeglib +with_libtiff +with_system_tre +with_valgrind_instrumentation +with_system_valgrind_headers +with_internal_tzcode +with_recommended_packages +with_ICU +enable_byte_compiled_packages +enable_static +enable_shared +with_pic +enable_fast_install +with_aix_soname +with_gnu_ld +with_sysroot +enable_libtool_lock +enable_long_double +enable_openmp +with_x +enable_largefile +enable_nls +enable_threads +enable_rpath +with_libpth_prefix +with_included_gettext +with_libintl_prefix +' + ac_precious_vars='build_alias +host_alias +target_alias +R_PRINTCMD +R_PAPERSIZE +R_BATCHSAVE +MAIN_CFLAGS +SHLIB_CFLAGS +MAIN_FFLAGS +SHLIB_FFLAGS +MAIN_LD +MAIN_LDFLAGS +CPICFLAGS +FPICFLAGS +FCPICFLAGS +SHLIB_LD +SHLIB_LDFLAGS +DYLIB_LD +DYLIB_LDFLAGS +CXXPICFLAGS +SHLIB_CXXLD +SHLIB_CXXLDFLAGS +SHLIB_FCLD +SHLIB_FCLDFLAGS +TCLTK_LIBS +TCLTK_CPPFLAGS +MAKE +TAR +R_BROWSER +R_PDFVIEWER +BLAS_LIBS +LAPACK_LIBS +LIBnn +SAFE_FFLAGS +r_arch +DEFS +JAVA_HOME +R_SHELL +YACC +YFLAGS +PKGCONF +PKG_CONFIG_PATH +PKG_CONFIG_LIBDIR +CC +CFLAGS +LDFLAGS +LIBS +CPPFLAGS +CPP +F77 +FFLAGS +CXX +CXXFLAGS +CCC +CXXCPP +OBJC +OBJCFLAGS +LT_SYS_LIBRARY_PATH +CXX98 +CXX98STD +CXX98FLAGS +CXX98PICFLAGS +SHLIB_CXX98LD +SHLIB_CXX98LDFLAGS +CXX11 +CXX11STD +CXX11FLAGS +CXX11PICFLAGS +SHLIB_CXX11LD +SHLIB_CXX11LDFLAGS +CXX14 +CXX14STD +CXX14FLAGS +CXX14PICFLAGS +SHLIB_CXX14LD +SHLIB_CXX14LDFLAGS +CXX17 +CXX17STD +CXX17FLAGS +CXX17PICFLAGS +SHLIB_CXX17LD +SHLIB_CXX17LDFLAGS +XMKMF +FC +FCFLAGS' + + +# Initialize some variables set by options. +ac_init_help= +ac_init_version=false +ac_unrecognized_opts= +ac_unrecognized_sep= +# The variables have the same names as the options, with +# dashes changed to underlines. +cache_file=/dev/null +exec_prefix=NONE +no_create= +no_recursion= +prefix=NONE +program_prefix=NONE +program_suffix=NONE +program_transform_name=s,x,x, +silent= +site= +srcdir= +verbose= +x_includes=NONE +x_libraries=NONE + +# Installation directory options. +# These are left unexpanded so users can "make install exec_prefix=/foo" +# and all the variables that are supposed to be based on exec_prefix +# by default will actually change. +# Use braces instead of parens because sh, perl, etc. also accept them. +# (The list follows the same order as the GNU Coding Standards.) +bindir='${exec_prefix}/bin' +sbindir='${exec_prefix}/sbin' +libexecdir='${exec_prefix}/libexec' +datarootdir='${prefix}/share' +datadir='${datarootdir}' +sysconfdir='${prefix}/etc' +sharedstatedir='${prefix}/com' +localstatedir='${prefix}/var' +includedir='${prefix}/include' +oldincludedir='/usr/include' +docdir='${datarootdir}/doc/${PACKAGE_TARNAME}' +infodir='${datarootdir}/info' +htmldir='${docdir}' +dvidir='${docdir}' +pdfdir='${docdir}' +psdir='${docdir}' +libdir='${exec_prefix}/lib' +localedir='${datarootdir}/locale' +mandir='${datarootdir}/man' + +ac_prev= +ac_dashdash= +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=`expr "X$ac_option" : '[^=]*=\(.*\)'` ;; + *=) ac_optarg= ;; + *) ac_optarg=yes ;; + esac + + # Accept the important Cygnus configure options, so we can diagnose typos. + + case $ac_dashdash$ac_option in + --) + ac_dashdash=yes ;; + + -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_alias ;; + -build=* | --build=* | --buil=* | --bui=* | --bu=*) + build_alias=$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 ;; + + --config-cache | -C) + cache_file=config.cache ;; + + -datadir | --datadir | --datadi | --datad) + ac_prev=datadir ;; + -datadir=* | --datadir=* | --datadi=* | --datad=*) + datadir=$ac_optarg ;; + + -datarootdir | --datarootdir | --datarootdi | --datarootd | --dataroot \ + | --dataroo | --dataro | --datar) + ac_prev=datarootdir ;; + -datarootdir=* | --datarootdir=* | --datarootdi=* | --datarootd=* \ + | --dataroot=* | --dataroo=* | --dataro=* | --datar=*) + datarootdir=$ac_optarg ;; + + -disable-* | --disable-*) + ac_useropt=`expr "x$ac_option" : 'x-*disable-\(.*\)'` + # Reject names that are not valid shell variable names. + expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && + as_fn_error $? "invalid feature name: $ac_useropt" + ac_useropt_orig=$ac_useropt + ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'` + case $ac_user_opts in + *" +"enable_$ac_useropt" +"*) ;; + *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--disable-$ac_useropt_orig" + ac_unrecognized_sep=', ';; + esac + eval enable_$ac_useropt=no ;; + + -docdir | --docdir | --docdi | --doc | --do) + ac_prev=docdir ;; + -docdir=* | --docdir=* | --docdi=* | --doc=* | --do=*) + docdir=$ac_optarg ;; + + -dvidir | --dvidir | --dvidi | --dvid | --dvi | --dv) + ac_prev=dvidir ;; + -dvidir=* | --dvidir=* | --dvidi=* | --dvid=* | --dvi=* | --dv=*) + dvidir=$ac_optarg ;; + + -enable-* | --enable-*) + ac_useropt=`expr "x$ac_option" : 'x-*enable-\([^=]*\)'` + # Reject names that are not valid shell variable names. + expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && + as_fn_error $? "invalid feature name: $ac_useropt" + ac_useropt_orig=$ac_useropt + ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'` + case $ac_user_opts in + *" +"enable_$ac_useropt" +"*) ;; + *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--enable-$ac_useropt_orig" + ac_unrecognized_sep=', ';; + esac + eval enable_$ac_useropt=\$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 | -h) + ac_init_help=long ;; + -help=r* | --help=r* | --hel=r* | --he=r* | -hr*) + ac_init_help=recursive ;; + -help=s* | --help=s* | --hel=s* | --he=s* | -hs*) + ac_init_help=short ;; + + -host | --host | --hos | --ho) + ac_prev=host_alias ;; + -host=* | --host=* | --hos=* | --ho=*) + host_alias=$ac_optarg ;; + + -htmldir | --htmldir | --htmldi | --htmld | --html | --htm | --ht) + ac_prev=htmldir ;; + -htmldir=* | --htmldir=* | --htmldi=* | --htmld=* | --html=* | --htm=* \ + | --ht=*) + htmldir=$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 ;; + + -localedir | --localedir | --localedi | --localed | --locale) + ac_prev=localedir ;; + -localedir=* | --localedir=* | --localedi=* | --localed=* | --locale=*) + localedir=$ac_optarg ;; + + -localstatedir | --localstatedir | --localstatedi | --localstated \ + | --localstate | --localstat | --localsta | --localst | --locals) + ac_prev=localstatedir ;; + -localstatedir=* | --localstatedir=* | --localstatedi=* | --localstated=* \ + | --localstate=* | --localstat=* | --localsta=* | --localst=* | --locals=*) + 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 | -n) + 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 ;; + + -pdfdir | --pdfdir | --pdfdi | --pdfd | --pdf | --pd) + ac_prev=pdfdir ;; + -pdfdir=* | --pdfdir=* | --pdfdi=* | --pdfd=* | --pdf=* | --pd=*) + pdfdir=$ac_optarg ;; + + -psdir | --psdir | --psdi | --psd | --ps) + ac_prev=psdir ;; + -psdir=* | --psdir=* | --psdi=* | --psd=* | --ps=*) + psdir=$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_alias ;; + -target=* | --target=* | --targe=* | --targ=* | --tar=* | --ta=* | --t=*) + target_alias=$ac_optarg ;; + + -v | -verbose | --verbose | --verbos | --verbo | --verb) + verbose=yes ;; + + -version | --version | --versio | --versi | --vers | -V) + ac_init_version=: ;; + + -with-* | --with-*) + ac_useropt=`expr "x$ac_option" : 'x-*with-\([^=]*\)'` + # Reject names that are not valid shell variable names. + expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && + as_fn_error $? "invalid package name: $ac_useropt" + ac_useropt_orig=$ac_useropt + ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'` + case $ac_user_opts in + *" +"with_$ac_useropt" +"*) ;; + *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--with-$ac_useropt_orig" + ac_unrecognized_sep=', ';; + esac + eval with_$ac_useropt=\$ac_optarg ;; + + -without-* | --without-*) + ac_useropt=`expr "x$ac_option" : 'x-*without-\(.*\)'` + # Reject names that are not valid shell variable names. + expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && + as_fn_error $? "invalid package name: $ac_useropt" + ac_useropt_orig=$ac_useropt + ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'` + case $ac_user_opts in + *" +"with_$ac_useropt" +"*) ;; + *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--without-$ac_useropt_orig" + ac_unrecognized_sep=', ';; + esac + eval with_$ac_useropt=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 ;; + + -*) as_fn_error $? "unrecognized option: \`$ac_option' +Try \`$0 --help' for more information" + ;; + + *=*) + ac_envvar=`expr "x$ac_option" : 'x\([^=]*\)='` + # Reject names that are not valid shell variable names. + case $ac_envvar in #( + '' | [0-9]* | *[!_$as_cr_alnum]* ) + as_fn_error $? "invalid variable name: \`$ac_envvar'" ;; + esac + eval $ac_envvar=\$ac_optarg + export $ac_envvar ;; + + *) + # FIXME: should be removed in autoconf 3.0. + $as_echo "$as_me: WARNING: you should use --build, --host, --target" >&2 + expr "x$ac_option" : ".*[^-._$as_cr_alnum]" >/dev/null && + $as_echo "$as_me: WARNING: invalid host type: $ac_option" >&2 + : "${build_alias=$ac_option} ${host_alias=$ac_option} ${target_alias=$ac_option}" + ;; + + esac +done + +if test -n "$ac_prev"; then + ac_option=--`echo $ac_prev | sed 's/_/-/g'` + as_fn_error $? "missing argument to $ac_option" +fi + +if test -n "$ac_unrecognized_opts"; then + case $enable_option_checking in + no) ;; + fatal) as_fn_error $? "unrecognized options: $ac_unrecognized_opts" ;; + *) $as_echo "$as_me: WARNING: unrecognized options: $ac_unrecognized_opts" >&2 ;; + esac +fi + +# Check all directory arguments for consistency. +for ac_var in exec_prefix prefix bindir sbindir libexecdir datarootdir \ + datadir sysconfdir sharedstatedir localstatedir includedir \ + oldincludedir docdir infodir htmldir dvidir pdfdir psdir \ + libdir localedir mandir +do + eval ac_val=\$$ac_var + # Remove trailing slashes. + case $ac_val in + */ ) + ac_val=`expr "X$ac_val" : 'X\(.*[^/]\)' \| "X$ac_val" : 'X\(.*\)'` + eval $ac_var=\$ac_val;; + esac + # Be sure to have absolute directory names. + case $ac_val in + [\\/$]* | ?:[\\/]* ) continue;; + NONE | '' ) case $ac_var in *prefix ) continue;; esac;; + esac + as_fn_error $? "expected an absolute directory name for --$ac_var: $ac_val" +done + +# There might be people who depend on the old broken behavior: `$host' +# used to hold the argument of --host etc. +# FIXME: To remove some day. +build=$build_alias +host=$host_alias +target=$target_alias + +# FIXME: To remove some day. +if test "x$host_alias" != x; then + if test "x$build_alias" = x; then + cross_compiling=maybe + elif test "x$build_alias" != "x$host_alias"; then + cross_compiling=yes + fi +fi + +ac_tool_prefix= +test -n "$host_alias" && ac_tool_prefix=$host_alias- + +test "$silent" = yes && exec 6>/dev/null + + +ac_pwd=`pwd` && test -n "$ac_pwd" && +ac_ls_di=`ls -di .` && +ac_pwd_ls_di=`cd "$ac_pwd" && ls -di .` || + as_fn_error $? "working directory cannot be determined" +test "X$ac_ls_di" = "X$ac_pwd_ls_di" || + as_fn_error $? "pwd does not report name of working directory" + + +# 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 the parent directory. + ac_confdir=`$as_dirname -- "$as_myself" || +$as_expr X"$as_myself" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ + X"$as_myself" : 'X\(//\)[^/]' \| \ + X"$as_myself" : 'X\(//\)$' \| \ + X"$as_myself" : 'X\(/\)' \| . 2>/dev/null || +$as_echo X"$as_myself" | + sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ + s//\1/ + q + } + /^X\(\/\/\)[^/].*/{ + s//\1/ + q + } + /^X\(\/\/\)$/{ + s//\1/ + q + } + /^X\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q'` + 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 + test "$ac_srcdir_defaulted" = yes && srcdir="$ac_confdir or .." + as_fn_error $? "cannot find sources ($ac_unique_file) in $srcdir" +fi +ac_msg="sources are in $srcdir, but \`cd $srcdir' does not work" +ac_abs_confdir=`( + cd "$srcdir" && test -r "./$ac_unique_file" || as_fn_error $? "$ac_msg" + pwd)` +# When building in place, set srcdir=. +if test "$ac_abs_confdir" = "$ac_pwd"; then + srcdir=. +fi +# Remove unnecessary trailing slashes from srcdir. +# Double slashes in file names in object file debugging info +# mess up M-x gdb in Emacs. +case $srcdir in +*/) srcdir=`expr "X$srcdir" : 'X\(.*[^/]\)' \| "X$srcdir" : 'X\(.*\)'`;; +esac +for ac_var in $ac_precious_vars; do + eval ac_env_${ac_var}_set=\${${ac_var}+set} + eval ac_env_${ac_var}_value=\$${ac_var} + eval ac_cv_env_${ac_var}_set=\${${ac_var}+set} + eval ac_cv_env_${ac_var}_value=\$${ac_var} +done + +# +# Report the --help message. +# +if test "$ac_init_help" = "long"; then + # Omit some internal or obsolete options to make the list less imposing. + # This message is too long to be a string in the A/UX 3.1 sh. + cat <<_ACEOF +\`configure' configures R 3.4.0 to adapt to many kinds of systems. + +Usage: $0 [OPTION]... [VAR=VALUE]... + +To assign environment variables (e.g., CC, CFLAGS...), specify them as +VAR=VALUE. See below for descriptions of some of the useful variables. + +Defaults for the options are specified in brackets. + +Configuration: + -h, --help display this help and exit + --help=short display options specific to this package + --help=recursive display the short help of all the included packages + -V, --version display version information and exit + -q, --quiet, --silent do not print \`checking ...' messages + --cache-file=FILE cache test results in FILE [disabled] + -C, --config-cache alias for \`--cache-file=config.cache' + -n, --no-create do not create output files + --srcdir=DIR find the sources in DIR [configure dir or \`..'] + +Installation directories: + --prefix=PREFIX install architecture-independent files in PREFIX + [$ac_default_prefix] + --exec-prefix=EPREFIX install architecture-dependent files in EPREFIX + [PREFIX] + +By default, \`make install' will install all the files in +\`$ac_default_prefix/bin', \`$ac_default_prefix/lib' etc. You can specify +an installation prefix other than \`$ac_default_prefix' using \`--prefix', +for instance \`--prefix=\$HOME'. + +For better control, use the options below. + +Fine tuning of the installation directories: + --bindir=DIR user executables [EPREFIX/bin] + --sbindir=DIR system admin executables [EPREFIX/sbin] + --libexecdir=DIR program executables [EPREFIX/libexec] + --sysconfdir=DIR read-only single-machine data [PREFIX/etc] + --sharedstatedir=DIR modifiable architecture-independent data [PREFIX/com] + --localstatedir=DIR modifiable single-machine data [PREFIX/var] + --libdir=DIR object code libraries [EPREFIX/lib] + --includedir=DIR C header files [PREFIX/include] + --oldincludedir=DIR C header files for non-gcc [/usr/include] + --datarootdir=DIR read-only arch.-independent data root [PREFIX/share] + --datadir=DIR read-only architecture-independent data [DATAROOTDIR] + --infodir=DIR info documentation [DATAROOTDIR/info] + --localedir=DIR locale-dependent data [DATAROOTDIR/locale] + --mandir=DIR man documentation [DATAROOTDIR/man] + --docdir=DIR documentation root [DATAROOTDIR/doc/R] + --htmldir=DIR html documentation [DOCDIR] + --dvidir=DIR dvi documentation [DOCDIR] + --pdfdir=DIR pdf documentation [DOCDIR] + --psdir=DIR ps documentation [DOCDIR] +_ACEOF + + cat <<\_ACEOF + +R installation directories: + --libdir=DIR R files to R_HOME=DIR/R [EPREFIX/$LIBnn] + rdocdir=DIR R doc files to DIR [R_HOME/doc] + rincludedir=DIR R include files to DIR [R_HOME/include] + rsharedir=DIR R share files to DIR [R_HOME/share] + +X features: + --x-includes=DIR X include files are in DIR + --x-libraries=DIR X library files are in DIR + +System types: + --build=BUILD configure for building on BUILD [guessed] + --host=HOST cross-compile to build programs to run on HOST [BUILD] +_ACEOF +fi + +if test -n "$ac_init_help"; then + case $ac_init_help in + short | recursive ) echo "Configuration of R 3.4.0:";; + esac + cat <<\_ACEOF + +Optional Features: + --disable-option-checking ignore unrecognized --enable/--with options + --disable-FEATURE do not include FEATURE (same as --enable-FEATURE=no) + --enable-FEATURE[=ARG] include FEATURE [ARG=yes] + --enable-R-profiling attempt to compile support for Rprof() [yes] + --enable-memory-profiling + attempt to compile support for Rprofmem(), + tracemem() [no] + --enable-R-framework[=DIR] + macOS only: build R framework (if possible), and + specify its installation prefix [no, + /Library/Frameworks] + --enable-R-shlib build the shared/dynamic library 'libR' [no] + --enable-R-static-lib build the static library 'libR.a' [no] + --enable-BLAS-shlib build BLAS into a shared/dynamic library [perhaps] + --enable-maintainer-mode + enable make rules and dependencies not useful (and + maybe confusing) to the casual installer [no] + --enable-strict-barrier provoke compile error on write barrier violation + [no] + --enable-prebuilt-html build static HTML help pages [no] + --enable-lto enable link-time optimization [no] + --enable-java enable Java [yes] + --enable-byte-compiled-packages + byte-compile base and recommended packages [yes] + --enable-static[=PKGS] (libtool) build static libraries [default=no] + --enable-shared[=PKGS] (libtool) build shared libraries [default=yes] + --enable-fast-install[=PKGS] + (libtool) optimize for fast installation + [default=yes] + --disable-libtool-lock avoid locking (might break parallel builds) + --enable-long-double use long double type [yes] + --disable-openmp do not use OpenMP + --disable-largefile omit support for large files + --disable-nls do not use Native Language Support + + --disable-rpath do not hardcode runtime library paths + +Optional Packages: + --with-PACKAGE[=ARG] use PACKAGE [ARG=yes] + --without-PACKAGE do not use PACKAGE (same as --with-PACKAGE=no) + --with-blas use system BLAS library (if available), or specify + it [no] + --with-lapack use system LAPACK library (if available), or specify + it [no] + --with-readline use readline library [yes] + --with-aqua macOS only: use Aqua (if available) [yes] + --with-tcltk use Tcl/Tk (if available), or specify its library + dir [yes] + --with-tcl-config=TCL_CONFIG + specify location of tclConfig.sh [] + --with-tk-config=TK_CONFIG + specify location of tkConfig.sh [] + --with-cairo use cairo (and pango) if available [yes] + --with-libpng use libpng library (if available) [yes] + --with-jpeglib use jpeglib library (if available) [yes] + --with-libtiff use libtiff library (if available) [yes] + --with-system-tre use system tre library (if available) [no] + --with-valgrind-instrumentation + Level of additional instrumentation for Valgrind + (0/1/2) [0] + --with-system-valgrind-headers + use system valgrind headers (if available) [no] + --with-internal-tzcode use internal time-zone code [no] + --with-recommended-packages + use/install recommended R packages [yes] + --with-ICU use ICU library (if available) [yes] + --with-pic[=PKGS] (libtool) try to use only PIC/non-PIC objects + [default=use both] + --with-aix-soname=aix|svr4|both + (libtool) shared library versioning (aka "SONAME") + variant to provide on AIX, [default=aix]. + --with-gnu-ld assume the C compiler uses GNU ld [default=no] + --with-sysroot[=DIR] Search for dependent libraries within DIR (or the + compiler's sysroot if not specified). + --with-x use the X Window System + --with-gnu-ld assume the C compiler uses GNU ld [default=no] + --with-libpth-prefix[=DIR] search for libpth in DIR/include and DIR/lib + --without-libpth-prefix don't search for libpth in includedir and libdir + --with-included-gettext use the GNU gettext library included here [no] + --with-libintl-prefix[=DIR] search for libintl in DIR/include and DIR/lib + --without-libintl-prefix don't search for libintl in includedir and libdir + +Some influential environment variables: + R_PRINTCMD command used to spool PostScript files to the printer + R_PAPERSIZE paper size for the local (PostScript) printer + R_BATCHSAVE set default behavior of R when ending a session + MAIN_CFLAGS additional CFLAGS used when compiling the main binary + SHLIB_CFLAGS + additional CFLAGS used when building shared objects + MAIN_FFLAGS additional FFLAGS used when compiling the main binary + SHLIB_FFLAGS + additional FFLAGS used when building shared objects + MAIN_LD command used to link the main binary + MAIN_LDFLAGS + flags which are necessary for loading a main program which will + load shared objects (DLLs) at runtime + CPICFLAGS special flags for compiling C code to be turned into a shared + object. + FPICFLAGS special flags for compiling Fortran code to be turned into a + shared object. + FCPICFLAGS special flags for compiling Fortran 95 code to be turned into a + shared object. + SHLIB_LD command for linking shared objects which contain object files + from a C or Fortran compiler only + SHLIB_LDFLAGS + special flags used by SHLIB_LD + DYLIB_LD command for linking dynamic libraries which contain object files + from a C or Fortran compiler only + DYLIB_LDFLAGS + special flags used for make a dynamic library + CXXPICFLAGS special flags for compiling C++ code to be turned into a shared + object + SHLIB_CXXLD command for linking shared objects which contain object files + from the C++ compiler + SHLIB_CXXLDFLAGS + special flags used by SHLIB_CXXLD + SHLIB_FCLD command for linking shared objects which contain object files + from the Fortran 95 compiler + SHLIB_FCLDFLAGS + special flags used by SHLIB_FCLD + TCLTK_LIBS flags needed for linking against the Tcl and Tk libraries + TCLTK_CPPFLAGS + flags needed for finding the tcl.h and tk.h headers + MAKE make command + TAR tar command + R_BROWSER default browser + R_PDFVIEWER default PDF viewer + BLAS_LIBS flags needed for linking against external BLAS libraries + LAPACK_LIBS flags needed for linking against external LAPACK libraries + LIBnn 'lib' or 'lib64' for dynamic libraries + SAFE_FFLAGS Safe Fortran 77 compiler flags for e.g. dlamc.f + r_arch Use architecture-dependent subdirs with this name + DEFS C defines for use when compiling R + JAVA_HOME Path to the root of the Java environment + R_SHELL shell to be used for shell scripts, including 'R' + YACC The `Yet Another Compiler Compiler' implementation to use. + Defaults to the first program found out of: `bison -y', `byacc', + `yacc'. + YFLAGS The list of arguments that will be passed by default to $YACC. + This script will default YFLAGS to the empty string to avoid a + default value of `-d' given by some make applications. + PKGCONF path to pkg-config utility + PKG_CONFIG_PATH + directories to add to pkg-config's search path + PKG_CONFIG_LIBDIR + path overriding pkg-config's default search path + CC C compiler command + CFLAGS C compiler flags + LDFLAGS linker flags, e.g. -L<lib dir> if you have libraries in a + nonstandard directory <lib dir> + LIBS libraries to pass to the linker, e.g. -l<library> + CPPFLAGS (Objective) C/C++ preprocessor flags, e.g. -I<include dir> if + you have headers in a nonstandard directory <include dir> + CPP C preprocessor + F77 Fortran 77 compiler command + FFLAGS Fortran 77 compiler flags + CXX C++ compiler command + CXXFLAGS C++ compiler flags + CXXCPP C++ preprocessor + OBJC Objective C compiler command + OBJCFLAGS Objective C compiler flags + LT_SYS_LIBRARY_PATH + User-defined run-time library search path. + CXX98 C++98 compiler command + CXX98STD special flag for compiling and for linking C++98 code, e.g. + -std=c++98 + CXX98FLAGS C++98 compiler flags + CXX98PICFLAGS + special flags for compiling C++98 code to be turned into a + shared object + SHLIB_CXX98LD + command for linking shared objects which contain object files + from the C++98 compiler + SHLIB_CXX98LDFLAGS + special flags used by SHLIB_CXX98LD + CXX11 C++11 compiler command + CXX11STD special flag for compiling and for linking C++11 code, e.g. + -std=c++11 + CXX11FLAGS C++11 compiler flags + CXX11PICFLAGS + special flags for compiling C++11 code to be turned into a + shared object + SHLIB_CXX11LD + command for linking shared objects which contain object files + from the C++11 compiler + SHLIB_CXX11LDFLAGS + special flags used by SHLIB_CXX11LD + CXX14 C++14 compiler command + CXX14STD special flag for compiling and for linking C++14 code, e.g. + -std=c++14 + CXX14FLAGS C++14 compiler flags + CXX14PICFLAGS + special flags for compiling C++14 code to be turned into a + shared object + SHLIB_CXX14LD + command for linking shared objects which contain object files + from the C++14 compiler + SHLIB_CXX14LDFLAGS + special flags used by SHLIB_CXX14LD + CXX17 C++17 compiler command + CXX17STD special flag for compiling and for linking C++17 code, e.g. + -std=c++17 + CXX17FLAGS C++17 compiler flags + CXX17PICFLAGS + special flags for compiling C++17 code to be turned into a + shared object + SHLIB_CXX17LD + command for linking shared objects which contain object files + from the C++17 compiler + SHLIB_CXX17LDFLAGS + special flags used by SHLIB_CXX17LD + XMKMF Path to xmkmf, Makefile generator for X Window System + FC Fortran compiler command + FCFLAGS Fortran compiler flags + +Use these variables to override the choices made by `configure' or to help +it to find libraries and programs with nonstandard names/locations. + +Report bugs to <https://bugs.r-project.org>. +R home page: <https://www.r-project.org>. +_ACEOF +ac_status=$? +fi + +if test "$ac_init_help" = "recursive"; then + # If there are subdirs, report their specific --help. + for ac_dir in : $ac_subdirs_all; do test "x$ac_dir" = x: && continue + test -d "$ac_dir" || + { cd "$srcdir" && ac_pwd=`pwd` && srcdir=. && test -d "$ac_dir"; } || + continue + ac_builddir=. + +case "$ac_dir" in +.) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;; +*) + ac_dir_suffix=/`$as_echo "$ac_dir" | sed 's|^\.[\\/]||'` + # A ".." for each directory in $ac_dir_suffix. + ac_top_builddir_sub=`$as_echo "$ac_dir_suffix" | sed 's|/[^\\/]*|/..|g;s|/||'` + case $ac_top_builddir_sub in + "") ac_top_builddir_sub=. ac_top_build_prefix= ;; + *) ac_top_build_prefix=$ac_top_builddir_sub/ ;; + esac ;; +esac +ac_abs_top_builddir=$ac_pwd +ac_abs_builddir=$ac_pwd$ac_dir_suffix +# for backward compatibility: +ac_top_builddir=$ac_top_build_prefix + +case $srcdir in + .) # We are building in place. + ac_srcdir=. + ac_top_srcdir=$ac_top_builddir_sub + ac_abs_top_srcdir=$ac_pwd ;; + [\\/]* | ?:[\\/]* ) # Absolute name. + ac_srcdir=$srcdir$ac_dir_suffix; + ac_top_srcdir=$srcdir + ac_abs_top_srcdir=$srcdir ;; + *) # Relative name. + ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix + ac_top_srcdir=$ac_top_build_prefix$srcdir + ac_abs_top_srcdir=$ac_pwd/$srcdir ;; +esac +ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix + + cd "$ac_dir" || { ac_status=$?; continue; } + # Check for guested configure. + if test -f "$ac_srcdir/configure.gnu"; then + echo && + $SHELL "$ac_srcdir/configure.gnu" --help=recursive + elif test -f "$ac_srcdir/configure"; then + echo && + $SHELL "$ac_srcdir/configure" --help=recursive + else + $as_echo "$as_me: WARNING: no configuration information is in $ac_dir" >&2 + fi || ac_status=$? + cd "$ac_pwd" || { ac_status=$?; break; } + done +fi + +test -n "$ac_init_help" && exit $ac_status +if $ac_init_version; then + cat <<\_ACEOF +R configure 3.4.0 +generated by GNU Autoconf 2.69 + +Copyright (C) 2012 Free Software Foundation, Inc. +This configure script is free software; the Free Software Foundation +gives unlimited permission to copy, distribute and modify it. +_ACEOF + exit +fi + +## ------------------------ ## +## Autoconf initialization. ## +## ------------------------ ## + +# ac_fn_c_try_compile LINENO +# -------------------------- +# Try to compile conftest.$ac_ext, and return whether this succeeded. +ac_fn_c_try_compile () +{ + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + rm -f conftest.$ac_objext + if { { ac_try="$ac_compile" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_compile") 2>conftest.err + ac_status=$? + if test -s conftest.err; then + grep -v '^ *+' conftest.err >conftest.er1 + cat conftest.er1 >&5 + mv -f conftest.er1 conftest.err + fi + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } && { + test -z "$ac_c_werror_flag" || + test ! -s conftest.err + } && test -s conftest.$ac_objext; then : + ac_retval=0 +else + $as_echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + ac_retval=1 +fi + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno + as_fn_set_status $ac_retval + +} # ac_fn_c_try_compile + +# ac_fn_c_try_cpp LINENO +# ---------------------- +# Try to preprocess conftest.$ac_ext, and return whether this succeeded. +ac_fn_c_try_cpp () +{ + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + if { { ac_try="$ac_cpp conftest.$ac_ext" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_cpp conftest.$ac_ext") 2>conftest.err + ac_status=$? + if test -s conftest.err; then + grep -v '^ *+' conftest.err >conftest.er1 + cat conftest.er1 >&5 + mv -f conftest.er1 conftest.err + fi + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } > conftest.i && { + test -z "$ac_c_preproc_warn_flag$ac_c_werror_flag" || + test ! -s conftest.err + }; then : + ac_retval=0 +else + $as_echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + ac_retval=1 +fi + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno + as_fn_set_status $ac_retval + +} # ac_fn_c_try_cpp + +# ac_fn_c_check_header_mongrel LINENO HEADER VAR INCLUDES +# ------------------------------------------------------- +# Tests whether HEADER exists, giving a warning if it cannot be compiled using +# the include files in INCLUDES and setting the cache variable VAR +# accordingly. +ac_fn_c_check_header_mongrel () +{ + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + if eval \${$3+:} false; then : + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5 +$as_echo_n "checking for $2... " >&6; } +if eval \${$3+:} false; then : + $as_echo_n "(cached) " >&6 +fi +eval ac_res=\$$3 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } +else + # Is the header compilable? +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking $2 usability" >&5 +$as_echo_n "checking $2 usability... " >&6; } +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +$4 +#include <$2> +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_header_compiler=yes +else + ac_header_compiler=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_header_compiler" >&5 +$as_echo "$ac_header_compiler" >&6; } + +# Is the header present? +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking $2 presence" >&5 +$as_echo_n "checking $2 presence... " >&6; } +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <$2> +_ACEOF +if ac_fn_c_try_cpp "$LINENO"; then : + ac_header_preproc=yes +else + ac_header_preproc=no +fi +rm -f conftest.err conftest.i conftest.$ac_ext +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_header_preproc" >&5 +$as_echo "$ac_header_preproc" >&6; } + +# So? What about this header? +case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in #(( + yes:no: ) + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: accepted by the compiler, rejected by the preprocessor!" >&5 +$as_echo "$as_me: WARNING: $2: accepted by the compiler, rejected by the preprocessor!" >&2;} + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: proceeding with the compiler's result" >&5 +$as_echo "$as_me: WARNING: $2: proceeding with the compiler's result" >&2;} + ;; + no:yes:* ) + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: present but cannot be compiled" >&5 +$as_echo "$as_me: WARNING: $2: present but cannot be compiled" >&2;} + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: check for missing prerequisite headers?" >&5 +$as_echo "$as_me: WARNING: $2: check for missing prerequisite headers?" >&2;} + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: see the Autoconf documentation" >&5 +$as_echo "$as_me: WARNING: $2: see the Autoconf documentation" >&2;} + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: section \"Present But Cannot Be Compiled\"" >&5 +$as_echo "$as_me: WARNING: $2: section \"Present But Cannot Be Compiled\"" >&2;} + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: proceeding with the compiler's result" >&5 +$as_echo "$as_me: WARNING: $2: proceeding with the compiler's result" >&2;} +( $as_echo "## ----------------------------------------- ## +## Report this to https://bugs.r-project.org ## +## ----------------------------------------- ##" + ) | sed "s/^/$as_me: WARNING: /" >&2 + ;; +esac + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5 +$as_echo_n "checking for $2... " >&6; } +if eval \${$3+:} false; then : + $as_echo_n "(cached) " >&6 +else + eval "$3=\$ac_header_compiler" +fi +eval ac_res=\$$3 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } +fi + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno + +} # ac_fn_c_check_header_mongrel + +# ac_fn_c_try_run LINENO +# ---------------------- +# Try to link conftest.$ac_ext, and return whether this succeeded. Assumes +# that executables *can* be run. +ac_fn_c_try_run () +{ + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + if { { ac_try="$ac_link" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_link") 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } && { ac_try='./conftest$ac_exeext' + { { case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_try") 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; }; }; then : + ac_retval=0 +else + $as_echo "$as_me: program exited with status $ac_status" >&5 + $as_echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + ac_retval=$ac_status +fi + rm -rf conftest.dSYM conftest_ipa8_conftest.oo + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno + as_fn_set_status $ac_retval + +} # ac_fn_c_try_run + +# ac_fn_c_check_header_compile LINENO HEADER VAR INCLUDES +# ------------------------------------------------------- +# Tests whether HEADER exists and can be compiled using the include files in +# INCLUDES, setting the cache variable VAR accordingly. +ac_fn_c_check_header_compile () +{ + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5 +$as_echo_n "checking for $2... " >&6; } +if eval \${$3+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +$4 +#include <$2> +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + eval "$3=yes" +else + eval "$3=no" +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi +eval ac_res=\$$3 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno + +} # ac_fn_c_check_header_compile + +# ac_fn_f77_try_compile LINENO +# ---------------------------- +# Try to compile conftest.$ac_ext, and return whether this succeeded. +ac_fn_f77_try_compile () +{ + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + rm -f conftest.$ac_objext + if { { ac_try="$ac_compile" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_compile") 2>conftest.err + ac_status=$? + if test -s conftest.err; then + grep -v '^ *+' conftest.err >conftest.er1 + cat conftest.er1 >&5 + mv -f conftest.er1 conftest.err + fi + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } && { + test -z "$ac_f77_werror_flag" || + test ! -s conftest.err + } && test -s conftest.$ac_objext; then : + ac_retval=0 +else + $as_echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + ac_retval=1 +fi + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno + as_fn_set_status $ac_retval + +} # ac_fn_f77_try_compile + +# ac_fn_cxx_try_compile LINENO +# ---------------------------- +# Try to compile conftest.$ac_ext, and return whether this succeeded. +ac_fn_cxx_try_compile () +{ + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + rm -f conftest.$ac_objext + if { { ac_try="$ac_compile" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_compile") 2>conftest.err + ac_status=$? + if test -s conftest.err; then + grep -v '^ *+' conftest.err >conftest.er1 + cat conftest.er1 >&5 + mv -f conftest.er1 conftest.err + fi + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } && { + test -z "$ac_cxx_werror_flag" || + test ! -s conftest.err + } && test -s conftest.$ac_objext; then : + ac_retval=0 +else + $as_echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + ac_retval=1 +fi + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno + as_fn_set_status $ac_retval + +} # ac_fn_cxx_try_compile + +# ac_fn_cxx_try_cpp LINENO +# ------------------------ +# Try to preprocess conftest.$ac_ext, and return whether this succeeded. +ac_fn_cxx_try_cpp () +{ + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + if { { ac_try="$ac_cpp conftest.$ac_ext" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_cpp conftest.$ac_ext") 2>conftest.err + ac_status=$? + if test -s conftest.err; then + grep -v '^ *+' conftest.err >conftest.er1 + cat conftest.er1 >&5 + mv -f conftest.er1 conftest.err + fi + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } > conftest.i && { + test -z "$ac_cxx_preproc_warn_flag$ac_cxx_werror_flag" || + test ! -s conftest.err + }; then : + ac_retval=0 +else + $as_echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + ac_retval=1 +fi + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno + as_fn_set_status $ac_retval + +} # ac_fn_cxx_try_cpp + +# ac_fn_objc_try_compile LINENO +# ----------------------------- +# Try to compile conftest.$ac_ext, and return whether this succeeded. +ac_fn_objc_try_compile () +{ + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + rm -f conftest.$ac_objext + if { { ac_try="$ac_compile" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_compile") 2>conftest.err + ac_status=$? + if test -s conftest.err; then + grep -v '^ *+' conftest.err >conftest.er1 + cat conftest.er1 >&5 + mv -f conftest.er1 conftest.err + fi + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } && { + test -z "$ac_objc_werror_flag" || + test ! -s conftest.err + } && test -s conftest.$ac_objext; then : + ac_retval=0 +else + $as_echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + ac_retval=1 +fi + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno + as_fn_set_status $ac_retval + +} # ac_fn_objc_try_compile + +# ac_fn_c_try_link LINENO +# ----------------------- +# Try to link conftest.$ac_ext, and return whether this succeeded. +ac_fn_c_try_link () +{ + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + rm -f conftest.$ac_objext conftest$ac_exeext + if { { ac_try="$ac_link" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_link") 2>conftest.err + ac_status=$? + if test -s conftest.err; then + grep -v '^ *+' conftest.err >conftest.er1 + cat conftest.er1 >&5 + mv -f conftest.er1 conftest.err + fi + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } && { + test -z "$ac_c_werror_flag" || + test ! -s conftest.err + } && test -s conftest$ac_exeext && { + test "$cross_compiling" = yes || + test -x conftest$ac_exeext + }; then : + ac_retval=0 +else + $as_echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + ac_retval=1 +fi + # Delete the IPA/IPO (Inter Procedural Analysis/Optimization) information + # created by the PGI compiler (conftest_ipa8_conftest.oo), as it would + # interfere with the next link command; also delete a directory that is + # left behind by Apple's compiler. We do this before executing the actions. + rm -rf conftest.dSYM conftest_ipa8_conftest.oo + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno + as_fn_set_status $ac_retval + +} # ac_fn_c_try_link + +# ac_fn_c_check_func LINENO FUNC VAR +# ---------------------------------- +# Tests whether FUNC exists, setting the cache variable VAR accordingly +ac_fn_c_check_func () +{ + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5 +$as_echo_n "checking for $2... " >&6; } +if eval \${$3+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +/* Define $2 to an innocuous variant, in case <limits.h> declares $2. + For example, HP-UX 11i <limits.h> declares gettimeofday. */ +#define $2 innocuous_$2 + +/* System header to define __stub macros and hopefully few prototypes, + which can conflict with char $2 (); below. + Prefer <limits.h> to <assert.h> if __STDC__ is defined, since + <limits.h> exists even on freestanding compilers. */ + +#ifdef __STDC__ +# include <limits.h> +#else +# include <assert.h> +#endif + +#undef $2 + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char $2 (); +/* 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_$2 || defined __stub___$2 +choke me +#endif + +int +main () +{ +return $2 (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + eval "$3=yes" +else + eval "$3=no" +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +fi +eval ac_res=\$$3 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno + +} # ac_fn_c_check_func + +# ac_fn_cxx_try_link LINENO +# ------------------------- +# Try to link conftest.$ac_ext, and return whether this succeeded. +ac_fn_cxx_try_link () +{ + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + rm -f conftest.$ac_objext conftest$ac_exeext + if { { ac_try="$ac_link" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_link") 2>conftest.err + ac_status=$? + if test -s conftest.err; then + grep -v '^ *+' conftest.err >conftest.er1 + cat conftest.er1 >&5 + mv -f conftest.er1 conftest.err + fi + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } && { + test -z "$ac_cxx_werror_flag" || + test ! -s conftest.err + } && test -s conftest$ac_exeext && { + test "$cross_compiling" = yes || + test -x conftest$ac_exeext + }; then : + ac_retval=0 +else + $as_echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + ac_retval=1 +fi + # Delete the IPA/IPO (Inter Procedural Analysis/Optimization) information + # created by the PGI compiler (conftest_ipa8_conftest.oo), as it would + # interfere with the next link command; also delete a directory that is + # left behind by Apple's compiler. We do this before executing the actions. + rm -rf conftest.dSYM conftest_ipa8_conftest.oo + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno + as_fn_set_status $ac_retval + +} # ac_fn_cxx_try_link + +# ac_fn_f77_try_link LINENO +# ------------------------- +# Try to link conftest.$ac_ext, and return whether this succeeded. +ac_fn_f77_try_link () +{ + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + rm -f conftest.$ac_objext conftest$ac_exeext + if { { ac_try="$ac_link" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_link") 2>conftest.err + ac_status=$? + if test -s conftest.err; then + grep -v '^ *+' conftest.err >conftest.er1 + cat conftest.er1 >&5 + mv -f conftest.er1 conftest.err + fi + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } && { + test -z "$ac_f77_werror_flag" || + test ! -s conftest.err + } && test -s conftest$ac_exeext && { + test "$cross_compiling" = yes || + test -x conftest$ac_exeext + }; then : + ac_retval=0 +else + $as_echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + ac_retval=1 +fi + # Delete the IPA/IPO (Inter Procedural Analysis/Optimization) information + # created by the PGI compiler (conftest_ipa8_conftest.oo), as it would + # interfere with the next link command; also delete a directory that is + # left behind by Apple's compiler. We do this before executing the actions. + rm -rf conftest.dSYM conftest_ipa8_conftest.oo + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno + as_fn_set_status $ac_retval + +} # ac_fn_f77_try_link + +# ac_fn_c_check_decl LINENO SYMBOL VAR INCLUDES +# --------------------------------------------- +# Tests whether SYMBOL is declared in INCLUDES, setting cache variable VAR +# accordingly. +ac_fn_c_check_decl () +{ + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + as_decl_name=`echo $2|sed 's/ *(.*//'` + as_decl_use=`echo $2|sed -e 's/(/((/' -e 's/)/) 0&/' -e 's/,/) 0& (/g'` + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $as_decl_name is declared" >&5 +$as_echo_n "checking whether $as_decl_name is declared... " >&6; } +if eval \${$3+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +$4 +int +main () +{ +#ifndef $as_decl_name +#ifdef __cplusplus + (void) $as_decl_use; +#else + (void) $as_decl_name; +#endif +#endif + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + eval "$3=yes" +else + eval "$3=no" +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi +eval ac_res=\$$3 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno + +} # ac_fn_c_check_decl + +# ac_fn_c_find_uintX_t LINENO BITS VAR +# ------------------------------------ +# Finds an unsigned integer type with width BITS, setting cache variable VAR +# accordingly. +ac_fn_c_find_uintX_t () +{ + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for uint$2_t" >&5 +$as_echo_n "checking for uint$2_t... " >&6; } +if eval \${$3+:} false; then : + $as_echo_n "(cached) " >&6 +else + eval "$3=no" + # Order is important - never check a type that is potentially smaller + # than half of the expected target width. + for ac_type in uint$2_t 'unsigned int' 'unsigned long int' \ + 'unsigned long long int' 'unsigned short int' 'unsigned char'; do + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +$ac_includes_default +int +main () +{ +static int test_array [1 - 2 * !((($ac_type) -1 >> ($2 / 2 - 1)) >> ($2 / 2 - 1) == 3)]; +test_array [0] = 0; +return test_array [0]; + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + case $ac_type in #( + uint$2_t) : + eval "$3=yes" ;; #( + *) : + eval "$3=\$ac_type" ;; +esac +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + if eval test \"x\$"$3"\" = x"no"; then : + +else + break +fi + done +fi +eval ac_res=\$$3 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno + +} # ac_fn_c_find_uintX_t + +# ac_fn_c_check_type LINENO TYPE VAR INCLUDES +# ------------------------------------------- +# Tests whether TYPE exists after having included INCLUDES, setting cache +# variable VAR accordingly. +ac_fn_c_check_type () +{ + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5 +$as_echo_n "checking for $2... " >&6; } +if eval \${$3+:} false; then : + $as_echo_n "(cached) " >&6 +else + eval "$3=no" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +$4 +int +main () +{ +if (sizeof ($2)) + return 0; + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +$4 +int +main () +{ +if (sizeof (($2))) + return 0; + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + +else + eval "$3=yes" +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi +eval ac_res=\$$3 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno + +} # ac_fn_c_check_type + +# ac_fn_c_compute_int LINENO EXPR VAR INCLUDES +# -------------------------------------------- +# Tries to find the compile-time value of EXPR in a program that includes +# INCLUDES, setting VAR accordingly. Returns whether the value could be +# computed +ac_fn_c_compute_int () +{ + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + if test "$cross_compiling" = yes; then + # Depending upon the size, compute the lo and hi bounds. +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +$4 +int +main () +{ +static int test_array [1 - 2 * !(($2) >= 0)]; +test_array [0] = 0; +return test_array [0]; + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_lo=0 ac_mid=0 + while :; do + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +$4 +int +main () +{ +static int test_array [1 - 2 * !(($2) <= $ac_mid)]; +test_array [0] = 0; +return test_array [0]; + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_hi=$ac_mid; break +else + as_fn_arith $ac_mid + 1 && ac_lo=$as_val + if test $ac_lo -le $ac_mid; then + ac_lo= ac_hi= + break + fi + as_fn_arith 2 '*' $ac_mid + 1 && ac_mid=$as_val +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + done +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +$4 +int +main () +{ +static int test_array [1 - 2 * !(($2) < 0)]; +test_array [0] = 0; +return test_array [0]; + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_hi=-1 ac_mid=-1 + while :; do + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +$4 +int +main () +{ +static int test_array [1 - 2 * !(($2) >= $ac_mid)]; +test_array [0] = 0; +return test_array [0]; + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_lo=$ac_mid; break +else + as_fn_arith '(' $ac_mid ')' - 1 && ac_hi=$as_val + if test $ac_mid -le $ac_hi; then + ac_lo= ac_hi= + break + fi + as_fn_arith 2 '*' $ac_mid && ac_mid=$as_val +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + done +else + ac_lo= ac_hi= +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +# Binary search between lo and hi bounds. +while test "x$ac_lo" != "x$ac_hi"; do + as_fn_arith '(' $ac_hi - $ac_lo ')' / 2 + $ac_lo && ac_mid=$as_val + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +$4 +int +main () +{ +static int test_array [1 - 2 * !(($2) <= $ac_mid)]; +test_array [0] = 0; +return test_array [0]; + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_hi=$ac_mid +else + as_fn_arith '(' $ac_mid ')' + 1 && ac_lo=$as_val +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +done +case $ac_lo in #(( +?*) eval "$3=\$ac_lo"; ac_retval=0 ;; +'') ac_retval=1 ;; +esac + else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +$4 +static long int longval () { return $2; } +static unsigned long int ulongval () { return $2; } +#include <stdio.h> +#include <stdlib.h> +int +main () +{ + + FILE *f = fopen ("conftest.val", "w"); + if (! f) + return 1; + if (($2) < 0) + { + long int i = longval (); + if (i != ($2)) + return 1; + fprintf (f, "%ld", i); + } + else + { + unsigned long int i = ulongval (); + if (i != ($2)) + return 1; + fprintf (f, "%lu", i); + } + /* Do not output a trailing newline, as this causes \r\n confusion + on some platforms. */ + return ferror (f) || fclose (f) != 0; + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_run "$LINENO"; then : + echo >>conftest.val; read $3 <conftest.val; ac_retval=0 +else + ac_retval=1 +fi +rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ + conftest.$ac_objext conftest.beam conftest.$ac_ext +rm -f conftest.val + + fi + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno + as_fn_set_status $ac_retval + +} # ac_fn_c_compute_int + +# ac_fn_objc_try_link LINENO +# -------------------------- +# Try to link conftest.$ac_ext, and return whether this succeeded. +ac_fn_objc_try_link () +{ + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + rm -f conftest.$ac_objext conftest$ac_exeext + if { { ac_try="$ac_link" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_link") 2>conftest.err + ac_status=$? + if test -s conftest.err; then + grep -v '^ *+' conftest.err >conftest.er1 + cat conftest.er1 >&5 + mv -f conftest.er1 conftest.err + fi + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } && { + test -z "$ac_objc_werror_flag" || + test ! -s conftest.err + } && test -s conftest$ac_exeext && { + test "$cross_compiling" = yes || + test -x conftest$ac_exeext + }; then : + ac_retval=0 +else + $as_echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + ac_retval=1 +fi + # Delete the IPA/IPO (Inter Procedural Analysis/Optimization) information + # created by the PGI compiler (conftest_ipa8_conftest.oo), as it would + # interfere with the next link command; also delete a directory that is + # left behind by Apple's compiler. We do this before executing the actions. + rm -rf conftest.dSYM conftest_ipa8_conftest.oo + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno + as_fn_set_status $ac_retval + +} # ac_fn_objc_try_link + +# ac_fn_c_check_member LINENO AGGR MEMBER VAR INCLUDES +# ---------------------------------------------------- +# Tries to find if the field MEMBER exists in type AGGR, after including +# INCLUDES, setting cache variable VAR accordingly. +ac_fn_c_check_member () +{ + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2.$3" >&5 +$as_echo_n "checking for $2.$3... " >&6; } +if eval \${$4+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +$5 +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +static $2 ac_aggr; +if (ac_aggr.$3) +return 0; + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + eval "$4=yes" +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +$5 +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +static $2 ac_aggr; +if (sizeof ac_aggr.$3) +return 0; + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + eval "$4=yes" +else + eval "$4=no" +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi +eval ac_res=\$$4 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno + +} # ac_fn_c_check_member + +# ac_fn_fc_try_compile LINENO +# --------------------------- +# Try to compile conftest.$ac_ext, and return whether this succeeded. +ac_fn_fc_try_compile () +{ + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + rm -f conftest.$ac_objext + if { { ac_try="$ac_compile" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_compile") 2>conftest.err + ac_status=$? + if test -s conftest.err; then + grep -v '^ *+' conftest.err >conftest.er1 + cat conftest.er1 >&5 + mv -f conftest.er1 conftest.err + fi + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } && { + test -z "$ac_fc_werror_flag" || + test ! -s conftest.err + } && test -s conftest.$ac_objext; then : + ac_retval=0 +else + $as_echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + ac_retval=1 +fi + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno + as_fn_set_status $ac_retval + +} # ac_fn_fc_try_compile + +# ac_fn_fc_try_link LINENO +# ------------------------ +# Try to link conftest.$ac_ext, and return whether this succeeded. +ac_fn_fc_try_link () +{ + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + rm -f conftest.$ac_objext conftest$ac_exeext + if { { ac_try="$ac_link" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_link") 2>conftest.err + ac_status=$? + if test -s conftest.err; then + grep -v '^ *+' conftest.err >conftest.er1 + cat conftest.er1 >&5 + mv -f conftest.er1 conftest.err + fi + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } && { + test -z "$ac_fc_werror_flag" || + test ! -s conftest.err + } && test -s conftest$ac_exeext && { + test "$cross_compiling" = yes || + test -x conftest$ac_exeext + }; then : + ac_retval=0 +else + $as_echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + ac_retval=1 +fi + # Delete the IPA/IPO (Inter Procedural Analysis/Optimization) information + # created by the PGI compiler (conftest_ipa8_conftest.oo), as it would + # interfere with the next link command; also delete a directory that is + # left behind by Apple's compiler. We do this before executing the actions. + rm -rf conftest.dSYM conftest_ipa8_conftest.oo + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno + as_fn_set_status $ac_retval + +} # ac_fn_fc_try_link +cat >config.log <<_ACEOF +This file contains any messages produced by compilers while +running configure, to aid debugging if configure makes a mistake. + +It was created by R $as_me 3.4.0, which was +generated by GNU Autoconf 2.69. Invocation command line was + + $ $0 $@ + +_ACEOF +exec 5>>config.log +{ +cat <<_ASUNAME +## --------- ## +## Platform. ## +## --------- ## + +hostname = `(hostname || uname -n) 2>/dev/null | sed 1q` +uname -m = `(uname -m) 2>/dev/null || echo unknown` +uname -r = `(uname -r) 2>/dev/null || echo unknown` +uname -s = `(uname -s) 2>/dev/null || echo unknown` +uname -v = `(uname -v) 2>/dev/null || echo unknown` + +/usr/bin/uname -p = `(/usr/bin/uname -p) 2>/dev/null || echo unknown` +/bin/uname -X = `(/bin/uname -X) 2>/dev/null || echo unknown` + +/bin/arch = `(/bin/arch) 2>/dev/null || echo unknown` +/usr/bin/arch -k = `(/usr/bin/arch -k) 2>/dev/null || echo unknown` +/usr/convex/getsysinfo = `(/usr/convex/getsysinfo) 2>/dev/null || echo unknown` +/usr/bin/hostinfo = `(/usr/bin/hostinfo) 2>/dev/null || echo unknown` +/bin/machine = `(/bin/machine) 2>/dev/null || echo unknown` +/usr/bin/oslevel = `(/usr/bin/oslevel) 2>/dev/null || echo unknown` +/bin/universe = `(/bin/universe) 2>/dev/null || echo unknown` + +_ASUNAME + +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + $as_echo "PATH: $as_dir" + done +IFS=$as_save_IFS + +} >&5 + +cat >&5 <<_ACEOF + + +## ----------- ## +## Core tests. ## +## ----------- ## + +_ACEOF + + +# Keep a trace of the command line. +# Strip out --no-create and --no-recursion so they do not pile up. +# Strip out --silent because we don't want to record it for future runs. +# Also quote any args containing shell meta-characters. +# Make two passes to allow for proper duplicate-argument suppression. +ac_configure_args= +ac_configure_args0= +ac_configure_args1= +ac_must_keep_next=false +for ac_pass in 1 2 +do + for ac_arg + do + case $ac_arg in + -no-create | --no-c* | -n | -no-recursion | --no-r*) continue ;; + -q | -quiet | --quiet | --quie | --qui | --qu | --q \ + | -silent | --silent | --silen | --sile | --sil) + continue ;; + *\'*) + ac_arg=`$as_echo "$ac_arg" | sed "s/'/'\\\\\\\\''/g"` ;; + esac + case $ac_pass in + 1) as_fn_append ac_configure_args0 " '$ac_arg'" ;; + 2) + as_fn_append ac_configure_args1 " '$ac_arg'" + if test $ac_must_keep_next = true; then + ac_must_keep_next=false # Got value, back to normal. + else + case $ac_arg in + *=* | --config-cache | -C | -disable-* | --disable-* \ + | -enable-* | --enable-* | -gas | --g* | -nfp | --nf* \ + | -q | -quiet | --q* | -silent | --sil* | -v | -verb* \ + | -with-* | --with-* | -without-* | --without-* | --x) + case "$ac_configure_args0 " in + "$ac_configure_args1"*" '$ac_arg' "* ) continue ;; + esac + ;; + -* ) ac_must_keep_next=true ;; + esac + fi + as_fn_append ac_configure_args " '$ac_arg'" + ;; + esac + done +done +{ ac_configure_args0=; unset ac_configure_args0;} +{ ac_configure_args1=; unset ac_configure_args1;} + +# When interrupted or exit'd, cleanup temporary files, and complete +# config.log. We remove comments because anyway the quotes in there +# would cause problems or look ugly. +# WARNING: Use '\'' to represent an apostrophe within the trap. +# WARNING: Do not start the trap code with a newline, due to a FreeBSD 4.0 bug. +trap 'exit_status=$? + # Save into config.log some information that might help in debugging. + { + echo + + $as_echo "## ---------------- ## +## Cache variables. ## +## ---------------- ##" + echo + # The following way of writing the cache mishandles newlines in values, +( + for ac_var in `(set) 2>&1 | sed -n '\''s/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'\''`; do + eval ac_val=\$$ac_var + case $ac_val in #( + *${as_nl}*) + case $ac_var in #( + *_cv_*) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: cache variable $ac_var contains a newline" >&5 +$as_echo "$as_me: WARNING: cache variable $ac_var contains a newline" >&2;} ;; + esac + case $ac_var in #( + _ | IFS | as_nl) ;; #( + BASH_ARGV | BASH_SOURCE) eval $ac_var= ;; #( + *) { eval $ac_var=; unset $ac_var;} ;; + esac ;; + esac + done + (set) 2>&1 | + case $as_nl`(ac_space='\'' '\''; set) 2>&1` in #( + *${as_nl}ac_space=\ *) + sed -n \ + "s/'\''/'\''\\\\'\'''\''/g; + s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\''\\2'\''/p" + ;; #( + *) + sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p" + ;; + esac | + sort +) + echo + + $as_echo "## ----------------- ## +## Output variables. ## +## ----------------- ##" + echo + for ac_var in $ac_subst_vars + do + eval ac_val=\$$ac_var + case $ac_val in + *\'\''*) ac_val=`$as_echo "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;; + esac + $as_echo "$ac_var='\''$ac_val'\''" + done | sort + echo + + if test -n "$ac_subst_files"; then + $as_echo "## ------------------- ## +## File substitutions. ## +## ------------------- ##" + echo + for ac_var in $ac_subst_files + do + eval ac_val=\$$ac_var + case $ac_val in + *\'\''*) ac_val=`$as_echo "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;; + esac + $as_echo "$ac_var='\''$ac_val'\''" + done | sort + echo + fi + + if test -s confdefs.h; then + $as_echo "## ----------- ## +## confdefs.h. ## +## ----------- ##" + echo + cat confdefs.h + echo + fi + test "$ac_signal" != 0 && + $as_echo "$as_me: caught signal $ac_signal" + $as_echo "$as_me: exit $exit_status" + } >&5 + rm -f core *.core core.conftest.* && + rm -f -r conftest* confdefs* conf$$* $ac_clean_files && + exit $exit_status +' 0 +for ac_signal in 1 2 13 15; do + trap 'ac_signal='$ac_signal'; as_fn_exit 1' $ac_signal +done +ac_signal=0 + +# confdefs.h avoids OS command line length limits that DEFS can exceed. +rm -f -r conftest* confdefs.h + +$as_echo "/* confdefs.h */" > confdefs.h + +# Predefined preprocessor variables. + +cat >>confdefs.h <<_ACEOF +#define PACKAGE_NAME "$PACKAGE_NAME" +_ACEOF + +cat >>confdefs.h <<_ACEOF +#define PACKAGE_TARNAME "$PACKAGE_TARNAME" +_ACEOF + +cat >>confdefs.h <<_ACEOF +#define PACKAGE_VERSION "$PACKAGE_VERSION" +_ACEOF + +cat >>confdefs.h <<_ACEOF +#define PACKAGE_STRING "$PACKAGE_STRING" +_ACEOF + +cat >>confdefs.h <<_ACEOF +#define PACKAGE_BUGREPORT "$PACKAGE_BUGREPORT" +_ACEOF + +cat >>confdefs.h <<_ACEOF +#define PACKAGE_URL "$PACKAGE_URL" +_ACEOF + + +# Let the site file select an alternate cache file if it wants to. +# Prefer an explicitly selected file to automatically selected ones. +ac_site_file1=NONE +ac_site_file2=NONE +if test -n "$CONFIG_SITE"; then + # We do not want a PATH search for config.site. + case $CONFIG_SITE in #(( + -*) ac_site_file1=./$CONFIG_SITE;; + */*) ac_site_file1=$CONFIG_SITE;; + *) ac_site_file1=./$CONFIG_SITE;; + esac +elif test "x$prefix" != xNONE; then + ac_site_file1=$prefix/share/config.site + ac_site_file2=$prefix/etc/config.site +else + ac_site_file1=$ac_default_prefix/share/config.site + ac_site_file2=$ac_default_prefix/etc/config.site +fi +for ac_site_file in "$ac_site_file1" "$ac_site_file2" +do + test "x$ac_site_file" = xNONE && continue + if test /dev/null != "$ac_site_file" && test -r "$ac_site_file"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: loading site script $ac_site_file" >&5 +$as_echo "$as_me: loading site script $ac_site_file" >&6;} + sed 's/^/| /' "$ac_site_file" >&5 + . "$ac_site_file" \ + || { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error $? "failed to load site script $ac_site_file +See \`config.log' for more details" "$LINENO" 5; } + fi +done + +if test -r "$cache_file"; then + # Some versions of bash will fail to source /dev/null (special files + # actually), so we avoid doing that. DJGPP emulates it as a regular file. + if test /dev/null != "$cache_file" && test -f "$cache_file"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: loading cache $cache_file" >&5 +$as_echo "$as_me: loading cache $cache_file" >&6;} + case $cache_file in + [\\/]* | ?:[\\/]* ) . "$cache_file";; + *) . "./$cache_file";; + esac + fi +else + { $as_echo "$as_me:${as_lineno-$LINENO}: creating cache $cache_file" >&5 +$as_echo "$as_me: creating cache $cache_file" >&6;} + >$cache_file +fi + +as_fn_append ac_header_list " sys/time.h" +gt_needs="$gt_needs need-ngettext" +as_fn_append ac_header_list " stdlib.h" +as_fn_append ac_header_list " unistd.h" +as_fn_append ac_header_list " sys/param.h" +# Check that the precious variables saved in the cache have kept the same +# value. +ac_cache_corrupted=false +for ac_var in $ac_precious_vars; do + eval ac_old_set=\$ac_cv_env_${ac_var}_set + eval ac_new_set=\$ac_env_${ac_var}_set + eval ac_old_val=\$ac_cv_env_${ac_var}_value + eval ac_new_val=\$ac_env_${ac_var}_value + case $ac_old_set,$ac_new_set in + set,) + { $as_echo "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&5 +$as_echo "$as_me: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&2;} + ac_cache_corrupted=: ;; + ,set) + { $as_echo "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' was not set in the previous run" >&5 +$as_echo "$as_me: error: \`$ac_var' was not set in the previous run" >&2;} + ac_cache_corrupted=: ;; + ,);; + *) + if test "x$ac_old_val" != "x$ac_new_val"; then + # differences in whitespace do not lead to failure. + ac_old_val_w=`echo x $ac_old_val` + ac_new_val_w=`echo x $ac_new_val` + if test "$ac_old_val_w" != "$ac_new_val_w"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' has changed since the previous run:" >&5 +$as_echo "$as_me: error: \`$ac_var' has changed since the previous run:" >&2;} + ac_cache_corrupted=: + else + { $as_echo "$as_me:${as_lineno-$LINENO}: warning: ignoring whitespace changes in \`$ac_var' since the previous run:" >&5 +$as_echo "$as_me: warning: ignoring whitespace changes in \`$ac_var' since the previous run:" >&2;} + eval $ac_var=\$ac_old_val + fi + { $as_echo "$as_me:${as_lineno-$LINENO}: former value: \`$ac_old_val'" >&5 +$as_echo "$as_me: former value: \`$ac_old_val'" >&2;} + { $as_echo "$as_me:${as_lineno-$LINENO}: current value: \`$ac_new_val'" >&5 +$as_echo "$as_me: current value: \`$ac_new_val'" >&2;} + fi;; + esac + # Pass precious variables to config.status. + if test "$ac_new_set" = set; then + case $ac_new_val in + *\'*) ac_arg=$ac_var=`$as_echo "$ac_new_val" | sed "s/'/'\\\\\\\\''/g"` ;; + *) ac_arg=$ac_var=$ac_new_val ;; + esac + case " $ac_configure_args " in + *" '$ac_arg' "*) ;; # Avoid dups. Use of quotes ensures accuracy. + *) as_fn_append ac_configure_args " '$ac_arg'" ;; + esac + fi +done +if $ac_cache_corrupted; then + { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} + { $as_echo "$as_me:${as_lineno-$LINENO}: error: changes in the environment can compromise the build" >&5 +$as_echo "$as_me: error: changes in the environment can compromise the build" >&2;} + as_fn_error $? "run \`make distclean' and/or \`rm $cache_file' and start over" "$LINENO" 5 +fi +## -------------------- ## +## Main body of script. ## +## -------------------- ## + +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + + + +ac_aux_dir= +for ac_dir in tools "$srcdir"/tools; do + if test -f "$ac_dir/install-sh"; then + ac_aux_dir=$ac_dir + ac_install_sh="$ac_aux_dir/install-sh -c" + break + elif test -f "$ac_dir/install.sh"; then + ac_aux_dir=$ac_dir + ac_install_sh="$ac_aux_dir/install.sh -c" + break + elif test -f "$ac_dir/shtool"; then + ac_aux_dir=$ac_dir + ac_install_sh="$ac_aux_dir/shtool install -c" + break + fi +done +if test -z "$ac_aux_dir"; then + as_fn_error $? "cannot find install-sh, install.sh, or shtool in tools \"$srcdir\"/tools" "$LINENO" 5 +fi + +# These three variables are undocumented and unsupported, +# and are intended to be withdrawn in a future Autoconf release. +# They can cause serious problems if a builder's source tree is in a directory +# whose full name contains unusual characters. +ac_config_guess="$SHELL $ac_aux_dir/config.guess" # Please don't use this var. +ac_config_sub="$SHELL $ac_aux_dir/config.sub" # Please don't use this var. +ac_configure="$SHELL $ac_aux_dir/configure" # Please don't use this var. + + + +### * Information on the package. + +PACKAGE=${PACKAGE_NAME} + +cat >>confdefs.h <<_ACEOF +#define PACKAGE "${PACKAGE}" +_ACEOF + + +VERSION=${PACKAGE_VERSION} + +cat >>confdefs.h <<_ACEOF +#define VERSION "${VERSION}" +_ACEOF + + +MAJ_MIN_VERSION=`echo ${VERSION} | sed 's/\.[0-9]$//'` + + +## Autoheader initialization. + + + +## We call AC_GNU_SOURCE early (it is a prerequisite for the gettext +## macros), so all the C compiling makes use of that. Nowadays it calls +## AC_USE_SYSTEM_EXTENSIONS .... +## This sets _GNU_SOURCE, so glibc defines all its extensions +## (_POSIX_C_SOURCE, _XOPEN_SOURCE, _BSD_SOURCE, __USE_MISC) and these +## unlock declarations of non-C99 functions and constants. +## Ditto for __EXTENSIONS__ on Solaris and _ALL_SOURCE on AIX. + +### ** Platform. + +# Make sure we can run config.sub. +$SHELL "$ac_aux_dir/config.sub" sun4 >/dev/null 2>&1 || + as_fn_error $? "cannot run $SHELL $ac_aux_dir/config.sub" "$LINENO" 5 + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking build system type" >&5 +$as_echo_n "checking build system type... " >&6; } +if ${ac_cv_build+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_build_alias=$build_alias +test "x$ac_build_alias" = x && + ac_build_alias=`$SHELL "$ac_aux_dir/config.guess"` +test "x$ac_build_alias" = x && + as_fn_error $? "cannot guess build type; you must specify one" "$LINENO" 5 +ac_cv_build=`$SHELL "$ac_aux_dir/config.sub" $ac_build_alias` || + as_fn_error $? "$SHELL $ac_aux_dir/config.sub $ac_build_alias failed" "$LINENO" 5 + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_build" >&5 +$as_echo "$ac_cv_build" >&6; } +case $ac_cv_build in +*-*-*) ;; +*) as_fn_error $? "invalid value of canonical build" "$LINENO" 5;; +esac +build=$ac_cv_build +ac_save_IFS=$IFS; IFS='-' +set x $ac_cv_build +shift +build_cpu=$1 +build_vendor=$2 +shift; shift +# Remember, the first character of IFS is used to create $*, +# except with old shells: +build_os=$* +IFS=$ac_save_IFS +case $build_os in *\ *) build_os=`echo "$build_os" | sed 's/ /-/g'`;; esac + + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking host system type" >&5 +$as_echo_n "checking host system type... " >&6; } +if ${ac_cv_host+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test "x$host_alias" = x; then + ac_cv_host=$ac_cv_build +else + ac_cv_host=`$SHELL "$ac_aux_dir/config.sub" $host_alias` || + as_fn_error $? "$SHELL $ac_aux_dir/config.sub $host_alias failed" "$LINENO" 5 +fi + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_host" >&5 +$as_echo "$ac_cv_host" >&6; } +case $ac_cv_host in +*-*-*) ;; +*) as_fn_error $? "invalid value of canonical host" "$LINENO" 5;; +esac +host=$ac_cv_host +ac_save_IFS=$IFS; IFS='-' +set x $ac_cv_host +shift +host_cpu=$1 +host_vendor=$2 +shift; shift +# Remember, the first character of IFS is used to create $*, +# except with old shells: +host_os=$* +IFS=$ac_save_IFS +case $host_os in *\ *) host_os=`echo "$host_os" | sed 's/ /-/g'`;; esac + + + +cat >>confdefs.h <<_ACEOF +#define R_PLATFORM "${host}" +_ACEOF + + +cat >>confdefs.h <<_ACEOF +#define R_CPU "${host_cpu}" +_ACEOF + + +cat >>confdefs.h <<_ACEOF +#define R_VENDOR "${host_vendor}" +_ACEOF + + +cat >>confdefs.h <<_ACEOF +#define R_OS "${host_os}" +_ACEOF + + +## exclude some unsupported OSes +case "${host_os}" in + ## Darwin 1.3.1 was macOS 10.0, 1.4.1 was 10.1, 5 is 10.2 etc + ## with 13 being 10.9. We no longer support < 10.6 (Snow Leopard) + ## https://en.wikipedia.org/wiki/Darwin_OS + darwin1.*) + as_fn_error $? "The earliest supported macOS is 10.6. + ;; + darwin56789*" "$LINENO" 5 + as_fn_error $? "The earliest supported macOS is 10.6. + ;; + aix123*|aix4.01*" "$LINENO" 5 + ## These need a form of linking we no longer support + as_fn_error $? "AIX prior to 4.2 is not supported" "$LINENO" 5 + ;; +esac + +R_PLATFORM="${host}" + +R_OS="${host_os}" + + +case "${host_os}" in + mingw*|windows*|winnt) + +$as_echo "#define Win32 1" >>confdefs.h + + R_OSTYPE="windows" + ;; + *) + +$as_echo "#define Unix 1" >>confdefs.h + + R_OSTYPE="unix" + ;; +esac + + +R_CONFIG_ARGS="${ac_configure_args}" + + +### ** Defaults. + +## NB: autoconf loads such files too +cfile="${srcdir}/config.site" +if test -r "${cfile}"; then + echo "loading site script '${cfile}'" + . "${cfile}" +fi +cfile="${HOME}/.R/config" +if test -r "${cfile}"; then + echo "loading user script '${cfile}'" + . "${cfile}" +fi +cfile="./config.site" +if test -r "${cfile}"; then + echo "loading build-specific script '${cfile}'" + . "${cfile}" +fi + +## We need to establish suitable defaults for a 64-bit OS +libnn=lib +case "${host_os}" in + linux*) + ## Not all distros use this: some choose to march out of step + ## Allow for ppc64le (Debian calls ppc64el), powerpc64le ... + case "${host_cpu}" in + x86_64|mips64|ppc64*|powerpc64*|sparc64|s390x) + if test -d /usr/lib64; then + libnn=lib64 + fi + ;; + esac + ;; + solaris*) + ## libnn=lib/sparcv9 ## on 64-bit only, but that's compiler-specific + ;; +esac +: ${LIBnn=$libnn} +## We provide these defaults so that headers and libraries in +## '/usr/local' are found (by the native tools, mostly). +if test -f "/sw/etc/fink.conf"; then + : ${CPPFLAGS="-I/sw/include -I/usr/local/include"} + : ${LDFLAGS="-L/sw/lib -L/usr/local/lib"} +else + : ${CPPFLAGS="-I/usr/local/include"} + : ${LDFLAGS="-L/usr/local/${LIBnn}"} +fi + +## take care not to override the command-line setting +if test "${libdir}" = '${exec_prefix}/lib'; then + libdir='${exec_prefix}/${LIBnn}' +fi + +## R installation directories + +if test -z "${rdocdir}"; then + rdocdir='${rhome}/doc' +fi + + +if test -z "${rincludedir}"; then + rincludedir='${rhome}/include' +fi + + +if test -z "${rsharedir}"; then + rsharedir='${rhome}/share' +fi + + +### ** Handle arguments to configure. + +config_opts="${ac_configure_args}" + + +### ** Optional features. + +## Allow the user to specify support for R profiling. +# Check whether --enable-R-profiling was given. +if test "${enable_R_profiling+set}" = set; then : + enableval=$enable_R_profiling; if test "${enableval}" = no; then + want_R_profiling=no +elif test "${enableval}" = yes; then + want_R_profiling=yes +else + want_R_profiling=yes +fi +else + want_R_profiling=yes +fi + + +## Allow the user to specify support for memory profiling. +# Check whether --enable-memory-profiling was given. +if test "${enable_memory_profiling+set}" = set; then : + enableval=$enable_memory_profiling; if test "${enableval}" = no; then + want_memory_profiling=no +elif test "${enableval}" = yes; then + want_memory_profiling=yes +else + want_memory_profiling=no +fi +else + want_memory_profiling=no +fi + + +## Allow the user to specify building an R framework (Darwin). +# Check whether --enable-R-framework was given. +if test "${enable_R_framework+set}" = set; then : + enableval=$enable_R_framework; want_R_framework="${enableval}" +else + want_R_framework=no +fi + +## Can only build frameworks on Darwin. +if test "${want_R_framework}" != no; then + case "${host_os}" in + darwin*) + if test "${want_R_framework}" = yes; then + ## If we build a framework and 'prefix' was not given, we need + ## to set it to '/Library/Frameworks' rather than '/usr/local'. + ## Note that Autoconf sets things up so that by default, prefix + ## and exec_prefix are set to 'NONE'. Let's hope for no change. + if test "x${prefix}" = xNONE; then + prefix="/Library/Frameworks" + fi + else + prefix="${want_R_framework}" + want_R_framework=yes + fi + ## FW_VERSION is the sub-directory name used in R.framework/Version + ## By default it's the a.b form of the full a.b.c version to simplify + ## binary updates. + : ${FW_VERSION=`echo "${PACKAGE_VERSION}" | sed -e "s/[\.][0-9]$//"`} + ;; + *) + want_R_framework=no + ;; + esac +fi + if test "x${want_R_framework}" = xyes; then + WANT_R_FRAMEWORK_TRUE= + WANT_R_FRAMEWORK_FALSE='#' +else + WANT_R_FRAMEWORK_TRUE='#' + WANT_R_FRAMEWORK_FALSE= +fi + + +## Allow the user to specify building R as a shared library. +## (but a 'dynamic library' in the terminology of macOS). +## <NOTE> +## Building a framework implies building R shared libraries, hence the +## strange default. +## We might want to warn about the case where '--disable-R-shlib' was +## given explicitly ... +## </NOTE> +# Check whether --enable-R-shlib was given. +if test "${enable_R_shlib+set}" = set; then : + enableval=$enable_R_shlib; want_R_shlib="${enableval}" +else + want_R_shlib="${want_R_framework}" +fi + + if test "x${want_R_shlib}" = xyes; then + WANT_R_SHLIB_TRUE= + WANT_R_SHLIB_FALSE='#' +else + WANT_R_SHLIB_TRUE='#' + WANT_R_SHLIB_FALSE= +fi + + +# Check whether --enable-R-static-lib was given. +if test "${enable_R_static_lib+set}" = set; then : + enableval=$enable_R_static_lib; want_R_static="${enableval}" +else + want_R_static="no" +fi + +if test "x${want_R_static}" = xyes; then + if test "x${want_R_shlib}" = xyes; then + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: --enable-R-static-lib conflicts with --enable-R-shlib and will be ignored" >&5 +$as_echo "$as_me: WARNING: --enable-R-static-lib conflicts with --enable-R-shlib and will be ignored" >&2;} + want_R_static=no + fi +fi + if test "x${want_R_static}" = xyes; then + WANT_R_STATIC_TRUE= + WANT_R_STATIC_FALSE='#' +else + WANT_R_STATIC_TRUE='#' + WANT_R_STATIC_FALSE= +fi + + +## Build separate shared/dynamic library containing R's BLAS if desired +# Check whether --enable-BLAS-shlib was given. +if test "${enable_BLAS_shlib+set}" = set; then : + enableval=$enable_BLAS_shlib; use_blas_shlib="${enableval}" +else + use_blas_shlib="unset" +fi + + +## As from R 3.2.0 split up -L... and -lR +if test "${want_R_shlib}" = yes; then + LIBR0="-L\$(R_HOME)/lib\$(R_ARCH)" + LIBR1=-lR +else + LIBR0= + LIBR1= +fi + +## Enable maintainer-specific portions of Makefiles. +# Check whether --enable-maintainer-mode was given. +if test "${enable_maintainer_mode+set}" = set; then : + enableval=$enable_maintainer_mode; use_maintainer_mode="${enableval}" +else + use_maintainer_mode=no +fi + + if test "x${use_maintainer_mode}" = xyes; then + MAINTAINER_MODE_TRUE= + MAINTAINER_MODE_FALSE='#' +else + MAINTAINER_MODE_TRUE='#' + MAINTAINER_MODE_FALSE= +fi + + +## Enable testing the write barrier. +# Check whether --enable-strict-barrier was given. +if test "${enable_strict_barrier+set}" = set; then : + enableval=$enable_strict_barrier; use_strict_barrier="${enableval}" +else + use_strict_barrier=no +fi + +if test x"${use_strict_barrier}" = xyes; then + +$as_echo "#define TESTING_WRITE_BARRIER 1" >>confdefs.h + +fi + +# Check whether --enable-prebuilt-html was given. +if test "${enable_prebuilt_html+set}" = set; then : + enableval=$enable_prebuilt_html; want_prebuilt_html="${enableval}" +else + want_prebuilt_html=no +fi + + if test "x${want_prebuilt_html}" = xyes; then + BUILD_HTML_TRUE= + BUILD_HTML_FALSE='#' +else + BUILD_HTML_TRUE='#' + BUILD_HTML_FALSE= +fi + + +# Check whether --enable-lto was given. +if test "${enable_lto+set}" = set; then : + enableval=$enable_lto; want_lto="${enableval}" +else + want_lto=no +fi + +## FIXME: add a test for gcc >= 4.5.0 +if test "x${want_lto}" != xno; then + LTO=-flto +fi +if test "x${want_lto}" = xyes; then + LTOALL=-flto +fi + + + if test "x${want_lto}" != xno; then + BUILD_LTO_TRUE= + BUILD_LTO_FALSE='#' +else + BUILD_LTO_TRUE='#' + BUILD_LTO_FALSE= +fi + + +# Check whether --enable-java was given. +if test "${enable_java+set}" = set; then : + enableval=$enable_java; want_java="${enableval}" +else + want_java=yes +fi + + if test "x${want_java}" = xyes; then + WANT_JAVA_TRUE= + WANT_JAVA_FALSE='#' +else + WANT_JAVA_TRUE='#' + WANT_JAVA_FALSE= +fi + + +### ** Optional packages. + +## BLAS. + +# Check whether --with-blas was given. +if test "${with_blas+set}" = set; then : + withval=$with_blas; if test "${withval}" = no; then + use_blas=no +else + use_blas=yes +fi + +else + use_blas=unset +fi + +# default is "no" except on macOS + +## LAPACK. + +# Check whether --with-lapack was given. +if test "${with_lapack+set}" = set; then : + withval=$with_lapack; if test "${withval}" = no; then + use_lapack=no +else + use_lapack=yes +fi + +else + use_lapack=unset +fi + +# default is "no" except on macOS + +## Readline. + +# Check whether --with-readline was given. +if test "${with_readline+set}" = set; then : + withval=$with_readline; if test "${withval}" = no; then + use_readline=no +else + use_readline=yes +fi + +else + use_readline=yes +fi + + +## Aqua. + +# Check whether --with-aqua was given. +if test "${with_aqua+set}" = set; then : + withval=$with_aqua; if test "${withval}" = no; then + want_aqua=no +else + want_aqua=yes +fi +else + want_aqua=yes +fi + + +## Tcl/Tk. + +# Check whether --with-tcltk was given. +if test "${with_tcltk+set}" = set; then : + withval=$with_tcltk; if test "${withval}" = no; then + want_tcltk=no +elif test "${withval}" = yes; then + want_tcltk=yes +else + want_tcltk=yes + LDFLAGS="${LDFLAGS} -L${withval}" + tcltk_prefix="${withval}" +fi +else + want_tcltk=yes +fi + + +# Check whether --with-tcl-config was given. +if test "${with_tcl_config+set}" = set; then : + withval=$with_tcl_config; TCL_CONFIG="${withval}" +else + TCL_CONFIG="" +fi + + +# Check whether --with-tk-config was given. +if test "${with_tk_config+set}" = set; then : + withval=$with_tk_config; TK_CONFIG="${withval}" +else + TK_CONFIG="" +fi + + +## cairographics etc + +# Check whether --with-cairo was given. +if test "${with_cairo+set}" = set; then : + withval=$with_cairo; if test "${withval}" = no; then + want_cairo=no +else + want_cairo=yes +fi +else + want_cairo=yes +fi + + +## other libraries + +# Check whether --with-libpng was given. +if test "${with_libpng+set}" = set; then : + withval=$with_libpng; if test "${withval}" = no; then + use_libpng=no +else + use_libpng=yes +fi + +else + use_libpng=yes +fi + + +# Check whether --with-jpeglib was given. +if test "${with_jpeglib+set}" = set; then : + withval=$with_jpeglib; if test "${withval}" = no; then + use_jpeglib=no +else + use_jpeglib=yes +fi + +else + use_jpeglib=yes +fi + + +# Check whether --with-libtiff was given. +if test "${with_libtiff+set}" = set; then : + withval=$with_libtiff; if test "${withval}" = no; then + use_libtiff=no +else + use_libtiff=yes +fi + +else + use_libtiff=yes +fi + + +# Check whether --with-system-tre was given. +if test "${with_system_tre+set}" = set; then : + withval=$with_system_tre; if test "${withval}" = no; then + use_system_tre=no +else + use_system_tre=yes +fi + +else + use_system_tre=no +fi + + +## Valgrind instrumentation + +# Check whether --with-valgrind-instrumentation was given. +if test "${with_valgrind_instrumentation+set}" = set; then : + withval=$with_valgrind_instrumentation; valgrind_level=${withval} +else + valgrind_level=0 +fi + + + +# Check whether --with-system-valgrind-headers was given. +if test "${with_system_valgrind_headers+set}" = set; then : + withval=$with_system_valgrind_headers; if test "${withval}" = no; then + use_system_valgrind=no +else + use_system_valgrind=yes +fi + +else + use_system_valgrind=no +fi + + + +# Check whether --with-internal-tzcode was given. +if test "${with_internal_tzcode+set}" = set; then : + withval=$with_internal_tzcode; use_internal_tzcode=${withval} +else + use_internal_tzcode=default +fi + + + +## <FIXME> +## Completely disable using libtool for building shlibs until libtool +## fully supports Fortran and C++. +## AC_ARG_WITH([libtool], +## [AS_HELP_STRING([--with-libtool],[use libtool for building shared libraries [yes]])], +## [use_libtool="${withval}"], +## [use_libtool=yes]) +## AM_CONDITIONAL(USE_LIBTOOL, [test "x${use_libtool}" = xyes]) +## </FIXME> + +## Recommended R packages. + +# Check whether --with-recommended-packages was given. +if test "${with_recommended_packages+set}" = set; then : + withval=$with_recommended_packages; if test "${withval}" = no; then + use_recommended_packages=no +else + use_recommended_packages=yes +fi + +else + use_recommended_packages=yes +fi + + +## ICU + +# Check whether --with-ICU was given. +if test "${with_ICU+set}" = set; then : + withval=$with_ICU; if test "${withval}" = no; then + use_ICU=no +else + use_ICU=yes +fi + +else + use_ICU=yes +fi + + +## Byte-compilation of packages. +# Check whether --enable-byte-compiled-packages was given. +if test "${enable_byte_compiled_packages+set}" = set; then : + enableval=$enable_byte_compiled_packages; want_byte_compiled_packages="${enableval}" +else + want_byte_compiled_packages=yes +fi + + if test "x${want_byte_compiled_packages}" = xyes; then + BYTE_COMPILE_PACKAGES_TRUE= + BYTE_COMPILE_PACKAGES_FALSE='#' +else + BYTE_COMPILE_PACKAGES_TRUE='#' + BYTE_COMPILE_PACKAGES_FALSE= +fi + + +### ** Precious variables. + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +if test -z "${r_arch}"; then + R_ARCH= + R_XTRA_CPPFLAGS2="-I\$(R_INCLUDE_DIR)" +else + R_ARCH="/${r_arch}" + R_XTRA_CPPFLAGS2="-I\$(R_INCLUDE_DIR) -I\$(R_INCLUDE_DIR)/${r_arch}" +fi + +cat >>confdefs.h <<_ACEOF +#define R_ARCH "${r_arch}" +_ACEOF + + + + +### ** Check whether we build in srcdir. + +# Extract the first word of "pwd", so it can be a program name with args. +set dummy pwd; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_path_GETWD+:} false; then : + $as_echo_n "(cached) " >&6 +else + case $GETWD in + [\\/]* | ?:[\\/]*) + ac_cv_path_GETWD="$GETWD" # Let the user override the test with a path. + ;; + *) + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_path_GETWD="$as_dir/$ac_word$ac_exec_ext" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + + test -z "$ac_cv_path_GETWD" && ac_cv_path_GETWD="pwd" + ;; +esac +fi +GETWD=$ac_cv_path_GETWD +if test -n "$GETWD"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $GETWD" >&5 +$as_echo "$GETWD" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether builddir is srcdir" >&5 +$as_echo_n "checking whether builddir is srcdir... " >&6; } +if test "`cd \"${srcdir}\" && ${GETWD}`" = "`${GETWD}`"; then + BUILDDIR_IS_SRCDIR=yes +else + BUILDDIR_IS_SRCDIR=no +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: ${BUILDDIR_IS_SRCDIR}" >&5 +$as_echo "${BUILDDIR_IS_SRCDIR}" >&6; } + +### * Checks for programs. + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for working aclocal" >&5 +$as_echo_n "checking for working aclocal... " >&6; } +if (aclocal --version) < /dev/null > /dev/null 2>&1; then + ACLOCAL=aclocal + { $as_echo "$as_me:${as_lineno-$LINENO}: result: found" >&5 +$as_echo "found" >&6; } +else + ACLOCAL="\$(SHELL) \$(top_srcdir)/tools/missing aclocal" + { $as_echo "$as_me:${as_lineno-$LINENO}: result: missing" >&5 +$as_echo "missing" >&6; } +fi + + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for working autoconf" >&5 +$as_echo_n "checking for working autoconf... " >&6; } +if (autoconf --version) < /dev/null > /dev/null 2>&1; then + AUTOCONF=autoconf + { $as_echo "$as_me:${as_lineno-$LINENO}: result: found" >&5 +$as_echo "found" >&6; } +else + AUTOCONF="\$(SHELL) \$(top_srcdir)/tools/missing autoconf" + { $as_echo "$as_me:${as_lineno-$LINENO}: result: missing" >&5 +$as_echo "missing" >&6; } +fi + + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for working automake" >&5 +$as_echo_n "checking for working automake... " >&6; } +if (automake --version) < /dev/null > /dev/null 2>&1; then + AUTOMAKE=automake + { $as_echo "$as_me:${as_lineno-$LINENO}: result: found" >&5 +$as_echo "found" >&6; } +else + AUTOMAKE="\$(SHELL) \$(top_srcdir)/tools/missing automake" + { $as_echo "$as_me:${as_lineno-$LINENO}: result: missing" >&5 +$as_echo "missing" >&6; } +fi + + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for working autoheader" >&5 +$as_echo_n "checking for working autoheader... " >&6; } +if (autoheader --version) < /dev/null > /dev/null 2>&1; then + AUTOHEADER=autoheader + { $as_echo "$as_me:${as_lineno-$LINENO}: result: found" >&5 +$as_echo "found" >&6; } +else + AUTOHEADER="\$(SHELL) \$(top_srcdir)/tools/missing autoheader" + { $as_echo "$as_me:${as_lineno-$LINENO}: result: missing" >&5 +$as_echo "missing" >&6; } +fi + + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether ln -s works" >&5 +$as_echo_n "checking whether ln -s works... " >&6; } +LN_S=$as_ln_s +if test "$LN_S" = "ln -s"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +$as_echo "yes" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no, using $LN_S" >&5 +$as_echo "no, using $LN_S" >&6; } +fi + +for ac_prog in 'bison -y' byacc +do + # Extract the first word of "$ac_prog", so it can be a program name with args. +set dummy $ac_prog; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_YACC+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$YACC"; then + ac_cv_prog_YACC="$YACC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_YACC="$ac_prog" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +YACC=$ac_cv_prog_YACC +if test -n "$YACC"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $YACC" >&5 +$as_echo "$YACC" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + test -n "$YACC" && break +done +test -n "$YACC" || YACC="yacc" + +for ac_prog in ${AR} ar +do + # Extract the first word of "$ac_prog", so it can be a program name with args. +set dummy $ac_prog; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_AR+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$AR"; then + ac_cv_prog_AR="$AR" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_AR="$ac_prog" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +AR=$ac_cv_prog_AR +if test -n "$AR"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $AR" >&5 +$as_echo "$AR" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + test -n "$AR" && break +done + +: ${ARFLAGS="rc"} + + +# Find a good install program. We prefer a C program (faster), +# so one script is as good as another. But avoid the broken or +# incompatible versions: +# SysV /etc/install, /usr/sbin/install +# SunOS /usr/etc/install +# IRIX /sbin/install +# AIX /bin/install +# AmigaOS /C/install, which installs bootblocks on floppy discs +# AIX 4 /usr/bin/installbsd, which doesn't work without a -g flag +# AFS /usr/afsws/bin/install, which mishandles nonexistent args +# SVR4 /usr/ucb/install, which tries to use the nonexistent group "staff" +# OS/2's system install, which has a completely different semantic +# ./install, which can be erroneously created by make from ./install.sh. +# Reject install programs that cannot install multiple files. +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for a BSD-compatible install" >&5 +$as_echo_n "checking for a BSD-compatible install... " >&6; } +if test -z "$INSTALL"; then +if ${ac_cv_path_install+:} false; then : + $as_echo_n "(cached) " >&6 +else + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + # Account for people who put trailing slashes in PATH elements. +case $as_dir/ in #(( + ./ | .// | /[cC]/* | \ + /etc/* | /usr/sbin/* | /usr/etc/* | /sbin/* | /usr/afsws/bin/* | \ + ?:[\\/]os2[\\/]install[\\/]* | ?:[\\/]OS2[\\/]INSTALL[\\/]* | \ + /usr/ucb/* ) ;; + *) + # OSF1 and SCO ODT 3.0 have their own names for install. + # Don't use installbsd from OSF since it installs stuff as root + # by default. + for ac_prog in ginstall scoinst install; do + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_prog$ac_exec_ext"; then + if test $ac_prog = install && + grep dspmsg "$as_dir/$ac_prog$ac_exec_ext" >/dev/null 2>&1; then + # AIX install. It has an incompatible calling convention. + : + elif test $ac_prog = install && + grep pwplus "$as_dir/$ac_prog$ac_exec_ext" >/dev/null 2>&1; then + # program-specific install script used by HP pwplus--don't use. + : + else + rm -rf conftest.one conftest.two conftest.dir + echo one > conftest.one + echo two > conftest.two + mkdir conftest.dir + if "$as_dir/$ac_prog$ac_exec_ext" -c conftest.one conftest.two "`pwd`/conftest.dir" && + test -s conftest.one && test -s conftest.two && + test -s conftest.dir/conftest.one && + test -s conftest.dir/conftest.two + then + ac_cv_path_install="$as_dir/$ac_prog$ac_exec_ext -c" + break 3 + fi + fi + fi + done + done + ;; +esac + + done +IFS=$as_save_IFS + +rm -rf conftest.one conftest.two conftest.dir + +fi + if test "${ac_cv_path_install+set}" = set; then + INSTALL=$ac_cv_path_install + else + # As a last resort, use the slow shell script. Don't cache a + # value for INSTALL within a source directory, because that will + # break other packages using the cache if that directory is + # removed, or if the value is a relative name. + INSTALL=$ac_install_sh + fi +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $INSTALL" >&5 +$as_echo "$INSTALL" >&6; } + +# Use test -z because SunOS4 sh mishandles braces in ${var-val}. +# It thinks the first close brace ends the variable substitution. +test -z "$INSTALL_PROGRAM" && INSTALL_PROGRAM='${INSTALL}' + +test -z "$INSTALL_SCRIPT" && INSTALL_SCRIPT='${INSTALL}' + +test -z "$INSTALL_DATA" && INSTALL_DATA='${INSTALL} -m 644' + + +case "${INSTALL}" in + [\\/]* | ?:[\\/]* ) # absolute + ;; + *) + INSTALL="\$\(top_srcdir\)/tools/install-sh -c" + ;; +esac +case "${host_os}" in + hpux*) + ## On some versions of HP-UX (seen on both 10.20 and 11.0) we end up + ## a broken install (seen in /opt/imake/bin) which has the default + ## permissions wrong (PR#2091). Let's just always use install-sh on + ## HP-UX. + INSTALL="\$\(top_srcdir\)/tools/install-sh -c" + ;; +esac + + +## we would like a POSIX sed, and need one on Solaris +for ac_prog in sed +do + # Extract the first word of "$ac_prog", so it can be a program name with args. +set dummy $ac_prog; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_path_SED+:} false; then : + $as_echo_n "(cached) " >&6 +else + case $SED in + [\\/]* | ?:[\\/]*) + ac_cv_path_SED="$SED" # Let the user override the test with a path. + ;; + *) + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +as_dummy="/usr/xpg4/bin:$PATH" +for as_dir in $as_dummy +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_path_SED="$as_dir/$ac_word$ac_exec_ext" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + + ;; +esac +fi +SED=$ac_cv_path_SED +if test -n "$SED"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $SED" >&5 +$as_echo "$SED" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + test -n "$SED" && break +done +test -n "$SED" || SED="/bin/sed" + +## 'which' is not POSIX, and might be a shell builtin or alias +## (but should not be in 'sh') +for ac_prog in which +do + # Extract the first word of "$ac_prog", so it can be a program name with args. +set dummy $ac_prog; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_path_WHICH+:} false; then : + $as_echo_n "(cached) " >&6 +else + case $WHICH in + [\\/]* | ?:[\\/]*) + ac_cv_path_WHICH="$WHICH" # Let the user override the test with a path. + ;; + *) + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_path_WHICH="$as_dir/$ac_word$ac_exec_ext" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + + ;; +esac +fi +WHICH=$ac_cv_path_WHICH +if test -n "$WHICH"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $WHICH" >&5 +$as_echo "$WHICH" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + test -n "$WHICH" && break +done +test -n "$WHICH" || WHICH="which" + +## Make +: ${MAKE=make} + +## Pager +for ac_prog in ${PAGER} less more page pg +do + # Extract the first word of "$ac_prog", so it can be a program name with args. +set dummy $ac_prog; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_path_PAGER+:} false; then : + $as_echo_n "(cached) " >&6 +else + case $PAGER in + [\\/]* | ?:[\\/]*) + ac_cv_path_PAGER="$PAGER" # Let the user override the test with a path. + ;; + *) + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_path_PAGER="$as_dir/$ac_word$ac_exec_ext" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + + ;; +esac +fi +PAGER=$ac_cv_path_PAGER +if test -n "$PAGER"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $PAGER" >&5 +$as_echo "$PAGER" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + test -n "$PAGER" && break +done +test -n "$PAGER" || PAGER="false" + +if test "${PAGER}" = false; then + warn_pager="I could not determine a pager" + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: ${warn_pager}" >&5 +$as_echo "$as_me: WARNING: ${warn_pager}" >&2;} +fi + +## Tar -- we prefer a GNU version +for ac_prog in ${TAR} gtar gnutar tar +do + # Extract the first word of "$ac_prog", so it can be a program name with args. +set dummy $ac_prog; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_path_TAR+:} false; then : + $as_echo_n "(cached) " >&6 +else + case $TAR in + [\\/]* | ?:[\\/]*) + ac_cv_path_TAR="$TAR" # Let the user override the test with a path. + ;; + *) + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_path_TAR="$as_dir/$ac_word$ac_exec_ext" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + + ;; +esac +fi +TAR=$ac_cv_path_TAR +if test -n "$TAR"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $TAR" >&5 +$as_echo "$TAR" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + test -n "$TAR" && break +done +test -n "$TAR" || TAR="""" + +## TeXMF stuff + +## PDFTEX PDFLATEX MAKEINDEX TEXI2DVI are used to make manuals +## PDFLATEX and MAKEINDEX in the emulation mode of tools::texi2dvi +## TEXI2DVICMD sets default for R_TEXI2DVICMD, used for options('texi2dvi') +## TEX AND LATEX are no longer used +for ac_prog in ${TEX} tex +do + # Extract the first word of "$ac_prog", so it can be a program name with args. +set dummy $ac_prog; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_path_TEX+:} false; then : + $as_echo_n "(cached) " >&6 +else + case $TEX in + [\\/]* | ?:[\\/]*) + ac_cv_path_TEX="$TEX" # Let the user override the test with a path. + ;; + *) + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_path_TEX="$as_dir/$ac_word$ac_exec_ext" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + + ;; +esac +fi +TEX=$ac_cv_path_TEX +if test -n "$TEX"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $TEX" >&5 +$as_echo "$TEX" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + test -n "$TEX" && break +done + +for ac_prog in ${PDFTEX} pdftex +do + # Extract the first word of "$ac_prog", so it can be a program name with args. +set dummy $ac_prog; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_path_PDFTEX+:} false; then : + $as_echo_n "(cached) " >&6 +else + case $PDFTEX in + [\\/]* | ?:[\\/]*) + ac_cv_path_PDFTEX="$PDFTEX" # Let the user override the test with a path. + ;; + *) + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_path_PDFTEX="$as_dir/$ac_word$ac_exec_ext" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + + ;; +esac +fi +PDFTEX=$ac_cv_path_PDFTEX +if test -n "$PDFTEX"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $PDFTEX" >&5 +$as_echo "$PDFTEX" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + test -n "$PDFTEX" && break +done + +if test -z "${ac_cv_path_PDFTEX}" ; then + warn_pdf1="you cannot build PDF versions of the R manuals" + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: ${warn_pdf1}" >&5 +$as_echo "$as_me: WARNING: ${warn_pdf1}" >&2;} +fi +for ac_prog in ${PDFLATEX} pdflatex +do + # Extract the first word of "$ac_prog", so it can be a program name with args. +set dummy $ac_prog; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_path_PDFLATEX+:} false; then : + $as_echo_n "(cached) " >&6 +else + case $PDFLATEX in + [\\/]* | ?:[\\/]*) + ac_cv_path_PDFLATEX="$PDFLATEX" # Let the user override the test with a path. + ;; + *) + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_path_PDFLATEX="$as_dir/$ac_word$ac_exec_ext" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + + ;; +esac +fi +PDFLATEX=$ac_cv_path_PDFLATEX +if test -n "$PDFLATEX"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $PDFLATEX" >&5 +$as_echo "$PDFLATEX" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + test -n "$PDFLATEX" && break +done + +if test -z "${ac_cv_path_PDFLATEX}" ; then + warn_pdf2="you cannot build PDF versions of vignettes and help pages" + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: ${warn_pdf2}" >&5 +$as_echo "$as_me: WARNING: ${warn_pdf2}" >&2;} +fi +for ac_prog in ${MAKEINDEX} makeindex +do + # Extract the first word of "$ac_prog", so it can be a program name with args. +set dummy $ac_prog; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_path_MAKEINDEX+:} false; then : + $as_echo_n "(cached) " >&6 +else + case $MAKEINDEX in + [\\/]* | ?:[\\/]*) + ac_cv_path_MAKEINDEX="$MAKEINDEX" # Let the user override the test with a path. + ;; + *) + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_path_MAKEINDEX="$as_dir/$ac_word$ac_exec_ext" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + + ;; +esac +fi +MAKEINDEX=$ac_cv_path_MAKEINDEX +if test -n "$MAKEINDEX"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $MAKEINDEX" >&5 +$as_echo "$MAKEINDEX" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + test -n "$MAKEINDEX" && break +done + +for ac_prog in ${MAKEINFO} texi2any +do + # Extract the first word of "$ac_prog", so it can be a program name with args. +set dummy $ac_prog; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_path_MAKEINFO+:} false; then : + $as_echo_n "(cached) " >&6 +else + case $MAKEINFO in + [\\/]* | ?:[\\/]*) + ac_cv_path_MAKEINFO="$MAKEINFO" # Let the user override the test with a path. + ;; + *) + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_path_MAKEINFO="$as_dir/$ac_word$ac_exec_ext" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + + ;; +esac +fi +MAKEINFO=$ac_cv_path_MAKEINFO +if test -n "$MAKEINFO"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $MAKEINFO" >&5 +$as_echo "$MAKEINFO" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + test -n "$MAKEINFO" && break +done + +if test -n "${MAKEINFO}"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether texi2any version is at least 5.1" >&5 +$as_echo_n "checking whether texi2any version is at least 5.1... " >&6; } +if ${r_cv_prog_texi2any_v5+:} false; then : + $as_echo_n "(cached) " >&6 +else + texi2any_version=`${MAKEINFO} --version | \ + grep -E '^(makeinfo|texi2any)' | sed 's/[^)]*) \(.*\)/\1/'` +texi2any_version_maj=`echo ${texi2any_version} | cut -f1 -d.` +texi2any_version_min=`echo ${texi2any_version} | \ + cut -f2 -d. | tr -dc '0123456789.' ` +if test -z "${texi2any_version_maj}" \ + || test -z "${texi2any_version_min}"; then + r_cv_prog_texi2any_v5=no +elif test ${texi2any_version_maj} -gt 5; then + r_cv_prog_texi2any_v5=yes +elif test ${texi2any_version_maj} -lt 5 \ + || test ${texi2any_version_min} -lt 1; then + r_cv_prog_texi2any_v5=no +else + r_cv_prog_texi2any_v5=yes +fi +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $r_cv_prog_texi2any_v5" >&5 +$as_echo "$r_cv_prog_texi2any_v5" >&6; } + + for ac_prog in ${INSTALL_INFO} ginstall-info install-info +do + # Extract the first word of "$ac_prog", so it can be a program name with args. +set dummy $ac_prog; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_path_INSTALL_INFO+:} false; then : + $as_echo_n "(cached) " >&6 +else + case $INSTALL_INFO in + [\\/]* | ?:[\\/]*) + ac_cv_path_INSTALL_INFO="$INSTALL_INFO" # Let the user override the test with a path. + ;; + *) + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_path_INSTALL_INFO="$as_dir/$ac_word$ac_exec_ext" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + + ;; +esac +fi +INSTALL_INFO=$ac_cv_path_INSTALL_INFO +if test -n "$INSTALL_INFO"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $INSTALL_INFO" >&5 +$as_echo "$INSTALL_INFO" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + test -n "$INSTALL_INFO" && break +done +test -n "$INSTALL_INFO" || INSTALL_INFO="false" + + if test "ac_cv_path_INSTALL_INFO" = "false"; then + if test "${r_cv_prog_perl_v5}" = yes; then + INSTALL_INFO="perl \$(top_srcdir)/tools/install-info.pl" + fi + fi + +fi +if test "${r_cv_prog_texi2any_v5}" != yes; then + warn_info="you cannot build info or HTML versions of the R manuals" + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: ${warn_info}" >&5 +$as_echo "$as_me: WARNING: ${warn_info}" >&2;} + MAKEINFO="" +else + MAKEINFO="${MAKEINFO}" +fi + +for ac_prog in ${TEXI2DVI} texi2dvi +do + # Extract the first word of "$ac_prog", so it can be a program name with args. +set dummy $ac_prog; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_path_TEXI2DVI+:} false; then : + $as_echo_n "(cached) " >&6 +else + case $TEXI2DVI in + [\\/]* | ?:[\\/]*) + ac_cv_path_TEXI2DVI="$TEXI2DVI" # Let the user override the test with a path. + ;; + *) + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_path_TEXI2DVI="$as_dir/$ac_word$ac_exec_ext" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + + ;; +esac +fi +TEXI2DVI=$ac_cv_path_TEXI2DVI +if test -n "$TEXI2DVI"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $TEXI2DVI" >&5 +$as_echo "$TEXI2DVI" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + test -n "$TEXI2DVI" && break +done + +TEXI2DVICMD=${ac_cv_path_TEXI2DVI} +if test -z "${TEXI2DVICMD}"; then + TEXI2DVICMD=texi2dvi +fi + +for ac_prog in ${KPSEWHICH} kpsewhich +do + # Extract the first word of "$ac_prog", so it can be a program name with args. +set dummy $ac_prog; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_path_KPSEWHICH+:} false; then : + $as_echo_n "(cached) " >&6 +else + case $KPSEWHICH in + [\\/]* | ?:[\\/]*) + ac_cv_path_KPSEWHICH="$KPSEWHICH" # Let the user override the test with a path. + ;; + *) + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_path_KPSEWHICH="$as_dir/$ac_word$ac_exec_ext" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + + ;; +esac +fi +KPSEWHICH=$ac_cv_path_KPSEWHICH +if test -n "$KPSEWHICH"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $KPSEWHICH" >&5 +$as_echo "$KPSEWHICH" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + test -n "$KPSEWHICH" && break +done +test -n "$KPSEWHICH" || KPSEWHICH="""" + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for latex inconsolata package" >&5 +$as_echo_n "checking for latex inconsolata package... " >&6; } +r_rd4pdf="times,inconsolata,hyper" +if test -n "${KPSEWHICH}"; then + ${KPSEWHICH} zi4.sty > /dev/null + if test $? -eq 0; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: found zi4.sty" >&5 +$as_echo "found zi4.sty" >&6; } + else + ${KPSEWHICH} inconsolata.sty > /dev/null + if test $? -eq 0; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: found inconsolata.sty" >&5 +$as_echo "found inconsolata.sty" >&6; } + else + r_rd4pdf="times,hyper" + if test -z "${R_RD4PDF}" ; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: missing" >&5 +$as_echo "missing" >&6; } + warn_pdf3="neither inconsolata.sty nor zi4.sty found: PDF vignettes and package manuals will not be rendered optimally" + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: ${warn_pdf3}" >&5 +$as_echo "$as_me: WARNING: ${warn_pdf3}" >&2;} + fi + fi + fi +fi +: ${R_RD4PDF=${r_rd4pdf}} + + +## Unzip & zip & gzip & bip2 +for ac_prog in ${UNZIP} unzip +do + # Extract the first word of "$ac_prog", so it can be a program name with args. +set dummy $ac_prog; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_path_R_UNZIPCMD+:} false; then : + $as_echo_n "(cached) " >&6 +else + case $R_UNZIPCMD in + [\\/]* | ?:[\\/]*) + ac_cv_path_R_UNZIPCMD="$R_UNZIPCMD" # Let the user override the test with a path. + ;; + *) + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_path_R_UNZIPCMD="$as_dir/$ac_word$ac_exec_ext" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + + ;; +esac +fi +R_UNZIPCMD=$ac_cv_path_R_UNZIPCMD +if test -n "$R_UNZIPCMD"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $R_UNZIPCMD" >&5 +$as_echo "$R_UNZIPCMD" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + test -n "$R_UNZIPCMD" && break +done +test -n "$R_UNZIPCMD" || R_UNZIPCMD="""" + +for ac_prog in ${ZIP} zip +do + # Extract the first word of "$ac_prog", so it can be a program name with args. +set dummy $ac_prog; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_path_R_ZIPCMD+:} false; then : + $as_echo_n "(cached) " >&6 +else + case $R_ZIPCMD in + [\\/]* | ?:[\\/]*) + ac_cv_path_R_ZIPCMD="$R_ZIPCMD" # Let the user override the test with a path. + ;; + *) + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_path_R_ZIPCMD="$as_dir/$ac_word$ac_exec_ext" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + + ;; +esac +fi +R_ZIPCMD=$ac_cv_path_R_ZIPCMD +if test -n "$R_ZIPCMD"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $R_ZIPCMD" >&5 +$as_echo "$R_ZIPCMD" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + test -n "$R_ZIPCMD" && break +done +test -n "$R_ZIPCMD" || R_ZIPCMD="""" + +for ac_prog in ${GZIP} gzip +do + # Extract the first word of "$ac_prog", so it can be a program name with args. +set dummy $ac_prog; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_path_R_GZIPCMD+:} false; then : + $as_echo_n "(cached) " >&6 +else + case $R_GZIPCMD in + [\\/]* | ?:[\\/]*) + ac_cv_path_R_GZIPCMD="$R_GZIPCMD" # Let the user override the test with a path. + ;; + *) + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_path_R_GZIPCMD="$as_dir/$ac_word$ac_exec_ext" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + + ;; +esac +fi +R_GZIPCMD=$ac_cv_path_R_GZIPCMD +if test -n "$R_GZIPCMD"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $R_GZIPCMD" >&5 +$as_echo "$R_GZIPCMD" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + test -n "$R_GZIPCMD" && break +done +test -n "$R_GZIPCMD" || R_GZIPCMD="true" + +for ac_prog in ${BZIP} bzip2 +do + # Extract the first word of "$ac_prog", so it can be a program name with args. +set dummy $ac_prog; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_path_R_BZIPCMD+:} false; then : + $as_echo_n "(cached) " >&6 +else + case $R_BZIPCMD in + [\\/]* | ?:[\\/]*) + ac_cv_path_R_BZIPCMD="$R_BZIPCMD" # Let the user override the test with a path. + ;; + *) + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_path_R_BZIPCMD="$as_dir/$ac_word$ac_exec_ext" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + + ;; +esac +fi +R_BZIPCMD=$ac_cv_path_R_BZIPCMD +if test -n "$R_BZIPCMD"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $R_BZIPCMD" >&5 +$as_echo "$R_BZIPCMD" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + test -n "$R_BZIPCMD" && break +done +test -n "$R_BZIPCMD" || R_BZIPCMD="""" + +## Browser +if test -z "${R_BROWSER}"; then + for ac_prog in firefox mozilla galeon opera xdg-open kfmclient gnome-moz-remote open +do + # Extract the first word of "$ac_prog", so it can be a program name with args. +set dummy $ac_prog; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_path_R_BROWSER+:} false; then : + $as_echo_n "(cached) " >&6 +else + case $R_BROWSER in + [\\/]* | ?:[\\/]*) + ac_cv_path_R_BROWSER="$R_BROWSER" # Let the user override the test with a path. + ;; + *) + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_path_R_BROWSER="$as_dir/$ac_word$ac_exec_ext" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + + ;; +esac +fi +R_BROWSER=$ac_cv_path_R_BROWSER +if test -n "$R_BROWSER"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $R_BROWSER" >&5 +$as_echo "$R_BROWSER" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + test -n "$R_BROWSER" && break +done + +fi +if test -z "${R_BROWSER}"; then + warn_browser="I could not determine a browser" + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: ${warn_browser}" >&5 +$as_echo "$as_me: WARNING: ${warn_browser}" >&2;} +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: using default browser ... ${R_BROWSER}" >&5 +$as_echo "using default browser ... ${R_BROWSER}" >&6; } +fi + + +## PDF viewer +for ac_prog in ${R_PDFVIEWER} acroread acroread4 xdg-open evince xpdf gv gnome-gv ggv okular kpdf open gpdf kghostview +do + # Extract the first word of "$ac_prog", so it can be a program name with args. +set dummy $ac_prog; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_path_R_PDFVIEWER+:} false; then : + $as_echo_n "(cached) " >&6 +else + case $R_PDFVIEWER in + [\\/]* | ?:[\\/]*) + ac_cv_path_R_PDFVIEWER="$R_PDFVIEWER" # Let the user override the test with a path. + ;; + *) + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_path_R_PDFVIEWER="$as_dir/$ac_word$ac_exec_ext" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + + ;; +esac +fi +R_PDFVIEWER=$ac_cv_path_R_PDFVIEWER +if test -n "$R_PDFVIEWER"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $R_PDFVIEWER" >&5 +$as_echo "$R_PDFVIEWER" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + test -n "$R_PDFVIEWER" && break +done + +if test -z "${R_PDFVIEWER}"; then + warn_pdfviewer="I could not determine a PDF viewer" + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: ${warn_pdfviewer}" >&5 +$as_echo "$as_me: WARNING: ${warn_pdfviewer}" >&2;} +fi + + +## Noweb - used for maintainer mode only +# Extract the first word of "notangle", so it can be a program name with args. +set dummy notangle; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_path_NOTANGLE+:} false; then : + $as_echo_n "(cached) " >&6 +else + case $NOTANGLE in + [\\/]* | ?:[\\/]*) + ac_cv_path_NOTANGLE="$NOTANGLE" # Let the user override the test with a path. + ;; + *) + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_path_NOTANGLE="$as_dir/$ac_word$ac_exec_ext" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + + test -z "$ac_cv_path_NOTANGLE" && ac_cv_path_NOTANGLE="false" + ;; +esac +fi +NOTANGLE=$ac_cv_path_NOTANGLE +if test -n "$NOTANGLE"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $NOTANGLE" >&5 +$as_echo "$NOTANGLE" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + +if test "x${use_maintainer_mode}" = xyes; then + if test "${NOTANGLE}" = false ; then + as_fn_error $? "Building R in maintainer mode requires notangle." "$LINENO" 5 + fi +fi +## javareconf needs this +# Extract the first word of "realpath", so it can be a program name with args. +set dummy realpath; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_path_REALPATH+:} false; then : + $as_echo_n "(cached) " >&6 +else + case $REALPATH in + [\\/]* | ?:[\\/]*) + ac_cv_path_REALPATH="$REALPATH" # Let the user override the test with a path. + ;; + *) + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_path_REALPATH="$as_dir/$ac_word$ac_exec_ext" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + + test -z "$ac_cv_path_REALPATH" && ac_cv_path_REALPATH="false" + ;; +esac +fi +REALPATH=$ac_cv_path_REALPATH +if test -n "$REALPATH"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $REALPATH" >&5 +$as_echo "$REALPATH" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + + +## Search for cairographics needs pkg-config, +## helps find jpeg, libpng and libtiff. +# Extract the first word of "pkg-config ", so it can be a program name with args. +set dummy pkg-config ; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_path_PKGCONF+:} false; then : + $as_echo_n "(cached) " >&6 +else + case $PKGCONF in + [\\/]* | ?:[\\/]*) + ac_cv_path_PKGCONF="$PKGCONF" # Let the user override the test with a path. + ;; + *) + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +as_dummy="$PATH:/usr/local/bin:/ext/bin:/ext:/sw/bin:/opt/bin" +for as_dir in $as_dummy +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_path_PKGCONF="$as_dir/$ac_word$ac_exec_ext" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + + ;; +esac +fi +PKGCONF=$ac_cv_path_PKGCONF +if test -n "$PKGCONF"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $PKGCONF" >&5 +$as_echo "$PKGCONF" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + + + + +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu +if test -n "$ac_tool_prefix"; then + # Extract the first word of "${ac_tool_prefix}gcc", so it can be a program name with args. +set dummy ${ac_tool_prefix}gcc; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_CC+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$CC"; then + ac_cv_prog_CC="$CC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_CC="${ac_tool_prefix}gcc" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +CC=$ac_cv_prog_CC +if test -n "$CC"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5 +$as_echo "$CC" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + +fi +if test -z "$ac_cv_prog_CC"; then + ac_ct_CC=$CC + # Extract the first word of "gcc", so it can be a program name with args. +set dummy gcc; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_ac_ct_CC+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$ac_ct_CC"; then + ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_ac_ct_CC="gcc" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +ac_ct_CC=$ac_cv_prog_ac_ct_CC +if test -n "$ac_ct_CC"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_CC" >&5 +$as_echo "$ac_ct_CC" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + if test "x$ac_ct_CC" = x; then + CC="" + else + case $cross_compiling:$ac_tool_warned in +yes:) +{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 +$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} +ac_tool_warned=yes ;; +esac + CC=$ac_ct_CC + fi +else + CC="$ac_cv_prog_CC" +fi + +if test -z "$CC"; then + if test -n "$ac_tool_prefix"; then + # Extract the first word of "${ac_tool_prefix}cc", so it can be a program name with args. +set dummy ${ac_tool_prefix}cc; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_CC+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$CC"; then + ac_cv_prog_CC="$CC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_CC="${ac_tool_prefix}cc" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +CC=$ac_cv_prog_CC +if test -n "$CC"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5 +$as_echo "$CC" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + fi +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 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_CC+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$CC"; then + ac_cv_prog_CC="$CC" # Let the user override the test. +else + ac_prog_rejected=no +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + if test "$as_dir/$ac_word$ac_exec_ext" = "/usr/ucb/cc"; then + ac_prog_rejected=yes + continue + fi + ac_cv_prog_CC="cc" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_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 $# != 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 + ac_cv_prog_CC="$as_dir/$ac_word${1+' '}$@" + fi +fi +fi +fi +CC=$ac_cv_prog_CC +if test -n "$CC"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5 +$as_echo "$CC" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + +fi +if test -z "$CC"; then + if test -n "$ac_tool_prefix"; then + for ac_prog in cl.exe + do + # Extract the first word of "$ac_tool_prefix$ac_prog", so it can be a program name with args. +set dummy $ac_tool_prefix$ac_prog; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_CC+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$CC"; then + ac_cv_prog_CC="$CC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_CC="$ac_tool_prefix$ac_prog" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +CC=$ac_cv_prog_CC +if test -n "$CC"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5 +$as_echo "$CC" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + test -n "$CC" && break + done +fi +if test -z "$CC"; then + ac_ct_CC=$CC + for ac_prog in cl.exe +do + # Extract the first word of "$ac_prog", so it can be a program name with args. +set dummy $ac_prog; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_ac_ct_CC+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$ac_ct_CC"; then + ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_ac_ct_CC="$ac_prog" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +ac_ct_CC=$ac_cv_prog_ac_ct_CC +if test -n "$ac_ct_CC"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_CC" >&5 +$as_echo "$ac_ct_CC" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + test -n "$ac_ct_CC" && break +done + + if test "x$ac_ct_CC" = x; then + CC="" + else + case $cross_compiling:$ac_tool_warned in +yes:) +{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 +$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} +ac_tool_warned=yes ;; +esac + CC=$ac_ct_CC + fi +fi + +fi + + +test -z "$CC" && { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error $? "no acceptable C compiler found in \$PATH +See \`config.log' for more details" "$LINENO" 5; } + +# Provide some information about the compiler. +$as_echo "$as_me:${as_lineno-$LINENO}: checking for C compiler version" >&5 +set X $ac_compile +ac_compiler=$2 +for ac_option in --version -v -V -qversion; do + { { ac_try="$ac_compiler $ac_option >&5" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_compiler $ac_option >&5") 2>conftest.err + ac_status=$? + if test -s conftest.err; then + sed '10a\ +... rest of stderr output deleted ... + 10q' conftest.err >conftest.er1 + cat conftest.er1 >&5 + fi + rm -f conftest.er1 conftest.err + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } +done + +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ + + ; + return 0; +} +_ACEOF +ac_clean_files_save=$ac_clean_files +ac_clean_files="$ac_clean_files a.out a.out.dSYM a.exe b.out" +# Try to create an executable without -o first, disregard a.out. +# It will help us diagnose broken compilers, and finding out an intuition +# of exeext. +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether the C compiler works" >&5 +$as_echo_n "checking whether the C compiler works... " >&6; } +ac_link_default=`$as_echo "$ac_link" | sed 's/ -o *conftest[^ ]*//'` + +# The possible output files: +ac_files="a.out conftest.exe conftest a.exe a_out.exe b.out conftest.*" + +ac_rmfiles= +for ac_file in $ac_files +do + case $ac_file in + *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj ) ;; + * ) ac_rmfiles="$ac_rmfiles $ac_file";; + esac +done +rm -f $ac_rmfiles + +if { { ac_try="$ac_link_default" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_link_default") 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; }; then : + # Autoconf-2.13 could set the ac_cv_exeext variable to `no'. +# So ignore a value of `no', otherwise this would lead to `EXEEXT = no' +# in a Makefile. We should not override ac_cv_exeext if it was cached, +# so that the user can short-circuit this test for compilers unknown to +# Autoconf. +for ac_file in $ac_files '' +do + test -f "$ac_file" || continue + case $ac_file in + *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj ) + ;; + [ab].out ) + # We found the default executable, but exeext='' is most + # certainly right. + break;; + *.* ) + if test "${ac_cv_exeext+set}" = set && test "$ac_cv_exeext" != no; + then :; else + ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'` + fi + # We set ac_cv_exeext here because the later test for it is not + # safe: cross compilers may not add the suffix if given an `-o' + # argument, so we may need to know it at that point already. + # Even if this section looks crufty: it has the advantage of + # actually working. + break;; + * ) + break;; + esac +done +test "$ac_cv_exeext" = no && ac_cv_exeext= + +else + ac_file='' +fi +if test -z "$ac_file"; then : + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +$as_echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +{ { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error 77 "C compiler cannot create executables +See \`config.log' for more details" "$LINENO" 5; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +$as_echo "yes" >&6; } +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for C compiler default output file name" >&5 +$as_echo_n "checking for C compiler default output file name... " >&6; } +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_file" >&5 +$as_echo "$ac_file" >&6; } +ac_exeext=$ac_cv_exeext + +rm -f -r a.out a.out.dSYM a.exe conftest$ac_cv_exeext b.out +ac_clean_files=$ac_clean_files_save +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for suffix of executables" >&5 +$as_echo_n "checking for suffix of executables... " >&6; } +if { { ac_try="$ac_link" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_link") 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; }; then : + # If both `conftest.exe' and `conftest' are `present' (well, observable) +# catch `conftest.exe'. For instance with Cygwin, `ls conftest' will +# work properly (i.e., refer to `conftest.exe'), while it won't with +# `rm'. +for ac_file in conftest.exe conftest conftest.*; do + test -f "$ac_file" || continue + case $ac_file in + *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj ) ;; + *.* ) ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'` + break;; + * ) break;; + esac +done +else + { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error $? "cannot compute suffix of executables: cannot compile and link +See \`config.log' for more details" "$LINENO" 5; } +fi +rm -f conftest conftest$ac_cv_exeext +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_exeext" >&5 +$as_echo "$ac_cv_exeext" >&6; } + +rm -f conftest.$ac_ext +EXEEXT=$ac_cv_exeext +ac_exeext=$EXEEXT +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <stdio.h> +int +main () +{ +FILE *f = fopen ("conftest.out", "w"); + return ferror (f) || fclose (f) != 0; + + ; + return 0; +} +_ACEOF +ac_clean_files="$ac_clean_files conftest.out" +# Check that the compiler produces executables we can run. If not, either +# the compiler is broken, or we cross compile. +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether we are cross compiling" >&5 +$as_echo_n "checking whether we are cross compiling... " >&6; } +if test "$cross_compiling" != yes; then + { { ac_try="$ac_link" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_link") 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } + if { ac_try='./conftest$ac_cv_exeext' + { { case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_try") 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; }; }; then + cross_compiling=no + else + if test "$cross_compiling" = maybe; then + cross_compiling=yes + else + { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error $? "cannot run C compiled programs. +If you meant to cross compile, use \`--host'. +See \`config.log' for more details" "$LINENO" 5; } + fi + fi +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $cross_compiling" >&5 +$as_echo "$cross_compiling" >&6; } + +rm -f conftest.$ac_ext conftest$ac_cv_exeext conftest.out +ac_clean_files=$ac_clean_files_save +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for suffix of object files" >&5 +$as_echo_n "checking for suffix of object files... " >&6; } +if ${ac_cv_objext+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ + + ; + return 0; +} +_ACEOF +rm -f conftest.o conftest.obj +if { { ac_try="$ac_compile" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_compile") 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; }; then : + for ac_file in conftest.o conftest.obj conftest.*; do + test -f "$ac_file" || continue; + case $ac_file in + *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM ) ;; + *) ac_cv_objext=`expr "$ac_file" : '.*\.\(.*\)'` + break;; + esac +done +else + $as_echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +{ { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error $? "cannot compute suffix of object files: cannot compile +See \`config.log' for more details" "$LINENO" 5; } +fi +rm -f conftest.$ac_cv_objext conftest.$ac_ext +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_objext" >&5 +$as_echo "$ac_cv_objext" >&6; } +OBJEXT=$ac_cv_objext +ac_objext=$OBJEXT +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether we are using the GNU C compiler" >&5 +$as_echo_n "checking whether we are using the GNU C compiler... " >&6; } +if ${ac_cv_c_compiler_gnu+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ +#ifndef __GNUC__ + choke me +#endif + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_compiler_gnu=yes +else + ac_compiler_gnu=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +ac_cv_c_compiler_gnu=$ac_compiler_gnu + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_c_compiler_gnu" >&5 +$as_echo "$ac_cv_c_compiler_gnu" >&6; } +if test $ac_compiler_gnu = yes; then + GCC=yes +else + GCC= +fi +ac_test_CFLAGS=${CFLAGS+set} +ac_save_CFLAGS=$CFLAGS +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $CC accepts -g" >&5 +$as_echo_n "checking whether $CC accepts -g... " >&6; } +if ${ac_cv_prog_cc_g+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_save_c_werror_flag=$ac_c_werror_flag + ac_c_werror_flag=yes + ac_cv_prog_cc_g=no + CFLAGS="-g" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_cv_prog_cc_g=yes +else + CFLAGS="" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + +else + ac_c_werror_flag=$ac_save_c_werror_flag + CFLAGS="-g" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_cv_prog_cc_g=yes +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + ac_c_werror_flag=$ac_save_c_werror_flag +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_g" >&5 +$as_echo "$ac_cv_prog_cc_g" >&6; } +if test "$ac_test_CFLAGS" = set; then + CFLAGS=$ac_save_CFLAGS +elif test $ac_cv_prog_cc_g = yes; then + if test "$GCC" = yes; then + CFLAGS="-g -O2" + else + CFLAGS="-g" + fi +else + if test "$GCC" = yes; then + CFLAGS="-O2" + else + CFLAGS= + fi +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $CC option to accept ISO C89" >&5 +$as_echo_n "checking for $CC option to accept ISO C89... " >&6; } +if ${ac_cv_prog_cc_c89+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_cv_prog_cc_c89=no +ac_save_CC=$CC +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <stdarg.h> +#include <stdio.h> +struct stat; +/* Most of the following tests are stolen from RCS 5.7's src/conf.sh. */ +struct buf { int x; }; +FILE * (*rcsopen) (struct buf *, struct stat *, int); +static char *e (p, i) + char **p; + int i; +{ + return p[i]; +} +static char *f (char * (*g) (char **, int), char **p, ...) +{ + char *s; + va_list v; + va_start (v,p); + s = g (p, va_arg (v,int)); + va_end (v); + return s; +} + +/* OSF 4.0 Compaq cc is some sort of almost-ANSI by default. It has + function prototypes and stuff, but not '\xHH' hex character constants. + These don't provoke an error unfortunately, instead are silently treated + as 'x'. The following induces an error, until -std is added to get + proper ANSI mode. Curiously '\x00'!='x' always comes out true, for an + array size at least. It's necessary to write '\x00'==0 to get something + that's true only with -std. */ +int osf4_cc_array ['\x00' == 0 ? 1 : -1]; + +/* IBM C 6 for AIX is almost-ANSI by default, but it replaces macro parameters + inside strings and character constants. */ +#define FOO(x) 'x' +int xlc6_cc_array[FOO(a) == 'x' ? 1 : -1]; + +int test (int i, double x); +struct s1 {int (*f) (int a);}; +struct s2 {int (*f) (double a);}; +int pairnames (int, char **, FILE *(*)(struct buf *, struct stat *, int), int, int); +int argc; +char **argv; +int +main () +{ +return f (e, argv, 0) != argv[0] || f (e, argv, 1) != argv[1]; + ; + return 0; +} +_ACEOF +for ac_arg in '' -qlanglvl=extc89 -qlanglvl=ansi -std \ + -Ae "-Aa -D_HPUX_SOURCE" "-Xc -D__EXTENSIONS__" +do + CC="$ac_save_CC $ac_arg" + if ac_fn_c_try_compile "$LINENO"; then : + ac_cv_prog_cc_c89=$ac_arg +fi +rm -f core conftest.err conftest.$ac_objext + test "x$ac_cv_prog_cc_c89" != "xno" && break +done +rm -f conftest.$ac_ext +CC=$ac_save_CC + +fi +# AC_CACHE_VAL +case "x$ac_cv_prog_cc_c89" in + x) + { $as_echo "$as_me:${as_lineno-$LINENO}: result: none needed" >&5 +$as_echo "none needed" >&6; } ;; + xno) + { $as_echo "$as_me:${as_lineno-$LINENO}: result: unsupported" >&5 +$as_echo "unsupported" >&6; } ;; + *) + CC="$CC $ac_cv_prog_cc_c89" + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_c89" >&5 +$as_echo "$ac_cv_prog_cc_c89" >&6; } ;; +esac +if test "x$ac_cv_prog_cc_c89" != xno; then : + +fi + +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + + +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking how to run the C preprocessor" >&5 +$as_echo_n "checking how to run the C preprocessor... " >&6; } +# On Suns, sometimes $CPP names a directory. +if test -n "$CPP" && test -d "$CPP"; then + CPP= +fi +if test -z "$CPP"; then + if ${ac_cv_prog_CPP+:} false; then : + $as_echo_n "(cached) " >&6 +else + # Double quotes because CPP needs to be expanded + for CPP in "$CC -E" "$CC -E -traditional-cpp" "/lib/cpp" + do + ac_preproc_ok=false +for ac_c_preproc_warn_flag in '' yes +do + # Use a header file that comes with gcc, so configuring glibc + # with a fresh cross-compiler works. + # Prefer <limits.h> to <assert.h> if __STDC__ is defined, since + # <limits.h> exists even on freestanding compilers. + # On the NeXT, cc -E runs the code through the compiler's parser, + # not just through cpp. "Syntax error" is here to catch this case. + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#ifdef __STDC__ +# include <limits.h> +#else +# include <assert.h> +#endif + Syntax error +_ACEOF +if ac_fn_c_try_cpp "$LINENO"; then : + +else + # Broken: fails on valid input. +continue +fi +rm -f conftest.err conftest.i conftest.$ac_ext + + # OK, works on sane cases. Now check whether nonexistent headers + # can be detected and how. + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <ac_nonexistent.h> +_ACEOF +if ac_fn_c_try_cpp "$LINENO"; then : + # Broken: success on invalid input. +continue +else + # Passes both tests. +ac_preproc_ok=: +break +fi +rm -f conftest.err conftest.i conftest.$ac_ext + +done +# Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped. +rm -f conftest.i conftest.err conftest.$ac_ext +if $ac_preproc_ok; then : + break +fi + + done + ac_cv_prog_CPP=$CPP + +fi + CPP=$ac_cv_prog_CPP +else + ac_cv_prog_CPP=$CPP +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $CPP" >&5 +$as_echo "$CPP" >&6; } +ac_preproc_ok=false +for ac_c_preproc_warn_flag in '' yes +do + # Use a header file that comes with gcc, so configuring glibc + # with a fresh cross-compiler works. + # Prefer <limits.h> to <assert.h> if __STDC__ is defined, since + # <limits.h> exists even on freestanding compilers. + # On the NeXT, cc -E runs the code through the compiler's parser, + # not just through cpp. "Syntax error" is here to catch this case. + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#ifdef __STDC__ +# include <limits.h> +#else +# include <assert.h> +#endif + Syntax error +_ACEOF +if ac_fn_c_try_cpp "$LINENO"; then : + +else + # Broken: fails on valid input. +continue +fi +rm -f conftest.err conftest.i conftest.$ac_ext + + # OK, works on sane cases. Now check whether nonexistent headers + # can be detected and how. + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <ac_nonexistent.h> +_ACEOF +if ac_fn_c_try_cpp "$LINENO"; then : + # Broken: success on invalid input. +continue +else + # Passes both tests. +ac_preproc_ok=: +break +fi +rm -f conftest.err conftest.i conftest.$ac_ext + +done +# Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped. +rm -f conftest.i conftest.err conftest.$ac_ext +if $ac_preproc_ok; then : + +else + { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error $? "C preprocessor \"$CPP\" fails sanity check +See \`config.log' for more details" "$LINENO" 5; } +fi + +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for grep that handles long lines and -e" >&5 +$as_echo_n "checking for grep that handles long lines and -e... " >&6; } +if ${ac_cv_path_GREP+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -z "$GREP"; then + ac_path_GREP_found=false + # Loop through the user's path and test for each of PROGNAME-LIST + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH$PATH_SEPARATOR/usr/xpg4/bin +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_prog in grep ggrep; do + for ac_exec_ext in '' $ac_executable_extensions; do + ac_path_GREP="$as_dir/$ac_prog$ac_exec_ext" + as_fn_executable_p "$ac_path_GREP" || continue +# Check for GNU ac_path_GREP and select it if it is found. + # Check for GNU $ac_path_GREP +case `"$ac_path_GREP" --version 2>&1` in +*GNU*) + ac_cv_path_GREP="$ac_path_GREP" ac_path_GREP_found=:;; +*) + ac_count=0 + $as_echo_n 0123456789 >"conftest.in" + while : + do + cat "conftest.in" "conftest.in" >"conftest.tmp" + mv "conftest.tmp" "conftest.in" + cp "conftest.in" "conftest.nl" + $as_echo 'GREP' >> "conftest.nl" + "$ac_path_GREP" -e 'GREP$' -e '-(cannot match)-' < "conftest.nl" >"conftest.out" 2>/dev/null || break + diff "conftest.out" "conftest.nl" >/dev/null 2>&1 || break + as_fn_arith $ac_count + 1 && ac_count=$as_val + if test $ac_count -gt ${ac_path_GREP_max-0}; then + # Best one so far, save it but keep looking for a better one + ac_cv_path_GREP="$ac_path_GREP" + ac_path_GREP_max=$ac_count + fi + # 10*(2^10) chars as input seems more than enough + test $ac_count -gt 10 && break + done + rm -f conftest.in conftest.tmp conftest.nl conftest.out;; +esac + + $ac_path_GREP_found && break 3 + done + done + done +IFS=$as_save_IFS + if test -z "$ac_cv_path_GREP"; then + as_fn_error $? "no acceptable grep could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" "$LINENO" 5 + fi +else + ac_cv_path_GREP=$GREP +fi + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_path_GREP" >&5 +$as_echo "$ac_cv_path_GREP" >&6; } + GREP="$ac_cv_path_GREP" + + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for egrep" >&5 +$as_echo_n "checking for egrep... " >&6; } +if ${ac_cv_path_EGREP+:} false; then : + $as_echo_n "(cached) " >&6 +else + if echo a | $GREP -E '(a|b)' >/dev/null 2>&1 + then ac_cv_path_EGREP="$GREP -E" + else + if test -z "$EGREP"; then + ac_path_EGREP_found=false + # Loop through the user's path and test for each of PROGNAME-LIST + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH$PATH_SEPARATOR/usr/xpg4/bin +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_prog in egrep; do + for ac_exec_ext in '' $ac_executable_extensions; do + ac_path_EGREP="$as_dir/$ac_prog$ac_exec_ext" + as_fn_executable_p "$ac_path_EGREP" || continue +# Check for GNU ac_path_EGREP and select it if it is found. + # Check for GNU $ac_path_EGREP +case `"$ac_path_EGREP" --version 2>&1` in +*GNU*) + ac_cv_path_EGREP="$ac_path_EGREP" ac_path_EGREP_found=:;; +*) + ac_count=0 + $as_echo_n 0123456789 >"conftest.in" + while : + do + cat "conftest.in" "conftest.in" >"conftest.tmp" + mv "conftest.tmp" "conftest.in" + cp "conftest.in" "conftest.nl" + $as_echo 'EGREP' >> "conftest.nl" + "$ac_path_EGREP" 'EGREP$' < "conftest.nl" >"conftest.out" 2>/dev/null || break + diff "conftest.out" "conftest.nl" >/dev/null 2>&1 || break + as_fn_arith $ac_count + 1 && ac_count=$as_val + if test $ac_count -gt ${ac_path_EGREP_max-0}; then + # Best one so far, save it but keep looking for a better one + ac_cv_path_EGREP="$ac_path_EGREP" + ac_path_EGREP_max=$ac_count + fi + # 10*(2^10) chars as input seems more than enough + test $ac_count -gt 10 && break + done + rm -f conftest.in conftest.tmp conftest.nl conftest.out;; +esac + + $ac_path_EGREP_found && break 3 + done + done + done +IFS=$as_save_IFS + if test -z "$ac_cv_path_EGREP"; then + as_fn_error $? "no acceptable egrep could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" "$LINENO" 5 + fi +else + ac_cv_path_EGREP=$EGREP +fi + + fi +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_path_EGREP" >&5 +$as_echo "$ac_cv_path_EGREP" >&6; } + EGREP="$ac_cv_path_EGREP" + + +if test $ac_cv_c_compiler_gnu = yes; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $CC needs -traditional" >&5 +$as_echo_n "checking whether $CC needs -traditional... " >&6; } +if ${ac_cv_prog_gcc_traditional+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_pattern="Autoconf.*'x'" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <sgtty.h> +Autoconf TIOCGETP +_ACEOF +if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | + $EGREP "$ac_pattern" >/dev/null 2>&1; then : + ac_cv_prog_gcc_traditional=yes +else + ac_cv_prog_gcc_traditional=no +fi +rm -f conftest* + + + if test $ac_cv_prog_gcc_traditional = no; then + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <termio.h> +Autoconf TCGETA +_ACEOF +if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | + $EGREP "$ac_pattern" >/dev/null 2>&1; then : + ac_cv_prog_gcc_traditional=yes +fi +rm -f conftest* + + fi +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_gcc_traditional" >&5 +$as_echo "$ac_cv_prog_gcc_traditional" >&6; } + if test $ac_cv_prog_gcc_traditional = yes; then + CC="$CC -traditional" + fi +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for ANSI C header files" >&5 +$as_echo_n "checking for ANSI C header files... " >&6; } +if ${ac_cv_header_stdc+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <stdlib.h> +#include <stdarg.h> +#include <string.h> +#include <float.h> + +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_cv_header_stdc=yes +else + ac_cv_header_stdc=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + +if test $ac_cv_header_stdc = yes; then + # SunOS 4.x string.h does not declare mem*, contrary to ANSI. + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <string.h> + +_ACEOF +if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | + $EGREP "memchr" >/dev/null 2>&1; then : + +else + 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 confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <stdlib.h> + +_ACEOF +if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | + $EGREP "free" >/dev/null 2>&1; then : + +else + 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 confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <ctype.h> +#include <stdlib.h> +#if ((' ' & 0x0FF) == 0x020) +# define ISLOWER(c) ('a' <= (c) && (c) <= 'z') +# define TOUPPER(c) (ISLOWER(c) ? 'A' + ((c) - 'a') : (c)) +#else +# define ISLOWER(c) \ + (('a' <= (c) && (c) <= 'i') \ + || ('j' <= (c) && (c) <= 'r') \ + || ('s' <= (c) && (c) <= 'z')) +# define TOUPPER(c) (ISLOWER(c) ? ((c) | 0x40) : (c)) +#endif + +#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)) + return 2; + return 0; +} +_ACEOF +if ac_fn_c_try_run "$LINENO"; then : + +else + ac_cv_header_stdc=no +fi +rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ + conftest.$ac_objext conftest.beam conftest.$ac_ext +fi + +fi +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_header_stdc" >&5 +$as_echo "$ac_cv_header_stdc" >&6; } +if test $ac_cv_header_stdc = yes; then + +$as_echo "#define STDC_HEADERS 1" >>confdefs.h + +fi + +# On IRIX 5.3, sys/types and inttypes.h are conflicting. +for ac_header in sys/types.h sys/stat.h stdlib.h string.h memory.h strings.h \ + inttypes.h stdint.h unistd.h +do : + as_ac_Header=`$as_echo "ac_cv_header_$ac_header" | $as_tr_sh` +ac_fn_c_check_header_compile "$LINENO" "$ac_header" "$as_ac_Header" "$ac_includes_default +" +if eval test \"x\$"$as_ac_Header"\" = x"yes"; then : + cat >>confdefs.h <<_ACEOF +#define `$as_echo "HAVE_$ac_header" | $as_tr_cpp` 1 +_ACEOF + +fi + +done + + + + ac_fn_c_check_header_mongrel "$LINENO" "minix/config.h" "ac_cv_header_minix_config_h" "$ac_includes_default" +if test "x$ac_cv_header_minix_config_h" = xyes; then : + MINIX=yes +else + MINIX= +fi + + + if test "$MINIX" = yes; then + +$as_echo "#define _POSIX_SOURCE 1" >>confdefs.h + + +$as_echo "#define _POSIX_1_SOURCE 2" >>confdefs.h + + +$as_echo "#define _MINIX 1" >>confdefs.h + + fi + + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether it is safe to define __EXTENSIONS__" >&5 +$as_echo_n "checking whether it is safe to define __EXTENSIONS__... " >&6; } +if ${ac_cv_safe_to_define___extensions__+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +# define __EXTENSIONS__ 1 + $ac_includes_default +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_cv_safe_to_define___extensions__=yes +else + ac_cv_safe_to_define___extensions__=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_safe_to_define___extensions__" >&5 +$as_echo "$ac_cv_safe_to_define___extensions__" >&6; } + test $ac_cv_safe_to_define___extensions__ = yes && + $as_echo "#define __EXTENSIONS__ 1" >>confdefs.h + + $as_echo "#define _ALL_SOURCE 1" >>confdefs.h + + $as_echo "#define _GNU_SOURCE 1" >>confdefs.h + + $as_echo "#define _POSIX_PTHREAD_SEMANTICS 1" >>confdefs.h + + $as_echo "#define _TANDEM_SOURCE 1" >>confdefs.h + + + ## see note above + +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking how to run the C preprocessor" >&5 +$as_echo_n "checking how to run the C preprocessor... " >&6; } +# On Suns, sometimes $CPP names a directory. +if test -n "$CPP" && test -d "$CPP"; then + CPP= +fi +if test -z "$CPP"; then + if ${ac_cv_prog_CPP+:} false; then : + $as_echo_n "(cached) " >&6 +else + # Double quotes because CPP needs to be expanded + for CPP in "$CC -E" "$CC -E -traditional-cpp" "/lib/cpp" + do + ac_preproc_ok=false +for ac_c_preproc_warn_flag in '' yes +do + # Use a header file that comes with gcc, so configuring glibc + # with a fresh cross-compiler works. + # Prefer <limits.h> to <assert.h> if __STDC__ is defined, since + # <limits.h> exists even on freestanding compilers. + # On the NeXT, cc -E runs the code through the compiler's parser, + # not just through cpp. "Syntax error" is here to catch this case. + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#ifdef __STDC__ +# include <limits.h> +#else +# include <assert.h> +#endif + Syntax error +_ACEOF +if ac_fn_c_try_cpp "$LINENO"; then : + +else + # Broken: fails on valid input. +continue +fi +rm -f conftest.err conftest.i conftest.$ac_ext + + # OK, works on sane cases. Now check whether nonexistent headers + # can be detected and how. + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <ac_nonexistent.h> +_ACEOF +if ac_fn_c_try_cpp "$LINENO"; then : + # Broken: success on invalid input. +continue +else + # Passes both tests. +ac_preproc_ok=: +break +fi +rm -f conftest.err conftest.i conftest.$ac_ext + +done +# Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped. +rm -f conftest.i conftest.err conftest.$ac_ext +if $ac_preproc_ok; then : + break +fi + + done + ac_cv_prog_CPP=$CPP + +fi + CPP=$ac_cv_prog_CPP +else + ac_cv_prog_CPP=$CPP +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $CPP" >&5 +$as_echo "$CPP" >&6; } +ac_preproc_ok=false +for ac_c_preproc_warn_flag in '' yes +do + # Use a header file that comes with gcc, so configuring glibc + # with a fresh cross-compiler works. + # Prefer <limits.h> to <assert.h> if __STDC__ is defined, since + # <limits.h> exists even on freestanding compilers. + # On the NeXT, cc -E runs the code through the compiler's parser, + # not just through cpp. "Syntax error" is here to catch this case. + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#ifdef __STDC__ +# include <limits.h> +#else +# include <assert.h> +#endif + Syntax error +_ACEOF +if ac_fn_c_try_cpp "$LINENO"; then : + +else + # Broken: fails on valid input. +continue +fi +rm -f conftest.err conftest.i conftest.$ac_ext + + # OK, works on sane cases. Now check whether nonexistent headers + # can be detected and how. + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <ac_nonexistent.h> +_ACEOF +if ac_fn_c_try_cpp "$LINENO"; then : + # Broken: success on invalid input. +continue +else + # Passes both tests. +ac_preproc_ok=: +break +fi +rm -f conftest.err conftest.i conftest.$ac_ext + +done +# Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped. +rm -f conftest.i conftest.err conftest.$ac_ext +if $ac_preproc_ok; then : + +else + { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error $? "C preprocessor \"$CPP\" fails sanity check +See \`config.log' for more details" "$LINENO" 5; } +fi + +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + + + +if test "${GCC}" = yes; then + ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ + + ; + return 0; +} +_ACEOF + if ${CPP} ${CPPFLAGS} conftest.${ac_ext} 2>&1 1>/dev/null | \ + grep 'warning:.*system directory.*/usr/local/include' >/dev/null; then + CPPFLAGS=`echo ${CPPFLAGS} | \ + sed 's|\(.*\)-I/usr/local/include *\(.*\)|\1\2|'` + fi + rm -f conftest.${ac_ext} + ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + +fi + +## see if the user set FFLAGS: used for Intel compilers below +userFFLAGS=${FFLAGS} + +CC_VERSION= +if test "${GCC}" = yes; then + CC_VERSION=`${CC} -v 2>&1 | grep "^.*g.. version" | \ + sed -e 's/^.*g.. version *//'` +fi + + +if test -n "${F77}"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: defining F77 to be ${F77}" >&5 +$as_echo "defining F77 to be ${F77}" >&6; } +else + F77= + F95_compilers="f95 fort xlf95 ifort ifc efc pgf95 lf95 gfortran ftn g95" + F90_compilers="f90 xlf90 pgf90 pghpf epcf90" + case "${host_os}" in + hpux*) + F77_compilers="g77 fort77 f77 xlf frt pgf77 cf77 fl32 af77" ;; + *) + F77_compilers="g77 f77 xlf frt pgf77 cf77 fort77 fl32 af77" ;; + esac + GCC_Fortran_compiler= + if test "${GCC}" = yes; then + case "${CC_VERSION}" in + 3.*) GCC_Fortran_compiler=g77 ;; + 4.*) GCC_Fortran_compiler=gfortran ;; + esac + fi + for ac_prog in ${GCC_Fortran_compiler} ${F95_compilers} \ + ${F90_compilers} ${F77_compilers} fc +do + # Extract the first word of "$ac_prog", so it can be a program name with args. +set dummy $ac_prog; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_F77+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$F77"; then + ac_cv_prog_F77="$F77" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_F77="$ac_prog" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +F77=$ac_cv_prog_F77 +if test -n "$F77"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $F77" >&5 +$as_echo "$F77" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + test -n "$F77" && break +done + +fi +if test -n "${F77}"; then + ## If the above 'found' a Fortran 77 compiler, we run AC_PROG_F77 as + ## this does additional testing (GNU, '-g', ...). + ac_ext=f +ac_compile='$F77 -c $FFLAGS conftest.$ac_ext >&5' +ac_link='$F77 -o conftest$ac_exeext $FFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_f77_compiler_gnu +if test -n "$ac_tool_prefix"; then + for ac_prog in g77 xlf f77 frt pgf77 cf77 fort77 fl32 af77 xlf90 f90 pgf90 pghpf epcf90 gfortran g95 xlf95 f95 fort ifort ifc efc pgfortran pgf95 lf95 ftn nagfor + do + # Extract the first word of "$ac_tool_prefix$ac_prog", so it can be a program name with args. +set dummy $ac_tool_prefix$ac_prog; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_F77+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$F77"; then + ac_cv_prog_F77="$F77" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_F77="$ac_tool_prefix$ac_prog" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +F77=$ac_cv_prog_F77 +if test -n "$F77"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $F77" >&5 +$as_echo "$F77" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + test -n "$F77" && break + done +fi +if test -z "$F77"; then + ac_ct_F77=$F77 + for ac_prog in g77 xlf f77 frt pgf77 cf77 fort77 fl32 af77 xlf90 f90 pgf90 pghpf epcf90 gfortran g95 xlf95 f95 fort ifort ifc efc pgfortran pgf95 lf95 ftn nagfor +do + # Extract the first word of "$ac_prog", so it can be a program name with args. +set dummy $ac_prog; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_ac_ct_F77+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$ac_ct_F77"; then + ac_cv_prog_ac_ct_F77="$ac_ct_F77" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_ac_ct_F77="$ac_prog" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +ac_ct_F77=$ac_cv_prog_ac_ct_F77 +if test -n "$ac_ct_F77"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_F77" >&5 +$as_echo "$ac_ct_F77" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + test -n "$ac_ct_F77" && break +done + + if test "x$ac_ct_F77" = x; then + F77="" + else + case $cross_compiling:$ac_tool_warned in +yes:) +{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 +$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} +ac_tool_warned=yes ;; +esac + F77=$ac_ct_F77 + fi +fi + + +# Provide some information about the compiler. +$as_echo "$as_me:${as_lineno-$LINENO}: checking for Fortran 77 compiler version" >&5 +set X $ac_compile +ac_compiler=$2 +for ac_option in --version -v -V -qversion; do + { { ac_try="$ac_compiler $ac_option >&5" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_compiler $ac_option >&5") 2>conftest.err + ac_status=$? + if test -s conftest.err; then + sed '10a\ +... rest of stderr output deleted ... + 10q' conftest.err >conftest.er1 + cat conftest.er1 >&5 + fi + rm -f conftest.er1 conftest.err + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } +done +rm -f a.out + +# If we don't use `.F' as extension, the preprocessor is not run on the +# input file. (Note that this only needs to work for GNU compilers.) +ac_save_ext=$ac_ext +ac_ext=F +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether we are using the GNU Fortran 77 compiler" >&5 +$as_echo_n "checking whether we are using the GNU Fortran 77 compiler... " >&6; } +if ${ac_cv_f77_compiler_gnu+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat > conftest.$ac_ext <<_ACEOF + program main +#ifndef __GNUC__ + choke me +#endif + + end +_ACEOF +if ac_fn_f77_try_compile "$LINENO"; then : + ac_compiler_gnu=yes +else + ac_compiler_gnu=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +ac_cv_f77_compiler_gnu=$ac_compiler_gnu + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_f77_compiler_gnu" >&5 +$as_echo "$ac_cv_f77_compiler_gnu" >&6; } +ac_ext=$ac_save_ext +ac_test_FFLAGS=${FFLAGS+set} +ac_save_FFLAGS=$FFLAGS +FFLAGS= +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $F77 accepts -g" >&5 +$as_echo_n "checking whether $F77 accepts -g... " >&6; } +if ${ac_cv_prog_f77_g+:} false; then : + $as_echo_n "(cached) " >&6 +else + FFLAGS=-g +cat > conftest.$ac_ext <<_ACEOF + program main + + end +_ACEOF +if ac_fn_f77_try_compile "$LINENO"; then : + ac_cv_prog_f77_g=yes +else + ac_cv_prog_f77_g=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_f77_g" >&5 +$as_echo "$ac_cv_prog_f77_g" >&6; } +if test "$ac_test_FFLAGS" = set; then + FFLAGS=$ac_save_FFLAGS +elif test $ac_cv_prog_f77_g = yes; then + if test "x$ac_cv_f77_compiler_gnu" = xyes; then + FFLAGS="-g -O2" + else + FFLAGS="-g" + fi +else + if test "x$ac_cv_f77_compiler_gnu" = xyes; then + FFLAGS="-O2" + else + FFLAGS= + fi +fi + +if test $ac_compiler_gnu = yes; then + G77=yes +else + G77= +fi +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + +else + as_fn_error $? "No F77 compiler found" "$LINENO" 5 +fi + + +ac_ext=cpp +ac_cpp='$CXXCPP $CPPFLAGS' +ac_compile='$CXX -c $CXXFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CXX -o conftest$ac_exeext $CXXFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_cxx_compiler_gnu +if test -z "$CXX"; then + if test -n "$CCC"; then + CXX=$CCC + else + if test -n "$ac_tool_prefix"; then + for ac_prog in g++ c++ gpp aCC CC cxx cc++ cl.exe FCC KCC RCC xlC_r xlC + do + # Extract the first word of "$ac_tool_prefix$ac_prog", so it can be a program name with args. +set dummy $ac_tool_prefix$ac_prog; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_CXX+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$CXX"; then + ac_cv_prog_CXX="$CXX" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_CXX="$ac_tool_prefix$ac_prog" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +CXX=$ac_cv_prog_CXX +if test -n "$CXX"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CXX" >&5 +$as_echo "$CXX" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + test -n "$CXX" && break + done +fi +if test -z "$CXX"; then + ac_ct_CXX=$CXX + for ac_prog in g++ c++ gpp aCC CC cxx cc++ cl.exe FCC KCC RCC xlC_r xlC +do + # Extract the first word of "$ac_prog", so it can be a program name with args. +set dummy $ac_prog; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_ac_ct_CXX+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$ac_ct_CXX"; then + ac_cv_prog_ac_ct_CXX="$ac_ct_CXX" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_ac_ct_CXX="$ac_prog" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +ac_ct_CXX=$ac_cv_prog_ac_ct_CXX +if test -n "$ac_ct_CXX"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_CXX" >&5 +$as_echo "$ac_ct_CXX" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + test -n "$ac_ct_CXX" && break +done + + if test "x$ac_ct_CXX" = x; then + CXX="g++" + else + case $cross_compiling:$ac_tool_warned in +yes:) +{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 +$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} +ac_tool_warned=yes ;; +esac + CXX=$ac_ct_CXX + fi +fi + + fi +fi +# Provide some information about the compiler. +$as_echo "$as_me:${as_lineno-$LINENO}: checking for C++ compiler version" >&5 +set X $ac_compile +ac_compiler=$2 +for ac_option in --version -v -V -qversion; do + { { ac_try="$ac_compiler $ac_option >&5" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_compiler $ac_option >&5") 2>conftest.err + ac_status=$? + if test -s conftest.err; then + sed '10a\ +... rest of stderr output deleted ... + 10q' conftest.err >conftest.er1 + cat conftest.er1 >&5 + fi + rm -f conftest.er1 conftest.err + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } +done + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether we are using the GNU C++ compiler" >&5 +$as_echo_n "checking whether we are using the GNU C++ compiler... " >&6; } +if ${ac_cv_cxx_compiler_gnu+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ +#ifndef __GNUC__ + choke me +#endif + + ; + return 0; +} +_ACEOF +if ac_fn_cxx_try_compile "$LINENO"; then : + ac_compiler_gnu=yes +else + ac_compiler_gnu=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +ac_cv_cxx_compiler_gnu=$ac_compiler_gnu + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_cxx_compiler_gnu" >&5 +$as_echo "$ac_cv_cxx_compiler_gnu" >&6; } +if test $ac_compiler_gnu = yes; then + GXX=yes +else + GXX= +fi +ac_test_CXXFLAGS=${CXXFLAGS+set} +ac_save_CXXFLAGS=$CXXFLAGS +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $CXX accepts -g" >&5 +$as_echo_n "checking whether $CXX accepts -g... " >&6; } +if ${ac_cv_prog_cxx_g+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_save_cxx_werror_flag=$ac_cxx_werror_flag + ac_cxx_werror_flag=yes + ac_cv_prog_cxx_g=no + CXXFLAGS="-g" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_cxx_try_compile "$LINENO"; then : + ac_cv_prog_cxx_g=yes +else + CXXFLAGS="" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_cxx_try_compile "$LINENO"; then : + +else + ac_cxx_werror_flag=$ac_save_cxx_werror_flag + CXXFLAGS="-g" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_cxx_try_compile "$LINENO"; then : + ac_cv_prog_cxx_g=yes +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + ac_cxx_werror_flag=$ac_save_cxx_werror_flag +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cxx_g" >&5 +$as_echo "$ac_cv_prog_cxx_g" >&6; } +if test "$ac_test_CXXFLAGS" = set; then + CXXFLAGS=$ac_save_CXXFLAGS +elif test $ac_cv_prog_cxx_g = yes; then + if test "$GXX" = yes; then + CXXFLAGS="-g -O2" + else + CXXFLAGS="-g" + fi +else + if test "$GXX" = yes; then + CXXFLAGS="-O2" + else + CXXFLAGS= + fi +fi +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + +## check this actually compiles + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether ${CXX} ${CXXFLAGS} can compile C++ code" >&5 +$as_echo_n "checking whether ${CXX} ${CXXFLAGS} can compile C++ code... " >&6; } +if ${r_cv_prog_cxx+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_ext=cpp +ac_cpp='$CXXCPP $CPPFLAGS' +ac_compile='$CXX -c $CXXFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CXX -o conftest$ac_exeext $CXXFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_cxx_compiler_gnu +r_save_CXX="${CXX}" +CXX="${CXX} ${CXXSTD}" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#ifndef __cplusplus +# error "not a C++ compiler" +#endif +#include <cmath> + +_ACEOF +if ac_fn_cxx_try_compile "$LINENO"; then : + r_cv_prog_cxx=yes +else + r_cv_prog_cxx=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +CXX="${r_save_CXX}" +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $r_cv_prog_cxx" >&5 +$as_echo "$r_cv_prog_cxx" >&6; } +if test "${r_cv_prog_cxx}" = no; then + CXX= + CXXFLAGS= + CXXSTD= +fi + + +### R_PROG_CXX98FLAG + +ac_ext=cpp +ac_cpp='$CXXCPP $CPPFLAGS' +ac_compile='$CXX -c $CXXFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CXX -o conftest$ac_exeext $CXXFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_cxx_compiler_gnu +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking how to run the C++ preprocessor" >&5 +$as_echo_n "checking how to run the C++ preprocessor... " >&6; } +if test -z "$CXXCPP"; then + if ${ac_cv_prog_CXXCPP+:} false; then : + $as_echo_n "(cached) " >&6 +else + # Double quotes because CXXCPP needs to be expanded + for CXXCPP in "$CXX -E" "/lib/cpp" + do + ac_preproc_ok=false +for ac_cxx_preproc_warn_flag in '' yes +do + # Use a header file that comes with gcc, so configuring glibc + # with a fresh cross-compiler works. + # Prefer <limits.h> to <assert.h> if __STDC__ is defined, since + # <limits.h> exists even on freestanding compilers. + # On the NeXT, cc -E runs the code through the compiler's parser, + # not just through cpp. "Syntax error" is here to catch this case. + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#ifdef __STDC__ +# include <limits.h> +#else +# include <assert.h> +#endif + Syntax error +_ACEOF +if ac_fn_cxx_try_cpp "$LINENO"; then : + +else + # Broken: fails on valid input. +continue +fi +rm -f conftest.err conftest.i conftest.$ac_ext + + # OK, works on sane cases. Now check whether nonexistent headers + # can be detected and how. + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <ac_nonexistent.h> +_ACEOF +if ac_fn_cxx_try_cpp "$LINENO"; then : + # Broken: success on invalid input. +continue +else + # Passes both tests. +ac_preproc_ok=: +break +fi +rm -f conftest.err conftest.i conftest.$ac_ext + +done +# Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped. +rm -f conftest.i conftest.err conftest.$ac_ext +if $ac_preproc_ok; then : + break +fi + + done + ac_cv_prog_CXXCPP=$CXXCPP + +fi + CXXCPP=$ac_cv_prog_CXXCPP +else + ac_cv_prog_CXXCPP=$CXXCPP +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $CXXCPP" >&5 +$as_echo "$CXXCPP" >&6; } +ac_preproc_ok=false +for ac_cxx_preproc_warn_flag in '' yes +do + # Use a header file that comes with gcc, so configuring glibc + # with a fresh cross-compiler works. + # Prefer <limits.h> to <assert.h> if __STDC__ is defined, since + # <limits.h> exists even on freestanding compilers. + # On the NeXT, cc -E runs the code through the compiler's parser, + # not just through cpp. "Syntax error" is here to catch this case. + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#ifdef __STDC__ +# include <limits.h> +#else +# include <assert.h> +#endif + Syntax error +_ACEOF +if ac_fn_cxx_try_cpp "$LINENO"; then : + +else + # Broken: fails on valid input. +continue +fi +rm -f conftest.err conftest.i conftest.$ac_ext + + # OK, works on sane cases. Now check whether nonexistent headers + # can be detected and how. + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <ac_nonexistent.h> +_ACEOF +if ac_fn_cxx_try_cpp "$LINENO"; then : + # Broken: success on invalid input. +continue +else + # Passes both tests. +ac_preproc_ok=: +break +fi +rm -f conftest.err conftest.i conftest.$ac_ext + +done +# Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped. +rm -f conftest.i conftest.err conftest.$ac_ext +if $ac_preproc_ok; then : + +else + { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error $? "C++ preprocessor \"$CXXCPP\" fails sanity check +See \`config.log' for more details" "$LINENO" 5; } +fi + +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + +if test "${CXXCPP}" = "${CXX} -E"; then + CXXCPP0="\$(CXX) -E" +else + CXXCPP0=${CXXCPP} +fi + + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether __attribute__((visibility())) is supported" >&5 +$as_echo_n "checking whether __attribute__((visibility())) is supported... " >&6; } +if ${r_cv_visibility_attribute+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat > conftest.c <<EOF +int foo __attribute__ ((visibility ("hidden"))) = 1; +int bar __attribute__ ((visibility ("default"))) = 1; +#ifndef __GNUC__ +# error unsupported compiler +#endif +EOF +r_cv_visibility_attribute=no +if { ac_try='${CC-cc} -Werror -S conftest.c -o conftest.s 1>&5' + { { eval echo "\"\$as_me\":${as_lineno-$LINENO}: \"$ac_try\""; } >&5 + (eval $ac_try) 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; }; }; then + if grep '\.hidden.*foo' conftest.s >/dev/null; then + r_cv_visibility_attribute=yes + fi +fi +rm -f conftest.cs + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $r_cv_visibility_attribute" >&5 +$as_echo "$r_cv_visibility_attribute" >&6; } +if test $r_cv_visibility_attribute = yes; then + +$as_echo "#define HAVE_VISIBILITY_ATTRIBUTE 1" >>confdefs.h + +fi +## test if visibility flag is accepted: NB Solaris compilers do and ignore, +## so only make use of this if HAVE_VISIBILITY_ATTRIBUTE is true. +r_save_CFLAGS=$CFLAGS +CFLAGS="$CFLAGS -fvisibility=hidden" +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $CC accepts -fvisibility" >&5 +$as_echo_n "checking whether $CC accepts -fvisibility... " >&6; } +if ${r_cv_prog_cc_vis+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + r_cv_prog_cc_vis=yes +else + r_cv_prog_cc_vis=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $r_cv_prog_cc_vis" >&5 +$as_echo "$r_cv_prog_cc_vis" >&6; } +CFLAGS=$r_save_CFLAGS +if test "${r_cv_prog_cc_vis}" = yes; then + if test "${r_cv_visibility_attribute}" = yes; then + C_VISIBILITY="-fvisibility=hidden" + fi +fi +## Need to exclude Intel compilers, where this does not work correctly. +## The flag is documented and is effective, but also hides +## unsatisfied references. We cannot test for GCC, as icc passes that test. +case "${CC}" in + ## Intel compiler: note that -c99 may have been appended + *icc*) + C_VISIBILITY= + ;; +esac + +ac_ext=f +ac_compile='$F77 -c $FFLAGS conftest.$ac_ext >&5' +ac_link='$F77 -o conftest$ac_exeext $FFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_f77_compiler_gnu + +r_save_FFLAGS=$FFLAGS +FFLAGS="$FFLAGS -fvisibility=hidden" +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $F77 accepts -fvisibility" >&5 +$as_echo_n "checking whether $F77 accepts -fvisibility... " >&6; } +if ${r_cv_prog_f77_vis+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat > conftest.$ac_ext <<_ACEOF + program main + + end +_ACEOF +if ac_fn_f77_try_compile "$LINENO"; then : + r_cv_prog_f77_vis=yes +else + r_cv_prog_f77_vis=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $r_cv_prog_f77_vis" >&5 +$as_echo "$r_cv_prog_f77_vis" >&6; } +FFLAGS=$r_save_FFLAGS +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + +if test "${r_cv_prog_f77_vis}" = yes; then + if test "${r_cv_visibility_attribute}" = yes; then + F77_VISIBILITY="-fvisibility=hidden" + fi +fi +## need to exclude Intel compilers. +case "${F77}" in + ## Intel compiler + *ifc|*ifort) + F77_VISIBILITY= + ;; +esac + + + +ac_ext=m +ac_cpp='$OBJCPP $CPPFLAGS' +ac_compile='$OBJC -c $OBJCFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$OBJC -o conftest$ac_exeext $OBJCFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_objc_compiler_gnu +if test -n "$ac_tool_prefix"; then + for ac_prog in gcc objcc objc cc CC + do + # Extract the first word of "$ac_tool_prefix$ac_prog", so it can be a program name with args. +set dummy $ac_tool_prefix$ac_prog; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_OBJC+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$OBJC"; then + ac_cv_prog_OBJC="$OBJC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_OBJC="$ac_tool_prefix$ac_prog" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +OBJC=$ac_cv_prog_OBJC +if test -n "$OBJC"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $OBJC" >&5 +$as_echo "$OBJC" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + test -n "$OBJC" && break + done +fi +if test -z "$OBJC"; then + ac_ct_OBJC=$OBJC + for ac_prog in gcc objcc objc cc CC +do + # Extract the first word of "$ac_prog", so it can be a program name with args. +set dummy $ac_prog; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_ac_ct_OBJC+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$ac_ct_OBJC"; then + ac_cv_prog_ac_ct_OBJC="$ac_ct_OBJC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_ac_ct_OBJC="$ac_prog" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +ac_ct_OBJC=$ac_cv_prog_ac_ct_OBJC +if test -n "$ac_ct_OBJC"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_OBJC" >&5 +$as_echo "$ac_ct_OBJC" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + test -n "$ac_ct_OBJC" && break +done + + if test "x$ac_ct_OBJC" = x; then + OBJC="gcc" + else + case $cross_compiling:$ac_tool_warned in +yes:) +{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 +$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} +ac_tool_warned=yes ;; +esac + OBJC=$ac_ct_OBJC + fi +fi + +# Provide some information about the compiler. +$as_echo "$as_me:${as_lineno-$LINENO}: checking for Objective C compiler version" >&5 +set X $ac_compile +ac_compiler=$2 +for ac_option in --version -v -V -qversion; do + { { ac_try="$ac_compiler $ac_option >&5" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_compiler $ac_option >&5") 2>conftest.err + ac_status=$? + if test -s conftest.err; then + sed '10a\ +... rest of stderr output deleted ... + 10q' conftest.err >conftest.er1 + cat conftest.er1 >&5 + fi + rm -f conftest.er1 conftest.err + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } +done + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether we are using the GNU Objective C compiler" >&5 +$as_echo_n "checking whether we are using the GNU Objective C compiler... " >&6; } +if ${ac_cv_objc_compiler_gnu+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ +#ifndef __GNUC__ + choke me +#endif + + ; + return 0; +} +_ACEOF +if ac_fn_objc_try_compile "$LINENO"; then : + ac_compiler_gnu=yes +else + ac_compiler_gnu=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +ac_cv_objc_compiler_gnu=$ac_compiler_gnu + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_objc_compiler_gnu" >&5 +$as_echo "$ac_cv_objc_compiler_gnu" >&6; } +if test $ac_compiler_gnu = yes; then + GOBJC=yes +else + GOBJC= +fi +ac_test_OBJCFLAGS=${OBJCFLAGS+set} +ac_save_OBJCFLAGS=$OBJCFLAGS +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $OBJC accepts -g" >&5 +$as_echo_n "checking whether $OBJC accepts -g... " >&6; } +if ${ac_cv_prog_objc_g+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_save_objc_werror_flag=$ac_objc_werror_flag + ac_objc_werror_flag=yes + ac_cv_prog_objc_g=no + OBJCFLAGS="-g" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_objc_try_compile "$LINENO"; then : + ac_cv_prog_objc_g=yes +else + OBJCFLAGS="" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_objc_try_compile "$LINENO"; then : + +else + ac_objc_werror_flag=$ac_save_objc_werror_flag + OBJCFLAGS="-g" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_objc_try_compile "$LINENO"; then : + ac_cv_prog_objc_g=yes +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + ac_objc_werror_flag=$ac_save_objc_werror_flag +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_objc_g" >&5 +$as_echo "$ac_cv_prog_objc_g" >&6; } +if test "$ac_test_OBJCFLAGS" = set; then + OBJCFLAGS=$ac_save_OBJCFLAGS +elif test $ac_cv_prog_objc_g = yes; then + if test "$GOBJC" = yes; then + OBJCFLAGS="-g -O2" + else + OBJCFLAGS="-g" + fi +else + if test "$GOBJC" = yes; then + OBJCFLAGS="-O2" + else + OBJCFLAGS= + fi +fi +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + +## unfortunately autoconf sets OBJC to gcc even if there is no working compiler +if test "${OBJC}" = gcc; then + ac_ext=m +ac_cpp='$OBJCPP $CPPFLAGS' +ac_compile='$OBJC -c $OBJCFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$OBJC -o conftest$ac_exeext $OBJCFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_objc_compiler_gnu + + +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ +id foo; + ; + return 0; +} +_ACEOF +if ac_fn_objc_try_compile "$LINENO"; then : + +else + OBJC='' +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + +fi + + + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for Objective C++ compiler" >&5 +$as_echo_n "checking for Objective C++ compiler... " >&6; } +if ${r_cv_OBJCXX+:} false; then : + $as_echo_n "(cached) " >&6 +else + +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: trying some possibilities" >&5 +$as_echo "trying some possibilities" >&6; } +if test -n "${OBJCXX}"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether ${OBJCXX} can compile ObjC++" >&5 +$as_echo_n "checking whether ${OBJCXX} can compile ObjC++... " >&6; } +## we don't use AC_LANG_xx because ObjC++ is not defined as a language (yet) +## (the test program is from the gcc test suite) +## but it needed an #undef (PR#15107) +cat << \EOF > conftest.mm +#undef __OBJC2__ +#include <objc/Object.h> +#include <iostream> + +@interface Greeter : Object +- (void) greet: (const char *)msg; +@end + +@implementation Greeter +- (void) greet: (const char *)msg { std::cout << msg; } +@end + +int +main () +{ + std::cout << "Hello from C++\n"; + Greeter *obj = [Greeter new]; + [obj greet: "Hello from Objective-C\n"]; +} +EOF +echo "running: ${OBJCXX} -c conftest.mm ${CPPFLAGS} ${OBJCXXFLAGS}" >&5 +if ${OBJCXX} -c conftest.mm ${CPPFLAGS} ${OBJCXXFLAGS} >&5 2>&1; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +$as_echo "yes" >&6; } + rm -rf conftest conftest.* core + OBJCXX=${OBJCXX} +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } + rm -f conftest.mm + OBJCXX='' +fi + +fi +# try the sequence $OBJCXX, $CXX, $OBJC +if test -z "${OBJCXX}"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether ${CXX} can compile ObjC++" >&5 +$as_echo_n "checking whether ${CXX} can compile ObjC++... " >&6; } +## we don't use AC_LANG_xx because ObjC++ is not defined as a language (yet) +## (the test program is from the gcc test suite) +## but it needed an #undef (PR#15107) +cat << \EOF > conftest.mm +#undef __OBJC2__ +#include <objc/Object.h> +#include <iostream> + +@interface Greeter : Object +- (void) greet: (const char *)msg; +@end + +@implementation Greeter +- (void) greet: (const char *)msg { std::cout << msg; } +@end + +int +main () +{ + std::cout << "Hello from C++\n"; + Greeter *obj = [Greeter new]; + [obj greet: "Hello from Objective-C\n"]; +} +EOF +echo "running: ${CXX} -c conftest.mm ${CPPFLAGS} ${OBJCXXFLAGS}" >&5 +if ${CXX} -c conftest.mm ${CPPFLAGS} ${OBJCXXFLAGS} >&5 2>&1; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +$as_echo "yes" >&6; } + rm -rf conftest conftest.* core + OBJCXX=${CXX} +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } + rm -f conftest.mm + if test -z "${OBJC}"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether ${OBJC} can compile ObjC++" >&5 +$as_echo_n "checking whether ${OBJC} can compile ObjC++... " >&6; } +## we don't use AC_LANG_xx because ObjC++ is not defined as a language (yet) +## (the test program is from the gcc test suite) +## but it needed an #undef (PR#15107) +cat << \EOF > conftest.mm +#undef __OBJC2__ +#include <objc/Object.h> +#include <iostream> + +@interface Greeter : Object +- (void) greet: (const char *)msg; +@end + +@implementation Greeter +- (void) greet: (const char *)msg { std::cout << msg; } +@end + +int +main () +{ + std::cout << "Hello from C++\n"; + Greeter *obj = [Greeter new]; + [obj greet: "Hello from Objective-C\n"]; +} +EOF +echo "running: ${OBJC} -c conftest.mm ${CPPFLAGS} ${OBJCXXFLAGS}" >&5 +if ${OBJC} -c conftest.mm ${CPPFLAGS} ${OBJCXXFLAGS} >&5 2>&1; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +$as_echo "yes" >&6; } + rm -rf conftest conftest.* core + OBJCXX=${OBJC} +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } + rm -f conftest.mm + +fi + + fi + +fi + +fi +r_cv_OBJCXX="${OBJCXX}" + +fi + +OBJCXX="${r_cv_OBJCXX}" +if test -z "${OBJCXX}"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no working ObjC++ compiler found" >&5 +$as_echo "no working ObjC++ compiler found" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: ${OBJCXX}" >&5 +$as_echo "${OBJCXX}" >&6; } +fi + + + +## This has to be R_DEFS as autoconf overrrides DEFS +R_DEFS=${DEFS} + + +## Libtool. +## (Run this after R_PROG_F77, as AC_PROG_LIBTOOL checks for a +## Fortran 77 compiler and sets F77 accordingly.) +# Check whether --enable-static was given. +if test "${enable_static+set}" = set; then : + enableval=$enable_static; p=${PACKAGE-default} + case $enableval in + yes) enable_static=yes ;; + no) enable_static=no ;; + *) + enable_static=no + # Look at the argument we got. We use all the common list separators. + lt_save_ifs=$IFS; IFS=$IFS$PATH_SEPARATOR, + for pkg in $enableval; do + IFS=$lt_save_ifs + if test "X$pkg" = "X$p"; then + enable_static=yes + fi + done + IFS=$lt_save_ifs + ;; + esac +else + enable_static=no +fi + + + + + + + + + +case `pwd` in + *\ * | *\ *) + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: Libtool does not cope well with whitespace in \`pwd\`" >&5 +$as_echo "$as_me: WARNING: Libtool does not cope well with whitespace in \`pwd\`" >&2;} ;; +esac + + + +macro_version='2.4.6' +macro_revision='2.4.6' + + + + + + + + + + + + + +ltmain=$ac_aux_dir/ltmain.sh + +# Backslashify metacharacters that are still active within +# double-quoted strings. +sed_quote_subst='s/\(["`$\\]\)/\\\1/g' + +# Same as above, but do not quote variable references. +double_quote_subst='s/\(["`\\]\)/\\\1/g' + +# Sed substitution to delay expansion of an escaped shell variable in a +# double_quote_subst'ed string. +delay_variable_subst='s/\\\\\\\\\\\$/\\\\\\$/g' + +# Sed substitution to delay expansion of an escaped single quote. +delay_single_quote_subst='s/'\''/'\'\\\\\\\'\''/g' + +# Sed substitution to avoid accidental globbing in evaled expressions +no_glob_subst='s/\*/\\\*/g' + +ECHO='\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\' +ECHO=$ECHO$ECHO$ECHO$ECHO$ECHO +ECHO=$ECHO$ECHO$ECHO$ECHO$ECHO$ECHO + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking how to print strings" >&5 +$as_echo_n "checking how to print strings... " >&6; } +# Test print first, because it will be a builtin if present. +if test "X`( print -r -- -n ) 2>/dev/null`" = X-n && \ + test "X`print -r -- $ECHO 2>/dev/null`" = "X$ECHO"; then + ECHO='print -r --' +elif test "X`printf %s $ECHO 2>/dev/null`" = "X$ECHO"; then + ECHO='printf %s\n' +else + # Use this function as a fallback that always works. + func_fallback_echo () + { + eval 'cat <<_LTECHO_EOF +$1 +_LTECHO_EOF' + } + ECHO='func_fallback_echo' +fi + +# func_echo_all arg... +# Invoke $ECHO with all args, space-separated. +func_echo_all () +{ + $ECHO "" +} + +case $ECHO in + printf*) { $as_echo "$as_me:${as_lineno-$LINENO}: result: printf" >&5 +$as_echo "printf" >&6; } ;; + print*) { $as_echo "$as_me:${as_lineno-$LINENO}: result: print -r" >&5 +$as_echo "print -r" >&6; } ;; + *) { $as_echo "$as_me:${as_lineno-$LINENO}: result: cat" >&5 +$as_echo "cat" >&6; } ;; +esac + + + + + + + + + + + + + + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for a sed that does not truncate output" >&5 +$as_echo_n "checking for a sed that does not truncate output... " >&6; } +if ${ac_cv_path_SED+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_script=s/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa/bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb/ + for ac_i in 1 2 3 4 5 6 7; do + ac_script="$ac_script$as_nl$ac_script" + done + echo "$ac_script" 2>/dev/null | sed 99q >conftest.sed + { ac_script=; unset ac_script;} + if test -z "$SED"; then + ac_path_SED_found=false + # Loop through the user's path and test for each of PROGNAME-LIST + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_prog in sed gsed; do + for ac_exec_ext in '' $ac_executable_extensions; do + ac_path_SED="$as_dir/$ac_prog$ac_exec_ext" + as_fn_executable_p "$ac_path_SED" || continue +# Check for GNU ac_path_SED and select it if it is found. + # Check for GNU $ac_path_SED +case `"$ac_path_SED" --version 2>&1` in +*GNU*) + ac_cv_path_SED="$ac_path_SED" ac_path_SED_found=:;; +*) + ac_count=0 + $as_echo_n 0123456789 >"conftest.in" + while : + do + cat "conftest.in" "conftest.in" >"conftest.tmp" + mv "conftest.tmp" "conftest.in" + cp "conftest.in" "conftest.nl" + $as_echo '' >> "conftest.nl" + "$ac_path_SED" -f conftest.sed < "conftest.nl" >"conftest.out" 2>/dev/null || break + diff "conftest.out" "conftest.nl" >/dev/null 2>&1 || break + as_fn_arith $ac_count + 1 && ac_count=$as_val + if test $ac_count -gt ${ac_path_SED_max-0}; then + # Best one so far, save it but keep looking for a better one + ac_cv_path_SED="$ac_path_SED" + ac_path_SED_max=$ac_count + fi + # 10*(2^10) chars as input seems more than enough + test $ac_count -gt 10 && break + done + rm -f conftest.in conftest.tmp conftest.nl conftest.out;; +esac + + $ac_path_SED_found && break 3 + done + done + done +IFS=$as_save_IFS + if test -z "$ac_cv_path_SED"; then + as_fn_error $? "no acceptable sed could be found in \$PATH" "$LINENO" 5 + fi +else + ac_cv_path_SED=$SED +fi + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_path_SED" >&5 +$as_echo "$ac_cv_path_SED" >&6; } + SED="$ac_cv_path_SED" + rm -f conftest.sed + +test -z "$SED" && SED=sed +Xsed="$SED -e 1s/^X//" + + + + + + + + + + + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for fgrep" >&5 +$as_echo_n "checking for fgrep... " >&6; } +if ${ac_cv_path_FGREP+:} false; then : + $as_echo_n "(cached) " >&6 +else + if echo 'ab*c' | $GREP -F 'ab*c' >/dev/null 2>&1 + then ac_cv_path_FGREP="$GREP -F" + else + if test -z "$FGREP"; then + ac_path_FGREP_found=false + # Loop through the user's path and test for each of PROGNAME-LIST + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH$PATH_SEPARATOR/usr/xpg4/bin +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_prog in fgrep; do + for ac_exec_ext in '' $ac_executable_extensions; do + ac_path_FGREP="$as_dir/$ac_prog$ac_exec_ext" + as_fn_executable_p "$ac_path_FGREP" || continue +# Check for GNU ac_path_FGREP and select it if it is found. + # Check for GNU $ac_path_FGREP +case `"$ac_path_FGREP" --version 2>&1` in +*GNU*) + ac_cv_path_FGREP="$ac_path_FGREP" ac_path_FGREP_found=:;; +*) + ac_count=0 + $as_echo_n 0123456789 >"conftest.in" + while : + do + cat "conftest.in" "conftest.in" >"conftest.tmp" + mv "conftest.tmp" "conftest.in" + cp "conftest.in" "conftest.nl" + $as_echo 'FGREP' >> "conftest.nl" + "$ac_path_FGREP" FGREP < "conftest.nl" >"conftest.out" 2>/dev/null || break + diff "conftest.out" "conftest.nl" >/dev/null 2>&1 || break + as_fn_arith $ac_count + 1 && ac_count=$as_val + if test $ac_count -gt ${ac_path_FGREP_max-0}; then + # Best one so far, save it but keep looking for a better one + ac_cv_path_FGREP="$ac_path_FGREP" + ac_path_FGREP_max=$ac_count + fi + # 10*(2^10) chars as input seems more than enough + test $ac_count -gt 10 && break + done + rm -f conftest.in conftest.tmp conftest.nl conftest.out;; +esac + + $ac_path_FGREP_found && break 3 + done + done + done +IFS=$as_save_IFS + if test -z "$ac_cv_path_FGREP"; then + as_fn_error $? "no acceptable fgrep could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" "$LINENO" 5 + fi +else + ac_cv_path_FGREP=$FGREP +fi + + fi +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_path_FGREP" >&5 +$as_echo "$ac_cv_path_FGREP" >&6; } + FGREP="$ac_cv_path_FGREP" + + +test -z "$GREP" && GREP=grep + + + + + + + + + + + + + + + + + + + +# Check whether --with-gnu-ld was given. +if test "${with_gnu_ld+set}" = set; then : + withval=$with_gnu_ld; test no = "$withval" || with_gnu_ld=yes +else + with_gnu_ld=no +fi + +ac_prog=ld +if test yes = "$GCC"; then + # Check if gcc -print-prog-name=ld gives a path. + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for ld used by $CC" >&5 +$as_echo_n "checking for ld used by $CC... " >&6; } + case $host in + *-*-mingw*) + # gcc leaves a trailing carriage return, which upsets mingw + ac_prog=`($CC -print-prog-name=ld) 2>&5 | tr -d '\015'` ;; + *) + ac_prog=`($CC -print-prog-name=ld) 2>&5` ;; + esac + case $ac_prog in + # Accept absolute paths. + [\\/]* | ?:[\\/]*) + re_direlt='/[^/][^/]*/\.\./' + # Canonicalize the pathname of ld + ac_prog=`$ECHO "$ac_prog"| $SED 's%\\\\%/%g'` + while $ECHO "$ac_prog" | $GREP "$re_direlt" > /dev/null 2>&1; do + ac_prog=`$ECHO $ac_prog| $SED "s%$re_direlt%/%"` + done + test -z "$LD" && LD=$ac_prog + ;; + "") + # If it fails, then pretend we aren't using GCC. + ac_prog=ld + ;; + *) + # If it is relative, then search for the first ld in PATH. + with_gnu_ld=unknown + ;; + esac +elif test yes = "$with_gnu_ld"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for GNU ld" >&5 +$as_echo_n "checking for GNU ld... " >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for non-GNU ld" >&5 +$as_echo_n "checking for non-GNU ld... " >&6; } +fi +if ${lt_cv_path_LD+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -z "$LD"; then + lt_save_ifs=$IFS; IFS=$PATH_SEPARATOR + for ac_dir in $PATH; do + IFS=$lt_save_ifs + test -z "$ac_dir" && ac_dir=. + if test -f "$ac_dir/$ac_prog" || test -f "$ac_dir/$ac_prog$ac_exeext"; then + lt_cv_path_LD=$ac_dir/$ac_prog + # Check to see if the program is GNU ld. I'd rather use --version, + # but apparently some variants of GNU ld only accept -v. + # Break only if it was the GNU/non-GNU ld that we prefer. + case `"$lt_cv_path_LD" -v 2>&1 </dev/null` in + *GNU* | *'with BFD'*) + test no != "$with_gnu_ld" && break + ;; + *) + test yes != "$with_gnu_ld" && break + ;; + esac + fi + done + IFS=$lt_save_ifs +else + lt_cv_path_LD=$LD # Let the user override the test with a path. +fi +fi + +LD=$lt_cv_path_LD +if test -n "$LD"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $LD" >&5 +$as_echo "$LD" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi +test -z "$LD" && as_fn_error $? "no acceptable ld found in \$PATH" "$LINENO" 5 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking if the linker ($LD) is GNU ld" >&5 +$as_echo_n "checking if the linker ($LD) is GNU ld... " >&6; } +if ${lt_cv_prog_gnu_ld+:} false; then : + $as_echo_n "(cached) " >&6 +else + # I'd rather use --version here, but apparently some GNU lds only accept -v. +case `$LD -v 2>&1 </dev/null` in +*GNU* | *'with BFD'*) + lt_cv_prog_gnu_ld=yes + ;; +*) + lt_cv_prog_gnu_ld=no + ;; +esac +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_prog_gnu_ld" >&5 +$as_echo "$lt_cv_prog_gnu_ld" >&6; } +with_gnu_ld=$lt_cv_prog_gnu_ld + + + + + + + + + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for BSD- or MS-compatible name lister (nm)" >&5 +$as_echo_n "checking for BSD- or MS-compatible name lister (nm)... " >&6; } +if ${lt_cv_path_NM+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$NM"; then + # Let the user override the test. + lt_cv_path_NM=$NM +else + lt_nm_to_check=${ac_tool_prefix}nm + if test -n "$ac_tool_prefix" && test "$build" = "$host"; then + lt_nm_to_check="$lt_nm_to_check nm" + fi + for lt_tmp_nm in $lt_nm_to_check; do + lt_save_ifs=$IFS; IFS=$PATH_SEPARATOR + for ac_dir in $PATH /usr/ccs/bin/elf /usr/ccs/bin /usr/ucb /bin; do + IFS=$lt_save_ifs + test -z "$ac_dir" && ac_dir=. + tmp_nm=$ac_dir/$lt_tmp_nm + if test -f "$tmp_nm" || test -f "$tmp_nm$ac_exeext"; then + # Check to see if the nm accepts a BSD-compat flag. + # Adding the 'sed 1q' prevents false positives on HP-UX, which says: + # nm: unknown option "B" ignored + # Tru64's nm complains that /dev/null is an invalid object file + # MSYS converts /dev/null to NUL, MinGW nm treats NUL as empty + case $build_os in + mingw*) lt_bad_file=conftest.nm/nofile ;; + *) lt_bad_file=/dev/null ;; + esac + case `"$tmp_nm" -B $lt_bad_file 2>&1 | sed '1q'` in + *$lt_bad_file* | *'Invalid file or object type'*) + lt_cv_path_NM="$tmp_nm -B" + break 2 + ;; + *) + case `"$tmp_nm" -p /dev/null 2>&1 | sed '1q'` in + */dev/null*) + lt_cv_path_NM="$tmp_nm -p" + break 2 + ;; + *) + lt_cv_path_NM=${lt_cv_path_NM="$tmp_nm"} # keep the first match, but + continue # so that we can try to find one that supports BSD flags + ;; + esac + ;; + esac + fi + done + IFS=$lt_save_ifs + done + : ${lt_cv_path_NM=no} +fi +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_path_NM" >&5 +$as_echo "$lt_cv_path_NM" >&6; } +if test no != "$lt_cv_path_NM"; then + NM=$lt_cv_path_NM +else + # Didn't find any BSD compatible name lister, look for dumpbin. + if test -n "$DUMPBIN"; then : + # Let the user override the test. + else + if test -n "$ac_tool_prefix"; then + for ac_prog in dumpbin "link -dump" + do + # Extract the first word of "$ac_tool_prefix$ac_prog", so it can be a program name with args. +set dummy $ac_tool_prefix$ac_prog; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_DUMPBIN+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$DUMPBIN"; then + ac_cv_prog_DUMPBIN="$DUMPBIN" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_DUMPBIN="$ac_tool_prefix$ac_prog" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +DUMPBIN=$ac_cv_prog_DUMPBIN +if test -n "$DUMPBIN"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $DUMPBIN" >&5 +$as_echo "$DUMPBIN" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + test -n "$DUMPBIN" && break + done +fi +if test -z "$DUMPBIN"; then + ac_ct_DUMPBIN=$DUMPBIN + for ac_prog in dumpbin "link -dump" +do + # Extract the first word of "$ac_prog", so it can be a program name with args. +set dummy $ac_prog; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_ac_ct_DUMPBIN+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$ac_ct_DUMPBIN"; then + ac_cv_prog_ac_ct_DUMPBIN="$ac_ct_DUMPBIN" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_ac_ct_DUMPBIN="$ac_prog" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +ac_ct_DUMPBIN=$ac_cv_prog_ac_ct_DUMPBIN +if test -n "$ac_ct_DUMPBIN"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_DUMPBIN" >&5 +$as_echo "$ac_ct_DUMPBIN" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + test -n "$ac_ct_DUMPBIN" && break +done + + if test "x$ac_ct_DUMPBIN" = x; then + DUMPBIN=":" + else + case $cross_compiling:$ac_tool_warned in +yes:) +{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 +$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} +ac_tool_warned=yes ;; +esac + DUMPBIN=$ac_ct_DUMPBIN + fi +fi + + case `$DUMPBIN -symbols -headers /dev/null 2>&1 | sed '1q'` in + *COFF*) + DUMPBIN="$DUMPBIN -symbols -headers" + ;; + *) + DUMPBIN=: + ;; + esac + fi + + if test : != "$DUMPBIN"; then + NM=$DUMPBIN + fi +fi +test -z "$NM" && NM=nm + + + + + + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking the name lister ($NM) interface" >&5 +$as_echo_n "checking the name lister ($NM) interface... " >&6; } +if ${lt_cv_nm_interface+:} false; then : + $as_echo_n "(cached) " >&6 +else + lt_cv_nm_interface="BSD nm" + echo "int some_variable = 0;" > conftest.$ac_ext + (eval echo "\"\$as_me:$LINENO: $ac_compile\"" >&5) + (eval "$ac_compile" 2>conftest.err) + cat conftest.err >&5 + (eval echo "\"\$as_me:$LINENO: $NM \\\"conftest.$ac_objext\\\"\"" >&5) + (eval "$NM \"conftest.$ac_objext\"" 2>conftest.err > conftest.out) + cat conftest.err >&5 + (eval echo "\"\$as_me:$LINENO: output\"" >&5) + cat conftest.out >&5 + if $GREP 'External.*some_variable' conftest.out > /dev/null; then + lt_cv_nm_interface="MS dumpbin" + fi + rm -f conftest* +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_nm_interface" >&5 +$as_echo "$lt_cv_nm_interface" >&6; } + +# find the maximum length of command line arguments +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking the maximum length of command line arguments" >&5 +$as_echo_n "checking the maximum length of command line arguments... " >&6; } +if ${lt_cv_sys_max_cmd_len+:} false; then : + $as_echo_n "(cached) " >&6 +else + i=0 + teststring=ABCD + + case $build_os in + msdosdjgpp*) + # On DJGPP, this test can blow up pretty badly due to problems in libc + # (any single argument exceeding 2000 bytes causes a buffer overrun + # during glob expansion). Even if it were fixed, the result of this + # check would be larger than it should be. + lt_cv_sys_max_cmd_len=12288; # 12K is about right + ;; + + gnu*) + # Under GNU Hurd, this test is not required because there is + # no limit to the length of command line arguments. + # Libtool will interpret -1 as no limit whatsoever + lt_cv_sys_max_cmd_len=-1; + ;; + + cygwin* | mingw* | cegcc*) + # On Win9x/ME, this test blows up -- it succeeds, but takes + # about 5 minutes as the teststring grows exponentially. + # Worse, since 9x/ME are not pre-emptively multitasking, + # you end up with a "frozen" computer, even though with patience + # the test eventually succeeds (with a max line length of 256k). + # Instead, let's just punt: use the minimum linelength reported by + # all of the supported platforms: 8192 (on NT/2K/XP). + lt_cv_sys_max_cmd_len=8192; + ;; + + mint*) + # On MiNT this can take a long time and run out of memory. + lt_cv_sys_max_cmd_len=8192; + ;; + + amigaos*) + # On AmigaOS with pdksh, this test takes hours, literally. + # So we just punt and use a minimum line length of 8192. + lt_cv_sys_max_cmd_len=8192; + ;; + + bitrig* | darwin* | dragonfly* | freebsd* | netbsd* | openbsd*) + # This has been around since 386BSD, at least. Likely further. + if test -x /sbin/sysctl; then + lt_cv_sys_max_cmd_len=`/sbin/sysctl -n kern.argmax` + elif test -x /usr/sbin/sysctl; then + lt_cv_sys_max_cmd_len=`/usr/sbin/sysctl -n kern.argmax` + else + lt_cv_sys_max_cmd_len=65536 # usable default for all BSDs + fi + # And add a safety zone + lt_cv_sys_max_cmd_len=`expr $lt_cv_sys_max_cmd_len \/ 4` + lt_cv_sys_max_cmd_len=`expr $lt_cv_sys_max_cmd_len \* 3` + ;; + + interix*) + # We know the value 262144 and hardcode it with a safety zone (like BSD) + lt_cv_sys_max_cmd_len=196608 + ;; + + os2*) + # The test takes a long time on OS/2. + lt_cv_sys_max_cmd_len=8192 + ;; + + osf*) + # Dr. Hans Ekkehard Plesser reports seeing a kernel panic running configure + # due to this test when exec_disable_arg_limit is 1 on Tru64. It is not + # nice to cause kernel panics so lets avoid the loop below. + # First set a reasonable default. + lt_cv_sys_max_cmd_len=16384 + # + if test -x /sbin/sysconfig; then + case `/sbin/sysconfig -q proc exec_disable_arg_limit` in + *1*) lt_cv_sys_max_cmd_len=-1 ;; + esac + fi + ;; + sco3.2v5*) + lt_cv_sys_max_cmd_len=102400 + ;; + sysv5* | sco5v6* | sysv4.2uw2*) + kargmax=`grep ARG_MAX /etc/conf/cf.d/stune 2>/dev/null` + if test -n "$kargmax"; then + lt_cv_sys_max_cmd_len=`echo $kargmax | sed 's/.*[ ]//'` + else + lt_cv_sys_max_cmd_len=32768 + fi + ;; + *) + lt_cv_sys_max_cmd_len=`(getconf ARG_MAX) 2> /dev/null` + if test -n "$lt_cv_sys_max_cmd_len" && \ + test undefined != "$lt_cv_sys_max_cmd_len"; then + lt_cv_sys_max_cmd_len=`expr $lt_cv_sys_max_cmd_len \/ 4` + lt_cv_sys_max_cmd_len=`expr $lt_cv_sys_max_cmd_len \* 3` + else + # Make teststring a little bigger before we do anything with it. + # a 1K string should be a reasonable start. + for i in 1 2 3 4 5 6 7 8; do + teststring=$teststring$teststring + done + SHELL=${SHELL-${CONFIG_SHELL-/bin/sh}} + # If test is not a shell built-in, we'll probably end up computing a + # maximum length that is only half of the actual maximum length, but + # we can't tell. + while { test X`env echo "$teststring$teststring" 2>/dev/null` \ + = "X$teststring$teststring"; } >/dev/null 2>&1 && + test 17 != "$i" # 1/2 MB should be enough + do + i=`expr $i + 1` + teststring=$teststring$teststring + done + # Only check the string length outside the loop. + lt_cv_sys_max_cmd_len=`expr "X$teststring" : ".*" 2>&1` + teststring= + # Add a significant safety factor because C++ compilers can tack on + # massive amounts of additional arguments before passing them to the + # linker. It appears as though 1/2 is a usable value. + lt_cv_sys_max_cmd_len=`expr $lt_cv_sys_max_cmd_len \/ 2` + fi + ;; + esac + +fi + +if test -n "$lt_cv_sys_max_cmd_len"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_sys_max_cmd_len" >&5 +$as_echo "$lt_cv_sys_max_cmd_len" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: none" >&5 +$as_echo "none" >&6; } +fi +max_cmd_len=$lt_cv_sys_max_cmd_len + + + + + + +: ${CP="cp -f"} +: ${MV="mv -f"} +: ${RM="rm -f"} + +if ( (MAIL=60; unset MAIL) || exit) >/dev/null 2>&1; then + lt_unset=unset +else + lt_unset=false +fi + + + + + +# test EBCDIC or ASCII +case `echo X|tr X '\101'` in + A) # ASCII based system + # \n is not interpreted correctly by Solaris 8 /usr/ucb/tr + lt_SP2NL='tr \040 \012' + lt_NL2SP='tr \015\012 \040\040' + ;; + *) # EBCDIC based system + lt_SP2NL='tr \100 \n' + lt_NL2SP='tr \r\n \100\100' + ;; +esac + + + + + + + + + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking how to convert $build file names to $host format" >&5 +$as_echo_n "checking how to convert $build file names to $host format... " >&6; } +if ${lt_cv_to_host_file_cmd+:} false; then : + $as_echo_n "(cached) " >&6 +else + case $host in + *-*-mingw* ) + case $build in + *-*-mingw* ) # actually msys + lt_cv_to_host_file_cmd=func_convert_file_msys_to_w32 + ;; + *-*-cygwin* ) + lt_cv_to_host_file_cmd=func_convert_file_cygwin_to_w32 + ;; + * ) # otherwise, assume *nix + lt_cv_to_host_file_cmd=func_convert_file_nix_to_w32 + ;; + esac + ;; + *-*-cygwin* ) + case $build in + *-*-mingw* ) # actually msys + lt_cv_to_host_file_cmd=func_convert_file_msys_to_cygwin + ;; + *-*-cygwin* ) + lt_cv_to_host_file_cmd=func_convert_file_noop + ;; + * ) # otherwise, assume *nix + lt_cv_to_host_file_cmd=func_convert_file_nix_to_cygwin + ;; + esac + ;; + * ) # unhandled hosts (and "normal" native builds) + lt_cv_to_host_file_cmd=func_convert_file_noop + ;; +esac + +fi + +to_host_file_cmd=$lt_cv_to_host_file_cmd +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_to_host_file_cmd" >&5 +$as_echo "$lt_cv_to_host_file_cmd" >&6; } + + + + + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking how to convert $build file names to toolchain format" >&5 +$as_echo_n "checking how to convert $build file names to toolchain format... " >&6; } +if ${lt_cv_to_tool_file_cmd+:} false; then : + $as_echo_n "(cached) " >&6 +else + #assume ordinary cross tools, or native build. +lt_cv_to_tool_file_cmd=func_convert_file_noop +case $host in + *-*-mingw* ) + case $build in + *-*-mingw* ) # actually msys + lt_cv_to_tool_file_cmd=func_convert_file_msys_to_w32 + ;; + esac + ;; +esac + +fi + +to_tool_file_cmd=$lt_cv_to_tool_file_cmd +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_to_tool_file_cmd" >&5 +$as_echo "$lt_cv_to_tool_file_cmd" >&6; } + + + + + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $LD option to reload object files" >&5 +$as_echo_n "checking for $LD option to reload object files... " >&6; } +if ${lt_cv_ld_reload_flag+:} false; then : + $as_echo_n "(cached) " >&6 +else + lt_cv_ld_reload_flag='-r' +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_ld_reload_flag" >&5 +$as_echo "$lt_cv_ld_reload_flag" >&6; } +reload_flag=$lt_cv_ld_reload_flag +case $reload_flag in +"" | " "*) ;; +*) reload_flag=" $reload_flag" ;; +esac +reload_cmds='$LD$reload_flag -o $output$reload_objs' +case $host_os in + cygwin* | mingw* | pw32* | cegcc*) + if test yes != "$GCC"; then + reload_cmds=false + fi + ;; + darwin*) + if test yes = "$GCC"; then + reload_cmds='$LTCC $LTCFLAGS -nostdlib $wl-r -o $output$reload_objs' + else + reload_cmds='$LD$reload_flag -o $output$reload_objs' + fi + ;; +esac + + + + + + + + + +if test -n "$ac_tool_prefix"; then + # Extract the first word of "${ac_tool_prefix}objdump", so it can be a program name with args. +set dummy ${ac_tool_prefix}objdump; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_OBJDUMP+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$OBJDUMP"; then + ac_cv_prog_OBJDUMP="$OBJDUMP" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_OBJDUMP="${ac_tool_prefix}objdump" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +OBJDUMP=$ac_cv_prog_OBJDUMP +if test -n "$OBJDUMP"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $OBJDUMP" >&5 +$as_echo "$OBJDUMP" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + +fi +if test -z "$ac_cv_prog_OBJDUMP"; then + ac_ct_OBJDUMP=$OBJDUMP + # Extract the first word of "objdump", so it can be a program name with args. +set dummy objdump; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_ac_ct_OBJDUMP+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$ac_ct_OBJDUMP"; then + ac_cv_prog_ac_ct_OBJDUMP="$ac_ct_OBJDUMP" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_ac_ct_OBJDUMP="objdump" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +ac_ct_OBJDUMP=$ac_cv_prog_ac_ct_OBJDUMP +if test -n "$ac_ct_OBJDUMP"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_OBJDUMP" >&5 +$as_echo "$ac_ct_OBJDUMP" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + if test "x$ac_ct_OBJDUMP" = x; then + OBJDUMP="false" + else + case $cross_compiling:$ac_tool_warned in +yes:) +{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 +$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} +ac_tool_warned=yes ;; +esac + OBJDUMP=$ac_ct_OBJDUMP + fi +else + OBJDUMP="$ac_cv_prog_OBJDUMP" +fi + +test -z "$OBJDUMP" && OBJDUMP=objdump + + + + + + + + + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking how to recognize dependent libraries" >&5 +$as_echo_n "checking how to recognize dependent libraries... " >&6; } +if ${lt_cv_deplibs_check_method+:} false; then : + $as_echo_n "(cached) " >&6 +else + lt_cv_file_magic_cmd='$MAGIC_CMD' +lt_cv_file_magic_test_file= +lt_cv_deplibs_check_method='unknown' +# Need to set the preceding variable on all platforms that support +# interlibrary dependencies. +# 'none' -- dependencies not supported. +# 'unknown' -- same as none, but documents that we really don't know. +# 'pass_all' -- all dependencies passed with no checks. +# 'test_compile' -- check by making test program. +# 'file_magic [[regex]]' -- check by looking for files in library path +# that responds to the $file_magic_cmd with a given extended regex. +# If you have 'file' or equivalent on your system and you're not sure +# whether 'pass_all' will *always* work, you probably want this one. + +case $host_os in +aix[4-9]*) + lt_cv_deplibs_check_method=pass_all + ;; + +beos*) + lt_cv_deplibs_check_method=pass_all + ;; + +bsdi[45]*) + lt_cv_deplibs_check_method='file_magic ELF [0-9][0-9]*-bit [ML]SB (shared object|dynamic lib)' + lt_cv_file_magic_cmd='/usr/bin/file -L' + lt_cv_file_magic_test_file=/shlib/libc.so + ;; + +cygwin*) + # func_win32_libid is a shell function defined in ltmain.sh + lt_cv_deplibs_check_method='file_magic ^x86 archive import|^x86 DLL' + lt_cv_file_magic_cmd='func_win32_libid' + ;; + +mingw* | pw32*) + # Base MSYS/MinGW do not provide the 'file' command needed by + # func_win32_libid shell function, so use a weaker test based on 'objdump', + # unless we find 'file', for example because we are cross-compiling. + if ( file / ) >/dev/null 2>&1; then + lt_cv_deplibs_check_method='file_magic ^x86 archive import|^x86 DLL' + lt_cv_file_magic_cmd='func_win32_libid' + else + # Keep this pattern in sync with the one in func_win32_libid. + lt_cv_deplibs_check_method='file_magic file format (pei*-i386(.*architecture: i386)?|pe-arm-wince|pe-x86-64)' + lt_cv_file_magic_cmd='$OBJDUMP -f' + fi + ;; + +cegcc*) + # use the weaker test based on 'objdump'. See mingw*. + lt_cv_deplibs_check_method='file_magic file format pe-arm-.*little(.*architecture: arm)?' + lt_cv_file_magic_cmd='$OBJDUMP -f' + ;; + +darwin* | rhapsody*) + lt_cv_deplibs_check_method=pass_all + ;; + +freebsd* | dragonfly*) + if echo __ELF__ | $CC -E - | $GREP __ELF__ > /dev/null; then + case $host_cpu in + i*86 ) + # Not sure whether the presence of OpenBSD here was a mistake. + # Let's accept both of them until this is cleared up. + lt_cv_deplibs_check_method='file_magic (FreeBSD|OpenBSD|DragonFly)/i[3-9]86 (compact )?demand paged shared library' + lt_cv_file_magic_cmd=/usr/bin/file + lt_cv_file_magic_test_file=`echo /usr/lib/libc.so.*` + ;; + esac + else + lt_cv_deplibs_check_method=pass_all + fi + ;; + +haiku*) + lt_cv_deplibs_check_method=pass_all + ;; + +hpux10.20* | hpux11*) + lt_cv_file_magic_cmd=/usr/bin/file + case $host_cpu in + ia64*) + lt_cv_deplibs_check_method='file_magic (s[0-9][0-9][0-9]|ELF-[0-9][0-9]) shared object file - IA64' + lt_cv_file_magic_test_file=/usr/lib/hpux32/libc.so + ;; + hppa*64*) + lt_cv_deplibs_check_method='file_magic (s[0-9][0-9][0-9]|ELF[ -][0-9][0-9])(-bit)?( [LM]SB)? shared object( file)?[, -]* PA-RISC [0-9]\.[0-9]' + lt_cv_file_magic_test_file=/usr/lib/pa20_64/libc.sl + ;; + *) + lt_cv_deplibs_check_method='file_magic (s[0-9][0-9][0-9]|PA-RISC[0-9]\.[0-9]) shared library' + lt_cv_file_magic_test_file=/usr/lib/libc.sl + ;; + esac + ;; + +interix[3-9]*) + # PIC code is broken on Interix 3.x, that's why |\.a not |_pic\.a here + lt_cv_deplibs_check_method='match_pattern /lib[^/]+(\.so|\.a)$' + ;; + +irix5* | irix6* | nonstopux*) + case $LD in + *-32|*"-32 ") libmagic=32-bit;; + *-n32|*"-n32 ") libmagic=N32;; + *-64|*"-64 ") libmagic=64-bit;; + *) libmagic=never-match;; + esac + lt_cv_deplibs_check_method=pass_all + ;; + +# This must be glibc/ELF. +linux* | k*bsd*-gnu | kopensolaris*-gnu | gnu*) + lt_cv_deplibs_check_method=pass_all + ;; + +netbsd*) + if echo __ELF__ | $CC -E - | $GREP __ELF__ > /dev/null; then + lt_cv_deplibs_check_method='match_pattern /lib[^/]+(\.so\.[0-9]+\.[0-9]+|_pic\.a)$' + else + lt_cv_deplibs_check_method='match_pattern /lib[^/]+(\.so|_pic\.a)$' + fi + ;; + +newos6*) + lt_cv_deplibs_check_method='file_magic ELF [0-9][0-9]*-bit [ML]SB (executable|dynamic lib)' + lt_cv_file_magic_cmd=/usr/bin/file + lt_cv_file_magic_test_file=/usr/lib/libnls.so + ;; + +*nto* | *qnx*) + lt_cv_deplibs_check_method=pass_all + ;; + +openbsd* | bitrig*) + if test -z "`echo __ELF__ | $CC -E - | $GREP __ELF__`"; then + lt_cv_deplibs_check_method='match_pattern /lib[^/]+(\.so\.[0-9]+\.[0-9]+|\.so|_pic\.a)$' + else + lt_cv_deplibs_check_method='match_pattern /lib[^/]+(\.so\.[0-9]+\.[0-9]+|_pic\.a)$' + fi + ;; + +osf3* | osf4* | osf5*) + lt_cv_deplibs_check_method=pass_all + ;; + +rdos*) + lt_cv_deplibs_check_method=pass_all + ;; + +solaris*) + lt_cv_deplibs_check_method=pass_all + ;; + +sysv5* | sco3.2v5* | sco5v6* | unixware* | OpenUNIX* | sysv4*uw2*) + lt_cv_deplibs_check_method=pass_all + ;; + +sysv4 | sysv4.3*) + case $host_vendor in + motorola) + lt_cv_deplibs_check_method='file_magic ELF [0-9][0-9]*-bit [ML]SB (shared object|dynamic lib) M[0-9][0-9]* Version [0-9]' + lt_cv_file_magic_test_file=`echo /usr/lib/libc.so*` + ;; + ncr) + lt_cv_deplibs_check_method=pass_all + ;; + sequent) + lt_cv_file_magic_cmd='/bin/file' + lt_cv_deplibs_check_method='file_magic ELF [0-9][0-9]*-bit [LM]SB (shared object|dynamic lib )' + ;; + sni) + lt_cv_file_magic_cmd='/bin/file' + lt_cv_deplibs_check_method="file_magic ELF [0-9][0-9]*-bit [LM]SB dynamic lib" + lt_cv_file_magic_test_file=/lib/libc.so + ;; + siemens) + lt_cv_deplibs_check_method=pass_all + ;; + pc) + lt_cv_deplibs_check_method=pass_all + ;; + esac + ;; + +tpf*) + lt_cv_deplibs_check_method=pass_all + ;; +os2*) + lt_cv_deplibs_check_method=pass_all + ;; +esac + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_deplibs_check_method" >&5 +$as_echo "$lt_cv_deplibs_check_method" >&6; } + +file_magic_glob= +want_nocaseglob=no +if test "$build" = "$host"; then + case $host_os in + mingw* | pw32*) + if ( shopt | grep nocaseglob ) >/dev/null 2>&1; then + want_nocaseglob=yes + else + file_magic_glob=`echo aAbBcCdDeEfFgGhHiIjJkKlLmMnNoOpPqQrRsStTuUvVwWxXyYzZ | $SED -e "s/\(..\)/s\/[\1]\/[\1]\/g;/g"` + fi + ;; + esac +fi + +file_magic_cmd=$lt_cv_file_magic_cmd +deplibs_check_method=$lt_cv_deplibs_check_method +test -z "$deplibs_check_method" && deplibs_check_method=unknown + + + + + + + + + + + + + + + + + + + + + + +if test -n "$ac_tool_prefix"; then + # Extract the first word of "${ac_tool_prefix}dlltool", so it can be a program name with args. +set dummy ${ac_tool_prefix}dlltool; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_DLLTOOL+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$DLLTOOL"; then + ac_cv_prog_DLLTOOL="$DLLTOOL" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_DLLTOOL="${ac_tool_prefix}dlltool" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +DLLTOOL=$ac_cv_prog_DLLTOOL +if test -n "$DLLTOOL"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $DLLTOOL" >&5 +$as_echo "$DLLTOOL" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + +fi +if test -z "$ac_cv_prog_DLLTOOL"; then + ac_ct_DLLTOOL=$DLLTOOL + # Extract the first word of "dlltool", so it can be a program name with args. +set dummy dlltool; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_ac_ct_DLLTOOL+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$ac_ct_DLLTOOL"; then + ac_cv_prog_ac_ct_DLLTOOL="$ac_ct_DLLTOOL" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_ac_ct_DLLTOOL="dlltool" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +ac_ct_DLLTOOL=$ac_cv_prog_ac_ct_DLLTOOL +if test -n "$ac_ct_DLLTOOL"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_DLLTOOL" >&5 +$as_echo "$ac_ct_DLLTOOL" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + if test "x$ac_ct_DLLTOOL" = x; then + DLLTOOL="false" + else + case $cross_compiling:$ac_tool_warned in +yes:) +{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 +$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} +ac_tool_warned=yes ;; +esac + DLLTOOL=$ac_ct_DLLTOOL + fi +else + DLLTOOL="$ac_cv_prog_DLLTOOL" +fi + +test -z "$DLLTOOL" && DLLTOOL=dlltool + + + + + + + + + + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking how to associate runtime and link libraries" >&5 +$as_echo_n "checking how to associate runtime and link libraries... " >&6; } +if ${lt_cv_sharedlib_from_linklib_cmd+:} false; then : + $as_echo_n "(cached) " >&6 +else + lt_cv_sharedlib_from_linklib_cmd='unknown' + +case $host_os in +cygwin* | mingw* | pw32* | cegcc*) + # two different shell functions defined in ltmain.sh; + # decide which one to use based on capabilities of $DLLTOOL + case `$DLLTOOL --help 2>&1` in + *--identify-strict*) + lt_cv_sharedlib_from_linklib_cmd=func_cygming_dll_for_implib + ;; + *) + lt_cv_sharedlib_from_linklib_cmd=func_cygming_dll_for_implib_fallback + ;; + esac + ;; +*) + # fallback: assume linklib IS sharedlib + lt_cv_sharedlib_from_linklib_cmd=$ECHO + ;; +esac + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_sharedlib_from_linklib_cmd" >&5 +$as_echo "$lt_cv_sharedlib_from_linklib_cmd" >&6; } +sharedlib_from_linklib_cmd=$lt_cv_sharedlib_from_linklib_cmd +test -z "$sharedlib_from_linklib_cmd" && sharedlib_from_linklib_cmd=$ECHO + + + + + + + +if test -n "$ac_tool_prefix"; then + for ac_prog in ar + do + # Extract the first word of "$ac_tool_prefix$ac_prog", so it can be a program name with args. +set dummy $ac_tool_prefix$ac_prog; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_AR+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$AR"; then + ac_cv_prog_AR="$AR" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_AR="$ac_tool_prefix$ac_prog" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +AR=$ac_cv_prog_AR +if test -n "$AR"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $AR" >&5 +$as_echo "$AR" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + test -n "$AR" && break + done +fi +if test -z "$AR"; then + ac_ct_AR=$AR + for ac_prog in ar +do + # Extract the first word of "$ac_prog", so it can be a program name with args. +set dummy $ac_prog; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_ac_ct_AR+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$ac_ct_AR"; then + ac_cv_prog_ac_ct_AR="$ac_ct_AR" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_ac_ct_AR="$ac_prog" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +ac_ct_AR=$ac_cv_prog_ac_ct_AR +if test -n "$ac_ct_AR"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_AR" >&5 +$as_echo "$ac_ct_AR" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + test -n "$ac_ct_AR" && break +done + + if test "x$ac_ct_AR" = x; then + AR="false" + else + case $cross_compiling:$ac_tool_warned in +yes:) +{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 +$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} +ac_tool_warned=yes ;; +esac + AR=$ac_ct_AR + fi +fi + +: ${AR=ar} +: ${AR_FLAGS=cru} + + + + + + + + + + + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for archiver @FILE support" >&5 +$as_echo_n "checking for archiver @FILE support... " >&6; } +if ${lt_cv_ar_at_file+:} false; then : + $as_echo_n "(cached) " >&6 +else + lt_cv_ar_at_file=no + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + echo conftest.$ac_objext > conftest.lst + lt_ar_try='$AR $AR_FLAGS libconftest.a @conftest.lst >&5' + { { eval echo "\"\$as_me\":${as_lineno-$LINENO}: \"$lt_ar_try\""; } >&5 + (eval $lt_ar_try) 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } + if test 0 -eq "$ac_status"; then + # Ensure the archiver fails upon bogus file names. + rm -f conftest.$ac_objext libconftest.a + { { eval echo "\"\$as_me\":${as_lineno-$LINENO}: \"$lt_ar_try\""; } >&5 + (eval $lt_ar_try) 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } + if test 0 -ne "$ac_status"; then + lt_cv_ar_at_file=@ + fi + fi + rm -f conftest.* libconftest.a + +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_ar_at_file" >&5 +$as_echo "$lt_cv_ar_at_file" >&6; } + +if test no = "$lt_cv_ar_at_file"; then + archiver_list_spec= +else + archiver_list_spec=$lt_cv_ar_at_file +fi + + + + + + + +if test -n "$ac_tool_prefix"; then + # Extract the first word of "${ac_tool_prefix}strip", so it can be a program name with args. +set dummy ${ac_tool_prefix}strip; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_STRIP+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$STRIP"; then + ac_cv_prog_STRIP="$STRIP" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_STRIP="${ac_tool_prefix}strip" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +STRIP=$ac_cv_prog_STRIP +if test -n "$STRIP"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $STRIP" >&5 +$as_echo "$STRIP" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + +fi +if test -z "$ac_cv_prog_STRIP"; then + ac_ct_STRIP=$STRIP + # Extract the first word of "strip", so it can be a program name with args. +set dummy strip; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_ac_ct_STRIP+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$ac_ct_STRIP"; then + ac_cv_prog_ac_ct_STRIP="$ac_ct_STRIP" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_ac_ct_STRIP="strip" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +ac_ct_STRIP=$ac_cv_prog_ac_ct_STRIP +if test -n "$ac_ct_STRIP"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_STRIP" >&5 +$as_echo "$ac_ct_STRIP" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + if test "x$ac_ct_STRIP" = x; then + STRIP=":" + else + case $cross_compiling:$ac_tool_warned in +yes:) +{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 +$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} +ac_tool_warned=yes ;; +esac + STRIP=$ac_ct_STRIP + fi +else + STRIP="$ac_cv_prog_STRIP" +fi + +test -z "$STRIP" && STRIP=: + + + + + + +if test -n "$ac_tool_prefix"; then + # Extract the first word of "${ac_tool_prefix}ranlib", so it can be a program name with args. +set dummy ${ac_tool_prefix}ranlib; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_RANLIB+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$RANLIB"; then + ac_cv_prog_RANLIB="$RANLIB" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_RANLIB="${ac_tool_prefix}ranlib" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +RANLIB=$ac_cv_prog_RANLIB +if test -n "$RANLIB"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $RANLIB" >&5 +$as_echo "$RANLIB" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + +fi +if test -z "$ac_cv_prog_RANLIB"; then + ac_ct_RANLIB=$RANLIB + # Extract the first word of "ranlib", so it can be a program name with args. +set dummy ranlib; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_ac_ct_RANLIB+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$ac_ct_RANLIB"; then + ac_cv_prog_ac_ct_RANLIB="$ac_ct_RANLIB" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_ac_ct_RANLIB="ranlib" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +ac_ct_RANLIB=$ac_cv_prog_ac_ct_RANLIB +if test -n "$ac_ct_RANLIB"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_RANLIB" >&5 +$as_echo "$ac_ct_RANLIB" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + if test "x$ac_ct_RANLIB" = x; then + RANLIB=":" + else + case $cross_compiling:$ac_tool_warned in +yes:) +{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 +$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} +ac_tool_warned=yes ;; +esac + RANLIB=$ac_ct_RANLIB + fi +else + RANLIB="$ac_cv_prog_RANLIB" +fi + +test -z "$RANLIB" && RANLIB=: + + + + + + +# Determine commands to create old-style static archives. +old_archive_cmds='$AR $AR_FLAGS $oldlib$oldobjs' +old_postinstall_cmds='chmod 644 $oldlib' +old_postuninstall_cmds= + +if test -n "$RANLIB"; then + case $host_os in + bitrig* | openbsd*) + old_postinstall_cmds="$old_postinstall_cmds~\$RANLIB -t \$tool_oldlib" + ;; + *) + old_postinstall_cmds="$old_postinstall_cmds~\$RANLIB \$tool_oldlib" + ;; + esac + old_archive_cmds="$old_archive_cmds~\$RANLIB \$tool_oldlib" +fi + +case $host_os in + darwin*) + lock_old_archive_extraction=yes ;; + *) + lock_old_archive_extraction=no ;; +esac + + + + + + + + + + + + + + + + + + + + + +for ac_prog in gawk mawk nawk awk +do + # Extract the first word of "$ac_prog", so it can be a program name with args. +set dummy $ac_prog; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_AWK+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$AWK"; then + ac_cv_prog_AWK="$AWK" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_AWK="$ac_prog" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +AWK=$ac_cv_prog_AWK +if test -n "$AWK"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $AWK" >&5 +$as_echo "$AWK" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + test -n "$AWK" && break +done + + + + + + + + + + + + + + + + + + + +# If no C compiler was specified, use CC. +LTCC=${LTCC-"$CC"} + +# If no C compiler flags were specified, use CFLAGS. +LTCFLAGS=${LTCFLAGS-"$CFLAGS"} + +# Allow CC to be a program name with arguments. +compiler=$CC + + +# Check for command to grab the raw symbol name followed by C symbol from nm. +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking command to parse $NM output from $compiler object" >&5 +$as_echo_n "checking command to parse $NM output from $compiler object... " >&6; } +if ${lt_cv_sys_global_symbol_pipe+:} false; then : + $as_echo_n "(cached) " >&6 +else + +# These are sane defaults that work on at least a few old systems. +# [They come from Ultrix. What could be older than Ultrix?!! ;)] + +# Character class describing NM global symbol codes. +symcode='[BCDEGRST]' + +# Regexp to match symbols that can be accessed directly from C. +sympat='\([_A-Za-z][_A-Za-z0-9]*\)' + +# Define system-specific variables. +case $host_os in +aix*) + symcode='[BCDT]' + ;; +cygwin* | mingw* | pw32* | cegcc*) + symcode='[ABCDGISTW]' + ;; +hpux*) + if test ia64 = "$host_cpu"; then + symcode='[ABCDEGRST]' + fi + ;; +irix* | nonstopux*) + symcode='[BCDEGRST]' + ;; +osf*) + symcode='[BCDEGQRST]' + ;; +solaris*) + symcode='[BDRT]' + ;; +sco3.2v5*) + symcode='[DT]' + ;; +sysv4.2uw2*) + symcode='[DT]' + ;; +sysv5* | sco5v6* | unixware* | OpenUNIX*) + symcode='[ABDT]' + ;; +sysv4) + symcode='[DFNSTU]' + ;; +esac + +# If we're using GNU nm, then use its standard symbol codes. +case `$NM -V 2>&1` in +*GNU* | *'with BFD'*) + symcode='[ABCDGIRSTW]' ;; +esac + +if test "$lt_cv_nm_interface" = "MS dumpbin"; then + # Gets list of data symbols to import. + lt_cv_sys_global_symbol_to_import="sed -n -e 's/^I .* \(.*\)$/\1/p'" + # Adjust the below global symbol transforms to fixup imported variables. + lt_cdecl_hook=" -e 's/^I .* \(.*\)$/extern __declspec(dllimport) char \1;/p'" + lt_c_name_hook=" -e 's/^I .* \(.*\)$/ {\"\1\", (void *) 0},/p'" + lt_c_name_lib_hook="\ + -e 's/^I .* \(lib.*\)$/ {\"\1\", (void *) 0},/p'\ + -e 's/^I .* \(.*\)$/ {\"lib\1\", (void *) 0},/p'" +else + # Disable hooks by default. + lt_cv_sys_global_symbol_to_import= + lt_cdecl_hook= + lt_c_name_hook= + lt_c_name_lib_hook= +fi + +# Transform an extracted symbol line into a proper C declaration. +# Some systems (esp. on ia64) link data and code symbols differently, +# so use this general approach. +lt_cv_sys_global_symbol_to_cdecl="sed -n"\ +$lt_cdecl_hook\ +" -e 's/^T .* \(.*\)$/extern int \1();/p'"\ +" -e 's/^$symcode$symcode* .* \(.*\)$/extern char \1;/p'" + +# Transform an extracted symbol line into symbol name and symbol address +lt_cv_sys_global_symbol_to_c_name_address="sed -n"\ +$lt_c_name_hook\ +" -e 's/^: \(.*\) .*$/ {\"\1\", (void *) 0},/p'"\ +" -e 's/^$symcode$symcode* .* \(.*\)$/ {\"\1\", (void *) \&\1},/p'" + +# Transform an extracted symbol line into symbol name with lib prefix and +# symbol address. +lt_cv_sys_global_symbol_to_c_name_address_lib_prefix="sed -n"\ +$lt_c_name_lib_hook\ +" -e 's/^: \(.*\) .*$/ {\"\1\", (void *) 0},/p'"\ +" -e 's/^$symcode$symcode* .* \(lib.*\)$/ {\"\1\", (void *) \&\1},/p'"\ +" -e 's/^$symcode$symcode* .* \(.*\)$/ {\"lib\1\", (void *) \&\1},/p'" + +# Handle CRLF in mingw tool chain +opt_cr= +case $build_os in +mingw*) + opt_cr=`$ECHO 'x\{0,1\}' | tr x '\015'` # option cr in regexp + ;; +esac + +# Try without a prefix underscore, then with it. +for ac_symprfx in "" "_"; do + + # Transform symcode, sympat, and symprfx into a raw symbol and a C symbol. + symxfrm="\\1 $ac_symprfx\\2 \\2" + + # Write the raw and C identifiers. + if test "$lt_cv_nm_interface" = "MS dumpbin"; then + # Fake it for dumpbin and say T for any non-static function, + # D for any global variable and I for any imported variable. + # Also find C++ and __fastcall symbols from MSVC++, + # which start with @ or ?. + lt_cv_sys_global_symbol_pipe="$AWK '"\ +" {last_section=section; section=\$ 3};"\ +" /^COFF SYMBOL TABLE/{for(i in hide) delete hide[i]};"\ +" /Section length .*#relocs.*(pick any)/{hide[last_section]=1};"\ +" /^ *Symbol name *: /{split(\$ 0,sn,\":\"); si=substr(sn[2],2)};"\ +" /^ *Type *: code/{print \"T\",si,substr(si,length(prfx))};"\ +" /^ *Type *: data/{print \"I\",si,substr(si,length(prfx))};"\ +" \$ 0!~/External *\|/{next};"\ +" / 0+ UNDEF /{next}; / UNDEF \([^|]\)*()/{next};"\ +" {if(hide[section]) next};"\ +" {f=\"D\"}; \$ 0~/\(\).*\|/{f=\"T\"};"\ +" {split(\$ 0,a,/\||\r/); split(a[2],s)};"\ +" s[1]~/^[@?]/{print f,s[1],s[1]; next};"\ +" s[1]~prfx {split(s[1],t,\"@\"); print f,t[1],substr(t[1],length(prfx))}"\ +" ' prfx=^$ac_symprfx" + else + lt_cv_sys_global_symbol_pipe="sed -n -e 's/^.*[ ]\($symcode$symcode*\)[ ][ ]*$ac_symprfx$sympat$opt_cr$/$symxfrm/p'" + fi + lt_cv_sys_global_symbol_pipe="$lt_cv_sys_global_symbol_pipe | sed '/ __gnu_lto/d'" + + # Check to see that the pipe works correctly. + pipe_works=no + + rm -f conftest* + cat > conftest.$ac_ext <<_LT_EOF +#ifdef __cplusplus +extern "C" { +#endif +char nm_test_var; +void nm_test_func(void); +void nm_test_func(void){} +#ifdef __cplusplus +} +#endif +int main(){nm_test_var='a';nm_test_func();return(0);} +_LT_EOF + + if { { eval echo "\"\$as_me\":${as_lineno-$LINENO}: \"$ac_compile\""; } >&5 + (eval $ac_compile) 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; }; then + # Now try to grab the symbols. + nlist=conftest.nm + if { { eval echo "\"\$as_me\":${as_lineno-$LINENO}: \"$NM conftest.$ac_objext \| "$lt_cv_sys_global_symbol_pipe" \> $nlist\""; } >&5 + (eval $NM conftest.$ac_objext \| "$lt_cv_sys_global_symbol_pipe" \> $nlist) 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } && test -s "$nlist"; then + # Try sorting and uniquifying the output. + if sort "$nlist" | uniq > "$nlist"T; then + mv -f "$nlist"T "$nlist" + else + rm -f "$nlist"T + fi + + # Make sure that we snagged all the symbols we need. + if $GREP ' nm_test_var$' "$nlist" >/dev/null; then + if $GREP ' nm_test_func$' "$nlist" >/dev/null; then + cat <<_LT_EOF > conftest.$ac_ext +/* Keep this code in sync between libtool.m4, ltmain, lt_system.h, and tests. */ +#if defined _WIN32 || defined __CYGWIN__ || defined _WIN32_WCE +/* DATA imports from DLLs on WIN32 can't be const, because runtime + relocations are performed -- see ld's documentation on pseudo-relocs. */ +# define LT_DLSYM_CONST +#elif defined __osf__ +/* This system does not cope well with relocations in const data. */ +# define LT_DLSYM_CONST +#else +# define LT_DLSYM_CONST const +#endif + +#ifdef __cplusplus +extern "C" { +#endif + +_LT_EOF + # Now generate the symbol file. + eval "$lt_cv_sys_global_symbol_to_cdecl"' < "$nlist" | $GREP -v main >> conftest.$ac_ext' + + cat <<_LT_EOF >> conftest.$ac_ext + +/* The mapping between symbol names and symbols. */ +LT_DLSYM_CONST struct { + const char *name; + void *address; +} +lt__PROGRAM__LTX_preloaded_symbols[] = +{ + { "@PROGRAM@", (void *) 0 }, +_LT_EOF + $SED "s/^$symcode$symcode* .* \(.*\)$/ {\"\1\", (void *) \&\1},/" < "$nlist" | $GREP -v main >> conftest.$ac_ext + cat <<\_LT_EOF >> conftest.$ac_ext + {0, (void *) 0} +}; + +/* This works around a problem in FreeBSD linker */ +#ifdef FREEBSD_WORKAROUND +static const void *lt_preloaded_setup() { + return lt__PROGRAM__LTX_preloaded_symbols; +} +#endif + +#ifdef __cplusplus +} +#endif +_LT_EOF + # Now try linking the two files. + mv conftest.$ac_objext conftstm.$ac_objext + lt_globsym_save_LIBS=$LIBS + lt_globsym_save_CFLAGS=$CFLAGS + LIBS=conftstm.$ac_objext + CFLAGS="$CFLAGS$lt_prog_compiler_no_builtin_flag" + if { { eval echo "\"\$as_me\":${as_lineno-$LINENO}: \"$ac_link\""; } >&5 + (eval $ac_link) 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } && test -s conftest$ac_exeext; then + pipe_works=yes + fi + LIBS=$lt_globsym_save_LIBS + CFLAGS=$lt_globsym_save_CFLAGS + else + echo "cannot find nm_test_func in $nlist" >&5 + fi + else + echo "cannot find nm_test_var in $nlist" >&5 + fi + else + echo "cannot run $lt_cv_sys_global_symbol_pipe" >&5 + fi + else + echo "$progname: failed program was:" >&5 + cat conftest.$ac_ext >&5 + fi + rm -rf conftest* conftst* + + # Do not use the global_symbol_pipe unless it works. + if test yes = "$pipe_works"; then + break + else + lt_cv_sys_global_symbol_pipe= + fi +done + +fi + +if test -z "$lt_cv_sys_global_symbol_pipe"; then + lt_cv_sys_global_symbol_to_cdecl= +fi +if test -z "$lt_cv_sys_global_symbol_pipe$lt_cv_sys_global_symbol_to_cdecl"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: failed" >&5 +$as_echo "failed" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: ok" >&5 +$as_echo "ok" >&6; } +fi + +# Response file support. +if test "$lt_cv_nm_interface" = "MS dumpbin"; then + nm_file_list_spec='@' +elif $NM --help 2>/dev/null | grep '[@]FILE' >/dev/null; then + nm_file_list_spec='@' +fi + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for sysroot" >&5 +$as_echo_n "checking for sysroot... " >&6; } + +# Check whether --with-sysroot was given. +if test "${with_sysroot+set}" = set; then : + withval=$with_sysroot; +else + with_sysroot=no +fi + + +lt_sysroot= +case $with_sysroot in #( + yes) + if test yes = "$GCC"; then + lt_sysroot=`$CC --print-sysroot 2>/dev/null` + fi + ;; #( + /*) + lt_sysroot=`echo "$with_sysroot" | sed -e "$sed_quote_subst"` + ;; #( + no|'') + ;; #( + *) + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $with_sysroot" >&5 +$as_echo "$with_sysroot" >&6; } + as_fn_error $? "The sysroot must be an absolute path." "$LINENO" 5 + ;; +esac + + { $as_echo "$as_me:${as_lineno-$LINENO}: result: ${lt_sysroot:-no}" >&5 +$as_echo "${lt_sysroot:-no}" >&6; } + + + + + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for a working dd" >&5 +$as_echo_n "checking for a working dd... " >&6; } +if ${ac_cv_path_lt_DD+:} false; then : + $as_echo_n "(cached) " >&6 +else + printf 0123456789abcdef0123456789abcdef >conftest.i +cat conftest.i conftest.i >conftest2.i +: ${lt_DD:=$DD} +if test -z "$lt_DD"; then + ac_path_lt_DD_found=false + # Loop through the user's path and test for each of PROGNAME-LIST + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_prog in dd; do + for ac_exec_ext in '' $ac_executable_extensions; do + ac_path_lt_DD="$as_dir/$ac_prog$ac_exec_ext" + as_fn_executable_p "$ac_path_lt_DD" || continue +if "$ac_path_lt_DD" bs=32 count=1 <conftest2.i >conftest.out 2>/dev/null; then + cmp -s conftest.i conftest.out \ + && ac_cv_path_lt_DD="$ac_path_lt_DD" ac_path_lt_DD_found=: +fi + $ac_path_lt_DD_found && break 3 + done + done + done +IFS=$as_save_IFS + if test -z "$ac_cv_path_lt_DD"; then + : + fi +else + ac_cv_path_lt_DD=$lt_DD +fi + +rm -f conftest.i conftest2.i conftest.out +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_path_lt_DD" >&5 +$as_echo "$ac_cv_path_lt_DD" >&6; } + + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking how to truncate binary pipes" >&5 +$as_echo_n "checking how to truncate binary pipes... " >&6; } +if ${lt_cv_truncate_bin+:} false; then : + $as_echo_n "(cached) " >&6 +else + printf 0123456789abcdef0123456789abcdef >conftest.i +cat conftest.i conftest.i >conftest2.i +lt_cv_truncate_bin= +if "$ac_cv_path_lt_DD" bs=32 count=1 <conftest2.i >conftest.out 2>/dev/null; then + cmp -s conftest.i conftest.out \ + && lt_cv_truncate_bin="$ac_cv_path_lt_DD bs=4096 count=1" +fi +rm -f conftest.i conftest2.i conftest.out +test -z "$lt_cv_truncate_bin" && lt_cv_truncate_bin="$SED -e 4q" +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_truncate_bin" >&5 +$as_echo "$lt_cv_truncate_bin" >&6; } + + + + + + + +# Calculate cc_basename. Skip known compiler wrappers and cross-prefix. +func_cc_basename () +{ + for cc_temp in $*""; do + case $cc_temp in + compile | *[\\/]compile | ccache | *[\\/]ccache ) ;; + distcc | *[\\/]distcc | purify | *[\\/]purify ) ;; + \-*) ;; + *) break;; + esac + done + func_cc_basename_result=`$ECHO "$cc_temp" | $SED "s%.*/%%; s%^$host_alias-%%"` +} + +# Check whether --enable-libtool-lock was given. +if test "${enable_libtool_lock+set}" = set; then : + enableval=$enable_libtool_lock; +fi + +test no = "$enable_libtool_lock" || enable_libtool_lock=yes + +# Some flags need to be propagated to the compiler or linker for good +# libtool support. +case $host in +ia64-*-hpux*) + # Find out what ABI is being produced by ac_compile, and set mode + # options accordingly. + echo 'int i;' > conftest.$ac_ext + if { { eval echo "\"\$as_me\":${as_lineno-$LINENO}: \"$ac_compile\""; } >&5 + (eval $ac_compile) 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; }; then + case `/usr/bin/file conftest.$ac_objext` in + *ELF-32*) + HPUX_IA64_MODE=32 + ;; + *ELF-64*) + HPUX_IA64_MODE=64 + ;; + esac + fi + rm -rf conftest* + ;; +*-*-irix6*) + # Find out what ABI is being produced by ac_compile, and set linker + # options accordingly. + echo '#line '$LINENO' "configure"' > conftest.$ac_ext + if { { eval echo "\"\$as_me\":${as_lineno-$LINENO}: \"$ac_compile\""; } >&5 + (eval $ac_compile) 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; }; then + if test yes = "$lt_cv_prog_gnu_ld"; then + case `/usr/bin/file conftest.$ac_objext` in + *32-bit*) + LD="${LD-ld} -melf32bsmip" + ;; + *N32*) + LD="${LD-ld} -melf32bmipn32" + ;; + *64-bit*) + LD="${LD-ld} -melf64bmip" + ;; + esac + else + case `/usr/bin/file conftest.$ac_objext` in + *32-bit*) + LD="${LD-ld} -32" + ;; + *N32*) + LD="${LD-ld} -n32" + ;; + *64-bit*) + LD="${LD-ld} -64" + ;; + esac + fi + fi + rm -rf conftest* + ;; + +mips64*-*linux*) + # Find out what ABI is being produced by ac_compile, and set linker + # options accordingly. + echo '#line '$LINENO' "configure"' > conftest.$ac_ext + if { { eval echo "\"\$as_me\":${as_lineno-$LINENO}: \"$ac_compile\""; } >&5 + (eval $ac_compile) 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; }; then + emul=elf + case `/usr/bin/file conftest.$ac_objext` in + *32-bit*) + emul="${emul}32" + ;; + *64-bit*) + emul="${emul}64" + ;; + esac + case `/usr/bin/file conftest.$ac_objext` in + *MSB*) + emul="${emul}btsmip" + ;; + *LSB*) + emul="${emul}ltsmip" + ;; + esac + case `/usr/bin/file conftest.$ac_objext` in + *N32*) + emul="${emul}n32" + ;; + esac + LD="${LD-ld} -m $emul" + fi + rm -rf conftest* + ;; + +x86_64-*kfreebsd*-gnu|x86_64-*linux*|powerpc*-*linux*| \ +s390*-*linux*|s390*-*tpf*|sparc*-*linux*) + # Find out what ABI is being produced by ac_compile, and set linker + # options accordingly. Note that the listed cases only cover the + # situations where additional linker options are needed (such as when + # doing 32-bit compilation for a host where ld defaults to 64-bit, or + # vice versa); the common cases where no linker options are needed do + # not appear in the list. + echo 'int i;' > conftest.$ac_ext + if { { eval echo "\"\$as_me\":${as_lineno-$LINENO}: \"$ac_compile\""; } >&5 + (eval $ac_compile) 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; }; then + case `/usr/bin/file conftest.o` in + *32-bit*) + case $host in + x86_64-*kfreebsd*-gnu) + LD="${LD-ld} -m elf_i386_fbsd" + ;; + x86_64-*linux*) + case `/usr/bin/file conftest.o` in + *x86-64*) + LD="${LD-ld} -m elf32_x86_64" + ;; + *) + LD="${LD-ld} -m elf_i386" + ;; + esac + ;; + powerpc64le-*linux*) + LD="${LD-ld} -m elf32lppclinux" + ;; + powerpc64-*linux*) + LD="${LD-ld} -m elf32ppclinux" + ;; + s390x-*linux*) + LD="${LD-ld} -m elf_s390" + ;; + sparc64-*linux*) + LD="${LD-ld} -m elf32_sparc" + ;; + esac + ;; + *64-bit*) + case $host in + x86_64-*kfreebsd*-gnu) + LD="${LD-ld} -m elf_x86_64_fbsd" + ;; + x86_64-*linux*) + LD="${LD-ld} -m elf_x86_64" + ;; + powerpcle-*linux*) + LD="${LD-ld} -m elf64lppc" + ;; + powerpc-*linux*) + LD="${LD-ld} -m elf64ppc" + ;; + s390*-*linux*|s390*-*tpf*) + LD="${LD-ld} -m elf64_s390" + ;; + sparc*-*linux*) + LD="${LD-ld} -m elf64_sparc" + ;; + esac + ;; + esac + fi + rm -rf conftest* + ;; + +*-*-sco3.2v5*) + # On SCO OpenServer 5, we need -belf to get full-featured binaries. + SAVE_CFLAGS=$CFLAGS + CFLAGS="$CFLAGS -belf" + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether the C compiler needs -belf" >&5 +$as_echo_n "checking whether the C compiler needs -belf... " >&6; } +if ${lt_cv_cc_needs_belf+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + lt_cv_cc_needs_belf=yes +else + lt_cv_cc_needs_belf=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_cc_needs_belf" >&5 +$as_echo "$lt_cv_cc_needs_belf" >&6; } + if test yes != "$lt_cv_cc_needs_belf"; then + # this is probably gcc 2.8.0, egcs 1.0 or newer; no need for -belf + CFLAGS=$SAVE_CFLAGS + fi + ;; +*-*solaris*) + # Find out what ABI is being produced by ac_compile, and set linker + # options accordingly. + echo 'int i;' > conftest.$ac_ext + if { { eval echo "\"\$as_me\":${as_lineno-$LINENO}: \"$ac_compile\""; } >&5 + (eval $ac_compile) 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; }; then + case `/usr/bin/file conftest.o` in + *64-bit*) + case $lt_cv_prog_gnu_ld in + yes*) + case $host in + i?86-*-solaris*|x86_64-*-solaris*) + LD="${LD-ld} -m elf_x86_64" + ;; + sparc*-*-solaris*) + LD="${LD-ld} -m elf64_sparc" + ;; + esac + # GNU ld 2.21 introduced _sol2 emulations. Use them if available. + if ${LD-ld} -V | grep _sol2 >/dev/null 2>&1; then + LD=${LD-ld}_sol2 + fi + ;; + *) + if ${LD-ld} -64 -r -o conftest2.o conftest.o >/dev/null 2>&1; then + LD="${LD-ld} -64" + fi + ;; + esac + ;; + esac + fi + rm -rf conftest* + ;; +esac + +need_locks=$enable_libtool_lock + +if test -n "$ac_tool_prefix"; then + # Extract the first word of "${ac_tool_prefix}mt", so it can be a program name with args. +set dummy ${ac_tool_prefix}mt; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_MANIFEST_TOOL+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$MANIFEST_TOOL"; then + ac_cv_prog_MANIFEST_TOOL="$MANIFEST_TOOL" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_MANIFEST_TOOL="${ac_tool_prefix}mt" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +MANIFEST_TOOL=$ac_cv_prog_MANIFEST_TOOL +if test -n "$MANIFEST_TOOL"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $MANIFEST_TOOL" >&5 +$as_echo "$MANIFEST_TOOL" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + +fi +if test -z "$ac_cv_prog_MANIFEST_TOOL"; then + ac_ct_MANIFEST_TOOL=$MANIFEST_TOOL + # Extract the first word of "mt", so it can be a program name with args. +set dummy mt; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_ac_ct_MANIFEST_TOOL+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$ac_ct_MANIFEST_TOOL"; then + ac_cv_prog_ac_ct_MANIFEST_TOOL="$ac_ct_MANIFEST_TOOL" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_ac_ct_MANIFEST_TOOL="mt" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +ac_ct_MANIFEST_TOOL=$ac_cv_prog_ac_ct_MANIFEST_TOOL +if test -n "$ac_ct_MANIFEST_TOOL"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_MANIFEST_TOOL" >&5 +$as_echo "$ac_ct_MANIFEST_TOOL" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + if test "x$ac_ct_MANIFEST_TOOL" = x; then + MANIFEST_TOOL=":" + else + case $cross_compiling:$ac_tool_warned in +yes:) +{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 +$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} +ac_tool_warned=yes ;; +esac + MANIFEST_TOOL=$ac_ct_MANIFEST_TOOL + fi +else + MANIFEST_TOOL="$ac_cv_prog_MANIFEST_TOOL" +fi + +test -z "$MANIFEST_TOOL" && MANIFEST_TOOL=mt +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking if $MANIFEST_TOOL is a manifest tool" >&5 +$as_echo_n "checking if $MANIFEST_TOOL is a manifest tool... " >&6; } +if ${lt_cv_path_mainfest_tool+:} false; then : + $as_echo_n "(cached) " >&6 +else + lt_cv_path_mainfest_tool=no + echo "$as_me:$LINENO: $MANIFEST_TOOL '-?'" >&5 + $MANIFEST_TOOL '-?' 2>conftest.err > conftest.out + cat conftest.err >&5 + if $GREP 'Manifest Tool' conftest.out > /dev/null; then + lt_cv_path_mainfest_tool=yes + fi + rm -f conftest* +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_path_mainfest_tool" >&5 +$as_echo "$lt_cv_path_mainfest_tool" >&6; } +if test yes != "$lt_cv_path_mainfest_tool"; then + MANIFEST_TOOL=: +fi + + + + + + + case $host_os in + rhapsody* | darwin*) + if test -n "$ac_tool_prefix"; then + # Extract the first word of "${ac_tool_prefix}dsymutil", so it can be a program name with args. +set dummy ${ac_tool_prefix}dsymutil; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_DSYMUTIL+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$DSYMUTIL"; then + ac_cv_prog_DSYMUTIL="$DSYMUTIL" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_DSYMUTIL="${ac_tool_prefix}dsymutil" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +DSYMUTIL=$ac_cv_prog_DSYMUTIL +if test -n "$DSYMUTIL"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $DSYMUTIL" >&5 +$as_echo "$DSYMUTIL" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + +fi +if test -z "$ac_cv_prog_DSYMUTIL"; then + ac_ct_DSYMUTIL=$DSYMUTIL + # Extract the first word of "dsymutil", so it can be a program name with args. +set dummy dsymutil; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_ac_ct_DSYMUTIL+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$ac_ct_DSYMUTIL"; then + ac_cv_prog_ac_ct_DSYMUTIL="$ac_ct_DSYMUTIL" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_ac_ct_DSYMUTIL="dsymutil" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +ac_ct_DSYMUTIL=$ac_cv_prog_ac_ct_DSYMUTIL +if test -n "$ac_ct_DSYMUTIL"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_DSYMUTIL" >&5 +$as_echo "$ac_ct_DSYMUTIL" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + if test "x$ac_ct_DSYMUTIL" = x; then + DSYMUTIL=":" + else + case $cross_compiling:$ac_tool_warned in +yes:) +{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 +$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} +ac_tool_warned=yes ;; +esac + DSYMUTIL=$ac_ct_DSYMUTIL + fi +else + DSYMUTIL="$ac_cv_prog_DSYMUTIL" +fi + + if test -n "$ac_tool_prefix"; then + # Extract the first word of "${ac_tool_prefix}nmedit", so it can be a program name with args. +set dummy ${ac_tool_prefix}nmedit; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_NMEDIT+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$NMEDIT"; then + ac_cv_prog_NMEDIT="$NMEDIT" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_NMEDIT="${ac_tool_prefix}nmedit" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +NMEDIT=$ac_cv_prog_NMEDIT +if test -n "$NMEDIT"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $NMEDIT" >&5 +$as_echo "$NMEDIT" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + +fi +if test -z "$ac_cv_prog_NMEDIT"; then + ac_ct_NMEDIT=$NMEDIT + # Extract the first word of "nmedit", so it can be a program name with args. +set dummy nmedit; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_ac_ct_NMEDIT+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$ac_ct_NMEDIT"; then + ac_cv_prog_ac_ct_NMEDIT="$ac_ct_NMEDIT" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_ac_ct_NMEDIT="nmedit" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +ac_ct_NMEDIT=$ac_cv_prog_ac_ct_NMEDIT +if test -n "$ac_ct_NMEDIT"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_NMEDIT" >&5 +$as_echo "$ac_ct_NMEDIT" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + if test "x$ac_ct_NMEDIT" = x; then + NMEDIT=":" + else + case $cross_compiling:$ac_tool_warned in +yes:) +{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 +$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} +ac_tool_warned=yes ;; +esac + NMEDIT=$ac_ct_NMEDIT + fi +else + NMEDIT="$ac_cv_prog_NMEDIT" +fi + + if test -n "$ac_tool_prefix"; then + # Extract the first word of "${ac_tool_prefix}lipo", so it can be a program name with args. +set dummy ${ac_tool_prefix}lipo; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_LIPO+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$LIPO"; then + ac_cv_prog_LIPO="$LIPO" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_LIPO="${ac_tool_prefix}lipo" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +LIPO=$ac_cv_prog_LIPO +if test -n "$LIPO"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $LIPO" >&5 +$as_echo "$LIPO" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + +fi +if test -z "$ac_cv_prog_LIPO"; then + ac_ct_LIPO=$LIPO + # Extract the first word of "lipo", so it can be a program name with args. +set dummy lipo; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_ac_ct_LIPO+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$ac_ct_LIPO"; then + ac_cv_prog_ac_ct_LIPO="$ac_ct_LIPO" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_ac_ct_LIPO="lipo" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +ac_ct_LIPO=$ac_cv_prog_ac_ct_LIPO +if test -n "$ac_ct_LIPO"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_LIPO" >&5 +$as_echo "$ac_ct_LIPO" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + if test "x$ac_ct_LIPO" = x; then + LIPO=":" + else + case $cross_compiling:$ac_tool_warned in +yes:) +{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 +$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} +ac_tool_warned=yes ;; +esac + LIPO=$ac_ct_LIPO + fi +else + LIPO="$ac_cv_prog_LIPO" +fi + + if test -n "$ac_tool_prefix"; then + # Extract the first word of "${ac_tool_prefix}otool", so it can be a program name with args. +set dummy ${ac_tool_prefix}otool; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_OTOOL+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$OTOOL"; then + ac_cv_prog_OTOOL="$OTOOL" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_OTOOL="${ac_tool_prefix}otool" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +OTOOL=$ac_cv_prog_OTOOL +if test -n "$OTOOL"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $OTOOL" >&5 +$as_echo "$OTOOL" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + +fi +if test -z "$ac_cv_prog_OTOOL"; then + ac_ct_OTOOL=$OTOOL + # Extract the first word of "otool", so it can be a program name with args. +set dummy otool; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_ac_ct_OTOOL+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$ac_ct_OTOOL"; then + ac_cv_prog_ac_ct_OTOOL="$ac_ct_OTOOL" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_ac_ct_OTOOL="otool" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +ac_ct_OTOOL=$ac_cv_prog_ac_ct_OTOOL +if test -n "$ac_ct_OTOOL"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_OTOOL" >&5 +$as_echo "$ac_ct_OTOOL" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + if test "x$ac_ct_OTOOL" = x; then + OTOOL=":" + else + case $cross_compiling:$ac_tool_warned in +yes:) +{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 +$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} +ac_tool_warned=yes ;; +esac + OTOOL=$ac_ct_OTOOL + fi +else + OTOOL="$ac_cv_prog_OTOOL" +fi + + if test -n "$ac_tool_prefix"; then + # Extract the first word of "${ac_tool_prefix}otool64", so it can be a program name with args. +set dummy ${ac_tool_prefix}otool64; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_OTOOL64+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$OTOOL64"; then + ac_cv_prog_OTOOL64="$OTOOL64" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_OTOOL64="${ac_tool_prefix}otool64" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +OTOOL64=$ac_cv_prog_OTOOL64 +if test -n "$OTOOL64"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $OTOOL64" >&5 +$as_echo "$OTOOL64" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + +fi +if test -z "$ac_cv_prog_OTOOL64"; then + ac_ct_OTOOL64=$OTOOL64 + # Extract the first word of "otool64", so it can be a program name with args. +set dummy otool64; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_ac_ct_OTOOL64+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$ac_ct_OTOOL64"; then + ac_cv_prog_ac_ct_OTOOL64="$ac_ct_OTOOL64" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_ac_ct_OTOOL64="otool64" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +ac_ct_OTOOL64=$ac_cv_prog_ac_ct_OTOOL64 +if test -n "$ac_ct_OTOOL64"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_OTOOL64" >&5 +$as_echo "$ac_ct_OTOOL64" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + if test "x$ac_ct_OTOOL64" = x; then + OTOOL64=":" + else + case $cross_compiling:$ac_tool_warned in +yes:) +{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 +$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} +ac_tool_warned=yes ;; +esac + OTOOL64=$ac_ct_OTOOL64 + fi +else + OTOOL64="$ac_cv_prog_OTOOL64" +fi + + + + + + + + + + + + + + + + + + + + + + + + + + + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for -single_module linker flag" >&5 +$as_echo_n "checking for -single_module linker flag... " >&6; } +if ${lt_cv_apple_cc_single_mod+:} false; then : + $as_echo_n "(cached) " >&6 +else + lt_cv_apple_cc_single_mod=no + if test -z "$LT_MULTI_MODULE"; then + # By default we will add the -single_module flag. You can override + # by either setting the environment variable LT_MULTI_MODULE + # non-empty at configure time, or by adding -multi_module to the + # link flags. + rm -rf libconftest.dylib* + echo "int foo(void){return 1;}" > conftest.c + echo "$LTCC $LTCFLAGS $LDFLAGS -o libconftest.dylib \ +-dynamiclib -Wl,-single_module conftest.c" >&5 + $LTCC $LTCFLAGS $LDFLAGS -o libconftest.dylib \ + -dynamiclib -Wl,-single_module conftest.c 2>conftest.err + _lt_result=$? + # If there is a non-empty error log, and "single_module" + # appears in it, assume the flag caused a linker warning + if test -s conftest.err && $GREP single_module conftest.err; then + cat conftest.err >&5 + # Otherwise, if the output was created with a 0 exit code from + # the compiler, it worked. + elif test -f libconftest.dylib && test 0 = "$_lt_result"; then + lt_cv_apple_cc_single_mod=yes + else + cat conftest.err >&5 + fi + rm -rf libconftest.dylib* + rm -f conftest.* + fi +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_apple_cc_single_mod" >&5 +$as_echo "$lt_cv_apple_cc_single_mod" >&6; } + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for -exported_symbols_list linker flag" >&5 +$as_echo_n "checking for -exported_symbols_list linker flag... " >&6; } +if ${lt_cv_ld_exported_symbols_list+:} false; then : + $as_echo_n "(cached) " >&6 +else + lt_cv_ld_exported_symbols_list=no + save_LDFLAGS=$LDFLAGS + echo "_main" > conftest.sym + LDFLAGS="$LDFLAGS -Wl,-exported_symbols_list,conftest.sym" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + lt_cv_ld_exported_symbols_list=yes +else + lt_cv_ld_exported_symbols_list=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + LDFLAGS=$save_LDFLAGS + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_ld_exported_symbols_list" >&5 +$as_echo "$lt_cv_ld_exported_symbols_list" >&6; } + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for -force_load linker flag" >&5 +$as_echo_n "checking for -force_load linker flag... " >&6; } +if ${lt_cv_ld_force_load+:} false; then : + $as_echo_n "(cached) " >&6 +else + lt_cv_ld_force_load=no + cat > conftest.c << _LT_EOF +int forced_loaded() { return 2;} +_LT_EOF + echo "$LTCC $LTCFLAGS -c -o conftest.o conftest.c" >&5 + $LTCC $LTCFLAGS -c -o conftest.o conftest.c 2>&5 + echo "$AR cru libconftest.a conftest.o" >&5 + $AR cru libconftest.a conftest.o 2>&5 + echo "$RANLIB libconftest.a" >&5 + $RANLIB libconftest.a 2>&5 + cat > conftest.c << _LT_EOF +int main() { return 0;} +_LT_EOF + echo "$LTCC $LTCFLAGS $LDFLAGS -o conftest conftest.c -Wl,-force_load,./libconftest.a" >&5 + $LTCC $LTCFLAGS $LDFLAGS -o conftest conftest.c -Wl,-force_load,./libconftest.a 2>conftest.err + _lt_result=$? + if test -s conftest.err && $GREP force_load conftest.err; then + cat conftest.err >&5 + elif test -f conftest && test 0 = "$_lt_result" && $GREP forced_load conftest >/dev/null 2>&1; then + lt_cv_ld_force_load=yes + else + cat conftest.err >&5 + fi + rm -f conftest.err libconftest.a conftest conftest.c + rm -rf conftest.dSYM + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_ld_force_load" >&5 +$as_echo "$lt_cv_ld_force_load" >&6; } + case $host_os in + rhapsody* | darwin1.[012]) + _lt_dar_allow_undefined='$wl-undefined ${wl}suppress' ;; + darwin1.*) + _lt_dar_allow_undefined='$wl-flat_namespace $wl-undefined ${wl}suppress' ;; + darwin*) # darwin 5.x on + # if running on 10.5 or later, the deployment target defaults + # to the OS version, if on x86, and 10.4, the deployment + # target defaults to 10.4. Don't you love it? + case ${MACOSX_DEPLOYMENT_TARGET-10.0},$host in + 10.0,*86*-darwin8*|10.0,*-darwin[91]*) + _lt_dar_allow_undefined='$wl-undefined ${wl}dynamic_lookup' ;; + 10.[012][,.]*) + _lt_dar_allow_undefined='$wl-flat_namespace $wl-undefined ${wl}suppress' ;; + 10.*) + _lt_dar_allow_undefined='$wl-undefined ${wl}dynamic_lookup' ;; + esac + ;; + esac + if test yes = "$lt_cv_apple_cc_single_mod"; then + _lt_dar_single_mod='$single_module' + fi + if test yes = "$lt_cv_ld_exported_symbols_list"; then + _lt_dar_export_syms=' $wl-exported_symbols_list,$output_objdir/$libname-symbols.expsym' + else + _lt_dar_export_syms='~$NMEDIT -s $output_objdir/$libname-symbols.expsym $lib' + fi + if test : != "$DSYMUTIL" && test no = "$lt_cv_ld_force_load"; then + _lt_dsymutil='~$DSYMUTIL $lib || :' + else + _lt_dsymutil= + fi + ;; + esac + +# func_munge_path_list VARIABLE PATH +# ----------------------------------- +# VARIABLE is name of variable containing _space_ separated list of +# directories to be munged by the contents of PATH, which is string +# having a format: +# "DIR[:DIR]:" +# string "DIR[ DIR]" will be prepended to VARIABLE +# ":DIR[:DIR]" +# string "DIR[ DIR]" will be appended to VARIABLE +# "DIRP[:DIRP]::[DIRA:]DIRA" +# string "DIRP[ DIRP]" will be prepended to VARIABLE and string +# "DIRA[ DIRA]" will be appended to VARIABLE +# "DIR[:DIR]" +# VARIABLE will be replaced by "DIR[ DIR]" +func_munge_path_list () +{ + case x$2 in + x) + ;; + *:) + eval $1=\"`$ECHO $2 | $SED 's/:/ /g'` \$$1\" + ;; + x:*) + eval $1=\"\$$1 `$ECHO $2 | $SED 's/:/ /g'`\" + ;; + *::*) + eval $1=\"\$$1\ `$ECHO $2 | $SED -e 's/.*:://' -e 's/:/ /g'`\" + eval $1=\"`$ECHO $2 | $SED -e 's/::.*//' -e 's/:/ /g'`\ \$$1\" + ;; + *) + eval $1=\"`$ECHO $2 | $SED 's/:/ /g'`\" + ;; + esac +} + +for ac_header in dlfcn.h +do : + ac_fn_c_check_header_compile "$LINENO" "dlfcn.h" "ac_cv_header_dlfcn_h" "$ac_includes_default +" +if test "x$ac_cv_header_dlfcn_h" = xyes; then : + cat >>confdefs.h <<_ACEOF +#define HAVE_DLFCN_H 1 +_ACEOF + +fi + +done + + + +func_stripname_cnf () +{ + case $2 in + .*) func_stripname_result=`$ECHO "$3" | $SED "s%^$1%%; s%\\\\$2\$%%"`;; + *) func_stripname_result=`$ECHO "$3" | $SED "s%^$1%%; s%$2\$%%"`;; + esac +} # func_stripname_cnf + + + + + + +# Set options + + + + enable_dlopen=no + + + enable_win32_dll=no + + + # Check whether --enable-shared was given. +if test "${enable_shared+set}" = set; then : + enableval=$enable_shared; p=${PACKAGE-default} + case $enableval in + yes) enable_shared=yes ;; + no) enable_shared=no ;; + *) + enable_shared=no + # Look at the argument we got. We use all the common list separators. + lt_save_ifs=$IFS; IFS=$IFS$PATH_SEPARATOR, + for pkg in $enableval; do + IFS=$lt_save_ifs + if test "X$pkg" = "X$p"; then + enable_shared=yes + fi + done + IFS=$lt_save_ifs + ;; + esac +else + enable_shared=yes +fi + + + + + + + + + + + +# Check whether --with-pic was given. +if test "${with_pic+set}" = set; then : + withval=$with_pic; lt_p=${PACKAGE-default} + case $withval in + yes|no) pic_mode=$withval ;; + *) + pic_mode=default + # Look at the argument we got. We use all the common list separators. + lt_save_ifs=$IFS; IFS=$IFS$PATH_SEPARATOR, + for lt_pkg in $withval; do + IFS=$lt_save_ifs + if test "X$lt_pkg" = "X$lt_p"; then + pic_mode=yes + fi + done + IFS=$lt_save_ifs + ;; + esac +else + pic_mode=default +fi + + + + + + + + + # Check whether --enable-fast-install was given. +if test "${enable_fast_install+set}" = set; then : + enableval=$enable_fast_install; p=${PACKAGE-default} + case $enableval in + yes) enable_fast_install=yes ;; + no) enable_fast_install=no ;; + *) + enable_fast_install=no + # Look at the argument we got. We use all the common list separators. + lt_save_ifs=$IFS; IFS=$IFS$PATH_SEPARATOR, + for pkg in $enableval; do + IFS=$lt_save_ifs + if test "X$pkg" = "X$p"; then + enable_fast_install=yes + fi + done + IFS=$lt_save_ifs + ;; + esac +else + enable_fast_install=yes +fi + + + + + + + + + shared_archive_member_spec= +case $host,$enable_shared in +power*-*-aix[5-9]*,yes) + { $as_echo "$as_me:${as_lineno-$LINENO}: checking which variant of shared library versioning to provide" >&5 +$as_echo_n "checking which variant of shared library versioning to provide... " >&6; } + +# Check whether --with-aix-soname was given. +if test "${with_aix_soname+set}" = set; then : + withval=$with_aix_soname; case $withval in + aix|svr4|both) + ;; + *) + as_fn_error $? "Unknown argument to --with-aix-soname" "$LINENO" 5 + ;; + esac + lt_cv_with_aix_soname=$with_aix_soname +else + if ${lt_cv_with_aix_soname+:} false; then : + $as_echo_n "(cached) " >&6 +else + lt_cv_with_aix_soname=aix +fi + + with_aix_soname=$lt_cv_with_aix_soname +fi + + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $with_aix_soname" >&5 +$as_echo "$with_aix_soname" >&6; } + if test aix != "$with_aix_soname"; then + # For the AIX way of multilib, we name the shared archive member + # based on the bitwidth used, traditionally 'shr.o' or 'shr_64.o', + # and 'shr.imp' or 'shr_64.imp', respectively, for the Import File. + # Even when GNU compilers ignore OBJECT_MODE but need '-maix64' flag, + # the AIX toolchain works better with OBJECT_MODE set (default 32). + if test 64 = "${OBJECT_MODE-32}"; then + shared_archive_member_spec=shr_64 + else + shared_archive_member_spec=shr + fi + fi + ;; +*) + with_aix_soname=aix + ;; +esac + + + + + + + + + + +# This can be used to rebuild libtool when needed +LIBTOOL_DEPS=$ltmain + +# Always use our own libtool. +LIBTOOL='$(SHELL) $(top_builddir)/libtool' + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +test -z "$LN_S" && LN_S="ln -s" + + + + + + + + + + + + + + +if test -n "${ZSH_VERSION+set}"; then + setopt NO_GLOB_SUBST +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for objdir" >&5 +$as_echo_n "checking for objdir... " >&6; } +if ${lt_cv_objdir+:} false; then : + $as_echo_n "(cached) " >&6 +else + rm -f .libs 2>/dev/null +mkdir .libs 2>/dev/null +if test -d .libs; then + lt_cv_objdir=.libs +else + # MS-DOS does not allow filenames that begin with a dot. + lt_cv_objdir=_libs +fi +rmdir .libs 2>/dev/null +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_objdir" >&5 +$as_echo "$lt_cv_objdir" >&6; } +objdir=$lt_cv_objdir + + + + + +cat >>confdefs.h <<_ACEOF +#define LT_OBJDIR "$lt_cv_objdir/" +_ACEOF + + + + +case $host_os in +aix3*) + # AIX sometimes has problems with the GCC collect2 program. For some + # reason, if we set the COLLECT_NAMES environment variable, the problems + # vanish in a puff of smoke. + if test set != "${COLLECT_NAMES+set}"; then + COLLECT_NAMES= + export COLLECT_NAMES + fi + ;; +esac + +# Global variables: +ofile=libtool +can_build_shared=yes + +# All known linkers require a '.a' archive for static linking (except MSVC, +# which needs '.lib'). +libext=a + +with_gnu_ld=$lt_cv_prog_gnu_ld + +old_CC=$CC +old_CFLAGS=$CFLAGS + +# Set sane defaults for various variables +test -z "$CC" && CC=cc +test -z "$LTCC" && LTCC=$CC +test -z "$LTCFLAGS" && LTCFLAGS=$CFLAGS +test -z "$LD" && LD=ld +test -z "$ac_objext" && ac_objext=o + +func_cc_basename $compiler +cc_basename=$func_cc_basename_result + + +# Only perform the check for file, if the check method requires it +test -z "$MAGIC_CMD" && MAGIC_CMD=file +case $deplibs_check_method in +file_magic*) + if test "$file_magic_cmd" = '$MAGIC_CMD'; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for ${ac_tool_prefix}file" >&5 +$as_echo_n "checking for ${ac_tool_prefix}file... " >&6; } +if ${lt_cv_path_MAGIC_CMD+:} false; then : + $as_echo_n "(cached) " >&6 +else + case $MAGIC_CMD in +[\\/*] | ?:[\\/]*) + lt_cv_path_MAGIC_CMD=$MAGIC_CMD # Let the user override the test with a path. + ;; +*) + lt_save_MAGIC_CMD=$MAGIC_CMD + lt_save_ifs=$IFS; IFS=$PATH_SEPARATOR + ac_dummy="/usr/bin$PATH_SEPARATOR$PATH" + for ac_dir in $ac_dummy; do + IFS=$lt_save_ifs + test -z "$ac_dir" && ac_dir=. + if test -f "$ac_dir/${ac_tool_prefix}file"; then + lt_cv_path_MAGIC_CMD=$ac_dir/"${ac_tool_prefix}file" + if test -n "$file_magic_test_file"; then + case $deplibs_check_method in + "file_magic "*) + file_magic_regex=`expr "$deplibs_check_method" : "file_magic \(.*\)"` + MAGIC_CMD=$lt_cv_path_MAGIC_CMD + if eval $file_magic_cmd \$file_magic_test_file 2> /dev/null | + $EGREP "$file_magic_regex" > /dev/null; then + : + else + cat <<_LT_EOF 1>&2 + +*** Warning: the command libtool uses to detect shared libraries, +*** $file_magic_cmd, produces output that libtool cannot recognize. +*** The result is that libtool may fail to recognize shared libraries +*** as such. This will affect the creation of libtool libraries that +*** depend on shared libraries, but programs linked with such libtool +*** libraries will work regardless of this problem. Nevertheless, you +*** may want to report the problem to your system manager and/or to +*** bug-libtool@gnu.org + +_LT_EOF + fi ;; + esac + fi + break + fi + done + IFS=$lt_save_ifs + MAGIC_CMD=$lt_save_MAGIC_CMD + ;; +esac +fi + +MAGIC_CMD=$lt_cv_path_MAGIC_CMD +if test -n "$MAGIC_CMD"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $MAGIC_CMD" >&5 +$as_echo "$MAGIC_CMD" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + + + +if test -z "$lt_cv_path_MAGIC_CMD"; then + if test -n "$ac_tool_prefix"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for file" >&5 +$as_echo_n "checking for file... " >&6; } +if ${lt_cv_path_MAGIC_CMD+:} false; then : + $as_echo_n "(cached) " >&6 +else + case $MAGIC_CMD in +[\\/*] | ?:[\\/]*) + lt_cv_path_MAGIC_CMD=$MAGIC_CMD # Let the user override the test with a path. + ;; +*) + lt_save_MAGIC_CMD=$MAGIC_CMD + lt_save_ifs=$IFS; IFS=$PATH_SEPARATOR + ac_dummy="/usr/bin$PATH_SEPARATOR$PATH" + for ac_dir in $ac_dummy; do + IFS=$lt_save_ifs + test -z "$ac_dir" && ac_dir=. + if test -f "$ac_dir/file"; then + lt_cv_path_MAGIC_CMD=$ac_dir/"file" + if test -n "$file_magic_test_file"; then + case $deplibs_check_method in + "file_magic "*) + file_magic_regex=`expr "$deplibs_check_method" : "file_magic \(.*\)"` + MAGIC_CMD=$lt_cv_path_MAGIC_CMD + if eval $file_magic_cmd \$file_magic_test_file 2> /dev/null | + $EGREP "$file_magic_regex" > /dev/null; then + : + else + cat <<_LT_EOF 1>&2 + +*** Warning: the command libtool uses to detect shared libraries, +*** $file_magic_cmd, produces output that libtool cannot recognize. +*** The result is that libtool may fail to recognize shared libraries +*** as such. This will affect the creation of libtool libraries that +*** depend on shared libraries, but programs linked with such libtool +*** libraries will work regardless of this problem. Nevertheless, you +*** may want to report the problem to your system manager and/or to +*** bug-libtool@gnu.org + +_LT_EOF + fi ;; + esac + fi + break + fi + done + IFS=$lt_save_ifs + MAGIC_CMD=$lt_save_MAGIC_CMD + ;; +esac +fi + +MAGIC_CMD=$lt_cv_path_MAGIC_CMD +if test -n "$MAGIC_CMD"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $MAGIC_CMD" >&5 +$as_echo "$MAGIC_CMD" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + else + MAGIC_CMD=: + fi +fi + + fi + ;; +esac + +# Use C for the default configuration in the libtool script + +lt_save_CC=$CC +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + + +# Source file extension for C test sources. +ac_ext=c + +# Object file extension for compiled C test sources. +objext=o +objext=$objext + +# Code to be used in simple compile tests +lt_simple_compile_test_code="int some_variable = 0;" + +# Code to be used in simple link tests +lt_simple_link_test_code='int main(){return(0);}' + + + + + + + +# If no C compiler was specified, use CC. +LTCC=${LTCC-"$CC"} + +# If no C compiler flags were specified, use CFLAGS. +LTCFLAGS=${LTCFLAGS-"$CFLAGS"} + +# Allow CC to be a program name with arguments. +compiler=$CC + +# Save the default compiler, since it gets overwritten when the other +# tags are being tested, and _LT_TAGVAR(compiler, []) is a NOP. +compiler_DEFAULT=$CC + +# save warnings/boilerplate of simple test code +ac_outfile=conftest.$ac_objext +echo "$lt_simple_compile_test_code" >conftest.$ac_ext +eval "$ac_compile" 2>&1 >/dev/null | $SED '/^$/d; /^ *+/d' >conftest.err +_lt_compiler_boilerplate=`cat conftest.err` +$RM conftest* + +ac_outfile=conftest.$ac_objext +echo "$lt_simple_link_test_code" >conftest.$ac_ext +eval "$ac_link" 2>&1 >/dev/null | $SED '/^$/d; /^ *+/d' >conftest.err +_lt_linker_boilerplate=`cat conftest.err` +$RM -r conftest* + + +## CAVEAT EMPTOR: +## There is no encapsulation within the following macros, do not change +## the running order or otherwise move them around unless you know exactly +## what you are doing... +if test -n "$compiler"; then + +lt_prog_compiler_no_builtin_flag= + +if test yes = "$GCC"; then + case $cc_basename in + nvcc*) + lt_prog_compiler_no_builtin_flag=' -Xcompiler -fno-builtin' ;; + *) + lt_prog_compiler_no_builtin_flag=' -fno-builtin' ;; + esac + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking if $compiler supports -fno-rtti -fno-exceptions" >&5 +$as_echo_n "checking if $compiler supports -fno-rtti -fno-exceptions... " >&6; } +if ${lt_cv_prog_compiler_rtti_exceptions+:} false; then : + $as_echo_n "(cached) " >&6 +else + lt_cv_prog_compiler_rtti_exceptions=no + ac_outfile=conftest.$ac_objext + echo "$lt_simple_compile_test_code" > conftest.$ac_ext + lt_compiler_flag="-fno-rtti -fno-exceptions" ## exclude from sc_useless_quotes_in_assignment + # Insert the option either (1) after the last *FLAGS variable, or + # (2) before a word containing "conftest.", or (3) at the end. + # Note that $ac_compile itself does not contain backslashes and begins + # with a dollar sign (not a hyphen), so the echo should work correctly. + # The option is referenced via a variable to avoid confusing sed. + lt_compile=`echo "$ac_compile" | $SED \ + -e 's:.*FLAGS}\{0,1\} :&$lt_compiler_flag :; t' \ + -e 's: [^ ]*conftest\.: $lt_compiler_flag&:; t' \ + -e 's:$: $lt_compiler_flag:'` + (eval echo "\"\$as_me:$LINENO: $lt_compile\"" >&5) + (eval "$lt_compile" 2>conftest.err) + ac_status=$? + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + if (exit $ac_status) && test -s "$ac_outfile"; then + # The compiler can only warn and ignore the option if not recognized + # So say no if there are warnings other than the usual output. + $ECHO "$_lt_compiler_boilerplate" | $SED '/^$/d' >conftest.exp + $SED '/^$/d; /^ *+/d' conftest.err >conftest.er2 + if test ! -s conftest.er2 || diff conftest.exp conftest.er2 >/dev/null; then + lt_cv_prog_compiler_rtti_exceptions=yes + fi + fi + $RM conftest* + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_prog_compiler_rtti_exceptions" >&5 +$as_echo "$lt_cv_prog_compiler_rtti_exceptions" >&6; } + +if test yes = "$lt_cv_prog_compiler_rtti_exceptions"; then + lt_prog_compiler_no_builtin_flag="$lt_prog_compiler_no_builtin_flag -fno-rtti -fno-exceptions" +else + : +fi + +fi + + + + + + + lt_prog_compiler_wl= +lt_prog_compiler_pic= +lt_prog_compiler_static= + + + if test yes = "$GCC"; then + lt_prog_compiler_wl='-Wl,' + lt_prog_compiler_static='-static' + + case $host_os in + aix*) + # All AIX code is PIC. + if test ia64 = "$host_cpu"; then + # AIX 5 now supports IA64 processor + lt_prog_compiler_static='-Bstatic' + fi + lt_prog_compiler_pic='-fPIC' + ;; + + amigaos*) + case $host_cpu in + powerpc) + # see comment about AmigaOS4 .so support + lt_prog_compiler_pic='-fPIC' + ;; + m68k) + # FIXME: we need at least 68020 code to build shared libraries, but + # adding the '-m68020' flag to GCC prevents building anything better, + # like '-m68040'. + lt_prog_compiler_pic='-m68020 -resident32 -malways-restore-a4' + ;; + esac + ;; + + beos* | irix5* | irix6* | nonstopux* | osf3* | osf4* | osf5*) + # PIC is the default for these OSes. + ;; + + mingw* | cygwin* | pw32* | os2* | cegcc*) + # This hack is so that the source file can tell whether it is being + # built for inclusion in a dll (and should export symbols for example). + # Although the cygwin gcc ignores -fPIC, still need this for old-style + # (--disable-auto-import) libraries + lt_prog_compiler_pic='-DDLL_EXPORT' + case $host_os in + os2*) + lt_prog_compiler_static='$wl-static' + ;; + esac + ;; + + darwin* | rhapsody*) + # PIC is the default on this platform + # Common symbols not allowed in MH_DYLIB files + lt_prog_compiler_pic='-fno-common' + ;; + + haiku*) + # PIC is the default for Haiku. + # The "-static" flag exists, but is broken. + lt_prog_compiler_static= + ;; + + hpux*) + # PIC is the default for 64-bit PA HP-UX, but not for 32-bit + # PA HP-UX. On IA64 HP-UX, PIC is the default but the pic flag + # sets the default TLS model and affects inlining. + case $host_cpu in + hppa*64*) + # +Z the default + ;; + *) + lt_prog_compiler_pic='-fPIC' + ;; + esac + ;; + + interix[3-9]*) + # Interix 3.x gcc -fpic/-fPIC options generate broken code. + # Instead, we relocate shared libraries at runtime. + ;; + + msdosdjgpp*) + # Just because we use GCC doesn't mean we suddenly get shared libraries + # on systems that don't support them. + lt_prog_compiler_can_build_shared=no + enable_shared=no + ;; + + *nto* | *qnx*) + # QNX uses GNU C++, but need to define -shared option too, otherwise + # it will coredump. + lt_prog_compiler_pic='-fPIC -shared' + ;; + + sysv4*MP*) + if test -d /usr/nec; then + lt_prog_compiler_pic=-Kconform_pic + fi + ;; + + *) + lt_prog_compiler_pic='-fPIC' + ;; + esac + + case $cc_basename in + nvcc*) # Cuda Compiler Driver 2.2 + lt_prog_compiler_wl='-Xlinker ' + if test -n "$lt_prog_compiler_pic"; then + lt_prog_compiler_pic="-Xcompiler $lt_prog_compiler_pic" + fi + ;; + esac + else + # PORTME Check for flag to pass linker flags through the system compiler. + case $host_os in + aix*) + lt_prog_compiler_wl='-Wl,' + if test ia64 = "$host_cpu"; then + # AIX 5 now supports IA64 processor + lt_prog_compiler_static='-Bstatic' + else + lt_prog_compiler_static='-bnso -bI:/lib/syscalls.exp' + fi + ;; + + darwin* | rhapsody*) + # PIC is the default on this platform + # Common symbols not allowed in MH_DYLIB files + lt_prog_compiler_pic='-fno-common' + case $cc_basename in + nagfor*) + # NAG Fortran compiler + lt_prog_compiler_wl='-Wl,-Wl,,' + lt_prog_compiler_pic='-PIC' + lt_prog_compiler_static='-Bstatic' + ;; + esac + ;; + + mingw* | cygwin* | pw32* | os2* | cegcc*) + # This hack is so that the source file can tell whether it is being + # built for inclusion in a dll (and should export symbols for example). + lt_prog_compiler_pic='-DDLL_EXPORT' + case $host_os in + os2*) + lt_prog_compiler_static='$wl-static' + ;; + esac + ;; + + hpux9* | hpux10* | hpux11*) + lt_prog_compiler_wl='-Wl,' + # PIC is the default for IA64 HP-UX and 64-bit HP-UX, but + # not for PA HP-UX. + case $host_cpu in + hppa*64*|ia64*) + # +Z the default + ;; + *) + lt_prog_compiler_pic='+Z' + ;; + esac + # Is there a better lt_prog_compiler_static that works with the bundled CC? + lt_prog_compiler_static='$wl-a ${wl}archive' + ;; + + irix5* | irix6* | nonstopux*) + lt_prog_compiler_wl='-Wl,' + # PIC (with -KPIC) is the default. + lt_prog_compiler_static='-non_shared' + ;; + + linux* | k*bsd*-gnu | kopensolaris*-gnu | gnu*) + case $cc_basename in + # old Intel for x86_64, which still supported -KPIC. + ecc*) + lt_prog_compiler_wl='-Wl,' + lt_prog_compiler_pic='-KPIC' + lt_prog_compiler_static='-static' + ;; + # icc used to be incompatible with GCC. + # ICC 10 doesn't accept -KPIC any more. + icc* | ifort*) + lt_prog_compiler_wl='-Wl,' + lt_prog_compiler_pic='-fPIC' + lt_prog_compiler_static='-static' + ;; + # Lahey Fortran 8.1. + lf95*) + lt_prog_compiler_wl='-Wl,' + lt_prog_compiler_pic='--shared' + lt_prog_compiler_static='--static' + ;; + nagfor*) + # NAG Fortran compiler + lt_prog_compiler_wl='-Wl,-Wl,,' + lt_prog_compiler_pic='-PIC' + lt_prog_compiler_static='-Bstatic' + ;; + tcc*) + # Fabrice Bellard et al's Tiny C Compiler + lt_prog_compiler_wl='-Wl,' + lt_prog_compiler_pic='-fPIC' + lt_prog_compiler_static='-static' + ;; + pgcc* | pgf77* | pgf90* | pgf95* | pgfortran*) + # Portland Group compilers (*not* the Pentium gcc compiler, + # which looks to be a dead project) + lt_prog_compiler_wl='-Wl,' + lt_prog_compiler_pic='-fpic' + lt_prog_compiler_static='-Bstatic' + ;; + ccc*) + lt_prog_compiler_wl='-Wl,' + # All Alpha code is PIC. + lt_prog_compiler_static='-non_shared' + ;; + xl* | bgxl* | bgf* | mpixl*) + # IBM XL C 8.0/Fortran 10.1, 11.1 on PPC and BlueGene + lt_prog_compiler_wl='-Wl,' + lt_prog_compiler_pic='-qpic' + lt_prog_compiler_static='-qstaticlink' + ;; + *) + case `$CC -V 2>&1 | sed 5q` in + *Sun\ Ceres\ Fortran* | *Sun*Fortran*\ [1-7].* | *Sun*Fortran*\ 8.[0-3]*) + # Sun Fortran 8.3 passes all unrecognized flags to the linker + lt_prog_compiler_pic='-KPIC' + lt_prog_compiler_static='-Bstatic' + lt_prog_compiler_wl='' + ;; + *Sun\ F* | *Sun*Fortran*) + lt_prog_compiler_pic='-KPIC' + lt_prog_compiler_static='-Bstatic' + lt_prog_compiler_wl='-Qoption ld ' + ;; + *Sun\ C*) + # Sun C 5.9 + lt_prog_compiler_pic='-KPIC' + lt_prog_compiler_static='-Bstatic' + lt_prog_compiler_wl='-Wl,' + ;; + *Intel*\ [CF]*Compiler*) + lt_prog_compiler_wl='-Wl,' + lt_prog_compiler_pic='-fPIC' + lt_prog_compiler_static='-static' + ;; + *Portland\ Group*) + lt_prog_compiler_wl='-Wl,' + lt_prog_compiler_pic='-fpic' + lt_prog_compiler_static='-Bstatic' + ;; + esac + ;; + esac + ;; + + newsos6) + lt_prog_compiler_pic='-KPIC' + lt_prog_compiler_static='-Bstatic' + ;; + + *nto* | *qnx*) + # QNX uses GNU C++, but need to define -shared option too, otherwise + # it will coredump. + lt_prog_compiler_pic='-fPIC -shared' + ;; + + osf3* | osf4* | osf5*) + lt_prog_compiler_wl='-Wl,' + # All OSF/1 code is PIC. + lt_prog_compiler_static='-non_shared' + ;; + + rdos*) + lt_prog_compiler_static='-non_shared' + ;; + + solaris*) + lt_prog_compiler_pic='-KPIC' + lt_prog_compiler_static='-Bstatic' + case $cc_basename in + f77* | f90* | f95* | sunf77* | sunf90* | sunf95*) + lt_prog_compiler_wl='-Qoption ld ';; + *) + lt_prog_compiler_wl='-Wl,';; + esac + ;; + + sunos4*) + lt_prog_compiler_wl='-Qoption ld ' + lt_prog_compiler_pic='-PIC' + lt_prog_compiler_static='-Bstatic' + ;; + + sysv4 | sysv4.2uw2* | sysv4.3*) + lt_prog_compiler_wl='-Wl,' + lt_prog_compiler_pic='-KPIC' + lt_prog_compiler_static='-Bstatic' + ;; + + sysv4*MP*) + if test -d /usr/nec; then + lt_prog_compiler_pic='-Kconform_pic' + lt_prog_compiler_static='-Bstatic' + fi + ;; + + sysv5* | unixware* | sco3.2v5* | sco5v6* | OpenUNIX*) + lt_prog_compiler_wl='-Wl,' + lt_prog_compiler_pic='-KPIC' + lt_prog_compiler_static='-Bstatic' + ;; + + unicos*) + lt_prog_compiler_wl='-Wl,' + lt_prog_compiler_can_build_shared=no + ;; + + uts4*) + lt_prog_compiler_pic='-pic' + lt_prog_compiler_static='-Bstatic' + ;; + + *) + lt_prog_compiler_can_build_shared=no + ;; + esac + fi + +case $host_os in + # For platforms that do not support PIC, -DPIC is meaningless: + *djgpp*) + lt_prog_compiler_pic= + ;; + *) + lt_prog_compiler_pic="$lt_prog_compiler_pic -DPIC" + ;; +esac + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $compiler option to produce PIC" >&5 +$as_echo_n "checking for $compiler option to produce PIC... " >&6; } +if ${lt_cv_prog_compiler_pic+:} false; then : + $as_echo_n "(cached) " >&6 +else + lt_cv_prog_compiler_pic=$lt_prog_compiler_pic +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_prog_compiler_pic" >&5 +$as_echo "$lt_cv_prog_compiler_pic" >&6; } +lt_prog_compiler_pic=$lt_cv_prog_compiler_pic + +# +# Check to make sure the PIC flag actually works. +# +if test -n "$lt_prog_compiler_pic"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking if $compiler PIC flag $lt_prog_compiler_pic works" >&5 +$as_echo_n "checking if $compiler PIC flag $lt_prog_compiler_pic works... " >&6; } +if ${lt_cv_prog_compiler_pic_works+:} false; then : + $as_echo_n "(cached) " >&6 +else + lt_cv_prog_compiler_pic_works=no + ac_outfile=conftest.$ac_objext + echo "$lt_simple_compile_test_code" > conftest.$ac_ext + lt_compiler_flag="$lt_prog_compiler_pic -DPIC" ## exclude from sc_useless_quotes_in_assignment + # Insert the option either (1) after the last *FLAGS variable, or + # (2) before a word containing "conftest.", or (3) at the end. + # Note that $ac_compile itself does not contain backslashes and begins + # with a dollar sign (not a hyphen), so the echo should work correctly. + # The option is referenced via a variable to avoid confusing sed. + lt_compile=`echo "$ac_compile" | $SED \ + -e 's:.*FLAGS}\{0,1\} :&$lt_compiler_flag :; t' \ + -e 's: [^ ]*conftest\.: $lt_compiler_flag&:; t' \ + -e 's:$: $lt_compiler_flag:'` + (eval echo "\"\$as_me:$LINENO: $lt_compile\"" >&5) + (eval "$lt_compile" 2>conftest.err) + ac_status=$? + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + if (exit $ac_status) && test -s "$ac_outfile"; then + # The compiler can only warn and ignore the option if not recognized + # So say no if there are warnings other than the usual output. + $ECHO "$_lt_compiler_boilerplate" | $SED '/^$/d' >conftest.exp + $SED '/^$/d; /^ *+/d' conftest.err >conftest.er2 + if test ! -s conftest.er2 || diff conftest.exp conftest.er2 >/dev/null; then + lt_cv_prog_compiler_pic_works=yes + fi + fi + $RM conftest* + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_prog_compiler_pic_works" >&5 +$as_echo "$lt_cv_prog_compiler_pic_works" >&6; } + +if test yes = "$lt_cv_prog_compiler_pic_works"; then + case $lt_prog_compiler_pic in + "" | " "*) ;; + *) lt_prog_compiler_pic=" $lt_prog_compiler_pic" ;; + esac +else + lt_prog_compiler_pic= + lt_prog_compiler_can_build_shared=no +fi + +fi + + + + + + + + + + + +# +# Check to make sure the static flag actually works. +# +wl=$lt_prog_compiler_wl eval lt_tmp_static_flag=\"$lt_prog_compiler_static\" +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking if $compiler static flag $lt_tmp_static_flag works" >&5 +$as_echo_n "checking if $compiler static flag $lt_tmp_static_flag works... " >&6; } +if ${lt_cv_prog_compiler_static_works+:} false; then : + $as_echo_n "(cached) " >&6 +else + lt_cv_prog_compiler_static_works=no + save_LDFLAGS=$LDFLAGS + LDFLAGS="$LDFLAGS $lt_tmp_static_flag" + echo "$lt_simple_link_test_code" > conftest.$ac_ext + if (eval $ac_link 2>conftest.err) && test -s conftest$ac_exeext; then + # The linker can only warn and ignore the option if not recognized + # So say no if there are warnings + if test -s conftest.err; then + # Append any errors to the config.log. + cat conftest.err 1>&5 + $ECHO "$_lt_linker_boilerplate" | $SED '/^$/d' > conftest.exp + $SED '/^$/d; /^ *+/d' conftest.err >conftest.er2 + if diff conftest.exp conftest.er2 >/dev/null; then + lt_cv_prog_compiler_static_works=yes + fi + else + lt_cv_prog_compiler_static_works=yes + fi + fi + $RM -r conftest* + LDFLAGS=$save_LDFLAGS + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_prog_compiler_static_works" >&5 +$as_echo "$lt_cv_prog_compiler_static_works" >&6; } + +if test yes = "$lt_cv_prog_compiler_static_works"; then + : +else + lt_prog_compiler_static= +fi + + + + + + + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking if $compiler supports -c -o file.$ac_objext" >&5 +$as_echo_n "checking if $compiler supports -c -o file.$ac_objext... " >&6; } +if ${lt_cv_prog_compiler_c_o+:} false; then : + $as_echo_n "(cached) " >&6 +else + lt_cv_prog_compiler_c_o=no + $RM -r conftest 2>/dev/null + mkdir conftest + cd conftest + mkdir out + echo "$lt_simple_compile_test_code" > conftest.$ac_ext + + lt_compiler_flag="-o out/conftest2.$ac_objext" + # Insert the option either (1) after the last *FLAGS variable, or + # (2) before a word containing "conftest.", or (3) at the end. + # Note that $ac_compile itself does not contain backslashes and begins + # with a dollar sign (not a hyphen), so the echo should work correctly. + lt_compile=`echo "$ac_compile" | $SED \ + -e 's:.*FLAGS}\{0,1\} :&$lt_compiler_flag :; t' \ + -e 's: [^ ]*conftest\.: $lt_compiler_flag&:; t' \ + -e 's:$: $lt_compiler_flag:'` + (eval echo "\"\$as_me:$LINENO: $lt_compile\"" >&5) + (eval "$lt_compile" 2>out/conftest.err) + ac_status=$? + cat out/conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + if (exit $ac_status) && test -s out/conftest2.$ac_objext + then + # The compiler can only warn and ignore the option if not recognized + # So say no if there are warnings + $ECHO "$_lt_compiler_boilerplate" | $SED '/^$/d' > out/conftest.exp + $SED '/^$/d; /^ *+/d' out/conftest.err >out/conftest.er2 + if test ! -s out/conftest.er2 || diff out/conftest.exp out/conftest.er2 >/dev/null; then + lt_cv_prog_compiler_c_o=yes + fi + fi + chmod u+w . 2>&5 + $RM conftest* + # SGI C++ compiler will create directory out/ii_files/ for + # template instantiation + test -d out/ii_files && $RM out/ii_files/* && rmdir out/ii_files + $RM out/* && rmdir out + cd .. + $RM -r conftest + $RM conftest* + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_prog_compiler_c_o" >&5 +$as_echo "$lt_cv_prog_compiler_c_o" >&6; } + + + + + + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking if $compiler supports -c -o file.$ac_objext" >&5 +$as_echo_n "checking if $compiler supports -c -o file.$ac_objext... " >&6; } +if ${lt_cv_prog_compiler_c_o+:} false; then : + $as_echo_n "(cached) " >&6 +else + lt_cv_prog_compiler_c_o=no + $RM -r conftest 2>/dev/null + mkdir conftest + cd conftest + mkdir out + echo "$lt_simple_compile_test_code" > conftest.$ac_ext + + lt_compiler_flag="-o out/conftest2.$ac_objext" + # Insert the option either (1) after the last *FLAGS variable, or + # (2) before a word containing "conftest.", or (3) at the end. + # Note that $ac_compile itself does not contain backslashes and begins + # with a dollar sign (not a hyphen), so the echo should work correctly. + lt_compile=`echo "$ac_compile" | $SED \ + -e 's:.*FLAGS}\{0,1\} :&$lt_compiler_flag :; t' \ + -e 's: [^ ]*conftest\.: $lt_compiler_flag&:; t' \ + -e 's:$: $lt_compiler_flag:'` + (eval echo "\"\$as_me:$LINENO: $lt_compile\"" >&5) + (eval "$lt_compile" 2>out/conftest.err) + ac_status=$? + cat out/conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + if (exit $ac_status) && test -s out/conftest2.$ac_objext + then + # The compiler can only warn and ignore the option if not recognized + # So say no if there are warnings + $ECHO "$_lt_compiler_boilerplate" | $SED '/^$/d' > out/conftest.exp + $SED '/^$/d; /^ *+/d' out/conftest.err >out/conftest.er2 + if test ! -s out/conftest.er2 || diff out/conftest.exp out/conftest.er2 >/dev/null; then + lt_cv_prog_compiler_c_o=yes + fi + fi + chmod u+w . 2>&5 + $RM conftest* + # SGI C++ compiler will create directory out/ii_files/ for + # template instantiation + test -d out/ii_files && $RM out/ii_files/* && rmdir out/ii_files + $RM out/* && rmdir out + cd .. + $RM -r conftest + $RM conftest* + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_prog_compiler_c_o" >&5 +$as_echo "$lt_cv_prog_compiler_c_o" >&6; } + + + + +hard_links=nottested +if test no = "$lt_cv_prog_compiler_c_o" && test no != "$need_locks"; then + # do not overwrite the value of need_locks provided by the user + { $as_echo "$as_me:${as_lineno-$LINENO}: checking if we can lock with hard links" >&5 +$as_echo_n "checking if we can lock with hard links... " >&6; } + hard_links=yes + $RM conftest* + ln conftest.a conftest.b 2>/dev/null && hard_links=no + touch conftest.a + ln conftest.a conftest.b 2>&5 || hard_links=no + ln conftest.a conftest.b 2>/dev/null && hard_links=no + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $hard_links" >&5 +$as_echo "$hard_links" >&6; } + if test no = "$hard_links"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: '$CC' does not support '-c -o', so 'make -j' may be unsafe" >&5 +$as_echo "$as_me: WARNING: '$CC' does not support '-c -o', so 'make -j' may be unsafe" >&2;} + need_locks=warn + fi +else + need_locks=no +fi + + + + + + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether the $compiler linker ($LD) supports shared libraries" >&5 +$as_echo_n "checking whether the $compiler linker ($LD) supports shared libraries... " >&6; } + + runpath_var= + allow_undefined_flag= + always_export_symbols=no + archive_cmds= + archive_expsym_cmds= + compiler_needs_object=no + enable_shared_with_static_runtimes=no + export_dynamic_flag_spec= + export_symbols_cmds='$NM $libobjs $convenience | $global_symbol_pipe | $SED '\''s/.* //'\'' | sort | uniq > $export_symbols' + hardcode_automatic=no + hardcode_direct=no + hardcode_direct_absolute=no + hardcode_libdir_flag_spec= + hardcode_libdir_separator= + hardcode_minus_L=no + hardcode_shlibpath_var=unsupported + inherit_rpath=no + link_all_deplibs=unknown + module_cmds= + module_expsym_cmds= + old_archive_from_new_cmds= + old_archive_from_expsyms_cmds= + thread_safe_flag_spec= + whole_archive_flag_spec= + # include_expsyms should be a list of space-separated symbols to be *always* + # included in the symbol list + include_expsyms= + # exclude_expsyms can be an extended regexp of symbols to exclude + # it will be wrapped by ' (' and ')$', so one must not match beginning or + # end of line. Example: 'a|bc|.*d.*' will exclude the symbols 'a' and 'bc', + # as well as any symbol that contains 'd'. + exclude_expsyms='_GLOBAL_OFFSET_TABLE_|_GLOBAL__F[ID]_.*' + # Although _GLOBAL_OFFSET_TABLE_ is a valid symbol C name, most a.out + # platforms (ab)use it in PIC code, but their linkers get confused if + # the symbol is explicitly referenced. Since portable code cannot + # rely on this symbol name, it's probably fine to never include it in + # preloaded symbol tables. + # Exclude shared library initialization/finalization symbols. + extract_expsyms_cmds= + + case $host_os in + cygwin* | mingw* | pw32* | cegcc*) + # FIXME: the MSVC++ port hasn't been tested in a loooong time + # When not using gcc, we currently assume that we are using + # Microsoft Visual C++. + if test yes != "$GCC"; then + with_gnu_ld=no + fi + ;; + interix*) + # we just hope/assume this is gcc and not c89 (= MSVC++) + with_gnu_ld=yes + ;; + openbsd* | bitrig*) + with_gnu_ld=no + ;; + esac + + ld_shlibs=yes + + # On some targets, GNU ld is compatible enough with the native linker + # that we're better off using the native interface for both. + lt_use_gnu_ld_interface=no + if test yes = "$with_gnu_ld"; then + case $host_os in + aix*) + # The AIX port of GNU ld has always aspired to compatibility + # with the native linker. However, as the warning in the GNU ld + # block says, versions before 2.19.5* couldn't really create working + # shared libraries, regardless of the interface used. + case `$LD -v 2>&1` in + *\ \(GNU\ Binutils\)\ 2.19.5*) ;; + *\ \(GNU\ Binutils\)\ 2.[2-9]*) ;; + *\ \(GNU\ Binutils\)\ [3-9]*) ;; + *) + lt_use_gnu_ld_interface=yes + ;; + esac + ;; + *) + lt_use_gnu_ld_interface=yes + ;; + esac + fi + + if test yes = "$lt_use_gnu_ld_interface"; then + # If archive_cmds runs LD, not CC, wlarc should be empty + wlarc='$wl' + + # Set some defaults for GNU ld with shared library support. These + # are reset later if shared libraries are not supported. Putting them + # here allows them to be overridden if necessary. + runpath_var=LD_RUN_PATH + hardcode_libdir_flag_spec='$wl-rpath $wl$libdir' + export_dynamic_flag_spec='$wl--export-dynamic' + # ancient GNU ld didn't support --whole-archive et. al. + if $LD --help 2>&1 | $GREP 'no-whole-archive' > /dev/null; then + whole_archive_flag_spec=$wlarc'--whole-archive$convenience '$wlarc'--no-whole-archive' + else + whole_archive_flag_spec= + fi + supports_anon_versioning=no + case `$LD -v | $SED -e 's/(^)\+)\s\+//' 2>&1` in + *GNU\ gold*) supports_anon_versioning=yes ;; + *\ [01].* | *\ 2.[0-9].* | *\ 2.10.*) ;; # catch versions < 2.11 + *\ 2.11.93.0.2\ *) supports_anon_versioning=yes ;; # RH7.3 ... + *\ 2.11.92.0.12\ *) supports_anon_versioning=yes ;; # Mandrake 8.2 ... + *\ 2.11.*) ;; # other 2.11 versions + *) supports_anon_versioning=yes ;; + esac + + # See if GNU ld supports shared libraries. + case $host_os in + aix[3-9]*) + # On AIX/PPC, the GNU linker is very broken + if test ia64 != "$host_cpu"; then + ld_shlibs=no + cat <<_LT_EOF 1>&2 + +*** Warning: the GNU linker, at least up to release 2.19, is reported +*** to be unable to reliably create shared libraries on AIX. +*** Therefore, libtool is disabling shared libraries support. If you +*** really care for shared libraries, you may want to install binutils +*** 2.20 or above, or modify your PATH so that a non-GNU linker is found. +*** You will then need to restart the configuration process. + +_LT_EOF + fi + ;; + + amigaos*) + case $host_cpu in + powerpc) + # see comment about AmigaOS4 .so support + archive_cmds='$CC -shared $libobjs $deplibs $compiler_flags $wl-soname $wl$soname -o $lib' + archive_expsym_cmds='' + ;; + m68k) + archive_cmds='$RM $output_objdir/a2ixlibrary.data~$ECHO "#define NAME $libname" > $output_objdir/a2ixlibrary.data~$ECHO "#define LIBRARY_ID 1" >> $output_objdir/a2ixlibrary.data~$ECHO "#define VERSION $major" >> $output_objdir/a2ixlibrary.data~$ECHO "#define REVISION $revision" >> $output_objdir/a2ixlibrary.data~$AR $AR_FLAGS $lib $libobjs~$RANLIB $lib~(cd $output_objdir && a2ixlibrary -32)' + hardcode_libdir_flag_spec='-L$libdir' + hardcode_minus_L=yes + ;; + esac + ;; + + beos*) + if $LD --help 2>&1 | $GREP ': supported targets:.* elf' > /dev/null; then + allow_undefined_flag=unsupported + # Joseph Beckenbach <jrb3@best.com> says some releases of gcc + # support --undefined. This deserves some investigation. FIXME + archive_cmds='$CC -nostart $libobjs $deplibs $compiler_flags $wl-soname $wl$soname -o $lib' + else + ld_shlibs=no + fi + ;; + + cygwin* | mingw* | pw32* | cegcc*) + # _LT_TAGVAR(hardcode_libdir_flag_spec, ) is actually meaningless, + # as there is no search path for DLLs. + hardcode_libdir_flag_spec='-L$libdir' + export_dynamic_flag_spec='$wl--export-all-symbols' + allow_undefined_flag=unsupported + always_export_symbols=no + enable_shared_with_static_runtimes=yes + export_symbols_cmds='$NM $libobjs $convenience | $global_symbol_pipe | $SED -e '\''/^[BCDGRS][ ]/s/.*[ ]\([^ ]*\)/\1 DATA/;s/^.*[ ]__nm__\([^ ]*\)[ ][^ ]*/\1 DATA/;/^I[ ]/d;/^[AITW][ ]/s/.* //'\'' | sort | uniq > $export_symbols' + exclude_expsyms='[_]+GLOBAL_OFFSET_TABLE_|[_]+GLOBAL__[FID]_.*|[_]+head_[A-Za-z0-9_]+_dll|[A-Za-z0-9_]+_dll_iname' + + if $LD --help 2>&1 | $GREP 'auto-import' > /dev/null; then + archive_cmds='$CC -shared $libobjs $deplibs $compiler_flags -o $output_objdir/$soname $wl--enable-auto-image-base -Xlinker --out-implib -Xlinker $lib' + # If the export-symbols file already is a .def file, use it as + # is; otherwise, prepend EXPORTS... + archive_expsym_cmds='if test DEF = "`$SED -n -e '\''s/^[ ]*//'\'' -e '\''/^\(;.*\)*$/d'\'' -e '\''s/^\(EXPORTS\|LIBRARY\)\([ ].*\)*$/DEF/p'\'' -e q $export_symbols`" ; then + cp $export_symbols $output_objdir/$soname.def; + else + echo EXPORTS > $output_objdir/$soname.def; + cat $export_symbols >> $output_objdir/$soname.def; + fi~ + $CC -shared $output_objdir/$soname.def $libobjs $deplibs $compiler_flags -o $output_objdir/$soname $wl--enable-auto-image-base -Xlinker --out-implib -Xlinker $lib' + else + ld_shlibs=no + fi + ;; + + haiku*) + archive_cmds='$CC -shared $libobjs $deplibs $compiler_flags $wl-soname $wl$soname -o $lib' + link_all_deplibs=yes + ;; + + os2*) + hardcode_libdir_flag_spec='-L$libdir' + hardcode_minus_L=yes + allow_undefined_flag=unsupported + shrext_cmds=.dll + archive_cmds='$ECHO "LIBRARY ${soname%$shared_ext} INITINSTANCE TERMINSTANCE" > $output_objdir/$libname.def~ + $ECHO "DESCRIPTION \"$libname\"" >> $output_objdir/$libname.def~ + $ECHO "DATA MULTIPLE NONSHARED" >> $output_objdir/$libname.def~ + $ECHO EXPORTS >> $output_objdir/$libname.def~ + emxexp $libobjs | $SED /"_DLL_InitTerm"/d >> $output_objdir/$libname.def~ + $CC -Zdll -Zcrtdll -o $output_objdir/$soname $libobjs $deplibs $compiler_flags $output_objdir/$libname.def~ + emximp -o $lib $output_objdir/$libname.def' + archive_expsym_cmds='$ECHO "LIBRARY ${soname%$shared_ext} INITINSTANCE TERMINSTANCE" > $output_objdir/$libname.def~ + $ECHO "DESCRIPTION \"$libname\"" >> $output_objdir/$libname.def~ + $ECHO "DATA MULTIPLE NONSHARED" >> $output_objdir/$libname.def~ + $ECHO EXPORTS >> $output_objdir/$libname.def~ + prefix_cmds="$SED"~ + if test EXPORTS = "`$SED 1q $export_symbols`"; then + prefix_cmds="$prefix_cmds -e 1d"; + fi~ + prefix_cmds="$prefix_cmds -e \"s/^\(.*\)$/_\1/g\""~ + cat $export_symbols | $prefix_cmds >> $output_objdir/$libname.def~ + $CC -Zdll -Zcrtdll -o $output_objdir/$soname $libobjs $deplibs $compiler_flags $output_objdir/$libname.def~ + emximp -o $lib $output_objdir/$libname.def' + old_archive_From_new_cmds='emximp -o $output_objdir/${libname}_dll.a $output_objdir/$libname.def' + enable_shared_with_static_runtimes=yes + ;; + + interix[3-9]*) + hardcode_direct=no + hardcode_shlibpath_var=no + hardcode_libdir_flag_spec='$wl-rpath,$libdir' + export_dynamic_flag_spec='$wl-E' + # Hack: On Interix 3.x, we cannot compile PIC because of a broken gcc. + # Instead, shared libraries are loaded at an image base (0x10000000 by + # default) and relocated if they conflict, which is a slow very memory + # consuming and fragmenting process. To avoid this, we pick a random, + # 256 KiB-aligned image base between 0x50000000 and 0x6FFC0000 at link + # time. Moving up from 0x10000000 also allows more sbrk(2) space. + archive_cmds='$CC -shared $pic_flag $libobjs $deplibs $compiler_flags $wl-h,$soname $wl--image-base,`expr ${RANDOM-$$} % 4096 / 2 \* 262144 + 1342177280` -o $lib' + archive_expsym_cmds='sed "s|^|_|" $export_symbols >$output_objdir/$soname.expsym~$CC -shared $pic_flag $libobjs $deplibs $compiler_flags $wl-h,$soname $wl--retain-symbols-file,$output_objdir/$soname.expsym $wl--image-base,`expr ${RANDOM-$$} % 4096 / 2 \* 262144 + 1342177280` -o $lib' + ;; + + gnu* | linux* | tpf* | k*bsd*-gnu | kopensolaris*-gnu) + tmp_diet=no + if test linux-dietlibc = "$host_os"; then + case $cc_basename in + diet\ *) tmp_diet=yes;; # linux-dietlibc with static linking (!diet-dyn) + esac + fi + if $LD --help 2>&1 | $EGREP ': supported targets:.* elf' > /dev/null \ + && test no = "$tmp_diet" + then + tmp_addflag=' $pic_flag' + tmp_sharedflag='-shared' + case $cc_basename,$host_cpu in + pgcc*) # Portland Group C compiler + whole_archive_flag_spec='$wl--whole-archive`for conv in $convenience\"\"; do test -n \"$conv\" && new_convenience=\"$new_convenience,$conv\"; done; func_echo_all \"$new_convenience\"` $wl--no-whole-archive' + tmp_addflag=' $pic_flag' + ;; + pgf77* | pgf90* | pgf95* | pgfortran*) + # Portland Group f77 and f90 compilers + whole_archive_flag_spec='$wl--whole-archive`for conv in $convenience\"\"; do test -n \"$conv\" && new_convenience=\"$new_convenience,$conv\"; done; func_echo_all \"$new_convenience\"` $wl--no-whole-archive' + tmp_addflag=' $pic_flag -Mnomain' ;; + ecc*,ia64* | icc*,ia64*) # Intel C compiler on ia64 + tmp_addflag=' -i_dynamic' ;; + efc*,ia64* | ifort*,ia64*) # Intel Fortran compiler on ia64 + tmp_addflag=' -i_dynamic -nofor_main' ;; + ifc* | ifort*) # Intel Fortran compiler + tmp_addflag=' -nofor_main' ;; + lf95*) # Lahey Fortran 8.1 + whole_archive_flag_spec= + tmp_sharedflag='--shared' ;; + nagfor*) # NAGFOR 5.3 + tmp_sharedflag='-Wl,-shared' ;; + xl[cC]* | bgxl[cC]* | mpixl[cC]*) # IBM XL C 8.0 on PPC (deal with xlf below) + tmp_sharedflag='-qmkshrobj' + tmp_addflag= ;; + nvcc*) # Cuda Compiler Driver 2.2 + whole_archive_flag_spec='$wl--whole-archive`for conv in $convenience\"\"; do test -n \"$conv\" && new_convenience=\"$new_convenience,$conv\"; done; func_echo_all \"$new_convenience\"` $wl--no-whole-archive' + compiler_needs_object=yes + ;; + esac + case `$CC -V 2>&1 | sed 5q` in + *Sun\ C*) # Sun C 5.9 + whole_archive_flag_spec='$wl--whole-archive`new_convenience=; for conv in $convenience\"\"; do test -z \"$conv\" || new_convenience=\"$new_convenience,$conv\"; done; func_echo_all \"$new_convenience\"` $wl--no-whole-archive' + compiler_needs_object=yes + tmp_sharedflag='-G' ;; + *Sun\ F*) # Sun Fortran 8.3 + tmp_sharedflag='-G' ;; + esac + archive_cmds='$CC '"$tmp_sharedflag""$tmp_addflag"' $libobjs $deplibs $compiler_flags $wl-soname $wl$soname -o $lib' + + if test yes = "$supports_anon_versioning"; then + archive_expsym_cmds='echo "{ global:" > $output_objdir/$libname.ver~ + cat $export_symbols | sed -e "s/\(.*\)/\1;/" >> $output_objdir/$libname.ver~ + echo "local: *; };" >> $output_objdir/$libname.ver~ + $CC '"$tmp_sharedflag""$tmp_addflag"' $libobjs $deplibs $compiler_flags $wl-soname $wl$soname $wl-version-script $wl$output_objdir/$libname.ver -o $lib' + fi + + case $cc_basename in + tcc*) + export_dynamic_flag_spec='-rdynamic' + ;; + xlf* | bgf* | bgxlf* | mpixlf*) + # IBM XL Fortran 10.1 on PPC cannot create shared libs itself + whole_archive_flag_spec='--whole-archive$convenience --no-whole-archive' + hardcode_libdir_flag_spec='$wl-rpath $wl$libdir' + archive_cmds='$LD -shared $libobjs $deplibs $linker_flags -soname $soname -o $lib' + if test yes = "$supports_anon_versioning"; then + archive_expsym_cmds='echo "{ global:" > $output_objdir/$libname.ver~ + cat $export_symbols | sed -e "s/\(.*\)/\1;/" >> $output_objdir/$libname.ver~ + echo "local: *; };" >> $output_objdir/$libname.ver~ + $LD -shared $libobjs $deplibs $linker_flags -soname $soname -version-script $output_objdir/$libname.ver -o $lib' + fi + ;; + esac + else + ld_shlibs=no + fi + ;; + + netbsd*) + if echo __ELF__ | $CC -E - | $GREP __ELF__ >/dev/null; then + archive_cmds='$LD -Bshareable $libobjs $deplibs $linker_flags -o $lib' + wlarc= + else + archive_cmds='$CC -shared $pic_flag $libobjs $deplibs $compiler_flags $wl-soname $wl$soname -o $lib' + archive_expsym_cmds='$CC -shared $pic_flag $libobjs $deplibs $compiler_flags $wl-soname $wl$soname $wl-retain-symbols-file $wl$export_symbols -o $lib' + fi + ;; + + solaris*) + if $LD -v 2>&1 | $GREP 'BFD 2\.8' > /dev/null; then + ld_shlibs=no + cat <<_LT_EOF 1>&2 + +*** Warning: The releases 2.8.* of the GNU linker cannot reliably +*** create shared libraries on Solaris systems. Therefore, libtool +*** is disabling shared libraries support. We urge you to upgrade GNU +*** binutils to release 2.9.1 or newer. Another option is to modify +*** your PATH or compiler configuration so that the native linker is +*** used, and then restart. + +_LT_EOF + elif $LD --help 2>&1 | $GREP ': supported targets:.* elf' > /dev/null; then + archive_cmds='$CC -shared $pic_flag $libobjs $deplibs $compiler_flags $wl-soname $wl$soname -o $lib' + archive_expsym_cmds='$CC -shared $pic_flag $libobjs $deplibs $compiler_flags $wl-soname $wl$soname $wl-retain-symbols-file $wl$export_symbols -o $lib' + else + ld_shlibs=no + fi + ;; + + sysv5* | sco3.2v5* | sco5v6* | unixware* | OpenUNIX*) + case `$LD -v 2>&1` in + *\ [01].* | *\ 2.[0-9].* | *\ 2.1[0-5].*) + ld_shlibs=no + cat <<_LT_EOF 1>&2 + +*** Warning: Releases of the GNU linker prior to 2.16.91.0.3 cannot +*** reliably create shared libraries on SCO systems. Therefore, libtool +*** is disabling shared libraries support. We urge you to upgrade GNU +*** binutils to release 2.16.91.0.3 or newer. Another option is to modify +*** your PATH or compiler configuration so that the native linker is +*** used, and then restart. + +_LT_EOF + ;; + *) + # For security reasons, it is highly recommended that you always + # use absolute paths for naming shared libraries, and exclude the + # DT_RUNPATH tag from executables and libraries. But doing so + # requires that you compile everything twice, which is a pain. + if $LD --help 2>&1 | $GREP ': supported targets:.* elf' > /dev/null; then + hardcode_libdir_flag_spec='$wl-rpath $wl$libdir' + archive_cmds='$CC -shared $libobjs $deplibs $compiler_flags $wl-soname $wl$soname -o $lib' + archive_expsym_cmds='$CC -shared $libobjs $deplibs $compiler_flags $wl-soname $wl$soname $wl-retain-symbols-file $wl$export_symbols -o $lib' + else + ld_shlibs=no + fi + ;; + esac + ;; + + sunos4*) + archive_cmds='$LD -assert pure-text -Bshareable -o $lib $libobjs $deplibs $linker_flags' + wlarc= + hardcode_direct=yes + hardcode_shlibpath_var=no + ;; + + *) + if $LD --help 2>&1 | $GREP ': supported targets:.* elf' > /dev/null; then + archive_cmds='$CC -shared $pic_flag $libobjs $deplibs $compiler_flags $wl-soname $wl$soname -o $lib' + archive_expsym_cmds='$CC -shared $pic_flag $libobjs $deplibs $compiler_flags $wl-soname $wl$soname $wl-retain-symbols-file $wl$export_symbols -o $lib' + else + ld_shlibs=no + fi + ;; + esac + + if test no = "$ld_shlibs"; then + runpath_var= + hardcode_libdir_flag_spec= + export_dynamic_flag_spec= + whole_archive_flag_spec= + fi + else + # PORTME fill in a description of your system's linker (not GNU ld) + case $host_os in + aix3*) + allow_undefined_flag=unsupported + always_export_symbols=yes + archive_expsym_cmds='$LD -o $output_objdir/$soname $libobjs $deplibs $linker_flags -bE:$export_symbols -T512 -H512 -bM:SRE~$AR $AR_FLAGS $lib $output_objdir/$soname' + # Note: this linker hardcodes the directories in LIBPATH if there + # are no directories specified by -L. + hardcode_minus_L=yes + if test yes = "$GCC" && test -z "$lt_prog_compiler_static"; then + # Neither direct hardcoding nor static linking is supported with a + # broken collect2. + hardcode_direct=unsupported + fi + ;; + + aix[4-9]*) + if test ia64 = "$host_cpu"; then + # On IA64, the linker does run time linking by default, so we don't + # have to do anything special. + aix_use_runtimelinking=no + exp_sym_flag='-Bexport' + no_entry_flag= + else + # If we're using GNU nm, then we don't want the "-C" option. + # -C means demangle to GNU nm, but means don't demangle to AIX nm. + # Without the "-l" option, or with the "-B" option, AIX nm treats + # weak defined symbols like other global defined symbols, whereas + # GNU nm marks them as "W". + # While the 'weak' keyword is ignored in the Export File, we need + # it in the Import File for the 'aix-soname' feature, so we have + # to replace the "-B" option with "-P" for AIX nm. + if $NM -V 2>&1 | $GREP 'GNU' > /dev/null; then + export_symbols_cmds='$NM -Bpg $libobjs $convenience | awk '\''{ if (((\$ 2 == "T") || (\$ 2 == "D") || (\$ 2 == "B") || (\$ 2 == "W")) && (substr(\$ 3,1,1) != ".")) { if (\$ 2 == "W") { print \$ 3 " weak" } else { print \$ 3 } } }'\'' | sort -u > $export_symbols' + else + export_symbols_cmds='`func_echo_all $NM | $SED -e '\''s/B\([^B]*\)$/P\1/'\''` -PCpgl $libobjs $convenience | awk '\''{ if (((\$ 2 == "T") || (\$ 2 == "D") || (\$ 2 == "B") || (\$ 2 == "W") || (\$ 2 == "V") || (\$ 2 == "Z")) && (substr(\$ 1,1,1) != ".")) { if ((\$ 2 == "W") || (\$ 2 == "V") || (\$ 2 == "Z")) { print \$ 1 " weak" } else { print \$ 1 } } }'\'' | sort -u > $export_symbols' + fi + aix_use_runtimelinking=no + + # Test if we are trying to use run time linking or normal + # AIX style linking. If -brtl is somewhere in LDFLAGS, we + # have runtime linking enabled, and use it for executables. + # For shared libraries, we enable/disable runtime linking + # depending on the kind of the shared library created - + # when "with_aix_soname,aix_use_runtimelinking" is: + # "aix,no" lib.a(lib.so.V) shared, rtl:no, for executables + # "aix,yes" lib.so shared, rtl:yes, for executables + # lib.a static archive + # "both,no" lib.so.V(shr.o) shared, rtl:yes + # lib.a(lib.so.V) shared, rtl:no, for executables + # "both,yes" lib.so.V(shr.o) shared, rtl:yes, for executables + # lib.a(lib.so.V) shared, rtl:no + # "svr4,*" lib.so.V(shr.o) shared, rtl:yes, for executables + # lib.a static archive + case $host_os in aix4.[23]|aix4.[23].*|aix[5-9]*) + for ld_flag in $LDFLAGS; do + if (test x-brtl = "x$ld_flag" || test x-Wl,-brtl = "x$ld_flag"); then + aix_use_runtimelinking=yes + break + fi + done + if test svr4,no = "$with_aix_soname,$aix_use_runtimelinking"; then + # With aix-soname=svr4, we create the lib.so.V shared archives only, + # so we don't have lib.a shared libs to link our executables. + # We have to force runtime linking in this case. + aix_use_runtimelinking=yes + LDFLAGS="$LDFLAGS -Wl,-brtl" + fi + ;; + esac + + exp_sym_flag='-bexport' + no_entry_flag='-bnoentry' + fi + + # When large executables or shared objects are built, AIX ld can + # have problems creating the table of contents. If linking a library + # or program results in "error TOC overflow" add -mminimal-toc to + # CXXFLAGS/CFLAGS for g++/gcc. In the cases where that is not + # enough to fix the problem, add -Wl,-bbigtoc to LDFLAGS. + + archive_cmds='' + hardcode_direct=yes + hardcode_direct_absolute=yes + hardcode_libdir_separator=':' + link_all_deplibs=yes + file_list_spec='$wl-f,' + case $with_aix_soname,$aix_use_runtimelinking in + aix,*) ;; # traditional, no import file + svr4,* | *,yes) # use import file + # The Import File defines what to hardcode. + hardcode_direct=no + hardcode_direct_absolute=no + ;; + esac + + if test yes = "$GCC"; then + case $host_os in aix4.[012]|aix4.[012].*) + # We only want to do this on AIX 4.2 and lower, the check + # below for broken collect2 doesn't work under 4.3+ + collect2name=`$CC -print-prog-name=collect2` + if test -f "$collect2name" && + strings "$collect2name" | $GREP resolve_lib_name >/dev/null + then + # We have reworked collect2 + : + else + # We have old collect2 + hardcode_direct=unsupported + # It fails to find uninstalled libraries when the uninstalled + # path is not listed in the libpath. Setting hardcode_minus_L + # to unsupported forces relinking + hardcode_minus_L=yes + hardcode_libdir_flag_spec='-L$libdir' + hardcode_libdir_separator= + fi + ;; + esac + shared_flag='-shared' + if test yes = "$aix_use_runtimelinking"; then + shared_flag="$shared_flag "'$wl-G' + fi + # Need to ensure runtime linking is disabled for the traditional + # shared library, or the linker may eventually find shared libraries + # /with/ Import File - we do not want to mix them. + shared_flag_aix='-shared' + shared_flag_svr4='-shared $wl-G' + else + # not using gcc + if test ia64 = "$host_cpu"; then + # VisualAge C++, Version 5.5 for AIX 5L for IA-64, Beta 3 Release + # chokes on -Wl,-G. The following line is correct: + shared_flag='-G' + else + if test yes = "$aix_use_runtimelinking"; then + shared_flag='$wl-G' + else + shared_flag='$wl-bM:SRE' + fi + shared_flag_aix='$wl-bM:SRE' + shared_flag_svr4='$wl-G' + fi + fi + + export_dynamic_flag_spec='$wl-bexpall' + # It seems that -bexpall does not export symbols beginning with + # underscore (_), so it is better to generate a list of symbols to export. + always_export_symbols=yes + if test aix,yes = "$with_aix_soname,$aix_use_runtimelinking"; then + # Warning - without using the other runtime loading flags (-brtl), + # -berok will link without error, but may produce a broken library. + allow_undefined_flag='-berok' + # Determine the default libpath from the value encoded in an + # empty executable. + if test set = "${lt_cv_aix_libpath+set}"; then + aix_libpath=$lt_cv_aix_libpath +else + if ${lt_cv_aix_libpath_+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + + lt_aix_libpath_sed=' + /Import File Strings/,/^$/ { + /^0/ { + s/^0 *\([^ ]*\) *$/\1/ + p + } + }' + lt_cv_aix_libpath_=`dump -H conftest$ac_exeext 2>/dev/null | $SED -n -e "$lt_aix_libpath_sed"` + # Check for a 64-bit object if we didn't find anything. + if test -z "$lt_cv_aix_libpath_"; then + lt_cv_aix_libpath_=`dump -HX64 conftest$ac_exeext 2>/dev/null | $SED -n -e "$lt_aix_libpath_sed"` + fi +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + if test -z "$lt_cv_aix_libpath_"; then + lt_cv_aix_libpath_=/usr/lib:/lib + fi + +fi + + aix_libpath=$lt_cv_aix_libpath_ +fi + + hardcode_libdir_flag_spec='$wl-blibpath:$libdir:'"$aix_libpath" + archive_expsym_cmds='$CC -o $output_objdir/$soname $libobjs $deplibs $wl'$no_entry_flag' $compiler_flags `if test -n "$allow_undefined_flag"; then func_echo_all "$wl$allow_undefined_flag"; else :; fi` $wl'$exp_sym_flag:\$export_symbols' '$shared_flag + else + if test ia64 = "$host_cpu"; then + hardcode_libdir_flag_spec='$wl-R $libdir:/usr/lib:/lib' + allow_undefined_flag="-z nodefs" + archive_expsym_cmds="\$CC $shared_flag"' -o $output_objdir/$soname $libobjs $deplibs '"\$wl$no_entry_flag"' $compiler_flags $wl$allow_undefined_flag '"\$wl$exp_sym_flag:\$export_symbols" + else + # Determine the default libpath from the value encoded in an + # empty executable. + if test set = "${lt_cv_aix_libpath+set}"; then + aix_libpath=$lt_cv_aix_libpath +else + if ${lt_cv_aix_libpath_+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + + lt_aix_libpath_sed=' + /Import File Strings/,/^$/ { + /^0/ { + s/^0 *\([^ ]*\) *$/\1/ + p + } + }' + lt_cv_aix_libpath_=`dump -H conftest$ac_exeext 2>/dev/null | $SED -n -e "$lt_aix_libpath_sed"` + # Check for a 64-bit object if we didn't find anything. + if test -z "$lt_cv_aix_libpath_"; then + lt_cv_aix_libpath_=`dump -HX64 conftest$ac_exeext 2>/dev/null | $SED -n -e "$lt_aix_libpath_sed"` + fi +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + if test -z "$lt_cv_aix_libpath_"; then + lt_cv_aix_libpath_=/usr/lib:/lib + fi + +fi + + aix_libpath=$lt_cv_aix_libpath_ +fi + + hardcode_libdir_flag_spec='$wl-blibpath:$libdir:'"$aix_libpath" + # Warning - without using the other run time loading flags, + # -berok will link without error, but may produce a broken library. + no_undefined_flag=' $wl-bernotok' + allow_undefined_flag=' $wl-berok' + if test yes = "$with_gnu_ld"; then + # We only use this code for GNU lds that support --whole-archive. + whole_archive_flag_spec='$wl--whole-archive$convenience $wl--no-whole-archive' + else + # Exported symbols can be pulled into shared objects from archives + whole_archive_flag_spec='$convenience' + fi + archive_cmds_need_lc=yes + archive_expsym_cmds='$RM -r $output_objdir/$realname.d~$MKDIR $output_objdir/$realname.d' + # -brtl affects multiple linker settings, -berok does not and is overridden later + compiler_flags_filtered='`func_echo_all "$compiler_flags " | $SED -e "s%-brtl\\([, ]\\)%-berok\\1%g"`' + if test svr4 != "$with_aix_soname"; then + # This is similar to how AIX traditionally builds its shared libraries. + archive_expsym_cmds="$archive_expsym_cmds"'~$CC '$shared_flag_aix' -o $output_objdir/$realname.d/$soname $libobjs $deplibs $wl-bnoentry '$compiler_flags_filtered'$wl-bE:$export_symbols$allow_undefined_flag~$AR $AR_FLAGS $output_objdir/$libname$release.a $output_objdir/$realname.d/$soname' + fi + if test aix != "$with_aix_soname"; then + archive_expsym_cmds="$archive_expsym_cmds"'~$CC '$shared_flag_svr4' -o $output_objdir/$realname.d/$shared_archive_member_spec.o $libobjs $deplibs $wl-bnoentry '$compiler_flags_filtered'$wl-bE:$export_symbols$allow_undefined_flag~$STRIP -e $output_objdir/$realname.d/$shared_archive_member_spec.o~( func_echo_all "#! $soname($shared_archive_member_spec.o)"; if test shr_64 = "$shared_archive_member_spec"; then func_echo_all "# 64"; else func_echo_all "# 32"; fi; cat $export_symbols ) > $output_objdir/$realname.d/$shared_archive_member_spec.imp~$AR $AR_FLAGS $output_objdir/$soname $output_objdir/$realname.d/$shared_archive_member_spec.o $output_objdir/$realname.d/$shared_archive_member_spec.imp' + else + # used by -dlpreopen to get the symbols + archive_expsym_cmds="$archive_expsym_cmds"'~$MV $output_objdir/$realname.d/$soname $output_objdir' + fi + archive_expsym_cmds="$archive_expsym_cmds"'~$RM -r $output_objdir/$realname.d' + fi + fi + ;; + + amigaos*) + case $host_cpu in + powerpc) + # see comment about AmigaOS4 .so support + archive_cmds='$CC -shared $libobjs $deplibs $compiler_flags $wl-soname $wl$soname -o $lib' + archive_expsym_cmds='' + ;; + m68k) + archive_cmds='$RM $output_objdir/a2ixlibrary.data~$ECHO "#define NAME $libname" > $output_objdir/a2ixlibrary.data~$ECHO "#define LIBRARY_ID 1" >> $output_objdir/a2ixlibrary.data~$ECHO "#define VERSION $major" >> $output_objdir/a2ixlibrary.data~$ECHO "#define REVISION $revision" >> $output_objdir/a2ixlibrary.data~$AR $AR_FLAGS $lib $libobjs~$RANLIB $lib~(cd $output_objdir && a2ixlibrary -32)' + hardcode_libdir_flag_spec='-L$libdir' + hardcode_minus_L=yes + ;; + esac + ;; + + bsdi[45]*) + export_dynamic_flag_spec=-rdynamic + ;; + + cygwin* | mingw* | pw32* | cegcc*) + # When not using gcc, we currently assume that we are using + # Microsoft Visual C++. + # hardcode_libdir_flag_spec is actually meaningless, as there is + # no search path for DLLs. + case $cc_basename in + cl*) + # Native MSVC + hardcode_libdir_flag_spec=' ' + allow_undefined_flag=unsupported + always_export_symbols=yes + file_list_spec='@' + # Tell ltmain to make .lib files, not .a files. + libext=lib + # Tell ltmain to make .dll files, not .so files. + shrext_cmds=.dll + # FIXME: Setting linknames here is a bad hack. + archive_cmds='$CC -o $output_objdir/$soname $libobjs $compiler_flags $deplibs -Wl,-DLL,-IMPLIB:"$tool_output_objdir$libname.dll.lib"~linknames=' + archive_expsym_cmds='if test DEF = "`$SED -n -e '\''s/^[ ]*//'\'' -e '\''/^\(;.*\)*$/d'\'' -e '\''s/^\(EXPORTS\|LIBRARY\)\([ ].*\)*$/DEF/p'\'' -e q $export_symbols`" ; then + cp "$export_symbols" "$output_objdir/$soname.def"; + echo "$tool_output_objdir$soname.def" > "$output_objdir/$soname.exp"; + else + $SED -e '\''s/^/-link -EXPORT:/'\'' < $export_symbols > $output_objdir/$soname.exp; + fi~ + $CC -o $tool_output_objdir$soname $libobjs $compiler_flags $deplibs "@$tool_output_objdir$soname.exp" -Wl,-DLL,-IMPLIB:"$tool_output_objdir$libname.dll.lib"~ + linknames=' + # The linker will not automatically build a static lib if we build a DLL. + # _LT_TAGVAR(old_archive_from_new_cmds, )='true' + enable_shared_with_static_runtimes=yes + exclude_expsyms='_NULL_IMPORT_DESCRIPTOR|_IMPORT_DESCRIPTOR_.*' + export_symbols_cmds='$NM $libobjs $convenience | $global_symbol_pipe | $SED -e '\''/^[BCDGRS][ ]/s/.*[ ]\([^ ]*\)/\1,DATA/'\'' | $SED -e '\''/^[AITW][ ]/s/.*[ ]//'\'' | sort | uniq > $export_symbols' + # Don't use ranlib + old_postinstall_cmds='chmod 644 $oldlib' + postlink_cmds='lt_outputfile="@OUTPUT@"~ + lt_tool_outputfile="@TOOL_OUTPUT@"~ + case $lt_outputfile in + *.exe|*.EXE) ;; + *) + lt_outputfile=$lt_outputfile.exe + lt_tool_outputfile=$lt_tool_outputfile.exe + ;; + esac~ + if test : != "$MANIFEST_TOOL" && test -f "$lt_outputfile.manifest"; then + $MANIFEST_TOOL -manifest "$lt_tool_outputfile.manifest" -outputresource:"$lt_tool_outputfile" || exit 1; + $RM "$lt_outputfile.manifest"; + fi' + ;; + *) + # Assume MSVC wrapper + hardcode_libdir_flag_spec=' ' + allow_undefined_flag=unsupported + # Tell ltmain to make .lib files, not .a files. + libext=lib + # Tell ltmain to make .dll files, not .so files. + shrext_cmds=.dll + # FIXME: Setting linknames here is a bad hack. + archive_cmds='$CC -o $lib $libobjs $compiler_flags `func_echo_all "$deplibs" | $SED '\''s/ -lc$//'\''` -link -dll~linknames=' + # The linker will automatically build a .lib file if we build a DLL. + old_archive_from_new_cmds='true' + # FIXME: Should let the user specify the lib program. + old_archive_cmds='lib -OUT:$oldlib$oldobjs$old_deplibs' + enable_shared_with_static_runtimes=yes + ;; + esac + ;; + + darwin* | rhapsody*) + + + archive_cmds_need_lc=no + hardcode_direct=no + hardcode_automatic=yes + hardcode_shlibpath_var=unsupported + if test yes = "$lt_cv_ld_force_load"; then + whole_archive_flag_spec='`for conv in $convenience\"\"; do test -n \"$conv\" && new_convenience=\"$new_convenience $wl-force_load,$conv\"; done; func_echo_all \"$new_convenience\"`' + + else + whole_archive_flag_spec='' + fi + link_all_deplibs=yes + allow_undefined_flag=$_lt_dar_allow_undefined + case $cc_basename in + ifort*|nagfor*) _lt_dar_can_shared=yes ;; + *) _lt_dar_can_shared=$GCC ;; + esac + if test yes = "$_lt_dar_can_shared"; then + output_verbose_link_cmd=func_echo_all + archive_cmds="\$CC -dynamiclib \$allow_undefined_flag -o \$lib \$libobjs \$deplibs \$compiler_flags -install_name \$rpath/\$soname \$verstring $_lt_dar_single_mod$_lt_dsymutil" + module_cmds="\$CC \$allow_undefined_flag -o \$lib -bundle \$libobjs \$deplibs \$compiler_flags$_lt_dsymutil" + archive_expsym_cmds="sed 's|^|_|' < \$export_symbols > \$output_objdir/\$libname-symbols.expsym~\$CC -dynamiclib \$allow_undefined_flag -o \$lib \$libobjs \$deplibs \$compiler_flags -install_name \$rpath/\$soname \$verstring $_lt_dar_single_mod$_lt_dar_export_syms$_lt_dsymutil" + module_expsym_cmds="sed -e 's|^|_|' < \$export_symbols > \$output_objdir/\$libname-symbols.expsym~\$CC \$allow_undefined_flag -o \$lib -bundle \$libobjs \$deplibs \$compiler_flags$_lt_dar_export_syms$_lt_dsymutil" + + else + ld_shlibs=no + fi + + ;; + + dgux*) + archive_cmds='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags' + hardcode_libdir_flag_spec='-L$libdir' + hardcode_shlibpath_var=no + ;; + + # FreeBSD 2.2.[012] allows us to include c++rt0.o to get C++ constructor + # support. Future versions do this automatically, but an explicit c++rt0.o + # does not break anything, and helps significantly (at the cost of a little + # extra space). + freebsd2.2*) + archive_cmds='$LD -Bshareable -o $lib $libobjs $deplibs $linker_flags /usr/lib/c++rt0.o' + hardcode_libdir_flag_spec='-R$libdir' + hardcode_direct=yes + hardcode_shlibpath_var=no + ;; + + # Unfortunately, older versions of FreeBSD 2 do not have this feature. + freebsd2.*) + archive_cmds='$LD -Bshareable -o $lib $libobjs $deplibs $linker_flags' + hardcode_direct=yes + hardcode_minus_L=yes + hardcode_shlibpath_var=no + ;; + + # FreeBSD 3 and greater uses gcc -shared to do shared libraries. + freebsd* | dragonfly*) + archive_cmds='$CC -shared $pic_flag -o $lib $libobjs $deplibs $compiler_flags' + hardcode_libdir_flag_spec='-R$libdir' + hardcode_direct=yes + hardcode_shlibpath_var=no + ;; + + hpux9*) + if test yes = "$GCC"; then + archive_cmds='$RM $output_objdir/$soname~$CC -shared $pic_flag $wl+b $wl$install_libdir -o $output_objdir/$soname $libobjs $deplibs $compiler_flags~test "x$output_objdir/$soname" = "x$lib" || mv $output_objdir/$soname $lib' + else + archive_cmds='$RM $output_objdir/$soname~$LD -b +b $install_libdir -o $output_objdir/$soname $libobjs $deplibs $linker_flags~test "x$output_objdir/$soname" = "x$lib" || mv $output_objdir/$soname $lib' + fi + hardcode_libdir_flag_spec='$wl+b $wl$libdir' + hardcode_libdir_separator=: + hardcode_direct=yes + + # hardcode_minus_L: Not really in the search PATH, + # but as the default location of the library. + hardcode_minus_L=yes + export_dynamic_flag_spec='$wl-E' + ;; + + hpux10*) + if test yes,no = "$GCC,$with_gnu_ld"; then + archive_cmds='$CC -shared $pic_flag $wl+h $wl$soname $wl+b $wl$install_libdir -o $lib $libobjs $deplibs $compiler_flags' + else + archive_cmds='$LD -b +h $soname +b $install_libdir -o $lib $libobjs $deplibs $linker_flags' + fi + if test no = "$with_gnu_ld"; then + hardcode_libdir_flag_spec='$wl+b $wl$libdir' + hardcode_libdir_separator=: + hardcode_direct=yes + hardcode_direct_absolute=yes + export_dynamic_flag_spec='$wl-E' + # hardcode_minus_L: Not really in the search PATH, + # but as the default location of the library. + hardcode_minus_L=yes + fi + ;; + + hpux11*) + if test yes,no = "$GCC,$with_gnu_ld"; then + case $host_cpu in + hppa*64*) + archive_cmds='$CC -shared $wl+h $wl$soname -o $lib $libobjs $deplibs $compiler_flags' + ;; + ia64*) + archive_cmds='$CC -shared $pic_flag $wl+h $wl$soname $wl+nodefaultrpath -o $lib $libobjs $deplibs $compiler_flags' + ;; + *) + archive_cmds='$CC -shared $pic_flag $wl+h $wl$soname $wl+b $wl$install_libdir -o $lib $libobjs $deplibs $compiler_flags' + ;; + esac + else + case $host_cpu in + hppa*64*) + archive_cmds='$CC -b $wl+h $wl$soname -o $lib $libobjs $deplibs $compiler_flags' + ;; + ia64*) + archive_cmds='$CC -b $wl+h $wl$soname $wl+nodefaultrpath -o $lib $libobjs $deplibs $compiler_flags' + ;; + *) + + # Older versions of the 11.00 compiler do not understand -b yet + # (HP92453-01 A.11.01.20 doesn't, HP92453-01 B.11.X.35175-35176.GP does) + { $as_echo "$as_me:${as_lineno-$LINENO}: checking if $CC understands -b" >&5 +$as_echo_n "checking if $CC understands -b... " >&6; } +if ${lt_cv_prog_compiler__b+:} false; then : + $as_echo_n "(cached) " >&6 +else + lt_cv_prog_compiler__b=no + save_LDFLAGS=$LDFLAGS + LDFLAGS="$LDFLAGS -b" + echo "$lt_simple_link_test_code" > conftest.$ac_ext + if (eval $ac_link 2>conftest.err) && test -s conftest$ac_exeext; then + # The linker can only warn and ignore the option if not recognized + # So say no if there are warnings + if test -s conftest.err; then + # Append any errors to the config.log. + cat conftest.err 1>&5 + $ECHO "$_lt_linker_boilerplate" | $SED '/^$/d' > conftest.exp + $SED '/^$/d; /^ *+/d' conftest.err >conftest.er2 + if diff conftest.exp conftest.er2 >/dev/null; then + lt_cv_prog_compiler__b=yes + fi + else + lt_cv_prog_compiler__b=yes + fi + fi + $RM -r conftest* + LDFLAGS=$save_LDFLAGS + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_prog_compiler__b" >&5 +$as_echo "$lt_cv_prog_compiler__b" >&6; } + +if test yes = "$lt_cv_prog_compiler__b"; then + archive_cmds='$CC -b $wl+h $wl$soname $wl+b $wl$install_libdir -o $lib $libobjs $deplibs $compiler_flags' +else + archive_cmds='$LD -b +h $soname +b $install_libdir -o $lib $libobjs $deplibs $linker_flags' +fi + + ;; + esac + fi + if test no = "$with_gnu_ld"; then + hardcode_libdir_flag_spec='$wl+b $wl$libdir' + hardcode_libdir_separator=: + + case $host_cpu in + hppa*64*|ia64*) + hardcode_direct=no + hardcode_shlibpath_var=no + ;; + *) + hardcode_direct=yes + hardcode_direct_absolute=yes + export_dynamic_flag_spec='$wl-E' + + # hardcode_minus_L: Not really in the search PATH, + # but as the default location of the library. + hardcode_minus_L=yes + ;; + esac + fi + ;; + + irix5* | irix6* | nonstopux*) + if test yes = "$GCC"; then + archive_cmds='$CC -shared $pic_flag $libobjs $deplibs $compiler_flags $wl-soname $wl$soname `test -n "$verstring" && func_echo_all "$wl-set_version $wl$verstring"` $wl-update_registry $wl$output_objdir/so_locations -o $lib' + # Try to use the -exported_symbol ld option, if it does not + # work, assume that -exports_file does not work either and + # implicitly export all symbols. + # This should be the same for all languages, so no per-tag cache variable. + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether the $host_os linker accepts -exported_symbol" >&5 +$as_echo_n "checking whether the $host_os linker accepts -exported_symbol... " >&6; } +if ${lt_cv_irix_exported_symbol+:} false; then : + $as_echo_n "(cached) " >&6 +else + save_LDFLAGS=$LDFLAGS + LDFLAGS="$LDFLAGS -shared $wl-exported_symbol ${wl}foo $wl-update_registry $wl/dev/null" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +int foo (void) { return 0; } +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + lt_cv_irix_exported_symbol=yes +else + lt_cv_irix_exported_symbol=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + LDFLAGS=$save_LDFLAGS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_irix_exported_symbol" >&5 +$as_echo "$lt_cv_irix_exported_symbol" >&6; } + if test yes = "$lt_cv_irix_exported_symbol"; then + archive_expsym_cmds='$CC -shared $pic_flag $libobjs $deplibs $compiler_flags $wl-soname $wl$soname `test -n "$verstring" && func_echo_all "$wl-set_version $wl$verstring"` $wl-update_registry $wl$output_objdir/so_locations $wl-exports_file $wl$export_symbols -o $lib' + fi + else + archive_cmds='$CC -shared $libobjs $deplibs $compiler_flags -soname $soname `test -n "$verstring" && func_echo_all "-set_version $verstring"` -update_registry $output_objdir/so_locations -o $lib' + archive_expsym_cmds='$CC -shared $libobjs $deplibs $compiler_flags -soname $soname `test -n "$verstring" && func_echo_all "-set_version $verstring"` -update_registry $output_objdir/so_locations -exports_file $export_symbols -o $lib' + fi + archive_cmds_need_lc='no' + hardcode_libdir_flag_spec='$wl-rpath $wl$libdir' + hardcode_libdir_separator=: + inherit_rpath=yes + link_all_deplibs=yes + ;; + + linux*) + case $cc_basename in + tcc*) + # Fabrice Bellard et al's Tiny C Compiler + ld_shlibs=yes + archive_cmds='$CC -shared $pic_flag -o $lib $libobjs $deplibs $compiler_flags' + ;; + esac + ;; + + netbsd*) + if echo __ELF__ | $CC -E - | $GREP __ELF__ >/dev/null; then + archive_cmds='$LD -Bshareable -o $lib $libobjs $deplibs $linker_flags' # a.out + else + archive_cmds='$LD -shared -o $lib $libobjs $deplibs $linker_flags' # ELF + fi + hardcode_libdir_flag_spec='-R$libdir' + hardcode_direct=yes + hardcode_shlibpath_var=no + ;; + + newsos6) + archive_cmds='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags' + hardcode_direct=yes + hardcode_libdir_flag_spec='$wl-rpath $wl$libdir' + hardcode_libdir_separator=: + hardcode_shlibpath_var=no + ;; + + *nto* | *qnx*) + ;; + + openbsd* | bitrig*) + if test -f /usr/libexec/ld.so; then + hardcode_direct=yes + hardcode_shlibpath_var=no + hardcode_direct_absolute=yes + if test -z "`echo __ELF__ | $CC -E - | $GREP __ELF__`"; then + archive_cmds='$CC -shared $pic_flag -o $lib $libobjs $deplibs $compiler_flags' + archive_expsym_cmds='$CC -shared $pic_flag -o $lib $libobjs $deplibs $compiler_flags $wl-retain-symbols-file,$export_symbols' + hardcode_libdir_flag_spec='$wl-rpath,$libdir' + export_dynamic_flag_spec='$wl-E' + else + archive_cmds='$CC -shared $pic_flag -o $lib $libobjs $deplibs $compiler_flags' + hardcode_libdir_flag_spec='$wl-rpath,$libdir' + fi + else + ld_shlibs=no + fi + ;; + + os2*) + hardcode_libdir_flag_spec='-L$libdir' + hardcode_minus_L=yes + allow_undefined_flag=unsupported + shrext_cmds=.dll + archive_cmds='$ECHO "LIBRARY ${soname%$shared_ext} INITINSTANCE TERMINSTANCE" > $output_objdir/$libname.def~ + $ECHO "DESCRIPTION \"$libname\"" >> $output_objdir/$libname.def~ + $ECHO "DATA MULTIPLE NONSHARED" >> $output_objdir/$libname.def~ + $ECHO EXPORTS >> $output_objdir/$libname.def~ + emxexp $libobjs | $SED /"_DLL_InitTerm"/d >> $output_objdir/$libname.def~ + $CC -Zdll -Zcrtdll -o $output_objdir/$soname $libobjs $deplibs $compiler_flags $output_objdir/$libname.def~ + emximp -o $lib $output_objdir/$libname.def' + archive_expsym_cmds='$ECHO "LIBRARY ${soname%$shared_ext} INITINSTANCE TERMINSTANCE" > $output_objdir/$libname.def~ + $ECHO "DESCRIPTION \"$libname\"" >> $output_objdir/$libname.def~ + $ECHO "DATA MULTIPLE NONSHARED" >> $output_objdir/$libname.def~ + $ECHO EXPORTS >> $output_objdir/$libname.def~ + prefix_cmds="$SED"~ + if test EXPORTS = "`$SED 1q $export_symbols`"; then + prefix_cmds="$prefix_cmds -e 1d"; + fi~ + prefix_cmds="$prefix_cmds -e \"s/^\(.*\)$/_\1/g\""~ + cat $export_symbols | $prefix_cmds >> $output_objdir/$libname.def~ + $CC -Zdll -Zcrtdll -o $output_objdir/$soname $libobjs $deplibs $compiler_flags $output_objdir/$libname.def~ + emximp -o $lib $output_objdir/$libname.def' + old_archive_From_new_cmds='emximp -o $output_objdir/${libname}_dll.a $output_objdir/$libname.def' + enable_shared_with_static_runtimes=yes + ;; + + osf3*) + if test yes = "$GCC"; then + allow_undefined_flag=' $wl-expect_unresolved $wl\*' + archive_cmds='$CC -shared$allow_undefined_flag $libobjs $deplibs $compiler_flags $wl-soname $wl$soname `test -n "$verstring" && func_echo_all "$wl-set_version $wl$verstring"` $wl-update_registry $wl$output_objdir/so_locations -o $lib' + else + allow_undefined_flag=' -expect_unresolved \*' + archive_cmds='$CC -shared$allow_undefined_flag $libobjs $deplibs $compiler_flags -soname $soname `test -n "$verstring" && func_echo_all "-set_version $verstring"` -update_registry $output_objdir/so_locations -o $lib' + fi + archive_cmds_need_lc='no' + hardcode_libdir_flag_spec='$wl-rpath $wl$libdir' + hardcode_libdir_separator=: + ;; + + osf4* | osf5*) # as osf3* with the addition of -msym flag + if test yes = "$GCC"; then + allow_undefined_flag=' $wl-expect_unresolved $wl\*' + archive_cmds='$CC -shared$allow_undefined_flag $pic_flag $libobjs $deplibs $compiler_flags $wl-msym $wl-soname $wl$soname `test -n "$verstring" && func_echo_all "$wl-set_version $wl$verstring"` $wl-update_registry $wl$output_objdir/so_locations -o $lib' + hardcode_libdir_flag_spec='$wl-rpath $wl$libdir' + else + allow_undefined_flag=' -expect_unresolved \*' + archive_cmds='$CC -shared$allow_undefined_flag $libobjs $deplibs $compiler_flags -msym -soname $soname `test -n "$verstring" && func_echo_all "-set_version $verstring"` -update_registry $output_objdir/so_locations -o $lib' + archive_expsym_cmds='for i in `cat $export_symbols`; do printf "%s %s\\n" -exported_symbol "\$i" >> $lib.exp; done; printf "%s\\n" "-hidden">> $lib.exp~ + $CC -shared$allow_undefined_flag $wl-input $wl$lib.exp $compiler_flags $libobjs $deplibs -soname $soname `test -n "$verstring" && $ECHO "-set_version $verstring"` -update_registry $output_objdir/so_locations -o $lib~$RM $lib.exp' + + # Both c and cxx compiler support -rpath directly + hardcode_libdir_flag_spec='-rpath $libdir' + fi + archive_cmds_need_lc='no' + hardcode_libdir_separator=: + ;; + + solaris*) + no_undefined_flag=' -z defs' + if test yes = "$GCC"; then + wlarc='$wl' + archive_cmds='$CC -shared $pic_flag $wl-z ${wl}text $wl-h $wl$soname -o $lib $libobjs $deplibs $compiler_flags' + archive_expsym_cmds='echo "{ global:" > $lib.exp~cat $export_symbols | $SED -e "s/\(.*\)/\1;/" >> $lib.exp~echo "local: *; };" >> $lib.exp~ + $CC -shared $pic_flag $wl-z ${wl}text $wl-M $wl$lib.exp $wl-h $wl$soname -o $lib $libobjs $deplibs $compiler_flags~$RM $lib.exp' + else + case `$CC -V 2>&1` in + *"Compilers 5.0"*) + wlarc='' + archive_cmds='$LD -G$allow_undefined_flag -h $soname -o $lib $libobjs $deplibs $linker_flags' + archive_expsym_cmds='echo "{ global:" > $lib.exp~cat $export_symbols | $SED -e "s/\(.*\)/\1;/" >> $lib.exp~echo "local: *; };" >> $lib.exp~ + $LD -G$allow_undefined_flag -M $lib.exp -h $soname -o $lib $libobjs $deplibs $linker_flags~$RM $lib.exp' + ;; + *) + wlarc='$wl' + archive_cmds='$CC -G$allow_undefined_flag -h $soname -o $lib $libobjs $deplibs $compiler_flags' + archive_expsym_cmds='echo "{ global:" > $lib.exp~cat $export_symbols | $SED -e "s/\(.*\)/\1;/" >> $lib.exp~echo "local: *; };" >> $lib.exp~ + $CC -G$allow_undefined_flag -M $lib.exp -h $soname -o $lib $libobjs $deplibs $compiler_flags~$RM $lib.exp' + ;; + esac + fi + hardcode_libdir_flag_spec='-R$libdir' + hardcode_shlibpath_var=no + case $host_os in + solaris2.[0-5] | solaris2.[0-5].*) ;; + *) + # The compiler driver will combine and reorder linker options, + # but understands '-z linker_flag'. GCC discards it without '$wl', + # but is careful enough not to reorder. + # Supported since Solaris 2.6 (maybe 2.5.1?) + if test yes = "$GCC"; then + whole_archive_flag_spec='$wl-z ${wl}allextract$convenience $wl-z ${wl}defaultextract' + else + whole_archive_flag_spec='-z allextract$convenience -z defaultextract' + fi + ;; + esac + link_all_deplibs=yes + ;; + + sunos4*) + if test sequent = "$host_vendor"; then + # Use $CC to link under sequent, because it throws in some extra .o + # files that make .init and .fini sections work. + archive_cmds='$CC -G $wl-h $soname -o $lib $libobjs $deplibs $compiler_flags' + else + archive_cmds='$LD -assert pure-text -Bstatic -o $lib $libobjs $deplibs $linker_flags' + fi + hardcode_libdir_flag_spec='-L$libdir' + hardcode_direct=yes + hardcode_minus_L=yes + hardcode_shlibpath_var=no + ;; + + sysv4) + case $host_vendor in + sni) + archive_cmds='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags' + hardcode_direct=yes # is this really true??? + ;; + siemens) + ## LD is ld it makes a PLAMLIB + ## CC just makes a GrossModule. + archive_cmds='$LD -G -o $lib $libobjs $deplibs $linker_flags' + reload_cmds='$CC -r -o $output$reload_objs' + hardcode_direct=no + ;; + motorola) + archive_cmds='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags' + hardcode_direct=no #Motorola manual says yes, but my tests say they lie + ;; + esac + runpath_var='LD_RUN_PATH' + hardcode_shlibpath_var=no + ;; + + sysv4.3*) + archive_cmds='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags' + hardcode_shlibpath_var=no + export_dynamic_flag_spec='-Bexport' + ;; + + sysv4*MP*) + if test -d /usr/nec; then + archive_cmds='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags' + hardcode_shlibpath_var=no + runpath_var=LD_RUN_PATH + hardcode_runpath_var=yes + ld_shlibs=yes + fi + ;; + + sysv4*uw2* | sysv5OpenUNIX* | sysv5UnixWare7.[01].[10]* | unixware7* | sco3.2v5.0.[024]*) + no_undefined_flag='$wl-z,text' + archive_cmds_need_lc=no + hardcode_shlibpath_var=no + runpath_var='LD_RUN_PATH' + + if test yes = "$GCC"; then + archive_cmds='$CC -shared $wl-h,$soname -o $lib $libobjs $deplibs $compiler_flags' + archive_expsym_cmds='$CC -shared $wl-Bexport:$export_symbols $wl-h,$soname -o $lib $libobjs $deplibs $compiler_flags' + else + archive_cmds='$CC -G $wl-h,$soname -o $lib $libobjs $deplibs $compiler_flags' + archive_expsym_cmds='$CC -G $wl-Bexport:$export_symbols $wl-h,$soname -o $lib $libobjs $deplibs $compiler_flags' + fi + ;; + + sysv5* | sco3.2v5* | sco5v6*) + # Note: We CANNOT use -z defs as we might desire, because we do not + # link with -lc, and that would cause any symbols used from libc to + # always be unresolved, which means just about no library would + # ever link correctly. If we're not using GNU ld we use -z text + # though, which does catch some bad symbols but isn't as heavy-handed + # as -z defs. + no_undefined_flag='$wl-z,text' + allow_undefined_flag='$wl-z,nodefs' + archive_cmds_need_lc=no + hardcode_shlibpath_var=no + hardcode_libdir_flag_spec='$wl-R,$libdir' + hardcode_libdir_separator=':' + link_all_deplibs=yes + export_dynamic_flag_spec='$wl-Bexport' + runpath_var='LD_RUN_PATH' + + if test yes = "$GCC"; then + archive_cmds='$CC -shared $wl-h,$soname -o $lib $libobjs $deplibs $compiler_flags' + archive_expsym_cmds='$CC -shared $wl-Bexport:$export_symbols $wl-h,$soname -o $lib $libobjs $deplibs $compiler_flags' + else + archive_cmds='$CC -G $wl-h,$soname -o $lib $libobjs $deplibs $compiler_flags' + archive_expsym_cmds='$CC -G $wl-Bexport:$export_symbols $wl-h,$soname -o $lib $libobjs $deplibs $compiler_flags' + fi + ;; + + uts4*) + archive_cmds='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags' + hardcode_libdir_flag_spec='-L$libdir' + hardcode_shlibpath_var=no + ;; + + *) + ld_shlibs=no + ;; + esac + + if test sni = "$host_vendor"; then + case $host in + sysv4 | sysv4.2uw2* | sysv4.3* | sysv5*) + export_dynamic_flag_spec='$wl-Blargedynsym' + ;; + esac + fi + fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ld_shlibs" >&5 +$as_echo "$ld_shlibs" >&6; } +test no = "$ld_shlibs" && can_build_shared=no + +with_gnu_ld=$with_gnu_ld + + + + + + + + + + + + + + + +# +# Do we need to explicitly link libc? +# +case "x$archive_cmds_need_lc" in +x|xyes) + # Assume -lc should be added + archive_cmds_need_lc=yes + + if test yes,yes = "$GCC,$enable_shared"; then + case $archive_cmds in + *'~'*) + # FIXME: we may have to deal with multi-command sequences. + ;; + '$CC '*) + # Test whether the compiler implicitly links with -lc since on some + # systems, -lgcc has to come before -lc. If gcc already passes -lc + # to ld, don't add -lc before -lgcc. + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether -lc should be explicitly linked in" >&5 +$as_echo_n "checking whether -lc should be explicitly linked in... " >&6; } +if ${lt_cv_archive_cmds_need_lc+:} false; then : + $as_echo_n "(cached) " >&6 +else + $RM conftest* + echo "$lt_simple_compile_test_code" > conftest.$ac_ext + + if { { eval echo "\"\$as_me\":${as_lineno-$LINENO}: \"$ac_compile\""; } >&5 + (eval $ac_compile) 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } 2>conftest.err; then + soname=conftest + lib=conftest + libobjs=conftest.$ac_objext + deplibs= + wl=$lt_prog_compiler_wl + pic_flag=$lt_prog_compiler_pic + compiler_flags=-v + linker_flags=-v + verstring= + output_objdir=. + libname=conftest + lt_save_allow_undefined_flag=$allow_undefined_flag + allow_undefined_flag= + if { { eval echo "\"\$as_me\":${as_lineno-$LINENO}: \"$archive_cmds 2\>\&1 \| $GREP \" -lc \" \>/dev/null 2\>\&1\""; } >&5 + (eval $archive_cmds 2\>\&1 \| $GREP \" -lc \" \>/dev/null 2\>\&1) 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } + then + lt_cv_archive_cmds_need_lc=no + else + lt_cv_archive_cmds_need_lc=yes + fi + allow_undefined_flag=$lt_save_allow_undefined_flag + else + cat conftest.err 1>&5 + fi + $RM conftest* + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_archive_cmds_need_lc" >&5 +$as_echo "$lt_cv_archive_cmds_need_lc" >&6; } + archive_cmds_need_lc=$lt_cv_archive_cmds_need_lc + ;; + esac + fi + ;; +esac + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking dynamic linker characteristics" >&5 +$as_echo_n "checking dynamic linker characteristics... " >&6; } + +if test yes = "$GCC"; then + case $host_os in + darwin*) lt_awk_arg='/^libraries:/,/LR/' ;; + *) lt_awk_arg='/^libraries:/' ;; + esac + case $host_os in + mingw* | cegcc*) lt_sed_strip_eq='s|=\([A-Za-z]:\)|\1|g' ;; + *) lt_sed_strip_eq='s|=/|/|g' ;; + esac + lt_search_path_spec=`$CC -print-search-dirs | awk $lt_awk_arg | $SED -e "s/^libraries://" -e $lt_sed_strip_eq` + case $lt_search_path_spec in + *\;*) + # if the path contains ";" then we assume it to be the separator + # otherwise default to the standard path separator (i.e. ":") - it is + # assumed that no part of a normal pathname contains ";" but that should + # okay in the real world where ";" in dirpaths is itself problematic. + lt_search_path_spec=`$ECHO "$lt_search_path_spec" | $SED 's/;/ /g'` + ;; + *) + lt_search_path_spec=`$ECHO "$lt_search_path_spec" | $SED "s/$PATH_SEPARATOR/ /g"` + ;; + esac + # Ok, now we have the path, separated by spaces, we can step through it + # and add multilib dir if necessary... + lt_tmp_lt_search_path_spec= + lt_multi_os_dir=/`$CC $CPPFLAGS $CFLAGS $LDFLAGS -print-multi-os-directory 2>/dev/null` + # ...but if some path component already ends with the multilib dir we assume + # that all is fine and trust -print-search-dirs as is (GCC 4.2? or newer). + case "$lt_multi_os_dir; $lt_search_path_spec " in + "/; "* | "/.; "* | "/./; "* | *"$lt_multi_os_dir "* | *"$lt_multi_os_dir/ "*) + lt_multi_os_dir= + ;; + esac + for lt_sys_path in $lt_search_path_spec; do + if test -d "$lt_sys_path$lt_multi_os_dir"; then + lt_tmp_lt_search_path_spec="$lt_tmp_lt_search_path_spec $lt_sys_path$lt_multi_os_dir" + elif test -n "$lt_multi_os_dir"; then + test -d "$lt_sys_path" && \ + lt_tmp_lt_search_path_spec="$lt_tmp_lt_search_path_spec $lt_sys_path" + fi + done + lt_search_path_spec=`$ECHO "$lt_tmp_lt_search_path_spec" | awk ' +BEGIN {RS = " "; FS = "/|\n";} { + lt_foo = ""; + lt_count = 0; + for (lt_i = NF; lt_i > 0; lt_i--) { + if ($lt_i != "" && $lt_i != ".") { + if ($lt_i == "..") { + lt_count++; + } else { + if (lt_count == 0) { + lt_foo = "/" $lt_i lt_foo; + } else { + lt_count--; + } + } + } + } + if (lt_foo != "") { lt_freq[lt_foo]++; } + if (lt_freq[lt_foo] == 1) { print lt_foo; } +}'` + # AWK program above erroneously prepends '/' to C:/dos/paths + # for these hosts. + case $host_os in + mingw* | cegcc*) lt_search_path_spec=`$ECHO "$lt_search_path_spec" |\ + $SED 's|/\([A-Za-z]:\)|\1|g'` ;; + esac + sys_lib_search_path_spec=`$ECHO "$lt_search_path_spec" | $lt_NL2SP` +else + sys_lib_search_path_spec="/lib /usr/lib /usr/local/lib" +fi +library_names_spec= +libname_spec='lib$name' +soname_spec= +shrext_cmds=.so +postinstall_cmds= +postuninstall_cmds= +finish_cmds= +finish_eval= +shlibpath_var= +shlibpath_overrides_runpath=unknown +version_type=none +dynamic_linker="$host_os ld.so" +sys_lib_dlsearch_path_spec="/lib /usr/lib" +need_lib_prefix=unknown +hardcode_into_libs=no + +# when you set need_version to no, make sure it does not cause -set_version +# flags to be left without arguments +need_version=unknown + + + +case $host_os in +aix3*) + version_type=linux # correct to gnu/linux during the next big refactor + library_names_spec='$libname$release$shared_ext$versuffix $libname.a' + shlibpath_var=LIBPATH + + # AIX 3 has no versioning support, so we append a major version to the name. + soname_spec='$libname$release$shared_ext$major' + ;; + +aix[4-9]*) + version_type=linux # correct to gnu/linux during the next big refactor + need_lib_prefix=no + need_version=no + hardcode_into_libs=yes + if test ia64 = "$host_cpu"; then + # AIX 5 supports IA64 + library_names_spec='$libname$release$shared_ext$major $libname$release$shared_ext$versuffix $libname$shared_ext' + shlibpath_var=LD_LIBRARY_PATH + else + # With GCC up to 2.95.x, collect2 would create an import file + # for dependence libraries. The import file would start with + # the line '#! .'. This would cause the generated library to + # depend on '.', always an invalid library. This was fixed in + # development snapshots of GCC prior to 3.0. + case $host_os in + aix4 | aix4.[01] | aix4.[01].*) + if { echo '#if __GNUC__ > 2 || (__GNUC__ == 2 && __GNUC_MINOR__ >= 97)' + echo ' yes ' + echo '#endif'; } | $CC -E - | $GREP yes > /dev/null; then + : + else + can_build_shared=no + fi + ;; + esac + # Using Import Files as archive members, it is possible to support + # filename-based versioning of shared library archives on AIX. While + # this would work for both with and without runtime linking, it will + # prevent static linking of such archives. So we do filename-based + # shared library versioning with .so extension only, which is used + # when both runtime linking and shared linking is enabled. + # Unfortunately, runtime linking may impact performance, so we do + # not want this to be the default eventually. Also, we use the + # versioned .so libs for executables only if there is the -brtl + # linker flag in LDFLAGS as well, or --with-aix-soname=svr4 only. + # To allow for filename-based versioning support, we need to create + # libNAME.so.V as an archive file, containing: + # *) an Import File, referring to the versioned filename of the + # archive as well as the shared archive member, telling the + # bitwidth (32 or 64) of that shared object, and providing the + # list of exported symbols of that shared object, eventually + # decorated with the 'weak' keyword + # *) the shared object with the F_LOADONLY flag set, to really avoid + # it being seen by the linker. + # At run time we better use the real file rather than another symlink, + # but for link time we create the symlink libNAME.so -> libNAME.so.V + + case $with_aix_soname,$aix_use_runtimelinking in + # AIX (on Power*) has no versioning support, so currently we cannot hardcode correct + # soname into executable. Probably we can add versioning support to + # collect2, so additional links can be useful in future. + aix,yes) # traditional libtool + dynamic_linker='AIX unversionable lib.so' + # If using run time linking (on AIX 4.2 or later) use lib<name>.so + # instead of lib<name>.a to let people know that these are not + # typical AIX shared libraries. + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' + ;; + aix,no) # traditional AIX only + dynamic_linker='AIX lib.a(lib.so.V)' + # We preserve .a as extension for shared libraries through AIX4.2 + # and later when we are not doing run time linking. + library_names_spec='$libname$release.a $libname.a' + soname_spec='$libname$release$shared_ext$major' + ;; + svr4,*) # full svr4 only + dynamic_linker="AIX lib.so.V($shared_archive_member_spec.o)" + library_names_spec='$libname$release$shared_ext$major $libname$shared_ext' + # We do not specify a path in Import Files, so LIBPATH fires. + shlibpath_overrides_runpath=yes + ;; + *,yes) # both, prefer svr4 + dynamic_linker="AIX lib.so.V($shared_archive_member_spec.o), lib.a(lib.so.V)" + library_names_spec='$libname$release$shared_ext$major $libname$shared_ext' + # unpreferred sharedlib libNAME.a needs extra handling + postinstall_cmds='test -n "$linkname" || linkname="$realname"~func_stripname "" ".so" "$linkname"~$install_shared_prog "$dir/$func_stripname_result.$libext" "$destdir/$func_stripname_result.$libext"~test -z "$tstripme" || test -z "$striplib" || $striplib "$destdir/$func_stripname_result.$libext"' + postuninstall_cmds='for n in $library_names $old_library; do :; done~func_stripname "" ".so" "$n"~test "$func_stripname_result" = "$n" || func_append rmfiles " $odir/$func_stripname_result.$libext"' + # We do not specify a path in Import Files, so LIBPATH fires. + shlibpath_overrides_runpath=yes + ;; + *,no) # both, prefer aix + dynamic_linker="AIX lib.a(lib.so.V), lib.so.V($shared_archive_member_spec.o)" + library_names_spec='$libname$release.a $libname.a' + soname_spec='$libname$release$shared_ext$major' + # unpreferred sharedlib libNAME.so.V and symlink libNAME.so need extra handling + postinstall_cmds='test -z "$dlname" || $install_shared_prog $dir/$dlname $destdir/$dlname~test -z "$tstripme" || test -z "$striplib" || $striplib $destdir/$dlname~test -n "$linkname" || linkname=$realname~func_stripname "" ".a" "$linkname"~(cd "$destdir" && $LN_S -f $dlname $func_stripname_result.so)' + postuninstall_cmds='test -z "$dlname" || func_append rmfiles " $odir/$dlname"~for n in $old_library $library_names; do :; done~func_stripname "" ".a" "$n"~func_append rmfiles " $odir/$func_stripname_result.so"' + ;; + esac + shlibpath_var=LIBPATH + fi + ;; + +amigaos*) + case $host_cpu in + powerpc) + # Since July 2007 AmigaOS4 officially supports .so libraries. + # When compiling the executable, add -use-dynld -Lsobjs: to the compileline. + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' + ;; + m68k) + library_names_spec='$libname.ixlibrary $libname.a' + # Create ${libname}_ixlibrary.a entries in /sys/libs. + finish_eval='for lib in `ls $libdir/*.ixlibrary 2>/dev/null`; do libname=`func_echo_all "$lib" | $SED '\''s%^.*/\([^/]*\)\.ixlibrary$%\1%'\''`; $RM /sys/libs/${libname}_ixlibrary.a; $show "cd /sys/libs && $LN_S $lib ${libname}_ixlibrary.a"; cd /sys/libs && $LN_S $lib ${libname}_ixlibrary.a || exit 1; done' + ;; + esac + ;; + +beos*) + library_names_spec='$libname$shared_ext' + dynamic_linker="$host_os ld.so" + shlibpath_var=LIBRARY_PATH + ;; + +bsdi[45]*) + version_type=linux # correct to gnu/linux during the next big refactor + need_version=no + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' + soname_spec='$libname$release$shared_ext$major' + finish_cmds='PATH="\$PATH:/sbin" ldconfig $libdir' + shlibpath_var=LD_LIBRARY_PATH + sys_lib_search_path_spec="/shlib /usr/lib /usr/X11/lib /usr/contrib/lib /lib /usr/local/lib" + sys_lib_dlsearch_path_spec="/shlib /usr/lib /usr/local/lib" + # the default ld.so.conf also contains /usr/contrib/lib and + # /usr/X11R6/lib (/usr/X11 is a link to /usr/X11R6), but let us allow + # libtool to hard-code these into programs + ;; + +cygwin* | mingw* | pw32* | cegcc*) + version_type=windows + shrext_cmds=.dll + need_version=no + need_lib_prefix=no + + case $GCC,$cc_basename in + yes,*) + # gcc + library_names_spec='$libname.dll.a' + # DLL is installed to $(libdir)/../bin by postinstall_cmds + postinstall_cmds='base_file=`basename \$file`~ + dlpath=`$SHELL 2>&1 -c '\''. $dir/'\''\$base_file'\''i; echo \$dlname'\''`~ + dldir=$destdir/`dirname \$dlpath`~ + test -d \$dldir || mkdir -p \$dldir~ + $install_prog $dir/$dlname \$dldir/$dlname~ + chmod a+x \$dldir/$dlname~ + if test -n '\''$stripme'\'' && test -n '\''$striplib'\''; then + eval '\''$striplib \$dldir/$dlname'\'' || exit \$?; + fi' + postuninstall_cmds='dldll=`$SHELL 2>&1 -c '\''. $file; echo \$dlname'\''`~ + dlpath=$dir/\$dldll~ + $RM \$dlpath' + shlibpath_overrides_runpath=yes + + case $host_os in + cygwin*) + # Cygwin DLLs use 'cyg' prefix rather than 'lib' + soname_spec='`echo $libname | sed -e 's/^lib/cyg/'``echo $release | $SED -e 's/[.]/-/g'`$versuffix$shared_ext' + + sys_lib_search_path_spec="$sys_lib_search_path_spec /usr/lib/w32api" + ;; + mingw* | cegcc*) + # MinGW DLLs use traditional 'lib' prefix + soname_spec='$libname`echo $release | $SED -e 's/[.]/-/g'`$versuffix$shared_ext' + ;; + pw32*) + # pw32 DLLs use 'pw' prefix rather than 'lib' + library_names_spec='`echo $libname | sed -e 's/^lib/pw/'``echo $release | $SED -e 's/[.]/-/g'`$versuffix$shared_ext' + ;; + esac + dynamic_linker='Win32 ld.exe' + ;; + + *,cl*) + # Native MSVC + libname_spec='$name' + soname_spec='$libname`echo $release | $SED -e 's/[.]/-/g'`$versuffix$shared_ext' + library_names_spec='$libname.dll.lib' + + case $build_os in + mingw*) + sys_lib_search_path_spec= + lt_save_ifs=$IFS + IFS=';' + for lt_path in $LIB + do + IFS=$lt_save_ifs + # Let DOS variable expansion print the short 8.3 style file name. + lt_path=`cd "$lt_path" 2>/dev/null && cmd //C "for %i in (".") do @echo %~si"` + sys_lib_search_path_spec="$sys_lib_search_path_spec $lt_path" + done + IFS=$lt_save_ifs + # Convert to MSYS style. + sys_lib_search_path_spec=`$ECHO "$sys_lib_search_path_spec" | sed -e 's|\\\\|/|g' -e 's| \\([a-zA-Z]\\):| /\\1|g' -e 's|^ ||'` + ;; + cygwin*) + # Convert to unix form, then to dos form, then back to unix form + # but this time dos style (no spaces!) so that the unix form looks + # like /cygdrive/c/PROGRA~1:/cygdr... + sys_lib_search_path_spec=`cygpath --path --unix "$LIB"` + sys_lib_search_path_spec=`cygpath --path --dos "$sys_lib_search_path_spec" 2>/dev/null` + sys_lib_search_path_spec=`cygpath --path --unix "$sys_lib_search_path_spec" | $SED -e "s/$PATH_SEPARATOR/ /g"` + ;; + *) + sys_lib_search_path_spec=$LIB + if $ECHO "$sys_lib_search_path_spec" | $GREP ';[c-zC-Z]:/' >/dev/null; then + # It is most probably a Windows format PATH. + sys_lib_search_path_spec=`$ECHO "$sys_lib_search_path_spec" | $SED -e 's/;/ /g'` + else + sys_lib_search_path_spec=`$ECHO "$sys_lib_search_path_spec" | $SED -e "s/$PATH_SEPARATOR/ /g"` + fi + # FIXME: find the short name or the path components, as spaces are + # common. (e.g. "Program Files" -> "PROGRA~1") + ;; + esac + + # DLL is installed to $(libdir)/../bin by postinstall_cmds + postinstall_cmds='base_file=`basename \$file`~ + dlpath=`$SHELL 2>&1 -c '\''. $dir/'\''\$base_file'\''i; echo \$dlname'\''`~ + dldir=$destdir/`dirname \$dlpath`~ + test -d \$dldir || mkdir -p \$dldir~ + $install_prog $dir/$dlname \$dldir/$dlname' + postuninstall_cmds='dldll=`$SHELL 2>&1 -c '\''. $file; echo \$dlname'\''`~ + dlpath=$dir/\$dldll~ + $RM \$dlpath' + shlibpath_overrides_runpath=yes + dynamic_linker='Win32 link.exe' + ;; + + *) + # Assume MSVC wrapper + library_names_spec='$libname`echo $release | $SED -e 's/[.]/-/g'`$versuffix$shared_ext $libname.lib' + dynamic_linker='Win32 ld.exe' + ;; + esac + # FIXME: first we should search . and the directory the executable is in + shlibpath_var=PATH + ;; + +darwin* | rhapsody*) + dynamic_linker="$host_os dyld" + version_type=darwin + need_lib_prefix=no + need_version=no + library_names_spec='$libname$release$major$shared_ext $libname$shared_ext' + soname_spec='$libname$release$major$shared_ext' + shlibpath_overrides_runpath=yes + shlibpath_var=DYLD_LIBRARY_PATH + shrext_cmds='`test .$module = .yes && echo .so || echo .dylib`' + + sys_lib_search_path_spec="$sys_lib_search_path_spec /usr/local/lib" + sys_lib_dlsearch_path_spec='/usr/local/lib /lib /usr/lib' + ;; + +dgux*) + version_type=linux # correct to gnu/linux during the next big refactor + need_lib_prefix=no + need_version=no + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' + soname_spec='$libname$release$shared_ext$major' + shlibpath_var=LD_LIBRARY_PATH + ;; + +freebsd* | dragonfly*) + # DragonFly does not have aout. When/if they implement a new + # versioning mechanism, adjust this. + if test -x /usr/bin/objformat; then + objformat=`/usr/bin/objformat` + else + case $host_os in + freebsd[23].*) objformat=aout ;; + *) objformat=elf ;; + esac + fi + version_type=freebsd-$objformat + case $version_type in + freebsd-elf*) + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' + soname_spec='$libname$release$shared_ext$major' + need_version=no + need_lib_prefix=no + ;; + freebsd-*) + library_names_spec='$libname$release$shared_ext$versuffix $libname$shared_ext$versuffix' + need_version=yes + ;; + esac + shlibpath_var=LD_LIBRARY_PATH + case $host_os in + freebsd2.*) + shlibpath_overrides_runpath=yes + ;; + freebsd3.[01]* | freebsdelf3.[01]*) + shlibpath_overrides_runpath=yes + hardcode_into_libs=yes + ;; + freebsd3.[2-9]* | freebsdelf3.[2-9]* | \ + freebsd4.[0-5] | freebsdelf4.[0-5] | freebsd4.1.1 | freebsdelf4.1.1) + shlibpath_overrides_runpath=no + hardcode_into_libs=yes + ;; + *) # from 4.6 on, and DragonFly + shlibpath_overrides_runpath=yes + hardcode_into_libs=yes + ;; + esac + ;; + +haiku*) + version_type=linux # correct to gnu/linux during the next big refactor + need_lib_prefix=no + need_version=no + dynamic_linker="$host_os runtime_loader" + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' + soname_spec='$libname$release$shared_ext$major' + shlibpath_var=LIBRARY_PATH + shlibpath_overrides_runpath=no + sys_lib_dlsearch_path_spec='/boot/home/config/lib /boot/common/lib /boot/system/lib' + hardcode_into_libs=yes + ;; + +hpux9* | hpux10* | hpux11*) + # Give a soname corresponding to the major version so that dld.sl refuses to + # link against other versions. + version_type=sunos + need_lib_prefix=no + need_version=no + case $host_cpu in + ia64*) + shrext_cmds='.so' + hardcode_into_libs=yes + dynamic_linker="$host_os dld.so" + shlibpath_var=LD_LIBRARY_PATH + shlibpath_overrides_runpath=yes # Unless +noenvvar is specified. + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' + soname_spec='$libname$release$shared_ext$major' + if test 32 = "$HPUX_IA64_MODE"; then + sys_lib_search_path_spec="/usr/lib/hpux32 /usr/local/lib/hpux32 /usr/local/lib" + sys_lib_dlsearch_path_spec=/usr/lib/hpux32 + else + sys_lib_search_path_spec="/usr/lib/hpux64 /usr/local/lib/hpux64" + sys_lib_dlsearch_path_spec=/usr/lib/hpux64 + fi + ;; + hppa*64*) + shrext_cmds='.sl' + hardcode_into_libs=yes + dynamic_linker="$host_os dld.sl" + shlibpath_var=LD_LIBRARY_PATH # How should we handle SHLIB_PATH + shlibpath_overrides_runpath=yes # Unless +noenvvar is specified. + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' + soname_spec='$libname$release$shared_ext$major' + sys_lib_search_path_spec="/usr/lib/pa20_64 /usr/ccs/lib/pa20_64" + sys_lib_dlsearch_path_spec=$sys_lib_search_path_spec + ;; + *) + shrext_cmds='.sl' + dynamic_linker="$host_os dld.sl" + shlibpath_var=SHLIB_PATH + shlibpath_overrides_runpath=no # +s is required to enable SHLIB_PATH + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' + soname_spec='$libname$release$shared_ext$major' + ;; + esac + # HP-UX runs *really* slowly unless shared libraries are mode 555, ... + postinstall_cmds='chmod 555 $lib' + # or fails outright, so override atomically: + install_override_mode=555 + ;; + +interix[3-9]*) + version_type=linux # correct to gnu/linux during the next big refactor + need_lib_prefix=no + need_version=no + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' + soname_spec='$libname$release$shared_ext$major' + dynamic_linker='Interix 3.x ld.so.1 (PE, like ELF)' + shlibpath_var=LD_LIBRARY_PATH + shlibpath_overrides_runpath=no + hardcode_into_libs=yes + ;; + +irix5* | irix6* | nonstopux*) + case $host_os in + nonstopux*) version_type=nonstopux ;; + *) + if test yes = "$lt_cv_prog_gnu_ld"; then + version_type=linux # correct to gnu/linux during the next big refactor + else + version_type=irix + fi ;; + esac + need_lib_prefix=no + need_version=no + soname_spec='$libname$release$shared_ext$major' + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$release$shared_ext $libname$shared_ext' + case $host_os in + irix5* | nonstopux*) + libsuff= shlibsuff= + ;; + *) + case $LD in # libtool.m4 will add one of these switches to LD + *-32|*"-32 "|*-melf32bsmip|*"-melf32bsmip ") + libsuff= shlibsuff= libmagic=32-bit;; + *-n32|*"-n32 "|*-melf32bmipn32|*"-melf32bmipn32 ") + libsuff=32 shlibsuff=N32 libmagic=N32;; + *-64|*"-64 "|*-melf64bmip|*"-melf64bmip ") + libsuff=64 shlibsuff=64 libmagic=64-bit;; + *) libsuff= shlibsuff= libmagic=never-match;; + esac + ;; + esac + shlibpath_var=LD_LIBRARY${shlibsuff}_PATH + shlibpath_overrides_runpath=no + sys_lib_search_path_spec="/usr/lib$libsuff /lib$libsuff /usr/local/lib$libsuff" + sys_lib_dlsearch_path_spec="/usr/lib$libsuff /lib$libsuff" + hardcode_into_libs=yes + ;; + +# No shared lib support for Linux oldld, aout, or coff. +linux*oldld* | linux*aout* | linux*coff*) + dynamic_linker=no + ;; + +linux*android*) + version_type=none # Android doesn't support versioned libraries. + need_lib_prefix=no + need_version=no + library_names_spec='$libname$release$shared_ext' + soname_spec='$libname$release$shared_ext' + finish_cmds= + shlibpath_var=LD_LIBRARY_PATH + shlibpath_overrides_runpath=yes + + # This implies no fast_install, which is unacceptable. + # Some rework will be needed to allow for fast_install + # before this can be enabled. + hardcode_into_libs=yes + + dynamic_linker='Android linker' + # Don't embed -rpath directories since the linker doesn't support them. + hardcode_libdir_flag_spec='-L$libdir' + ;; + +# This must be glibc/ELF. +linux* | k*bsd*-gnu | kopensolaris*-gnu | gnu*) + version_type=linux # correct to gnu/linux during the next big refactor + need_lib_prefix=no + need_version=no + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' + soname_spec='$libname$release$shared_ext$major' + finish_cmds='PATH="\$PATH:/sbin" ldconfig -n $libdir' + shlibpath_var=LD_LIBRARY_PATH + shlibpath_overrides_runpath=no + + # Some binutils ld are patched to set DT_RUNPATH + if ${lt_cv_shlibpath_overrides_runpath+:} false; then : + $as_echo_n "(cached) " >&6 +else + lt_cv_shlibpath_overrides_runpath=no + save_LDFLAGS=$LDFLAGS + save_libdir=$libdir + eval "libdir=/foo; wl=\"$lt_prog_compiler_wl\"; \ + LDFLAGS=\"\$LDFLAGS $hardcode_libdir_flag_spec\"" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + if ($OBJDUMP -p conftest$ac_exeext) 2>/dev/null | grep "RUNPATH.*$libdir" >/dev/null; then : + lt_cv_shlibpath_overrides_runpath=yes +fi +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + LDFLAGS=$save_LDFLAGS + libdir=$save_libdir + +fi + + shlibpath_overrides_runpath=$lt_cv_shlibpath_overrides_runpath + + # This implies no fast_install, which is unacceptable. + # Some rework will be needed to allow for fast_install + # before this can be enabled. + hardcode_into_libs=yes + + # Ideally, we could use ldconfig to report *all* directores which are + # searched for libraries, however this is still not possible. Aside from not + # being certain /sbin/ldconfig is available, command + # 'ldconfig -N -X -v | grep ^/' on 64bit Fedora does not report /usr/lib64, + # even though it is searched at run-time. Try to do the best guess by + # appending ld.so.conf contents (and includes) to the search path. + if test -f /etc/ld.so.conf; then + lt_ld_extra=`awk '/^include / { system(sprintf("cd /etc; cat %s 2>/dev/null", \$2)); skip = 1; } { if (!skip) print \$0; skip = 0; }' < /etc/ld.so.conf | $SED -e 's/#.*//;/^[ ]*hwcap[ ]/d;s/[:, ]/ /g;s/=[^=]*$//;s/=[^= ]* / /g;s/"//g;/^$/d' | tr '\n' ' '` + sys_lib_dlsearch_path_spec="/lib /usr/lib $lt_ld_extra" + fi + + # We used to test for /lib/ld.so.1 and disable shared libraries on + # powerpc, because MkLinux only supported shared libraries with the + # GNU dynamic linker. Since this was broken with cross compilers, + # most powerpc-linux boxes support dynamic linking these days and + # people can always --disable-shared, the test was removed, and we + # assume the GNU/Linux dynamic linker is in use. + dynamic_linker='GNU/Linux ld.so' + ;; + +netbsd*) + version_type=sunos + need_lib_prefix=no + need_version=no + if echo __ELF__ | $CC -E - | $GREP __ELF__ >/dev/null; then + library_names_spec='$libname$release$shared_ext$versuffix $libname$shared_ext$versuffix' + finish_cmds='PATH="\$PATH:/sbin" ldconfig -m $libdir' + dynamic_linker='NetBSD (a.out) ld.so' + else + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' + soname_spec='$libname$release$shared_ext$major' + dynamic_linker='NetBSD ld.elf_so' + fi + shlibpath_var=LD_LIBRARY_PATH + shlibpath_overrides_runpath=yes + hardcode_into_libs=yes + ;; + +newsos6) + version_type=linux # correct to gnu/linux during the next big refactor + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' + shlibpath_var=LD_LIBRARY_PATH + shlibpath_overrides_runpath=yes + ;; + +*nto* | *qnx*) + version_type=qnx + need_lib_prefix=no + need_version=no + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' + soname_spec='$libname$release$shared_ext$major' + shlibpath_var=LD_LIBRARY_PATH + shlibpath_overrides_runpath=no + hardcode_into_libs=yes + dynamic_linker='ldqnx.so' + ;; + +openbsd* | bitrig*) + version_type=sunos + sys_lib_dlsearch_path_spec=/usr/lib + need_lib_prefix=no + if test -z "`echo __ELF__ | $CC -E - | $GREP __ELF__`"; then + need_version=no + else + need_version=yes + fi + library_names_spec='$libname$release$shared_ext$versuffix $libname$shared_ext$versuffix' + finish_cmds='PATH="\$PATH:/sbin" ldconfig -m $libdir' + shlibpath_var=LD_LIBRARY_PATH + shlibpath_overrides_runpath=yes + ;; + +os2*) + libname_spec='$name' + version_type=windows + shrext_cmds=.dll + need_version=no + need_lib_prefix=no + # OS/2 can only load a DLL with a base name of 8 characters or less. + soname_spec='`test -n "$os2dllname" && libname="$os2dllname"; + v=$($ECHO $release$versuffix | tr -d .-); + n=$($ECHO $libname | cut -b -$((8 - ${#v})) | tr . _); + $ECHO $n$v`$shared_ext' + library_names_spec='${libname}_dll.$libext' + dynamic_linker='OS/2 ld.exe' + shlibpath_var=BEGINLIBPATH + sys_lib_search_path_spec="/lib /usr/lib /usr/local/lib" + sys_lib_dlsearch_path_spec=$sys_lib_search_path_spec + postinstall_cmds='base_file=`basename \$file`~ + dlpath=`$SHELL 2>&1 -c '\''. $dir/'\''\$base_file'\''i; $ECHO \$dlname'\''`~ + dldir=$destdir/`dirname \$dlpath`~ + test -d \$dldir || mkdir -p \$dldir~ + $install_prog $dir/$dlname \$dldir/$dlname~ + chmod a+x \$dldir/$dlname~ + if test -n '\''$stripme'\'' && test -n '\''$striplib'\''; then + eval '\''$striplib \$dldir/$dlname'\'' || exit \$?; + fi' + postuninstall_cmds='dldll=`$SHELL 2>&1 -c '\''. $file; $ECHO \$dlname'\''`~ + dlpath=$dir/\$dldll~ + $RM \$dlpath' + ;; + +osf3* | osf4* | osf5*) + version_type=osf + need_lib_prefix=no + need_version=no + soname_spec='$libname$release$shared_ext$major' + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' + shlibpath_var=LD_LIBRARY_PATH + sys_lib_search_path_spec="/usr/shlib /usr/ccs/lib /usr/lib/cmplrs/cc /usr/lib /usr/local/lib /var/shlib" + sys_lib_dlsearch_path_spec=$sys_lib_search_path_spec + ;; + +rdos*) + dynamic_linker=no + ;; + +solaris*) + version_type=linux # correct to gnu/linux during the next big refactor + need_lib_prefix=no + need_version=no + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' + soname_spec='$libname$release$shared_ext$major' + shlibpath_var=LD_LIBRARY_PATH + shlibpath_overrides_runpath=yes + hardcode_into_libs=yes + # ldd complains unless libraries are executable + postinstall_cmds='chmod +x $lib' + ;; + +sunos4*) + version_type=sunos + library_names_spec='$libname$release$shared_ext$versuffix $libname$shared_ext$versuffix' + finish_cmds='PATH="\$PATH:/usr/etc" ldconfig $libdir' + shlibpath_var=LD_LIBRARY_PATH + shlibpath_overrides_runpath=yes + if test yes = "$with_gnu_ld"; then + need_lib_prefix=no + fi + need_version=yes + ;; + +sysv4 | sysv4.3*) + version_type=linux # correct to gnu/linux during the next big refactor + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' + soname_spec='$libname$release$shared_ext$major' + shlibpath_var=LD_LIBRARY_PATH + case $host_vendor in + sni) + shlibpath_overrides_runpath=no + need_lib_prefix=no + runpath_var=LD_RUN_PATH + ;; + siemens) + need_lib_prefix=no + ;; + motorola) + need_lib_prefix=no + need_version=no + shlibpath_overrides_runpath=no + sys_lib_search_path_spec='/lib /usr/lib /usr/ccs/lib' + ;; + esac + ;; + +sysv4*MP*) + if test -d /usr/nec; then + version_type=linux # correct to gnu/linux during the next big refactor + library_names_spec='$libname$shared_ext.$versuffix $libname$shared_ext.$major $libname$shared_ext' + soname_spec='$libname$shared_ext.$major' + shlibpath_var=LD_LIBRARY_PATH + fi + ;; + +sysv5* | sco3.2v5* | sco5v6* | unixware* | OpenUNIX* | sysv4*uw2*) + version_type=sco + need_lib_prefix=no + need_version=no + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext $libname$shared_ext' + soname_spec='$libname$release$shared_ext$major' + shlibpath_var=LD_LIBRARY_PATH + shlibpath_overrides_runpath=yes + hardcode_into_libs=yes + if test yes = "$with_gnu_ld"; then + sys_lib_search_path_spec='/usr/local/lib /usr/gnu/lib /usr/ccs/lib /usr/lib /lib' + else + sys_lib_search_path_spec='/usr/ccs/lib /usr/lib' + case $host_os in + sco3.2v5*) + sys_lib_search_path_spec="$sys_lib_search_path_spec /lib" + ;; + esac + fi + sys_lib_dlsearch_path_spec='/usr/lib' + ;; + +tpf*) + # TPF is a cross-target only. Preferred cross-host = GNU/Linux. + version_type=linux # correct to gnu/linux during the next big refactor + need_lib_prefix=no + need_version=no + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' + shlibpath_var=LD_LIBRARY_PATH + shlibpath_overrides_runpath=no + hardcode_into_libs=yes + ;; + +uts4*) + version_type=linux # correct to gnu/linux during the next big refactor + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' + soname_spec='$libname$release$shared_ext$major' + shlibpath_var=LD_LIBRARY_PATH + ;; + +*) + dynamic_linker=no + ;; +esac +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $dynamic_linker" >&5 +$as_echo "$dynamic_linker" >&6; } +test no = "$dynamic_linker" && can_build_shared=no + +variables_saved_for_relink="PATH $shlibpath_var $runpath_var" +if test yes = "$GCC"; then + variables_saved_for_relink="$variables_saved_for_relink GCC_EXEC_PREFIX COMPILER_PATH LIBRARY_PATH" +fi + +if test set = "${lt_cv_sys_lib_search_path_spec+set}"; then + sys_lib_search_path_spec=$lt_cv_sys_lib_search_path_spec +fi + +if test set = "${lt_cv_sys_lib_dlsearch_path_spec+set}"; then + sys_lib_dlsearch_path_spec=$lt_cv_sys_lib_dlsearch_path_spec +fi + +# remember unaugmented sys_lib_dlsearch_path content for libtool script decls... +configure_time_dlsearch_path=$sys_lib_dlsearch_path_spec + +# ... but it needs LT_SYS_LIBRARY_PATH munging for other configure-time code +func_munge_path_list sys_lib_dlsearch_path_spec "$LT_SYS_LIBRARY_PATH" + +# to be used as default LT_SYS_LIBRARY_PATH value in generated libtool +configure_time_lt_sys_library_path=$LT_SYS_LIBRARY_PATH + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking how to hardcode library paths into programs" >&5 +$as_echo_n "checking how to hardcode library paths into programs... " >&6; } +hardcode_action= +if test -n "$hardcode_libdir_flag_spec" || + test -n "$runpath_var" || + test yes = "$hardcode_automatic"; then + + # We can hardcode non-existent directories. + if test no != "$hardcode_direct" && + # If the only mechanism to avoid hardcoding is shlibpath_var, we + # have to relink, otherwise we might link with an installed library + # when we should be linking with a yet-to-be-installed one + ## test no != "$_LT_TAGVAR(hardcode_shlibpath_var, )" && + test no != "$hardcode_minus_L"; then + # Linking always hardcodes the temporary library directory. + hardcode_action=relink + else + # We can link without hardcoding, and we can hardcode nonexisting dirs. + hardcode_action=immediate + fi +else + # We cannot hardcode anything, or else we can only hardcode existing + # directories. + hardcode_action=unsupported +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $hardcode_action" >&5 +$as_echo "$hardcode_action" >&6; } + +if test relink = "$hardcode_action" || + test yes = "$inherit_rpath"; then + # Fast installation is not supported + enable_fast_install=no +elif test yes = "$shlibpath_overrides_runpath" || + test no = "$enable_shared"; then + # Fast installation is not necessary + enable_fast_install=needless +fi + + + + + + + if test yes != "$enable_dlopen"; then + enable_dlopen=unknown + enable_dlopen_self=unknown + enable_dlopen_self_static=unknown +else + lt_cv_dlopen=no + lt_cv_dlopen_libs= + + case $host_os in + beos*) + lt_cv_dlopen=load_add_on + lt_cv_dlopen_libs= + lt_cv_dlopen_self=yes + ;; + + mingw* | pw32* | cegcc*) + lt_cv_dlopen=LoadLibrary + lt_cv_dlopen_libs= + ;; + + cygwin*) + lt_cv_dlopen=dlopen + lt_cv_dlopen_libs= + ;; + + darwin*) + # if libdl is installed we need to link against it + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for dlopen in -ldl" >&5 +$as_echo_n "checking for dlopen in -ldl... " >&6; } +if ${ac_cv_lib_dl_dlopen+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-ldl $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char dlopen (); +int +main () +{ +return dlopen (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_dl_dlopen=yes +else + ac_cv_lib_dl_dlopen=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_dl_dlopen" >&5 +$as_echo "$ac_cv_lib_dl_dlopen" >&6; } +if test "x$ac_cv_lib_dl_dlopen" = xyes; then : + lt_cv_dlopen=dlopen lt_cv_dlopen_libs=-ldl +else + + lt_cv_dlopen=dyld + lt_cv_dlopen_libs= + lt_cv_dlopen_self=yes + +fi + + ;; + + tpf*) + # Don't try to run any link tests for TPF. We know it's impossible + # because TPF is a cross-compiler, and we know how we open DSOs. + lt_cv_dlopen=dlopen + lt_cv_dlopen_libs= + lt_cv_dlopen_self=no + ;; + + *) + ac_fn_c_check_func "$LINENO" "shl_load" "ac_cv_func_shl_load" +if test "x$ac_cv_func_shl_load" = xyes; then : + lt_cv_dlopen=shl_load +else + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for shl_load in -ldld" >&5 +$as_echo_n "checking for shl_load in -ldld... " >&6; } +if ${ac_cv_lib_dld_shl_load+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-ldld $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char shl_load (); +int +main () +{ +return shl_load (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_dld_shl_load=yes +else + ac_cv_lib_dld_shl_load=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_dld_shl_load" >&5 +$as_echo "$ac_cv_lib_dld_shl_load" >&6; } +if test "x$ac_cv_lib_dld_shl_load" = xyes; then : + lt_cv_dlopen=shl_load lt_cv_dlopen_libs=-ldld +else + ac_fn_c_check_func "$LINENO" "dlopen" "ac_cv_func_dlopen" +if test "x$ac_cv_func_dlopen" = xyes; then : + lt_cv_dlopen=dlopen +else + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for dlopen in -ldl" >&5 +$as_echo_n "checking for dlopen in -ldl... " >&6; } +if ${ac_cv_lib_dl_dlopen+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-ldl $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char dlopen (); +int +main () +{ +return dlopen (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_dl_dlopen=yes +else + ac_cv_lib_dl_dlopen=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_dl_dlopen" >&5 +$as_echo "$ac_cv_lib_dl_dlopen" >&6; } +if test "x$ac_cv_lib_dl_dlopen" = xyes; then : + lt_cv_dlopen=dlopen lt_cv_dlopen_libs=-ldl +else + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for dlopen in -lsvld" >&5 +$as_echo_n "checking for dlopen in -lsvld... " >&6; } +if ${ac_cv_lib_svld_dlopen+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lsvld $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char dlopen (); +int +main () +{ +return dlopen (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_svld_dlopen=yes +else + ac_cv_lib_svld_dlopen=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_svld_dlopen" >&5 +$as_echo "$ac_cv_lib_svld_dlopen" >&6; } +if test "x$ac_cv_lib_svld_dlopen" = xyes; then : + lt_cv_dlopen=dlopen lt_cv_dlopen_libs=-lsvld +else + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for dld_link in -ldld" >&5 +$as_echo_n "checking for dld_link in -ldld... " >&6; } +if ${ac_cv_lib_dld_dld_link+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-ldld $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char dld_link (); +int +main () +{ +return dld_link (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_dld_dld_link=yes +else + ac_cv_lib_dld_dld_link=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_dld_dld_link" >&5 +$as_echo "$ac_cv_lib_dld_dld_link" >&6; } +if test "x$ac_cv_lib_dld_dld_link" = xyes; then : + lt_cv_dlopen=dld_link lt_cv_dlopen_libs=-ldld +fi + + +fi + + +fi + + +fi + + +fi + + +fi + + ;; + esac + + if test no = "$lt_cv_dlopen"; then + enable_dlopen=no + else + enable_dlopen=yes + fi + + case $lt_cv_dlopen in + dlopen) + save_CPPFLAGS=$CPPFLAGS + test yes = "$ac_cv_header_dlfcn_h" && CPPFLAGS="$CPPFLAGS -DHAVE_DLFCN_H" + + save_LDFLAGS=$LDFLAGS + wl=$lt_prog_compiler_wl eval LDFLAGS=\"\$LDFLAGS $export_dynamic_flag_spec\" + + save_LIBS=$LIBS + LIBS="$lt_cv_dlopen_libs $LIBS" + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether a program can dlopen itself" >&5 +$as_echo_n "checking whether a program can dlopen itself... " >&6; } +if ${lt_cv_dlopen_self+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test yes = "$cross_compiling"; then : + lt_cv_dlopen_self=cross +else + lt_dlunknown=0; lt_dlno_uscore=1; lt_dlneed_uscore=2 + lt_status=$lt_dlunknown + cat > conftest.$ac_ext <<_LT_EOF +#line $LINENO "configure" +#include "confdefs.h" + +#if HAVE_DLFCN_H +#include <dlfcn.h> +#endif + +#include <stdio.h> + +#ifdef RTLD_GLOBAL +# define LT_DLGLOBAL RTLD_GLOBAL +#else +# ifdef DL_GLOBAL +# define LT_DLGLOBAL DL_GLOBAL +# else +# define LT_DLGLOBAL 0 +# endif +#endif + +/* We may have to define LT_DLLAZY_OR_NOW in the command line if we + find out it does not work in some platform. */ +#ifndef LT_DLLAZY_OR_NOW +# ifdef RTLD_LAZY +# define LT_DLLAZY_OR_NOW RTLD_LAZY +# else +# ifdef DL_LAZY +# define LT_DLLAZY_OR_NOW DL_LAZY +# else +# ifdef RTLD_NOW +# define LT_DLLAZY_OR_NOW RTLD_NOW +# else +# ifdef DL_NOW +# define LT_DLLAZY_OR_NOW DL_NOW +# else +# define LT_DLLAZY_OR_NOW 0 +# endif +# endif +# endif +# endif +#endif + +/* When -fvisibility=hidden is used, assume the code has been annotated + correspondingly for the symbols needed. */ +#if defined __GNUC__ && (((__GNUC__ == 3) && (__GNUC_MINOR__ >= 3)) || (__GNUC__ > 3)) +int fnord () __attribute__((visibility("default"))); +#endif + +int fnord () { return 42; } +int main () +{ + void *self = dlopen (0, LT_DLGLOBAL|LT_DLLAZY_OR_NOW); + int status = $lt_dlunknown; + + if (self) + { + if (dlsym (self,"fnord")) status = $lt_dlno_uscore; + else + { + if (dlsym( self,"_fnord")) status = $lt_dlneed_uscore; + else puts (dlerror ()); + } + /* dlclose (self); */ + } + else + puts (dlerror ()); + + return status; +} +_LT_EOF + if { { eval echo "\"\$as_me\":${as_lineno-$LINENO}: \"$ac_link\""; } >&5 + (eval $ac_link) 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } && test -s "conftest$ac_exeext" 2>/dev/null; then + (./conftest; exit; ) >&5 2>/dev/null + lt_status=$? + case x$lt_status in + x$lt_dlno_uscore) lt_cv_dlopen_self=yes ;; + x$lt_dlneed_uscore) lt_cv_dlopen_self=yes ;; + x$lt_dlunknown|x*) lt_cv_dlopen_self=no ;; + esac + else : + # compilation failed + lt_cv_dlopen_self=no + fi +fi +rm -fr conftest* + + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_dlopen_self" >&5 +$as_echo "$lt_cv_dlopen_self" >&6; } + + if test yes = "$lt_cv_dlopen_self"; then + wl=$lt_prog_compiler_wl eval LDFLAGS=\"\$LDFLAGS $lt_prog_compiler_static\" + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether a statically linked program can dlopen itself" >&5 +$as_echo_n "checking whether a statically linked program can dlopen itself... " >&6; } +if ${lt_cv_dlopen_self_static+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test yes = "$cross_compiling"; then : + lt_cv_dlopen_self_static=cross +else + lt_dlunknown=0; lt_dlno_uscore=1; lt_dlneed_uscore=2 + lt_status=$lt_dlunknown + cat > conftest.$ac_ext <<_LT_EOF +#line $LINENO "configure" +#include "confdefs.h" + +#if HAVE_DLFCN_H +#include <dlfcn.h> +#endif + +#include <stdio.h> + +#ifdef RTLD_GLOBAL +# define LT_DLGLOBAL RTLD_GLOBAL +#else +# ifdef DL_GLOBAL +# define LT_DLGLOBAL DL_GLOBAL +# else +# define LT_DLGLOBAL 0 +# endif +#endif + +/* We may have to define LT_DLLAZY_OR_NOW in the command line if we + find out it does not work in some platform. */ +#ifndef LT_DLLAZY_OR_NOW +# ifdef RTLD_LAZY +# define LT_DLLAZY_OR_NOW RTLD_LAZY +# else +# ifdef DL_LAZY +# define LT_DLLAZY_OR_NOW DL_LAZY +# else +# ifdef RTLD_NOW +# define LT_DLLAZY_OR_NOW RTLD_NOW +# else +# ifdef DL_NOW +# define LT_DLLAZY_OR_NOW DL_NOW +# else +# define LT_DLLAZY_OR_NOW 0 +# endif +# endif +# endif +# endif +#endif + +/* When -fvisibility=hidden is used, assume the code has been annotated + correspondingly for the symbols needed. */ +#if defined __GNUC__ && (((__GNUC__ == 3) && (__GNUC_MINOR__ >= 3)) || (__GNUC__ > 3)) +int fnord () __attribute__((visibility("default"))); +#endif + +int fnord () { return 42; } +int main () +{ + void *self = dlopen (0, LT_DLGLOBAL|LT_DLLAZY_OR_NOW); + int status = $lt_dlunknown; + + if (self) + { + if (dlsym (self,"fnord")) status = $lt_dlno_uscore; + else + { + if (dlsym( self,"_fnord")) status = $lt_dlneed_uscore; + else puts (dlerror ()); + } + /* dlclose (self); */ + } + else + puts (dlerror ()); + + return status; +} +_LT_EOF + if { { eval echo "\"\$as_me\":${as_lineno-$LINENO}: \"$ac_link\""; } >&5 + (eval $ac_link) 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } && test -s "conftest$ac_exeext" 2>/dev/null; then + (./conftest; exit; ) >&5 2>/dev/null + lt_status=$? + case x$lt_status in + x$lt_dlno_uscore) lt_cv_dlopen_self_static=yes ;; + x$lt_dlneed_uscore) lt_cv_dlopen_self_static=yes ;; + x$lt_dlunknown|x*) lt_cv_dlopen_self_static=no ;; + esac + else : + # compilation failed + lt_cv_dlopen_self_static=no + fi +fi +rm -fr conftest* + + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_dlopen_self_static" >&5 +$as_echo "$lt_cv_dlopen_self_static" >&6; } + fi + + CPPFLAGS=$save_CPPFLAGS + LDFLAGS=$save_LDFLAGS + LIBS=$save_LIBS + ;; + esac + + case $lt_cv_dlopen_self in + yes|no) enable_dlopen_self=$lt_cv_dlopen_self ;; + *) enable_dlopen_self=unknown ;; + esac + + case $lt_cv_dlopen_self_static in + yes|no) enable_dlopen_self_static=$lt_cv_dlopen_self_static ;; + *) enable_dlopen_self_static=unknown ;; + esac +fi + + + + + + + + + + + + + + + + + +striplib= +old_striplib= +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether stripping libraries is possible" >&5 +$as_echo_n "checking whether stripping libraries is possible... " >&6; } +if test -n "$STRIP" && $STRIP -V 2>&1 | $GREP "GNU strip" >/dev/null; then + test -z "$old_striplib" && old_striplib="$STRIP --strip-debug" + test -z "$striplib" && striplib="$STRIP --strip-unneeded" + { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +$as_echo "yes" >&6; } +else +# FIXME - insert some real tests, host_os isn't really good enough + case $host_os in + darwin*) + if test -n "$STRIP"; then + striplib="$STRIP -x" + old_striplib="$STRIP -S" + { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +$as_echo "yes" >&6; } + else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } + fi + ;; + *) + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } + ;; + esac +fi + + + + + + + + + + + + + # Report what library types will actually be built + { $as_echo "$as_me:${as_lineno-$LINENO}: checking if libtool supports shared libraries" >&5 +$as_echo_n "checking if libtool supports shared libraries... " >&6; } + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $can_build_shared" >&5 +$as_echo "$can_build_shared" >&6; } + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether to build shared libraries" >&5 +$as_echo_n "checking whether to build shared libraries... " >&6; } + test no = "$can_build_shared" && enable_shared=no + + # On AIX, shared libraries and static libraries use the same namespace, and + # are all built from PIC. + case $host_os in + aix3*) + test yes = "$enable_shared" && enable_static=no + if test -n "$RANLIB"; then + archive_cmds="$archive_cmds~\$RANLIB \$lib" + postinstall_cmds='$RANLIB $lib' + fi + ;; + + aix[4-9]*) + if test ia64 != "$host_cpu"; then + case $enable_shared,$with_aix_soname,$aix_use_runtimelinking in + yes,aix,yes) ;; # shared object as lib.so file only + yes,svr4,*) ;; # shared object as lib.so archive member only + yes,*) enable_static=no ;; # shared object in lib.a archive as well + esac + fi + ;; + esac + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $enable_shared" >&5 +$as_echo "$enable_shared" >&6; } + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether to build static libraries" >&5 +$as_echo_n "checking whether to build static libraries... " >&6; } + # Make sure either enable_shared or enable_static is yes. + test yes = "$enable_shared" || enable_static=yes + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $enable_static" >&5 +$as_echo "$enable_static" >&6; } + + + + +fi +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + +CC=$lt_save_CC + + if test -n "$CXX" && ( test no != "$CXX" && + ( (test g++ = "$CXX" && `g++ -v >/dev/null 2>&1` ) || + (test g++ != "$CXX"))); then + ac_ext=cpp +ac_cpp='$CXXCPP $CPPFLAGS' +ac_compile='$CXX -c $CXXFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CXX -o conftest$ac_exeext $CXXFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_cxx_compiler_gnu +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking how to run the C++ preprocessor" >&5 +$as_echo_n "checking how to run the C++ preprocessor... " >&6; } +if test -z "$CXXCPP"; then + if ${ac_cv_prog_CXXCPP+:} false; then : + $as_echo_n "(cached) " >&6 +else + # Double quotes because CXXCPP needs to be expanded + for CXXCPP in "$CXX -E" "/lib/cpp" + do + ac_preproc_ok=false +for ac_cxx_preproc_warn_flag in '' yes +do + # Use a header file that comes with gcc, so configuring glibc + # with a fresh cross-compiler works. + # Prefer <limits.h> to <assert.h> if __STDC__ is defined, since + # <limits.h> exists even on freestanding compilers. + # On the NeXT, cc -E runs the code through the compiler's parser, + # not just through cpp. "Syntax error" is here to catch this case. + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#ifdef __STDC__ +# include <limits.h> +#else +# include <assert.h> +#endif + Syntax error +_ACEOF +if ac_fn_cxx_try_cpp "$LINENO"; then : + +else + # Broken: fails on valid input. +continue +fi +rm -f conftest.err conftest.i conftest.$ac_ext + + # OK, works on sane cases. Now check whether nonexistent headers + # can be detected and how. + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <ac_nonexistent.h> +_ACEOF +if ac_fn_cxx_try_cpp "$LINENO"; then : + # Broken: success on invalid input. +continue +else + # Passes both tests. +ac_preproc_ok=: +break +fi +rm -f conftest.err conftest.i conftest.$ac_ext + +done +# Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped. +rm -f conftest.i conftest.err conftest.$ac_ext +if $ac_preproc_ok; then : + break +fi + + done + ac_cv_prog_CXXCPP=$CXXCPP + +fi + CXXCPP=$ac_cv_prog_CXXCPP +else + ac_cv_prog_CXXCPP=$CXXCPP +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $CXXCPP" >&5 +$as_echo "$CXXCPP" >&6; } +ac_preproc_ok=false +for ac_cxx_preproc_warn_flag in '' yes +do + # Use a header file that comes with gcc, so configuring glibc + # with a fresh cross-compiler works. + # Prefer <limits.h> to <assert.h> if __STDC__ is defined, since + # <limits.h> exists even on freestanding compilers. + # On the NeXT, cc -E runs the code through the compiler's parser, + # not just through cpp. "Syntax error" is here to catch this case. + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#ifdef __STDC__ +# include <limits.h> +#else +# include <assert.h> +#endif + Syntax error +_ACEOF +if ac_fn_cxx_try_cpp "$LINENO"; then : + +else + # Broken: fails on valid input. +continue +fi +rm -f conftest.err conftest.i conftest.$ac_ext + + # OK, works on sane cases. Now check whether nonexistent headers + # can be detected and how. + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <ac_nonexistent.h> +_ACEOF +if ac_fn_cxx_try_cpp "$LINENO"; then : + # Broken: success on invalid input. +continue +else + # Passes both tests. +ac_preproc_ok=: +break +fi +rm -f conftest.err conftest.i conftest.$ac_ext + +done +# Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped. +rm -f conftest.i conftest.err conftest.$ac_ext +if $ac_preproc_ok; then : + +else + { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error $? "C++ preprocessor \"$CXXCPP\" fails sanity check +See \`config.log' for more details" "$LINENO" 5; } +fi + +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + +else + _lt_caught_CXX_error=yes +fi + +ac_ext=cpp +ac_cpp='$CXXCPP $CPPFLAGS' +ac_compile='$CXX -c $CXXFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CXX -o conftest$ac_exeext $CXXFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_cxx_compiler_gnu + +archive_cmds_need_lc_CXX=no +allow_undefined_flag_CXX= +always_export_symbols_CXX=no +archive_expsym_cmds_CXX= +compiler_needs_object_CXX=no +export_dynamic_flag_spec_CXX= +hardcode_direct_CXX=no +hardcode_direct_absolute_CXX=no +hardcode_libdir_flag_spec_CXX= +hardcode_libdir_separator_CXX= +hardcode_minus_L_CXX=no +hardcode_shlibpath_var_CXX=unsupported +hardcode_automatic_CXX=no +inherit_rpath_CXX=no +module_cmds_CXX= +module_expsym_cmds_CXX= +link_all_deplibs_CXX=unknown +old_archive_cmds_CXX=$old_archive_cmds +reload_flag_CXX=$reload_flag +reload_cmds_CXX=$reload_cmds +no_undefined_flag_CXX= +whole_archive_flag_spec_CXX= +enable_shared_with_static_runtimes_CXX=no + +# Source file extension for C++ test sources. +ac_ext=cpp + +# Object file extension for compiled C++ test sources. +objext=o +objext_CXX=$objext + +# No sense in running all these tests if we already determined that +# the CXX compiler isn't working. Some variables (like enable_shared) +# are currently assumed to apply to all compilers on this platform, +# and will be corrupted by setting them based on a non-working compiler. +if test yes != "$_lt_caught_CXX_error"; then + # Code to be used in simple compile tests + lt_simple_compile_test_code="int some_variable = 0;" + + # Code to be used in simple link tests + lt_simple_link_test_code='int main(int, char *[]) { return(0); }' + + # ltmain only uses $CC for tagged configurations so make sure $CC is set. + + + + + + +# If no C compiler was specified, use CC. +LTCC=${LTCC-"$CC"} + +# If no C compiler flags were specified, use CFLAGS. +LTCFLAGS=${LTCFLAGS-"$CFLAGS"} + +# Allow CC to be a program name with arguments. +compiler=$CC + + + # save warnings/boilerplate of simple test code + ac_outfile=conftest.$ac_objext +echo "$lt_simple_compile_test_code" >conftest.$ac_ext +eval "$ac_compile" 2>&1 >/dev/null | $SED '/^$/d; /^ *+/d' >conftest.err +_lt_compiler_boilerplate=`cat conftest.err` +$RM conftest* + + ac_outfile=conftest.$ac_objext +echo "$lt_simple_link_test_code" >conftest.$ac_ext +eval "$ac_link" 2>&1 >/dev/null | $SED '/^$/d; /^ *+/d' >conftest.err +_lt_linker_boilerplate=`cat conftest.err` +$RM -r conftest* + + + # Allow CC to be a program name with arguments. + lt_save_CC=$CC + lt_save_CFLAGS=$CFLAGS + lt_save_LD=$LD + lt_save_GCC=$GCC + GCC=$GXX + lt_save_with_gnu_ld=$with_gnu_ld + lt_save_path_LD=$lt_cv_path_LD + if test -n "${lt_cv_prog_gnu_ldcxx+set}"; then + lt_cv_prog_gnu_ld=$lt_cv_prog_gnu_ldcxx + else + $as_unset lt_cv_prog_gnu_ld + fi + if test -n "${lt_cv_path_LDCXX+set}"; then + lt_cv_path_LD=$lt_cv_path_LDCXX + else + $as_unset lt_cv_path_LD + fi + test -z "${LDCXX+set}" || LD=$LDCXX + CC=${CXX-"c++"} + CFLAGS=$CXXFLAGS + compiler=$CC + compiler_CXX=$CC + func_cc_basename $compiler +cc_basename=$func_cc_basename_result + + + if test -n "$compiler"; then + # We don't want -fno-exception when compiling C++ code, so set the + # no_builtin_flag separately + if test yes = "$GXX"; then + lt_prog_compiler_no_builtin_flag_CXX=' -fno-builtin' + else + lt_prog_compiler_no_builtin_flag_CXX= + fi + + if test yes = "$GXX"; then + # Set up default GNU C++ configuration + + + +# Check whether --with-gnu-ld was given. +if test "${with_gnu_ld+set}" = set; then : + withval=$with_gnu_ld; test no = "$withval" || with_gnu_ld=yes +else + with_gnu_ld=no +fi + +ac_prog=ld +if test yes = "$GCC"; then + # Check if gcc -print-prog-name=ld gives a path. + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for ld used by $CC" >&5 +$as_echo_n "checking for ld used by $CC... " >&6; } + case $host in + *-*-mingw*) + # gcc leaves a trailing carriage return, which upsets mingw + ac_prog=`($CC -print-prog-name=ld) 2>&5 | tr -d '\015'` ;; + *) + ac_prog=`($CC -print-prog-name=ld) 2>&5` ;; + esac + case $ac_prog in + # Accept absolute paths. + [\\/]* | ?:[\\/]*) + re_direlt='/[^/][^/]*/\.\./' + # Canonicalize the pathname of ld + ac_prog=`$ECHO "$ac_prog"| $SED 's%\\\\%/%g'` + while $ECHO "$ac_prog" | $GREP "$re_direlt" > /dev/null 2>&1; do + ac_prog=`$ECHO $ac_prog| $SED "s%$re_direlt%/%"` + done + test -z "$LD" && LD=$ac_prog + ;; + "") + # If it fails, then pretend we aren't using GCC. + ac_prog=ld + ;; + *) + # If it is relative, then search for the first ld in PATH. + with_gnu_ld=unknown + ;; + esac +elif test yes = "$with_gnu_ld"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for GNU ld" >&5 +$as_echo_n "checking for GNU ld... " >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for non-GNU ld" >&5 +$as_echo_n "checking for non-GNU ld... " >&6; } +fi +if ${lt_cv_path_LD+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -z "$LD"; then + lt_save_ifs=$IFS; IFS=$PATH_SEPARATOR + for ac_dir in $PATH; do + IFS=$lt_save_ifs + test -z "$ac_dir" && ac_dir=. + if test -f "$ac_dir/$ac_prog" || test -f "$ac_dir/$ac_prog$ac_exeext"; then + lt_cv_path_LD=$ac_dir/$ac_prog + # Check to see if the program is GNU ld. I'd rather use --version, + # but apparently some variants of GNU ld only accept -v. + # Break only if it was the GNU/non-GNU ld that we prefer. + case `"$lt_cv_path_LD" -v 2>&1 </dev/null` in + *GNU* | *'with BFD'*) + test no != "$with_gnu_ld" && break + ;; + *) + test yes != "$with_gnu_ld" && break + ;; + esac + fi + done + IFS=$lt_save_ifs +else + lt_cv_path_LD=$LD # Let the user override the test with a path. +fi +fi + +LD=$lt_cv_path_LD +if test -n "$LD"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $LD" >&5 +$as_echo "$LD" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi +test -z "$LD" && as_fn_error $? "no acceptable ld found in \$PATH" "$LINENO" 5 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking if the linker ($LD) is GNU ld" >&5 +$as_echo_n "checking if the linker ($LD) is GNU ld... " >&6; } +if ${lt_cv_prog_gnu_ld+:} false; then : + $as_echo_n "(cached) " >&6 +else + # I'd rather use --version here, but apparently some GNU lds only accept -v. +case `$LD -v 2>&1 </dev/null` in +*GNU* | *'with BFD'*) + lt_cv_prog_gnu_ld=yes + ;; +*) + lt_cv_prog_gnu_ld=no + ;; +esac +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_prog_gnu_ld" >&5 +$as_echo "$lt_cv_prog_gnu_ld" >&6; } +with_gnu_ld=$lt_cv_prog_gnu_ld + + + + + + + + # Check if GNU C++ uses GNU ld as the underlying linker, since the + # archiving commands below assume that GNU ld is being used. + if test yes = "$with_gnu_ld"; then + archive_cmds_CXX='$CC $pic_flag -shared -nostdlib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags $wl-soname $wl$soname -o $lib' + archive_expsym_cmds_CXX='$CC $pic_flag -shared -nostdlib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags $wl-soname $wl$soname $wl-retain-symbols-file $wl$export_symbols -o $lib' + + hardcode_libdir_flag_spec_CXX='$wl-rpath $wl$libdir' + export_dynamic_flag_spec_CXX='$wl--export-dynamic' + + # If archive_cmds runs LD, not CC, wlarc should be empty + # XXX I think wlarc can be eliminated in ltcf-cxx, but I need to + # investigate it a little bit more. (MM) + wlarc='$wl' + + # ancient GNU ld didn't support --whole-archive et. al. + if eval "`$CC -print-prog-name=ld` --help 2>&1" | + $GREP 'no-whole-archive' > /dev/null; then + whole_archive_flag_spec_CXX=$wlarc'--whole-archive$convenience '$wlarc'--no-whole-archive' + else + whole_archive_flag_spec_CXX= + fi + else + with_gnu_ld=no + wlarc= + + # A generic and very simple default shared library creation + # command for GNU C++ for the case where it uses the native + # linker, instead of GNU ld. If possible, this setting should + # overridden to take advantage of the native linker features on + # the platform it is being used on. + archive_cmds_CXX='$CC -shared -nostdlib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags -o $lib' + fi + + # Commands to make compiler produce verbose output that lists + # what "hidden" libraries, object files and flags are used when + # linking a shared library. + output_verbose_link_cmd='$CC -shared $CFLAGS -v conftest.$objext 2>&1 | $GREP -v "^Configured with:" | $GREP "\-L"' + + else + GXX=no + with_gnu_ld=no + wlarc= + fi + + # PORTME: fill in a description of your system's C++ link characteristics + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether the $compiler linker ($LD) supports shared libraries" >&5 +$as_echo_n "checking whether the $compiler linker ($LD) supports shared libraries... " >&6; } + ld_shlibs_CXX=yes + case $host_os in + aix3*) + # FIXME: insert proper C++ library support + ld_shlibs_CXX=no + ;; + aix[4-9]*) + if test ia64 = "$host_cpu"; then + # On IA64, the linker does run time linking by default, so we don't + # have to do anything special. + aix_use_runtimelinking=no + exp_sym_flag='-Bexport' + no_entry_flag= + else + aix_use_runtimelinking=no + + # Test if we are trying to use run time linking or normal + # AIX style linking. If -brtl is somewhere in LDFLAGS, we + # have runtime linking enabled, and use it for executables. + # For shared libraries, we enable/disable runtime linking + # depending on the kind of the shared library created - + # when "with_aix_soname,aix_use_runtimelinking" is: + # "aix,no" lib.a(lib.so.V) shared, rtl:no, for executables + # "aix,yes" lib.so shared, rtl:yes, for executables + # lib.a static archive + # "both,no" lib.so.V(shr.o) shared, rtl:yes + # lib.a(lib.so.V) shared, rtl:no, for executables + # "both,yes" lib.so.V(shr.o) shared, rtl:yes, for executables + # lib.a(lib.so.V) shared, rtl:no + # "svr4,*" lib.so.V(shr.o) shared, rtl:yes, for executables + # lib.a static archive + case $host_os in aix4.[23]|aix4.[23].*|aix[5-9]*) + for ld_flag in $LDFLAGS; do + case $ld_flag in + *-brtl*) + aix_use_runtimelinking=yes + break + ;; + esac + done + if test svr4,no = "$with_aix_soname,$aix_use_runtimelinking"; then + # With aix-soname=svr4, we create the lib.so.V shared archives only, + # so we don't have lib.a shared libs to link our executables. + # We have to force runtime linking in this case. + aix_use_runtimelinking=yes + LDFLAGS="$LDFLAGS -Wl,-brtl" + fi + ;; + esac + + exp_sym_flag='-bexport' + no_entry_flag='-bnoentry' + fi + + # When large executables or shared objects are built, AIX ld can + # have problems creating the table of contents. If linking a library + # or program results in "error TOC overflow" add -mminimal-toc to + # CXXFLAGS/CFLAGS for g++/gcc. In the cases where that is not + # enough to fix the problem, add -Wl,-bbigtoc to LDFLAGS. + + archive_cmds_CXX='' + hardcode_direct_CXX=yes + hardcode_direct_absolute_CXX=yes + hardcode_libdir_separator_CXX=':' + link_all_deplibs_CXX=yes + file_list_spec_CXX='$wl-f,' + case $with_aix_soname,$aix_use_runtimelinking in + aix,*) ;; # no import file + svr4,* | *,yes) # use import file + # The Import File defines what to hardcode. + hardcode_direct_CXX=no + hardcode_direct_absolute_CXX=no + ;; + esac + + if test yes = "$GXX"; then + case $host_os in aix4.[012]|aix4.[012].*) + # We only want to do this on AIX 4.2 and lower, the check + # below for broken collect2 doesn't work under 4.3+ + collect2name=`$CC -print-prog-name=collect2` + if test -f "$collect2name" && + strings "$collect2name" | $GREP resolve_lib_name >/dev/null + then + # We have reworked collect2 + : + else + # We have old collect2 + hardcode_direct_CXX=unsupported + # It fails to find uninstalled libraries when the uninstalled + # path is not listed in the libpath. Setting hardcode_minus_L + # to unsupported forces relinking + hardcode_minus_L_CXX=yes + hardcode_libdir_flag_spec_CXX='-L$libdir' + hardcode_libdir_separator_CXX= + fi + esac + shared_flag='-shared' + if test yes = "$aix_use_runtimelinking"; then + shared_flag=$shared_flag' $wl-G' + fi + # Need to ensure runtime linking is disabled for the traditional + # shared library, or the linker may eventually find shared libraries + # /with/ Import File - we do not want to mix them. + shared_flag_aix='-shared' + shared_flag_svr4='-shared $wl-G' + else + # not using gcc + if test ia64 = "$host_cpu"; then + # VisualAge C++, Version 5.5 for AIX 5L for IA-64, Beta 3 Release + # chokes on -Wl,-G. The following line is correct: + shared_flag='-G' + else + if test yes = "$aix_use_runtimelinking"; then + shared_flag='$wl-G' + else + shared_flag='$wl-bM:SRE' + fi + shared_flag_aix='$wl-bM:SRE' + shared_flag_svr4='$wl-G' + fi + fi + + export_dynamic_flag_spec_CXX='$wl-bexpall' + # It seems that -bexpall does not export symbols beginning with + # underscore (_), so it is better to generate a list of symbols to + # export. + always_export_symbols_CXX=yes + if test aix,yes = "$with_aix_soname,$aix_use_runtimelinking"; then + # Warning - without using the other runtime loading flags (-brtl), + # -berok will link without error, but may produce a broken library. + # The "-G" linker flag allows undefined symbols. + no_undefined_flag_CXX='-bernotok' + # Determine the default libpath from the value encoded in an empty + # executable. + if test set = "${lt_cv_aix_libpath+set}"; then + aix_libpath=$lt_cv_aix_libpath +else + if ${lt_cv_aix_libpath__CXX+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_cxx_try_link "$LINENO"; then : + + lt_aix_libpath_sed=' + /Import File Strings/,/^$/ { + /^0/ { + s/^0 *\([^ ]*\) *$/\1/ + p + } + }' + lt_cv_aix_libpath__CXX=`dump -H conftest$ac_exeext 2>/dev/null | $SED -n -e "$lt_aix_libpath_sed"` + # Check for a 64-bit object if we didn't find anything. + if test -z "$lt_cv_aix_libpath__CXX"; then + lt_cv_aix_libpath__CXX=`dump -HX64 conftest$ac_exeext 2>/dev/null | $SED -n -e "$lt_aix_libpath_sed"` + fi +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + if test -z "$lt_cv_aix_libpath__CXX"; then + lt_cv_aix_libpath__CXX=/usr/lib:/lib + fi + +fi + + aix_libpath=$lt_cv_aix_libpath__CXX +fi + + hardcode_libdir_flag_spec_CXX='$wl-blibpath:$libdir:'"$aix_libpath" + + archive_expsym_cmds_CXX='$CC -o $output_objdir/$soname $libobjs $deplibs $wl'$no_entry_flag' $compiler_flags `if test -n "$allow_undefined_flag"; then func_echo_all "$wl$allow_undefined_flag"; else :; fi` $wl'$exp_sym_flag:\$export_symbols' '$shared_flag + else + if test ia64 = "$host_cpu"; then + hardcode_libdir_flag_spec_CXX='$wl-R $libdir:/usr/lib:/lib' + allow_undefined_flag_CXX="-z nodefs" + archive_expsym_cmds_CXX="\$CC $shared_flag"' -o $output_objdir/$soname $libobjs $deplibs '"\$wl$no_entry_flag"' $compiler_flags $wl$allow_undefined_flag '"\$wl$exp_sym_flag:\$export_symbols" + else + # Determine the default libpath from the value encoded in an + # empty executable. + if test set = "${lt_cv_aix_libpath+set}"; then + aix_libpath=$lt_cv_aix_libpath +else + if ${lt_cv_aix_libpath__CXX+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_cxx_try_link "$LINENO"; then : + + lt_aix_libpath_sed=' + /Import File Strings/,/^$/ { + /^0/ { + s/^0 *\([^ ]*\) *$/\1/ + p + } + }' + lt_cv_aix_libpath__CXX=`dump -H conftest$ac_exeext 2>/dev/null | $SED -n -e "$lt_aix_libpath_sed"` + # Check for a 64-bit object if we didn't find anything. + if test -z "$lt_cv_aix_libpath__CXX"; then + lt_cv_aix_libpath__CXX=`dump -HX64 conftest$ac_exeext 2>/dev/null | $SED -n -e "$lt_aix_libpath_sed"` + fi +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + if test -z "$lt_cv_aix_libpath__CXX"; then + lt_cv_aix_libpath__CXX=/usr/lib:/lib + fi + +fi + + aix_libpath=$lt_cv_aix_libpath__CXX +fi + + hardcode_libdir_flag_spec_CXX='$wl-blibpath:$libdir:'"$aix_libpath" + # Warning - without using the other run time loading flags, + # -berok will link without error, but may produce a broken library. + no_undefined_flag_CXX=' $wl-bernotok' + allow_undefined_flag_CXX=' $wl-berok' + if test yes = "$with_gnu_ld"; then + # We only use this code for GNU lds that support --whole-archive. + whole_archive_flag_spec_CXX='$wl--whole-archive$convenience $wl--no-whole-archive' + else + # Exported symbols can be pulled into shared objects from archives + whole_archive_flag_spec_CXX='$convenience' + fi + archive_cmds_need_lc_CXX=yes + archive_expsym_cmds_CXX='$RM -r $output_objdir/$realname.d~$MKDIR $output_objdir/$realname.d' + # -brtl affects multiple linker settings, -berok does not and is overridden later + compiler_flags_filtered='`func_echo_all "$compiler_flags " | $SED -e "s%-brtl\\([, ]\\)%-berok\\1%g"`' + if test svr4 != "$with_aix_soname"; then + # This is similar to how AIX traditionally builds its shared + # libraries. Need -bnortl late, we may have -brtl in LDFLAGS. + archive_expsym_cmds_CXX="$archive_expsym_cmds_CXX"'~$CC '$shared_flag_aix' -o $output_objdir/$realname.d/$soname $libobjs $deplibs $wl-bnoentry '$compiler_flags_filtered'$wl-bE:$export_symbols$allow_undefined_flag~$AR $AR_FLAGS $output_objdir/$libname$release.a $output_objdir/$realname.d/$soname' + fi + if test aix != "$with_aix_soname"; then + archive_expsym_cmds_CXX="$archive_expsym_cmds_CXX"'~$CC '$shared_flag_svr4' -o $output_objdir/$realname.d/$shared_archive_member_spec.o $libobjs $deplibs $wl-bnoentry '$compiler_flags_filtered'$wl-bE:$export_symbols$allow_undefined_flag~$STRIP -e $output_objdir/$realname.d/$shared_archive_member_spec.o~( func_echo_all "#! $soname($shared_archive_member_spec.o)"; if test shr_64 = "$shared_archive_member_spec"; then func_echo_all "# 64"; else func_echo_all "# 32"; fi; cat $export_symbols ) > $output_objdir/$realname.d/$shared_archive_member_spec.imp~$AR $AR_FLAGS $output_objdir/$soname $output_objdir/$realname.d/$shared_archive_member_spec.o $output_objdir/$realname.d/$shared_archive_member_spec.imp' + else + # used by -dlpreopen to get the symbols + archive_expsym_cmds_CXX="$archive_expsym_cmds_CXX"'~$MV $output_objdir/$realname.d/$soname $output_objdir' + fi + archive_expsym_cmds_CXX="$archive_expsym_cmds_CXX"'~$RM -r $output_objdir/$realname.d' + fi + fi + ;; + + beos*) + if $LD --help 2>&1 | $GREP ': supported targets:.* elf' > /dev/null; then + allow_undefined_flag_CXX=unsupported + # Joseph Beckenbach <jrb3@best.com> says some releases of gcc + # support --undefined. This deserves some investigation. FIXME + archive_cmds_CXX='$CC -nostart $libobjs $deplibs $compiler_flags $wl-soname $wl$soname -o $lib' + else + ld_shlibs_CXX=no + fi + ;; + + chorus*) + case $cc_basename in + *) + # FIXME: insert proper C++ library support + ld_shlibs_CXX=no + ;; + esac + ;; + + cygwin* | mingw* | pw32* | cegcc*) + case $GXX,$cc_basename in + ,cl* | no,cl*) + # Native MSVC + # hardcode_libdir_flag_spec is actually meaningless, as there is + # no search path for DLLs. + hardcode_libdir_flag_spec_CXX=' ' + allow_undefined_flag_CXX=unsupported + always_export_symbols_CXX=yes + file_list_spec_CXX='@' + # Tell ltmain to make .lib files, not .a files. + libext=lib + # Tell ltmain to make .dll files, not .so files. + shrext_cmds=.dll + # FIXME: Setting linknames here is a bad hack. + archive_cmds_CXX='$CC -o $output_objdir/$soname $libobjs $compiler_flags $deplibs -Wl,-DLL,-IMPLIB:"$tool_output_objdir$libname.dll.lib"~linknames=' + archive_expsym_cmds_CXX='if test DEF = "`$SED -n -e '\''s/^[ ]*//'\'' -e '\''/^\(;.*\)*$/d'\'' -e '\''s/^\(EXPORTS\|LIBRARY\)\([ ].*\)*$/DEF/p'\'' -e q $export_symbols`" ; then + cp "$export_symbols" "$output_objdir/$soname.def"; + echo "$tool_output_objdir$soname.def" > "$output_objdir/$soname.exp"; + else + $SED -e '\''s/^/-link -EXPORT:/'\'' < $export_symbols > $output_objdir/$soname.exp; + fi~ + $CC -o $tool_output_objdir$soname $libobjs $compiler_flags $deplibs "@$tool_output_objdir$soname.exp" -Wl,-DLL,-IMPLIB:"$tool_output_objdir$libname.dll.lib"~ + linknames=' + # The linker will not automatically build a static lib if we build a DLL. + # _LT_TAGVAR(old_archive_from_new_cmds, CXX)='true' + enable_shared_with_static_runtimes_CXX=yes + # Don't use ranlib + old_postinstall_cmds_CXX='chmod 644 $oldlib' + postlink_cmds_CXX='lt_outputfile="@OUTPUT@"~ + lt_tool_outputfile="@TOOL_OUTPUT@"~ + case $lt_outputfile in + *.exe|*.EXE) ;; + *) + lt_outputfile=$lt_outputfile.exe + lt_tool_outputfile=$lt_tool_outputfile.exe + ;; + esac~ + func_to_tool_file "$lt_outputfile"~ + if test : != "$MANIFEST_TOOL" && test -f "$lt_outputfile.manifest"; then + $MANIFEST_TOOL -manifest "$lt_tool_outputfile.manifest" -outputresource:"$lt_tool_outputfile" || exit 1; + $RM "$lt_outputfile.manifest"; + fi' + ;; + *) + # g++ + # _LT_TAGVAR(hardcode_libdir_flag_spec, CXX) is actually meaningless, + # as there is no search path for DLLs. + hardcode_libdir_flag_spec_CXX='-L$libdir' + export_dynamic_flag_spec_CXX='$wl--export-all-symbols' + allow_undefined_flag_CXX=unsupported + always_export_symbols_CXX=no + enable_shared_with_static_runtimes_CXX=yes + + if $LD --help 2>&1 | $GREP 'auto-import' > /dev/null; then + archive_cmds_CXX='$CC -shared -nostdlib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags -o $output_objdir/$soname $wl--enable-auto-image-base -Xlinker --out-implib -Xlinker $lib' + # If the export-symbols file already is a .def file, use it as + # is; otherwise, prepend EXPORTS... + archive_expsym_cmds_CXX='if test DEF = "`$SED -n -e '\''s/^[ ]*//'\'' -e '\''/^\(;.*\)*$/d'\'' -e '\''s/^\(EXPORTS\|LIBRARY\)\([ ].*\)*$/DEF/p'\'' -e q $export_symbols`" ; then + cp $export_symbols $output_objdir/$soname.def; + else + echo EXPORTS > $output_objdir/$soname.def; + cat $export_symbols >> $output_objdir/$soname.def; + fi~ + $CC -shared -nostdlib $output_objdir/$soname.def $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags -o $output_objdir/$soname $wl--enable-auto-image-base -Xlinker --out-implib -Xlinker $lib' + else + ld_shlibs_CXX=no + fi + ;; + esac + ;; + darwin* | rhapsody*) + + + archive_cmds_need_lc_CXX=no + hardcode_direct_CXX=no + hardcode_automatic_CXX=yes + hardcode_shlibpath_var_CXX=unsupported + if test yes = "$lt_cv_ld_force_load"; then + whole_archive_flag_spec_CXX='`for conv in $convenience\"\"; do test -n \"$conv\" && new_convenience=\"$new_convenience $wl-force_load,$conv\"; done; func_echo_all \"$new_convenience\"`' + + else + whole_archive_flag_spec_CXX='' + fi + link_all_deplibs_CXX=yes + allow_undefined_flag_CXX=$_lt_dar_allow_undefined + case $cc_basename in + ifort*|nagfor*) _lt_dar_can_shared=yes ;; + *) _lt_dar_can_shared=$GCC ;; + esac + if test yes = "$_lt_dar_can_shared"; then + output_verbose_link_cmd=func_echo_all + archive_cmds_CXX="\$CC -dynamiclib \$allow_undefined_flag -o \$lib \$libobjs \$deplibs \$compiler_flags -install_name \$rpath/\$soname \$verstring $_lt_dar_single_mod$_lt_dsymutil" + module_cmds_CXX="\$CC \$allow_undefined_flag -o \$lib -bundle \$libobjs \$deplibs \$compiler_flags$_lt_dsymutil" + archive_expsym_cmds_CXX="sed 's|^|_|' < \$export_symbols > \$output_objdir/\$libname-symbols.expsym~\$CC -dynamiclib \$allow_undefined_flag -o \$lib \$libobjs \$deplibs \$compiler_flags -install_name \$rpath/\$soname \$verstring $_lt_dar_single_mod$_lt_dar_export_syms$_lt_dsymutil" + module_expsym_cmds_CXX="sed -e 's|^|_|' < \$export_symbols > \$output_objdir/\$libname-symbols.expsym~\$CC \$allow_undefined_flag -o \$lib -bundle \$libobjs \$deplibs \$compiler_flags$_lt_dar_export_syms$_lt_dsymutil" + if test yes != "$lt_cv_apple_cc_single_mod"; then + archive_cmds_CXX="\$CC -r -keep_private_externs -nostdlib -o \$lib-master.o \$libobjs~\$CC -dynamiclib \$allow_undefined_flag -o \$lib \$lib-master.o \$deplibs \$compiler_flags -install_name \$rpath/\$soname \$verstring$_lt_dsymutil" + archive_expsym_cmds_CXX="sed 's|^|_|' < \$export_symbols > \$output_objdir/\$libname-symbols.expsym~\$CC -r -keep_private_externs -nostdlib -o \$lib-master.o \$libobjs~\$CC -dynamiclib \$allow_undefined_flag -o \$lib \$lib-master.o \$deplibs \$compiler_flags -install_name \$rpath/\$soname \$verstring$_lt_dar_export_syms$_lt_dsymutil" + fi + + else + ld_shlibs_CXX=no + fi + + ;; + + os2*) + hardcode_libdir_flag_spec_CXX='-L$libdir' + hardcode_minus_L_CXX=yes + allow_undefined_flag_CXX=unsupported + shrext_cmds=.dll + archive_cmds_CXX='$ECHO "LIBRARY ${soname%$shared_ext} INITINSTANCE TERMINSTANCE" > $output_objdir/$libname.def~ + $ECHO "DESCRIPTION \"$libname\"" >> $output_objdir/$libname.def~ + $ECHO "DATA MULTIPLE NONSHARED" >> $output_objdir/$libname.def~ + $ECHO EXPORTS >> $output_objdir/$libname.def~ + emxexp $libobjs | $SED /"_DLL_InitTerm"/d >> $output_objdir/$libname.def~ + $CC -Zdll -Zcrtdll -o $output_objdir/$soname $libobjs $deplibs $compiler_flags $output_objdir/$libname.def~ + emximp -o $lib $output_objdir/$libname.def' + archive_expsym_cmds_CXX='$ECHO "LIBRARY ${soname%$shared_ext} INITINSTANCE TERMINSTANCE" > $output_objdir/$libname.def~ + $ECHO "DESCRIPTION \"$libname\"" >> $output_objdir/$libname.def~ + $ECHO "DATA MULTIPLE NONSHARED" >> $output_objdir/$libname.def~ + $ECHO EXPORTS >> $output_objdir/$libname.def~ + prefix_cmds="$SED"~ + if test EXPORTS = "`$SED 1q $export_symbols`"; then + prefix_cmds="$prefix_cmds -e 1d"; + fi~ + prefix_cmds="$prefix_cmds -e \"s/^\(.*\)$/_\1/g\""~ + cat $export_symbols | $prefix_cmds >> $output_objdir/$libname.def~ + $CC -Zdll -Zcrtdll -o $output_objdir/$soname $libobjs $deplibs $compiler_flags $output_objdir/$libname.def~ + emximp -o $lib $output_objdir/$libname.def' + old_archive_From_new_cmds_CXX='emximp -o $output_objdir/${libname}_dll.a $output_objdir/$libname.def' + enable_shared_with_static_runtimes_CXX=yes + ;; + + dgux*) + case $cc_basename in + ec++*) + # FIXME: insert proper C++ library support + ld_shlibs_CXX=no + ;; + ghcx*) + # Green Hills C++ Compiler + # FIXME: insert proper C++ library support + ld_shlibs_CXX=no + ;; + *) + # FIXME: insert proper C++ library support + ld_shlibs_CXX=no + ;; + esac + ;; + + freebsd2.*) + # C++ shared libraries reported to be fairly broken before + # switch to ELF + ld_shlibs_CXX=no + ;; + + freebsd-elf*) + archive_cmds_need_lc_CXX=no + ;; + + freebsd* | dragonfly*) + # FreeBSD 3 and later use GNU C++ and GNU ld with standard ELF + # conventions + ld_shlibs_CXX=yes + ;; + + haiku*) + archive_cmds_CXX='$CC -shared $libobjs $deplibs $compiler_flags $wl-soname $wl$soname -o $lib' + link_all_deplibs_CXX=yes + ;; + + hpux9*) + hardcode_libdir_flag_spec_CXX='$wl+b $wl$libdir' + hardcode_libdir_separator_CXX=: + export_dynamic_flag_spec_CXX='$wl-E' + hardcode_direct_CXX=yes + hardcode_minus_L_CXX=yes # Not in the search PATH, + # but as the default + # location of the library. + + case $cc_basename in + CC*) + # FIXME: insert proper C++ library support + ld_shlibs_CXX=no + ;; + aCC*) + archive_cmds_CXX='$RM $output_objdir/$soname~$CC -b $wl+b $wl$install_libdir -o $output_objdir/$soname $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags~test "x$output_objdir/$soname" = "x$lib" || mv $output_objdir/$soname $lib' + # Commands to make compiler produce verbose output that lists + # what "hidden" libraries, object files and flags are used when + # linking a shared library. + # + # There doesn't appear to be a way to prevent this compiler from + # explicitly linking system object files so we need to strip them + # from the output so that they don't get included in the library + # dependencies. + output_verbose_link_cmd='templist=`($CC -b $CFLAGS -v conftest.$objext 2>&1) | $EGREP "\-L"`; list= ; for z in $templist; do case $z in conftest.$objext) list="$list $z";; *.$objext);; *) list="$list $z";;esac; done; func_echo_all "$list"' + ;; + *) + if test yes = "$GXX"; then + archive_cmds_CXX='$RM $output_objdir/$soname~$CC -shared -nostdlib $pic_flag $wl+b $wl$install_libdir -o $output_objdir/$soname $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags~test "x$output_objdir/$soname" = "x$lib" || mv $output_objdir/$soname $lib' + else + # FIXME: insert proper C++ library support + ld_shlibs_CXX=no + fi + ;; + esac + ;; + + hpux10*|hpux11*) + if test no = "$with_gnu_ld"; then + hardcode_libdir_flag_spec_CXX='$wl+b $wl$libdir' + hardcode_libdir_separator_CXX=: + + case $host_cpu in + hppa*64*|ia64*) + ;; + *) + export_dynamic_flag_spec_CXX='$wl-E' + ;; + esac + fi + case $host_cpu in + hppa*64*|ia64*) + hardcode_direct_CXX=no + hardcode_shlibpath_var_CXX=no + ;; + *) + hardcode_direct_CXX=yes + hardcode_direct_absolute_CXX=yes + hardcode_minus_L_CXX=yes # Not in the search PATH, + # but as the default + # location of the library. + ;; + esac + + case $cc_basename in + CC*) + # FIXME: insert proper C++ library support + ld_shlibs_CXX=no + ;; + aCC*) + case $host_cpu in + hppa*64*) + archive_cmds_CXX='$CC -b $wl+h $wl$soname -o $lib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags' + ;; + ia64*) + archive_cmds_CXX='$CC -b $wl+h $wl$soname $wl+nodefaultrpath -o $lib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags' + ;; + *) + archive_cmds_CXX='$CC -b $wl+h $wl$soname $wl+b $wl$install_libdir -o $lib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags' + ;; + esac + # Commands to make compiler produce verbose output that lists + # what "hidden" libraries, object files and flags are used when + # linking a shared library. + # + # There doesn't appear to be a way to prevent this compiler from + # explicitly linking system object files so we need to strip them + # from the output so that they don't get included in the library + # dependencies. + output_verbose_link_cmd='templist=`($CC -b $CFLAGS -v conftest.$objext 2>&1) | $GREP "\-L"`; list= ; for z in $templist; do case $z in conftest.$objext) list="$list $z";; *.$objext);; *) list="$list $z";;esac; done; func_echo_all "$list"' + ;; + *) + if test yes = "$GXX"; then + if test no = "$with_gnu_ld"; then + case $host_cpu in + hppa*64*) + archive_cmds_CXX='$CC -shared -nostdlib -fPIC $wl+h $wl$soname -o $lib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags' + ;; + ia64*) + archive_cmds_CXX='$CC -shared -nostdlib $pic_flag $wl+h $wl$soname $wl+nodefaultrpath -o $lib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags' + ;; + *) + archive_cmds_CXX='$CC -shared -nostdlib $pic_flag $wl+h $wl$soname $wl+b $wl$install_libdir -o $lib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags' + ;; + esac + fi + else + # FIXME: insert proper C++ library support + ld_shlibs_CXX=no + fi + ;; + esac + ;; + + interix[3-9]*) + hardcode_direct_CXX=no + hardcode_shlibpath_var_CXX=no + hardcode_libdir_flag_spec_CXX='$wl-rpath,$libdir' + export_dynamic_flag_spec_CXX='$wl-E' + # Hack: On Interix 3.x, we cannot compile PIC because of a broken gcc. + # Instead, shared libraries are loaded at an image base (0x10000000 by + # default) and relocated if they conflict, which is a slow very memory + # consuming and fragmenting process. To avoid this, we pick a random, + # 256 KiB-aligned image base between 0x50000000 and 0x6FFC0000 at link + # time. Moving up from 0x10000000 also allows more sbrk(2) space. + archive_cmds_CXX='$CC -shared $pic_flag $libobjs $deplibs $compiler_flags $wl-h,$soname $wl--image-base,`expr ${RANDOM-$$} % 4096 / 2 \* 262144 + 1342177280` -o $lib' + archive_expsym_cmds_CXX='sed "s|^|_|" $export_symbols >$output_objdir/$soname.expsym~$CC -shared $pic_flag $libobjs $deplibs $compiler_flags $wl-h,$soname $wl--retain-symbols-file,$output_objdir/$soname.expsym $wl--image-base,`expr ${RANDOM-$$} % 4096 / 2 \* 262144 + 1342177280` -o $lib' + ;; + irix5* | irix6*) + case $cc_basename in + CC*) + # SGI C++ + archive_cmds_CXX='$CC -shared -all -multigot $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags -soname $soname `test -n "$verstring" && func_echo_all "-set_version $verstring"` -update_registry $output_objdir/so_locations -o $lib' + + # Archives containing C++ object files must be created using + # "CC -ar", where "CC" is the IRIX C++ compiler. This is + # necessary to make sure instantiated templates are included + # in the archive. + old_archive_cmds_CXX='$CC -ar -WR,-u -o $oldlib $oldobjs' + ;; + *) + if test yes = "$GXX"; then + if test no = "$with_gnu_ld"; then + archive_cmds_CXX='$CC -shared $pic_flag -nostdlib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags $wl-soname $wl$soname `test -n "$verstring" && func_echo_all "$wl-set_version $wl$verstring"` $wl-update_registry $wl$output_objdir/so_locations -o $lib' + else + archive_cmds_CXX='$CC -shared $pic_flag -nostdlib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags $wl-soname $wl$soname `test -n "$verstring" && func_echo_all "$wl-set_version $wl$verstring"` -o $lib' + fi + fi + link_all_deplibs_CXX=yes + ;; + esac + hardcode_libdir_flag_spec_CXX='$wl-rpath $wl$libdir' + hardcode_libdir_separator_CXX=: + inherit_rpath_CXX=yes + ;; + + linux* | k*bsd*-gnu | kopensolaris*-gnu | gnu*) + case $cc_basename in + KCC*) + # Kuck and Associates, Inc. (KAI) C++ Compiler + + # KCC will only create a shared library if the output file + # ends with ".so" (or ".sl" for HP-UX), so rename the library + # to its proper name (with version) after linking. + archive_cmds_CXX='tempext=`echo $shared_ext | $SED -e '\''s/\([^()0-9A-Za-z{}]\)/\\\\\1/g'\''`; templib=`echo $lib | $SED -e "s/\$tempext\..*/.so/"`; $CC $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags --soname $soname -o \$templib; mv \$templib $lib' + archive_expsym_cmds_CXX='tempext=`echo $shared_ext | $SED -e '\''s/\([^()0-9A-Za-z{}]\)/\\\\\1/g'\''`; templib=`echo $lib | $SED -e "s/\$tempext\..*/.so/"`; $CC $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags --soname $soname -o \$templib $wl-retain-symbols-file,$export_symbols; mv \$templib $lib' + # Commands to make compiler produce verbose output that lists + # what "hidden" libraries, object files and flags are used when + # linking a shared library. + # + # There doesn't appear to be a way to prevent this compiler from + # explicitly linking system object files so we need to strip them + # from the output so that they don't get included in the library + # dependencies. + output_verbose_link_cmd='templist=`$CC $CFLAGS -v conftest.$objext -o libconftest$shared_ext 2>&1 | $GREP "ld"`; rm -f libconftest$shared_ext; list= ; for z in $templist; do case $z in conftest.$objext) list="$list $z";; *.$objext);; *) list="$list $z";;esac; done; func_echo_all "$list"' + + hardcode_libdir_flag_spec_CXX='$wl-rpath,$libdir' + export_dynamic_flag_spec_CXX='$wl--export-dynamic' + + # Archives containing C++ object files must be created using + # "CC -Bstatic", where "CC" is the KAI C++ compiler. + old_archive_cmds_CXX='$CC -Bstatic -o $oldlib $oldobjs' + ;; + icpc* | ecpc* ) + # Intel C++ + with_gnu_ld=yes + # version 8.0 and above of icpc choke on multiply defined symbols + # if we add $predep_objects and $postdep_objects, however 7.1 and + # earlier do not add the objects themselves. + case `$CC -V 2>&1` in + *"Version 7."*) + archive_cmds_CXX='$CC -shared $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags $wl-soname $wl$soname -o $lib' + archive_expsym_cmds_CXX='$CC -shared $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags $wl-soname $wl$soname $wl-retain-symbols-file $wl$export_symbols -o $lib' + ;; + *) # Version 8.0 or newer + tmp_idyn= + case $host_cpu in + ia64*) tmp_idyn=' -i_dynamic';; + esac + archive_cmds_CXX='$CC -shared'"$tmp_idyn"' $libobjs $deplibs $compiler_flags $wl-soname $wl$soname -o $lib' + archive_expsym_cmds_CXX='$CC -shared'"$tmp_idyn"' $libobjs $deplibs $compiler_flags $wl-soname $wl$soname $wl-retain-symbols-file $wl$export_symbols -o $lib' + ;; + esac + archive_cmds_need_lc_CXX=no + hardcode_libdir_flag_spec_CXX='$wl-rpath,$libdir' + export_dynamic_flag_spec_CXX='$wl--export-dynamic' + whole_archive_flag_spec_CXX='$wl--whole-archive$convenience $wl--no-whole-archive' + ;; + pgCC* | pgcpp*) + # Portland Group C++ compiler + case `$CC -V` in + *pgCC\ [1-5].* | *pgcpp\ [1-5].*) + prelink_cmds_CXX='tpldir=Template.dir~ + rm -rf $tpldir~ + $CC --prelink_objects --instantiation_dir $tpldir $objs $libobjs $compile_deplibs~ + compile_command="$compile_command `find $tpldir -name \*.o | sort | $NL2SP`"' + old_archive_cmds_CXX='tpldir=Template.dir~ + rm -rf $tpldir~ + $CC --prelink_objects --instantiation_dir $tpldir $oldobjs$old_deplibs~ + $AR $AR_FLAGS $oldlib$oldobjs$old_deplibs `find $tpldir -name \*.o | sort | $NL2SP`~ + $RANLIB $oldlib' + archive_cmds_CXX='tpldir=Template.dir~ + rm -rf $tpldir~ + $CC --prelink_objects --instantiation_dir $tpldir $predep_objects $libobjs $deplibs $convenience $postdep_objects~ + $CC -shared $pic_flag $predep_objects $libobjs $deplibs `find $tpldir -name \*.o | sort | $NL2SP` $postdep_objects $compiler_flags $wl-soname $wl$soname -o $lib' + archive_expsym_cmds_CXX='tpldir=Template.dir~ + rm -rf $tpldir~ + $CC --prelink_objects --instantiation_dir $tpldir $predep_objects $libobjs $deplibs $convenience $postdep_objects~ + $CC -shared $pic_flag $predep_objects $libobjs $deplibs `find $tpldir -name \*.o | sort | $NL2SP` $postdep_objects $compiler_flags $wl-soname $wl$soname $wl-retain-symbols-file $wl$export_symbols -o $lib' + ;; + *) # Version 6 and above use weak symbols + archive_cmds_CXX='$CC -shared $pic_flag $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags $wl-soname $wl$soname -o $lib' + archive_expsym_cmds_CXX='$CC -shared $pic_flag $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags $wl-soname $wl$soname $wl-retain-symbols-file $wl$export_symbols -o $lib' + ;; + esac + + hardcode_libdir_flag_spec_CXX='$wl--rpath $wl$libdir' + export_dynamic_flag_spec_CXX='$wl--export-dynamic' + whole_archive_flag_spec_CXX='$wl--whole-archive`for conv in $convenience\"\"; do test -n \"$conv\" && new_convenience=\"$new_convenience,$conv\"; done; func_echo_all \"$new_convenience\"` $wl--no-whole-archive' + ;; + cxx*) + # Compaq C++ + archive_cmds_CXX='$CC -shared $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags $wl-soname $wl$soname -o $lib' + archive_expsym_cmds_CXX='$CC -shared $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags $wl-soname $wl$soname -o $lib $wl-retain-symbols-file $wl$export_symbols' + + runpath_var=LD_RUN_PATH + hardcode_libdir_flag_spec_CXX='-rpath $libdir' + hardcode_libdir_separator_CXX=: + + # Commands to make compiler produce verbose output that lists + # what "hidden" libraries, object files and flags are used when + # linking a shared library. + # + # There doesn't appear to be a way to prevent this compiler from + # explicitly linking system object files so we need to strip them + # from the output so that they don't get included in the library + # dependencies. + output_verbose_link_cmd='templist=`$CC -shared $CFLAGS -v conftest.$objext 2>&1 | $GREP "ld"`; templist=`func_echo_all "$templist" | $SED "s/\(^.*ld.*\)\( .*ld .*$\)/\1/"`; list= ; for z in $templist; do case $z in conftest.$objext) list="$list $z";; *.$objext);; *) list="$list $z";;esac; done; func_echo_all "X$list" | $Xsed' + ;; + xl* | mpixl* | bgxl*) + # IBM XL 8.0 on PPC, with GNU ld + hardcode_libdir_flag_spec_CXX='$wl-rpath $wl$libdir' + export_dynamic_flag_spec_CXX='$wl--export-dynamic' + archive_cmds_CXX='$CC -qmkshrobj $libobjs $deplibs $compiler_flags $wl-soname $wl$soname -o $lib' + if test yes = "$supports_anon_versioning"; then + archive_expsym_cmds_CXX='echo "{ global:" > $output_objdir/$libname.ver~ + cat $export_symbols | sed -e "s/\(.*\)/\1;/" >> $output_objdir/$libname.ver~ + echo "local: *; };" >> $output_objdir/$libname.ver~ + $CC -qmkshrobj $libobjs $deplibs $compiler_flags $wl-soname $wl$soname $wl-version-script $wl$output_objdir/$libname.ver -o $lib' + fi + ;; + *) + case `$CC -V 2>&1 | sed 5q` in + *Sun\ C*) + # Sun C++ 5.9 + no_undefined_flag_CXX=' -zdefs' + archive_cmds_CXX='$CC -G$allow_undefined_flag -h$soname -o $lib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags' + archive_expsym_cmds_CXX='$CC -G$allow_undefined_flag -h$soname -o $lib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags $wl-retain-symbols-file $wl$export_symbols' + hardcode_libdir_flag_spec_CXX='-R$libdir' + whole_archive_flag_spec_CXX='$wl--whole-archive`new_convenience=; for conv in $convenience\"\"; do test -z \"$conv\" || new_convenience=\"$new_convenience,$conv\"; done; func_echo_all \"$new_convenience\"` $wl--no-whole-archive' + compiler_needs_object_CXX=yes + + # Not sure whether something based on + # $CC $CFLAGS -v conftest.$objext -o libconftest$shared_ext 2>&1 + # would be better. + output_verbose_link_cmd='func_echo_all' + + # Archives containing C++ object files must be created using + # "CC -xar", where "CC" is the Sun C++ compiler. This is + # necessary to make sure instantiated templates are included + # in the archive. + old_archive_cmds_CXX='$CC -xar -o $oldlib $oldobjs' + ;; + esac + ;; + esac + ;; + + lynxos*) + # FIXME: insert proper C++ library support + ld_shlibs_CXX=no + ;; + + m88k*) + # FIXME: insert proper C++ library support + ld_shlibs_CXX=no + ;; + + mvs*) + case $cc_basename in + cxx*) + # FIXME: insert proper C++ library support + ld_shlibs_CXX=no + ;; + *) + # FIXME: insert proper C++ library support + ld_shlibs_CXX=no + ;; + esac + ;; + + netbsd*) + if echo __ELF__ | $CC -E - | $GREP __ELF__ >/dev/null; then + archive_cmds_CXX='$LD -Bshareable -o $lib $predep_objects $libobjs $deplibs $postdep_objects $linker_flags' + wlarc= + hardcode_libdir_flag_spec_CXX='-R$libdir' + hardcode_direct_CXX=yes + hardcode_shlibpath_var_CXX=no + fi + # Workaround some broken pre-1.5 toolchains + output_verbose_link_cmd='$CC -shared $CFLAGS -v conftest.$objext 2>&1 | $GREP conftest.$objext | $SED -e "s:-lgcc -lc -lgcc::"' + ;; + + *nto* | *qnx*) + ld_shlibs_CXX=yes + ;; + + openbsd* | bitrig*) + if test -f /usr/libexec/ld.so; then + hardcode_direct_CXX=yes + hardcode_shlibpath_var_CXX=no + hardcode_direct_absolute_CXX=yes + archive_cmds_CXX='$CC -shared $pic_flag $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags -o $lib' + hardcode_libdir_flag_spec_CXX='$wl-rpath,$libdir' + if test -z "`echo __ELF__ | $CC -E - | grep __ELF__`"; then + archive_expsym_cmds_CXX='$CC -shared $pic_flag $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags $wl-retain-symbols-file,$export_symbols -o $lib' + export_dynamic_flag_spec_CXX='$wl-E' + whole_archive_flag_spec_CXX=$wlarc'--whole-archive$convenience '$wlarc'--no-whole-archive' + fi + output_verbose_link_cmd=func_echo_all + else + ld_shlibs_CXX=no + fi + ;; + + osf3* | osf4* | osf5*) + case $cc_basename in + KCC*) + # Kuck and Associates, Inc. (KAI) C++ Compiler + + # KCC will only create a shared library if the output file + # ends with ".so" (or ".sl" for HP-UX), so rename the library + # to its proper name (with version) after linking. + archive_cmds_CXX='tempext=`echo $shared_ext | $SED -e '\''s/\([^()0-9A-Za-z{}]\)/\\\\\1/g'\''`; templib=`echo "$lib" | $SED -e "s/\$tempext\..*/.so/"`; $CC $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags --soname $soname -o \$templib; mv \$templib $lib' + + hardcode_libdir_flag_spec_CXX='$wl-rpath,$libdir' + hardcode_libdir_separator_CXX=: + + # Archives containing C++ object files must be created using + # the KAI C++ compiler. + case $host in + osf3*) old_archive_cmds_CXX='$CC -Bstatic -o $oldlib $oldobjs' ;; + *) old_archive_cmds_CXX='$CC -o $oldlib $oldobjs' ;; + esac + ;; + RCC*) + # Rational C++ 2.4.1 + # FIXME: insert proper C++ library support + ld_shlibs_CXX=no + ;; + cxx*) + case $host in + osf3*) + allow_undefined_flag_CXX=' $wl-expect_unresolved $wl\*' + archive_cmds_CXX='$CC -shared$allow_undefined_flag $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags $wl-soname $soname `test -n "$verstring" && func_echo_all "$wl-set_version $verstring"` -update_registry $output_objdir/so_locations -o $lib' + hardcode_libdir_flag_spec_CXX='$wl-rpath $wl$libdir' + ;; + *) + allow_undefined_flag_CXX=' -expect_unresolved \*' + archive_cmds_CXX='$CC -shared$allow_undefined_flag $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags -msym -soname $soname `test -n "$verstring" && func_echo_all "-set_version $verstring"` -update_registry $output_objdir/so_locations -o $lib' + archive_expsym_cmds_CXX='for i in `cat $export_symbols`; do printf "%s %s\\n" -exported_symbol "\$i" >> $lib.exp; done~ + echo "-hidden">> $lib.exp~ + $CC -shared$allow_undefined_flag $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags -msym -soname $soname $wl-input $wl$lib.exp `test -n "$verstring" && $ECHO "-set_version $verstring"` -update_registry $output_objdir/so_locations -o $lib~ + $RM $lib.exp' + hardcode_libdir_flag_spec_CXX='-rpath $libdir' + ;; + esac + + hardcode_libdir_separator_CXX=: + + # Commands to make compiler produce verbose output that lists + # what "hidden" libraries, object files and flags are used when + # linking a shared library. + # + # There doesn't appear to be a way to prevent this compiler from + # explicitly linking system object files so we need to strip them + # from the output so that they don't get included in the library + # dependencies. + output_verbose_link_cmd='templist=`$CC -shared $CFLAGS -v conftest.$objext 2>&1 | $GREP "ld" | $GREP -v "ld:"`; templist=`func_echo_all "$templist" | $SED "s/\(^.*ld.*\)\( .*ld.*$\)/\1/"`; list= ; for z in $templist; do case $z in conftest.$objext) list="$list $z";; *.$objext);; *) list="$list $z";;esac; done; func_echo_all "$list"' + ;; + *) + if test yes,no = "$GXX,$with_gnu_ld"; then + allow_undefined_flag_CXX=' $wl-expect_unresolved $wl\*' + case $host in + osf3*) + archive_cmds_CXX='$CC -shared -nostdlib $allow_undefined_flag $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags $wl-soname $wl$soname `test -n "$verstring" && func_echo_all "$wl-set_version $wl$verstring"` $wl-update_registry $wl$output_objdir/so_locations -o $lib' + ;; + *) + archive_cmds_CXX='$CC -shared $pic_flag -nostdlib $allow_undefined_flag $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags $wl-msym $wl-soname $wl$soname `test -n "$verstring" && func_echo_all "$wl-set_version $wl$verstring"` $wl-update_registry $wl$output_objdir/so_locations -o $lib' + ;; + esac + + hardcode_libdir_flag_spec_CXX='$wl-rpath $wl$libdir' + hardcode_libdir_separator_CXX=: + + # Commands to make compiler produce verbose output that lists + # what "hidden" libraries, object files and flags are used when + # linking a shared library. + output_verbose_link_cmd='$CC -shared $CFLAGS -v conftest.$objext 2>&1 | $GREP -v "^Configured with:" | $GREP "\-L"' + + else + # FIXME: insert proper C++ library support + ld_shlibs_CXX=no + fi + ;; + esac + ;; + + psos*) + # FIXME: insert proper C++ library support + ld_shlibs_CXX=no + ;; + + sunos4*) + case $cc_basename in + CC*) + # Sun C++ 4.x + # FIXME: insert proper C++ library support + ld_shlibs_CXX=no + ;; + lcc*) + # Lucid + # FIXME: insert proper C++ library support + ld_shlibs_CXX=no + ;; + *) + # FIXME: insert proper C++ library support + ld_shlibs_CXX=no + ;; + esac + ;; + + solaris*) + case $cc_basename in + CC* | sunCC*) + # Sun C++ 4.2, 5.x and Centerline C++ + archive_cmds_need_lc_CXX=yes + no_undefined_flag_CXX=' -zdefs' + archive_cmds_CXX='$CC -G$allow_undefined_flag -h$soname -o $lib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags' + archive_expsym_cmds_CXX='echo "{ global:" > $lib.exp~cat $export_symbols | $SED -e "s/\(.*\)/\1;/" >> $lib.exp~echo "local: *; };" >> $lib.exp~ + $CC -G$allow_undefined_flag $wl-M $wl$lib.exp -h$soname -o $lib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags~$RM $lib.exp' + + hardcode_libdir_flag_spec_CXX='-R$libdir' + hardcode_shlibpath_var_CXX=no + case $host_os in + solaris2.[0-5] | solaris2.[0-5].*) ;; + *) + # The compiler driver will combine and reorder linker options, + # but understands '-z linker_flag'. + # Supported since Solaris 2.6 (maybe 2.5.1?) + whole_archive_flag_spec_CXX='-z allextract$convenience -z defaultextract' + ;; + esac + link_all_deplibs_CXX=yes + + output_verbose_link_cmd='func_echo_all' + + # Archives containing C++ object files must be created using + # "CC -xar", where "CC" is the Sun C++ compiler. This is + # necessary to make sure instantiated templates are included + # in the archive. + old_archive_cmds_CXX='$CC -xar -o $oldlib $oldobjs' + ;; + gcx*) + # Green Hills C++ Compiler + archive_cmds_CXX='$CC -shared $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags $wl-h $wl$soname -o $lib' + + # The C++ compiler must be used to create the archive. + old_archive_cmds_CXX='$CC $LDFLAGS -archive -o $oldlib $oldobjs' + ;; + *) + # GNU C++ compiler with Solaris linker + if test yes,no = "$GXX,$with_gnu_ld"; then + no_undefined_flag_CXX=' $wl-z ${wl}defs' + if $CC --version | $GREP -v '^2\.7' > /dev/null; then + archive_cmds_CXX='$CC -shared $pic_flag -nostdlib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags $wl-h $wl$soname -o $lib' + archive_expsym_cmds_CXX='echo "{ global:" > $lib.exp~cat $export_symbols | $SED -e "s/\(.*\)/\1;/" >> $lib.exp~echo "local: *; };" >> $lib.exp~ + $CC -shared $pic_flag -nostdlib $wl-M $wl$lib.exp $wl-h $wl$soname -o $lib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags~$RM $lib.exp' + + # Commands to make compiler produce verbose output that lists + # what "hidden" libraries, object files and flags are used when + # linking a shared library. + output_verbose_link_cmd='$CC -shared $CFLAGS -v conftest.$objext 2>&1 | $GREP -v "^Configured with:" | $GREP "\-L"' + else + # g++ 2.7 appears to require '-G' NOT '-shared' on this + # platform. + archive_cmds_CXX='$CC -G -nostdlib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags $wl-h $wl$soname -o $lib' + archive_expsym_cmds_CXX='echo "{ global:" > $lib.exp~cat $export_symbols | $SED -e "s/\(.*\)/\1;/" >> $lib.exp~echo "local: *; };" >> $lib.exp~ + $CC -G -nostdlib $wl-M $wl$lib.exp $wl-h $wl$soname -o $lib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags~$RM $lib.exp' + + # Commands to make compiler produce verbose output that lists + # what "hidden" libraries, object files and flags are used when + # linking a shared library. + output_verbose_link_cmd='$CC -G $CFLAGS -v conftest.$objext 2>&1 | $GREP -v "^Configured with:" | $GREP "\-L"' + fi + + hardcode_libdir_flag_spec_CXX='$wl-R $wl$libdir' + case $host_os in + solaris2.[0-5] | solaris2.[0-5].*) ;; + *) + whole_archive_flag_spec_CXX='$wl-z ${wl}allextract$convenience $wl-z ${wl}defaultextract' + ;; + esac + fi + ;; + esac + ;; + + sysv4*uw2* | sysv5OpenUNIX* | sysv5UnixWare7.[01].[10]* | unixware7* | sco3.2v5.0.[024]*) + no_undefined_flag_CXX='$wl-z,text' + archive_cmds_need_lc_CXX=no + hardcode_shlibpath_var_CXX=no + runpath_var='LD_RUN_PATH' + + case $cc_basename in + CC*) + archive_cmds_CXX='$CC -G $wl-h,$soname -o $lib $libobjs $deplibs $compiler_flags' + archive_expsym_cmds_CXX='$CC -G $wl-Bexport:$export_symbols $wl-h,$soname -o $lib $libobjs $deplibs $compiler_flags' + ;; + *) + archive_cmds_CXX='$CC -shared $wl-h,$soname -o $lib $libobjs $deplibs $compiler_flags' + archive_expsym_cmds_CXX='$CC -shared $wl-Bexport:$export_symbols $wl-h,$soname -o $lib $libobjs $deplibs $compiler_flags' + ;; + esac + ;; + + sysv5* | sco3.2v5* | sco5v6*) + # Note: We CANNOT use -z defs as we might desire, because we do not + # link with -lc, and that would cause any symbols used from libc to + # always be unresolved, which means just about no library would + # ever link correctly. If we're not using GNU ld we use -z text + # though, which does catch some bad symbols but isn't as heavy-handed + # as -z defs. + no_undefined_flag_CXX='$wl-z,text' + allow_undefined_flag_CXX='$wl-z,nodefs' + archive_cmds_need_lc_CXX=no + hardcode_shlibpath_var_CXX=no + hardcode_libdir_flag_spec_CXX='$wl-R,$libdir' + hardcode_libdir_separator_CXX=':' + link_all_deplibs_CXX=yes + export_dynamic_flag_spec_CXX='$wl-Bexport' + runpath_var='LD_RUN_PATH' + + case $cc_basename in + CC*) + archive_cmds_CXX='$CC -G $wl-h,$soname -o $lib $libobjs $deplibs $compiler_flags' + archive_expsym_cmds_CXX='$CC -G $wl-Bexport:$export_symbols $wl-h,$soname -o $lib $libobjs $deplibs $compiler_flags' + old_archive_cmds_CXX='$CC -Tprelink_objects $oldobjs~ + '"$old_archive_cmds_CXX" + reload_cmds_CXX='$CC -Tprelink_objects $reload_objs~ + '"$reload_cmds_CXX" + ;; + *) + archive_cmds_CXX='$CC -shared $wl-h,$soname -o $lib $libobjs $deplibs $compiler_flags' + archive_expsym_cmds_CXX='$CC -shared $wl-Bexport:$export_symbols $wl-h,$soname -o $lib $libobjs $deplibs $compiler_flags' + ;; + esac + ;; + + tandem*) + case $cc_basename in + NCC*) + # NonStop-UX NCC 3.20 + # FIXME: insert proper C++ library support + ld_shlibs_CXX=no + ;; + *) + # FIXME: insert proper C++ library support + ld_shlibs_CXX=no + ;; + esac + ;; + + vxworks*) + # FIXME: insert proper C++ library support + ld_shlibs_CXX=no + ;; + + *) + # FIXME: insert proper C++ library support + ld_shlibs_CXX=no + ;; + esac + + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ld_shlibs_CXX" >&5 +$as_echo "$ld_shlibs_CXX" >&6; } + test no = "$ld_shlibs_CXX" && can_build_shared=no + + GCC_CXX=$GXX + LD_CXX=$LD + + ## CAVEAT EMPTOR: + ## There is no encapsulation within the following macros, do not change + ## the running order or otherwise move them around unless you know exactly + ## what you are doing... + # Dependencies to place before and after the object being linked: +predep_objects_CXX= +postdep_objects_CXX= +predeps_CXX= +postdeps_CXX= +compiler_lib_search_path_CXX= + +cat > conftest.$ac_ext <<_LT_EOF +class Foo +{ +public: + Foo (void) { a = 0; } +private: + int a; +}; +_LT_EOF + + +_lt_libdeps_save_CFLAGS=$CFLAGS +case "$CC $CFLAGS " in #( +*\ -flto*\ *) CFLAGS="$CFLAGS -fno-lto" ;; +*\ -fwhopr*\ *) CFLAGS="$CFLAGS -fno-whopr" ;; +*\ -fuse-linker-plugin*\ *) CFLAGS="$CFLAGS -fno-use-linker-plugin" ;; +esac + +if { { eval echo "\"\$as_me\":${as_lineno-$LINENO}: \"$ac_compile\""; } >&5 + (eval $ac_compile) 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; }; then + # Parse the compiler output and extract the necessary + # objects, libraries and library flags. + + # Sentinel used to keep track of whether or not we are before + # the conftest object file. + pre_test_object_deps_done=no + + for p in `eval "$output_verbose_link_cmd"`; do + case $prev$p in + + -L* | -R* | -l*) + # Some compilers place space between "-{L,R}" and the path. + # Remove the space. + if test x-L = "$p" || + test x-R = "$p"; then + prev=$p + continue + fi + + # Expand the sysroot to ease extracting the directories later. + if test -z "$prev"; then + case $p in + -L*) func_stripname_cnf '-L' '' "$p"; prev=-L; p=$func_stripname_result ;; + -R*) func_stripname_cnf '-R' '' "$p"; prev=-R; p=$func_stripname_result ;; + -l*) func_stripname_cnf '-l' '' "$p"; prev=-l; p=$func_stripname_result ;; + esac + fi + case $p in + =*) func_stripname_cnf '=' '' "$p"; p=$lt_sysroot$func_stripname_result ;; + esac + if test no = "$pre_test_object_deps_done"; then + case $prev in + -L | -R) + # Internal compiler library paths should come after those + # provided the user. The postdeps already come after the + # user supplied libs so there is no need to process them. + if test -z "$compiler_lib_search_path_CXX"; then + compiler_lib_search_path_CXX=$prev$p + else + compiler_lib_search_path_CXX="${compiler_lib_search_path_CXX} $prev$p" + fi + ;; + # The "-l" case would never come before the object being + # linked, so don't bother handling this case. + esac + else + if test -z "$postdeps_CXX"; then + postdeps_CXX=$prev$p + else + postdeps_CXX="${postdeps_CXX} $prev$p" + fi + fi + prev= + ;; + + *.lto.$objext) ;; # Ignore GCC LTO objects + *.$objext) + # This assumes that the test object file only shows up + # once in the compiler output. + if test "$p" = "conftest.$objext"; then + pre_test_object_deps_done=yes + continue + fi + + if test no = "$pre_test_object_deps_done"; then + if test -z "$predep_objects_CXX"; then + predep_objects_CXX=$p + else + predep_objects_CXX="$predep_objects_CXX $p" + fi + else + if test -z "$postdep_objects_CXX"; then + postdep_objects_CXX=$p + else + postdep_objects_CXX="$postdep_objects_CXX $p" + fi + fi + ;; + + *) ;; # Ignore the rest. + + esac + done + + # Clean up. + rm -f a.out a.exe +else + echo "libtool.m4: error: problem compiling CXX test program" +fi + +$RM -f confest.$objext +CFLAGS=$_lt_libdeps_save_CFLAGS + +# PORTME: override above test on systems where it is broken +case $host_os in +interix[3-9]*) + # Interix 3.5 installs completely hosed .la files for C++, so rather than + # hack all around it, let's just trust "g++" to DTRT. + predep_objects_CXX= + postdep_objects_CXX= + postdeps_CXX= + ;; +esac + + +case " $postdeps_CXX " in +*" -lc "*) archive_cmds_need_lc_CXX=no ;; +esac + compiler_lib_search_dirs_CXX= +if test -n "${compiler_lib_search_path_CXX}"; then + compiler_lib_search_dirs_CXX=`echo " ${compiler_lib_search_path_CXX}" | $SED -e 's! -L! !g' -e 's!^ !!'` +fi + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + lt_prog_compiler_wl_CXX= +lt_prog_compiler_pic_CXX= +lt_prog_compiler_static_CXX= + + + # C++ specific cases for pic, static, wl, etc. + if test yes = "$GXX"; then + lt_prog_compiler_wl_CXX='-Wl,' + lt_prog_compiler_static_CXX='-static' + + case $host_os in + aix*) + # All AIX code is PIC. + if test ia64 = "$host_cpu"; then + # AIX 5 now supports IA64 processor + lt_prog_compiler_static_CXX='-Bstatic' + fi + lt_prog_compiler_pic_CXX='-fPIC' + ;; + + amigaos*) + case $host_cpu in + powerpc) + # see comment about AmigaOS4 .so support + lt_prog_compiler_pic_CXX='-fPIC' + ;; + m68k) + # FIXME: we need at least 68020 code to build shared libraries, but + # adding the '-m68020' flag to GCC prevents building anything better, + # like '-m68040'. + lt_prog_compiler_pic_CXX='-m68020 -resident32 -malways-restore-a4' + ;; + esac + ;; + + beos* | irix5* | irix6* | nonstopux* | osf3* | osf4* | osf5*) + # PIC is the default for these OSes. + ;; + mingw* | cygwin* | os2* | pw32* | cegcc*) + # This hack is so that the source file can tell whether it is being + # built for inclusion in a dll (and should export symbols for example). + # Although the cygwin gcc ignores -fPIC, still need this for old-style + # (--disable-auto-import) libraries + lt_prog_compiler_pic_CXX='-DDLL_EXPORT' + case $host_os in + os2*) + lt_prog_compiler_static_CXX='$wl-static' + ;; + esac + ;; + darwin* | rhapsody*) + # PIC is the default on this platform + # Common symbols not allowed in MH_DYLIB files + lt_prog_compiler_pic_CXX='-fno-common' + ;; + *djgpp*) + # DJGPP does not support shared libraries at all + lt_prog_compiler_pic_CXX= + ;; + haiku*) + # PIC is the default for Haiku. + # The "-static" flag exists, but is broken. + lt_prog_compiler_static_CXX= + ;; + interix[3-9]*) + # Interix 3.x gcc -fpic/-fPIC options generate broken code. + # Instead, we relocate shared libraries at runtime. + ;; + sysv4*MP*) + if test -d /usr/nec; then + lt_prog_compiler_pic_CXX=-Kconform_pic + fi + ;; + hpux*) + # PIC is the default for 64-bit PA HP-UX, but not for 32-bit + # PA HP-UX. On IA64 HP-UX, PIC is the default but the pic flag + # sets the default TLS model and affects inlining. + case $host_cpu in + hppa*64*) + ;; + *) + lt_prog_compiler_pic_CXX='-fPIC' + ;; + esac + ;; + *qnx* | *nto*) + # QNX uses GNU C++, but need to define -shared option too, otherwise + # it will coredump. + lt_prog_compiler_pic_CXX='-fPIC -shared' + ;; + *) + lt_prog_compiler_pic_CXX='-fPIC' + ;; + esac + else + case $host_os in + aix[4-9]*) + # All AIX code is PIC. + if test ia64 = "$host_cpu"; then + # AIX 5 now supports IA64 processor + lt_prog_compiler_static_CXX='-Bstatic' + else + lt_prog_compiler_static_CXX='-bnso -bI:/lib/syscalls.exp' + fi + ;; + chorus*) + case $cc_basename in + cxch68*) + # Green Hills C++ Compiler + # _LT_TAGVAR(lt_prog_compiler_static, CXX)="--no_auto_instantiation -u __main -u __premain -u _abort -r $COOL_DIR/lib/libOrb.a $MVME_DIR/lib/CC/libC.a $MVME_DIR/lib/classix/libcx.s.a" + ;; + esac + ;; + mingw* | cygwin* | os2* | pw32* | cegcc*) + # This hack is so that the source file can tell whether it is being + # built for inclusion in a dll (and should export symbols for example). + lt_prog_compiler_pic_CXX='-DDLL_EXPORT' + ;; + dgux*) + case $cc_basename in + ec++*) + lt_prog_compiler_pic_CXX='-KPIC' + ;; + ghcx*) + # Green Hills C++ Compiler + lt_prog_compiler_pic_CXX='-pic' + ;; + *) + ;; + esac + ;; + freebsd* | dragonfly*) + # FreeBSD uses GNU C++ + ;; + hpux9* | hpux10* | hpux11*) + case $cc_basename in + CC*) + lt_prog_compiler_wl_CXX='-Wl,' + lt_prog_compiler_static_CXX='$wl-a ${wl}archive' + if test ia64 != "$host_cpu"; then + lt_prog_compiler_pic_CXX='+Z' + fi + ;; + aCC*) + lt_prog_compiler_wl_CXX='-Wl,' + lt_prog_compiler_static_CXX='$wl-a ${wl}archive' + case $host_cpu in + hppa*64*|ia64*) + # +Z the default + ;; + *) + lt_prog_compiler_pic_CXX='+Z' + ;; + esac + ;; + *) + ;; + esac + ;; + interix*) + # This is c89, which is MS Visual C++ (no shared libs) + # Anyone wants to do a port? + ;; + irix5* | irix6* | nonstopux*) + case $cc_basename in + CC*) + lt_prog_compiler_wl_CXX='-Wl,' + lt_prog_compiler_static_CXX='-non_shared' + # CC pic flag -KPIC is the default. + ;; + *) + ;; + esac + ;; + linux* | k*bsd*-gnu | kopensolaris*-gnu | gnu*) + case $cc_basename in + KCC*) + # KAI C++ Compiler + lt_prog_compiler_wl_CXX='--backend -Wl,' + lt_prog_compiler_pic_CXX='-fPIC' + ;; + ecpc* ) + # old Intel C++ for x86_64, which still supported -KPIC. + lt_prog_compiler_wl_CXX='-Wl,' + lt_prog_compiler_pic_CXX='-KPIC' + lt_prog_compiler_static_CXX='-static' + ;; + icpc* ) + # Intel C++, used to be incompatible with GCC. + # ICC 10 doesn't accept -KPIC any more. + lt_prog_compiler_wl_CXX='-Wl,' + lt_prog_compiler_pic_CXX='-fPIC' + lt_prog_compiler_static_CXX='-static' + ;; + pgCC* | pgcpp*) + # Portland Group C++ compiler + lt_prog_compiler_wl_CXX='-Wl,' + lt_prog_compiler_pic_CXX='-fpic' + lt_prog_compiler_static_CXX='-Bstatic' + ;; + cxx*) + # Compaq C++ + # Make sure the PIC flag is empty. It appears that all Alpha + # Linux and Compaq Tru64 Unix objects are PIC. + lt_prog_compiler_pic_CXX= + lt_prog_compiler_static_CXX='-non_shared' + ;; + xlc* | xlC* | bgxl[cC]* | mpixl[cC]*) + # IBM XL 8.0, 9.0 on PPC and BlueGene + lt_prog_compiler_wl_CXX='-Wl,' + lt_prog_compiler_pic_CXX='-qpic' + lt_prog_compiler_static_CXX='-qstaticlink' + ;; + *) + case `$CC -V 2>&1 | sed 5q` in + *Sun\ C*) + # Sun C++ 5.9 + lt_prog_compiler_pic_CXX='-KPIC' + lt_prog_compiler_static_CXX='-Bstatic' + lt_prog_compiler_wl_CXX='-Qoption ld ' + ;; + esac + ;; + esac + ;; + lynxos*) + ;; + m88k*) + ;; + mvs*) + case $cc_basename in + cxx*) + lt_prog_compiler_pic_CXX='-W c,exportall' + ;; + *) + ;; + esac + ;; + netbsd*) + ;; + *qnx* | *nto*) + # QNX uses GNU C++, but need to define -shared option too, otherwise + # it will coredump. + lt_prog_compiler_pic_CXX='-fPIC -shared' + ;; + osf3* | osf4* | osf5*) + case $cc_basename in + KCC*) + lt_prog_compiler_wl_CXX='--backend -Wl,' + ;; + RCC*) + # Rational C++ 2.4.1 + lt_prog_compiler_pic_CXX='-pic' + ;; + cxx*) + # Digital/Compaq C++ + lt_prog_compiler_wl_CXX='-Wl,' + # Make sure the PIC flag is empty. It appears that all Alpha + # Linux and Compaq Tru64 Unix objects are PIC. + lt_prog_compiler_pic_CXX= + lt_prog_compiler_static_CXX='-non_shared' + ;; + *) + ;; + esac + ;; + psos*) + ;; + solaris*) + case $cc_basename in + CC* | sunCC*) + # Sun C++ 4.2, 5.x and Centerline C++ + lt_prog_compiler_pic_CXX='-KPIC' + lt_prog_compiler_static_CXX='-Bstatic' + lt_prog_compiler_wl_CXX='-Qoption ld ' + ;; + gcx*) + # Green Hills C++ Compiler + lt_prog_compiler_pic_CXX='-PIC' + ;; + *) + ;; + esac + ;; + sunos4*) + case $cc_basename in + CC*) + # Sun C++ 4.x + lt_prog_compiler_pic_CXX='-pic' + lt_prog_compiler_static_CXX='-Bstatic' + ;; + lcc*) + # Lucid + lt_prog_compiler_pic_CXX='-pic' + ;; + *) + ;; + esac + ;; + sysv5* | unixware* | sco3.2v5* | sco5v6* | OpenUNIX*) + case $cc_basename in + CC*) + lt_prog_compiler_wl_CXX='-Wl,' + lt_prog_compiler_pic_CXX='-KPIC' + lt_prog_compiler_static_CXX='-Bstatic' + ;; + esac + ;; + tandem*) + case $cc_basename in + NCC*) + # NonStop-UX NCC 3.20 + lt_prog_compiler_pic_CXX='-KPIC' + ;; + *) + ;; + esac + ;; + vxworks*) + ;; + *) + lt_prog_compiler_can_build_shared_CXX=no + ;; + esac + fi + +case $host_os in + # For platforms that do not support PIC, -DPIC is meaningless: + *djgpp*) + lt_prog_compiler_pic_CXX= + ;; + *) + lt_prog_compiler_pic_CXX="$lt_prog_compiler_pic_CXX -DPIC" + ;; +esac + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $compiler option to produce PIC" >&5 +$as_echo_n "checking for $compiler option to produce PIC... " >&6; } +if ${lt_cv_prog_compiler_pic_CXX+:} false; then : + $as_echo_n "(cached) " >&6 +else + lt_cv_prog_compiler_pic_CXX=$lt_prog_compiler_pic_CXX +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_prog_compiler_pic_CXX" >&5 +$as_echo "$lt_cv_prog_compiler_pic_CXX" >&6; } +lt_prog_compiler_pic_CXX=$lt_cv_prog_compiler_pic_CXX + +# +# Check to make sure the PIC flag actually works. +# +if test -n "$lt_prog_compiler_pic_CXX"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking if $compiler PIC flag $lt_prog_compiler_pic_CXX works" >&5 +$as_echo_n "checking if $compiler PIC flag $lt_prog_compiler_pic_CXX works... " >&6; } +if ${lt_cv_prog_compiler_pic_works_CXX+:} false; then : + $as_echo_n "(cached) " >&6 +else + lt_cv_prog_compiler_pic_works_CXX=no + ac_outfile=conftest.$ac_objext + echo "$lt_simple_compile_test_code" > conftest.$ac_ext + lt_compiler_flag="$lt_prog_compiler_pic_CXX -DPIC" ## exclude from sc_useless_quotes_in_assignment + # Insert the option either (1) after the last *FLAGS variable, or + # (2) before a word containing "conftest.", or (3) at the end. + # Note that $ac_compile itself does not contain backslashes and begins + # with a dollar sign (not a hyphen), so the echo should work correctly. + # The option is referenced via a variable to avoid confusing sed. + lt_compile=`echo "$ac_compile" | $SED \ + -e 's:.*FLAGS}\{0,1\} :&$lt_compiler_flag :; t' \ + -e 's: [^ ]*conftest\.: $lt_compiler_flag&:; t' \ + -e 's:$: $lt_compiler_flag:'` + (eval echo "\"\$as_me:$LINENO: $lt_compile\"" >&5) + (eval "$lt_compile" 2>conftest.err) + ac_status=$? + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + if (exit $ac_status) && test -s "$ac_outfile"; then + # The compiler can only warn and ignore the option if not recognized + # So say no if there are warnings other than the usual output. + $ECHO "$_lt_compiler_boilerplate" | $SED '/^$/d' >conftest.exp + $SED '/^$/d; /^ *+/d' conftest.err >conftest.er2 + if test ! -s conftest.er2 || diff conftest.exp conftest.er2 >/dev/null; then + lt_cv_prog_compiler_pic_works_CXX=yes + fi + fi + $RM conftest* + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_prog_compiler_pic_works_CXX" >&5 +$as_echo "$lt_cv_prog_compiler_pic_works_CXX" >&6; } + +if test yes = "$lt_cv_prog_compiler_pic_works_CXX"; then + case $lt_prog_compiler_pic_CXX in + "" | " "*) ;; + *) lt_prog_compiler_pic_CXX=" $lt_prog_compiler_pic_CXX" ;; + esac +else + lt_prog_compiler_pic_CXX= + lt_prog_compiler_can_build_shared_CXX=no +fi + +fi + + + + + +# +# Check to make sure the static flag actually works. +# +wl=$lt_prog_compiler_wl_CXX eval lt_tmp_static_flag=\"$lt_prog_compiler_static_CXX\" +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking if $compiler static flag $lt_tmp_static_flag works" >&5 +$as_echo_n "checking if $compiler static flag $lt_tmp_static_flag works... " >&6; } +if ${lt_cv_prog_compiler_static_works_CXX+:} false; then : + $as_echo_n "(cached) " >&6 +else + lt_cv_prog_compiler_static_works_CXX=no + save_LDFLAGS=$LDFLAGS + LDFLAGS="$LDFLAGS $lt_tmp_static_flag" + echo "$lt_simple_link_test_code" > conftest.$ac_ext + if (eval $ac_link 2>conftest.err) && test -s conftest$ac_exeext; then + # The linker can only warn and ignore the option if not recognized + # So say no if there are warnings + if test -s conftest.err; then + # Append any errors to the config.log. + cat conftest.err 1>&5 + $ECHO "$_lt_linker_boilerplate" | $SED '/^$/d' > conftest.exp + $SED '/^$/d; /^ *+/d' conftest.err >conftest.er2 + if diff conftest.exp conftest.er2 >/dev/null; then + lt_cv_prog_compiler_static_works_CXX=yes + fi + else + lt_cv_prog_compiler_static_works_CXX=yes + fi + fi + $RM -r conftest* + LDFLAGS=$save_LDFLAGS + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_prog_compiler_static_works_CXX" >&5 +$as_echo "$lt_cv_prog_compiler_static_works_CXX" >&6; } + +if test yes = "$lt_cv_prog_compiler_static_works_CXX"; then + : +else + lt_prog_compiler_static_CXX= +fi + + + + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking if $compiler supports -c -o file.$ac_objext" >&5 +$as_echo_n "checking if $compiler supports -c -o file.$ac_objext... " >&6; } +if ${lt_cv_prog_compiler_c_o_CXX+:} false; then : + $as_echo_n "(cached) " >&6 +else + lt_cv_prog_compiler_c_o_CXX=no + $RM -r conftest 2>/dev/null + mkdir conftest + cd conftest + mkdir out + echo "$lt_simple_compile_test_code" > conftest.$ac_ext + + lt_compiler_flag="-o out/conftest2.$ac_objext" + # Insert the option either (1) after the last *FLAGS variable, or + # (2) before a word containing "conftest.", or (3) at the end. + # Note that $ac_compile itself does not contain backslashes and begins + # with a dollar sign (not a hyphen), so the echo should work correctly. + lt_compile=`echo "$ac_compile" | $SED \ + -e 's:.*FLAGS}\{0,1\} :&$lt_compiler_flag :; t' \ + -e 's: [^ ]*conftest\.: $lt_compiler_flag&:; t' \ + -e 's:$: $lt_compiler_flag:'` + (eval echo "\"\$as_me:$LINENO: $lt_compile\"" >&5) + (eval "$lt_compile" 2>out/conftest.err) + ac_status=$? + cat out/conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + if (exit $ac_status) && test -s out/conftest2.$ac_objext + then + # The compiler can only warn and ignore the option if not recognized + # So say no if there are warnings + $ECHO "$_lt_compiler_boilerplate" | $SED '/^$/d' > out/conftest.exp + $SED '/^$/d; /^ *+/d' out/conftest.err >out/conftest.er2 + if test ! -s out/conftest.er2 || diff out/conftest.exp out/conftest.er2 >/dev/null; then + lt_cv_prog_compiler_c_o_CXX=yes + fi + fi + chmod u+w . 2>&5 + $RM conftest* + # SGI C++ compiler will create directory out/ii_files/ for + # template instantiation + test -d out/ii_files && $RM out/ii_files/* && rmdir out/ii_files + $RM out/* && rmdir out + cd .. + $RM -r conftest + $RM conftest* + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_prog_compiler_c_o_CXX" >&5 +$as_echo "$lt_cv_prog_compiler_c_o_CXX" >&6; } + + + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking if $compiler supports -c -o file.$ac_objext" >&5 +$as_echo_n "checking if $compiler supports -c -o file.$ac_objext... " >&6; } +if ${lt_cv_prog_compiler_c_o_CXX+:} false; then : + $as_echo_n "(cached) " >&6 +else + lt_cv_prog_compiler_c_o_CXX=no + $RM -r conftest 2>/dev/null + mkdir conftest + cd conftest + mkdir out + echo "$lt_simple_compile_test_code" > conftest.$ac_ext + + lt_compiler_flag="-o out/conftest2.$ac_objext" + # Insert the option either (1) after the last *FLAGS variable, or + # (2) before a word containing "conftest.", or (3) at the end. + # Note that $ac_compile itself does not contain backslashes and begins + # with a dollar sign (not a hyphen), so the echo should work correctly. + lt_compile=`echo "$ac_compile" | $SED \ + -e 's:.*FLAGS}\{0,1\} :&$lt_compiler_flag :; t' \ + -e 's: [^ ]*conftest\.: $lt_compiler_flag&:; t' \ + -e 's:$: $lt_compiler_flag:'` + (eval echo "\"\$as_me:$LINENO: $lt_compile\"" >&5) + (eval "$lt_compile" 2>out/conftest.err) + ac_status=$? + cat out/conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + if (exit $ac_status) && test -s out/conftest2.$ac_objext + then + # The compiler can only warn and ignore the option if not recognized + # So say no if there are warnings + $ECHO "$_lt_compiler_boilerplate" | $SED '/^$/d' > out/conftest.exp + $SED '/^$/d; /^ *+/d' out/conftest.err >out/conftest.er2 + if test ! -s out/conftest.er2 || diff out/conftest.exp out/conftest.er2 >/dev/null; then + lt_cv_prog_compiler_c_o_CXX=yes + fi + fi + chmod u+w . 2>&5 + $RM conftest* + # SGI C++ compiler will create directory out/ii_files/ for + # template instantiation + test -d out/ii_files && $RM out/ii_files/* && rmdir out/ii_files + $RM out/* && rmdir out + cd .. + $RM -r conftest + $RM conftest* + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_prog_compiler_c_o_CXX" >&5 +$as_echo "$lt_cv_prog_compiler_c_o_CXX" >&6; } + + + + +hard_links=nottested +if test no = "$lt_cv_prog_compiler_c_o_CXX" && test no != "$need_locks"; then + # do not overwrite the value of need_locks provided by the user + { $as_echo "$as_me:${as_lineno-$LINENO}: checking if we can lock with hard links" >&5 +$as_echo_n "checking if we can lock with hard links... " >&6; } + hard_links=yes + $RM conftest* + ln conftest.a conftest.b 2>/dev/null && hard_links=no + touch conftest.a + ln conftest.a conftest.b 2>&5 || hard_links=no + ln conftest.a conftest.b 2>/dev/null && hard_links=no + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $hard_links" >&5 +$as_echo "$hard_links" >&6; } + if test no = "$hard_links"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: '$CC' does not support '-c -o', so 'make -j' may be unsafe" >&5 +$as_echo "$as_me: WARNING: '$CC' does not support '-c -o', so 'make -j' may be unsafe" >&2;} + need_locks=warn + fi +else + need_locks=no +fi + + + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether the $compiler linker ($LD) supports shared libraries" >&5 +$as_echo_n "checking whether the $compiler linker ($LD) supports shared libraries... " >&6; } + + export_symbols_cmds_CXX='$NM $libobjs $convenience | $global_symbol_pipe | $SED '\''s/.* //'\'' | sort | uniq > $export_symbols' + exclude_expsyms_CXX='_GLOBAL_OFFSET_TABLE_|_GLOBAL__F[ID]_.*' + case $host_os in + aix[4-9]*) + # If we're using GNU nm, then we don't want the "-C" option. + # -C means demangle to GNU nm, but means don't demangle to AIX nm. + # Without the "-l" option, or with the "-B" option, AIX nm treats + # weak defined symbols like other global defined symbols, whereas + # GNU nm marks them as "W". + # While the 'weak' keyword is ignored in the Export File, we need + # it in the Import File for the 'aix-soname' feature, so we have + # to replace the "-B" option with "-P" for AIX nm. + if $NM -V 2>&1 | $GREP 'GNU' > /dev/null; then + export_symbols_cmds_CXX='$NM -Bpg $libobjs $convenience | awk '\''{ if (((\$ 2 == "T") || (\$ 2 == "D") || (\$ 2 == "B") || (\$ 2 == "W")) && (substr(\$ 3,1,1) != ".")) { if (\$ 2 == "W") { print \$ 3 " weak" } else { print \$ 3 } } }'\'' | sort -u > $export_symbols' + else + export_symbols_cmds_CXX='`func_echo_all $NM | $SED -e '\''s/B\([^B]*\)$/P\1/'\''` -PCpgl $libobjs $convenience | awk '\''{ if (((\$ 2 == "T") || (\$ 2 == "D") || (\$ 2 == "B") || (\$ 2 == "W") || (\$ 2 == "V") || (\$ 2 == "Z")) && (substr(\$ 1,1,1) != ".")) { if ((\$ 2 == "W") || (\$ 2 == "V") || (\$ 2 == "Z")) { print \$ 1 " weak" } else { print \$ 1 } } }'\'' | sort -u > $export_symbols' + fi + ;; + pw32*) + export_symbols_cmds_CXX=$ltdll_cmds + ;; + cygwin* | mingw* | cegcc*) + case $cc_basename in + cl*) + exclude_expsyms_CXX='_NULL_IMPORT_DESCRIPTOR|_IMPORT_DESCRIPTOR_.*' + ;; + *) + export_symbols_cmds_CXX='$NM $libobjs $convenience | $global_symbol_pipe | $SED -e '\''/^[BCDGRS][ ]/s/.*[ ]\([^ ]*\)/\1 DATA/;s/^.*[ ]__nm__\([^ ]*\)[ ][^ ]*/\1 DATA/;/^I[ ]/d;/^[AITW][ ]/s/.* //'\'' | sort | uniq > $export_symbols' + exclude_expsyms_CXX='[_]+GLOBAL_OFFSET_TABLE_|[_]+GLOBAL__[FID]_.*|[_]+head_[A-Za-z0-9_]+_dll|[A-Za-z0-9_]+_dll_iname' + ;; + esac + ;; + *) + export_symbols_cmds_CXX='$NM $libobjs $convenience | $global_symbol_pipe | $SED '\''s/.* //'\'' | sort | uniq > $export_symbols' + ;; + esac + +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ld_shlibs_CXX" >&5 +$as_echo "$ld_shlibs_CXX" >&6; } +test no = "$ld_shlibs_CXX" && can_build_shared=no + +with_gnu_ld_CXX=$with_gnu_ld + + + + + + +# +# Do we need to explicitly link libc? +# +case "x$archive_cmds_need_lc_CXX" in +x|xyes) + # Assume -lc should be added + archive_cmds_need_lc_CXX=yes + + if test yes,yes = "$GCC,$enable_shared"; then + case $archive_cmds_CXX in + *'~'*) + # FIXME: we may have to deal with multi-command sequences. + ;; + '$CC '*) + # Test whether the compiler implicitly links with -lc since on some + # systems, -lgcc has to come before -lc. If gcc already passes -lc + # to ld, don't add -lc before -lgcc. + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether -lc should be explicitly linked in" >&5 +$as_echo_n "checking whether -lc should be explicitly linked in... " >&6; } +if ${lt_cv_archive_cmds_need_lc_CXX+:} false; then : + $as_echo_n "(cached) " >&6 +else + $RM conftest* + echo "$lt_simple_compile_test_code" > conftest.$ac_ext + + if { { eval echo "\"\$as_me\":${as_lineno-$LINENO}: \"$ac_compile\""; } >&5 + (eval $ac_compile) 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } 2>conftest.err; then + soname=conftest + lib=conftest + libobjs=conftest.$ac_objext + deplibs= + wl=$lt_prog_compiler_wl_CXX + pic_flag=$lt_prog_compiler_pic_CXX + compiler_flags=-v + linker_flags=-v + verstring= + output_objdir=. + libname=conftest + lt_save_allow_undefined_flag=$allow_undefined_flag_CXX + allow_undefined_flag_CXX= + if { { eval echo "\"\$as_me\":${as_lineno-$LINENO}: \"$archive_cmds_CXX 2\>\&1 \| $GREP \" -lc \" \>/dev/null 2\>\&1\""; } >&5 + (eval $archive_cmds_CXX 2\>\&1 \| $GREP \" -lc \" \>/dev/null 2\>\&1) 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } + then + lt_cv_archive_cmds_need_lc_CXX=no + else + lt_cv_archive_cmds_need_lc_CXX=yes + fi + allow_undefined_flag_CXX=$lt_save_allow_undefined_flag + else + cat conftest.err 1>&5 + fi + $RM conftest* + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_archive_cmds_need_lc_CXX" >&5 +$as_echo "$lt_cv_archive_cmds_need_lc_CXX" >&6; } + archive_cmds_need_lc_CXX=$lt_cv_archive_cmds_need_lc_CXX + ;; + esac + fi + ;; +esac + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking dynamic linker characteristics" >&5 +$as_echo_n "checking dynamic linker characteristics... " >&6; } + +library_names_spec= +libname_spec='lib$name' +soname_spec= +shrext_cmds=.so +postinstall_cmds= +postuninstall_cmds= +finish_cmds= +finish_eval= +shlibpath_var= +shlibpath_overrides_runpath=unknown +version_type=none +dynamic_linker="$host_os ld.so" +sys_lib_dlsearch_path_spec="/lib /usr/lib" +need_lib_prefix=unknown +hardcode_into_libs=no + +# when you set need_version to no, make sure it does not cause -set_version +# flags to be left without arguments +need_version=unknown + + + +case $host_os in +aix3*) + version_type=linux # correct to gnu/linux during the next big refactor + library_names_spec='$libname$release$shared_ext$versuffix $libname.a' + shlibpath_var=LIBPATH + + # AIX 3 has no versioning support, so we append a major version to the name. + soname_spec='$libname$release$shared_ext$major' + ;; + +aix[4-9]*) + version_type=linux # correct to gnu/linux during the next big refactor + need_lib_prefix=no + need_version=no + hardcode_into_libs=yes + if test ia64 = "$host_cpu"; then + # AIX 5 supports IA64 + library_names_spec='$libname$release$shared_ext$major $libname$release$shared_ext$versuffix $libname$shared_ext' + shlibpath_var=LD_LIBRARY_PATH + else + # With GCC up to 2.95.x, collect2 would create an import file + # for dependence libraries. The import file would start with + # the line '#! .'. This would cause the generated library to + # depend on '.', always an invalid library. This was fixed in + # development snapshots of GCC prior to 3.0. + case $host_os in + aix4 | aix4.[01] | aix4.[01].*) + if { echo '#if __GNUC__ > 2 || (__GNUC__ == 2 && __GNUC_MINOR__ >= 97)' + echo ' yes ' + echo '#endif'; } | $CC -E - | $GREP yes > /dev/null; then + : + else + can_build_shared=no + fi + ;; + esac + # Using Import Files as archive members, it is possible to support + # filename-based versioning of shared library archives on AIX. While + # this would work for both with and without runtime linking, it will + # prevent static linking of such archives. So we do filename-based + # shared library versioning with .so extension only, which is used + # when both runtime linking and shared linking is enabled. + # Unfortunately, runtime linking may impact performance, so we do + # not want this to be the default eventually. Also, we use the + # versioned .so libs for executables only if there is the -brtl + # linker flag in LDFLAGS as well, or --with-aix-soname=svr4 only. + # To allow for filename-based versioning support, we need to create + # libNAME.so.V as an archive file, containing: + # *) an Import File, referring to the versioned filename of the + # archive as well as the shared archive member, telling the + # bitwidth (32 or 64) of that shared object, and providing the + # list of exported symbols of that shared object, eventually + # decorated with the 'weak' keyword + # *) the shared object with the F_LOADONLY flag set, to really avoid + # it being seen by the linker. + # At run time we better use the real file rather than another symlink, + # but for link time we create the symlink libNAME.so -> libNAME.so.V + + case $with_aix_soname,$aix_use_runtimelinking in + # AIX (on Power*) has no versioning support, so currently we cannot hardcode correct + # soname into executable. Probably we can add versioning support to + # collect2, so additional links can be useful in future. + aix,yes) # traditional libtool + dynamic_linker='AIX unversionable lib.so' + # If using run time linking (on AIX 4.2 or later) use lib<name>.so + # instead of lib<name>.a to let people know that these are not + # typical AIX shared libraries. + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' + ;; + aix,no) # traditional AIX only + dynamic_linker='AIX lib.a(lib.so.V)' + # We preserve .a as extension for shared libraries through AIX4.2 + # and later when we are not doing run time linking. + library_names_spec='$libname$release.a $libname.a' + soname_spec='$libname$release$shared_ext$major' + ;; + svr4,*) # full svr4 only + dynamic_linker="AIX lib.so.V($shared_archive_member_spec.o)" + library_names_spec='$libname$release$shared_ext$major $libname$shared_ext' + # We do not specify a path in Import Files, so LIBPATH fires. + shlibpath_overrides_runpath=yes + ;; + *,yes) # both, prefer svr4 + dynamic_linker="AIX lib.so.V($shared_archive_member_spec.o), lib.a(lib.so.V)" + library_names_spec='$libname$release$shared_ext$major $libname$shared_ext' + # unpreferred sharedlib libNAME.a needs extra handling + postinstall_cmds='test -n "$linkname" || linkname="$realname"~func_stripname "" ".so" "$linkname"~$install_shared_prog "$dir/$func_stripname_result.$libext" "$destdir/$func_stripname_result.$libext"~test -z "$tstripme" || test -z "$striplib" || $striplib "$destdir/$func_stripname_result.$libext"' + postuninstall_cmds='for n in $library_names $old_library; do :; done~func_stripname "" ".so" "$n"~test "$func_stripname_result" = "$n" || func_append rmfiles " $odir/$func_stripname_result.$libext"' + # We do not specify a path in Import Files, so LIBPATH fires. + shlibpath_overrides_runpath=yes + ;; + *,no) # both, prefer aix + dynamic_linker="AIX lib.a(lib.so.V), lib.so.V($shared_archive_member_spec.o)" + library_names_spec='$libname$release.a $libname.a' + soname_spec='$libname$release$shared_ext$major' + # unpreferred sharedlib libNAME.so.V and symlink libNAME.so need extra handling + postinstall_cmds='test -z "$dlname" || $install_shared_prog $dir/$dlname $destdir/$dlname~test -z "$tstripme" || test -z "$striplib" || $striplib $destdir/$dlname~test -n "$linkname" || linkname=$realname~func_stripname "" ".a" "$linkname"~(cd "$destdir" && $LN_S -f $dlname $func_stripname_result.so)' + postuninstall_cmds='test -z "$dlname" || func_append rmfiles " $odir/$dlname"~for n in $old_library $library_names; do :; done~func_stripname "" ".a" "$n"~func_append rmfiles " $odir/$func_stripname_result.so"' + ;; + esac + shlibpath_var=LIBPATH + fi + ;; + +amigaos*) + case $host_cpu in + powerpc) + # Since July 2007 AmigaOS4 officially supports .so libraries. + # When compiling the executable, add -use-dynld -Lsobjs: to the compileline. + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' + ;; + m68k) + library_names_spec='$libname.ixlibrary $libname.a' + # Create ${libname}_ixlibrary.a entries in /sys/libs. + finish_eval='for lib in `ls $libdir/*.ixlibrary 2>/dev/null`; do libname=`func_echo_all "$lib" | $SED '\''s%^.*/\([^/]*\)\.ixlibrary$%\1%'\''`; $RM /sys/libs/${libname}_ixlibrary.a; $show "cd /sys/libs && $LN_S $lib ${libname}_ixlibrary.a"; cd /sys/libs && $LN_S $lib ${libname}_ixlibrary.a || exit 1; done' + ;; + esac + ;; + +beos*) + library_names_spec='$libname$shared_ext' + dynamic_linker="$host_os ld.so" + shlibpath_var=LIBRARY_PATH + ;; + +bsdi[45]*) + version_type=linux # correct to gnu/linux during the next big refactor + need_version=no + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' + soname_spec='$libname$release$shared_ext$major' + finish_cmds='PATH="\$PATH:/sbin" ldconfig $libdir' + shlibpath_var=LD_LIBRARY_PATH + sys_lib_search_path_spec="/shlib /usr/lib /usr/X11/lib /usr/contrib/lib /lib /usr/local/lib" + sys_lib_dlsearch_path_spec="/shlib /usr/lib /usr/local/lib" + # the default ld.so.conf also contains /usr/contrib/lib and + # /usr/X11R6/lib (/usr/X11 is a link to /usr/X11R6), but let us allow + # libtool to hard-code these into programs + ;; + +cygwin* | mingw* | pw32* | cegcc*) + version_type=windows + shrext_cmds=.dll + need_version=no + need_lib_prefix=no + + case $GCC,$cc_basename in + yes,*) + # gcc + library_names_spec='$libname.dll.a' + # DLL is installed to $(libdir)/../bin by postinstall_cmds + postinstall_cmds='base_file=`basename \$file`~ + dlpath=`$SHELL 2>&1 -c '\''. $dir/'\''\$base_file'\''i; echo \$dlname'\''`~ + dldir=$destdir/`dirname \$dlpath`~ + test -d \$dldir || mkdir -p \$dldir~ + $install_prog $dir/$dlname \$dldir/$dlname~ + chmod a+x \$dldir/$dlname~ + if test -n '\''$stripme'\'' && test -n '\''$striplib'\''; then + eval '\''$striplib \$dldir/$dlname'\'' || exit \$?; + fi' + postuninstall_cmds='dldll=`$SHELL 2>&1 -c '\''. $file; echo \$dlname'\''`~ + dlpath=$dir/\$dldll~ + $RM \$dlpath' + shlibpath_overrides_runpath=yes + + case $host_os in + cygwin*) + # Cygwin DLLs use 'cyg' prefix rather than 'lib' + soname_spec='`echo $libname | sed -e 's/^lib/cyg/'``echo $release | $SED -e 's/[.]/-/g'`$versuffix$shared_ext' + + ;; + mingw* | cegcc*) + # MinGW DLLs use traditional 'lib' prefix + soname_spec='$libname`echo $release | $SED -e 's/[.]/-/g'`$versuffix$shared_ext' + ;; + pw32*) + # pw32 DLLs use 'pw' prefix rather than 'lib' + library_names_spec='`echo $libname | sed -e 's/^lib/pw/'``echo $release | $SED -e 's/[.]/-/g'`$versuffix$shared_ext' + ;; + esac + dynamic_linker='Win32 ld.exe' + ;; + + *,cl*) + # Native MSVC + libname_spec='$name' + soname_spec='$libname`echo $release | $SED -e 's/[.]/-/g'`$versuffix$shared_ext' + library_names_spec='$libname.dll.lib' + + case $build_os in + mingw*) + sys_lib_search_path_spec= + lt_save_ifs=$IFS + IFS=';' + for lt_path in $LIB + do + IFS=$lt_save_ifs + # Let DOS variable expansion print the short 8.3 style file name. + lt_path=`cd "$lt_path" 2>/dev/null && cmd //C "for %i in (".") do @echo %~si"` + sys_lib_search_path_spec="$sys_lib_search_path_spec $lt_path" + done + IFS=$lt_save_ifs + # Convert to MSYS style. + sys_lib_search_path_spec=`$ECHO "$sys_lib_search_path_spec" | sed -e 's|\\\\|/|g' -e 's| \\([a-zA-Z]\\):| /\\1|g' -e 's|^ ||'` + ;; + cygwin*) + # Convert to unix form, then to dos form, then back to unix form + # but this time dos style (no spaces!) so that the unix form looks + # like /cygdrive/c/PROGRA~1:/cygdr... + sys_lib_search_path_spec=`cygpath --path --unix "$LIB"` + sys_lib_search_path_spec=`cygpath --path --dos "$sys_lib_search_path_spec" 2>/dev/null` + sys_lib_search_path_spec=`cygpath --path --unix "$sys_lib_search_path_spec" | $SED -e "s/$PATH_SEPARATOR/ /g"` + ;; + *) + sys_lib_search_path_spec=$LIB + if $ECHO "$sys_lib_search_path_spec" | $GREP ';[c-zC-Z]:/' >/dev/null; then + # It is most probably a Windows format PATH. + sys_lib_search_path_spec=`$ECHO "$sys_lib_search_path_spec" | $SED -e 's/;/ /g'` + else + sys_lib_search_path_spec=`$ECHO "$sys_lib_search_path_spec" | $SED -e "s/$PATH_SEPARATOR/ /g"` + fi + # FIXME: find the short name or the path components, as spaces are + # common. (e.g. "Program Files" -> "PROGRA~1") + ;; + esac + + # DLL is installed to $(libdir)/../bin by postinstall_cmds + postinstall_cmds='base_file=`basename \$file`~ + dlpath=`$SHELL 2>&1 -c '\''. $dir/'\''\$base_file'\''i; echo \$dlname'\''`~ + dldir=$destdir/`dirname \$dlpath`~ + test -d \$dldir || mkdir -p \$dldir~ + $install_prog $dir/$dlname \$dldir/$dlname' + postuninstall_cmds='dldll=`$SHELL 2>&1 -c '\''. $file; echo \$dlname'\''`~ + dlpath=$dir/\$dldll~ + $RM \$dlpath' + shlibpath_overrides_runpath=yes + dynamic_linker='Win32 link.exe' + ;; + + *) + # Assume MSVC wrapper + library_names_spec='$libname`echo $release | $SED -e 's/[.]/-/g'`$versuffix$shared_ext $libname.lib' + dynamic_linker='Win32 ld.exe' + ;; + esac + # FIXME: first we should search . and the directory the executable is in + shlibpath_var=PATH + ;; + +darwin* | rhapsody*) + dynamic_linker="$host_os dyld" + version_type=darwin + need_lib_prefix=no + need_version=no + library_names_spec='$libname$release$major$shared_ext $libname$shared_ext' + soname_spec='$libname$release$major$shared_ext' + shlibpath_overrides_runpath=yes + shlibpath_var=DYLD_LIBRARY_PATH + shrext_cmds='`test .$module = .yes && echo .so || echo .dylib`' + + sys_lib_dlsearch_path_spec='/usr/local/lib /lib /usr/lib' + ;; + +dgux*) + version_type=linux # correct to gnu/linux during the next big refactor + need_lib_prefix=no + need_version=no + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' + soname_spec='$libname$release$shared_ext$major' + shlibpath_var=LD_LIBRARY_PATH + ;; + +freebsd* | dragonfly*) + # DragonFly does not have aout. When/if they implement a new + # versioning mechanism, adjust this. + if test -x /usr/bin/objformat; then + objformat=`/usr/bin/objformat` + else + case $host_os in + freebsd[23].*) objformat=aout ;; + *) objformat=elf ;; + esac + fi + version_type=freebsd-$objformat + case $version_type in + freebsd-elf*) + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' + soname_spec='$libname$release$shared_ext$major' + need_version=no + need_lib_prefix=no + ;; + freebsd-*) + library_names_spec='$libname$release$shared_ext$versuffix $libname$shared_ext$versuffix' + need_version=yes + ;; + esac + shlibpath_var=LD_LIBRARY_PATH + case $host_os in + freebsd2.*) + shlibpath_overrides_runpath=yes + ;; + freebsd3.[01]* | freebsdelf3.[01]*) + shlibpath_overrides_runpath=yes + hardcode_into_libs=yes + ;; + freebsd3.[2-9]* | freebsdelf3.[2-9]* | \ + freebsd4.[0-5] | freebsdelf4.[0-5] | freebsd4.1.1 | freebsdelf4.1.1) + shlibpath_overrides_runpath=no + hardcode_into_libs=yes + ;; + *) # from 4.6 on, and DragonFly + shlibpath_overrides_runpath=yes + hardcode_into_libs=yes + ;; + esac + ;; + +haiku*) + version_type=linux # correct to gnu/linux during the next big refactor + need_lib_prefix=no + need_version=no + dynamic_linker="$host_os runtime_loader" + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' + soname_spec='$libname$release$shared_ext$major' + shlibpath_var=LIBRARY_PATH + shlibpath_overrides_runpath=no + sys_lib_dlsearch_path_spec='/boot/home/config/lib /boot/common/lib /boot/system/lib' + hardcode_into_libs=yes + ;; + +hpux9* | hpux10* | hpux11*) + # Give a soname corresponding to the major version so that dld.sl refuses to + # link against other versions. + version_type=sunos + need_lib_prefix=no + need_version=no + case $host_cpu in + ia64*) + shrext_cmds='.so' + hardcode_into_libs=yes + dynamic_linker="$host_os dld.so" + shlibpath_var=LD_LIBRARY_PATH + shlibpath_overrides_runpath=yes # Unless +noenvvar is specified. + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' + soname_spec='$libname$release$shared_ext$major' + if test 32 = "$HPUX_IA64_MODE"; then + sys_lib_search_path_spec="/usr/lib/hpux32 /usr/local/lib/hpux32 /usr/local/lib" + sys_lib_dlsearch_path_spec=/usr/lib/hpux32 + else + sys_lib_search_path_spec="/usr/lib/hpux64 /usr/local/lib/hpux64" + sys_lib_dlsearch_path_spec=/usr/lib/hpux64 + fi + ;; + hppa*64*) + shrext_cmds='.sl' + hardcode_into_libs=yes + dynamic_linker="$host_os dld.sl" + shlibpath_var=LD_LIBRARY_PATH # How should we handle SHLIB_PATH + shlibpath_overrides_runpath=yes # Unless +noenvvar is specified. + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' + soname_spec='$libname$release$shared_ext$major' + sys_lib_search_path_spec="/usr/lib/pa20_64 /usr/ccs/lib/pa20_64" + sys_lib_dlsearch_path_spec=$sys_lib_search_path_spec + ;; + *) + shrext_cmds='.sl' + dynamic_linker="$host_os dld.sl" + shlibpath_var=SHLIB_PATH + shlibpath_overrides_runpath=no # +s is required to enable SHLIB_PATH + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' + soname_spec='$libname$release$shared_ext$major' + ;; + esac + # HP-UX runs *really* slowly unless shared libraries are mode 555, ... + postinstall_cmds='chmod 555 $lib' + # or fails outright, so override atomically: + install_override_mode=555 + ;; + +interix[3-9]*) + version_type=linux # correct to gnu/linux during the next big refactor + need_lib_prefix=no + need_version=no + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' + soname_spec='$libname$release$shared_ext$major' + dynamic_linker='Interix 3.x ld.so.1 (PE, like ELF)' + shlibpath_var=LD_LIBRARY_PATH + shlibpath_overrides_runpath=no + hardcode_into_libs=yes + ;; + +irix5* | irix6* | nonstopux*) + case $host_os in + nonstopux*) version_type=nonstopux ;; + *) + if test yes = "$lt_cv_prog_gnu_ld"; then + version_type=linux # correct to gnu/linux during the next big refactor + else + version_type=irix + fi ;; + esac + need_lib_prefix=no + need_version=no + soname_spec='$libname$release$shared_ext$major' + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$release$shared_ext $libname$shared_ext' + case $host_os in + irix5* | nonstopux*) + libsuff= shlibsuff= + ;; + *) + case $LD in # libtool.m4 will add one of these switches to LD + *-32|*"-32 "|*-melf32bsmip|*"-melf32bsmip ") + libsuff= shlibsuff= libmagic=32-bit;; + *-n32|*"-n32 "|*-melf32bmipn32|*"-melf32bmipn32 ") + libsuff=32 shlibsuff=N32 libmagic=N32;; + *-64|*"-64 "|*-melf64bmip|*"-melf64bmip ") + libsuff=64 shlibsuff=64 libmagic=64-bit;; + *) libsuff= shlibsuff= libmagic=never-match;; + esac + ;; + esac + shlibpath_var=LD_LIBRARY${shlibsuff}_PATH + shlibpath_overrides_runpath=no + sys_lib_search_path_spec="/usr/lib$libsuff /lib$libsuff /usr/local/lib$libsuff" + sys_lib_dlsearch_path_spec="/usr/lib$libsuff /lib$libsuff" + hardcode_into_libs=yes + ;; + +# No shared lib support for Linux oldld, aout, or coff. +linux*oldld* | linux*aout* | linux*coff*) + dynamic_linker=no + ;; + +linux*android*) + version_type=none # Android doesn't support versioned libraries. + need_lib_prefix=no + need_version=no + library_names_spec='$libname$release$shared_ext' + soname_spec='$libname$release$shared_ext' + finish_cmds= + shlibpath_var=LD_LIBRARY_PATH + shlibpath_overrides_runpath=yes + + # This implies no fast_install, which is unacceptable. + # Some rework will be needed to allow for fast_install + # before this can be enabled. + hardcode_into_libs=yes + + dynamic_linker='Android linker' + # Don't embed -rpath directories since the linker doesn't support them. + hardcode_libdir_flag_spec_CXX='-L$libdir' + ;; + +# This must be glibc/ELF. +linux* | k*bsd*-gnu | kopensolaris*-gnu | gnu*) + version_type=linux # correct to gnu/linux during the next big refactor + need_lib_prefix=no + need_version=no + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' + soname_spec='$libname$release$shared_ext$major' + finish_cmds='PATH="\$PATH:/sbin" ldconfig -n $libdir' + shlibpath_var=LD_LIBRARY_PATH + shlibpath_overrides_runpath=no + + # Some binutils ld are patched to set DT_RUNPATH + if ${lt_cv_shlibpath_overrides_runpath+:} false; then : + $as_echo_n "(cached) " >&6 +else + lt_cv_shlibpath_overrides_runpath=no + save_LDFLAGS=$LDFLAGS + save_libdir=$libdir + eval "libdir=/foo; wl=\"$lt_prog_compiler_wl_CXX\"; \ + LDFLAGS=\"\$LDFLAGS $hardcode_libdir_flag_spec_CXX\"" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_cxx_try_link "$LINENO"; then : + if ($OBJDUMP -p conftest$ac_exeext) 2>/dev/null | grep "RUNPATH.*$libdir" >/dev/null; then : + lt_cv_shlibpath_overrides_runpath=yes +fi +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + LDFLAGS=$save_LDFLAGS + libdir=$save_libdir + +fi + + shlibpath_overrides_runpath=$lt_cv_shlibpath_overrides_runpath + + # This implies no fast_install, which is unacceptable. + # Some rework will be needed to allow for fast_install + # before this can be enabled. + hardcode_into_libs=yes + + # Ideally, we could use ldconfig to report *all* directores which are + # searched for libraries, however this is still not possible. Aside from not + # being certain /sbin/ldconfig is available, command + # 'ldconfig -N -X -v | grep ^/' on 64bit Fedora does not report /usr/lib64, + # even though it is searched at run-time. Try to do the best guess by + # appending ld.so.conf contents (and includes) to the search path. + if test -f /etc/ld.so.conf; then + lt_ld_extra=`awk '/^include / { system(sprintf("cd /etc; cat %s 2>/dev/null", \$2)); skip = 1; } { if (!skip) print \$0; skip = 0; }' < /etc/ld.so.conf | $SED -e 's/#.*//;/^[ ]*hwcap[ ]/d;s/[:, ]/ /g;s/=[^=]*$//;s/=[^= ]* / /g;s/"//g;/^$/d' | tr '\n' ' '` + sys_lib_dlsearch_path_spec="/lib /usr/lib $lt_ld_extra" + fi + + # We used to test for /lib/ld.so.1 and disable shared libraries on + # powerpc, because MkLinux only supported shared libraries with the + # GNU dynamic linker. Since this was broken with cross compilers, + # most powerpc-linux boxes support dynamic linking these days and + # people can always --disable-shared, the test was removed, and we + # assume the GNU/Linux dynamic linker is in use. + dynamic_linker='GNU/Linux ld.so' + ;; + +netbsd*) + version_type=sunos + need_lib_prefix=no + need_version=no + if echo __ELF__ | $CC -E - | $GREP __ELF__ >/dev/null; then + library_names_spec='$libname$release$shared_ext$versuffix $libname$shared_ext$versuffix' + finish_cmds='PATH="\$PATH:/sbin" ldconfig -m $libdir' + dynamic_linker='NetBSD (a.out) ld.so' + else + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' + soname_spec='$libname$release$shared_ext$major' + dynamic_linker='NetBSD ld.elf_so' + fi + shlibpath_var=LD_LIBRARY_PATH + shlibpath_overrides_runpath=yes + hardcode_into_libs=yes + ;; + +newsos6) + version_type=linux # correct to gnu/linux during the next big refactor + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' + shlibpath_var=LD_LIBRARY_PATH + shlibpath_overrides_runpath=yes + ;; + +*nto* | *qnx*) + version_type=qnx + need_lib_prefix=no + need_version=no + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' + soname_spec='$libname$release$shared_ext$major' + shlibpath_var=LD_LIBRARY_PATH + shlibpath_overrides_runpath=no + hardcode_into_libs=yes + dynamic_linker='ldqnx.so' + ;; + +openbsd* | bitrig*) + version_type=sunos + sys_lib_dlsearch_path_spec=/usr/lib + need_lib_prefix=no + if test -z "`echo __ELF__ | $CC -E - | $GREP __ELF__`"; then + need_version=no + else + need_version=yes + fi + library_names_spec='$libname$release$shared_ext$versuffix $libname$shared_ext$versuffix' + finish_cmds='PATH="\$PATH:/sbin" ldconfig -m $libdir' + shlibpath_var=LD_LIBRARY_PATH + shlibpath_overrides_runpath=yes + ;; + +os2*) + libname_spec='$name' + version_type=windows + shrext_cmds=.dll + need_version=no + need_lib_prefix=no + # OS/2 can only load a DLL with a base name of 8 characters or less. + soname_spec='`test -n "$os2dllname" && libname="$os2dllname"; + v=$($ECHO $release$versuffix | tr -d .-); + n=$($ECHO $libname | cut -b -$((8 - ${#v})) | tr . _); + $ECHO $n$v`$shared_ext' + library_names_spec='${libname}_dll.$libext' + dynamic_linker='OS/2 ld.exe' + shlibpath_var=BEGINLIBPATH + sys_lib_search_path_spec="/lib /usr/lib /usr/local/lib" + sys_lib_dlsearch_path_spec=$sys_lib_search_path_spec + postinstall_cmds='base_file=`basename \$file`~ + dlpath=`$SHELL 2>&1 -c '\''. $dir/'\''\$base_file'\''i; $ECHO \$dlname'\''`~ + dldir=$destdir/`dirname \$dlpath`~ + test -d \$dldir || mkdir -p \$dldir~ + $install_prog $dir/$dlname \$dldir/$dlname~ + chmod a+x \$dldir/$dlname~ + if test -n '\''$stripme'\'' && test -n '\''$striplib'\''; then + eval '\''$striplib \$dldir/$dlname'\'' || exit \$?; + fi' + postuninstall_cmds='dldll=`$SHELL 2>&1 -c '\''. $file; $ECHO \$dlname'\''`~ + dlpath=$dir/\$dldll~ + $RM \$dlpath' + ;; + +osf3* | osf4* | osf5*) + version_type=osf + need_lib_prefix=no + need_version=no + soname_spec='$libname$release$shared_ext$major' + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' + shlibpath_var=LD_LIBRARY_PATH + sys_lib_search_path_spec="/usr/shlib /usr/ccs/lib /usr/lib/cmplrs/cc /usr/lib /usr/local/lib /var/shlib" + sys_lib_dlsearch_path_spec=$sys_lib_search_path_spec + ;; + +rdos*) + dynamic_linker=no + ;; + +solaris*) + version_type=linux # correct to gnu/linux during the next big refactor + need_lib_prefix=no + need_version=no + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' + soname_spec='$libname$release$shared_ext$major' + shlibpath_var=LD_LIBRARY_PATH + shlibpath_overrides_runpath=yes + hardcode_into_libs=yes + # ldd complains unless libraries are executable + postinstall_cmds='chmod +x $lib' + ;; + +sunos4*) + version_type=sunos + library_names_spec='$libname$release$shared_ext$versuffix $libname$shared_ext$versuffix' + finish_cmds='PATH="\$PATH:/usr/etc" ldconfig $libdir' + shlibpath_var=LD_LIBRARY_PATH + shlibpath_overrides_runpath=yes + if test yes = "$with_gnu_ld"; then + need_lib_prefix=no + fi + need_version=yes + ;; + +sysv4 | sysv4.3*) + version_type=linux # correct to gnu/linux during the next big refactor + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' + soname_spec='$libname$release$shared_ext$major' + shlibpath_var=LD_LIBRARY_PATH + case $host_vendor in + sni) + shlibpath_overrides_runpath=no + need_lib_prefix=no + runpath_var=LD_RUN_PATH + ;; + siemens) + need_lib_prefix=no + ;; + motorola) + need_lib_prefix=no + need_version=no + shlibpath_overrides_runpath=no + sys_lib_search_path_spec='/lib /usr/lib /usr/ccs/lib' + ;; + esac + ;; + +sysv4*MP*) + if test -d /usr/nec; then + version_type=linux # correct to gnu/linux during the next big refactor + library_names_spec='$libname$shared_ext.$versuffix $libname$shared_ext.$major $libname$shared_ext' + soname_spec='$libname$shared_ext.$major' + shlibpath_var=LD_LIBRARY_PATH + fi + ;; + +sysv5* | sco3.2v5* | sco5v6* | unixware* | OpenUNIX* | sysv4*uw2*) + version_type=sco + need_lib_prefix=no + need_version=no + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext $libname$shared_ext' + soname_spec='$libname$release$shared_ext$major' + shlibpath_var=LD_LIBRARY_PATH + shlibpath_overrides_runpath=yes + hardcode_into_libs=yes + if test yes = "$with_gnu_ld"; then + sys_lib_search_path_spec='/usr/local/lib /usr/gnu/lib /usr/ccs/lib /usr/lib /lib' + else + sys_lib_search_path_spec='/usr/ccs/lib /usr/lib' + case $host_os in + sco3.2v5*) + sys_lib_search_path_spec="$sys_lib_search_path_spec /lib" + ;; + esac + fi + sys_lib_dlsearch_path_spec='/usr/lib' + ;; + +tpf*) + # TPF is a cross-target only. Preferred cross-host = GNU/Linux. + version_type=linux # correct to gnu/linux during the next big refactor + need_lib_prefix=no + need_version=no + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' + shlibpath_var=LD_LIBRARY_PATH + shlibpath_overrides_runpath=no + hardcode_into_libs=yes + ;; + +uts4*) + version_type=linux # correct to gnu/linux during the next big refactor + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' + soname_spec='$libname$release$shared_ext$major' + shlibpath_var=LD_LIBRARY_PATH + ;; + +*) + dynamic_linker=no + ;; +esac +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $dynamic_linker" >&5 +$as_echo "$dynamic_linker" >&6; } +test no = "$dynamic_linker" && can_build_shared=no + +variables_saved_for_relink="PATH $shlibpath_var $runpath_var" +if test yes = "$GCC"; then + variables_saved_for_relink="$variables_saved_for_relink GCC_EXEC_PREFIX COMPILER_PATH LIBRARY_PATH" +fi + +if test set = "${lt_cv_sys_lib_search_path_spec+set}"; then + sys_lib_search_path_spec=$lt_cv_sys_lib_search_path_spec +fi + +if test set = "${lt_cv_sys_lib_dlsearch_path_spec+set}"; then + sys_lib_dlsearch_path_spec=$lt_cv_sys_lib_dlsearch_path_spec +fi + +# remember unaugmented sys_lib_dlsearch_path content for libtool script decls... +configure_time_dlsearch_path=$sys_lib_dlsearch_path_spec + +# ... but it needs LT_SYS_LIBRARY_PATH munging for other configure-time code +func_munge_path_list sys_lib_dlsearch_path_spec "$LT_SYS_LIBRARY_PATH" + +# to be used as default LT_SYS_LIBRARY_PATH value in generated libtool +configure_time_lt_sys_library_path=$LT_SYS_LIBRARY_PATH + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking how to hardcode library paths into programs" >&5 +$as_echo_n "checking how to hardcode library paths into programs... " >&6; } +hardcode_action_CXX= +if test -n "$hardcode_libdir_flag_spec_CXX" || + test -n "$runpath_var_CXX" || + test yes = "$hardcode_automatic_CXX"; then + + # We can hardcode non-existent directories. + if test no != "$hardcode_direct_CXX" && + # If the only mechanism to avoid hardcoding is shlibpath_var, we + # have to relink, otherwise we might link with an installed library + # when we should be linking with a yet-to-be-installed one + ## test no != "$_LT_TAGVAR(hardcode_shlibpath_var, CXX)" && + test no != "$hardcode_minus_L_CXX"; then + # Linking always hardcodes the temporary library directory. + hardcode_action_CXX=relink + else + # We can link without hardcoding, and we can hardcode nonexisting dirs. + hardcode_action_CXX=immediate + fi +else + # We cannot hardcode anything, or else we can only hardcode existing + # directories. + hardcode_action_CXX=unsupported +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $hardcode_action_CXX" >&5 +$as_echo "$hardcode_action_CXX" >&6; } + +if test relink = "$hardcode_action_CXX" || + test yes = "$inherit_rpath_CXX"; then + # Fast installation is not supported + enable_fast_install=no +elif test yes = "$shlibpath_overrides_runpath" || + test no = "$enable_shared"; then + # Fast installation is not necessary + enable_fast_install=needless +fi + + + + + + + + fi # test -n "$compiler" + + CC=$lt_save_CC + CFLAGS=$lt_save_CFLAGS + LDCXX=$LD + LD=$lt_save_LD + GCC=$lt_save_GCC + with_gnu_ld=$lt_save_with_gnu_ld + lt_cv_path_LDCXX=$lt_cv_path_LD + lt_cv_path_LD=$lt_save_path_LD + lt_cv_prog_gnu_ldcxx=$lt_cv_prog_gnu_ld + lt_cv_prog_gnu_ld=$lt_save_with_gnu_ld +fi # test yes != "$_lt_caught_CXX_error" + +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + + + + ac_ext=f +ac_compile='$F77 -c $FFLAGS conftest.$ac_ext >&5' +ac_link='$F77 -o conftest$ac_exeext $FFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_f77_compiler_gnu + +if test -z "$F77" || test no = "$F77"; then + _lt_disable_F77=yes +fi + +archive_cmds_need_lc_F77=no +allow_undefined_flag_F77= +always_export_symbols_F77=no +archive_expsym_cmds_F77= +export_dynamic_flag_spec_F77= +hardcode_direct_F77=no +hardcode_direct_absolute_F77=no +hardcode_libdir_flag_spec_F77= +hardcode_libdir_separator_F77= +hardcode_minus_L_F77=no +hardcode_automatic_F77=no +inherit_rpath_F77=no +module_cmds_F77= +module_expsym_cmds_F77= +link_all_deplibs_F77=unknown +old_archive_cmds_F77=$old_archive_cmds +reload_flag_F77=$reload_flag +reload_cmds_F77=$reload_cmds +no_undefined_flag_F77= +whole_archive_flag_spec_F77= +enable_shared_with_static_runtimes_F77=no + +# Source file extension for f77 test sources. +ac_ext=f + +# Object file extension for compiled f77 test sources. +objext=o +objext_F77=$objext + +# No sense in running all these tests if we already determined that +# the F77 compiler isn't working. Some variables (like enable_shared) +# are currently assumed to apply to all compilers on this platform, +# and will be corrupted by setting them based on a non-working compiler. +if test yes != "$_lt_disable_F77"; then + # Code to be used in simple compile tests + lt_simple_compile_test_code="\ + subroutine t + return + end +" + + # Code to be used in simple link tests + lt_simple_link_test_code="\ + program t + end +" + + # ltmain only uses $CC for tagged configurations so make sure $CC is set. + + + + + + +# If no C compiler was specified, use CC. +LTCC=${LTCC-"$CC"} + +# If no C compiler flags were specified, use CFLAGS. +LTCFLAGS=${LTCFLAGS-"$CFLAGS"} + +# Allow CC to be a program name with arguments. +compiler=$CC + + + # save warnings/boilerplate of simple test code + ac_outfile=conftest.$ac_objext +echo "$lt_simple_compile_test_code" >conftest.$ac_ext +eval "$ac_compile" 2>&1 >/dev/null | $SED '/^$/d; /^ *+/d' >conftest.err +_lt_compiler_boilerplate=`cat conftest.err` +$RM conftest* + + ac_outfile=conftest.$ac_objext +echo "$lt_simple_link_test_code" >conftest.$ac_ext +eval "$ac_link" 2>&1 >/dev/null | $SED '/^$/d; /^ *+/d' >conftest.err +_lt_linker_boilerplate=`cat conftest.err` +$RM -r conftest* + + + # Allow CC to be a program name with arguments. + lt_save_CC=$CC + lt_save_GCC=$GCC + lt_save_CFLAGS=$CFLAGS + CC=${F77-"f77"} + CFLAGS=$FFLAGS + compiler=$CC + compiler_F77=$CC + func_cc_basename $compiler +cc_basename=$func_cc_basename_result + + GCC=$G77 + if test -n "$compiler"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking if libtool supports shared libraries" >&5 +$as_echo_n "checking if libtool supports shared libraries... " >&6; } + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $can_build_shared" >&5 +$as_echo "$can_build_shared" >&6; } + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether to build shared libraries" >&5 +$as_echo_n "checking whether to build shared libraries... " >&6; } + test no = "$can_build_shared" && enable_shared=no + + # On AIX, shared libraries and static libraries use the same namespace, and + # are all built from PIC. + case $host_os in + aix3*) + test yes = "$enable_shared" && enable_static=no + if test -n "$RANLIB"; then + archive_cmds="$archive_cmds~\$RANLIB \$lib" + postinstall_cmds='$RANLIB $lib' + fi + ;; + aix[4-9]*) + if test ia64 != "$host_cpu"; then + case $enable_shared,$with_aix_soname,$aix_use_runtimelinking in + yes,aix,yes) ;; # shared object as lib.so file only + yes,svr4,*) ;; # shared object as lib.so archive member only + yes,*) enable_static=no ;; # shared object in lib.a archive as well + esac + fi + ;; + esac + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $enable_shared" >&5 +$as_echo "$enable_shared" >&6; } + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether to build static libraries" >&5 +$as_echo_n "checking whether to build static libraries... " >&6; } + # Make sure either enable_shared or enable_static is yes. + test yes = "$enable_shared" || enable_static=yes + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $enable_static" >&5 +$as_echo "$enable_static" >&6; } + + GCC_F77=$G77 + LD_F77=$LD + + ## CAVEAT EMPTOR: + ## There is no encapsulation within the following macros, do not change + ## the running order or otherwise move them around unless you know exactly + ## what you are doing... + lt_prog_compiler_wl_F77= +lt_prog_compiler_pic_F77= +lt_prog_compiler_static_F77= + + + if test yes = "$GCC"; then + lt_prog_compiler_wl_F77='-Wl,' + lt_prog_compiler_static_F77='-static' + + case $host_os in + aix*) + # All AIX code is PIC. + if test ia64 = "$host_cpu"; then + # AIX 5 now supports IA64 processor + lt_prog_compiler_static_F77='-Bstatic' + fi + lt_prog_compiler_pic_F77='-fPIC' + ;; + + amigaos*) + case $host_cpu in + powerpc) + # see comment about AmigaOS4 .so support + lt_prog_compiler_pic_F77='-fPIC' + ;; + m68k) + # FIXME: we need at least 68020 code to build shared libraries, but + # adding the '-m68020' flag to GCC prevents building anything better, + # like '-m68040'. + lt_prog_compiler_pic_F77='-m68020 -resident32 -malways-restore-a4' + ;; + esac + ;; + + beos* | irix5* | irix6* | nonstopux* | osf3* | osf4* | osf5*) + # PIC is the default for these OSes. + ;; + + mingw* | cygwin* | pw32* | os2* | cegcc*) + # This hack is so that the source file can tell whether it is being + # built for inclusion in a dll (and should export symbols for example). + # Although the cygwin gcc ignores -fPIC, still need this for old-style + # (--disable-auto-import) libraries + lt_prog_compiler_pic_F77='-DDLL_EXPORT' + case $host_os in + os2*) + lt_prog_compiler_static_F77='$wl-static' + ;; + esac + ;; + + darwin* | rhapsody*) + # PIC is the default on this platform + # Common symbols not allowed in MH_DYLIB files + lt_prog_compiler_pic_F77='-fno-common' + ;; + + haiku*) + # PIC is the default for Haiku. + # The "-static" flag exists, but is broken. + lt_prog_compiler_static_F77= + ;; + + hpux*) + # PIC is the default for 64-bit PA HP-UX, but not for 32-bit + # PA HP-UX. On IA64 HP-UX, PIC is the default but the pic flag + # sets the default TLS model and affects inlining. + case $host_cpu in + hppa*64*) + # +Z the default + ;; + *) + lt_prog_compiler_pic_F77='-fPIC' + ;; + esac + ;; + + interix[3-9]*) + # Interix 3.x gcc -fpic/-fPIC options generate broken code. + # Instead, we relocate shared libraries at runtime. + ;; + + msdosdjgpp*) + # Just because we use GCC doesn't mean we suddenly get shared libraries + # on systems that don't support them. + lt_prog_compiler_can_build_shared_F77=no + enable_shared=no + ;; + + *nto* | *qnx*) + # QNX uses GNU C++, but need to define -shared option too, otherwise + # it will coredump. + lt_prog_compiler_pic_F77='-fPIC -shared' + ;; + + sysv4*MP*) + if test -d /usr/nec; then + lt_prog_compiler_pic_F77=-Kconform_pic + fi + ;; + + *) + lt_prog_compiler_pic_F77='-fPIC' + ;; + esac + + case $cc_basename in + nvcc*) # Cuda Compiler Driver 2.2 + lt_prog_compiler_wl_F77='-Xlinker ' + if test -n "$lt_prog_compiler_pic_F77"; then + lt_prog_compiler_pic_F77="-Xcompiler $lt_prog_compiler_pic_F77" + fi + ;; + esac + else + # PORTME Check for flag to pass linker flags through the system compiler. + case $host_os in + aix*) + lt_prog_compiler_wl_F77='-Wl,' + if test ia64 = "$host_cpu"; then + # AIX 5 now supports IA64 processor + lt_prog_compiler_static_F77='-Bstatic' + else + lt_prog_compiler_static_F77='-bnso -bI:/lib/syscalls.exp' + fi + ;; + + darwin* | rhapsody*) + # PIC is the default on this platform + # Common symbols not allowed in MH_DYLIB files + lt_prog_compiler_pic_F77='-fno-common' + case $cc_basename in + nagfor*) + # NAG Fortran compiler + lt_prog_compiler_wl_F77='-Wl,-Wl,,' + lt_prog_compiler_pic_F77='-PIC' + lt_prog_compiler_static_F77='-Bstatic' + ;; + esac + ;; + + mingw* | cygwin* | pw32* | os2* | cegcc*) + # This hack is so that the source file can tell whether it is being + # built for inclusion in a dll (and should export symbols for example). + lt_prog_compiler_pic_F77='-DDLL_EXPORT' + case $host_os in + os2*) + lt_prog_compiler_static_F77='$wl-static' + ;; + esac + ;; + + hpux9* | hpux10* | hpux11*) + lt_prog_compiler_wl_F77='-Wl,' + # PIC is the default for IA64 HP-UX and 64-bit HP-UX, but + # not for PA HP-UX. + case $host_cpu in + hppa*64*|ia64*) + # +Z the default + ;; + *) + lt_prog_compiler_pic_F77='+Z' + ;; + esac + # Is there a better lt_prog_compiler_static that works with the bundled CC? + lt_prog_compiler_static_F77='$wl-a ${wl}archive' + ;; + + irix5* | irix6* | nonstopux*) + lt_prog_compiler_wl_F77='-Wl,' + # PIC (with -KPIC) is the default. + lt_prog_compiler_static_F77='-non_shared' + ;; + + linux* | k*bsd*-gnu | kopensolaris*-gnu | gnu*) + case $cc_basename in + # old Intel for x86_64, which still supported -KPIC. + ecc*) + lt_prog_compiler_wl_F77='-Wl,' + lt_prog_compiler_pic_F77='-KPIC' + lt_prog_compiler_static_F77='-static' + ;; + # icc used to be incompatible with GCC. + # ICC 10 doesn't accept -KPIC any more. + icc* | ifort*) + lt_prog_compiler_wl_F77='-Wl,' + lt_prog_compiler_pic_F77='-fPIC' + lt_prog_compiler_static_F77='-static' + ;; + # Lahey Fortran 8.1. + lf95*) + lt_prog_compiler_wl_F77='-Wl,' + lt_prog_compiler_pic_F77='--shared' + lt_prog_compiler_static_F77='--static' + ;; + nagfor*) + # NAG Fortran compiler + lt_prog_compiler_wl_F77='-Wl,-Wl,,' + lt_prog_compiler_pic_F77='-PIC' + lt_prog_compiler_static_F77='-Bstatic' + ;; + tcc*) + # Fabrice Bellard et al's Tiny C Compiler + lt_prog_compiler_wl_F77='-Wl,' + lt_prog_compiler_pic_F77='-fPIC' + lt_prog_compiler_static_F77='-static' + ;; + pgcc* | pgf77* | pgf90* | pgf95* | pgfortran*) + # Portland Group compilers (*not* the Pentium gcc compiler, + # which looks to be a dead project) + lt_prog_compiler_wl_F77='-Wl,' + lt_prog_compiler_pic_F77='-fpic' + lt_prog_compiler_static_F77='-Bstatic' + ;; + ccc*) + lt_prog_compiler_wl_F77='-Wl,' + # All Alpha code is PIC. + lt_prog_compiler_static_F77='-non_shared' + ;; + xl* | bgxl* | bgf* | mpixl*) + # IBM XL C 8.0/Fortran 10.1, 11.1 on PPC and BlueGene + lt_prog_compiler_wl_F77='-Wl,' + lt_prog_compiler_pic_F77='-qpic' + lt_prog_compiler_static_F77='-qstaticlink' + ;; + *) + case `$CC -V 2>&1 | sed 5q` in + *Sun\ Ceres\ Fortran* | *Sun*Fortran*\ [1-7].* | *Sun*Fortran*\ 8.[0-3]*) + # Sun Fortran 8.3 passes all unrecognized flags to the linker + lt_prog_compiler_pic_F77='-KPIC' + lt_prog_compiler_static_F77='-Bstatic' + lt_prog_compiler_wl_F77='' + ;; + *Sun\ F* | *Sun*Fortran*) + lt_prog_compiler_pic_F77='-KPIC' + lt_prog_compiler_static_F77='-Bstatic' + lt_prog_compiler_wl_F77='-Qoption ld ' + ;; + *Sun\ C*) + # Sun C 5.9 + lt_prog_compiler_pic_F77='-KPIC' + lt_prog_compiler_static_F77='-Bstatic' + lt_prog_compiler_wl_F77='-Wl,' + ;; + *Intel*\ [CF]*Compiler*) + lt_prog_compiler_wl_F77='-Wl,' + lt_prog_compiler_pic_F77='-fPIC' + lt_prog_compiler_static_F77='-static' + ;; + *Portland\ Group*) + lt_prog_compiler_wl_F77='-Wl,' + lt_prog_compiler_pic_F77='-fpic' + lt_prog_compiler_static_F77='-Bstatic' + ;; + esac + ;; + esac + ;; + + newsos6) + lt_prog_compiler_pic_F77='-KPIC' + lt_prog_compiler_static_F77='-Bstatic' + ;; + + *nto* | *qnx*) + # QNX uses GNU C++, but need to define -shared option too, otherwise + # it will coredump. + lt_prog_compiler_pic_F77='-fPIC -shared' + ;; + + osf3* | osf4* | osf5*) + lt_prog_compiler_wl_F77='-Wl,' + # All OSF/1 code is PIC. + lt_prog_compiler_static_F77='-non_shared' + ;; + + rdos*) + lt_prog_compiler_static_F77='-non_shared' + ;; + + solaris*) + lt_prog_compiler_pic_F77='-KPIC' + lt_prog_compiler_static_F77='-Bstatic' + case $cc_basename in + f77* | f90* | f95* | sunf77* | sunf90* | sunf95*) + lt_prog_compiler_wl_F77='-Qoption ld ';; + *) + lt_prog_compiler_wl_F77='-Wl,';; + esac + ;; + + sunos4*) + lt_prog_compiler_wl_F77='-Qoption ld ' + lt_prog_compiler_pic_F77='-PIC' + lt_prog_compiler_static_F77='-Bstatic' + ;; + + sysv4 | sysv4.2uw2* | sysv4.3*) + lt_prog_compiler_wl_F77='-Wl,' + lt_prog_compiler_pic_F77='-KPIC' + lt_prog_compiler_static_F77='-Bstatic' + ;; + + sysv4*MP*) + if test -d /usr/nec; then + lt_prog_compiler_pic_F77='-Kconform_pic' + lt_prog_compiler_static_F77='-Bstatic' + fi + ;; + + sysv5* | unixware* | sco3.2v5* | sco5v6* | OpenUNIX*) + lt_prog_compiler_wl_F77='-Wl,' + lt_prog_compiler_pic_F77='-KPIC' + lt_prog_compiler_static_F77='-Bstatic' + ;; + + unicos*) + lt_prog_compiler_wl_F77='-Wl,' + lt_prog_compiler_can_build_shared_F77=no + ;; + + uts4*) + lt_prog_compiler_pic_F77='-pic' + lt_prog_compiler_static_F77='-Bstatic' + ;; + + *) + lt_prog_compiler_can_build_shared_F77=no + ;; + esac + fi + +case $host_os in + # For platforms that do not support PIC, -DPIC is meaningless: + *djgpp*) + lt_prog_compiler_pic_F77= + ;; + *) + lt_prog_compiler_pic_F77="$lt_prog_compiler_pic_F77" + ;; +esac + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $compiler option to produce PIC" >&5 +$as_echo_n "checking for $compiler option to produce PIC... " >&6; } +if ${lt_cv_prog_compiler_pic_F77+:} false; then : + $as_echo_n "(cached) " >&6 +else + lt_cv_prog_compiler_pic_F77=$lt_prog_compiler_pic_F77 +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_prog_compiler_pic_F77" >&5 +$as_echo "$lt_cv_prog_compiler_pic_F77" >&6; } +lt_prog_compiler_pic_F77=$lt_cv_prog_compiler_pic_F77 + +# +# Check to make sure the PIC flag actually works. +# +if test -n "$lt_prog_compiler_pic_F77"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking if $compiler PIC flag $lt_prog_compiler_pic_F77 works" >&5 +$as_echo_n "checking if $compiler PIC flag $lt_prog_compiler_pic_F77 works... " >&6; } +if ${lt_cv_prog_compiler_pic_works_F77+:} false; then : + $as_echo_n "(cached) " >&6 +else + lt_cv_prog_compiler_pic_works_F77=no + ac_outfile=conftest.$ac_objext + echo "$lt_simple_compile_test_code" > conftest.$ac_ext + lt_compiler_flag="$lt_prog_compiler_pic_F77" ## exclude from sc_useless_quotes_in_assignment + # Insert the option either (1) after the last *FLAGS variable, or + # (2) before a word containing "conftest.", or (3) at the end. + # Note that $ac_compile itself does not contain backslashes and begins + # with a dollar sign (not a hyphen), so the echo should work correctly. + # The option is referenced via a variable to avoid confusing sed. + lt_compile=`echo "$ac_compile" | $SED \ + -e 's:.*FLAGS}\{0,1\} :&$lt_compiler_flag :; t' \ + -e 's: [^ ]*conftest\.: $lt_compiler_flag&:; t' \ + -e 's:$: $lt_compiler_flag:'` + (eval echo "\"\$as_me:$LINENO: $lt_compile\"" >&5) + (eval "$lt_compile" 2>conftest.err) + ac_status=$? + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + if (exit $ac_status) && test -s "$ac_outfile"; then + # The compiler can only warn and ignore the option if not recognized + # So say no if there are warnings other than the usual output. + $ECHO "$_lt_compiler_boilerplate" | $SED '/^$/d' >conftest.exp + $SED '/^$/d; /^ *+/d' conftest.err >conftest.er2 + if test ! -s conftest.er2 || diff conftest.exp conftest.er2 >/dev/null; then + lt_cv_prog_compiler_pic_works_F77=yes + fi + fi + $RM conftest* + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_prog_compiler_pic_works_F77" >&5 +$as_echo "$lt_cv_prog_compiler_pic_works_F77" >&6; } + +if test yes = "$lt_cv_prog_compiler_pic_works_F77"; then + case $lt_prog_compiler_pic_F77 in + "" | " "*) ;; + *) lt_prog_compiler_pic_F77=" $lt_prog_compiler_pic_F77" ;; + esac +else + lt_prog_compiler_pic_F77= + lt_prog_compiler_can_build_shared_F77=no +fi + +fi + + + + + +# +# Check to make sure the static flag actually works. +# +wl=$lt_prog_compiler_wl_F77 eval lt_tmp_static_flag=\"$lt_prog_compiler_static_F77\" +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking if $compiler static flag $lt_tmp_static_flag works" >&5 +$as_echo_n "checking if $compiler static flag $lt_tmp_static_flag works... " >&6; } +if ${lt_cv_prog_compiler_static_works_F77+:} false; then : + $as_echo_n "(cached) " >&6 +else + lt_cv_prog_compiler_static_works_F77=no + save_LDFLAGS=$LDFLAGS + LDFLAGS="$LDFLAGS $lt_tmp_static_flag" + echo "$lt_simple_link_test_code" > conftest.$ac_ext + if (eval $ac_link 2>conftest.err) && test -s conftest$ac_exeext; then + # The linker can only warn and ignore the option if not recognized + # So say no if there are warnings + if test -s conftest.err; then + # Append any errors to the config.log. + cat conftest.err 1>&5 + $ECHO "$_lt_linker_boilerplate" | $SED '/^$/d' > conftest.exp + $SED '/^$/d; /^ *+/d' conftest.err >conftest.er2 + if diff conftest.exp conftest.er2 >/dev/null; then + lt_cv_prog_compiler_static_works_F77=yes + fi + else + lt_cv_prog_compiler_static_works_F77=yes + fi + fi + $RM -r conftest* + LDFLAGS=$save_LDFLAGS + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_prog_compiler_static_works_F77" >&5 +$as_echo "$lt_cv_prog_compiler_static_works_F77" >&6; } + +if test yes = "$lt_cv_prog_compiler_static_works_F77"; then + : +else + lt_prog_compiler_static_F77= +fi + + + + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking if $compiler supports -c -o file.$ac_objext" >&5 +$as_echo_n "checking if $compiler supports -c -o file.$ac_objext... " >&6; } +if ${lt_cv_prog_compiler_c_o_F77+:} false; then : + $as_echo_n "(cached) " >&6 +else + lt_cv_prog_compiler_c_o_F77=no + $RM -r conftest 2>/dev/null + mkdir conftest + cd conftest + mkdir out + echo "$lt_simple_compile_test_code" > conftest.$ac_ext + + lt_compiler_flag="-o out/conftest2.$ac_objext" + # Insert the option either (1) after the last *FLAGS variable, or + # (2) before a word containing "conftest.", or (3) at the end. + # Note that $ac_compile itself does not contain backslashes and begins + # with a dollar sign (not a hyphen), so the echo should work correctly. + lt_compile=`echo "$ac_compile" | $SED \ + -e 's:.*FLAGS}\{0,1\} :&$lt_compiler_flag :; t' \ + -e 's: [^ ]*conftest\.: $lt_compiler_flag&:; t' \ + -e 's:$: $lt_compiler_flag:'` + (eval echo "\"\$as_me:$LINENO: $lt_compile\"" >&5) + (eval "$lt_compile" 2>out/conftest.err) + ac_status=$? + cat out/conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + if (exit $ac_status) && test -s out/conftest2.$ac_objext + then + # The compiler can only warn and ignore the option if not recognized + # So say no if there are warnings + $ECHO "$_lt_compiler_boilerplate" | $SED '/^$/d' > out/conftest.exp + $SED '/^$/d; /^ *+/d' out/conftest.err >out/conftest.er2 + if test ! -s out/conftest.er2 || diff out/conftest.exp out/conftest.er2 >/dev/null; then + lt_cv_prog_compiler_c_o_F77=yes + fi + fi + chmod u+w . 2>&5 + $RM conftest* + # SGI C++ compiler will create directory out/ii_files/ for + # template instantiation + test -d out/ii_files && $RM out/ii_files/* && rmdir out/ii_files + $RM out/* && rmdir out + cd .. + $RM -r conftest + $RM conftest* + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_prog_compiler_c_o_F77" >&5 +$as_echo "$lt_cv_prog_compiler_c_o_F77" >&6; } + + + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking if $compiler supports -c -o file.$ac_objext" >&5 +$as_echo_n "checking if $compiler supports -c -o file.$ac_objext... " >&6; } +if ${lt_cv_prog_compiler_c_o_F77+:} false; then : + $as_echo_n "(cached) " >&6 +else + lt_cv_prog_compiler_c_o_F77=no + $RM -r conftest 2>/dev/null + mkdir conftest + cd conftest + mkdir out + echo "$lt_simple_compile_test_code" > conftest.$ac_ext + + lt_compiler_flag="-o out/conftest2.$ac_objext" + # Insert the option either (1) after the last *FLAGS variable, or + # (2) before a word containing "conftest.", or (3) at the end. + # Note that $ac_compile itself does not contain backslashes and begins + # with a dollar sign (not a hyphen), so the echo should work correctly. + lt_compile=`echo "$ac_compile" | $SED \ + -e 's:.*FLAGS}\{0,1\} :&$lt_compiler_flag :; t' \ + -e 's: [^ ]*conftest\.: $lt_compiler_flag&:; t' \ + -e 's:$: $lt_compiler_flag:'` + (eval echo "\"\$as_me:$LINENO: $lt_compile\"" >&5) + (eval "$lt_compile" 2>out/conftest.err) + ac_status=$? + cat out/conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + if (exit $ac_status) && test -s out/conftest2.$ac_objext + then + # The compiler can only warn and ignore the option if not recognized + # So say no if there are warnings + $ECHO "$_lt_compiler_boilerplate" | $SED '/^$/d' > out/conftest.exp + $SED '/^$/d; /^ *+/d' out/conftest.err >out/conftest.er2 + if test ! -s out/conftest.er2 || diff out/conftest.exp out/conftest.er2 >/dev/null; then + lt_cv_prog_compiler_c_o_F77=yes + fi + fi + chmod u+w . 2>&5 + $RM conftest* + # SGI C++ compiler will create directory out/ii_files/ for + # template instantiation + test -d out/ii_files && $RM out/ii_files/* && rmdir out/ii_files + $RM out/* && rmdir out + cd .. + $RM -r conftest + $RM conftest* + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_prog_compiler_c_o_F77" >&5 +$as_echo "$lt_cv_prog_compiler_c_o_F77" >&6; } + + + + +hard_links=nottested +if test no = "$lt_cv_prog_compiler_c_o_F77" && test no != "$need_locks"; then + # do not overwrite the value of need_locks provided by the user + { $as_echo "$as_me:${as_lineno-$LINENO}: checking if we can lock with hard links" >&5 +$as_echo_n "checking if we can lock with hard links... " >&6; } + hard_links=yes + $RM conftest* + ln conftest.a conftest.b 2>/dev/null && hard_links=no + touch conftest.a + ln conftest.a conftest.b 2>&5 || hard_links=no + ln conftest.a conftest.b 2>/dev/null && hard_links=no + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $hard_links" >&5 +$as_echo "$hard_links" >&6; } + if test no = "$hard_links"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: '$CC' does not support '-c -o', so 'make -j' may be unsafe" >&5 +$as_echo "$as_me: WARNING: '$CC' does not support '-c -o', so 'make -j' may be unsafe" >&2;} + need_locks=warn + fi +else + need_locks=no +fi + + + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether the $compiler linker ($LD) supports shared libraries" >&5 +$as_echo_n "checking whether the $compiler linker ($LD) supports shared libraries... " >&6; } + + runpath_var= + allow_undefined_flag_F77= + always_export_symbols_F77=no + archive_cmds_F77= + archive_expsym_cmds_F77= + compiler_needs_object_F77=no + enable_shared_with_static_runtimes_F77=no + export_dynamic_flag_spec_F77= + export_symbols_cmds_F77='$NM $libobjs $convenience | $global_symbol_pipe | $SED '\''s/.* //'\'' | sort | uniq > $export_symbols' + hardcode_automatic_F77=no + hardcode_direct_F77=no + hardcode_direct_absolute_F77=no + hardcode_libdir_flag_spec_F77= + hardcode_libdir_separator_F77= + hardcode_minus_L_F77=no + hardcode_shlibpath_var_F77=unsupported + inherit_rpath_F77=no + link_all_deplibs_F77=unknown + module_cmds_F77= + module_expsym_cmds_F77= + old_archive_from_new_cmds_F77= + old_archive_from_expsyms_cmds_F77= + thread_safe_flag_spec_F77= + whole_archive_flag_spec_F77= + # include_expsyms should be a list of space-separated symbols to be *always* + # included in the symbol list + include_expsyms_F77= + # exclude_expsyms can be an extended regexp of symbols to exclude + # it will be wrapped by ' (' and ')$', so one must not match beginning or + # end of line. Example: 'a|bc|.*d.*' will exclude the symbols 'a' and 'bc', + # as well as any symbol that contains 'd'. + exclude_expsyms_F77='_GLOBAL_OFFSET_TABLE_|_GLOBAL__F[ID]_.*' + # Although _GLOBAL_OFFSET_TABLE_ is a valid symbol C name, most a.out + # platforms (ab)use it in PIC code, but their linkers get confused if + # the symbol is explicitly referenced. Since portable code cannot + # rely on this symbol name, it's probably fine to never include it in + # preloaded symbol tables. + # Exclude shared library initialization/finalization symbols. + extract_expsyms_cmds= + + case $host_os in + cygwin* | mingw* | pw32* | cegcc*) + # FIXME: the MSVC++ port hasn't been tested in a loooong time + # When not using gcc, we currently assume that we are using + # Microsoft Visual C++. + if test yes != "$GCC"; then + with_gnu_ld=no + fi + ;; + interix*) + # we just hope/assume this is gcc and not c89 (= MSVC++) + with_gnu_ld=yes + ;; + openbsd* | bitrig*) + with_gnu_ld=no + ;; + esac + + ld_shlibs_F77=yes + + # On some targets, GNU ld is compatible enough with the native linker + # that we're better off using the native interface for both. + lt_use_gnu_ld_interface=no + if test yes = "$with_gnu_ld"; then + case $host_os in + aix*) + # The AIX port of GNU ld has always aspired to compatibility + # with the native linker. However, as the warning in the GNU ld + # block says, versions before 2.19.5* couldn't really create working + # shared libraries, regardless of the interface used. + case `$LD -v 2>&1` in + *\ \(GNU\ Binutils\)\ 2.19.5*) ;; + *\ \(GNU\ Binutils\)\ 2.[2-9]*) ;; + *\ \(GNU\ Binutils\)\ [3-9]*) ;; + *) + lt_use_gnu_ld_interface=yes + ;; + esac + ;; + *) + lt_use_gnu_ld_interface=yes + ;; + esac + fi + + if test yes = "$lt_use_gnu_ld_interface"; then + # If archive_cmds runs LD, not CC, wlarc should be empty + wlarc='$wl' + + # Set some defaults for GNU ld with shared library support. These + # are reset later if shared libraries are not supported. Putting them + # here allows them to be overridden if necessary. + runpath_var=LD_RUN_PATH + hardcode_libdir_flag_spec_F77='$wl-rpath $wl$libdir' + export_dynamic_flag_spec_F77='$wl--export-dynamic' + # ancient GNU ld didn't support --whole-archive et. al. + if $LD --help 2>&1 | $GREP 'no-whole-archive' > /dev/null; then + whole_archive_flag_spec_F77=$wlarc'--whole-archive$convenience '$wlarc'--no-whole-archive' + else + whole_archive_flag_spec_F77= + fi + supports_anon_versioning=no + case `$LD -v | $SED -e 's/(^)\+)\s\+//' 2>&1` in + *GNU\ gold*) supports_anon_versioning=yes ;; + *\ [01].* | *\ 2.[0-9].* | *\ 2.10.*) ;; # catch versions < 2.11 + *\ 2.11.93.0.2\ *) supports_anon_versioning=yes ;; # RH7.3 ... + *\ 2.11.92.0.12\ *) supports_anon_versioning=yes ;; # Mandrake 8.2 ... + *\ 2.11.*) ;; # other 2.11 versions + *) supports_anon_versioning=yes ;; + esac + + # See if GNU ld supports shared libraries. + case $host_os in + aix[3-9]*) + # On AIX/PPC, the GNU linker is very broken + if test ia64 != "$host_cpu"; then + ld_shlibs_F77=no + cat <<_LT_EOF 1>&2 + +*** Warning: the GNU linker, at least up to release 2.19, is reported +*** to be unable to reliably create shared libraries on AIX. +*** Therefore, libtool is disabling shared libraries support. If you +*** really care for shared libraries, you may want to install binutils +*** 2.20 or above, or modify your PATH so that a non-GNU linker is found. +*** You will then need to restart the configuration process. + +_LT_EOF + fi + ;; + + amigaos*) + case $host_cpu in + powerpc) + # see comment about AmigaOS4 .so support + archive_cmds_F77='$CC -shared $libobjs $deplibs $compiler_flags $wl-soname $wl$soname -o $lib' + archive_expsym_cmds_F77='' + ;; + m68k) + archive_cmds_F77='$RM $output_objdir/a2ixlibrary.data~$ECHO "#define NAME $libname" > $output_objdir/a2ixlibrary.data~$ECHO "#define LIBRARY_ID 1" >> $output_objdir/a2ixlibrary.data~$ECHO "#define VERSION $major" >> $output_objdir/a2ixlibrary.data~$ECHO "#define REVISION $revision" >> $output_objdir/a2ixlibrary.data~$AR $AR_FLAGS $lib $libobjs~$RANLIB $lib~(cd $output_objdir && a2ixlibrary -32)' + hardcode_libdir_flag_spec_F77='-L$libdir' + hardcode_minus_L_F77=yes + ;; + esac + ;; + + beos*) + if $LD --help 2>&1 | $GREP ': supported targets:.* elf' > /dev/null; then + allow_undefined_flag_F77=unsupported + # Joseph Beckenbach <jrb3@best.com> says some releases of gcc + # support --undefined. This deserves some investigation. FIXME + archive_cmds_F77='$CC -nostart $libobjs $deplibs $compiler_flags $wl-soname $wl$soname -o $lib' + else + ld_shlibs_F77=no + fi + ;; + + cygwin* | mingw* | pw32* | cegcc*) + # _LT_TAGVAR(hardcode_libdir_flag_spec, F77) is actually meaningless, + # as there is no search path for DLLs. + hardcode_libdir_flag_spec_F77='-L$libdir' + export_dynamic_flag_spec_F77='$wl--export-all-symbols' + allow_undefined_flag_F77=unsupported + always_export_symbols_F77=no + enable_shared_with_static_runtimes_F77=yes + export_symbols_cmds_F77='$NM $libobjs $convenience | $global_symbol_pipe | $SED -e '\''/^[BCDGRS][ ]/s/.*[ ]\([^ ]*\)/\1 DATA/;s/^.*[ ]__nm__\([^ ]*\)[ ][^ ]*/\1 DATA/;/^I[ ]/d;/^[AITW][ ]/s/.* //'\'' | sort | uniq > $export_symbols' + exclude_expsyms_F77='[_]+GLOBAL_OFFSET_TABLE_|[_]+GLOBAL__[FID]_.*|[_]+head_[A-Za-z0-9_]+_dll|[A-Za-z0-9_]+_dll_iname' + + if $LD --help 2>&1 | $GREP 'auto-import' > /dev/null; then + archive_cmds_F77='$CC -shared $libobjs $deplibs $compiler_flags -o $output_objdir/$soname $wl--enable-auto-image-base -Xlinker --out-implib -Xlinker $lib' + # If the export-symbols file already is a .def file, use it as + # is; otherwise, prepend EXPORTS... + archive_expsym_cmds_F77='if test DEF = "`$SED -n -e '\''s/^[ ]*//'\'' -e '\''/^\(;.*\)*$/d'\'' -e '\''s/^\(EXPORTS\|LIBRARY\)\([ ].*\)*$/DEF/p'\'' -e q $export_symbols`" ; then + cp $export_symbols $output_objdir/$soname.def; + else + echo EXPORTS > $output_objdir/$soname.def; + cat $export_symbols >> $output_objdir/$soname.def; + fi~ + $CC -shared $output_objdir/$soname.def $libobjs $deplibs $compiler_flags -o $output_objdir/$soname $wl--enable-auto-image-base -Xlinker --out-implib -Xlinker $lib' + else + ld_shlibs_F77=no + fi + ;; + + haiku*) + archive_cmds_F77='$CC -shared $libobjs $deplibs $compiler_flags $wl-soname $wl$soname -o $lib' + link_all_deplibs_F77=yes + ;; + + os2*) + hardcode_libdir_flag_spec_F77='-L$libdir' + hardcode_minus_L_F77=yes + allow_undefined_flag_F77=unsupported + shrext_cmds=.dll + archive_cmds_F77='$ECHO "LIBRARY ${soname%$shared_ext} INITINSTANCE TERMINSTANCE" > $output_objdir/$libname.def~ + $ECHO "DESCRIPTION \"$libname\"" >> $output_objdir/$libname.def~ + $ECHO "DATA MULTIPLE NONSHARED" >> $output_objdir/$libname.def~ + $ECHO EXPORTS >> $output_objdir/$libname.def~ + emxexp $libobjs | $SED /"_DLL_InitTerm"/d >> $output_objdir/$libname.def~ + $CC -Zdll -Zcrtdll -o $output_objdir/$soname $libobjs $deplibs $compiler_flags $output_objdir/$libname.def~ + emximp -o $lib $output_objdir/$libname.def' + archive_expsym_cmds_F77='$ECHO "LIBRARY ${soname%$shared_ext} INITINSTANCE TERMINSTANCE" > $output_objdir/$libname.def~ + $ECHO "DESCRIPTION \"$libname\"" >> $output_objdir/$libname.def~ + $ECHO "DATA MULTIPLE NONSHARED" >> $output_objdir/$libname.def~ + $ECHO EXPORTS >> $output_objdir/$libname.def~ + prefix_cmds="$SED"~ + if test EXPORTS = "`$SED 1q $export_symbols`"; then + prefix_cmds="$prefix_cmds -e 1d"; + fi~ + prefix_cmds="$prefix_cmds -e \"s/^\(.*\)$/_\1/g\""~ + cat $export_symbols | $prefix_cmds >> $output_objdir/$libname.def~ + $CC -Zdll -Zcrtdll -o $output_objdir/$soname $libobjs $deplibs $compiler_flags $output_objdir/$libname.def~ + emximp -o $lib $output_objdir/$libname.def' + old_archive_From_new_cmds_F77='emximp -o $output_objdir/${libname}_dll.a $output_objdir/$libname.def' + enable_shared_with_static_runtimes_F77=yes + ;; + + interix[3-9]*) + hardcode_direct_F77=no + hardcode_shlibpath_var_F77=no + hardcode_libdir_flag_spec_F77='$wl-rpath,$libdir' + export_dynamic_flag_spec_F77='$wl-E' + # Hack: On Interix 3.x, we cannot compile PIC because of a broken gcc. + # Instead, shared libraries are loaded at an image base (0x10000000 by + # default) and relocated if they conflict, which is a slow very memory + # consuming and fragmenting process. To avoid this, we pick a random, + # 256 KiB-aligned image base between 0x50000000 and 0x6FFC0000 at link + # time. Moving up from 0x10000000 also allows more sbrk(2) space. + archive_cmds_F77='$CC -shared $pic_flag $libobjs $deplibs $compiler_flags $wl-h,$soname $wl--image-base,`expr ${RANDOM-$$} % 4096 / 2 \* 262144 + 1342177280` -o $lib' + archive_expsym_cmds_F77='sed "s|^|_|" $export_symbols >$output_objdir/$soname.expsym~$CC -shared $pic_flag $libobjs $deplibs $compiler_flags $wl-h,$soname $wl--retain-symbols-file,$output_objdir/$soname.expsym $wl--image-base,`expr ${RANDOM-$$} % 4096 / 2 \* 262144 + 1342177280` -o $lib' + ;; + + gnu* | linux* | tpf* | k*bsd*-gnu | kopensolaris*-gnu) + tmp_diet=no + if test linux-dietlibc = "$host_os"; then + case $cc_basename in + diet\ *) tmp_diet=yes;; # linux-dietlibc with static linking (!diet-dyn) + esac + fi + if $LD --help 2>&1 | $EGREP ': supported targets:.* elf' > /dev/null \ + && test no = "$tmp_diet" + then + tmp_addflag=' $pic_flag' + tmp_sharedflag='-shared' + case $cc_basename,$host_cpu in + pgcc*) # Portland Group C compiler + whole_archive_flag_spec_F77='$wl--whole-archive`for conv in $convenience\"\"; do test -n \"$conv\" && new_convenience=\"$new_convenience,$conv\"; done; func_echo_all \"$new_convenience\"` $wl--no-whole-archive' + tmp_addflag=' $pic_flag' + ;; + pgf77* | pgf90* | pgf95* | pgfortran*) + # Portland Group f77 and f90 compilers + whole_archive_flag_spec_F77='$wl--whole-archive`for conv in $convenience\"\"; do test -n \"$conv\" && new_convenience=\"$new_convenience,$conv\"; done; func_echo_all \"$new_convenience\"` $wl--no-whole-archive' + tmp_addflag=' $pic_flag -Mnomain' ;; + ecc*,ia64* | icc*,ia64*) # Intel C compiler on ia64 + tmp_addflag=' -i_dynamic' ;; + efc*,ia64* | ifort*,ia64*) # Intel Fortran compiler on ia64 + tmp_addflag=' -i_dynamic -nofor_main' ;; + ifc* | ifort*) # Intel Fortran compiler + tmp_addflag=' -nofor_main' ;; + lf95*) # Lahey Fortran 8.1 + whole_archive_flag_spec_F77= + tmp_sharedflag='--shared' ;; + nagfor*) # NAGFOR 5.3 + tmp_sharedflag='-Wl,-shared' ;; + xl[cC]* | bgxl[cC]* | mpixl[cC]*) # IBM XL C 8.0 on PPC (deal with xlf below) + tmp_sharedflag='-qmkshrobj' + tmp_addflag= ;; + nvcc*) # Cuda Compiler Driver 2.2 + whole_archive_flag_spec_F77='$wl--whole-archive`for conv in $convenience\"\"; do test -n \"$conv\" && new_convenience=\"$new_convenience,$conv\"; done; func_echo_all \"$new_convenience\"` $wl--no-whole-archive' + compiler_needs_object_F77=yes + ;; + esac + case `$CC -V 2>&1 | sed 5q` in + *Sun\ C*) # Sun C 5.9 + whole_archive_flag_spec_F77='$wl--whole-archive`new_convenience=; for conv in $convenience\"\"; do test -z \"$conv\" || new_convenience=\"$new_convenience,$conv\"; done; func_echo_all \"$new_convenience\"` $wl--no-whole-archive' + compiler_needs_object_F77=yes + tmp_sharedflag='-G' ;; + *Sun\ F*) # Sun Fortran 8.3 + tmp_sharedflag='-G' ;; + esac + archive_cmds_F77='$CC '"$tmp_sharedflag""$tmp_addflag"' $libobjs $deplibs $compiler_flags $wl-soname $wl$soname -o $lib' + + if test yes = "$supports_anon_versioning"; then + archive_expsym_cmds_F77='echo "{ global:" > $output_objdir/$libname.ver~ + cat $export_symbols | sed -e "s/\(.*\)/\1;/" >> $output_objdir/$libname.ver~ + echo "local: *; };" >> $output_objdir/$libname.ver~ + $CC '"$tmp_sharedflag""$tmp_addflag"' $libobjs $deplibs $compiler_flags $wl-soname $wl$soname $wl-version-script $wl$output_objdir/$libname.ver -o $lib' + fi + + case $cc_basename in + tcc*) + export_dynamic_flag_spec_F77='-rdynamic' + ;; + xlf* | bgf* | bgxlf* | mpixlf*) + # IBM XL Fortran 10.1 on PPC cannot create shared libs itself + whole_archive_flag_spec_F77='--whole-archive$convenience --no-whole-archive' + hardcode_libdir_flag_spec_F77='$wl-rpath $wl$libdir' + archive_cmds_F77='$LD -shared $libobjs $deplibs $linker_flags -soname $soname -o $lib' + if test yes = "$supports_anon_versioning"; then + archive_expsym_cmds_F77='echo "{ global:" > $output_objdir/$libname.ver~ + cat $export_symbols | sed -e "s/\(.*\)/\1;/" >> $output_objdir/$libname.ver~ + echo "local: *; };" >> $output_objdir/$libname.ver~ + $LD -shared $libobjs $deplibs $linker_flags -soname $soname -version-script $output_objdir/$libname.ver -o $lib' + fi + ;; + esac + else + ld_shlibs_F77=no + fi + ;; + + netbsd*) + if echo __ELF__ | $CC -E - | $GREP __ELF__ >/dev/null; then + archive_cmds_F77='$LD -Bshareable $libobjs $deplibs $linker_flags -o $lib' + wlarc= + else + archive_cmds_F77='$CC -shared $pic_flag $libobjs $deplibs $compiler_flags $wl-soname $wl$soname -o $lib' + archive_expsym_cmds_F77='$CC -shared $pic_flag $libobjs $deplibs $compiler_flags $wl-soname $wl$soname $wl-retain-symbols-file $wl$export_symbols -o $lib' + fi + ;; + + solaris*) + if $LD -v 2>&1 | $GREP 'BFD 2\.8' > /dev/null; then + ld_shlibs_F77=no + cat <<_LT_EOF 1>&2 + +*** Warning: The releases 2.8.* of the GNU linker cannot reliably +*** create shared libraries on Solaris systems. Therefore, libtool +*** is disabling shared libraries support. We urge you to upgrade GNU +*** binutils to release 2.9.1 or newer. Another option is to modify +*** your PATH or compiler configuration so that the native linker is +*** used, and then restart. + +_LT_EOF + elif $LD --help 2>&1 | $GREP ': supported targets:.* elf' > /dev/null; then + archive_cmds_F77='$CC -shared $pic_flag $libobjs $deplibs $compiler_flags $wl-soname $wl$soname -o $lib' + archive_expsym_cmds_F77='$CC -shared $pic_flag $libobjs $deplibs $compiler_flags $wl-soname $wl$soname $wl-retain-symbols-file $wl$export_symbols -o $lib' + else + ld_shlibs_F77=no + fi + ;; + + sysv5* | sco3.2v5* | sco5v6* | unixware* | OpenUNIX*) + case `$LD -v 2>&1` in + *\ [01].* | *\ 2.[0-9].* | *\ 2.1[0-5].*) + ld_shlibs_F77=no + cat <<_LT_EOF 1>&2 + +*** Warning: Releases of the GNU linker prior to 2.16.91.0.3 cannot +*** reliably create shared libraries on SCO systems. Therefore, libtool +*** is disabling shared libraries support. We urge you to upgrade GNU +*** binutils to release 2.16.91.0.3 or newer. Another option is to modify +*** your PATH or compiler configuration so that the native linker is +*** used, and then restart. + +_LT_EOF + ;; + *) + # For security reasons, it is highly recommended that you always + # use absolute paths for naming shared libraries, and exclude the + # DT_RUNPATH tag from executables and libraries. But doing so + # requires that you compile everything twice, which is a pain. + if $LD --help 2>&1 | $GREP ': supported targets:.* elf' > /dev/null; then + hardcode_libdir_flag_spec_F77='$wl-rpath $wl$libdir' + archive_cmds_F77='$CC -shared $libobjs $deplibs $compiler_flags $wl-soname $wl$soname -o $lib' + archive_expsym_cmds_F77='$CC -shared $libobjs $deplibs $compiler_flags $wl-soname $wl$soname $wl-retain-symbols-file $wl$export_symbols -o $lib' + else + ld_shlibs_F77=no + fi + ;; + esac + ;; + + sunos4*) + archive_cmds_F77='$LD -assert pure-text -Bshareable -o $lib $libobjs $deplibs $linker_flags' + wlarc= + hardcode_direct_F77=yes + hardcode_shlibpath_var_F77=no + ;; + + *) + if $LD --help 2>&1 | $GREP ': supported targets:.* elf' > /dev/null; then + archive_cmds_F77='$CC -shared $pic_flag $libobjs $deplibs $compiler_flags $wl-soname $wl$soname -o $lib' + archive_expsym_cmds_F77='$CC -shared $pic_flag $libobjs $deplibs $compiler_flags $wl-soname $wl$soname $wl-retain-symbols-file $wl$export_symbols -o $lib' + else + ld_shlibs_F77=no + fi + ;; + esac + + if test no = "$ld_shlibs_F77"; then + runpath_var= + hardcode_libdir_flag_spec_F77= + export_dynamic_flag_spec_F77= + whole_archive_flag_spec_F77= + fi + else + # PORTME fill in a description of your system's linker (not GNU ld) + case $host_os in + aix3*) + allow_undefined_flag_F77=unsupported + always_export_symbols_F77=yes + archive_expsym_cmds_F77='$LD -o $output_objdir/$soname $libobjs $deplibs $linker_flags -bE:$export_symbols -T512 -H512 -bM:SRE~$AR $AR_FLAGS $lib $output_objdir/$soname' + # Note: this linker hardcodes the directories in LIBPATH if there + # are no directories specified by -L. + hardcode_minus_L_F77=yes + if test yes = "$GCC" && test -z "$lt_prog_compiler_static"; then + # Neither direct hardcoding nor static linking is supported with a + # broken collect2. + hardcode_direct_F77=unsupported + fi + ;; + + aix[4-9]*) + if test ia64 = "$host_cpu"; then + # On IA64, the linker does run time linking by default, so we don't + # have to do anything special. + aix_use_runtimelinking=no + exp_sym_flag='-Bexport' + no_entry_flag= + else + # If we're using GNU nm, then we don't want the "-C" option. + # -C means demangle to GNU nm, but means don't demangle to AIX nm. + # Without the "-l" option, or with the "-B" option, AIX nm treats + # weak defined symbols like other global defined symbols, whereas + # GNU nm marks them as "W". + # While the 'weak' keyword is ignored in the Export File, we need + # it in the Import File for the 'aix-soname' feature, so we have + # to replace the "-B" option with "-P" for AIX nm. + if $NM -V 2>&1 | $GREP 'GNU' > /dev/null; then + export_symbols_cmds_F77='$NM -Bpg $libobjs $convenience | awk '\''{ if (((\$ 2 == "T") || (\$ 2 == "D") || (\$ 2 == "B") || (\$ 2 == "W")) && (substr(\$ 3,1,1) != ".")) { if (\$ 2 == "W") { print \$ 3 " weak" } else { print \$ 3 } } }'\'' | sort -u > $export_symbols' + else + export_symbols_cmds_F77='`func_echo_all $NM | $SED -e '\''s/B\([^B]*\)$/P\1/'\''` -PCpgl $libobjs $convenience | awk '\''{ if (((\$ 2 == "T") || (\$ 2 == "D") || (\$ 2 == "B") || (\$ 2 == "W") || (\$ 2 == "V") || (\$ 2 == "Z")) && (substr(\$ 1,1,1) != ".")) { if ((\$ 2 == "W") || (\$ 2 == "V") || (\$ 2 == "Z")) { print \$ 1 " weak" } else { print \$ 1 } } }'\'' | sort -u > $export_symbols' + fi + aix_use_runtimelinking=no + + # Test if we are trying to use run time linking or normal + # AIX style linking. If -brtl is somewhere in LDFLAGS, we + # have runtime linking enabled, and use it for executables. + # For shared libraries, we enable/disable runtime linking + # depending on the kind of the shared library created - + # when "with_aix_soname,aix_use_runtimelinking" is: + # "aix,no" lib.a(lib.so.V) shared, rtl:no, for executables + # "aix,yes" lib.so shared, rtl:yes, for executables + # lib.a static archive + # "both,no" lib.so.V(shr.o) shared, rtl:yes + # lib.a(lib.so.V) shared, rtl:no, for executables + # "both,yes" lib.so.V(shr.o) shared, rtl:yes, for executables + # lib.a(lib.so.V) shared, rtl:no + # "svr4,*" lib.so.V(shr.o) shared, rtl:yes, for executables + # lib.a static archive + case $host_os in aix4.[23]|aix4.[23].*|aix[5-9]*) + for ld_flag in $LDFLAGS; do + if (test x-brtl = "x$ld_flag" || test x-Wl,-brtl = "x$ld_flag"); then + aix_use_runtimelinking=yes + break + fi + done + if test svr4,no = "$with_aix_soname,$aix_use_runtimelinking"; then + # With aix-soname=svr4, we create the lib.so.V shared archives only, + # so we don't have lib.a shared libs to link our executables. + # We have to force runtime linking in this case. + aix_use_runtimelinking=yes + LDFLAGS="$LDFLAGS -Wl,-brtl" + fi + ;; + esac + + exp_sym_flag='-bexport' + no_entry_flag='-bnoentry' + fi + + # When large executables or shared objects are built, AIX ld can + # have problems creating the table of contents. If linking a library + # or program results in "error TOC overflow" add -mminimal-toc to + # CXXFLAGS/CFLAGS for g++/gcc. In the cases where that is not + # enough to fix the problem, add -Wl,-bbigtoc to LDFLAGS. + + archive_cmds_F77='' + hardcode_direct_F77=yes + hardcode_direct_absolute_F77=yes + hardcode_libdir_separator_F77=':' + link_all_deplibs_F77=yes + file_list_spec_F77='$wl-f,' + case $with_aix_soname,$aix_use_runtimelinking in + aix,*) ;; # traditional, no import file + svr4,* | *,yes) # use import file + # The Import File defines what to hardcode. + hardcode_direct_F77=no + hardcode_direct_absolute_F77=no + ;; + esac + + if test yes = "$GCC"; then + case $host_os in aix4.[012]|aix4.[012].*) + # We only want to do this on AIX 4.2 and lower, the check + # below for broken collect2 doesn't work under 4.3+ + collect2name=`$CC -print-prog-name=collect2` + if test -f "$collect2name" && + strings "$collect2name" | $GREP resolve_lib_name >/dev/null + then + # We have reworked collect2 + : + else + # We have old collect2 + hardcode_direct_F77=unsupported + # It fails to find uninstalled libraries when the uninstalled + # path is not listed in the libpath. Setting hardcode_minus_L + # to unsupported forces relinking + hardcode_minus_L_F77=yes + hardcode_libdir_flag_spec_F77='-L$libdir' + hardcode_libdir_separator_F77= + fi + ;; + esac + shared_flag='-shared' + if test yes = "$aix_use_runtimelinking"; then + shared_flag="$shared_flag "'$wl-G' + fi + # Need to ensure runtime linking is disabled for the traditional + # shared library, or the linker may eventually find shared libraries + # /with/ Import File - we do not want to mix them. + shared_flag_aix='-shared' + shared_flag_svr4='-shared $wl-G' + else + # not using gcc + if test ia64 = "$host_cpu"; then + # VisualAge C++, Version 5.5 for AIX 5L for IA-64, Beta 3 Release + # chokes on -Wl,-G. The following line is correct: + shared_flag='-G' + else + if test yes = "$aix_use_runtimelinking"; then + shared_flag='$wl-G' + else + shared_flag='$wl-bM:SRE' + fi + shared_flag_aix='$wl-bM:SRE' + shared_flag_svr4='$wl-G' + fi + fi + + export_dynamic_flag_spec_F77='$wl-bexpall' + # It seems that -bexpall does not export symbols beginning with + # underscore (_), so it is better to generate a list of symbols to export. + always_export_symbols_F77=yes + if test aix,yes = "$with_aix_soname,$aix_use_runtimelinking"; then + # Warning - without using the other runtime loading flags (-brtl), + # -berok will link without error, but may produce a broken library. + allow_undefined_flag_F77='-berok' + # Determine the default libpath from the value encoded in an + # empty executable. + if test set = "${lt_cv_aix_libpath+set}"; then + aix_libpath=$lt_cv_aix_libpath +else + if ${lt_cv_aix_libpath__F77+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat > conftest.$ac_ext <<_ACEOF + program main + + end +_ACEOF +if ac_fn_f77_try_link "$LINENO"; then : + + lt_aix_libpath_sed=' + /Import File Strings/,/^$/ { + /^0/ { + s/^0 *\([^ ]*\) *$/\1/ + p + } + }' + lt_cv_aix_libpath__F77=`dump -H conftest$ac_exeext 2>/dev/null | $SED -n -e "$lt_aix_libpath_sed"` + # Check for a 64-bit object if we didn't find anything. + if test -z "$lt_cv_aix_libpath__F77"; then + lt_cv_aix_libpath__F77=`dump -HX64 conftest$ac_exeext 2>/dev/null | $SED -n -e "$lt_aix_libpath_sed"` + fi +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + if test -z "$lt_cv_aix_libpath__F77"; then + lt_cv_aix_libpath__F77=/usr/lib:/lib + fi + +fi + + aix_libpath=$lt_cv_aix_libpath__F77 +fi + + hardcode_libdir_flag_spec_F77='$wl-blibpath:$libdir:'"$aix_libpath" + archive_expsym_cmds_F77='$CC -o $output_objdir/$soname $libobjs $deplibs $wl'$no_entry_flag' $compiler_flags `if test -n "$allow_undefined_flag"; then func_echo_all "$wl$allow_undefined_flag"; else :; fi` $wl'$exp_sym_flag:\$export_symbols' '$shared_flag + else + if test ia64 = "$host_cpu"; then + hardcode_libdir_flag_spec_F77='$wl-R $libdir:/usr/lib:/lib' + allow_undefined_flag_F77="-z nodefs" + archive_expsym_cmds_F77="\$CC $shared_flag"' -o $output_objdir/$soname $libobjs $deplibs '"\$wl$no_entry_flag"' $compiler_flags $wl$allow_undefined_flag '"\$wl$exp_sym_flag:\$export_symbols" + else + # Determine the default libpath from the value encoded in an + # empty executable. + if test set = "${lt_cv_aix_libpath+set}"; then + aix_libpath=$lt_cv_aix_libpath +else + if ${lt_cv_aix_libpath__F77+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat > conftest.$ac_ext <<_ACEOF + program main + + end +_ACEOF +if ac_fn_f77_try_link "$LINENO"; then : + + lt_aix_libpath_sed=' + /Import File Strings/,/^$/ { + /^0/ { + s/^0 *\([^ ]*\) *$/\1/ + p + } + }' + lt_cv_aix_libpath__F77=`dump -H conftest$ac_exeext 2>/dev/null | $SED -n -e "$lt_aix_libpath_sed"` + # Check for a 64-bit object if we didn't find anything. + if test -z "$lt_cv_aix_libpath__F77"; then + lt_cv_aix_libpath__F77=`dump -HX64 conftest$ac_exeext 2>/dev/null | $SED -n -e "$lt_aix_libpath_sed"` + fi +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + if test -z "$lt_cv_aix_libpath__F77"; then + lt_cv_aix_libpath__F77=/usr/lib:/lib + fi + +fi + + aix_libpath=$lt_cv_aix_libpath__F77 +fi + + hardcode_libdir_flag_spec_F77='$wl-blibpath:$libdir:'"$aix_libpath" + # Warning - without using the other run time loading flags, + # -berok will link without error, but may produce a broken library. + no_undefined_flag_F77=' $wl-bernotok' + allow_undefined_flag_F77=' $wl-berok' + if test yes = "$with_gnu_ld"; then + # We only use this code for GNU lds that support --whole-archive. + whole_archive_flag_spec_F77='$wl--whole-archive$convenience $wl--no-whole-archive' + else + # Exported symbols can be pulled into shared objects from archives + whole_archive_flag_spec_F77='$convenience' + fi + archive_cmds_need_lc_F77=yes + archive_expsym_cmds_F77='$RM -r $output_objdir/$realname.d~$MKDIR $output_objdir/$realname.d' + # -brtl affects multiple linker settings, -berok does not and is overridden later + compiler_flags_filtered='`func_echo_all "$compiler_flags " | $SED -e "s%-brtl\\([, ]\\)%-berok\\1%g"`' + if test svr4 != "$with_aix_soname"; then + # This is similar to how AIX traditionally builds its shared libraries. + archive_expsym_cmds_F77="$archive_expsym_cmds_F77"'~$CC '$shared_flag_aix' -o $output_objdir/$realname.d/$soname $libobjs $deplibs $wl-bnoentry '$compiler_flags_filtered'$wl-bE:$export_symbols$allow_undefined_flag~$AR $AR_FLAGS $output_objdir/$libname$release.a $output_objdir/$realname.d/$soname' + fi + if test aix != "$with_aix_soname"; then + archive_expsym_cmds_F77="$archive_expsym_cmds_F77"'~$CC '$shared_flag_svr4' -o $output_objdir/$realname.d/$shared_archive_member_spec.o $libobjs $deplibs $wl-bnoentry '$compiler_flags_filtered'$wl-bE:$export_symbols$allow_undefined_flag~$STRIP -e $output_objdir/$realname.d/$shared_archive_member_spec.o~( func_echo_all "#! $soname($shared_archive_member_spec.o)"; if test shr_64 = "$shared_archive_member_spec"; then func_echo_all "# 64"; else func_echo_all "# 32"; fi; cat $export_symbols ) > $output_objdir/$realname.d/$shared_archive_member_spec.imp~$AR $AR_FLAGS $output_objdir/$soname $output_objdir/$realname.d/$shared_archive_member_spec.o $output_objdir/$realname.d/$shared_archive_member_spec.imp' + else + # used by -dlpreopen to get the symbols + archive_expsym_cmds_F77="$archive_expsym_cmds_F77"'~$MV $output_objdir/$realname.d/$soname $output_objdir' + fi + archive_expsym_cmds_F77="$archive_expsym_cmds_F77"'~$RM -r $output_objdir/$realname.d' + fi + fi + ;; + + amigaos*) + case $host_cpu in + powerpc) + # see comment about AmigaOS4 .so support + archive_cmds_F77='$CC -shared $libobjs $deplibs $compiler_flags $wl-soname $wl$soname -o $lib' + archive_expsym_cmds_F77='' + ;; + m68k) + archive_cmds_F77='$RM $output_objdir/a2ixlibrary.data~$ECHO "#define NAME $libname" > $output_objdir/a2ixlibrary.data~$ECHO "#define LIBRARY_ID 1" >> $output_objdir/a2ixlibrary.data~$ECHO "#define VERSION $major" >> $output_objdir/a2ixlibrary.data~$ECHO "#define REVISION $revision" >> $output_objdir/a2ixlibrary.data~$AR $AR_FLAGS $lib $libobjs~$RANLIB $lib~(cd $output_objdir && a2ixlibrary -32)' + hardcode_libdir_flag_spec_F77='-L$libdir' + hardcode_minus_L_F77=yes + ;; + esac + ;; + + bsdi[45]*) + export_dynamic_flag_spec_F77=-rdynamic + ;; + + cygwin* | mingw* | pw32* | cegcc*) + # When not using gcc, we currently assume that we are using + # Microsoft Visual C++. + # hardcode_libdir_flag_spec is actually meaningless, as there is + # no search path for DLLs. + case $cc_basename in + cl*) + # Native MSVC + hardcode_libdir_flag_spec_F77=' ' + allow_undefined_flag_F77=unsupported + always_export_symbols_F77=yes + file_list_spec_F77='@' + # Tell ltmain to make .lib files, not .a files. + libext=lib + # Tell ltmain to make .dll files, not .so files. + shrext_cmds=.dll + # FIXME: Setting linknames here is a bad hack. + archive_cmds_F77='$CC -o $output_objdir/$soname $libobjs $compiler_flags $deplibs -Wl,-DLL,-IMPLIB:"$tool_output_objdir$libname.dll.lib"~linknames=' + archive_expsym_cmds_F77='if test DEF = "`$SED -n -e '\''s/^[ ]*//'\'' -e '\''/^\(;.*\)*$/d'\'' -e '\''s/^\(EXPORTS\|LIBRARY\)\([ ].*\)*$/DEF/p'\'' -e q $export_symbols`" ; then + cp "$export_symbols" "$output_objdir/$soname.def"; + echo "$tool_output_objdir$soname.def" > "$output_objdir/$soname.exp"; + else + $SED -e '\''s/^/-link -EXPORT:/'\'' < $export_symbols > $output_objdir/$soname.exp; + fi~ + $CC -o $tool_output_objdir$soname $libobjs $compiler_flags $deplibs "@$tool_output_objdir$soname.exp" -Wl,-DLL,-IMPLIB:"$tool_output_objdir$libname.dll.lib"~ + linknames=' + # The linker will not automatically build a static lib if we build a DLL. + # _LT_TAGVAR(old_archive_from_new_cmds, F77)='true' + enable_shared_with_static_runtimes_F77=yes + exclude_expsyms_F77='_NULL_IMPORT_DESCRIPTOR|_IMPORT_DESCRIPTOR_.*' + export_symbols_cmds_F77='$NM $libobjs $convenience | $global_symbol_pipe | $SED -e '\''/^[BCDGRS][ ]/s/.*[ ]\([^ ]*\)/\1,DATA/'\'' | $SED -e '\''/^[AITW][ ]/s/.*[ ]//'\'' | sort | uniq > $export_symbols' + # Don't use ranlib + old_postinstall_cmds_F77='chmod 644 $oldlib' + postlink_cmds_F77='lt_outputfile="@OUTPUT@"~ + lt_tool_outputfile="@TOOL_OUTPUT@"~ + case $lt_outputfile in + *.exe|*.EXE) ;; + *) + lt_outputfile=$lt_outputfile.exe + lt_tool_outputfile=$lt_tool_outputfile.exe + ;; + esac~ + if test : != "$MANIFEST_TOOL" && test -f "$lt_outputfile.manifest"; then + $MANIFEST_TOOL -manifest "$lt_tool_outputfile.manifest" -outputresource:"$lt_tool_outputfile" || exit 1; + $RM "$lt_outputfile.manifest"; + fi' + ;; + *) + # Assume MSVC wrapper + hardcode_libdir_flag_spec_F77=' ' + allow_undefined_flag_F77=unsupported + # Tell ltmain to make .lib files, not .a files. + libext=lib + # Tell ltmain to make .dll files, not .so files. + shrext_cmds=.dll + # FIXME: Setting linknames here is a bad hack. + archive_cmds_F77='$CC -o $lib $libobjs $compiler_flags `func_echo_all "$deplibs" | $SED '\''s/ -lc$//'\''` -link -dll~linknames=' + # The linker will automatically build a .lib file if we build a DLL. + old_archive_from_new_cmds_F77='true' + # FIXME: Should let the user specify the lib program. + old_archive_cmds_F77='lib -OUT:$oldlib$oldobjs$old_deplibs' + enable_shared_with_static_runtimes_F77=yes + ;; + esac + ;; + + darwin* | rhapsody*) + + + archive_cmds_need_lc_F77=no + hardcode_direct_F77=no + hardcode_automatic_F77=yes + hardcode_shlibpath_var_F77=unsupported + if test yes = "$lt_cv_ld_force_load"; then + whole_archive_flag_spec_F77='`for conv in $convenience\"\"; do test -n \"$conv\" && new_convenience=\"$new_convenience $wl-force_load,$conv\"; done; func_echo_all \"$new_convenience\"`' + compiler_needs_object_F77=yes + else + whole_archive_flag_spec_F77='' + fi + link_all_deplibs_F77=yes + allow_undefined_flag_F77=$_lt_dar_allow_undefined + case $cc_basename in + ifort*|nagfor*) _lt_dar_can_shared=yes ;; + *) _lt_dar_can_shared=$GCC ;; + esac + if test yes = "$_lt_dar_can_shared"; then + output_verbose_link_cmd=func_echo_all + archive_cmds_F77="\$CC -dynamiclib \$allow_undefined_flag -o \$lib \$libobjs \$deplibs \$compiler_flags -install_name \$rpath/\$soname \$verstring $_lt_dar_single_mod$_lt_dsymutil" + module_cmds_F77="\$CC \$allow_undefined_flag -o \$lib -bundle \$libobjs \$deplibs \$compiler_flags$_lt_dsymutil" + archive_expsym_cmds_F77="sed 's|^|_|' < \$export_symbols > \$output_objdir/\$libname-symbols.expsym~\$CC -dynamiclib \$allow_undefined_flag -o \$lib \$libobjs \$deplibs \$compiler_flags -install_name \$rpath/\$soname \$verstring $_lt_dar_single_mod$_lt_dar_export_syms$_lt_dsymutil" + module_expsym_cmds_F77="sed -e 's|^|_|' < \$export_symbols > \$output_objdir/\$libname-symbols.expsym~\$CC \$allow_undefined_flag -o \$lib -bundle \$libobjs \$deplibs \$compiler_flags$_lt_dar_export_syms$_lt_dsymutil" + + else + ld_shlibs_F77=no + fi + + ;; + + dgux*) + archive_cmds_F77='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags' + hardcode_libdir_flag_spec_F77='-L$libdir' + hardcode_shlibpath_var_F77=no + ;; + + # FreeBSD 2.2.[012] allows us to include c++rt0.o to get C++ constructor + # support. Future versions do this automatically, but an explicit c++rt0.o + # does not break anything, and helps significantly (at the cost of a little + # extra space). + freebsd2.2*) + archive_cmds_F77='$LD -Bshareable -o $lib $libobjs $deplibs $linker_flags /usr/lib/c++rt0.o' + hardcode_libdir_flag_spec_F77='-R$libdir' + hardcode_direct_F77=yes + hardcode_shlibpath_var_F77=no + ;; + + # Unfortunately, older versions of FreeBSD 2 do not have this feature. + freebsd2.*) + archive_cmds_F77='$LD -Bshareable -o $lib $libobjs $deplibs $linker_flags' + hardcode_direct_F77=yes + hardcode_minus_L_F77=yes + hardcode_shlibpath_var_F77=no + ;; + + # FreeBSD 3 and greater uses gcc -shared to do shared libraries. + freebsd* | dragonfly*) + archive_cmds_F77='$CC -shared $pic_flag -o $lib $libobjs $deplibs $compiler_flags' + hardcode_libdir_flag_spec_F77='-R$libdir' + hardcode_direct_F77=yes + hardcode_shlibpath_var_F77=no + ;; + + hpux9*) + if test yes = "$GCC"; then + archive_cmds_F77='$RM $output_objdir/$soname~$CC -shared $pic_flag $wl+b $wl$install_libdir -o $output_objdir/$soname $libobjs $deplibs $compiler_flags~test "x$output_objdir/$soname" = "x$lib" || mv $output_objdir/$soname $lib' + else + archive_cmds_F77='$RM $output_objdir/$soname~$LD -b +b $install_libdir -o $output_objdir/$soname $libobjs $deplibs $linker_flags~test "x$output_objdir/$soname" = "x$lib" || mv $output_objdir/$soname $lib' + fi + hardcode_libdir_flag_spec_F77='$wl+b $wl$libdir' + hardcode_libdir_separator_F77=: + hardcode_direct_F77=yes + + # hardcode_minus_L: Not really in the search PATH, + # but as the default location of the library. + hardcode_minus_L_F77=yes + export_dynamic_flag_spec_F77='$wl-E' + ;; + + hpux10*) + if test yes,no = "$GCC,$with_gnu_ld"; then + archive_cmds_F77='$CC -shared $pic_flag $wl+h $wl$soname $wl+b $wl$install_libdir -o $lib $libobjs $deplibs $compiler_flags' + else + archive_cmds_F77='$LD -b +h $soname +b $install_libdir -o $lib $libobjs $deplibs $linker_flags' + fi + if test no = "$with_gnu_ld"; then + hardcode_libdir_flag_spec_F77='$wl+b $wl$libdir' + hardcode_libdir_separator_F77=: + hardcode_direct_F77=yes + hardcode_direct_absolute_F77=yes + export_dynamic_flag_spec_F77='$wl-E' + # hardcode_minus_L: Not really in the search PATH, + # but as the default location of the library. + hardcode_minus_L_F77=yes + fi + ;; + + hpux11*) + if test yes,no = "$GCC,$with_gnu_ld"; then + case $host_cpu in + hppa*64*) + archive_cmds_F77='$CC -shared $wl+h $wl$soname -o $lib $libobjs $deplibs $compiler_flags' + ;; + ia64*) + archive_cmds_F77='$CC -shared $pic_flag $wl+h $wl$soname $wl+nodefaultrpath -o $lib $libobjs $deplibs $compiler_flags' + ;; + *) + archive_cmds_F77='$CC -shared $pic_flag $wl+h $wl$soname $wl+b $wl$install_libdir -o $lib $libobjs $deplibs $compiler_flags' + ;; + esac + else + case $host_cpu in + hppa*64*) + archive_cmds_F77='$CC -b $wl+h $wl$soname -o $lib $libobjs $deplibs $compiler_flags' + ;; + ia64*) + archive_cmds_F77='$CC -b $wl+h $wl$soname $wl+nodefaultrpath -o $lib $libobjs $deplibs $compiler_flags' + ;; + *) + archive_cmds_F77='$CC -b $wl+h $wl$soname $wl+b $wl$install_libdir -o $lib $libobjs $deplibs $compiler_flags' + ;; + esac + fi + if test no = "$with_gnu_ld"; then + hardcode_libdir_flag_spec_F77='$wl+b $wl$libdir' + hardcode_libdir_separator_F77=: + + case $host_cpu in + hppa*64*|ia64*) + hardcode_direct_F77=no + hardcode_shlibpath_var_F77=no + ;; + *) + hardcode_direct_F77=yes + hardcode_direct_absolute_F77=yes + export_dynamic_flag_spec_F77='$wl-E' + + # hardcode_minus_L: Not really in the search PATH, + # but as the default location of the library. + hardcode_minus_L_F77=yes + ;; + esac + fi + ;; + + irix5* | irix6* | nonstopux*) + if test yes = "$GCC"; then + archive_cmds_F77='$CC -shared $pic_flag $libobjs $deplibs $compiler_flags $wl-soname $wl$soname `test -n "$verstring" && func_echo_all "$wl-set_version $wl$verstring"` $wl-update_registry $wl$output_objdir/so_locations -o $lib' + # Try to use the -exported_symbol ld option, if it does not + # work, assume that -exports_file does not work either and + # implicitly export all symbols. + # This should be the same for all languages, so no per-tag cache variable. + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether the $host_os linker accepts -exported_symbol" >&5 +$as_echo_n "checking whether the $host_os linker accepts -exported_symbol... " >&6; } +if ${lt_cv_irix_exported_symbol+:} false; then : + $as_echo_n "(cached) " >&6 +else + save_LDFLAGS=$LDFLAGS + LDFLAGS="$LDFLAGS -shared $wl-exported_symbol ${wl}foo $wl-update_registry $wl/dev/null" + cat > conftest.$ac_ext <<_ACEOF + + subroutine foo + end +_ACEOF +if ac_fn_f77_try_link "$LINENO"; then : + lt_cv_irix_exported_symbol=yes +else + lt_cv_irix_exported_symbol=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + LDFLAGS=$save_LDFLAGS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_irix_exported_symbol" >&5 +$as_echo "$lt_cv_irix_exported_symbol" >&6; } + if test yes = "$lt_cv_irix_exported_symbol"; then + archive_expsym_cmds_F77='$CC -shared $pic_flag $libobjs $deplibs $compiler_flags $wl-soname $wl$soname `test -n "$verstring" && func_echo_all "$wl-set_version $wl$verstring"` $wl-update_registry $wl$output_objdir/so_locations $wl-exports_file $wl$export_symbols -o $lib' + fi + else + archive_cmds_F77='$CC -shared $libobjs $deplibs $compiler_flags -soname $soname `test -n "$verstring" && func_echo_all "-set_version $verstring"` -update_registry $output_objdir/so_locations -o $lib' + archive_expsym_cmds_F77='$CC -shared $libobjs $deplibs $compiler_flags -soname $soname `test -n "$verstring" && func_echo_all "-set_version $verstring"` -update_registry $output_objdir/so_locations -exports_file $export_symbols -o $lib' + fi + archive_cmds_need_lc_F77='no' + hardcode_libdir_flag_spec_F77='$wl-rpath $wl$libdir' + hardcode_libdir_separator_F77=: + inherit_rpath_F77=yes + link_all_deplibs_F77=yes + ;; + + linux*) + case $cc_basename in + tcc*) + # Fabrice Bellard et al's Tiny C Compiler + ld_shlibs_F77=yes + archive_cmds_F77='$CC -shared $pic_flag -o $lib $libobjs $deplibs $compiler_flags' + ;; + esac + ;; + + netbsd*) + if echo __ELF__ | $CC -E - | $GREP __ELF__ >/dev/null; then + archive_cmds_F77='$LD -Bshareable -o $lib $libobjs $deplibs $linker_flags' # a.out + else + archive_cmds_F77='$LD -shared -o $lib $libobjs $deplibs $linker_flags' # ELF + fi + hardcode_libdir_flag_spec_F77='-R$libdir' + hardcode_direct_F77=yes + hardcode_shlibpath_var_F77=no + ;; + + newsos6) + archive_cmds_F77='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags' + hardcode_direct_F77=yes + hardcode_libdir_flag_spec_F77='$wl-rpath $wl$libdir' + hardcode_libdir_separator_F77=: + hardcode_shlibpath_var_F77=no + ;; + + *nto* | *qnx*) + ;; + + openbsd* | bitrig*) + if test -f /usr/libexec/ld.so; then + hardcode_direct_F77=yes + hardcode_shlibpath_var_F77=no + hardcode_direct_absolute_F77=yes + if test -z "`echo __ELF__ | $CC -E - | $GREP __ELF__`"; then + archive_cmds_F77='$CC -shared $pic_flag -o $lib $libobjs $deplibs $compiler_flags' + archive_expsym_cmds_F77='$CC -shared $pic_flag -o $lib $libobjs $deplibs $compiler_flags $wl-retain-symbols-file,$export_symbols' + hardcode_libdir_flag_spec_F77='$wl-rpath,$libdir' + export_dynamic_flag_spec_F77='$wl-E' + else + archive_cmds_F77='$CC -shared $pic_flag -o $lib $libobjs $deplibs $compiler_flags' + hardcode_libdir_flag_spec_F77='$wl-rpath,$libdir' + fi + else + ld_shlibs_F77=no + fi + ;; + + os2*) + hardcode_libdir_flag_spec_F77='-L$libdir' + hardcode_minus_L_F77=yes + allow_undefined_flag_F77=unsupported + shrext_cmds=.dll + archive_cmds_F77='$ECHO "LIBRARY ${soname%$shared_ext} INITINSTANCE TERMINSTANCE" > $output_objdir/$libname.def~ + $ECHO "DESCRIPTION \"$libname\"" >> $output_objdir/$libname.def~ + $ECHO "DATA MULTIPLE NONSHARED" >> $output_objdir/$libname.def~ + $ECHO EXPORTS >> $output_objdir/$libname.def~ + emxexp $libobjs | $SED /"_DLL_InitTerm"/d >> $output_objdir/$libname.def~ + $CC -Zdll -Zcrtdll -o $output_objdir/$soname $libobjs $deplibs $compiler_flags $output_objdir/$libname.def~ + emximp -o $lib $output_objdir/$libname.def' + archive_expsym_cmds_F77='$ECHO "LIBRARY ${soname%$shared_ext} INITINSTANCE TERMINSTANCE" > $output_objdir/$libname.def~ + $ECHO "DESCRIPTION \"$libname\"" >> $output_objdir/$libname.def~ + $ECHO "DATA MULTIPLE NONSHARED" >> $output_objdir/$libname.def~ + $ECHO EXPORTS >> $output_objdir/$libname.def~ + prefix_cmds="$SED"~ + if test EXPORTS = "`$SED 1q $export_symbols`"; then + prefix_cmds="$prefix_cmds -e 1d"; + fi~ + prefix_cmds="$prefix_cmds -e \"s/^\(.*\)$/_\1/g\""~ + cat $export_symbols | $prefix_cmds >> $output_objdir/$libname.def~ + $CC -Zdll -Zcrtdll -o $output_objdir/$soname $libobjs $deplibs $compiler_flags $output_objdir/$libname.def~ + emximp -o $lib $output_objdir/$libname.def' + old_archive_From_new_cmds_F77='emximp -o $output_objdir/${libname}_dll.a $output_objdir/$libname.def' + enable_shared_with_static_runtimes_F77=yes + ;; + + osf3*) + if test yes = "$GCC"; then + allow_undefined_flag_F77=' $wl-expect_unresolved $wl\*' + archive_cmds_F77='$CC -shared$allow_undefined_flag $libobjs $deplibs $compiler_flags $wl-soname $wl$soname `test -n "$verstring" && func_echo_all "$wl-set_version $wl$verstring"` $wl-update_registry $wl$output_objdir/so_locations -o $lib' + else + allow_undefined_flag_F77=' -expect_unresolved \*' + archive_cmds_F77='$CC -shared$allow_undefined_flag $libobjs $deplibs $compiler_flags -soname $soname `test -n "$verstring" && func_echo_all "-set_version $verstring"` -update_registry $output_objdir/so_locations -o $lib' + fi + archive_cmds_need_lc_F77='no' + hardcode_libdir_flag_spec_F77='$wl-rpath $wl$libdir' + hardcode_libdir_separator_F77=: + ;; + + osf4* | osf5*) # as osf3* with the addition of -msym flag + if test yes = "$GCC"; then + allow_undefined_flag_F77=' $wl-expect_unresolved $wl\*' + archive_cmds_F77='$CC -shared$allow_undefined_flag $pic_flag $libobjs $deplibs $compiler_flags $wl-msym $wl-soname $wl$soname `test -n "$verstring" && func_echo_all "$wl-set_version $wl$verstring"` $wl-update_registry $wl$output_objdir/so_locations -o $lib' + hardcode_libdir_flag_spec_F77='$wl-rpath $wl$libdir' + else + allow_undefined_flag_F77=' -expect_unresolved \*' + archive_cmds_F77='$CC -shared$allow_undefined_flag $libobjs $deplibs $compiler_flags -msym -soname $soname `test -n "$verstring" && func_echo_all "-set_version $verstring"` -update_registry $output_objdir/so_locations -o $lib' + archive_expsym_cmds_F77='for i in `cat $export_symbols`; do printf "%s %s\\n" -exported_symbol "\$i" >> $lib.exp; done; printf "%s\\n" "-hidden">> $lib.exp~ + $CC -shared$allow_undefined_flag $wl-input $wl$lib.exp $compiler_flags $libobjs $deplibs -soname $soname `test -n "$verstring" && $ECHO "-set_version $verstring"` -update_registry $output_objdir/so_locations -o $lib~$RM $lib.exp' + + # Both c and cxx compiler support -rpath directly + hardcode_libdir_flag_spec_F77='-rpath $libdir' + fi + archive_cmds_need_lc_F77='no' + hardcode_libdir_separator_F77=: + ;; + + solaris*) + no_undefined_flag_F77=' -z defs' + if test yes = "$GCC"; then + wlarc='$wl' + archive_cmds_F77='$CC -shared $pic_flag $wl-z ${wl}text $wl-h $wl$soname -o $lib $libobjs $deplibs $compiler_flags' + archive_expsym_cmds_F77='echo "{ global:" > $lib.exp~cat $export_symbols | $SED -e "s/\(.*\)/\1;/" >> $lib.exp~echo "local: *; };" >> $lib.exp~ + $CC -shared $pic_flag $wl-z ${wl}text $wl-M $wl$lib.exp $wl-h $wl$soname -o $lib $libobjs $deplibs $compiler_flags~$RM $lib.exp' + else + case `$CC -V 2>&1` in + *"Compilers 5.0"*) + wlarc='' + archive_cmds_F77='$LD -G$allow_undefined_flag -h $soname -o $lib $libobjs $deplibs $linker_flags' + archive_expsym_cmds_F77='echo "{ global:" > $lib.exp~cat $export_symbols | $SED -e "s/\(.*\)/\1;/" >> $lib.exp~echo "local: *; };" >> $lib.exp~ + $LD -G$allow_undefined_flag -M $lib.exp -h $soname -o $lib $libobjs $deplibs $linker_flags~$RM $lib.exp' + ;; + *) + wlarc='$wl' + archive_cmds_F77='$CC -G$allow_undefined_flag -h $soname -o $lib $libobjs $deplibs $compiler_flags' + archive_expsym_cmds_F77='echo "{ global:" > $lib.exp~cat $export_symbols | $SED -e "s/\(.*\)/\1;/" >> $lib.exp~echo "local: *; };" >> $lib.exp~ + $CC -G$allow_undefined_flag -M $lib.exp -h $soname -o $lib $libobjs $deplibs $compiler_flags~$RM $lib.exp' + ;; + esac + fi + hardcode_libdir_flag_spec_F77='-R$libdir' + hardcode_shlibpath_var_F77=no + case $host_os in + solaris2.[0-5] | solaris2.[0-5].*) ;; + *) + # The compiler driver will combine and reorder linker options, + # but understands '-z linker_flag'. GCC discards it without '$wl', + # but is careful enough not to reorder. + # Supported since Solaris 2.6 (maybe 2.5.1?) + if test yes = "$GCC"; then + whole_archive_flag_spec_F77='$wl-z ${wl}allextract$convenience $wl-z ${wl}defaultextract' + else + whole_archive_flag_spec_F77='-z allextract$convenience -z defaultextract' + fi + ;; + esac + link_all_deplibs_F77=yes + ;; + + sunos4*) + if test sequent = "$host_vendor"; then + # Use $CC to link under sequent, because it throws in some extra .o + # files that make .init and .fini sections work. + archive_cmds_F77='$CC -G $wl-h $soname -o $lib $libobjs $deplibs $compiler_flags' + else + archive_cmds_F77='$LD -assert pure-text -Bstatic -o $lib $libobjs $deplibs $linker_flags' + fi + hardcode_libdir_flag_spec_F77='-L$libdir' + hardcode_direct_F77=yes + hardcode_minus_L_F77=yes + hardcode_shlibpath_var_F77=no + ;; + + sysv4) + case $host_vendor in + sni) + archive_cmds_F77='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags' + hardcode_direct_F77=yes # is this really true??? + ;; + siemens) + ## LD is ld it makes a PLAMLIB + ## CC just makes a GrossModule. + archive_cmds_F77='$LD -G -o $lib $libobjs $deplibs $linker_flags' + reload_cmds_F77='$CC -r -o $output$reload_objs' + hardcode_direct_F77=no + ;; + motorola) + archive_cmds_F77='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags' + hardcode_direct_F77=no #Motorola manual says yes, but my tests say they lie + ;; + esac + runpath_var='LD_RUN_PATH' + hardcode_shlibpath_var_F77=no + ;; + + sysv4.3*) + archive_cmds_F77='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags' + hardcode_shlibpath_var_F77=no + export_dynamic_flag_spec_F77='-Bexport' + ;; + + sysv4*MP*) + if test -d /usr/nec; then + archive_cmds_F77='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags' + hardcode_shlibpath_var_F77=no + runpath_var=LD_RUN_PATH + hardcode_runpath_var=yes + ld_shlibs_F77=yes + fi + ;; + + sysv4*uw2* | sysv5OpenUNIX* | sysv5UnixWare7.[01].[10]* | unixware7* | sco3.2v5.0.[024]*) + no_undefined_flag_F77='$wl-z,text' + archive_cmds_need_lc_F77=no + hardcode_shlibpath_var_F77=no + runpath_var='LD_RUN_PATH' + + if test yes = "$GCC"; then + archive_cmds_F77='$CC -shared $wl-h,$soname -o $lib $libobjs $deplibs $compiler_flags' + archive_expsym_cmds_F77='$CC -shared $wl-Bexport:$export_symbols $wl-h,$soname -o $lib $libobjs $deplibs $compiler_flags' + else + archive_cmds_F77='$CC -G $wl-h,$soname -o $lib $libobjs $deplibs $compiler_flags' + archive_expsym_cmds_F77='$CC -G $wl-Bexport:$export_symbols $wl-h,$soname -o $lib $libobjs $deplibs $compiler_flags' + fi + ;; + + sysv5* | sco3.2v5* | sco5v6*) + # Note: We CANNOT use -z defs as we might desire, because we do not + # link with -lc, and that would cause any symbols used from libc to + # always be unresolved, which means just about no library would + # ever link correctly. If we're not using GNU ld we use -z text + # though, which does catch some bad symbols but isn't as heavy-handed + # as -z defs. + no_undefined_flag_F77='$wl-z,text' + allow_undefined_flag_F77='$wl-z,nodefs' + archive_cmds_need_lc_F77=no + hardcode_shlibpath_var_F77=no + hardcode_libdir_flag_spec_F77='$wl-R,$libdir' + hardcode_libdir_separator_F77=':' + link_all_deplibs_F77=yes + export_dynamic_flag_spec_F77='$wl-Bexport' + runpath_var='LD_RUN_PATH' + + if test yes = "$GCC"; then + archive_cmds_F77='$CC -shared $wl-h,$soname -o $lib $libobjs $deplibs $compiler_flags' + archive_expsym_cmds_F77='$CC -shared $wl-Bexport:$export_symbols $wl-h,$soname -o $lib $libobjs $deplibs $compiler_flags' + else + archive_cmds_F77='$CC -G $wl-h,$soname -o $lib $libobjs $deplibs $compiler_flags' + archive_expsym_cmds_F77='$CC -G $wl-Bexport:$export_symbols $wl-h,$soname -o $lib $libobjs $deplibs $compiler_flags' + fi + ;; + + uts4*) + archive_cmds_F77='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags' + hardcode_libdir_flag_spec_F77='-L$libdir' + hardcode_shlibpath_var_F77=no + ;; + + *) + ld_shlibs_F77=no + ;; + esac + + if test sni = "$host_vendor"; then + case $host in + sysv4 | sysv4.2uw2* | sysv4.3* | sysv5*) + export_dynamic_flag_spec_F77='$wl-Blargedynsym' + ;; + esac + fi + fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ld_shlibs_F77" >&5 +$as_echo "$ld_shlibs_F77" >&6; } +test no = "$ld_shlibs_F77" && can_build_shared=no + +with_gnu_ld_F77=$with_gnu_ld + + + + + + +# +# Do we need to explicitly link libc? +# +case "x$archive_cmds_need_lc_F77" in +x|xyes) + # Assume -lc should be added + archive_cmds_need_lc_F77=yes + + if test yes,yes = "$GCC,$enable_shared"; then + case $archive_cmds_F77 in + *'~'*) + # FIXME: we may have to deal with multi-command sequences. + ;; + '$CC '*) + # Test whether the compiler implicitly links with -lc since on some + # systems, -lgcc has to come before -lc. If gcc already passes -lc + # to ld, don't add -lc before -lgcc. + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether -lc should be explicitly linked in" >&5 +$as_echo_n "checking whether -lc should be explicitly linked in... " >&6; } +if ${lt_cv_archive_cmds_need_lc_F77+:} false; then : + $as_echo_n "(cached) " >&6 +else + $RM conftest* + echo "$lt_simple_compile_test_code" > conftest.$ac_ext + + if { { eval echo "\"\$as_me\":${as_lineno-$LINENO}: \"$ac_compile\""; } >&5 + (eval $ac_compile) 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } 2>conftest.err; then + soname=conftest + lib=conftest + libobjs=conftest.$ac_objext + deplibs= + wl=$lt_prog_compiler_wl_F77 + pic_flag=$lt_prog_compiler_pic_F77 + compiler_flags=-v + linker_flags=-v + verstring= + output_objdir=. + libname=conftest + lt_save_allow_undefined_flag=$allow_undefined_flag_F77 + allow_undefined_flag_F77= + if { { eval echo "\"\$as_me\":${as_lineno-$LINENO}: \"$archive_cmds_F77 2\>\&1 \| $GREP \" -lc \" \>/dev/null 2\>\&1\""; } >&5 + (eval $archive_cmds_F77 2\>\&1 \| $GREP \" -lc \" \>/dev/null 2\>\&1) 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } + then + lt_cv_archive_cmds_need_lc_F77=no + else + lt_cv_archive_cmds_need_lc_F77=yes + fi + allow_undefined_flag_F77=$lt_save_allow_undefined_flag + else + cat conftest.err 1>&5 + fi + $RM conftest* + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_archive_cmds_need_lc_F77" >&5 +$as_echo "$lt_cv_archive_cmds_need_lc_F77" >&6; } + archive_cmds_need_lc_F77=$lt_cv_archive_cmds_need_lc_F77 + ;; + esac + fi + ;; +esac + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking dynamic linker characteristics" >&5 +$as_echo_n "checking dynamic linker characteristics... " >&6; } + +library_names_spec= +libname_spec='lib$name' +soname_spec= +shrext_cmds=.so +postinstall_cmds= +postuninstall_cmds= +finish_cmds= +finish_eval= +shlibpath_var= +shlibpath_overrides_runpath=unknown +version_type=none +dynamic_linker="$host_os ld.so" +sys_lib_dlsearch_path_spec="/lib /usr/lib" +need_lib_prefix=unknown +hardcode_into_libs=no + +# when you set need_version to no, make sure it does not cause -set_version +# flags to be left without arguments +need_version=unknown + + + +case $host_os in +aix3*) + version_type=linux # correct to gnu/linux during the next big refactor + library_names_spec='$libname$release$shared_ext$versuffix $libname.a' + shlibpath_var=LIBPATH + + # AIX 3 has no versioning support, so we append a major version to the name. + soname_spec='$libname$release$shared_ext$major' + ;; + +aix[4-9]*) + version_type=linux # correct to gnu/linux during the next big refactor + need_lib_prefix=no + need_version=no + hardcode_into_libs=yes + if test ia64 = "$host_cpu"; then + # AIX 5 supports IA64 + library_names_spec='$libname$release$shared_ext$major $libname$release$shared_ext$versuffix $libname$shared_ext' + shlibpath_var=LD_LIBRARY_PATH + else + # With GCC up to 2.95.x, collect2 would create an import file + # for dependence libraries. The import file would start with + # the line '#! .'. This would cause the generated library to + # depend on '.', always an invalid library. This was fixed in + # development snapshots of GCC prior to 3.0. + case $host_os in + aix4 | aix4.[01] | aix4.[01].*) + if { echo '#if __GNUC__ > 2 || (__GNUC__ == 2 && __GNUC_MINOR__ >= 97)' + echo ' yes ' + echo '#endif'; } | $CC -E - | $GREP yes > /dev/null; then + : + else + can_build_shared=no + fi + ;; + esac + # Using Import Files as archive members, it is possible to support + # filename-based versioning of shared library archives on AIX. While + # this would work for both with and without runtime linking, it will + # prevent static linking of such archives. So we do filename-based + # shared library versioning with .so extension only, which is used + # when both runtime linking and shared linking is enabled. + # Unfortunately, runtime linking may impact performance, so we do + # not want this to be the default eventually. Also, we use the + # versioned .so libs for executables only if there is the -brtl + # linker flag in LDFLAGS as well, or --with-aix-soname=svr4 only. + # To allow for filename-based versioning support, we need to create + # libNAME.so.V as an archive file, containing: + # *) an Import File, referring to the versioned filename of the + # archive as well as the shared archive member, telling the + # bitwidth (32 or 64) of that shared object, and providing the + # list of exported symbols of that shared object, eventually + # decorated with the 'weak' keyword + # *) the shared object with the F_LOADONLY flag set, to really avoid + # it being seen by the linker. + # At run time we better use the real file rather than another symlink, + # but for link time we create the symlink libNAME.so -> libNAME.so.V + + case $with_aix_soname,$aix_use_runtimelinking in + # AIX (on Power*) has no versioning support, so currently we cannot hardcode correct + # soname into executable. Probably we can add versioning support to + # collect2, so additional links can be useful in future. + aix,yes) # traditional libtool + dynamic_linker='AIX unversionable lib.so' + # If using run time linking (on AIX 4.2 or later) use lib<name>.so + # instead of lib<name>.a to let people know that these are not + # typical AIX shared libraries. + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' + ;; + aix,no) # traditional AIX only + dynamic_linker='AIX lib.a(lib.so.V)' + # We preserve .a as extension for shared libraries through AIX4.2 + # and later when we are not doing run time linking. + library_names_spec='$libname$release.a $libname.a' + soname_spec='$libname$release$shared_ext$major' + ;; + svr4,*) # full svr4 only + dynamic_linker="AIX lib.so.V($shared_archive_member_spec.o)" + library_names_spec='$libname$release$shared_ext$major $libname$shared_ext' + # We do not specify a path in Import Files, so LIBPATH fires. + shlibpath_overrides_runpath=yes + ;; + *,yes) # both, prefer svr4 + dynamic_linker="AIX lib.so.V($shared_archive_member_spec.o), lib.a(lib.so.V)" + library_names_spec='$libname$release$shared_ext$major $libname$shared_ext' + # unpreferred sharedlib libNAME.a needs extra handling + postinstall_cmds='test -n "$linkname" || linkname="$realname"~func_stripname "" ".so" "$linkname"~$install_shared_prog "$dir/$func_stripname_result.$libext" "$destdir/$func_stripname_result.$libext"~test -z "$tstripme" || test -z "$striplib" || $striplib "$destdir/$func_stripname_result.$libext"' + postuninstall_cmds='for n in $library_names $old_library; do :; done~func_stripname "" ".so" "$n"~test "$func_stripname_result" = "$n" || func_append rmfiles " $odir/$func_stripname_result.$libext"' + # We do not specify a path in Import Files, so LIBPATH fires. + shlibpath_overrides_runpath=yes + ;; + *,no) # both, prefer aix + dynamic_linker="AIX lib.a(lib.so.V), lib.so.V($shared_archive_member_spec.o)" + library_names_spec='$libname$release.a $libname.a' + soname_spec='$libname$release$shared_ext$major' + # unpreferred sharedlib libNAME.so.V and symlink libNAME.so need extra handling + postinstall_cmds='test -z "$dlname" || $install_shared_prog $dir/$dlname $destdir/$dlname~test -z "$tstripme" || test -z "$striplib" || $striplib $destdir/$dlname~test -n "$linkname" || linkname=$realname~func_stripname "" ".a" "$linkname"~(cd "$destdir" && $LN_S -f $dlname $func_stripname_result.so)' + postuninstall_cmds='test -z "$dlname" || func_append rmfiles " $odir/$dlname"~for n in $old_library $library_names; do :; done~func_stripname "" ".a" "$n"~func_append rmfiles " $odir/$func_stripname_result.so"' + ;; + esac + shlibpath_var=LIBPATH + fi + ;; + +amigaos*) + case $host_cpu in + powerpc) + # Since July 2007 AmigaOS4 officially supports .so libraries. + # When compiling the executable, add -use-dynld -Lsobjs: to the compileline. + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' + ;; + m68k) + library_names_spec='$libname.ixlibrary $libname.a' + # Create ${libname}_ixlibrary.a entries in /sys/libs. + finish_eval='for lib in `ls $libdir/*.ixlibrary 2>/dev/null`; do libname=`func_echo_all "$lib" | $SED '\''s%^.*/\([^/]*\)\.ixlibrary$%\1%'\''`; $RM /sys/libs/${libname}_ixlibrary.a; $show "cd /sys/libs && $LN_S $lib ${libname}_ixlibrary.a"; cd /sys/libs && $LN_S $lib ${libname}_ixlibrary.a || exit 1; done' + ;; + esac + ;; + +beos*) + library_names_spec='$libname$shared_ext' + dynamic_linker="$host_os ld.so" + shlibpath_var=LIBRARY_PATH + ;; + +bsdi[45]*) + version_type=linux # correct to gnu/linux during the next big refactor + need_version=no + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' + soname_spec='$libname$release$shared_ext$major' + finish_cmds='PATH="\$PATH:/sbin" ldconfig $libdir' + shlibpath_var=LD_LIBRARY_PATH + sys_lib_search_path_spec="/shlib /usr/lib /usr/X11/lib /usr/contrib/lib /lib /usr/local/lib" + sys_lib_dlsearch_path_spec="/shlib /usr/lib /usr/local/lib" + # the default ld.so.conf also contains /usr/contrib/lib and + # /usr/X11R6/lib (/usr/X11 is a link to /usr/X11R6), but let us allow + # libtool to hard-code these into programs + ;; + +cygwin* | mingw* | pw32* | cegcc*) + version_type=windows + shrext_cmds=.dll + need_version=no + need_lib_prefix=no + + case $GCC,$cc_basename in + yes,*) + # gcc + library_names_spec='$libname.dll.a' + # DLL is installed to $(libdir)/../bin by postinstall_cmds + postinstall_cmds='base_file=`basename \$file`~ + dlpath=`$SHELL 2>&1 -c '\''. $dir/'\''\$base_file'\''i; echo \$dlname'\''`~ + dldir=$destdir/`dirname \$dlpath`~ + test -d \$dldir || mkdir -p \$dldir~ + $install_prog $dir/$dlname \$dldir/$dlname~ + chmod a+x \$dldir/$dlname~ + if test -n '\''$stripme'\'' && test -n '\''$striplib'\''; then + eval '\''$striplib \$dldir/$dlname'\'' || exit \$?; + fi' + postuninstall_cmds='dldll=`$SHELL 2>&1 -c '\''. $file; echo \$dlname'\''`~ + dlpath=$dir/\$dldll~ + $RM \$dlpath' + shlibpath_overrides_runpath=yes + + case $host_os in + cygwin*) + # Cygwin DLLs use 'cyg' prefix rather than 'lib' + soname_spec='`echo $libname | sed -e 's/^lib/cyg/'``echo $release | $SED -e 's/[.]/-/g'`$versuffix$shared_ext' + + ;; + mingw* | cegcc*) + # MinGW DLLs use traditional 'lib' prefix + soname_spec='$libname`echo $release | $SED -e 's/[.]/-/g'`$versuffix$shared_ext' + ;; + pw32*) + # pw32 DLLs use 'pw' prefix rather than 'lib' + library_names_spec='`echo $libname | sed -e 's/^lib/pw/'``echo $release | $SED -e 's/[.]/-/g'`$versuffix$shared_ext' + ;; + esac + dynamic_linker='Win32 ld.exe' + ;; + + *,cl*) + # Native MSVC + libname_spec='$name' + soname_spec='$libname`echo $release | $SED -e 's/[.]/-/g'`$versuffix$shared_ext' + library_names_spec='$libname.dll.lib' + + case $build_os in + mingw*) + sys_lib_search_path_spec= + lt_save_ifs=$IFS + IFS=';' + for lt_path in $LIB + do + IFS=$lt_save_ifs + # Let DOS variable expansion print the short 8.3 style file name. + lt_path=`cd "$lt_path" 2>/dev/null && cmd //C "for %i in (".") do @echo %~si"` + sys_lib_search_path_spec="$sys_lib_search_path_spec $lt_path" + done + IFS=$lt_save_ifs + # Convert to MSYS style. + sys_lib_search_path_spec=`$ECHO "$sys_lib_search_path_spec" | sed -e 's|\\\\|/|g' -e 's| \\([a-zA-Z]\\):| /\\1|g' -e 's|^ ||'` + ;; + cygwin*) + # Convert to unix form, then to dos form, then back to unix form + # but this time dos style (no spaces!) so that the unix form looks + # like /cygdrive/c/PROGRA~1:/cygdr... + sys_lib_search_path_spec=`cygpath --path --unix "$LIB"` + sys_lib_search_path_spec=`cygpath --path --dos "$sys_lib_search_path_spec" 2>/dev/null` + sys_lib_search_path_spec=`cygpath --path --unix "$sys_lib_search_path_spec" | $SED -e "s/$PATH_SEPARATOR/ /g"` + ;; + *) + sys_lib_search_path_spec=$LIB + if $ECHO "$sys_lib_search_path_spec" | $GREP ';[c-zC-Z]:/' >/dev/null; then + # It is most probably a Windows format PATH. + sys_lib_search_path_spec=`$ECHO "$sys_lib_search_path_spec" | $SED -e 's/;/ /g'` + else + sys_lib_search_path_spec=`$ECHO "$sys_lib_search_path_spec" | $SED -e "s/$PATH_SEPARATOR/ /g"` + fi + # FIXME: find the short name or the path components, as spaces are + # common. (e.g. "Program Files" -> "PROGRA~1") + ;; + esac + + # DLL is installed to $(libdir)/../bin by postinstall_cmds + postinstall_cmds='base_file=`basename \$file`~ + dlpath=`$SHELL 2>&1 -c '\''. $dir/'\''\$base_file'\''i; echo \$dlname'\''`~ + dldir=$destdir/`dirname \$dlpath`~ + test -d \$dldir || mkdir -p \$dldir~ + $install_prog $dir/$dlname \$dldir/$dlname' + postuninstall_cmds='dldll=`$SHELL 2>&1 -c '\''. $file; echo \$dlname'\''`~ + dlpath=$dir/\$dldll~ + $RM \$dlpath' + shlibpath_overrides_runpath=yes + dynamic_linker='Win32 link.exe' + ;; + + *) + # Assume MSVC wrapper + library_names_spec='$libname`echo $release | $SED -e 's/[.]/-/g'`$versuffix$shared_ext $libname.lib' + dynamic_linker='Win32 ld.exe' + ;; + esac + # FIXME: first we should search . and the directory the executable is in + shlibpath_var=PATH + ;; + +darwin* | rhapsody*) + dynamic_linker="$host_os dyld" + version_type=darwin + need_lib_prefix=no + need_version=no + library_names_spec='$libname$release$major$shared_ext $libname$shared_ext' + soname_spec='$libname$release$major$shared_ext' + shlibpath_overrides_runpath=yes + shlibpath_var=DYLD_LIBRARY_PATH + shrext_cmds='`test .$module = .yes && echo .so || echo .dylib`' + + sys_lib_dlsearch_path_spec='/usr/local/lib /lib /usr/lib' + ;; + +dgux*) + version_type=linux # correct to gnu/linux during the next big refactor + need_lib_prefix=no + need_version=no + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' + soname_spec='$libname$release$shared_ext$major' + shlibpath_var=LD_LIBRARY_PATH + ;; + +freebsd* | dragonfly*) + # DragonFly does not have aout. When/if they implement a new + # versioning mechanism, adjust this. + if test -x /usr/bin/objformat; then + objformat=`/usr/bin/objformat` + else + case $host_os in + freebsd[23].*) objformat=aout ;; + *) objformat=elf ;; + esac + fi + version_type=freebsd-$objformat + case $version_type in + freebsd-elf*) + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' + soname_spec='$libname$release$shared_ext$major' + need_version=no + need_lib_prefix=no + ;; + freebsd-*) + library_names_spec='$libname$release$shared_ext$versuffix $libname$shared_ext$versuffix' + need_version=yes + ;; + esac + shlibpath_var=LD_LIBRARY_PATH + case $host_os in + freebsd2.*) + shlibpath_overrides_runpath=yes + ;; + freebsd3.[01]* | freebsdelf3.[01]*) + shlibpath_overrides_runpath=yes + hardcode_into_libs=yes + ;; + freebsd3.[2-9]* | freebsdelf3.[2-9]* | \ + freebsd4.[0-5] | freebsdelf4.[0-5] | freebsd4.1.1 | freebsdelf4.1.1) + shlibpath_overrides_runpath=no + hardcode_into_libs=yes + ;; + *) # from 4.6 on, and DragonFly + shlibpath_overrides_runpath=yes + hardcode_into_libs=yes + ;; + esac + ;; + +haiku*) + version_type=linux # correct to gnu/linux during the next big refactor + need_lib_prefix=no + need_version=no + dynamic_linker="$host_os runtime_loader" + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' + soname_spec='$libname$release$shared_ext$major' + shlibpath_var=LIBRARY_PATH + shlibpath_overrides_runpath=no + sys_lib_dlsearch_path_spec='/boot/home/config/lib /boot/common/lib /boot/system/lib' + hardcode_into_libs=yes + ;; + +hpux9* | hpux10* | hpux11*) + # Give a soname corresponding to the major version so that dld.sl refuses to + # link against other versions. + version_type=sunos + need_lib_prefix=no + need_version=no + case $host_cpu in + ia64*) + shrext_cmds='.so' + hardcode_into_libs=yes + dynamic_linker="$host_os dld.so" + shlibpath_var=LD_LIBRARY_PATH + shlibpath_overrides_runpath=yes # Unless +noenvvar is specified. + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' + soname_spec='$libname$release$shared_ext$major' + if test 32 = "$HPUX_IA64_MODE"; then + sys_lib_search_path_spec="/usr/lib/hpux32 /usr/local/lib/hpux32 /usr/local/lib" + sys_lib_dlsearch_path_spec=/usr/lib/hpux32 + else + sys_lib_search_path_spec="/usr/lib/hpux64 /usr/local/lib/hpux64" + sys_lib_dlsearch_path_spec=/usr/lib/hpux64 + fi + ;; + hppa*64*) + shrext_cmds='.sl' + hardcode_into_libs=yes + dynamic_linker="$host_os dld.sl" + shlibpath_var=LD_LIBRARY_PATH # How should we handle SHLIB_PATH + shlibpath_overrides_runpath=yes # Unless +noenvvar is specified. + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' + soname_spec='$libname$release$shared_ext$major' + sys_lib_search_path_spec="/usr/lib/pa20_64 /usr/ccs/lib/pa20_64" + sys_lib_dlsearch_path_spec=$sys_lib_search_path_spec + ;; + *) + shrext_cmds='.sl' + dynamic_linker="$host_os dld.sl" + shlibpath_var=SHLIB_PATH + shlibpath_overrides_runpath=no # +s is required to enable SHLIB_PATH + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' + soname_spec='$libname$release$shared_ext$major' + ;; + esac + # HP-UX runs *really* slowly unless shared libraries are mode 555, ... + postinstall_cmds='chmod 555 $lib' + # or fails outright, so override atomically: + install_override_mode=555 + ;; + +interix[3-9]*) + version_type=linux # correct to gnu/linux during the next big refactor + need_lib_prefix=no + need_version=no + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' + soname_spec='$libname$release$shared_ext$major' + dynamic_linker='Interix 3.x ld.so.1 (PE, like ELF)' + shlibpath_var=LD_LIBRARY_PATH + shlibpath_overrides_runpath=no + hardcode_into_libs=yes + ;; + +irix5* | irix6* | nonstopux*) + case $host_os in + nonstopux*) version_type=nonstopux ;; + *) + if test yes = "$lt_cv_prog_gnu_ld"; then + version_type=linux # correct to gnu/linux during the next big refactor + else + version_type=irix + fi ;; + esac + need_lib_prefix=no + need_version=no + soname_spec='$libname$release$shared_ext$major' + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$release$shared_ext $libname$shared_ext' + case $host_os in + irix5* | nonstopux*) + libsuff= shlibsuff= + ;; + *) + case $LD in # libtool.m4 will add one of these switches to LD + *-32|*"-32 "|*-melf32bsmip|*"-melf32bsmip ") + libsuff= shlibsuff= libmagic=32-bit;; + *-n32|*"-n32 "|*-melf32bmipn32|*"-melf32bmipn32 ") + libsuff=32 shlibsuff=N32 libmagic=N32;; + *-64|*"-64 "|*-melf64bmip|*"-melf64bmip ") + libsuff=64 shlibsuff=64 libmagic=64-bit;; + *) libsuff= shlibsuff= libmagic=never-match;; + esac + ;; + esac + shlibpath_var=LD_LIBRARY${shlibsuff}_PATH + shlibpath_overrides_runpath=no + sys_lib_search_path_spec="/usr/lib$libsuff /lib$libsuff /usr/local/lib$libsuff" + sys_lib_dlsearch_path_spec="/usr/lib$libsuff /lib$libsuff" + hardcode_into_libs=yes + ;; + +# No shared lib support for Linux oldld, aout, or coff. +linux*oldld* | linux*aout* | linux*coff*) + dynamic_linker=no + ;; + +linux*android*) + version_type=none # Android doesn't support versioned libraries. + need_lib_prefix=no + need_version=no + library_names_spec='$libname$release$shared_ext' + soname_spec='$libname$release$shared_ext' + finish_cmds= + shlibpath_var=LD_LIBRARY_PATH + shlibpath_overrides_runpath=yes + + # This implies no fast_install, which is unacceptable. + # Some rework will be needed to allow for fast_install + # before this can be enabled. + hardcode_into_libs=yes + + dynamic_linker='Android linker' + # Don't embed -rpath directories since the linker doesn't support them. + hardcode_libdir_flag_spec_F77='-L$libdir' + ;; + +# This must be glibc/ELF. +linux* | k*bsd*-gnu | kopensolaris*-gnu | gnu*) + version_type=linux # correct to gnu/linux during the next big refactor + need_lib_prefix=no + need_version=no + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' + soname_spec='$libname$release$shared_ext$major' + finish_cmds='PATH="\$PATH:/sbin" ldconfig -n $libdir' + shlibpath_var=LD_LIBRARY_PATH + shlibpath_overrides_runpath=no + + # Some binutils ld are patched to set DT_RUNPATH + if ${lt_cv_shlibpath_overrides_runpath+:} false; then : + $as_echo_n "(cached) " >&6 +else + lt_cv_shlibpath_overrides_runpath=no + save_LDFLAGS=$LDFLAGS + save_libdir=$libdir + eval "libdir=/foo; wl=\"$lt_prog_compiler_wl_F77\"; \ + LDFLAGS=\"\$LDFLAGS $hardcode_libdir_flag_spec_F77\"" + cat > conftest.$ac_ext <<_ACEOF + program main + + end +_ACEOF +if ac_fn_f77_try_link "$LINENO"; then : + if ($OBJDUMP -p conftest$ac_exeext) 2>/dev/null | grep "RUNPATH.*$libdir" >/dev/null; then : + lt_cv_shlibpath_overrides_runpath=yes +fi +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + LDFLAGS=$save_LDFLAGS + libdir=$save_libdir + +fi + + shlibpath_overrides_runpath=$lt_cv_shlibpath_overrides_runpath + + # This implies no fast_install, which is unacceptable. + # Some rework will be needed to allow for fast_install + # before this can be enabled. + hardcode_into_libs=yes + + # Ideally, we could use ldconfig to report *all* directores which are + # searched for libraries, however this is still not possible. Aside from not + # being certain /sbin/ldconfig is available, command + # 'ldconfig -N -X -v | grep ^/' on 64bit Fedora does not report /usr/lib64, + # even though it is searched at run-time. Try to do the best guess by + # appending ld.so.conf contents (and includes) to the search path. + if test -f /etc/ld.so.conf; then + lt_ld_extra=`awk '/^include / { system(sprintf("cd /etc; cat %s 2>/dev/null", \$2)); skip = 1; } { if (!skip) print \$0; skip = 0; }' < /etc/ld.so.conf | $SED -e 's/#.*//;/^[ ]*hwcap[ ]/d;s/[:, ]/ /g;s/=[^=]*$//;s/=[^= ]* / /g;s/"//g;/^$/d' | tr '\n' ' '` + sys_lib_dlsearch_path_spec="/lib /usr/lib $lt_ld_extra" + fi + + # We used to test for /lib/ld.so.1 and disable shared libraries on + # powerpc, because MkLinux only supported shared libraries with the + # GNU dynamic linker. Since this was broken with cross compilers, + # most powerpc-linux boxes support dynamic linking these days and + # people can always --disable-shared, the test was removed, and we + # assume the GNU/Linux dynamic linker is in use. + dynamic_linker='GNU/Linux ld.so' + ;; + +netbsd*) + version_type=sunos + need_lib_prefix=no + need_version=no + if echo __ELF__ | $CC -E - | $GREP __ELF__ >/dev/null; then + library_names_spec='$libname$release$shared_ext$versuffix $libname$shared_ext$versuffix' + finish_cmds='PATH="\$PATH:/sbin" ldconfig -m $libdir' + dynamic_linker='NetBSD (a.out) ld.so' + else + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' + soname_spec='$libname$release$shared_ext$major' + dynamic_linker='NetBSD ld.elf_so' + fi + shlibpath_var=LD_LIBRARY_PATH + shlibpath_overrides_runpath=yes + hardcode_into_libs=yes + ;; + +newsos6) + version_type=linux # correct to gnu/linux during the next big refactor + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' + shlibpath_var=LD_LIBRARY_PATH + shlibpath_overrides_runpath=yes + ;; + +*nto* | *qnx*) + version_type=qnx + need_lib_prefix=no + need_version=no + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' + soname_spec='$libname$release$shared_ext$major' + shlibpath_var=LD_LIBRARY_PATH + shlibpath_overrides_runpath=no + hardcode_into_libs=yes + dynamic_linker='ldqnx.so' + ;; + +openbsd* | bitrig*) + version_type=sunos + sys_lib_dlsearch_path_spec=/usr/lib + need_lib_prefix=no + if test -z "`echo __ELF__ | $CC -E - | $GREP __ELF__`"; then + need_version=no + else + need_version=yes + fi + library_names_spec='$libname$release$shared_ext$versuffix $libname$shared_ext$versuffix' + finish_cmds='PATH="\$PATH:/sbin" ldconfig -m $libdir' + shlibpath_var=LD_LIBRARY_PATH + shlibpath_overrides_runpath=yes + ;; + +os2*) + libname_spec='$name' + version_type=windows + shrext_cmds=.dll + need_version=no + need_lib_prefix=no + # OS/2 can only load a DLL with a base name of 8 characters or less. + soname_spec='`test -n "$os2dllname" && libname="$os2dllname"; + v=$($ECHO $release$versuffix | tr -d .-); + n=$($ECHO $libname | cut -b -$((8 - ${#v})) | tr . _); + $ECHO $n$v`$shared_ext' + library_names_spec='${libname}_dll.$libext' + dynamic_linker='OS/2 ld.exe' + shlibpath_var=BEGINLIBPATH + sys_lib_search_path_spec="/lib /usr/lib /usr/local/lib" + sys_lib_dlsearch_path_spec=$sys_lib_search_path_spec + postinstall_cmds='base_file=`basename \$file`~ + dlpath=`$SHELL 2>&1 -c '\''. $dir/'\''\$base_file'\''i; $ECHO \$dlname'\''`~ + dldir=$destdir/`dirname \$dlpath`~ + test -d \$dldir || mkdir -p \$dldir~ + $install_prog $dir/$dlname \$dldir/$dlname~ + chmod a+x \$dldir/$dlname~ + if test -n '\''$stripme'\'' && test -n '\''$striplib'\''; then + eval '\''$striplib \$dldir/$dlname'\'' || exit \$?; + fi' + postuninstall_cmds='dldll=`$SHELL 2>&1 -c '\''. $file; $ECHO \$dlname'\''`~ + dlpath=$dir/\$dldll~ + $RM \$dlpath' + ;; + +osf3* | osf4* | osf5*) + version_type=osf + need_lib_prefix=no + need_version=no + soname_spec='$libname$release$shared_ext$major' + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' + shlibpath_var=LD_LIBRARY_PATH + sys_lib_search_path_spec="/usr/shlib /usr/ccs/lib /usr/lib/cmplrs/cc /usr/lib /usr/local/lib /var/shlib" + sys_lib_dlsearch_path_spec=$sys_lib_search_path_spec + ;; + +rdos*) + dynamic_linker=no + ;; + +solaris*) + version_type=linux # correct to gnu/linux during the next big refactor + need_lib_prefix=no + need_version=no + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' + soname_spec='$libname$release$shared_ext$major' + shlibpath_var=LD_LIBRARY_PATH + shlibpath_overrides_runpath=yes + hardcode_into_libs=yes + # ldd complains unless libraries are executable + postinstall_cmds='chmod +x $lib' + ;; + +sunos4*) + version_type=sunos + library_names_spec='$libname$release$shared_ext$versuffix $libname$shared_ext$versuffix' + finish_cmds='PATH="\$PATH:/usr/etc" ldconfig $libdir' + shlibpath_var=LD_LIBRARY_PATH + shlibpath_overrides_runpath=yes + if test yes = "$with_gnu_ld"; then + need_lib_prefix=no + fi + need_version=yes + ;; + +sysv4 | sysv4.3*) + version_type=linux # correct to gnu/linux during the next big refactor + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' + soname_spec='$libname$release$shared_ext$major' + shlibpath_var=LD_LIBRARY_PATH + case $host_vendor in + sni) + shlibpath_overrides_runpath=no + need_lib_prefix=no + runpath_var=LD_RUN_PATH + ;; + siemens) + need_lib_prefix=no + ;; + motorola) + need_lib_prefix=no + need_version=no + shlibpath_overrides_runpath=no + sys_lib_search_path_spec='/lib /usr/lib /usr/ccs/lib' + ;; + esac + ;; + +sysv4*MP*) + if test -d /usr/nec; then + version_type=linux # correct to gnu/linux during the next big refactor + library_names_spec='$libname$shared_ext.$versuffix $libname$shared_ext.$major $libname$shared_ext' + soname_spec='$libname$shared_ext.$major' + shlibpath_var=LD_LIBRARY_PATH + fi + ;; + +sysv5* | sco3.2v5* | sco5v6* | unixware* | OpenUNIX* | sysv4*uw2*) + version_type=sco + need_lib_prefix=no + need_version=no + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext $libname$shared_ext' + soname_spec='$libname$release$shared_ext$major' + shlibpath_var=LD_LIBRARY_PATH + shlibpath_overrides_runpath=yes + hardcode_into_libs=yes + if test yes = "$with_gnu_ld"; then + sys_lib_search_path_spec='/usr/local/lib /usr/gnu/lib /usr/ccs/lib /usr/lib /lib' + else + sys_lib_search_path_spec='/usr/ccs/lib /usr/lib' + case $host_os in + sco3.2v5*) + sys_lib_search_path_spec="$sys_lib_search_path_spec /lib" + ;; + esac + fi + sys_lib_dlsearch_path_spec='/usr/lib' + ;; + +tpf*) + # TPF is a cross-target only. Preferred cross-host = GNU/Linux. + version_type=linux # correct to gnu/linux during the next big refactor + need_lib_prefix=no + need_version=no + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' + shlibpath_var=LD_LIBRARY_PATH + shlibpath_overrides_runpath=no + hardcode_into_libs=yes + ;; + +uts4*) + version_type=linux # correct to gnu/linux during the next big refactor + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' + soname_spec='$libname$release$shared_ext$major' + shlibpath_var=LD_LIBRARY_PATH + ;; + +*) + dynamic_linker=no + ;; +esac +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $dynamic_linker" >&5 +$as_echo "$dynamic_linker" >&6; } +test no = "$dynamic_linker" && can_build_shared=no + +variables_saved_for_relink="PATH $shlibpath_var $runpath_var" +if test yes = "$GCC"; then + variables_saved_for_relink="$variables_saved_for_relink GCC_EXEC_PREFIX COMPILER_PATH LIBRARY_PATH" +fi + +if test set = "${lt_cv_sys_lib_search_path_spec+set}"; then + sys_lib_search_path_spec=$lt_cv_sys_lib_search_path_spec +fi + +if test set = "${lt_cv_sys_lib_dlsearch_path_spec+set}"; then + sys_lib_dlsearch_path_spec=$lt_cv_sys_lib_dlsearch_path_spec +fi + +# remember unaugmented sys_lib_dlsearch_path content for libtool script decls... +configure_time_dlsearch_path=$sys_lib_dlsearch_path_spec + +# ... but it needs LT_SYS_LIBRARY_PATH munging for other configure-time code +func_munge_path_list sys_lib_dlsearch_path_spec "$LT_SYS_LIBRARY_PATH" + +# to be used as default LT_SYS_LIBRARY_PATH value in generated libtool +configure_time_lt_sys_library_path=$LT_SYS_LIBRARY_PATH + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking how to hardcode library paths into programs" >&5 +$as_echo_n "checking how to hardcode library paths into programs... " >&6; } +hardcode_action_F77= +if test -n "$hardcode_libdir_flag_spec_F77" || + test -n "$runpath_var_F77" || + test yes = "$hardcode_automatic_F77"; then + + # We can hardcode non-existent directories. + if test no != "$hardcode_direct_F77" && + # If the only mechanism to avoid hardcoding is shlibpath_var, we + # have to relink, otherwise we might link with an installed library + # when we should be linking with a yet-to-be-installed one + ## test no != "$_LT_TAGVAR(hardcode_shlibpath_var, F77)" && + test no != "$hardcode_minus_L_F77"; then + # Linking always hardcodes the temporary library directory. + hardcode_action_F77=relink + else + # We can link without hardcoding, and we can hardcode nonexisting dirs. + hardcode_action_F77=immediate + fi +else + # We cannot hardcode anything, or else we can only hardcode existing + # directories. + hardcode_action_F77=unsupported +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $hardcode_action_F77" >&5 +$as_echo "$hardcode_action_F77" >&6; } + +if test relink = "$hardcode_action_F77" || + test yes = "$inherit_rpath_F77"; then + # Fast installation is not supported + enable_fast_install=no +elif test yes = "$shlibpath_overrides_runpath" || + test no = "$enable_shared"; then + # Fast installation is not necessary + enable_fast_install=needless +fi + + + + + + + + fi # test -n "$compiler" + + GCC=$lt_save_GCC + CC=$lt_save_CC + CFLAGS=$lt_save_CFLAGS +fi # test yes != "$_lt_disable_F77" + +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + + + + + + + + + + + + + + ac_config_commands="$ac_config_commands libtool" + + + + +# Only expand once: + + + + +## cross-compiling: added May 2007, not actually used + +if test "${cross_compiling}" = yes; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for build C compiler" >&5 +$as_echo_n "checking for build C compiler... " >&6; } + build_cc_works=no + echo "int main(void) { return 0; }" > conftest.c + if test -n "${BUILD_CC}" && "${BUILD_CC}" conftest.c -o conftest && ./conftest; then + build_cc_works=yes; + fi + if test "${build_cc_works}" = no; then + for prog in gcc cc; do + if "${prog}" conftest.c -o conftest >/dev/null 2>&1 && ./conftest; then + BUILD_CC="${prog}"; build_cc_works=yes; break + fi + done + fi + rm -rf conftest conftest.* core + if test "${build_cc_works}" = no; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: none" >&5 +$as_echo "none" >&6; } + as_fn_error $? "Build C compiler doesn't work. Set BUILD_CC to a compiler capable of creating a binary native to the build machine." "$LINENO" 5 + fi + { $as_echo "$as_me:${as_lineno-$LINENO}: result: ${BUILD_CC}" >&5 +$as_echo "${BUILD_CC}" >&6; } + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for build R" >&5 +$as_echo_n "checking for build R... " >&6; } + : ${BUILD_R=R} + if echo 'cat(R.home())'|"${BUILD_R}" --vanilla --slave >/dev/null 2>&1; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: ${BUILD_R}" >&5 +$as_echo "${BUILD_R}" >&6; } + else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: none" >&5 +$as_echo "none" >&6; } + as_fn_error $? "Build R doesn't work. Set BUILD_R to a native build of the same R version that you want to cross-compile." "$LINENO" 5 + fi +fi + + + + if test "${cross_compiling}" = yes; then + CROSS_COMPILING_TRUE= + CROSS_COMPILING_FALSE='#' +else + CROSS_COMPILING_TRUE='#' + CROSS_COMPILING_FALSE= +fi + + +### * Checks for libraries. + +## Set up LD_LIBRARY_PATH or equivalent. +## <FIXME> +## What is this doing *HERE*? +## Should be needed for tests using AC_RUN_IFELSE()? +## Make sure that non-standard directories specified via '-L' are really +## searched in the tests. +## OTOH, R_LD_LIBRARY_PATH in the environment is meant to be the final version. +R_LD_LIBRARY_PATH_save=${R_LD_LIBRARY_PATH} +R_LD_LIBRARY_PATH= +case "${host_os}" in + darwin*) + ## Darwin provides a full path in the ID of each library such + ## that the linker can add library's path to the binary at link time. + ## This allows the dyld to find libraries even without xx_LIBRARY_PATH. + ## No paths should be added to R_LD_LIBRARY_PATH (which in turn + ## changes DYLD_LIBRARY_PATH), because they override the system + ## look-up sequence. Such automatic override has proven to break things + ## like system frameworks (e.g. ImageIO or OpenGL framework). + ## Not so bad in later versions of Darwin, + ## where DYLD_FALLBACK_LIBRARY_PATH is used (see below). + ;; + *) + for arg in ${LDFLAGS}; do + case "${arg}" in + -L*) + lib=`echo ${arg} | sed "s/^-L//"` + separator="${PATH_SEPARATOR}" +test -z "${separator}" && separator=" " +if test -z "${R_LD_LIBRARY_PATH}"; then + R_LD_LIBRARY_PATH="${lib}" +else + R_LD_LIBRARY_PATH="${R_LD_LIBRARY_PATH}${separator}${lib}" +fi + ;; + esac + done + ;; +esac + +## Record name of environment variable which tells the dynamic linker +## where to find shlibs (typically, 'LD_LIBRARY_PATH'). +## Used in etc/ldpaths: As from R 3.0.0 override what libtool thinks on macOS +## http://hublog.hubmed.org/archives/001192.html suggests this was in 10.4 +## However, as from 10.11 this variable is not passed down to shells. +case "${host_os}" in + darwin*) + Rshlibpath_var=DYLD_FALLBACK_LIBRARY_PATH + ;; + *) + Rshlibpath_var=${shlibpath_var} +esac + +## Export LD_LIBRARY_PATH or equivalent. +if eval "test -z \"\${${Rshlibpath_var}}\""; then + eval "${Rshlibpath_var}=\"${R_LD_LIBRARY_PATH}\"" +else + eval "${Rshlibpath_var}=\"${R_LD_LIBRARY_PATH}${PATH_SEPARATOR}\${${Rshlibpath_var}}\"" +fi +eval "export ${Rshlibpath_var}" + + +## record how to strip shared/dynamic libraries. + +## record how to strip static libraries. +stripstaticlib=${old_striplib} + + +## <NOTE> +## This actually comes from libtool.m4. +LIBM= +case $host in +*-*-beos* | *-*-cegcc* | *-*-cygwin* | *-*-haiku* | *-*-pw32* | *-*-darwin*) + # These system don't have libm, or don't need it + ;; +*-ncr-sysv4.3*) + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for _mwvalidcheckl in -lmw" >&5 +$as_echo_n "checking for _mwvalidcheckl in -lmw... " >&6; } +if ${ac_cv_lib_mw__mwvalidcheckl+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lmw $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char _mwvalidcheckl (); +int +main () +{ +return _mwvalidcheckl (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_mw__mwvalidcheckl=yes +else + ac_cv_lib_mw__mwvalidcheckl=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_mw__mwvalidcheckl" >&5 +$as_echo "$ac_cv_lib_mw__mwvalidcheckl" >&6; } +if test "x$ac_cv_lib_mw__mwvalidcheckl" = xyes; then : + LIBM=-lmw +fi + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for cos in -lm" >&5 +$as_echo_n "checking for cos in -lm... " >&6; } +if ${ac_cv_lib_m_cos+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char cos (); +int +main () +{ +return cos (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_cos=yes +else + ac_cv_lib_m_cos=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_cos" >&5 +$as_echo "$ac_cv_lib_m_cos" >&6; } +if test "x$ac_cv_lib_m_cos" = xyes; then : + LIBM="$LIBM -lm" +fi + + ;; +*) + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for cos in -lm" >&5 +$as_echo_n "checking for cos in -lm... " >&6; } +if ${ac_cv_lib_m_cos+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char cos (); +int +main () +{ +return cos (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_cos=yes +else + ac_cv_lib_m_cos=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_cos" >&5 +$as_echo "$ac_cv_lib_m_cos" >&6; } +if test "x$ac_cv_lib_m_cos" = xyes; then : + LIBM=-lm +fi + + ;; +esac + + + +## </NOTE> +## AC_CHECK_LIBM computes LIBM but does not add to LIBS, hence we do +## the following as well. +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for sin in -lm" >&5 +$as_echo_n "checking for sin in -lm... " >&6; } +if ${ac_cv_lib_m_sin+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char sin (); +int +main () +{ +return sin (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_sin=yes +else + ac_cv_lib_m_sin=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_sin" >&5 +$as_echo "$ac_cv_lib_m_sin" >&6; } +if test "x$ac_cv_lib_m_sin" = xyes; then : + cat >>confdefs.h <<_ACEOF +#define HAVE_LIBM 1 +_ACEOF + + LIBS="-lm $LIBS" + +fi + +case "${host_os}" in + darwin*) + ## macOS >= 10.3 include dlcompat in libSystem + ## This is ancient history + ## SI says we want '-lcc_dynamic' on Darwin, although currently + ## https://developer.apple.com/documentation/MacOSX/ has nothing + ## official. Bill Northcott <w.northcott@unsw.edu.au> points out + ## that it is only needed for GCC 3.x (and earlier) ... + if test "${GCC}" = yes; then + case "${CC_VERSION}" in + 2.*|3.*) + as_fn_error $? "Your gcc is too old." "$LINENO" 5 + esac + fi + ;; + *) + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for dlopen in -ldl" >&5 +$as_echo_n "checking for dlopen in -ldl... " >&6; } +if ${ac_cv_lib_dl_dlopen+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-ldl $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char dlopen (); +int +main () +{ +return dlopen (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_dl_dlopen=yes +else + ac_cv_lib_dl_dlopen=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_dl_dlopen" >&5 +$as_echo "$ac_cv_lib_dl_dlopen" >&6; } +if test "x$ac_cv_lib_dl_dlopen" = xyes; then : + cat >>confdefs.h <<_ACEOF +#define HAVE_LIBDL 1 +_ACEOF + + LIBS="-ldl $LIBS" + +fi + + ;; +esac + +## Readline. +if test "${use_readline}" = yes; then + for ac_header in readline/history.h readline/readline.h +do : + as_ac_Header=`$as_echo "ac_cv_header_$ac_header" | $as_tr_sh` +ac_fn_c_check_header_mongrel "$LINENO" "$ac_header" "$as_ac_Header" "$ac_includes_default" +if eval test \"x\$"$as_ac_Header"\" = x"yes"; then : + cat >>confdefs.h <<_ACEOF +#define `$as_echo "HAVE_$ac_header" | $as_tr_cpp` 1 +_ACEOF + +fi + +done + + r_save_LIBS="${LIBS}" + LIBS= + ## don't use the cached value as we need to rebuild LIBS + unset ac_cv_lib_readline_rl_callback_read_char + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for rl_callback_read_char in -lreadline" >&5 +$as_echo_n "checking for rl_callback_read_char in -lreadline... " >&6; } +if ${ac_cv_lib_readline_rl_callback_read_char+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lreadline $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char rl_callback_read_char (); +int +main () +{ +return rl_callback_read_char (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_readline_rl_callback_read_char=yes +else + ac_cv_lib_readline_rl_callback_read_char=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_readline_rl_callback_read_char" >&5 +$as_echo "$ac_cv_lib_readline_rl_callback_read_char" >&6; } +if test "x$ac_cv_lib_readline_rl_callback_read_char" = xyes; then : + cat >>confdefs.h <<_ACEOF +#define HAVE_LIBREADLINE 1 +_ACEOF + + LIBS="-lreadline $LIBS" + +fi + + use_readline="${ac_cv_lib_readline_rl_callback_read_char}" + if test "${use_readline}" = no; then + ## only need ncurses if libreadline is not statically linked against it + unset ac_cv_lib_readline_rl_callback_read_char + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for main in -lncurses" >&5 +$as_echo_n "checking for main in -lncurses... " >&6; } +if ${ac_cv_lib_ncurses_main+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lncurses $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + + +int +main () +{ +return main (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_ncurses_main=yes +else + ac_cv_lib_ncurses_main=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_ncurses_main" >&5 +$as_echo "$ac_cv_lib_ncurses_main" >&6; } +if test "x$ac_cv_lib_ncurses_main" = xyes; then : + cat >>confdefs.h <<_ACEOF +#define HAVE_LIBNCURSES 1 +_ACEOF + + LIBS="-lncurses $LIBS" + +else + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for main in -ltermcap" >&5 +$as_echo_n "checking for main in -ltermcap... " >&6; } +if ${ac_cv_lib_termcap_main+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-ltermcap $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + + +int +main () +{ +return main (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_termcap_main=yes +else + ac_cv_lib_termcap_main=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_termcap_main" >&5 +$as_echo "$ac_cv_lib_termcap_main" >&6; } +if test "x$ac_cv_lib_termcap_main" = xyes; then : + cat >>confdefs.h <<_ACEOF +#define HAVE_LIBTERMCAP 1 +_ACEOF + + LIBS="-ltermcap $LIBS" + +else + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for main in -ltermlib" >&5 +$as_echo_n "checking for main in -ltermlib... " >&6; } +if ${ac_cv_lib_termlib_main+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-ltermlib $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + + +int +main () +{ +return main (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_termlib_main=yes +else + ac_cv_lib_termlib_main=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_termlib_main" >&5 +$as_echo "$ac_cv_lib_termlib_main" >&6; } +if test "x$ac_cv_lib_termlib_main" = xyes; then : + cat >>confdefs.h <<_ACEOF +#define HAVE_LIBTERMLIB 1 +_ACEOF + + LIBS="-ltermlib $LIBS" + +fi + +fi + +fi + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for rl_callback_read_char in -lreadline" >&5 +$as_echo_n "checking for rl_callback_read_char in -lreadline... " >&6; } +if ${ac_cv_lib_readline_rl_callback_read_char+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lreadline $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char rl_callback_read_char (); +int +main () +{ +return rl_callback_read_char (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_readline_rl_callback_read_char=yes +else + ac_cv_lib_readline_rl_callback_read_char=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_readline_rl_callback_read_char" >&5 +$as_echo "$ac_cv_lib_readline_rl_callback_read_char" >&6; } +if test "x$ac_cv_lib_readline_rl_callback_read_char" = xyes; then : + cat >>confdefs.h <<_ACEOF +#define HAVE_LIBREADLINE 1 +_ACEOF + + LIBS="-lreadline $LIBS" + +fi + + use_readline="${ac_cv_lib_readline_rl_callback_read_char}" + if test "${use_readline}" = yes; then + use_readline="${ac_cv_header_readline_readline_h}" + fi + fi + if test "${use_readline}" = no; then + as_fn_error $? "--with-readline=yes (default) and headers/libs are not available" "$LINENO" 5 + else + ## the NetBSD emulation supplied by macOS does not have this + for ac_func in history_truncate_file +do : + ac_fn_c_check_func "$LINENO" "history_truncate_file" "ac_cv_func_history_truncate_file" +if test "x$ac_cv_func_history_truncate_file" = xyes; then : + cat >>confdefs.h <<_ACEOF +#define HAVE_HISTORY_TRUNCATE_FILE 1 +_ACEOF + +fi +done + + ## rl_completion_matches is >= 4.2. + ## rl_resize_terminal is >= 4.0 ane we use it only for >= 6.3. + ## rl_callback_sigcleanup is in pre-releases for 7.0, not yet used. + for ac_func in rl_callback_sigcleanup rl_completion_matches rl_resize_terminal rl_sort_completion_matches +do +as_ac_Symbol=`$as_echo "ac_cv_have_decl_$ac_func" | $as_tr_sh` +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $ac_func exists and is declared" >&5 +$as_echo_n "checking whether $ac_func exists and is declared... " >&6; } +if eval \${$as_ac_Symbol+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <stdio.h> +#include <readline/readline.h> + + +int +main () +{ +#ifndef $ac_func + char *p = (char *) $ac_func; +#endif + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + eval "$as_ac_Symbol=yes" +else + eval "$as_ac_Symbol=no" +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +fi +eval ac_res=\$$as_ac_Symbol + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } +if test `eval 'as_val=${'$as_ac_Symbol'};$as_echo "$as_val"'` = yes; then : + cat >>confdefs.h <<_ACEOF +#define `$as_echo "HAVE_$ac_func" | $as_tr_cpp` 1 +_ACEOF + +fi +done + + fi + READLINE_LIBS="${LIBS}" + LIBS="${r_save_LIBS}" +fi + + +### * Checks for header files. + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for ANSI C header files" >&5 +$as_echo_n "checking for ANSI C header files... " >&6; } +if ${ac_cv_header_stdc+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <stdlib.h> +#include <stdarg.h> +#include <string.h> +#include <float.h> + +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_cv_header_stdc=yes +else + ac_cv_header_stdc=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + +if test $ac_cv_header_stdc = yes; then + # SunOS 4.x string.h does not declare mem*, contrary to ANSI. + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <string.h> + +_ACEOF +if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | + $EGREP "memchr" >/dev/null 2>&1; then : + +else + 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 confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <stdlib.h> + +_ACEOF +if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | + $EGREP "free" >/dev/null 2>&1; then : + +else + 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 confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <ctype.h> +#include <stdlib.h> +#if ((' ' & 0x0FF) == 0x020) +# define ISLOWER(c) ('a' <= (c) && (c) <= 'z') +# define TOUPPER(c) (ISLOWER(c) ? 'A' + ((c) - 'a') : (c)) +#else +# define ISLOWER(c) \ + (('a' <= (c) && (c) <= 'i') \ + || ('j' <= (c) && (c) <= 'r') \ + || ('s' <= (c) && (c) <= 'z')) +# define TOUPPER(c) (ISLOWER(c) ? ((c) | 0x40) : (c)) +#endif + +#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)) + return 2; + return 0; +} +_ACEOF +if ac_fn_c_try_run "$LINENO"; then : + +else + ac_cv_header_stdc=no +fi +rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ + conftest.$ac_objext conftest.beam conftest.$ac_ext +fi + +fi +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_header_stdc" >&5 +$as_echo "$ac_cv_header_stdc" >&6; } +if test $ac_cv_header_stdc = yes; then + +$as_echo "#define STDC_HEADERS 1" >>confdefs.h + +fi + +ac_header_dirent=no +for ac_hdr in dirent.h sys/ndir.h sys/dir.h ndir.h; do + as_ac_Header=`$as_echo "ac_cv_header_dirent_$ac_hdr" | $as_tr_sh` +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_hdr that defines DIR" >&5 +$as_echo_n "checking for $ac_hdr that defines DIR... " >&6; } +if eval \${$as_ac_Header+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <sys/types.h> +#include <$ac_hdr> + +int +main () +{ +if ((DIR *) 0) +return 0; + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + eval "$as_ac_Header=yes" +else + eval "$as_ac_Header=no" +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi +eval ac_res=\$$as_ac_Header + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } +if eval test \"x\$"$as_ac_Header"\" = x"yes"; then : + cat >>confdefs.h <<_ACEOF +#define `$as_echo "HAVE_$ac_hdr" | $as_tr_cpp` 1 +_ACEOF + +ac_header_dirent=$ac_hdr; break +fi + +done +# Two versions of opendir et al. are in -ldir and -lx on SCO Xenix. +if test $ac_header_dirent = dirent.h; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for library containing opendir" >&5 +$as_echo_n "checking for library containing opendir... " >&6; } +if ${ac_cv_search_opendir+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_func_search_save_LIBS=$LIBS +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char opendir (); +int +main () +{ +return opendir (); + ; + return 0; +} +_ACEOF +for ac_lib in '' dir; do + if test -z "$ac_lib"; then + ac_res="none required" + else + ac_res=-l$ac_lib + LIBS="-l$ac_lib $ac_func_search_save_LIBS" + fi + if ac_fn_c_try_link "$LINENO"; then : + ac_cv_search_opendir=$ac_res +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext + if ${ac_cv_search_opendir+:} false; then : + break +fi +done +if ${ac_cv_search_opendir+:} false; then : + +else + ac_cv_search_opendir=no +fi +rm conftest.$ac_ext +LIBS=$ac_func_search_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_search_opendir" >&5 +$as_echo "$ac_cv_search_opendir" >&6; } +ac_res=$ac_cv_search_opendir +if test "$ac_res" != no; then : + test "$ac_res" = "none required" || LIBS="$ac_res $LIBS" + +fi + +else + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for library containing opendir" >&5 +$as_echo_n "checking for library containing opendir... " >&6; } +if ${ac_cv_search_opendir+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_func_search_save_LIBS=$LIBS +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char opendir (); +int +main () +{ +return opendir (); + ; + return 0; +} +_ACEOF +for ac_lib in '' x; do + if test -z "$ac_lib"; then + ac_res="none required" + else + ac_res=-l$ac_lib + LIBS="-l$ac_lib $ac_func_search_save_LIBS" + fi + if ac_fn_c_try_link "$LINENO"; then : + ac_cv_search_opendir=$ac_res +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext + if ${ac_cv_search_opendir+:} false; then : + break +fi +done +if ${ac_cv_search_opendir+:} false; then : + +else + ac_cv_search_opendir=no +fi +rm conftest.$ac_ext +LIBS=$ac_func_search_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_search_opendir" >&5 +$as_echo "$ac_cv_search_opendir" >&6; } +ac_res=$ac_cv_search_opendir +if test "$ac_res" != no; then : + test "$ac_res" = "none required" || LIBS="$ac_res $LIBS" + +fi + +fi + +## we also assume readdir and closedir +if test "${ac_cv_search_opendir}" = "no"; then + as_fn_error $? "Building R requires the 'opendir' system call" "$LINENO" 5 +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for sys/wait.h that is POSIX.1 compatible" >&5 +$as_echo_n "checking for sys/wait.h that is POSIX.1 compatible... " >&6; } +if ${ac_cv_header_sys_wait_h+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <sys/types.h> +#include <sys/wait.h> +#ifndef WEXITSTATUS +# define WEXITSTATUS(stat_val) ((unsigned int) (stat_val) >> 8) +#endif +#ifndef WIFEXITED +# define WIFEXITED(stat_val) (((stat_val) & 255) == 0) +#endif + +int +main () +{ + int s; + wait (&s); + s = WIFEXITED (s) ? WEXITSTATUS (s) : 1; + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_cv_header_sys_wait_h=yes +else + ac_cv_header_sys_wait_h=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_header_sys_wait_h" >&5 +$as_echo "$ac_cv_header_sys_wait_h" >&6; } +if test $ac_cv_header_sys_wait_h = yes; then + +$as_echo "#define HAVE_SYS_WAIT_H 1" >>confdefs.h + +fi + +## <NOTE> +## Some of these are also checked for when Autoconf computes the default +## includes. +## +## The following headers are POSIX, +## We use sched.h for Linux-specific features (affinity) +for ac_header in dlfcn.h fcntl.h glob.h grp.h pwd.h sched.h strings.h \ + sys/resource.h sys/select.h sys/socket.h sys/stat.h sys/time.h \ + sys/times.h sys/utsname.h unistd.h utime.h +do : + as_ac_Header=`$as_echo "ac_cv_header_$ac_header" | $as_tr_sh` +ac_fn_c_check_header_mongrel "$LINENO" "$ac_header" "$as_ac_Header" "$ac_includes_default" +if eval test \"x\$"$as_ac_Header"\" = x"yes"; then : + cat >>confdefs.h <<_ACEOF +#define `$as_echo "HAVE_$ac_header" | $as_tr_cpp` 1 +_ACEOF + +fi + +done + +## dl.h is used in src/unix/hpdlfcn.c included from src/unix/dynload.c on HP-UX +## features.h is used by date-time code on Linux. +## floatingpoint.h is used for fpsetmask on FreeBSD. +## sys/param.h is one way to get PATH_MAX. +for ac_header in arpa/inet.h dl.h elf.h features.h floatingpoint.h \ + langinfo.h netdb.h netinet/in.h sys/param.h +do : + as_ac_Header=`$as_echo "ac_cv_header_$ac_header" | $as_tr_sh` +ac_fn_c_check_header_mongrel "$LINENO" "$ac_header" "$as_ac_Header" "$ac_includes_default" +if eval test \"x\$"$as_ac_Header"\" = x"yes"; then : + cat >>confdefs.h <<_ACEOF +#define `$as_echo "HAVE_$ac_header" | $as_tr_cpp` 1 +_ACEOF + +fi + +done + +## stdalign.h is C11. +for ac_header in stdalign.h +do : + ac_fn_c_check_header_mongrel "$LINENO" "stdalign.h" "ac_cv_header_stdalign_h" "$ac_includes_default" +if test "x$ac_cv_header_stdalign_h" = xyes; then : + cat >>confdefs.h <<_ACEOF +#define HAVE_STDALIGN_H 1 +_ACEOF + +fi + +done + +## These are C99 headers but some C code (written to work also +## without assuming C99) may need the corresponding conditionals. +for ac_header in errno.h inttypes.h limits.h locale.h stdarg.h stdbool.h \ + stdint.h string.h +do : + as_ac_Header=`$as_echo "ac_cv_header_$ac_header" | $as_tr_sh` +ac_fn_c_check_header_mongrel "$LINENO" "$ac_header" "$as_ac_Header" "$ac_includes_default" +if eval test \"x\$"$as_ac_Header"\" = x"yes"; then : + cat >>confdefs.h <<_ACEOF +#define `$as_echo "HAVE_$ac_header" | $as_tr_cpp` 1 +_ACEOF + +fi + +done + +## only vsnprintf.c requires stdarg.h + +## We also use without checking sys/sysctl.h, but only on *BSD and macOS +## The default includes check for sys/types.h (POSIX), which we use unconditionally +## </NOTE> + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether setjmp.h is POSIX.1 compatible" >&5 +$as_echo_n "checking whether setjmp.h is POSIX.1 compatible... " >&6; } +if ${r_cv_header_setjmp_posix+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <setjmp.h> +int +main () +{ +sigjmp_buf b; +sigsetjmp(b, 0); +siglongjmp(b, 1); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + r_cv_header_setjmp_posix=yes +else + r_cv_header_setjmp_posix=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $r_cv_header_setjmp_posix" >&5 +$as_echo "$r_cv_header_setjmp_posix" >&6; } +ac_fn_c_check_decl "$LINENO" "sigsetjmp" "ac_cv_have_decl_sigsetjmp" "#include <setjmp.h> +" +if test "x$ac_cv_have_decl_sigsetjmp" = xyes; then : + ac_have_decl=1 +else + ac_have_decl=0 +fi + +cat >>confdefs.h <<_ACEOF +#define HAVE_DECL_SIGSETJMP $ac_have_decl +_ACEOF +ac_fn_c_check_decl "$LINENO" "siglongjmp" "ac_cv_have_decl_siglongjmp" "#include <setjmp.h> +" +if test "x$ac_cv_have_decl_siglongjmp" = xyes; then : + ac_have_decl=1 +else + ac_have_decl=0 +fi + +cat >>confdefs.h <<_ACEOF +#define HAVE_DECL_SIGLONGJMP $ac_have_decl +_ACEOF + +if test "$ac_cv_have_decl_sigsetjmp" = no; then + r_cv_header_setjmp_posix=no +fi +if test "$ac_cv_have_decl_siglongjmp" = no; then + r_cv_header_setjmp_posix=no +fi +if test "${r_cv_header_setjmp_posix}" = yes; then + +$as_echo "#define HAVE_POSIX_SETJMP 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for GNU C library with version >= 2" >&5 +$as_echo_n "checking for GNU C library with version >= 2... " >&6; } +if ${r_cv_header_glibc2+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <stdio.h> +#if defined __GLIBC__ && __GLIBC__ >= 2 + yes +#endif + +_ACEOF +if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | + $EGREP "yes" >/dev/null 2>&1; then : + r_cv_header_glibc2=yes +else + r_cv_header_glibc2=no +fi +rm -f conftest* + + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $r_cv_header_glibc2" >&5 +$as_echo "$r_cv_header_glibc2" >&6; } +if test "${r_cv_header_glibc2}" = yes; then + +$as_echo "#define HAVE_GLIBC2 1" >>confdefs.h + +fi + + +### * Checks for types. + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking return type of signal handlers" >&5 +$as_echo_n "checking return type of signal handlers... " >&6; } +if ${ac_cv_type_signal+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <sys/types.h> +#include <signal.h> + +int +main () +{ +return *(signal (0, 0)) (0) == 1; + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_cv_type_signal=int +else + ac_cv_type_signal=void +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_type_signal" >&5 +$as_echo "$ac_cv_type_signal" >&6; } + +cat >>confdefs.h <<_ACEOF +#define RETSIGTYPE $ac_cv_type_signal +_ACEOF + + +## liblzma uses uint64_t: used unconditionally in src/main/util.c +ac_fn_c_find_uintX_t "$LINENO" "64" "ac_cv_c_uint64_t" +case $ac_cv_c_uint64_t in #( + no|yes) ;; #( + *) + +$as_echo "#define _UINT64_T 1" >>confdefs.h + + +cat >>confdefs.h <<_ACEOF +#define uint64_t $ac_cv_c_uint64_t +_ACEOF +;; + esac + +ac_fn_c_check_type "$LINENO" "int64_t" "ac_cv_type_int64_t" "$ac_includes_default" +if test "x$ac_cv_type_int64_t" = xyes; then : + +cat >>confdefs.h <<_ACEOF +#define HAVE_INT64_T 1 +_ACEOF + + +fi +ac_fn_c_check_type "$LINENO" "int_fast64_t" "ac_cv_type_int_fast64_t" "$ac_includes_default" +if test "x$ac_cv_type_int_fast64_t" = xyes; then : + +cat >>confdefs.h <<_ACEOF +#define HAVE_INT_FAST64_T 1 +_ACEOF + + +fi + +ac_fn_c_check_type "$LINENO" "pid_t" "ac_cv_type_pid_t" "$ac_includes_default" +if test "x$ac_cv_type_pid_t" = xyes; then : + +else + +cat >>confdefs.h <<_ACEOF +#define pid_t int +_ACEOF + +fi + +ac_fn_c_check_type "$LINENO" "size_t" "ac_cv_type_size_t" "$ac_includes_default" +if test "x$ac_cv_type_size_t" = xyes; then : + +else + +cat >>confdefs.h <<_ACEOF +#define size_t unsigned int +_ACEOF + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether SIZE_MAX is declared" >&5 +$as_echo_n "checking whether SIZE_MAX is declared... " >&6; } +if ${r_cv_size_max+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test "$cross_compiling" = yes; then : + r_cv_size_max=no +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +#include <stdlib.h> +#ifdef HAVE_INTTYPES_H +# include <inttypes.h> +#endif +#ifdef HAVE_STDINT_H +# include <stdint.h> +#endif +#ifdef HAVE_LIMITS_H +# include <limits.h> +#endif + +int +main() { +#ifndef SIZE_MAX + char *p = (char *) SIZE_MAX; +#endif + + ; + return 0; +} + +_ACEOF +if ac_fn_c_try_run "$LINENO"; then : + r_cv_size_max=yes +else + r_cv_size_max=no +fi +rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ + conftest.$ac_objext conftest.beam conftest.$ac_ext +fi + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $r_cv_size_max" >&5 +$as_echo "$r_cv_size_max" >&6; } +if test "x${r_cv_size_max}" = xyes; then + +$as_echo "#define HAVE_DECL_SIZE_MAX 1" >>confdefs.h + +fi + +ac_fn_c_check_type "$LINENO" "blkcnt_t" "ac_cv_type_blkcnt_t" "$ac_includes_default" +if test "x$ac_cv_type_blkcnt_t" = xyes; then : + +else + +cat >>confdefs.h <<_ACEOF +#define blkcnt_t long +_ACEOF + +fi + + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for type of socket length" >&5 +$as_echo_n "checking for type of socket length... " >&6; } +if ${r_cv_type_socklen+:} false; then : + $as_echo_n "(cached) " >&6 +else + for t in socklen_t size_t int; do + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +#include <stddef.h> +#include <sys/types.h> +#ifdef HAVE_SYS_SOCKET_H +# include <sys/socket.h> +#endif +#ifdef Win32 +# include <winsock.h> +#endif + +int +main () +{ +(void)getsockopt (1, 1, 1, NULL, (${t} *)NULL) + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + r_cv_type_socklen=${t}; break +else + r_cv_type_socklen= +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +done +fi + +## size_t works on Windows but is unsigned and int is correct +case "${host_os}" in + cygwin*|mingw*|windows*|winnt) + r_cv_type_socklen=int + ;; +esac +if test "x${r_cv_type_socklen}" = x; then + warn_type_socklen="could not determine type of socket length" + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: ${warn_type_socklen}" >&5 +$as_echo "$as_me: WARNING: ${warn_type_socklen}" >&2;} +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: ${r_cv_type_socklen} *" >&5 +$as_echo "${r_cv_type_socklen} *" >&6; } +fi + +cat >>confdefs.h <<_ACEOF +#define R_SOCKLEN_T ${r_cv_type_socklen} +_ACEOF + + +ac_fn_c_check_type "$LINENO" "stack_t" "ac_cv_type_stack_t" "#include <signal.h> +" +if test "x$ac_cv_type_stack_t" = xyes; then : + +cat >>confdefs.h <<_ACEOF +#define HAVE_STACK_T 1 +_ACEOF + + +fi + +## These are optional C99 types, which we used to typedef in Defn.h if absent. +## There seems some confusion as to where they should be defined: +## the standard says stdint.h but drafts and Solaris 8 have inttypes.h. +## It seems all systems having stdint.h include it in inttypes.h, and +## POSIX requires that. But we will make sure. +ac_fn_c_check_type "$LINENO" "intptr_t" "ac_cv_type_intptr_t" "#ifdef HAVE_INTTYPES_H +#include <inttypes.h> +#endif +#ifdef HAVE_STDINT_H +#include <stdint.h> +#endif +" +if test "x$ac_cv_type_intptr_t" = xyes; then : + +cat >>confdefs.h <<_ACEOF +#define HAVE_INTPTR_T 1 +_ACEOF + + +fi +ac_fn_c_check_type "$LINENO" "uintptr_t" "ac_cv_type_uintptr_t" "#ifdef HAVE_INTTYPES_H +#include <inttypes.h> +#endif +#ifdef HAVE_STDINT_H +#include <stdint.h> +#endif +" +if test "x$ac_cv_type_uintptr_t" = xyes; then : + +cat >>confdefs.h <<_ACEOF +#define HAVE_UINTPTR_T 1 +_ACEOF + + +fi + + +### * Checks for compiler characteristics. + +### ** Generic tests for the C, Fortran 77 and C++ compilers. + +### *** C compiler. + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether byte ordering is bigendian" >&5 +$as_echo_n "checking whether byte ordering is bigendian... " >&6; } +if ${ac_cv_c_bigendian+:} false; then : + $as_echo_n "(cached) " >&6 +else + # See if sys/param.h defines the BYTE_ORDER macro. +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <sys/types.h> +#include <sys/param.h> + +int +main () +{ +#if ! (defined BYTE_ORDER && defined BIG_ENDIAN && defined LITTLE_ENDIAN \ + && BYTE_ORDER && BIG_ENDIAN && LITTLE_ENDIAN) + bogus endian macros +#endif + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + # It does; now see whether it defined to BIG_ENDIAN or not. +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <sys/types.h> +#include <sys/param.h> + +int +main () +{ +#if BYTE_ORDER != BIG_ENDIAN + not big endian +#endif + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_cv_c_bigendian=yes +else + ac_cv_c_bigendian=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +else + # It does not; compile a test program. +if test "$cross_compiling" = yes; then : + # try to guess the endianness by grepping values into an object file + ac_cv_c_bigendian=unknown + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +short int ascii_mm[] = { 0x4249, 0x4765, 0x6E44, 0x6961, 0x6E53, 0x7953, 0 }; +short int ascii_ii[] = { 0x694C, 0x5454, 0x656C, 0x6E45, 0x6944, 0x6E61, 0 }; +void _ascii () { char *s = (char *) ascii_mm; s = (char *) ascii_ii; } +short int ebcdic_ii[] = { 0x89D3, 0xE3E3, 0x8593, 0x95C5, 0x89C4, 0x9581, 0 }; +short int ebcdic_mm[] = { 0xC2C9, 0xC785, 0x95C4, 0x8981, 0x95E2, 0xA8E2, 0 }; +void _ebcdic () { char *s = (char *) ebcdic_mm; s = (char *) ebcdic_ii; } +int +main () +{ + _ascii (); _ebcdic (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + if grep BIGenDianSyS conftest.$ac_objext >/dev/null ; then + ac_cv_c_bigendian=yes +fi +if grep LiTTleEnDian conftest.$ac_objext >/dev/null ; then + if test "$ac_cv_c_bigendian" = unknown; then + ac_cv_c_bigendian=no + else + # finding both strings is unlikely to happen, but who knows? + ac_cv_c_bigendian=unknown + fi +fi +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +$ac_includes_default +int +main () +{ + + /* Are we little or big endian? From Harbison&Steele. */ + union + { + long int l; + char c[sizeof (long int)]; + } u; + u.l = 1; + return u.c[sizeof (long int) - 1] == 1; + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_run "$LINENO"; then : + ac_cv_c_bigendian=no +else + ac_cv_c_bigendian=yes +fi +rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ + conftest.$ac_objext conftest.beam conftest.$ac_ext +fi + +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_c_bigendian" >&5 +$as_echo "$ac_cv_c_bigendian" >&6; } +case $ac_cv_c_bigendian in + yes) + +$as_echo "#define WORDS_BIGENDIAN 1" >>confdefs.h + ;; + no) + ;; + *) + as_fn_error $? "unknown endianness +presetting ac_cv_c_bigendian=no (or yes) will help" "$LINENO" 5 ;; +esac + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for an ANSI C-conforming const" >&5 +$as_echo_n "checking for an ANSI C-conforming const... " >&6; } +if ${ac_cv_c_const+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ + +#ifndef __cplusplus + /* Ultrix mips cc rejects this sort of thing. */ + typedef int charset[2]; + const charset cs = { 0, 0 }; + /* SunOS 4.1.1 cc rejects this. */ + char const *const *pcpcc; + char **ppc; + /* 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"; + pcpcc = &g + (g ? g-g : 0); + /* HPUX 7.0 cc rejects these. */ + ++pcpcc; + ppc = (char**) pcpcc; + pcpcc = (char const *const *) ppc; + { /* SCO 3.2v4 cc rejects this sort of thing. */ + char tx; + char *t = &tx; + char const *s = 0 ? (char *) 0 : (char const *) 0; + + *t++ = 0; + if (s) return 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 sort of thing, saying + "k.c", line 2.27: 1506-025 (S) Operand must be a modifiable lvalue. */ + struct s { int j; const int *ap[3]; } bx; + struct s *b = &bx; b->j = 5; + } + { /* ULTRIX-32 V3.1 (Rev 9) vcc rejects this */ + const int foo = 10; + if (!foo) return 0; + } + return !cs[0] && !zero.x; +#endif + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_cv_c_const=yes +else + ac_cv_c_const=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_c_const" >&5 +$as_echo "$ac_cv_c_const" >&6; } +if test $ac_cv_c_const = no; then + +$as_echo "#define const /**/" >>confdefs.h + +fi + + case $ac_cv_prog_cc_stdc in #( + no) : + ac_cv_prog_cc_c99=no; ac_cv_prog_cc_c89=no ;; #( + *) : + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $CC option to accept ISO C99" >&5 +$as_echo_n "checking for $CC option to accept ISO C99... " >&6; } +if ${ac_cv_prog_cc_c99+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_cv_prog_cc_c99=no +ac_save_CC=$CC +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <stdarg.h> +#include <stdbool.h> +#include <stdlib.h> +#include <wchar.h> +#include <stdio.h> + +// Check varargs macros. These examples are taken from C99 6.10.3.5. +#define debug(...) fprintf (stderr, __VA_ARGS__) +#define showlist(...) puts (#__VA_ARGS__) +#define report(test,...) ((test) ? puts (#test) : printf (__VA_ARGS__)) +static void +test_varargs_macros (void) +{ + int x = 1234; + int y = 5678; + debug ("Flag"); + debug ("X = %d\n", x); + showlist (The first, second, and third items.); + report (x>y, "x is %d but y is %d", x, y); +} + +// Check long long types. +#define BIG64 18446744073709551615ull +#define BIG32 4294967295ul +#define BIG_OK (BIG64 / BIG32 == 4294967297ull && BIG64 % BIG32 == 0) +#if !BIG_OK + your preprocessor is broken; +#endif +#if BIG_OK +#else + your preprocessor is broken; +#endif +static long long int bignum = -9223372036854775807LL; +static unsigned long long int ubignum = BIG64; + +struct incomplete_array +{ + int datasize; + double data[]; +}; + +struct named_init { + int number; + const wchar_t *name; + double average; +}; + +typedef const char *ccp; + +static inline int +test_restrict (ccp restrict text) +{ + // See if C++-style comments work. + // Iterate through items via the restricted pointer. + // Also check for declarations in for loops. + for (unsigned int i = 0; *(text+i) != '\0'; ++i) + continue; + return 0; +} + +// Check varargs and va_copy. +static void +test_varargs (const char *format, ...) +{ + va_list args; + va_start (args, format); + va_list args_copy; + va_copy (args_copy, args); + + const char *str; + int number; + float fnumber; + + while (*format) + { + switch (*format++) + { + case 's': // string + str = va_arg (args_copy, const char *); + break; + case 'd': // int + number = va_arg (args_copy, int); + break; + case 'f': // float + fnumber = va_arg (args_copy, double); + break; + default: + break; + } + } + va_end (args_copy); + va_end (args); +} + +int +main () +{ + + // Check bool. + _Bool success = false; + + // Check restrict. + if (test_restrict ("String literal") == 0) + success = true; + char *restrict newvar = "Another string"; + + // Check varargs. + test_varargs ("s, d' f .", "string", 65, 34.234); + test_varargs_macros (); + + // Check flexible array members. + struct incomplete_array *ia = + malloc (sizeof (struct incomplete_array) + (sizeof (double) * 10)); + ia->datasize = 10; + for (int i = 0; i < ia->datasize; ++i) + ia->data[i] = i * 1.234; + + // Check named initializers. + struct named_init ni = { + .number = 34, + .name = L"Test wide string", + .average = 543.34343, + }; + + ni.number = 58; + + int dynamic_array[ni.number]; + dynamic_array[ni.number - 1] = 543; + + // work around unused variable warnings + return (!success || bignum == 0LL || ubignum == 0uLL || newvar[0] == 'x' + || dynamic_array[ni.number - 1] != 543); + + ; + return 0; +} +_ACEOF +for ac_arg in '' -std=gnu99 -std=c99 -c99 -AC99 -D_STDC_C99= -qlanglvl=extc99 +do + CC="$ac_save_CC $ac_arg" + if ac_fn_c_try_compile "$LINENO"; then : + ac_cv_prog_cc_c99=$ac_arg +fi +rm -f core conftest.err conftest.$ac_objext + test "x$ac_cv_prog_cc_c99" != "xno" && break +done +rm -f conftest.$ac_ext +CC=$ac_save_CC + +fi +# AC_CACHE_VAL +case "x$ac_cv_prog_cc_c99" in + x) + { $as_echo "$as_me:${as_lineno-$LINENO}: result: none needed" >&5 +$as_echo "none needed" >&6; } ;; + xno) + { $as_echo "$as_me:${as_lineno-$LINENO}: result: unsupported" >&5 +$as_echo "unsupported" >&6; } ;; + *) + CC="$CC $ac_cv_prog_cc_c99" + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_c99" >&5 +$as_echo "$ac_cv_prog_cc_c99" >&6; } ;; +esac +if test "x$ac_cv_prog_cc_c99" != xno; then : + ac_cv_prog_cc_stdc=$ac_cv_prog_cc_c99 +else + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $CC option to accept ISO C89" >&5 +$as_echo_n "checking for $CC option to accept ISO C89... " >&6; } +if ${ac_cv_prog_cc_c89+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_cv_prog_cc_c89=no +ac_save_CC=$CC +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <stdarg.h> +#include <stdio.h> +struct stat; +/* Most of the following tests are stolen from RCS 5.7's src/conf.sh. */ +struct buf { int x; }; +FILE * (*rcsopen) (struct buf *, struct stat *, int); +static char *e (p, i) + char **p; + int i; +{ + return p[i]; +} +static char *f (char * (*g) (char **, int), char **p, ...) +{ + char *s; + va_list v; + va_start (v,p); + s = g (p, va_arg (v,int)); + va_end (v); + return s; +} + +/* OSF 4.0 Compaq cc is some sort of almost-ANSI by default. It has + function prototypes and stuff, but not '\xHH' hex character constants. + These don't provoke an error unfortunately, instead are silently treated + as 'x'. The following induces an error, until -std is added to get + proper ANSI mode. Curiously '\x00'!='x' always comes out true, for an + array size at least. It's necessary to write '\x00'==0 to get something + that's true only with -std. */ +int osf4_cc_array ['\x00' == 0 ? 1 : -1]; + +/* IBM C 6 for AIX is almost-ANSI by default, but it replaces macro parameters + inside strings and character constants. */ +#define FOO(x) 'x' +int xlc6_cc_array[FOO(a) == 'x' ? 1 : -1]; + +int test (int i, double x); +struct s1 {int (*f) (int a);}; +struct s2 {int (*f) (double a);}; +int pairnames (int, char **, FILE *(*)(struct buf *, struct stat *, int), int, int); +int argc; +char **argv; +int +main () +{ +return f (e, argv, 0) != argv[0] || f (e, argv, 1) != argv[1]; + ; + return 0; +} +_ACEOF +for ac_arg in '' -qlanglvl=extc89 -qlanglvl=ansi -std \ + -Ae "-Aa -D_HPUX_SOURCE" "-Xc -D__EXTENSIONS__" +do + CC="$ac_save_CC $ac_arg" + if ac_fn_c_try_compile "$LINENO"; then : + ac_cv_prog_cc_c89=$ac_arg +fi +rm -f core conftest.err conftest.$ac_objext + test "x$ac_cv_prog_cc_c89" != "xno" && break +done +rm -f conftest.$ac_ext +CC=$ac_save_CC + +fi +# AC_CACHE_VAL +case "x$ac_cv_prog_cc_c89" in + x) + { $as_echo "$as_me:${as_lineno-$LINENO}: result: none needed" >&5 +$as_echo "none needed" >&6; } ;; + xno) + { $as_echo "$as_me:${as_lineno-$LINENO}: result: unsupported" >&5 +$as_echo "unsupported" >&6; } ;; + *) + CC="$CC $ac_cv_prog_cc_c89" + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_c89" >&5 +$as_echo "$ac_cv_prog_cc_c89" >&6; } ;; +esac +if test "x$ac_cv_prog_cc_c89" != xno; then : + ac_cv_prog_cc_stdc=$ac_cv_prog_cc_c89 +else + ac_cv_prog_cc_stdc=no +fi + +fi + ;; +esac + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $CC option to accept ISO Standard C" >&5 +$as_echo_n "checking for $CC option to accept ISO Standard C... " >&6; } + if ${ac_cv_prog_cc_stdc+:} false; then : + $as_echo_n "(cached) " >&6 +fi + + case $ac_cv_prog_cc_stdc in #( + no) : + { $as_echo "$as_me:${as_lineno-$LINENO}: result: unsupported" >&5 +$as_echo "unsupported" >&6; } ;; #( + '') : + { $as_echo "$as_me:${as_lineno-$LINENO}: result: none needed" >&5 +$as_echo "none needed" >&6; } ;; #( + *) : + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_stdc" >&5 +$as_echo "$ac_cv_prog_cc_stdc" >&6; } ;; +esac + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for inline" >&5 +$as_echo_n "checking for inline... " >&6; } +if ${r_cv_c_inline+:} false; then : + $as_echo_n "(cached) " >&6 +else + r_cv_c_inline="" +for ac_kw in inline __inline__ __inline; do + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#ifndef __cplusplus +static $ac_kw int static_foo () {return 0; } +$ac_kw int foo () {return 0; } +#endif + +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + r_cv_c_inline=$ac_kw; break +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +done + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $r_cv_c_inline" >&5 +$as_echo "$r_cv_c_inline" >&6; } +case $r_cv_c_inline in + no) +$as_echo "#define R_INLINE /**/" >>confdefs.h + ;; + *) cat >>confdefs.h <<_ACEOF +#define R_INLINE $r_cv_c_inline +_ACEOF + ;; +esac + +# The cast to long int works around a bug in the HP C Compiler +# version HP92453-01 B.11.11.23709.GP, which incorrectly rejects +# declarations like `int a3[[(sizeof (unsigned char)) >= 0]];'. +# This bug is HP SR number 8606223364. +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking size of int" >&5 +$as_echo_n "checking size of int... " >&6; } +if ${ac_cv_sizeof_int+:} false; then : + $as_echo_n "(cached) " >&6 +else + if ac_fn_c_compute_int "$LINENO" "(long int) (sizeof (int))" "ac_cv_sizeof_int" "$ac_includes_default"; then : + +else + if test "$ac_cv_type_int" = yes; then + { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error 77 "cannot compute sizeof (int) +See \`config.log' for more details" "$LINENO" 5; } + else + ac_cv_sizeof_int=0 + fi +fi + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_sizeof_int" >&5 +$as_echo "$ac_cv_sizeof_int" >&6; } + + + +cat >>confdefs.h <<_ACEOF +#define SIZEOF_INT $ac_cv_sizeof_int +_ACEOF + + +## on some platforms this gives a trailing lf, so +case "${ac_cv_sizeof_int}" in + 4*) + +$as_echo "#define INT_32_BITS 1" >>confdefs.h + + ;; +esac +# The cast to long int works around a bug in the HP C Compiler +# version HP92453-01 B.11.11.23709.GP, which incorrectly rejects +# declarations like `int a3[[(sizeof (unsigned char)) >= 0]];'. +# This bug is HP SR number 8606223364. +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking size of long" >&5 +$as_echo_n "checking size of long... " >&6; } +if ${ac_cv_sizeof_long+:} false; then : + $as_echo_n "(cached) " >&6 +else + if ac_fn_c_compute_int "$LINENO" "(long int) (sizeof (long))" "ac_cv_sizeof_long" "$ac_includes_default"; then : + +else + if test "$ac_cv_type_long" = yes; then + { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error 77 "cannot compute sizeof (long) +See \`config.log' for more details" "$LINENO" 5; } + else + ac_cv_sizeof_long=0 + fi +fi + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_sizeof_long" >&5 +$as_echo "$ac_cv_sizeof_long" >&6; } + + + +cat >>confdefs.h <<_ACEOF +#define SIZEOF_LONG $ac_cv_sizeof_long +_ACEOF + + +# The cast to long int works around a bug in the HP C Compiler +# version HP92453-01 B.11.11.23709.GP, which incorrectly rejects +# declarations like `int a3[[(sizeof (unsigned char)) >= 0]];'. +# This bug is HP SR number 8606223364. +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking size of long long" >&5 +$as_echo_n "checking size of long long... " >&6; } +if ${ac_cv_sizeof_long_long+:} false; then : + $as_echo_n "(cached) " >&6 +else + if ac_fn_c_compute_int "$LINENO" "(long int) (sizeof (long long))" "ac_cv_sizeof_long_long" "$ac_includes_default"; then : + +else + if test "$ac_cv_type_long_long" = yes; then + { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error 77 "cannot compute sizeof (long long) +See \`config.log' for more details" "$LINENO" 5; } + else + ac_cv_sizeof_long_long=0 + fi +fi + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_sizeof_long_long" >&5 +$as_echo "$ac_cv_sizeof_long_long" >&6; } + + + +cat >>confdefs.h <<_ACEOF +#define SIZEOF_LONG_LONG $ac_cv_sizeof_long_long +_ACEOF + + +# The cast to long int works around a bug in the HP C Compiler +# version HP92453-01 B.11.11.23709.GP, which incorrectly rejects +# declarations like `int a3[[(sizeof (unsigned char)) >= 0]];'. +# This bug is HP SR number 8606223364. +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking size of double" >&5 +$as_echo_n "checking size of double... " >&6; } +if ${ac_cv_sizeof_double+:} false; then : + $as_echo_n "(cached) " >&6 +else + if ac_fn_c_compute_int "$LINENO" "(long int) (sizeof (double))" "ac_cv_sizeof_double" "$ac_includes_default"; then : + +else + if test "$ac_cv_type_double" = yes; then + { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error 77 "cannot compute sizeof (double) +See \`config.log' for more details" "$LINENO" 5; } + else + ac_cv_sizeof_double=0 + fi +fi + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_sizeof_double" >&5 +$as_echo "$ac_cv_sizeof_double" >&6; } + + + +cat >>confdefs.h <<_ACEOF +#define SIZEOF_DOUBLE $ac_cv_sizeof_double +_ACEOF + + +# The cast to long int works around a bug in the HP C Compiler +# version HP92453-01 B.11.11.23709.GP, which incorrectly rejects +# declarations like `int a3[[(sizeof (unsigned char)) >= 0]];'. +# This bug is HP SR number 8606223364. +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking size of size_t" >&5 +$as_echo_n "checking size of size_t... " >&6; } +if ${ac_cv_sizeof_size_t+:} false; then : + $as_echo_n "(cached) " >&6 +else + if ac_fn_c_compute_int "$LINENO" "(long int) (sizeof (size_t))" "ac_cv_sizeof_size_t" "$ac_includes_default"; then : + +else + if test "$ac_cv_type_size_t" = yes; then + { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error 77 "cannot compute sizeof (size_t) +See \`config.log' for more details" "$LINENO" 5; } + else + ac_cv_sizeof_size_t=0 + fi +fi + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_sizeof_size_t" >&5 +$as_echo "$ac_cv_sizeof_size_t" >&6; } + + + +cat >>confdefs.h <<_ACEOF +#define SIZEOF_SIZE_T $ac_cv_sizeof_size_t +_ACEOF + + +# Check whether --enable-long-double was given. +if test "${enable_long_double+set}" = set; then : + enableval=$enable_long_double; if test "${enableval}" = no; then + use_long_double=no +else + use_long_double=yes +fi +else + use_long_double=yes +fi + + +if test "x${use_long_double}" = xyes; then + +$as_echo "#define HAVE_LONG_DOUBLE 1" >>confdefs.h + + # The cast to long int works around a bug in the HP C Compiler +# version HP92453-01 B.11.11.23709.GP, which incorrectly rejects +# declarations like `int a3[[(sizeof (unsigned char)) >= 0]];'. +# This bug is HP SR number 8606223364. +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking size of long double" >&5 +$as_echo_n "checking size of long double... " >&6; } +if ${ac_cv_sizeof_long_double+:} false; then : + $as_echo_n "(cached) " >&6 +else + if ac_fn_c_compute_int "$LINENO" "(long int) (sizeof (long double))" "ac_cv_sizeof_long_double" "$ac_includes_default"; then : + +else + if test "$ac_cv_type_long_double" = yes; then + { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error 77 "cannot compute sizeof (long double) +See \`config.log' for more details" "$LINENO" 5; } + else + ac_cv_sizeof_long_double=0 + fi +fi + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_sizeof_long_double" >&5 +$as_echo "$ac_cv_sizeof_long_double" >&6; } + + + +cat >>confdefs.h <<_ACEOF +#define SIZEOF_LONG_DOUBLE $ac_cv_sizeof_long_double +_ACEOF + + +else + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: Not using the 'long double' type" >&5 +$as_echo "$as_me: WARNING: Not using the 'long double' type" >&2;} +fi + + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether we can compute C Make dependencies" >&5 +$as_echo_n "checking whether we can compute C Make dependencies... " >&6; } +if ${r_cv_prog_cc_m+:} false; then : + $as_echo_n "(cached) " >&6 +else + echo "#include <math.h>" > conftest.c +## No real point in using AC_LANG_* and ${ac_ext}, as we need to create +## hard-wired suffix rules. +## Another obvious candidate to try is '${MAKEDEPEND-makedepend} -f-'. +## However, this does not work out of the box when srcdir and builddir +## are different, as it creates dependencies of the form +## ${srcdir}/foo.o: /path/to/bar.h +## Could be made to work, of course ... +## Note also that it does not create a 'conftest.o: conftest.c' line. +## For gcc 3.2 or better, we want to use '-MM' in case this works. +cc_minus_MM=false +if test "${GCC}" = yes; then + case "${CC_VERSION}" in + 1.*|2.*|3.[01]*) ;; + *) cc_minus_MM="${CC} -MM" ;; + esac +fi +for prog in "${cc_minus_MM}" "${CC} -M" "${CPP} -M" "cpp -M"; do + if ${prog} conftest.c 2>/dev/null | \ + grep 'conftest.o: conftest.c' >/dev/null; then + r_cv_prog_cc_m="${prog}" + break + fi +done +fi + +if test "${r_cv_prog_cc_m}" = "${cc_minus_MM}"; then + r_cv_prog_cc_m="\$(CC) -MM" +fi +if test -z "${r_cv_prog_cc_m}"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes, using ${r_cv_prog_cc_m}" >&5 +$as_echo "yes, using ${r_cv_prog_cc_m}" >&6; } +fi + +r_cc_rules_frag=Makefrag.cc + +cat << \EOF > ${r_cc_rules_frag} +.c.o: + $(CC) $(ALL_CPPFLAGS) $(ALL_CFLAGS) -c $< -o $@ +EOF +if test -n "${r_cv_prog_cc_m}"; then + cat << EOF >> ${r_cc_rules_frag} +.c.d: + @echo "making \$@ from \$<" + @${r_cv_prog_cc_m} \$(ALL_CPPFLAGS) $< > \$@ +EOF +else + cat << \EOF >> ${r_cc_rules_frag} +.c.d: + @echo > $@ +EOF +fi + + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether ${CC} supports -c -o FILE.lo" >&5 +$as_echo_n "checking whether ${CC} supports -c -o FILE.lo... " >&6; } +if ${r_cv_prog_cc_c_o_lo+:} false; then : + $as_echo_n "(cached) " >&6 +else + test -d TMP || mkdir TMP +echo "int some_variable = 0;" > conftest.c +## No real point in using AC_LANG_* and ${ac_ext}, as we need to create +## hard-wired suffix rules. +ac_try='${CC} ${CFLAGS} -c conftest.c -o TMP/conftest.lo 1>&5' +if { { eval echo "\"\$as_me\":${as_lineno-$LINENO}: \"$ac_try\""; } >&5 + (eval $ac_try) 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } \ + && test -f TMP/conftest.lo \ + && { { eval echo "\"\$as_me\":${as_lineno-$LINENO}: \"$ac_try\""; } >&5 + (eval $ac_try) 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; }; then + r_cv_prog_cc_c_o_lo=yes +else + r_cv_prog_cc_c_o_lo=no +fi +rm -rf conftest* TMP +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $r_cv_prog_cc_c_o_lo" >&5 +$as_echo "$r_cv_prog_cc_c_o_lo" >&6; } + +r_cc_lo_rules_frag=Makefrag.cc_lo + +if test "${r_cv_prog_cc_c_o_lo}" = yes; then + cat << \EOF > ${r_cc_lo_rules_frag} +.c.lo: + $(CC) $(ALL_CPPFLAGS) $(ALL_CFLAGS_LO) -c $< -o $@ +EOF +else + cat << \EOF > ${r_cc_lo_rules_frag} +.c.lo: + @-test -d .libs || mkdir .libs + $(CC) $(ALL_CPPFLAGS) $(ALL_CFLAGS_LO) -c $< -o .libs/$*.o + mv .libs/$*.o $*.lo +EOF +fi + + + + + OPENMP_CFLAGS= + # Check whether --enable-openmp was given. +if test "${enable_openmp+set}" = set; then : + enableval=$enable_openmp; +fi + + if test "$enable_openmp" != no; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $CC option to support OpenMP" >&5 +$as_echo_n "checking for $CC option to support OpenMP... " >&6; } +if ${ac_cv_prog_c_openmp+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +#ifndef _OPENMP + choke me +#endif +#include <omp.h> +int main () { return omp_get_num_threads (); } + +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_prog_c_openmp='none needed' +else + ac_cv_prog_c_openmp='unsupported' + for ac_option in -fopenmp -xopenmp -qopenmp \ + -openmp -mp -omp -qsmp=omp -homp \ + -fopenmp=libomp \ + -Popenmp --openmp; do + ac_save_CFLAGS=$CFLAGS + CFLAGS="$CFLAGS $ac_option" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +#ifndef _OPENMP + choke me +#endif +#include <omp.h> +int main () { return omp_get_num_threads (); } + +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_prog_c_openmp=$ac_option +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + CFLAGS=$ac_save_CFLAGS + if test "$ac_cv_prog_c_openmp" != unsupported; then + break + fi + done +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_c_openmp" >&5 +$as_echo "$ac_cv_prog_c_openmp" >&6; } + case $ac_cv_prog_c_openmp in #( + "none needed" | unsupported) + ;; #( + *) + OPENMP_CFLAGS=$ac_cv_prog_c_openmp ;; + esac + fi + + + +### *** Fortran 77 compiler. + + +if test -z "${FLIBS}"; then +## +## Currently (Autoconf 2.50 or better, it seems) FLIBS also contains all +## elements of LIBS when AC_F77_LIBRARY_LDFLAGS is run. This is because +## _AC_PROG_F77_V_OUTPUT() uses 'eval $ac_link' for obtaining verbose +## linker output, and AC_LANG(Fortran 77) sets up ac_link to contain +## LIBS. Most likely a bug, and a nuisance in any case ... +## But we cannot simply eliminate the elements in FLIBS duplicated from +## LIBS (e.g. '-lm' should be preserved). Hence, we try to call +## AC_F77_LIBRARY_LDFLAGS() with LIBS temporarily set to empty. +r_save_LIBS="${LIBS}" +LIBS= +ac_ext=f +ac_compile='$F77 -c $FFLAGS conftest.$ac_ext >&5' +ac_link='$F77 -o conftest$ac_exeext $FFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_f77_compiler_gnu +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking how to get verbose linking output from $F77" >&5 +$as_echo_n "checking how to get verbose linking output from $F77... " >&6; } +if ${ac_cv_prog_f77_v+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat > conftest.$ac_ext <<_ACEOF + program main + + end +_ACEOF +if ac_fn_f77_try_compile "$LINENO"; then : + ac_cv_prog_f77_v= +# Try some options frequently used verbose output +for ac_verb in -v -verbose --verbose -V -\#\#\#; do + cat > conftest.$ac_ext <<_ACEOF + program main + + end +_ACEOF + +# Compile and link our simple test program by passing a flag (argument +# 1 to this macro) to the Fortran compiler in order to get +# "verbose" output that we can then parse for the Fortran linker +# flags. +ac_save_FFLAGS=$FFLAGS +FFLAGS="$FFLAGS $ac_verb" +eval "set x $ac_link" +shift +$as_echo "$as_me:${as_lineno-$LINENO}: $*" >&5 +# gfortran 4.3 outputs lines setting COLLECT_GCC_OPTIONS, COMPILER_PATH, +# LIBRARY_PATH; skip all such settings. +ac_f77_v_output=`eval $ac_link 5>&1 2>&1 | + sed '/^Driving:/d; /^Configured with:/d; + '"/^[_$as_cr_Letters][_$as_cr_alnum]*=/d"` +$as_echo "$ac_f77_v_output" >&5 +FFLAGS=$ac_save_FFLAGS + +rm -rf conftest* + +# On HP/UX there is a line like: "LPATH is: /foo:/bar:/baz" where +# /foo, /bar, and /baz are search directories for the Fortran linker. +# Here, we change these into -L/foo -L/bar -L/baz (and put it first): +ac_f77_v_output="`echo $ac_f77_v_output | + grep 'LPATH is:' | + sed 's|.*LPATH is\(: *[^ ]*\).*|\1|;s|: */| -L/|g'` $ac_f77_v_output" + +# FIXME: we keep getting bitten by quoted arguments; a more general fix +# that detects unbalanced quotes in FLIBS should be implemented +# and (ugh) tested at some point. +case $ac_f77_v_output in + # With xlf replace commas with spaces, + # and remove "-link" and closing parenthesis. + *xlfentry*) + ac_f77_v_output=`echo $ac_f77_v_output | + sed ' + s/,/ /g + s/ -link / /g + s/) *$// + ' + ` ;; + + # With Intel ifc, ignore the quoted -mGLOB_options_string stuff (quoted + # $LIBS confuse us, and the libraries appear later in the output anyway). + *mGLOB_options_string*) + ac_f77_v_output=`echo $ac_f77_v_output | sed 's/"-mGLOB[^"]*"/ /g'` ;; + + # Portland Group compiler has singly- or doubly-quoted -cmdline argument + # Singly-quoted arguments were reported for versions 5.2-4 and 6.0-4. + # Doubly-quoted arguments were reported for "PGF90/x86 Linux/x86 5.0-2". + *-cmdline\ * | *-ignore\ * | *-def\ *) + ac_f77_v_output=`echo $ac_f77_v_output | sed "\ + s/-cmdline *'[^']*'/ /g; s/-cmdline *\"[^\"]*\"/ /g + s/-ignore *'[^']*'/ /g; s/-ignore *\"[^\"]*\"/ /g + s/-def *'[^']*'/ /g; s/-def *\"[^\"]*\"/ /g"` ;; + + # If we are using fort77 (the f2c wrapper) then filter output and delete quotes. + *fort77*f2c*gcc*) + ac_f77_v_output=`echo "$ac_f77_v_output" | sed -n ' + /:[ ]\+Running[ ]\{1,\}"gcc"/{ + /"-c"/d + /[.]c"*/d + s/^.*"gcc"/"gcc"/ + s/"//gp + }'` ;; + + # If we are using Cray Fortran then delete quotes. + *cft90*) + ac_f77_v_output=`echo $ac_f77_v_output | sed 's/"//g'` ;; +esac + + + # look for -l* and *.a constructs in the output + for ac_arg in $ac_f77_v_output; do + case $ac_arg in + [\\/]*.a | ?:[\\/]*.a | -[lLRu]*) + ac_cv_prog_f77_v=$ac_verb + break 2 ;; + esac + done +done +if test -z "$ac_cv_prog_f77_v"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: cannot determine how to obtain linking information from $F77" >&5 +$as_echo "$as_me: WARNING: cannot determine how to obtain linking information from $F77" >&2;} +fi +else + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: compilation failed" >&5 +$as_echo "$as_me: WARNING: compilation failed" >&2;} +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_f77_v" >&5 +$as_echo "$ac_cv_prog_f77_v" >&6; } +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for Fortran 77 libraries of $F77" >&5 +$as_echo_n "checking for Fortran 77 libraries of $F77... " >&6; } +if ${ac_cv_f77_libs+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test "x$FLIBS" != "x"; then + ac_cv_f77_libs="$FLIBS" # Let the user override the test. +else + +cat > conftest.$ac_ext <<_ACEOF + program main + + end +_ACEOF + +# Compile and link our simple test program by passing a flag (argument +# 1 to this macro) to the Fortran compiler in order to get +# "verbose" output that we can then parse for the Fortran linker +# flags. +ac_save_FFLAGS=$FFLAGS +FFLAGS="$FFLAGS $ac_cv_prog_f77_v" +eval "set x $ac_link" +shift +$as_echo "$as_me:${as_lineno-$LINENO}: $*" >&5 +# gfortran 4.3 outputs lines setting COLLECT_GCC_OPTIONS, COMPILER_PATH, +# LIBRARY_PATH; skip all such settings. +ac_f77_v_output=`eval $ac_link 5>&1 2>&1 | + sed '/^Driving:/d; /^Configured with:/d; + '"/^[_$as_cr_Letters][_$as_cr_alnum]*=/d"` +$as_echo "$ac_f77_v_output" >&5 +FFLAGS=$ac_save_FFLAGS + +rm -rf conftest* + +# On HP/UX there is a line like: "LPATH is: /foo:/bar:/baz" where +# /foo, /bar, and /baz are search directories for the Fortran linker. +# Here, we change these into -L/foo -L/bar -L/baz (and put it first): +ac_f77_v_output="`echo $ac_f77_v_output | + grep 'LPATH is:' | + sed 's|.*LPATH is\(: *[^ ]*\).*|\1|;s|: */| -L/|g'` $ac_f77_v_output" + +# FIXME: we keep getting bitten by quoted arguments; a more general fix +# that detects unbalanced quotes in FLIBS should be implemented +# and (ugh) tested at some point. +case $ac_f77_v_output in + # With xlf replace commas with spaces, + # and remove "-link" and closing parenthesis. + *xlfentry*) + ac_f77_v_output=`echo $ac_f77_v_output | + sed ' + s/,/ /g + s/ -link / /g + s/) *$// + ' + ` ;; + + # With Intel ifc, ignore the quoted -mGLOB_options_string stuff (quoted + # $LIBS confuse us, and the libraries appear later in the output anyway). + *mGLOB_options_string*) + ac_f77_v_output=`echo $ac_f77_v_output | sed 's/"-mGLOB[^"]*"/ /g'` ;; + + # Portland Group compiler has singly- or doubly-quoted -cmdline argument + # Singly-quoted arguments were reported for versions 5.2-4 and 6.0-4. + # Doubly-quoted arguments were reported for "PGF90/x86 Linux/x86 5.0-2". + *-cmdline\ * | *-ignore\ * | *-def\ *) + ac_f77_v_output=`echo $ac_f77_v_output | sed "\ + s/-cmdline *'[^']*'/ /g; s/-cmdline *\"[^\"]*\"/ /g + s/-ignore *'[^']*'/ /g; s/-ignore *\"[^\"]*\"/ /g + s/-def *'[^']*'/ /g; s/-def *\"[^\"]*\"/ /g"` ;; + + # If we are using fort77 (the f2c wrapper) then filter output and delete quotes. + *fort77*f2c*gcc*) + ac_f77_v_output=`echo "$ac_f77_v_output" | sed -n ' + /:[ ]\+Running[ ]\{1,\}"gcc"/{ + /"-c"/d + /[.]c"*/d + s/^.*"gcc"/"gcc"/ + s/"//gp + }'` ;; + + # If we are using Cray Fortran then delete quotes. + *cft90*) + ac_f77_v_output=`echo $ac_f77_v_output | sed 's/"//g'` ;; +esac + + + +ac_cv_f77_libs= + +# Save positional arguments (if any) +ac_save_positional="$@" + +set X $ac_f77_v_output +while test $# != 1; do + shift + ac_arg=$1 + case $ac_arg in + [\\/]*.a | ?:[\\/]*.a) + ac_exists=false + for ac_i in $ac_cv_f77_libs; do + if test x"$ac_arg" = x"$ac_i"; then + ac_exists=true + break + fi + done + + if test x"$ac_exists" = xtrue; then : + +else + ac_cv_f77_libs="$ac_cv_f77_libs $ac_arg" +fi + ;; + -bI:*) + ac_exists=false + for ac_i in $ac_cv_f77_libs; do + if test x"$ac_arg" = x"$ac_i"; then + ac_exists=true + break + fi + done + + if test x"$ac_exists" = xtrue; then : + +else + if test "$ac_compiler_gnu" = yes; then + for ac_link_opt in $ac_arg; do + ac_cv_f77_libs="$ac_cv_f77_libs -Xlinker $ac_link_opt" + done +else + ac_cv_f77_libs="$ac_cv_f77_libs $ac_arg" +fi +fi + ;; + # Ignore these flags. + -lang* | -lcrt*.o | -lc | -lgcc* | -lSystem | -libmil | -little \ + |-LANG:=* | -LIST:* | -LNO:* | -link) + ;; + -lkernel32) + case $host_os in + *cygwin*) ;; + *) ac_cv_f77_libs="$ac_cv_f77_libs $ac_arg" + ;; + esac + ;; + -[LRuYz]) + # These flags, when seen by themselves, take an argument. + # We remove the space between option and argument and re-iterate + # unless we find an empty arg or a new option (starting with -) + case $2 in + "" | -*);; + *) + ac_arg="$ac_arg$2" + shift; shift + set X $ac_arg "$@" + ;; + esac + ;; + -YP,*) + for ac_j in `$as_echo "$ac_arg" | sed -e 's/-YP,/-L/;s/:/ -L/g'`; do + ac_exists=false + for ac_i in $ac_cv_f77_libs; do + if test x"$ac_j" = x"$ac_i"; then + ac_exists=true + break + fi + done + + if test x"$ac_exists" = xtrue; then : + +else + ac_arg="$ac_arg $ac_j" + ac_cv_f77_libs="$ac_cv_f77_libs $ac_j" +fi + done + ;; + -[lLR]*) + ac_exists=false + for ac_i in $ac_cv_f77_libs; do + if test x"$ac_arg" = x"$ac_i"; then + ac_exists=true + break + fi + done + + if test x"$ac_exists" = xtrue; then : + +else + ac_cv_f77_libs="$ac_cv_f77_libs $ac_arg" +fi + ;; + -zallextract*| -zdefaultextract) + ac_cv_f77_libs="$ac_cv_f77_libs $ac_arg" + ;; + # Ignore everything else. + esac +done +# restore positional arguments +set X $ac_save_positional; shift + +# We only consider "LD_RUN_PATH" on Solaris systems. If this is seen, +# then we insist that the "run path" must be an absolute path (i.e. it +# must begin with a "/"). +case `(uname -sr) 2>/dev/null` in + "SunOS 5"*) + ac_ld_run_path=`$as_echo "$ac_f77_v_output" | + sed -n 's,^.*LD_RUN_PATH *= *\(/[^ ]*\).*$,-R\1,p'` + test "x$ac_ld_run_path" != x && + if test "$ac_compiler_gnu" = yes; then + for ac_link_opt in $ac_ld_run_path; do + ac_cv_f77_libs="$ac_cv_f77_libs -Xlinker $ac_link_opt" + done +else + ac_cv_f77_libs="$ac_cv_f77_libs $ac_ld_run_path" +fi + ;; +esac +fi # test "x$[]_AC_LANG_PREFIX[]LIBS" = "x" + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_f77_libs" >&5 +$as_echo "$ac_cv_f77_libs" >&6; } +FLIBS="$ac_cv_f77_libs" + + +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + +if test -z "${MAIN_LD}" ; then + LIBS= + ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking how to get verbose linking output from ${CC}" >&5 +$as_echo_n "checking how to get verbose linking output from ${CC}... " >&6; } +if ${r_cv_prog_c_v+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + r_cv_prog_c_v= +# Try some options frequently used verbose output +for r_verb in -v -verbose --verbose -V -\#\#\#; do + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ + + ; + return 0; +} +_ACEOF + +# Compile and link our simple test program by passing a flag (argument +# 1 to this macro) to the Fortran compiler in order to get +# "verbose" output that we can then parse for the Fortran linker +# flags. +r_save_CFLAGS=$CFLAGS +CFLAGS="$CFLAGS $r_verb" +(eval echo $as_me:25211: \"$ac_link\") >&5 +r_c_v_output=`eval $ac_link 5>&1 2>&1 | grep -v 'Driving:'` +echo "$r_c_v_output" >&5 +CFLAGS=$r_save_CFLAGS + +rm -rf conftest* + +# On HP/UX there is a line like: "LPATH is: /foo:/bar:/baz" where +# /foo, /bar, and /baz are search directories for the Fortran linker. +# Here, we change these into -L/foo -L/bar -L/baz (and put it first): +r_c_v_output="`echo $r_c_v_output | + grep 'LPATH is:' | + sed 's,.*LPATH is\(: *[^ ]*\).*,\1,;s,: */, -L/,g'` $r_c_v_output" + +case $r_c_v_output in + # If we are using xlc then replace all the commas with spaces. + *xlcentry*) + r_c_v_output=`echo $r_c_v_output | sed 's/,/ /g'` ;; + + # With Intel ifc, ignore the quoted -mGLOB_options_string stuff (quoted + # $LIBS confuse us, and the libraries appear later in the output anyway). + *mGLOB_options_string*) + r_c_v_output=`echo $r_c_v_output | sed 's/\"-mGLOB[^\"]*\"/ /g'` ;; +esac + + + # look for -l* and *.a constructs in the output + for r_arg in $r_c_v_output; do + case $r_arg in + [\\/]*.a | ?:[\\/]*.a | -[lLRu]*) + r_cv_prog_c_v=$r_verb + break 2 ;; + esac + done +done +if test -z "$r_cv_prog_c_v"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: cannot determine how to obtain linking information from ${CC}" >&5 +$as_echo "$as_me: WARNING: cannot determine how to obtain linking information from ${CC}" >&2;} +fi +else + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: compilation failed" >&5 +$as_echo "$as_me: WARNING: compilation failed" >&2;} +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $r_cv_prog_c_v" >&5 +$as_echo "$r_cv_prog_c_v" >&6; } +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for C libraries of ${CC}" >&5 +$as_echo_n "checking for C libraries of ${CC}... " >&6; } +if ${r_cv_c_libs+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test "x$CLIBS" != "x"; then + r_cv_c_libs="$CLIBS" # Let the user override the test. +else + +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ + + ; + return 0; +} +_ACEOF + +# Compile and link our simple test program by passing a flag (argument +# 1 to this macro) to the Fortran compiler in order to get +# "verbose" output that we can then parse for the Fortran linker +# flags. +r_save_CFLAGS=$CFLAGS +CFLAGS="$CFLAGS $r_cv_prog_c_v" +(eval echo $as_me:25286: \"$ac_link\") >&5 +r_c_v_output=`eval $ac_link 5>&1 2>&1 | grep -v 'Driving:'` +echo "$r_c_v_output" >&5 +CFLAGS=$r_save_CFLAGS + +rm -rf conftest* + +# On HP/UX there is a line like: "LPATH is: /foo:/bar:/baz" where +# /foo, /bar, and /baz are search directories for the Fortran linker. +# Here, we change these into -L/foo -L/bar -L/baz (and put it first): +r_c_v_output="`echo $r_c_v_output | + grep 'LPATH is:' | + sed 's,.*LPATH is\(: *[^ ]*\).*,\1,;s,: */, -L/,g'` $r_c_v_output" + +case $r_c_v_output in + # If we are using xlc then replace all the commas with spaces. + *xlcentry*) + r_c_v_output=`echo $r_c_v_output | sed 's/,/ /g'` ;; + + # With Intel ifc, ignore the quoted -mGLOB_options_string stuff (quoted + # $LIBS confuse us, and the libraries appear later in the output anyway). + *mGLOB_options_string*) + r_c_v_output=`echo $r_c_v_output | sed 's/\"-mGLOB[^\"]*\"/ /g'` ;; +esac + + + +r_cv_c_libs= + +# Save positional arguments (if any) +r_save_positional="$@" + +set X $r_c_v_output +while test $# != 1; do + shift + r_arg=$1 + case $r_arg in + [\\/]*.a | ?:[\\/]*.a) + ac_exists=false + for ac_i in $r_cv_c_libs; do + if test x"$r_arg" = x"$ac_i"; then + ac_exists=true + break + fi + done + + if test x"$ac_exists" = xtrue; then : + +else + r_cv_c_libs="$r_cv_c_libs $r_arg" +fi + ;; + -bI:*) + ac_exists=false + for ac_i in $r_cv_c_libs; do + if test x"$r_arg" = x"$ac_i"; then + ac_exists=true + break + fi + done + + if test x"$ac_exists" = xtrue; then : + +else + if test "$ac_compiler_gnu" = yes; then + for ac_link_opt in $r_arg; do + r_cv_c_libs="$r_cv_c_libs -Xlinker $ac_link_opt" + done +else + r_cv_c_libs="$r_cv_c_libs $r_arg" +fi +fi + ;; + # Ignore these flags. + -lang* | -lcrt[01].o | -lcrtbegin.o | -lc | -lgcc | -libmil | -LANG:=*) + ;; + -lkernel32) + test x"$CYGWIN" != xyes && r_cv_c_libs="$r_cv_c_libs $r_arg" + ;; + -[LRuY]) + # These flags, when seen by themselves, take an argument. + # We remove the space between option and argument and re-iterate + # unless we find an empty arg or a new option (starting with -) + case $2 in + "" | -*);; + *) + r_arg="$r_arg$2" + shift; shift + set X $r_arg "$@" + ;; + esac + ;; + -YP,*) + for r_j in `echo $r_arg | sed -e 's/-YP,/-L/;s/:/ -L/g'`; do + ac_exists=false + for ac_i in $r_cv_c_libs; do + if test x"$r_j" = x"$ac_i"; then + ac_exists=true + break + fi + done + + if test x"$ac_exists" = xtrue; then : + +else + r_arg="$r_arg $r_j" + r_cv_c_libs="$r_cv_c_libs $r_j" +fi + done + ;; + -[lLR]*) + ac_exists=false + for ac_i in $r_cv_c_libs; do + if test x"$r_arg" = x"$ac_i"; then + ac_exists=true + break + fi + done + + if test x"$ac_exists" = xtrue; then : + +else + r_cv_c_libs="$r_cv_c_libs $r_arg" +fi + ;; + # Ignore everything else. + esac +done +# restore positional arguments +set X $r_save_positional; shift + +# We only consider "LD_RUN_PATH" on Solaris systems. If this is seen, +# then we insist that the "run path" must be an absolute path (i.e. it +# must begin with a "/"). +case `(uname -sr) 2>/dev/null` in + "SunOS 5"*) + r_ld_run_path=`echo $r_c_v_output | + sed -n 's,^.*LD_RUN_PATH *= *\(/[^ ]*\).*$,-R\1,p'` + test "x$r_ld_run_path" != x && + if test "$ac_compiler_gnu" = yes; then + for ac_link_opt in $r_ld_run_path; do + r_cv_c_libs="$r_cv_c_libs -Xlinker $ac_link_opt" + done +else + r_cv_c_libs="$r_cv_c_libs $r_ld_run_path" +fi + ;; +esac +fi # test "x$CLIBS" = "x" + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $r_cv_c_libs" >&5 +$as_echo "$r_cv_c_libs" >&6; } +CLIBS= +for arg in $r_cv_c_libs; do + case "${arg}" in + -L*) + CLIBS="${CLIBS} $arg" + ;; + esac +done + +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + +else + CLIBS= +fi +LIBS="${r_save_LIBS}" +## Currently g77 on Darwin links against '-lcrt1.o' (and for GCC 3.1 or +## better also against '-lcrtbegin.o'), which (unlike '-lcrt0.o') are +## not stripped by AC_F77_LIBRARY_LDFLAGS. This in particular causes +## R_PROG_F77_CC_COMPAT to fail. Hence, we make sure all -lcrt*.o are +## removed. In Addition, -lmx and -lSystem are implicit and their +## manual inclusion leads to ordering problems (remove when autoconf +## is fixed - supposedly the CVS version is, but 2.6.0 is not). +## +## Native f90 on HPUX 11 comes up with '-l:libF90.a' causing trouble +## when using gcc for linking. The '-l:' construction is similar to +## plain '-l' except that search order (archive/shared) given by '-a' +## is not important. We escape such flags via '-Wl,' in case of gcc. +## Note that the current Autoconf CVS uses _AC_LINKER_OPTION for a +## similar purpose when computing FLIBS: this uses '-Xlinker' escapes +## for gcc and does nothing otherwise. Note also that we cannot simply +## unconditionally escape with '${wl}' from libtool as on HPUX we need +## SHLIB_LD=ld for native C compilers (problem with non-PIC 'crt0.o', +## see 'Individual platform overrides' in section 'DLL stuff' in file +## 'configure.ac'. +## +## Using the Intel Fortran compiler (ifc) one typically gets incorrect +## flags, as the output from _AC_PROG_F77_V_OUTPUT() contains double +## quoted options, e.g. "-mGLOB_options_string=......", see also e.g. +## http://www.octave.org/octave-lists/archive/octave-maintainers.2002/msg00038.html. +## One possible solution is to change AC_F77_LIBRARY_LDFLAGS() to remove +## double quotes for ifc, as it already does for the Cray cft90. As we +## prefer not to overload Autoconf code, we try to fix things here ... +## +## As of 2.1.0 we try to tidy this up a bit. +## 1) -lfrtbegin and -lgfortranbegin are used by g77/gfortran only for a +## Fortran main program, which we do not have. +## 2) g77 also tends to duplicate paths via ../../.., so we canonicalize +## paths and remove duplicates. +## 3) We do not need -L/lib etc, nor those in LDFLAGS +## 4) We exclude path with CC will include when linking. +## +## First try to fathom out what -Lfoo commands are unnecessary. +case "${host_os}" in + linux*) + r_libpath_default="/usr/lib64 /lib64 /usr/lib /lib" + ;; + solaris*) + r_libpath_default="/usr/lib /lib" + ;; + *) + r_libpath_default= + ;; +esac +r_extra_libs= +for arg in ${LDFLAGS} ${CLIBS}; do + case "${arg}" in + -L*) + lib=`echo ${arg} | sed "s/^-L//"` + test -d "${lib}" || continue + ## Canonicalize (/usr/lib/gcc-lib/i686-linux/3.4.3/../../..). + lib=`cd "${lib}" && ${GETWD}` + r_extra_libs="${r_extra_libs} $lib" + ;; + esac +done + +flibs= +if test "${GCC}" = yes; then + linker_option="-Wl," +else + linker_option= +fi +r_save_flibs="" +for arg in ${FLIBS}; do + case "${arg}" in + ## this is not for a Fortran main program + -lcrt*.o | -lfrtbegin | -lgfortranbegin | -lmx | -lSystem) + ;; + -[a-zA-Z]/*\" | -[a-zA-Z]*\\) # ifc + ;; + -l:*) + flibs="${flibs} ${linker_option}${arg}" + ;; + -L*) + lib=`echo ${arg} | sed "s/^-L//"` + ## Do not add non-existent directories. + test -d "${lib}" || continue + ## Canonicalize (/usr/lib/gcc-lib/i686-linux/3.4.3/../../..). + lib=`cd "${lib}" && ${GETWD}` + r_want_lib=true + ## Do not add something twice nor default paths nor those in LDFLAGS + for dir in ${r_save_flibs} ${r_libpath_default} ${r_extra_libs}; do + if test "${dir}" = "${lib}"; then + r_want_lib=false + break + fi + done + if test x"${r_want_lib}" = xtrue; then + flibs="${flibs} -L${lib}" + r_save_flibs="${r_save_flibs} ${lib}" + fi + ;; + *) + flibs="${flibs} ${arg}" + ;; + esac +done +FLIBS="${flibs}" +fi + +if test -z "$FLIBS_IN_SO"; then + FLIBS_IN_SO=${FLIBS} +fi + +ac_ext=f +ac_compile='$F77 -c $FFLAGS conftest.$ac_ext >&5' +ac_link='$F77 -o conftest$ac_exeext $FFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_f77_compiler_gnu + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for dummy main to link with Fortran 77 libraries" >&5 +$as_echo_n "checking for dummy main to link with Fortran 77 libraries... " >&6; } +if ${ac_cv_f77_dummy_main+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_f77_dm_save_LIBS=$LIBS + LIBS="$LIBS $FLIBS" + ac_fortran_dm_var=F77_DUMMY_MAIN + ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + + # First, try linking without a dummy main: + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_fortran_dummy_main=none +else + ac_cv_fortran_dummy_main=unknown +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + + if test $ac_cv_fortran_dummy_main = unknown; then + for ac_func in MAIN__ MAIN_ __main MAIN _MAIN __MAIN main_ main__ _main; do + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#define $ac_fortran_dm_var $ac_func +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_fortran_dummy_main=$ac_func; break +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + done + fi + ac_ext=f +ac_compile='$F77 -c $FFLAGS conftest.$ac_ext >&5' +ac_link='$F77 -o conftest$ac_exeext $FFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_f77_compiler_gnu + ac_cv_f77_dummy_main=$ac_cv_fortran_dummy_main + rm -rf conftest* + LIBS=$ac_f77_dm_save_LIBS + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_f77_dummy_main" >&5 +$as_echo "$ac_cv_f77_dummy_main" >&6; } +F77_DUMMY_MAIN=$ac_cv_f77_dummy_main +if test "$F77_DUMMY_MAIN" != unknown; then : + if test $F77_DUMMY_MAIN != none; then + +cat >>confdefs.h <<_ACEOF +#define F77_DUMMY_MAIN $F77_DUMMY_MAIN +_ACEOF + + if test "x$ac_cv_fc_dummy_main" = "x$ac_cv_f77_dummy_main"; then + +$as_echo "#define FC_DUMMY_MAIN_EQ_F77 1" >>confdefs.h + + fi +fi +else + { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error $? "linking to Fortran libraries from C fails +See \`config.log' for more details" "$LINENO" 5; } +fi + +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + +ac_ext=f +ac_compile='$F77 -c $FFLAGS conftest.$ac_ext >&5' +ac_link='$F77 -o conftest$ac_exeext $FFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_f77_compiler_gnu +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for Fortran 77 name-mangling scheme" >&5 +$as_echo_n "checking for Fortran 77 name-mangling scheme... " >&6; } +if ${ac_cv_f77_mangling+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat > conftest.$ac_ext <<_ACEOF + subroutine foobar() + return + end + subroutine foo_bar() + return + end +_ACEOF +if ac_fn_f77_try_compile "$LINENO"; then : + mv conftest.$ac_objext cfortran_test.$ac_objext + + ac_save_LIBS=$LIBS + LIBS="cfortran_test.$ac_objext $LIBS $FLIBS" + + ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + ac_success=no + for ac_foobar in foobar FOOBAR; do + for ac_underscore in "" "_"; do + ac_func="$ac_foobar$ac_underscore" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char $ac_func (); +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +return $ac_func (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_success=yes; break 2 +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + done + done + ac_ext=f +ac_compile='$F77 -c $FFLAGS conftest.$ac_ext >&5' +ac_link='$F77 -o conftest$ac_exeext $FFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_f77_compiler_gnu + + if test "$ac_success" = "yes"; then + case $ac_foobar in + foobar) + ac_case=lower + ac_foo_bar=foo_bar + ;; + FOOBAR) + ac_case=upper + ac_foo_bar=FOO_BAR + ;; + esac + + ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + ac_success_extra=no + for ac_extra in "" "_"; do + ac_func="$ac_foo_bar$ac_underscore$ac_extra" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char $ac_func (); +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +return $ac_func (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_success_extra=yes; break +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + done + ac_ext=f +ac_compile='$F77 -c $FFLAGS conftest.$ac_ext >&5' +ac_link='$F77 -o conftest$ac_exeext $FFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_f77_compiler_gnu + + if test "$ac_success_extra" = "yes"; then + ac_cv_f77_mangling="$ac_case case" + if test -z "$ac_underscore"; then + ac_cv_f77_mangling="$ac_cv_f77_mangling, no underscore" + else + ac_cv_f77_mangling="$ac_cv_f77_mangling, underscore" + fi + if test -z "$ac_extra"; then + ac_cv_f77_mangling="$ac_cv_f77_mangling, no extra underscore" + else + ac_cv_f77_mangling="$ac_cv_f77_mangling, extra underscore" + fi + else + ac_cv_f77_mangling="unknown" + fi + else + ac_cv_f77_mangling="unknown" + fi + + LIBS=$ac_save_LIBS + rm -rf conftest* + rm -f cfortran_test* +else + { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error $? "cannot compile a simple Fortran program +See \`config.log' for more details" "$LINENO" 5; } +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_f77_mangling" >&5 +$as_echo "$ac_cv_f77_mangling" >&6; } + +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + +ac_ext=f +ac_compile='$F77 -c $FFLAGS conftest.$ac_ext >&5' +ac_link='$F77 -o conftest$ac_exeext $FFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_f77_compiler_gnu +case $ac_cv_f77_mangling in + "lower case, no underscore, no extra underscore") + $as_echo "#define F77_FUNC(name,NAME) name" >>confdefs.h + + $as_echo "#define F77_FUNC_(name,NAME) name" >>confdefs.h + ;; + "lower case, no underscore, extra underscore") + $as_echo "#define F77_FUNC(name,NAME) name" >>confdefs.h + + $as_echo "#define F77_FUNC_(name,NAME) name ## _" >>confdefs.h + ;; + "lower case, underscore, no extra underscore") + $as_echo "#define F77_FUNC(name,NAME) name ## _" >>confdefs.h + + $as_echo "#define F77_FUNC_(name,NAME) name ## _" >>confdefs.h + ;; + "lower case, underscore, extra underscore") + $as_echo "#define F77_FUNC(name,NAME) name ## _" >>confdefs.h + + $as_echo "#define F77_FUNC_(name,NAME) name ## __" >>confdefs.h + ;; + "upper case, no underscore, no extra underscore") + $as_echo "#define F77_FUNC(name,NAME) NAME" >>confdefs.h + + $as_echo "#define F77_FUNC_(name,NAME) NAME" >>confdefs.h + ;; + "upper case, no underscore, extra underscore") + $as_echo "#define F77_FUNC(name,NAME) NAME" >>confdefs.h + + $as_echo "#define F77_FUNC_(name,NAME) NAME ## _" >>confdefs.h + ;; + "upper case, underscore, no extra underscore") + $as_echo "#define F77_FUNC(name,NAME) NAME ## _" >>confdefs.h + + $as_echo "#define F77_FUNC_(name,NAME) NAME ## _" >>confdefs.h + ;; + "upper case, underscore, extra underscore") + $as_echo "#define F77_FUNC(name,NAME) NAME ## _" >>confdefs.h + + $as_echo "#define F77_FUNC_(name,NAME) NAME ## __" >>confdefs.h + ;; + *) + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: unknown Fortran name-mangling scheme" >&5 +$as_echo "$as_me: WARNING: unknown Fortran name-mangling scheme" >&2;} + ;; +esac + +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + + +## DANGER! We really needs the results of _AC_F77_NAME_MANGLING as +## stored in the cache var ac_cv_f77_mangling which is not documented +## and hence may change ... +case "${ac_cv_f77_mangling}" in + "upper "*) + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: Fortran compiler uses uppercase external names" >&5 +$as_echo "$as_me: WARNING: Fortran compiler uses uppercase external names" >&2;} + as_fn_error $? "cannot use Fortran" "$LINENO" 5 + ;; +esac +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether ${F77} appends underscores to external names" >&5 +$as_echo_n "checking whether ${F77} appends underscores to external names... " >&6; } +if ${r_cv_prog_f77_append_underscore+:} false; then : + $as_echo_n "(cached) " >&6 +else + case "${ac_cv_f77_mangling}" in + *", underscore, "*) + r_cv_prog_f77_append_underscore=yes + ;; + *", no underscore, "*) + r_cv_prog_f77_append_underscore=no + ;; +esac +fi + +if test -n "${r_cv_prog_f77_append_underscore}"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: ${r_cv_prog_f77_append_underscore}" >&5 +$as_echo "${r_cv_prog_f77_append_underscore}" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: unknown" >&5 +$as_echo "unknown" >&6; } + as_fn_error $? "cannot use Fortran" "$LINENO" 5 +fi +if test "${r_cv_prog_f77_append_underscore}" = yes; then + +$as_echo "#define HAVE_F77_UNDERSCORE 1" >>confdefs.h + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether ${F77} appends extra underscores to external names" >&5 +$as_echo_n "checking whether ${F77} appends extra underscores to external names... " >&6; } +if ${r_cv_prog_f77_append_second_underscore+:} false; then : + $as_echo_n "(cached) " >&6 +else + case "${ac_cv_f77_mangling}" in + *", extra underscore") + r_cv_prog_f77_append_second_underscore=yes + ;; + *", no extra underscore") + r_cv_prog_f77_append_second_underscore=no + ;; +esac +fi + +if test -n "${r_cv_prog_f77_append_second_underscore}"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: ${r_cv_prog_f77_append_second_underscore}" >&5 +$as_echo "${r_cv_prog_f77_append_second_underscore}" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: unknown" >&5 +$as_echo "unknown" >&6; } + as_fn_error $? "cannot use Fortran" "$LINENO" 5 +fi +if test "${r_cv_prog_f77_append_second_underscore}" = yes; then + +$as_echo "#define HAVE_F77_EXTRA_UNDERSCORE 1" >>confdefs.h + +fi + + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether mixed C/Fortran code can be run" >&5 +$as_echo_n "checking whether mixed C/Fortran code can be run... " >&6; } +if ${r_cv_prog_f77_can_run+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat > conftestf.f <<EOF + subroutine cftest(a, b, x, y) + integer a(3), b(2) + double precision x(3), y(3) + + b(1) = a(3)/a(2) + b(2) = a(3) - a(1)*a(2) + y(1) = dble(a(3))/x(2) + y(2) = x(3)*x(1) + y(3) = (x(2)/x(1)) ** a(1) + end +EOF +${F77} ${FFLAGS} -c conftestf.f 1>&5 2>&5 +## Yes we need to double quote this ... +cat > conftest.c <<EOF +#include <math.h> +#include <stdlib.h> +#include "confdefs.h" +#ifdef HAVE_F77_UNDERSCORE +# define F77_SYMBOL(x) x ## _ +#else +# define F77_SYMBOL(x) x +#endif +int main () { + exit(0); +} +EOF +if ${CC} ${CFLAGS} -c conftest.c 1>&5 2>&5; then + ## <NOTE> + ## This should really use MAIN_LD, and hence come after this is + ## determined (and necessary additions to MAIN_LDFLAGS were made). + ## But it seems that we currently can always use the C compiler. + ## Also, to be defensive there should be a similar test with SHLIB_LD + ## and SHLIB_LDFLAGS (and note that on HPUX with native cc we have to + ## use ld for SHLIB_LD) ... + ## Be nice to people who put compiler architecture opts in CFLAGS + if ${CC} ${CFLAGS} ${LDFLAGS} ${MAIN_LDFLAGS} -o conftest${ac_exeext} \ + conftest.${ac_objext} conftestf.${ac_objext} ${FLIBS} \ + ${LIBM} 1>&5 2>&5; + ## </NOTE> + then + ## redirect error messages to config.log + output=`./conftest${ac_exeext} 2>&5` + if test ${?} = 0; then + r_cv_prog_f77_can_run=yes + fi + fi +fi + +fi + +rm -rf conftest conftest.* conftestf.* core +if test -n "${r_cv_prog_f77_can_run}"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +$as_echo "yes" >&6; } +else + if test "${cross_compiling}" = yes; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: don't know (cross-compiling)" >&5 +$as_echo "don't know (cross-compiling)" >&6; } + else + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: cannot run mixed C/Fortran code" >&5 +$as_echo "$as_me: WARNING: cannot run mixed C/Fortran code" >&2;} + as_fn_error $? "Maybe check LDFLAGS for paths to Fortran libraries?" "$LINENO" 5 + fi +fi + + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether ${F77} and ${CC} agree on int and double" >&5 +$as_echo_n "checking whether ${F77} and ${CC} agree on int and double... " >&6; } +if ${r_cv_prog_f77_cc_compat+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat > conftestf.f <<EOF + subroutine cftest(a, b, x, y) + integer a(3), b(2) + double precision x(3), y(3) + + b(1) = a(3)/a(2) + b(2) = a(3) - a(1)*a(2) + y(1) = dble(a(3))/x(2) + y(2) = x(3)*x(1) + y(3) = (x(2)/x(1)) ** a(1) + end +EOF +${F77} ${FFLAGS} -c conftestf.f 1>&5 2>&5 +## Yes we need to double quote this ... +cat > conftest.c <<EOF +#include <math.h> +#include <stdlib.h> +#include <stdio.h> +#include "confdefs.h" +#ifdef HAVE_F77_UNDERSCORE +# define F77_SYMBOL(x) x ## _ +#else +# define F77_SYMBOL(x) x +#endif + +extern void F77_SYMBOL(cftest)(int *a, int *b, double *x, double *y); + +int main () { + int a[3] = {17, 237, 2000000000}, b[2], res = 0; + double x[3] = {3.14159265, 123.456789, 2.3e34}, z[3]; + double eps = 1e-6; + double zres[3]; + int i, bres[2]; + + zres[0] = (double) a[2]/x[1]; + zres[1] = x[2]*x[0]; + zres[2] = pow(x[1]/x[0], 17.0); + bres[0] = a[2]/a[1]; + bres[1] = a[2] - a[0]*a[1]; + F77_SYMBOL(cftest)(a, b, x, z); + if(b[0] != bres[0]) res++; + if(b[1] != bres[1]) res++; + for(i = 0; i < 3; i++) + if(fabs(z[i]/zres[i] - 1) > eps) res++; + printf("number of errors %d\n", res); + exit(res); +} +EOF +if ${CC} ${CFLAGS} -c conftest.c 1>&5 2>&5; then + ## <NOTE> + ## This should really use MAIN_LD, and hence come after this is + ## determined (and necessary additions to MAIN_LDFLAGS were made). + ## But it seems that we currently can always use the C compiler. + ## Also, to be defensive there should be a similar test with SHLIB_LD + ## and SHLIB_LDFLAGS (and note that on HPUX with native cc we have to + ## use ld for SHLIB_LD) ... + if ${CC} ${CFLAGS} ${LDFLAGS} ${MAIN_LDFLAGS} -o conftest${ac_exeext} \ + conftest.${ac_objext} conftestf.${ac_objext} ${FLIBS} \ + ${LIBM} 1>&5 2>&5; + ## </NOTE> + then + ## redirect error messages to config.log + output=`./conftest${ac_exeext} 2>&5` + if test ${?} = 0; then + r_cv_prog_f77_cc_compat=yes + fi + fi +fi + +fi + +rm -rf conftest conftest.* conftestf.* core +if test -n "${r_cv_prog_f77_cc_compat}"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +$as_echo "yes" >&6; } +else + if test "${cross_compiling}" = yes; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: don't know (cross-compiling)" >&5 +$as_echo "don't know (cross-compiling)" >&6; } + else + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: ${F77} and ${CC} disagree on int and double" >&5 +$as_echo "$as_me: WARNING: ${F77} and ${CC} disagree on int and double" >&2;} + as_fn_error $? "Maybe change CFLAGS or FFLAGS?" "$LINENO" 5 + fi +fi + + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether ${F77} and ${CC} agree on double complex" >&5 +$as_echo_n "checking whether ${F77} and ${CC} agree on double complex... " >&6; } +if ${r_cv_prog_f77_cc_compat_complex+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat > conftestf.f <<EOF + subroutine cftest(x) + complex*16 x(3) + integer i + +c a few tests of constructs that are sometimes missing + if(x(1) .eq. x(1)) i = 0 + x(1) = x(1)*x(2) + x(3) + end +EOF +${F77} ${FFLAGS} -c conftestf.f 1>&5 2>&5 +## Yes we need to double quote this ... +cat > conftest.c <<EOF +#include <math.h> +#include <stdlib.h> +#include "confdefs.h" +#include <stdio.h> +#ifdef HAVE_F77_UNDERSCORE +# define F77_SYMBOL(x) x ## _ +#else +# define F77_SYMBOL(x) x +#endif + +typedef struct { + double r; + double i; +} Rcomplex; + +extern void F77_SYMBOL(cftest)(Rcomplex *x); + +int main () { + Rcomplex z[3]; + + z[0].r = 3.14159265; + z[0].i = 2.172; + z[1].i = 3.14159265; + z[1].r = 2.172; + z[2].r = 123.456; + z[2].i = 0.123456; + F77_SYMBOL(cftest)(z); + printf("%f %f\n", z[0].r, z[0].i); + if(fabs(z[0].r - 123.456) < 1e-4 && fabs(z[0].i - 14.71065) < 1e-4) + exit(0); + else exit(1); +} +EOF +if ${CC} ${CFLAGS} -c conftest.c 1>&5 2>&5; then + ## <NOTE> + ## This should really use MAIN_LD, and hence come after this is + ## determined (and necessary additions to MAIN_LDFLAGS were made). + ## But it seems that we currently can always use the C compiler. + ## Also, to be defensive there should be a similar test with SHLIB_LD + ## and SHLIB_LDFLAGS (and note that on HPUX with native cc we have to + ## use ld for SHLIB_LD) ... + if ${CC} ${CFLAGS} ${LDFLAGS} ${MAIN_LDFLAGS} -o conftest${ac_exeext} \ + conftest.${ac_objext} conftestf.${ac_objext} ${FLIBS} \ + ${LIBM} 1>&5 2>&5; + ## </NOTE> + then + ## redirect error messages to config.log + output=`./conftest${ac_exeext} 2>&5` + if test ${?} = 0; then + r_cv_prog_f77_cc_compat_complex=yes + fi + fi +fi + +fi + +rm -rf conftest conftest.* conftestf.* core +if test -n "${r_cv_prog_f77_cc_compat_complex}"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +$as_echo "yes" >&6; } + +$as_echo "#define HAVE_FORTRAN_DOUBLE_COMPLEX 1" >>confdefs.h + +else + warn_f77_cc_double_complex="${F77} and ${CC} disagree on double complex" + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: ${warn_f77_cc_double_complex}" >&5 +$as_echo "$as_me: WARNING: ${warn_f77_cc_double_complex}" >&2;} +fi + + + + if test "x${HAVE_FORTRAN_DOUBLE_COMPLEX}" != x; then + COMPILE_FORTRAN_DOUBLE_COMPLEX_TRUE= + COMPILE_FORTRAN_DOUBLE_COMPLEX_FALSE='#' +else + COMPILE_FORTRAN_DOUBLE_COMPLEX_TRUE='#' + COMPILE_FORTRAN_DOUBLE_COMPLEX_FALSE= +fi + + +ac_ext=f +ac_compile='$F77 -c $FFLAGS conftest.$ac_ext >&5' +ac_link='$F77 -o conftest$ac_exeext $FFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_f77_compiler_gnu + + + OPENMP_FFLAGS= + # Check whether --enable-openmp was given. +if test "${enable_openmp+set}" = set; then : + enableval=$enable_openmp; +fi + + if test "$enable_openmp" != no; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $F77 option to support OpenMP" >&5 +$as_echo_n "checking for $F77 option to support OpenMP... " >&6; } +if ${ac_cv_prog_f77_openmp+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat > conftest.$ac_ext <<_ACEOF + + program main + implicit none +!$ integer tid + tid = 42 + call omp_set_num_threads(2) + end + +_ACEOF +if ac_fn_f77_try_link "$LINENO"; then : + ac_cv_prog_f77_openmp='none needed' +else + ac_cv_prog_f77_openmp='unsupported' + for ac_option in -fopenmp -xopenmp -qopenmp \ + -openmp -mp -omp -qsmp=omp -homp \ + -fopenmp=libomp \ + -Popenmp --openmp; do + ac_save_FFLAGS=$FFLAGS + FFLAGS="$FFLAGS $ac_option" + cat > conftest.$ac_ext <<_ACEOF + + program main + implicit none +!$ integer tid + tid = 42 + call omp_set_num_threads(2) + end + +_ACEOF +if ac_fn_f77_try_link "$LINENO"; then : + ac_cv_prog_f77_openmp=$ac_option +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + FFLAGS=$ac_save_FFLAGS + if test "$ac_cv_prog_f77_openmp" != unsupported; then + break + fi + done +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_f77_openmp" >&5 +$as_echo "$ac_cv_prog_f77_openmp" >&6; } + case $ac_cv_prog_f77_openmp in #( + "none needed" | unsupported) + ;; #( + *) + OPENMP_FFLAGS=$ac_cv_prog_f77_openmp ;; + esac + fi + + +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + + + +### *** C++ compiler. + + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether ${CXX} accepts -M for generating dependencies" >&5 +$as_echo_n "checking whether ${CXX} accepts -M for generating dependencies... " >&6; } +if ${r_cv_prog_cxx_m+:} false; then : + $as_echo_n "(cached) " >&6 +else + echo "#include <math.h>" > conftest.cc +## No real point in using AC_LANG_* and ${ac_ext}, as we need to create +## hard-wired suffix rules. We could be a bit more careful as we +## actually only test suffix '.cc'. +if test -n "`${CXX} -M conftest.cc 2>/dev/null | grep conftest`"; then + r_cv_prog_cxx_m=yes +else + r_cv_prog_cxx_m=no +fi +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $r_cv_prog_cxx_m" >&5 +$as_echo "$r_cv_prog_cxx_m" >&6; } + +r_cxx_rules_frag=Makefrag.cxx + +cat << \EOF > ${r_cxx_rules_frag} +.cc.o: + $(CXX) $(ALL_CPPFLAGS) $(ALL_CXXFLAGS) -c $< -o $@ +.cpp.o: + $(CXX) $(ALL_CPPFLAGS) $(ALL_CXXFLAGS) -c $< -o $@ +EOF +if test "${r_cv_prog_cxx_m}" = yes; then + cat << \EOF >> ${r_cxx_rules_frag} +.cc.d: + @echo "making $@ from $<" + @$(CXX) -M $(ALL_CPPFLAGS) $< > $@ +.cpp.d: + @echo "making $@ from $<" + @$(CXX) -M $(ALL_CPPFLAGS) $< > $@ +EOF +else + cat << \EOF >> ${r_cxx_rules_frag} +.cc.d: + @echo > $@ +.cpp.d: + @echo > $@ +EOF +fi + + + +ac_ext=cpp +ac_cpp='$CXXCPP $CPPFLAGS' +ac_compile='$CXX -c $CXXFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CXX -o conftest$ac_exeext $CXXFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_cxx_compiler_gnu + + + OPENMP_CXXFLAGS= + # Check whether --enable-openmp was given. +if test "${enable_openmp+set}" = set; then : + enableval=$enable_openmp; +fi + + if test "$enable_openmp" != no; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $CXX option to support OpenMP" >&5 +$as_echo_n "checking for $CXX option to support OpenMP... " >&6; } +if ${ac_cv_prog_cxx_openmp+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +#ifndef _OPENMP + choke me +#endif +#include <omp.h> +int main () { return omp_get_num_threads (); } + +_ACEOF +if ac_fn_cxx_try_link "$LINENO"; then : + ac_cv_prog_cxx_openmp='none needed' +else + ac_cv_prog_cxx_openmp='unsupported' + for ac_option in -fopenmp -xopenmp -qopenmp \ + -openmp -mp -omp -qsmp=omp -homp \ + -fopenmp=libomp \ + -Popenmp --openmp; do + ac_save_CXXFLAGS=$CXXFLAGS + CXXFLAGS="$CXXFLAGS $ac_option" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +#ifndef _OPENMP + choke me +#endif +#include <omp.h> +int main () { return omp_get_num_threads (); } + +_ACEOF +if ac_fn_cxx_try_link "$LINENO"; then : + ac_cv_prog_cxx_openmp=$ac_option +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + CXXFLAGS=$ac_save_CXXFLAGS + if test "$ac_cv_prog_cxx_openmp" != unsupported; then + break + fi + done +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cxx_openmp" >&5 +$as_echo "$ac_cv_prog_cxx_openmp" >&6; } + case $ac_cv_prog_cxx_openmp in #( + "none needed" | unsupported) + ;; #( + *) + OPENMP_CXXFLAGS=$ac_cv_prog_cxx_openmp ;; + esac + fi + + +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + + +### *** ObjC compiler + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether we can compute ObjC Make dependencies" >&5 +$as_echo_n "checking whether we can compute ObjC Make dependencies... " >&6; } +if ${r_cv_prog_objc_m+:} false; then : + $as_echo_n "(cached) " >&6 +else + echo "#include <math.h>" > conftest.m +for prog in "${OBJC} -MM" "${OBJC} -M" "${CPP} -M" "cpp -M"; do + if ${prog} conftest.m 2>/dev/null | \ + grep 'conftest.o: conftest.m' >/dev/null; then + r_cv_prog_objc_m="${prog}" + break + fi +done +fi + +if test -z "${r_cv_prog_objc_m}"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes, using ${r_cv_prog_objc_m}" >&5 +$as_echo "yes, using ${r_cv_prog_objc_m}" >&6; } +fi + +r_objc_rules_frag=Makefrag.m + +cat << \EOF > ${r_objc_rules_frag} +.m.o: + $(OBJC) $(ALL_CPPFLAGS) $(ALL_OBJCFLAGS) -c $< -o $@ +EOF +if test -n "${r_cv_prog_objc_m}"; then + cat << EOF >> ${r_objc_rules_frag} +.m.d: + @echo "making \$@ from \$<" + @${r_cv_prog_objc_m} \$(ALL_CPPFLAGS) $< > \$@ +EOF +else + cat << \EOF >> ${r_cc_rules_frag} +.m.d: + @echo > $@ +EOF +fi + + + + if test -z "${OBJC}"; then + r_cv_objc_runtime=none + else + + ac_ext=m +ac_cpp='$OBJCPP $CPPFLAGS' +ac_compile='$OBJC -c $OBJCFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$OBJC -o conftest$ac_exeext $OBJCFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_objc_compiler_gnu + + + # Don't check for headers, becasue that will require Obj-C preprocessor unconditionally (autoconf bug?) + #AC_MSG_CHECKING([for ObjC headers]) + # Check for common headers + #AC_CHECK_HEADERS_ONCE([objc/objc.h objc/objc-api.h objc/Object.h], [ ac_has_objc_headers=yes ], [ + # AC_MSG_FAILURE([Objective C runtime headers were not found]) + #]) + + # FIXME: we don't check whether the runtime needs -lpthread which is possible + # (empirically Linux GNU and Apple runtime don't) + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for ObjC runtime library" >&5 +$as_echo_n "checking for ObjC runtime library... " >&6; } +if ${r_cv_objc_runtime+:} false; then : + $as_echo_n "(cached) " >&6 +else + + save_OBJCFLAGS="$OBJCFLAGS" + save_LIBS="$LIBS" + r_cv_objc_runtime= + for libobjc in objc objc-gnu objc-lf objc-lf2; do + LIBS="${save_LIBS} -l${libobjc}" + #OBJCFLAGS="$OBJCFLAGS $PTHREAD_CFLAGS -fgnu-runtime" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + + +#undef __OBJC2__ +#include <objc/Object.h> + +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ + + [Object class]; + + ; + return 0; +} + +_ACEOF +if ac_fn_objc_try_link "$LINENO"; then : + + r_cv_objc_runtime="-l${libobjc}" + break + +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + done + LIBS="$save_LIBS" + OBJCFLAGS="$save_OBJCFLAGS" + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $r_cv_objc_runtime" >&5 +$as_echo "$r_cv_objc_runtime" >&6; } + + OBJC_LIBS="${r_cv_objc_runtime} ${OBJC_LIBS}" + + if test "z${r_cv_objc_runtime}" != z; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for ObjC runtime style" >&5 +$as_echo_n "checking for ObjC runtime style... " >&6; } +if ${r_cv_objc_runtime_style+:} false; then : + $as_echo_n "(cached) " >&6 +else + + save_OBJCFLAGS="$OBJCFLAGS" + save_LIBS="$LIBS" + r_cv_objc_runtime_style=unknown + LIBS="${OBJC_LIBS} $LIBS" + for objc_lookup_class in objc_lookup_class objc_lookUpClass; do + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + + +/* see PR#15107 */ +#undef __OBJC2__ +#include <objc/objc.h> +#include <objc/objc-api.h> + +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ + + id class = ${objc_lookup_class} ("Object"); + + ; + return 0; +} + +_ACEOF +if ac_fn_objc_try_link "$LINENO"; then : + + if test ${objc_lookup_class} = objc_lookup_class; then + r_cv_objc_runtime_style=gnu + else + r_cv_objc_runtime_style=next + fi + break + +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + done + LIBS="$save_LIBS" + OBJCFLAGS="$save_OBJCFLAGS" + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $r_cv_objc_runtime_style" >&5 +$as_echo "$r_cv_objc_runtime_style" >&6; } + fi + + if test "${r_cv_objc_runtime_style}" = gnu; then + +$as_echo "#define OBJC_GNU_RUNTIME 1" >>confdefs.h + + fi + if test "${r_cv_objc_runtime_style}" = next; then + +$as_echo "#define OBJC_NEXT_RUNTIME 1" >>confdefs.h + + fi + + ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + + fi # -n ${OBJC} + + +## FSF builds of gcc (and maybe others?) need -fobjc-exceptions otherwise +## @try and friends don't work +ac_safe=_fobjc_exceptions + + if test -z "${OBJC}"; then + eval r_cv_prog_objc_flag_${ac_safe}=no + else + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether ${OBJC} accepts -fobjc-exceptions" >&5 +$as_echo_n "checking whether ${OBJC} accepts -fobjc-exceptions... " >&6; } + if eval \${r_cv_prog_objc_flag_${ac_safe}+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_ext=m +ac_cpp='$OBJCPP $CPPFLAGS' +ac_compile='$OBJC -c $OBJCFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$OBJC -o conftest$ac_exeext $OBJCFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_objc_compiler_gnu + + r_save_OBJCFLAGS="${OBJCFLAGS}" + OBJCFLAGS="${OBJCFLAGS} -fobjc-exceptions" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_objc_try_link "$LINENO"; then : + eval "r_cv_prog_objc_flag_${ac_safe}=yes" +else + eval "r_cv_prog_objc_flag_${ac_safe}=no" +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + OBJCFLAGS="${r_save_OBJCFLAGS}" + ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + + +fi + + if eval "test \"`echo '$r_cv_prog_objc_flag_'$ac_safe`\" = yes"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +$as_echo "yes" >&6; } + separator="" +test -z "${separator}" && separator=" " +if test -z "${OBJCFLAGS}"; then + OBJCFLAGS="-fobjc-exceptions" +else + OBJCFLAGS="${OBJCFLAGS}${separator}-fobjc-exceptions" +fi + else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } + fi + fi + +## FIXME: checks for Foundation are not darwin-specifc at all. In fact the whole +## point of R_OBJC_FOUNDATION is to detect foundation classes on other +## platforms (on Darwin we already *know* that is it -framework Foundation +## but not so on Linux!), so the following was not intended to be conditonal. +case "${host_os}" in + darwin*) + + ac_objc_foundation=no + if test -n "${OBJC}"; then + + r_foundation_cached=yes + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for cached Foundation settings" >&5 +$as_echo_n "checking for cached Foundation settings... " >&6; } + if ${r_cv_cache_foundation_flags+:} false; then : + $as_echo_n "(cached) " >&6 +else + + r_cv_cache_foundation_flags=yes + r_foundation_cached=no +fi + + { $as_echo "$as_me:${as_lineno-$LINENO}: result: ${r_foundation_cached}" >&5 +$as_echo "${r_foundation_cached}" >&6; } + # if so, fetch them from the cache + if test "${r_foundation_cached}" = yes; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking FOUNDATION_LIBS" >&5 +$as_echo_n "checking FOUNDATION_LIBS... " >&6; } +if ${r_cv_FOUNDATION_LIBS+:} false; then : + $as_echo_n "(cached) " >&6 +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $r_cv_FOUNDATION_LIBS" >&5 +$as_echo "$r_cv_FOUNDATION_LIBS" >&6; } + FOUNDATION_LIBS="${r_cv_FOUNDATION_LIBS}" + { $as_echo "$as_me:${as_lineno-$LINENO}: checking FOUNDATION_CPPFLAGS" >&5 +$as_echo_n "checking FOUNDATION_CPPFLAGS... " >&6; } +if ${r_cv_FOUNDATION_CPPFLAGS+:} false; then : + $as_echo_n "(cached) " >&6 +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $r_cv_FOUNDATION_CPPFLAGS" >&5 +$as_echo "$r_cv_FOUNDATION_CPPFLAGS" >&6; } + FOUNDATION_CPPFLAGS="${r_cv_FOUNDATION_CPPFLAGS}" + else + + ac_ext=m +ac_cpp='$OBJCPP $CPPFLAGS' +ac_compile='$OBJC -c $OBJCFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$OBJC -o conftest$ac_exeext $OBJCFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_objc_compiler_gnu + + rof_save_LIBS="${LIBS}" + rof_save_CPPFLAGS="${CPPFLAGS}" + LIBS="${LIBS} ${FOUNDATION_LIBS}" + CPPFLAGS="${CPPFLAGS} ${FOUNDATION_CPPFLAGS}" + + if test -n "whether default Foundation framework works"; then { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether default Foundation framework works" >&5 +$as_echo_n "checking whether default Foundation framework works... " >&6; }; fi + ac_objc_foundation_works=no + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +#import <Foundation/Foundation.h> + +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ + + NSAutoreleasePool *pool = [[NSAutoreleasePool alloc] init]; + NSString *s = @"hello, world"; + + [pool release]; + + ; + return 0; +} +_ACEOF +if ac_fn_objc_try_link "$LINENO"; then : + ac_objc_foundation_works=yes +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + if test "${ac_objc_foundation_works}" = yes; then + if test -n "whether default Foundation framework works"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +$as_echo "yes" >&6; }; fi + + else + if test -n "whether default Foundation framework works"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; }; fi + + fi + + if test "${ac_objc_foundation_works}" != yes; then + LIBS="${rof_save_LIBS} -framework Foundation" + CPPFLAGS="${rof_save_CPPFLAGS}" + + if test -n "whether -framework Foundation works"; then { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether -framework Foundation works" >&5 +$as_echo_n "checking whether -framework Foundation works... " >&6; }; fi + ac_objc_foundation_works=no + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +#import <Foundation/Foundation.h> + +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ + + NSAutoreleasePool *pool = [[NSAutoreleasePool alloc] init]; + NSString *s = @"hello, world"; + + [pool release]; + + ; + return 0; +} +_ACEOF +if ac_fn_objc_try_link "$LINENO"; then : + ac_objc_foundation_works=yes +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + if test "${ac_objc_foundation_works}" = yes; then + if test -n "whether -framework Foundation works"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +$as_echo "yes" >&6; }; fi + FOUNDATION_LIBS='-framework Foundation' + else + if test -n "whether -framework Foundation works"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; }; fi + + fi + + fi + if test "${ac_objc_foundation_works}" != yes; then + LIBS="${rof_save_LIBS} -lFoundation ${OBJC_LIBS}" + + if test -n "whether libFoundation works"; then { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether libFoundation works" >&5 +$as_echo_n "checking whether libFoundation works... " >&6; }; fi + ac_objc_foundation_works=no + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +#import <Foundation/Foundation.h> + +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ + + NSAutoreleasePool *pool = [[NSAutoreleasePool alloc] init]; + NSString *s = @"hello, world"; + + [pool release]; + + ; + return 0; +} +_ACEOF +if ac_fn_objc_try_link "$LINENO"; then : + ac_objc_foundation_works=yes +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + if test "${ac_objc_foundation_works}" = yes; then + if test -n "whether libFoundation works"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +$as_echo "yes" >&6; }; fi + FOUNDATION_LIBS='-lFoundation' + else + if test -n "whether libFoundation works"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; }; fi + + fi + + fi + if test "${ac_objc_foundation_works}" != yes; then + LIBS="${rof_save_LIBS}" + ac_working_gnustep=no + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for GNUstep" >&5 +$as_echo_n "checking for GNUstep... " >&6; } + if test -z "${GNUSTEP_SYSTEM_ROOT}"; then + for dir in /usr/lib/GNUstep /usr/local/lib/GNUstep; do + if test -e "${dir}/System/Makefiles"; then GNUSTEP_SYSTEM_ROOT="${dir}/System"; break; fi + done + fi + if test -z "${GNUSTEP_SYSTEM_ROOT}"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } + else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: in ${GNUSTEP_SYSTEM_ROOT}" >&5 +$as_echo "in ${GNUSTEP_SYSTEM_ROOT}" >&6; } + # this is a hack - we extract the relevant flags from GNUstep's makefiles. + # in order to do that, we must setup the entire GNUstep environment which we do + # in a separate script as to not pollute configure's environment + cat << EOF > gnusteptest.sh +#!/bin/sh +. ${GNUSTEP_SYSTEM_ROOT}/Library/Makefiles/GNUstep.sh +${MAKE} -s -f gnustepmake -f \${GNUSTEP_MAKEFILES}/common.make -f \${GNUSTEP_MAKEFILES}/rules.make \${1} +EOF + cat << \EOF > gnustepmake +printcppflags: FORCE + @echo $(ALL_CPPFLAGS) $(ADDITIONAL_OBJCFLAGS) $(AUXILIARY_OBJCFLAGS) $(GNUSTEP_HEADERS_FLAGS) +printlibs: FORCE + @echo $(ALL_LIB_DIRS) $(FND_LIBS) $(ADDITIONAL_OBJC_LIBS) $(AUXILIARY_OBJC_LIBS) $(OBJC_LIBS) $(SYSTEM_LIBS) $(TARGET_SYSTEM_LIBS) +FORCE: +EOF + GNUSTEP_CPPFLAGS=`sh gnusteptest.sh printcppflags` + GNUSTEP_LIBS=`sh gnusteptest.sh printlibs` + #echo " GNUstep CPPFLAGS: ${GNUSTEP_CPPFLAGS}" + #echo " GNUstep LIBS: ${GNUSTEP_LIBS}" + LIBS="${rof_save_LIBS} ${GNUSTEP_LIBS}" + CPPFLAGS="${rof_save_CPPFLAGS} ${GNUSTEP_CPPFLAGS}" + rm -f gnusteptest.sh gnustepmake + + if test -n "whether GNUstep works"; then { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether GNUstep works" >&5 +$as_echo_n "checking whether GNUstep works... " >&6; }; fi + ac_objc_foundation_works=no + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +#import <Foundation/Foundation.h> + +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ + + NSAutoreleasePool *pool = [[NSAutoreleasePool alloc] init]; + NSString *s = @"hello, world"; + + [pool release]; + + ; + return 0; +} +_ACEOF +if ac_fn_objc_try_link "$LINENO"; then : + ac_objc_foundation_works=yes +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + if test "${ac_objc_foundation_works}" = yes; then + if test -n "whether GNUstep works"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +$as_echo "yes" >&6; }; fi + + FOUNDATION_CPPFLAGS="${GNUSTEP_CPPFLAGS}" + FOUNDATION_LIBS="${GNUSTEP_LIBS}" + else + if test -n "whether GNUstep works"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; }; fi + + fi + + fi # -n GNUSTEP_SYSTEM_ROOT + fi + LIBS="${rof_save_LIBS}" + CPPFLAGS="${rof_save_CPPFLAGS}" + + + if ${r_cv_FOUNDATION_CPPFLAGS+:} false; then : + $as_echo_n "(cached) " >&6 +else + r_cv_FOUNDATION_CPPFLAGS="${FOUNDATION_CPPFLAGS}" +fi + + if ${r_cv_FOUNDATION_LIBS+:} false; then : + $as_echo_n "(cached) " >&6 +else + r_cv_FOUNDATION_LIBS="${FOUNDATION_LIBS}" +fi + + ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + + ac_objc_foundation=${ac_objc_foundation_works} + + fi # not cached flags + + fi # -n ${OBJC} + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for working Foundation implementation" >&5 +$as_echo_n "checking for working Foundation implementation... " >&6; } +if ${r_cv_objc_foundation+:} false; then : + $as_echo_n "(cached) " >&6 +else + r_cv_objc_foundation="${ac_objc_foundation}" +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $r_cv_objc_foundation" >&5 +$as_echo "$r_cv_objc_foundation" >&6; } + + ;; +esac + +### ** Platform-specific overrides for the C, Fortran 77 and C++ compilers. + +case "${host_cpu}" in + i*86|x86_64) + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether C runtime needs -D__NO_MATH_INLINES" >&5 +$as_echo_n "checking whether C runtime needs -D__NO_MATH_INLINES... " >&6; } +if ${r_cv_c_no_math_inlines+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test "$cross_compiling" = yes; then : + r_cv_c_no_math_inlines=no +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +#include <math.h> +#if defined(__GLIBC__) +#include <math.h> +int main () { + double x, y; + x = -1./0.; + y = exp(x); + exit (y != 0.); +} +#else +int main () { + exit(0); +} +#endif + +_ACEOF +if ac_fn_c_try_run "$LINENO"; then : + r_cv_c_no_math_inlines=no +else + r_cv_c_no_math_inlines=yes +fi +rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ + conftest.$ac_objext conftest.beam conftest.$ac_ext +fi + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $r_cv_c_no_math_inlines" >&5 +$as_echo "$r_cv_c_no_math_inlines" >&6; } +if test "${r_cv_c_no_math_inlines}" = yes; then + separator="" +test -z "${separator}" && separator=" " +if test -z "${R_XTRA_CFLAGS}"; then + R_XTRA_CFLAGS="-D__NO_MATH_INLINES" +else + R_XTRA_CFLAGS="${R_XTRA_CFLAGS}${separator}-D__NO_MATH_INLINES" +fi +fi + + ## We used to add -mieee-fp here, but it seems it is really a + ## linker flag for old Linuxen adding -lieee to a non-shared link. + ;; +esac + + + +case "${host_os}" in + aix*) + $as_echo "#define HAVE_NO_SYMBOL_UNDERSCORE 1" >>confdefs.h + + if test "${GCC}" = yes; then + if test "x${OBJECT_MODE}" = "x64"; then + ac_safe=_mminimal_toc +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether ${CC} accepts -mminimal-toc" >&5 +$as_echo_n "checking whether ${CC} accepts -mminimal-toc... " >&6; } +if eval \${r_cv_prog_cc_flag_${ac_safe}+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + +r_save_CFLAGS="${CFLAGS}" +CFLAGS="${CFLAGS} -mminimal-toc" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + eval "r_cv_prog_cc_flag_${ac_safe}=yes" +else + eval "r_cv_prog_cc_flag_${ac_safe}=no" +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +CFLAGS="${r_save_CFLAGS}" +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + + +fi + +if eval "test \"`echo '$r_cv_prog_cc_flag_'$ac_safe`\" = yes"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +$as_echo "yes" >&6; } + separator="" +test -z "${separator}" && separator=" " +if test -z "${R_XTRA_CFLAGS}"; then + R_XTRA_CFLAGS="-mminimal-toc" +else + R_XTRA_CFLAGS="${R_XTRA_CFLAGS}${separator}-mminimal-toc" +fi +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + else + ac_safe=_mno_fp_in_toc +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether ${CC} accepts -mno-fp-in-toc" >&5 +$as_echo_n "checking whether ${CC} accepts -mno-fp-in-toc... " >&6; } +if eval \${r_cv_prog_cc_flag_${ac_safe}+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + +r_save_CFLAGS="${CFLAGS}" +CFLAGS="${CFLAGS} -mno-fp-in-toc" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + eval "r_cv_prog_cc_flag_${ac_safe}=yes" +else + eval "r_cv_prog_cc_flag_${ac_safe}=no" +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +CFLAGS="${r_save_CFLAGS}" +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + + +fi + +if eval "test \"`echo '$r_cv_prog_cc_flag_'$ac_safe`\" = yes"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +$as_echo "yes" >&6; } + separator="" +test -z "${separator}" && separator=" " +if test -z "${R_XTRA_CFLAGS}"; then + R_XTRA_CFLAGS="-mno-fp-in-toc" +else + R_XTRA_CFLAGS="${R_XTRA_CFLAGS}${separator}-mno-fp-in-toc" +fi +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + fi + fi + ;; + darwin*) + ## which these days mean macOS + $as_echo "#define HAVE_NO_SYMBOL_UNDERSCORE 1" >>confdefs.h + + ;; + hpux*) + $as_echo "#define HAVE_NO_SYMBOL_UNDERSCORE 1" >>confdefs.h + + case "${CC}" in + cc|c89) + ## Luke Tierney says we also need '-Wp,-H16000' which tells the + ## pre-processor to increase the size of an internal table. It + ## seems that src/main/vfonts/g_her_glyph.c contains a line + ## that is too long for the pre-processor without this flag. + separator="" +test -z "${separator}" && separator=" " +if test -z "${R_XTRA_CPPFLAGS}"; then + R_XTRA_CPPFLAGS="-Wp,-H16000" +else + R_XTRA_CPPFLAGS="${R_XTRA_CPPFLAGS}${separator}-Wp,-H16000" +fi + ;; + esac + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for shl_load in -ldld" >&5 +$as_echo_n "checking for shl_load in -ldld... " >&6; } +if ${ac_cv_lib_dld_shl_load+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-ldld $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char shl_load (); +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +return shl_load (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_dld_shl_load=yes +else + ac_cv_lib_dld_shl_load=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_dld_shl_load" >&5 +$as_echo "$ac_cv_lib_dld_shl_load" >&6; } +if test "x$ac_cv_lib_dld_shl_load" = xyes; then : + R_XTRA_LIBS="-ldld ${R_XTRA_LIBS}" +fi + + ;; + linux*) + case "${CC}" in + ## Intel compiler + *icc*) + ## icc declares __GNUC__, so it picks up CFLAGS intended for gcc. + if test "$ac_test_CFLAGS" != set; then + if test $ac_cv_prog_cc_g = yes; then + case "${host_cpu}" in + x86_64) + CFLAGS="-g -O2 -std=c99" + ;; + *) + ## on ix86 optimization fails + CFLAGS="-g -std=c99" + ;; + esac + else + case "${host_cpu}" in + x86_64) + CFLAGS="-O2 -std=c99" + ;; + *) + CFLAGS="-std=c99" + ;; + esac + fi + fi + ## used to set IEEE flag, but this is version-dependent. + ;; + esac + case "${F77}" in + ## Intel compilers + *ifc|*ifort) + if test "x$userFFLAGS" = x; then + if test $ac_cv_prog_f77_g = yes; then + case "${host_cpu}" in + x86_64) + FFLAGS="-g -O2" + ;; + *) + FFLAGS="-g" + ;; + esac + else + case "${host_cpu}" in + x86_64) + FFLAGS="-O2" + ;; + *) + ## on ix86 optimization of dlamc.f fails + FFLAGS= + ;; + esac + fi + fi + ;; + esac + case "${CXX}" in + ## Intel compilers + *icpc|*icc) + if test "$ac_test_CXXFLAGS" != set; then + if test $ac_cv_prog_cxx_g = yes; then + case "${host_cpu}" in + x86_64) + CXXFLAGS="-g -O2" + ;; + *) + CXXFLAGS="-g" + ;; + esac + else + case "${host_cpu}" in + x86_64) + CXXFLAGS="-O2" + ;; + *) + CXXFLAGS= + ;; + esac + fi + fi + ;; + esac + ;; + mingw*|windows*|winnt) + $as_echo "#define HAVE_NO_SYMBOL_UNDERSCORE 1" >>confdefs.h + + ;; + openbsd*) + if test -z "`echo __ELF__ | $CC -E - | grep __ELF__`"; then + $as_echo "#define HAVE_NO_SYMBOL_UNDERSCORE 1" >>confdefs.h + + fi + ;; +esac + +if test "${SAFE_FFLAGS+set}" != set; then + if test "x${ac_cv_f77_compiler_gnu}" = xyes; then + SAFE_FFLAGS="${FFLAGS} -ffloat-store" + else + SAFE_FFLAGS=${FFLAGS} + fi +fi + + + + + + + + + + + + + + + + + + + + + +## System type. +case "${host_os}" in + linux*) + R_SYSTEM_ABI="linux" + ;; + solaris*) + R_SYSTEM_ABI="solaris" + ;; + darwin*) + R_SYSTEM_ABI="osx" + ;; + freebsd*) + R_SYSTEM_ABI="freebsd" + ;; + *) + R_SYSTEM_ABI="?" + ;; +esac +## Compiler types +## C: AC_PROG_CC does +## If using the GNU C compiler, set shell variable `GCC' to `yes'. +## Alternatively, could use ac_cv_c_compiler_gnu (undocumented). +if test "${GCC}" = yes; then + R_SYSTEM_ABI="${R_SYSTEM_ABI},gcc" +else +case "${host_os}" in + solaris*) + ## we assume native compilers elsewhere (e.g. for -KPIC), so do so here too. + R_SYSTEM_ABI="${R_SYSTEM_ABI},solcc" + ;; + *) + R_SYSTEM_ABI="${R_SYSTEM_ABI},?" +esac +fi +## C++: AC_PROG_CXX does +## If using the GNU C++ compiler, set shell variable `GXX' to `yes'. +## Alternatively, could use ac_cv_cxx_compiler_gnu (undocumented). +if test "${GXX}" = yes; then + R_SYSTEM_ABI="${R_SYSTEM_ABI},gxx" +else +case "${host_os}" in + solaris*) + R_SYSTEM_ABI="${R_SYSTEM_ABI},solCC" + ;; + *) + R_SYSTEM_ABI="${R_SYSTEM_ABI},?" +esac +fi +## Fortran 77: AC_PROG_F77 does +## If using `g77' (the GNU Fortran 77 compiler), then set the shell +## variable `G77' to `yes' (and also seems to do so for gfortran, which +## is what we really need). +## Alternatively, could use ac_cv_f77_compiler_gnu (undocumented). +if test "${G77}" = yes; then + R_SYSTEM_ABI="${R_SYSTEM_ABI},gfortran" +else +case "${host_os}" in + solaris*) + R_SYSTEM_ABI="${R_SYSTEM_ABI},solf95" + ;; + *) + R_SYSTEM_ABI="${R_SYSTEM_ABI},?" +esac +fi +## Fortran 90/95: AC_PROG_FC does not seem to set a shell variable +## indicating the GNU Fortran 90/95 compiler. +## Hence, need to use ac_cv_fc_compiler_gnu (undocumented). +if test "${ac_cv_fc_compiler_gnu}" = yes; then + R_SYSTEM_ABI="${R_SYSTEM_ABI},gfortran" +else +case "${host_os}" in + solaris*) + R_SYSTEM_ABI="${R_SYSTEM_ABI},solf95" + ;; + *) + R_SYSTEM_ABI="${R_SYSTEM_ABI},?" +esac +fi + + + +### ** DLL stuff. + +## We need to determine the following: +## +## MAIN_LD, MAIN_LDFLAGS +## command and flags for loading the main binary so that it will load +## shared objects (DLLs) at runtime, also for profiling. +## CPICFLAGS, CXXPICFLAGS, FPICFLAGS, FCPICFLAGS +## flags for compiling C, C++, and Fortran library code. +## SHLIB_LD, SHLIB_LDFLAGS +## command and flags for creating DLLs (which contain object files +## from a C or Fortran compiler). +## DYLIB_LD, DYLIB_LDFLAGS +## ditto for dynamic libraries (where different.) +## SHLIB_CXXLD, SHLIB_CXXLDFLAGS +## command and flags for creating DLLs which contain object files from +## a C++ compiler. According to Autoconf, the C++ compiler/linker +## must be used for linking in this case (since special C++-ish things +## need to happen at link time like calling global constructors, +## instantiating templates, enabling exception support, etc.). +## +## The procedure is as follows. +## +## * We use applicable values from imake in case its CC is ours. +## * Irrespective of that, we think we know what to do with GNU tools +## (GNU C, Fortran, and C++ compilers). +## * Then, use platform specific overrides. +## * As a final safeguard, values from the environment (as specified in +## one of the configuration files or at the configure command line) +## override anything we figure out in the case of compiler flags; for +## linker flags (*LDFLAGS), environment settings override our results +## if the corresponding *LD variable was set, and add otherwise. +## +## NOTE: We do not provide defaults for the *LDFLAGS, taking a defensive +## approach. In case we cannot figure out {MAIN,SHLIB}_LDFLAGS and the +## user did not provide defaults, an error results. A warning is given +## if nothing was obtained for SHLIB_CXXLDFLAGS. +## +## Note also that some systems (formerly AIX) do not allow for unresolved +## symbols at link time. For such systems, we link against -lm (in case +## it exists) when building a shlib module via SHLIB_LIBADD. + +main_ld="${CC}" +shlib_ld="${CC}" +shlib_cxxld="${CXX}" +SHLIB_EXT=".so" +SHLIB_LIBADD= +use_exportfiles=no + +## Step 1. Ask imake. +## <NOTE> +## Earlier versions had fpicflags=${cpicflags}. As this really amounts +## to hoping rather than knowing, we no longer do this. +## </NOTE> +r_xtra_path="${PATH}" +for dir in /usr/bin/X11 /usr/X11R6/bin /usr/openwin/bin; do + r_xtra_path="${r_xtra_path}${PATH_SEPARATOR}${dir}" +done +# Extract the first word of "xmkmf", so it can be a program name with args. +set dummy xmkmf; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_path_XMKMF+:} false; then : + $as_echo_n "(cached) " >&6 +else + case $XMKMF in + [\\/]* | ?:[\\/]*) + ac_cv_path_XMKMF="$XMKMF" # Let the user override the test with a path. + ;; + *) + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in ${r_xtra_path} +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_path_XMKMF="$as_dir/$ac_word$ac_exec_ext" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + + ;; +esac +fi +XMKMF=$ac_cv_path_XMKMF +if test -n "$XMKMF"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $XMKMF" >&5 +$as_echo "$XMKMF" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + +if test -n "${XMKMF}"; then + echo > Imakefile + ${XMKMF} > /dev/null 2>&1 || echo > Makefile + cc=`"${srcdir}/tools/GETMAKEVAL" CC` + cc=`echo ${cc} | sed "s/ .*//"` + ## Paul Gilbert reported on R-devel 2006-04-13 a system with cc="" + if test -n "${cc}" ; then + r_cc_cmd=`echo ${CC} | sed "s/ .*//"` + if test "`which ${cc}`" = "`which ${r_cc_cmd}`"; then + shlib_ldflags=`"${srcdir}/tools/GETMAKEVAL" SHLIBLDFLAGS` + cpicflags=`"${srcdir}/tools/GETMAKEVAL" PICFLAGS` + fi + fi + cxx=`"${srcdir}/tools/GETMAKEVAL" CXX` + cxx=`echo ${cxx} | sed "s/ .*//"` + if test -n "${cxx}" -a -n "${CXX}"; then + r_cxx_cmd=`echo ${CXX} | sed "s/ .*//"` + if test "`which ${cxx}`" = "`which ${r_cxx_cmd}`"; then + cxxpicflags=`"${srcdir}/tools/GETMAKEVAL" CXXPICFLAGS` + fi + fi + rm -f Imakefile Makefile +fi + +## Step 2. GNU compilers. +if test "${GCC}" = yes; then + case "${host_cpu}" in +## Sparc has only an 8k global object table, 1024 entries on 64-bit. +## PowerPC has 32k, not enough on ppc64 for the ca6200 entries in libR.so +## The only other platform where this is said to matter is m68k, which +## has 32k and so can use -fpic. +## However, although the gcc docs do not mention it, it seems s390/s390x +## also supports and needs -fPIC + sparc*|ppc64*|powerpc64*|s390*) + cpicflags="-fPIC" + ;; + *) + cpicflags="-fpic" + ;; + esac + shlib_ldflags="-shared" +fi +if test "${G77}" = yes; then + case "${host_cpu}" in + sparc*|ppc64*|powerpc64*|s390*) + fpicflags="-fPIC" + ;; + *) + fpicflags="-fpic" + ;; + esac +fi +if test "${GXX}" = yes; then + case "${host_cpu}" in + sparc*|ppc64*|powerpc64*|s390*) + cxxpicflags="-fPIC" + ;; + *) + cxxpicflags="-fpic" + ;; + esac + shlib_cxxldflags="-shared" +fi + +## Step 3. Individual platform overrides. +dylib_undefined_allowed=yes +case "${host_os}" in + aix*) + use_exportfiles=yes + ## All AIX code is PIC. + cpicflags= + cxxpicflags= + fpicflags= + ## not clear if this is correct for native compilers + wl="-Wl," + ## libtool suggests that ia64 needs -Bexport and not -brtl + ## but we have no confirmation. + dylib_undefined_allowed=no + ##ADD: A symbol of memcpy,memset is exported in libR by expall. + ##ADD: However, for example, symbol in libc of memcpy is __memmove,__memmove64. + ##ADD: This black magic puts lc before lR and pockets this. + if test "x${OBJECT_MODE}" = "x64"; then + main_ldflags="${wl}-brtl ${wl}-bexpall ${wl}-bpT:0x100000000 ${wl}-bpD:0x110000000 -lc" + else + main_ldflags="${wl}-brtl ${wl}-bexpall -lc" + fi + shlib_ldflags="${wl}-brtl ${wl}-G ${wl}-bexpall ${wl}-bnoentry -lc" + SHLIB_LIBADD="\$(LIBM)" + shlib_cxxldflags="${shlib_ldflags}" + if test "${GCC}" = yes; then + shlib_ldflags="-shared ${shlib_ldflags}" + fi + if test "${GXX}" = yes; then + shlib_cxxldflags="-shared ${shlib_cxxldflags}" + fi + ;; + darwin*) + darwin_pic="-fPIC" + dylib_undefined_allowed=no + darwin_dylib_ldflags="-dynamiclib" + shlib_ldflags="-dynamiclib -Wl,-headerpad_max_install_names -undefined dynamic_lookup -single_module -multiply_defined suppress" + ## * recent ld has -single_module so it doesn't need -fno-common + ## we have to use dylib instead of a bundle + ## * dylib+single_module+flat_namespace=pretty much what other platforms call .so + ## but there can be no multiple symbols (due to flat namespace) + ## * since 10.3 we can also use -undefined dynamic_lookup which allows us to + ## use two-level namespace and still have undefined symbols + + ## FIXME: strictly speaking it should be "yes" but libRblas still + ## needs -lgfortran because the sharing is a one-way street + ## dylib_undefined_allowed=yes + + ## we have to test this in case an outdated linker or non-Apple compiler is used + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether linker supports dynamic lookup" >&5 +$as_echo_n "checking whether linker supports dynamic lookup... " >&6; } + if ${r_cv_has_dynlookup+:} false; then : + $as_echo_n "(cached) " >&6 +else + +cat > conftest.c <<EOF + void dummy() { } +EOF +echo "${CC} ${CFLAGS} conftest.c ${shlib_ldflags} -o libconftest${DYLIB_EXT} ${LIBS}" >&5 +if ${CC} ${CFLAGS} conftest.c ${shlib_ldflags} -o libconftest${DYLIB_EXT} ${LIBS} 1>&5 2>&5; then + r_cv_has_dynlookup=yes + { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +$as_echo "yes" >&6; } +else + r_cv_has_dynlookup=no + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: *** Please consider updating your Xcode tools. ***" >&5 +$as_echo "$as_me: WARNING: *** Please consider updating your Xcode tools. ***" >&2;} +fi +rm -f libconftest${DYLIB_EXT} conftest.c + +fi + + if test -n "${FORCE_FLAT_NAMESPACE}"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: Use of flat namespace is requested by user." >&5 +$as_echo "$as_me: WARNING: Use of flat namespace is requested by user." >&2;} + r_cv_has_dynlookup=forced-no + fi + if test "${r_cv_has_dynlookup}" != "yes"; then + shlib_ldflags="-dynamiclib -flat_namespace -undefined suppress -single_module -multiply_defined suppress" + dylib_undefined_allowed=yes + fi + + ## we use the same method for shlib and dylib now + darwin_dylib_ldflags="${shlib_ldflags}" + ## side note: we could use flat namespace instead, but there is an exception: + ## * libRblas must be 2-level, dyn lookup because of xerbla which is undefined + cpicflags="${darwin_pic}" + cxxpicflags="${darwin_pic}" + ## macOS does not have a Fortran compiler, so this is speculative + fpicflags="${darwin_pic}" + shlib_cxxldflags="${shlib_ldflags}" + ;; + freebsd*) + ## maybe this needs to depend on the compiler: + ## -export-dynamic used to work, but does not with clang. + ## Seems FreeBSD has used the GNU linker since at least 3.0 (Oct 1998) + ## We could also use -rdynamic, which seems to work with clang and gcc. + main_ldflags="-Wl,--export-dynamic" + shlib_ldflags="-shared" + ;; + gnu*) # GNU Hurd, see FreeBSD comment + main_ldflags="-Wl,--export-dynamic" + ;; + hpux*) + SHLIB_EXT=".sl" + case "${CC}" in + cc|c89) + cpicflags="+Z" + ;; + esac + case "${F77}" in + f77|fort77|f90) + fpicflags="+Z" + ;; + esac + main_ldflags="-Wl,-E" + if test "${GCC}" = yes; then + shlib_ldflags="-shared -fPIC -Wl,-Bsymbolic" + else + ## <NOTE> + ## Native cc insists on tacking on crt0.o when it calls ld, and + ## crt0.o is not built with PIC. As there seems to be no obvious + ## way to tell cc not to do this, we use ld for linking shlibs. + shlib_ld=ld + shlib_ldflags="-b -Bsymbolic" + ## </NOTE> + fi + if test "${GXX}" = yes; then + shlib_cxxldflags="-shared -fPIC" + fi + ;; + linux*aout) # GNU Linux/aout + sed '/HAVE_ELF_H/d' confdefs.h > tmp.h ; mv tmp.h confdefs.h + ;; + linux*) # GNU Linux/ELF + case "${CC}" in + ## Intel compiler: note that -c99 may have been appended + *icc*) + cpicflags="-fpic" + ;; + ## Portland Group + *pgcc*) + cpicflags="-fpic" + ;; + esac + case "${F77}" in + ## Intel compilers + *ifc|*ifort) + fpicflags="-fpic" + ;; + ## Portland Group + *pgf77|*pgf90|*pgf95) + fpicflags="-fpic" + ;; + esac + case "${CXX}" in + ## Intel compilers + *icpc|*icc) + cxxpicflags="-fpic" + ;; + ## Portland Group + *pgCC) + cxxpicflags="-fpic" + ;; + esac + ## Luke Tierney says that just '-export-dynamic' does not work for + ## Intel compilers (icc). It is accepted by clang but ignored. + ## Could also use -rdynamic, at least for gcc and clang. + main_ldflags="-Wl,--export-dynamic" + STATICR1="-Wl,--whole-archive" + STATICR2="-Wl,--no-whole-archive" + ;; + mingw*) + SHLIB_EXT=".dll" + cpicflags= + cxxpicflags= + fpicflags= + fcpicflags= + ;; + netbsd*) + ## See the comments about FreeBSD + if ${CPP} - -dM < /dev/null | grep __ELF__ >/dev/null ; then + main_ldflags="-Wl,--export-dynamic" + shlib_ldflags="-shared" + else + shlib_ldflags="-Bshareable" + fi + ;; + openbsd*) + ## ${wl} is defined by libtool configuration code. + ## Both -Wl,-export-dynamic and -Wl,--export-dynamic seem to + ## work with the GNU linker, but the second is what is documented. + ## libtool seems to use -Wl-E , a GNU ld alias of -Wl,--export-dynamic + if test -z "`echo __ELF__ | $CC -E - | grep __ELF__`"; then + main_ldflags="${wl}-export-dynamic" + shlib_ldflags="-shared -fPIC" + fi + case "${host_cpu}" in + powerpc*) + ## GCC -fpic limits to 2**16 on OpenBSD powerpc. + ## Error message without -fPIC: + ## relocation truncated to fit: R_PPC_GOT16... + if test "${GCC}" = yes; then + cpicflags="-fPIC" + fi + if test "${G77}" = yes; then + fpicflags="-fPIC" + fi + if test "${GXX}" = yes; then + cxxpicflags="-fPIC" + fi + ;; + esac + ;; + solaris*) +## SPARC has only an 8k global object table, 1024 entries on 64-bit, +## so need PIC not pic. They are the same on other Solaris platforms. + shlib_ldflags="-G" + shlib_cxxldflags="-G" + if test "${GCC}" = yes; then + cpicflags="-fPIC" + ld=`${CC} -print-prog-name=ld` + ldoutput=`${ld} -v 2>&1 | grep GNU` + if test -n "${ldoutput}"; then + main_ldflags="-Wl,-export-dynamic" + shlib_ldflags="-shared" + shlib_cxxldflags="-shared" + else + ## it seems gcc c 4.6.2 needs this with Solaris linker + shlib_ldflags="-shared" + shlib_cxxldflags="-shared" + fi + else + cpicflags="-KPIC" + if test "`basename ${CXX}`" = "CC" ; then + ## Forte version 7 needs -lCstd: Forte 6 does not. + ver=`${CXX} -V 2>&1 | sed 2d | grep 'Forte Developer 7 C++'` + if test -n "${ver}" ; then + shlib_cxxldflags="-G -lCstd" + fi + fi + fi + ## G77 include gfortran + if test "${G77}" != yes; then + fpicflags="-PIC" + else + fpicflags="-fPIC" + fi + if test "${GXX}" = yes; then + cxxpicflags="-fPIC" + ld=`${CXX} -print-prog-name=ld` + ldoutput=`${ld} -v 2>&1 | grep GNU` + if test -n "${ldoutput}"; then + shlib_cxxldflags="-shared" + fi + else + cxxpicflags="-KPIC" + fi + ;; +esac + +## <FIXME> +## Completely disable using libtool for building shlibs until libtool +## fully supports at least Fortran and C++. +## ## Step 4. In case we use libtool ... +## if test "${use_libtool}" = yes; then +## case "${host_os}" in +## *) +## ;; +## esac +## fi +## </FIXME> + +## Step 5. Overrides from the environment and error checking. +if test -z "${MAIN_LD}"; then + main_ld_was_given=no + if test "${main_ld}" = "${CC}"; then + MAIN_LD="\$(CC)" + else + MAIN_LD="${main_ld}" + fi +fi +separator="" +test -z "${separator}" && separator=" " +if test -z "${MAIN_LDFLAGS}"; then + MAIN_LDFLAGS="${main_ldflags}" +else + MAIN_LDFLAGS="${MAIN_LDFLAGS}${separator}${main_ldflags}" +fi + +: ${CPICFLAGS="${cpicflags}"} +if test -z "${CPICFLAGS}"; then + case "${host_os}" in + aix*|mingw*) + ;; + *) + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: I could not determine CPICFLAGS." >&5 +$as_echo "$as_me: WARNING: I could not determine CPICFLAGS." >&2;} + as_fn_error $? "See the file doc/html/R-admin.html for more information." "$LINENO" 5 + ;; + esac +fi + +: ${FPICFLAGS="${fpicflags}"} +if test -z "${FPICFLAGS}"; then + case "${host_os}" in + aix*|mingw*) + ;; + *) + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: I could not determine FPICFLAGS." >&5 +$as_echo "$as_me: WARNING: I could not determine FPICFLAGS." >&2;} + as_fn_error $? "See the file doc/html/R-admin.html for more information." "$LINENO" 5 + ;; + esac +fi + +: ${CXXPICFLAGS="${cxxpicflags}"} +if test -n "${CXX}" -a -z "${CXXPICFLAGS}"; then + case "${host_os}" in + aix*|mingw*) + ;; + *) + warn_cxxpicflags="I could not determine CXXPICFLAGS." + ;; + esac +fi + +if test -z "${SHLIB_LD}"; then + shlib_ld_was_given=no + if test "${shlib_ld}" = "${CC}"; then + SHLIB_LD="\$(CC)" + else + SHLIB_LD="${shlib_ld}" + fi + separator="" +test -z "${separator}" && separator=" " +if test -z "${SHLIB_LDFLAGS}"; then + SHLIB_LDFLAGS="${shlib_ldflags}" +else + SHLIB_LDFLAGS="${SHLIB_LDFLAGS}${separator}${shlib_ldflags}" +fi +fi +if test -z "${SHLIB_LDFLAGS}"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: I could not determine SHLIB_LDFLAGS." >&5 +$as_echo "$as_me: WARNING: I could not determine SHLIB_LDFLAGS." >&2;} + as_fn_error $? "See the file doc/html/R-admin.html for more information." "$LINENO" 5 +fi + +if test -z "${SHLIB_CXXLD}"; then + shlib_cxxld_was_given=no + if test "${shlib_cxxld}" = "${CXX}"; then + SHLIB_CXXLD="\$(CXX)" + else + SHLIB_CXXLD="${shlib_cxxld}" + fi + separator="" +test -z "${separator}" && separator=" " +if test -z "${SHLIB_CXXLDFLAGS}"; then + SHLIB_CXXLDFLAGS="${shlib_cxxldflags}" +else + SHLIB_CXXLDFLAGS="${SHLIB_CXXLDFLAGS}${separator}${shlib_cxxldflags}" +fi +fi +if test -n "${CXX}" -a -z "${SHLIB_CXXLDFLAGS}"; then + warn_shlib_cxxldflags="I could not determine SHLIB_CXXLDFLAGS" + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: ${warn_shlib_cxxldflags}" >&5 +$as_echo "$as_me: WARNING: ${warn_shlib_cxxldflags}" >&2;} +fi + +## Step 6. We may need flags different from SHLIB_LDFLAGS and SHLIB_EXT +## for building R as a shared library to link against (the SHLIB_* vars +## just determined are really for loadable modules). On ELF there is no +## difference, but e.g. on Mach-O for Darwin there is. +## +## Also need flags to build the Rlapack shared library on some platforms. +DYLIB_EXT="${SHLIB_EXT}" +dylib_ldflags="${SHLIB_LDFLAGS}" +LIBR_LDFLAGS="" +RLAPACK_LDFLAGS="" +RBLAS_LDFLAGS="" +R_DYLIB_VERSION_SUFFIX="" +case "${host_os}" in + aix*) + ## Not needed for -brtl linking + # RLAPACK_LDFLAGS="${wl}-bE:\$(top_builddir)/etc/Rlapack.exp" + # LAPACK_LDFLAGS="${wl}-bI:\$(R_HOME)/etc/Rlapack.exp" + ;; + darwin*) + DYLIB_EXT=".dylib" + dylib_ldflags="${darwin_dylib_ldflags}" + MAJR_VERSION=`echo "${PACKAGE_VERSION}" | sed -e "s/[\.][1-9]$/.0/"` + LIBR_LDFLAGS="-install_name libR.dylib -compatibility_version ${MAJR_VERSION} -current_version ${PACKAGE_VERSION} -headerpad_max_install_names" + RLAPACK_LDFLAGS="-install_name libRlapack.dylib -compatibility_version ${MAJR_VERSION} -current_version ${PACKAGE_VERSION} -headerpad_max_install_names" + ## don't use version in libRblas so we can replace it with any BLAS implementation + RBLAS_LDFLAGS="-install_name libRblas.dylib -headerpad_max_install_names" + ;; + hpux*) + ## Needs to avoid embedding a relative path ../../../bin. + ## See the above code for shlib_ldflags for reasons why we currently + ## cannot always use '-Wl,+s'. + if test "${GCC}" = yes; then + LAPACK_LDFLAGS="-Wl,+s" + else + LAPACK_LDFLAGS="+s" + fi + ;; + openbsd*) + if test -z "${R_DYLIB_VERSION}"; then + PACKAGE_VERSION_MAJOR=`echo "${PACKAGE_VERSION}" | \ + sed -e "s/\.//" -e "s/\..*$//"` + PACKAGE_VERSION_MINOR=`echo "${PACKAGE_VERSION}" | \ + sed -e "s/.*\.\([^.][^.]*$\)/\1/"` + R_DYLIB_VERSION="${PACKAGE_VERSION_MAJOR}.${PACKAGE_VERSION_MINOR}" + fi + R_DYLIB_VERSION_SUFFIX=".${R_DYLIB_VERSION}" + ;; +esac + +R_DYLIB_EXT="${DYLIB_EXT}${R_DYLIB_VERSION_SUFFIX}" + +if test -z "${DYLIB_LD}"; then + dylib_ld_was_given=no + DYLIB_LD="${SHLIB_LD}" + separator="" +test -z "${separator}" && separator=" " +if test -z "${DYLIB_LDFLAGS}"; then + DYLIB_LDFLAGS="${dylib_ldflags}" +else + DYLIB_LDFLAGS="${DYLIB_LDFLAGS}${separator}${dylib_ldflags}" +fi +else + if test -z "${DYLIB_LDFLAGS}"; then + DYLIB_LDFLAGS="${dylib_ldflags}" + fi +fi + +## some claim Solaris needs -lsocket -lnsl (PR#15815) +: ${INTERNET_LIBS="${internet_libs}"} + + + if test "x${dylib_undefined_allowed}" = xyes; then + DYLIB_UNDEFINED_ALLOWED_TRUE= + DYLIB_UNDEFINED_ALLOWED_FALSE='#' +else + DYLIB_UNDEFINED_ALLOWED_TRUE='#' + DYLIB_UNDEFINED_ALLOWED_FALSE= +fi + + + + + + + + + + + + + + + + + +cat >>confdefs.h <<_ACEOF +#define SHLIB_EXT "${SHLIB_EXT}" +_ACEOF + + if test "x${use_exportfiles}" = xyes; then + USE_EXPORTFILES_TRUE= + USE_EXPORTFILES_FALSE='#' +else + USE_EXPORTFILES_TRUE='#' + USE_EXPORTFILES_FALSE= +fi + + + + + + + + + + + +## Test support for C++ standards +r_save_CXX="${CXX}" +r_save_CXXFLAGS="${CXXFLAGS}" + +: ${CXX98=${CXX}} +: ${CXX98FLAGS=${CXXFLAGS}} +: ${CXX98PICFLAGS=${CXXPICFLAGS}} + +CXX="${CXX98} ${CXX98STD}" +CXXFLAGS="${CXX98FLAGS} ${CXX98PICFLAGS}" +ac_ext=cpp +ac_cpp='$CXXCPP $CPPFLAGS' +ac_compile='$CXX -c $CXXFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CXX -o conftest$ac_exeext $CXXFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_cxx_compiler_gnu + ax_cxx_compile_alternatives="98 03" ax_cxx_compile_cxx98_required=false + ac_ext=cpp +ac_cpp='$CXXCPP $CPPFLAGS' +ac_compile='$CXX -c $CXXFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CXX -o conftest$ac_exeext $CXXFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_cxx_compiler_gnu + ac_success=no + switch="" + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $CXX supports C++98 features by default" >&5 +$as_echo_n "checking whether $CXX supports C++98 features by default... " >&6; } +if ${ax_cv_cxx_compile_cxx98+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +#ifndef __cplusplus +# error "This is not a C++ compiler" +#endif +// or we could test for later than C++03 +#if __cplusplus >= 201103L +# error "This is a compiler for C++11 or later" +#endif + +_ACEOF +if ac_fn_cxx_try_compile "$LINENO"; then : + ax_cv_cxx_compile_cxx98=yes +else + ax_cv_cxx_compile_cxx98=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ax_cv_cxx_compile_cxx98" >&5 +$as_echo "$ax_cv_cxx_compile_cxx98" >&6; } + if test x$ax_cv_cxx_compile_cxx98 = xyes; then + ac_success=yes + fi + + if test x$ac_success = xno; then + for alternative in ${ax_cxx_compile_alternatives}; do + switch="-std=gnu++${alternative}" + cachevar=`$as_echo "ax_cv_cxx_compile_cxx98_$switch" | $as_tr_sh` + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $CXX supports C++98 features with $switch" >&5 +$as_echo_n "checking whether $CXX supports C++98 features with $switch... " >&6; } +if eval \${$cachevar+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_save_CXX="$CXX" + CXX="$CXX $switch" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +#ifndef __cplusplus +# error "This is not a C++ compiler" +#endif +// or we could test for later than C++03 +#if __cplusplus >= 201103L +# error "This is a compiler for C++11 or later" +#endif + +_ACEOF +if ac_fn_cxx_try_compile "$LINENO"; then : + eval $cachevar=yes +else + eval $cachevar=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + CXX="$ac_save_CXX" +fi +eval ac_res=\$$cachevar + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } + if eval test x\$$cachevar = xyes; then + CXX="$CXX $switch" + if test -n "$CXXCPP" ; then + CXXCPP="$CXXCPP $switch" + fi + ac_success=yes + break + fi + done + fi + + if test x$ac_success = xno; then + for alternative in ${ax_cxx_compile_alternatives}; do + for switch in -std=c++${alternative}; do + cachevar=`$as_echo "ax_cv_cxx_compile_cxx98_$switch" | $as_tr_sh` + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $CXX supports C++98 features with $switch" >&5 +$as_echo_n "checking whether $CXX supports C++98 features with $switch... " >&6; } +if eval \${$cachevar+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_save_CXX="$CXX" + CXX="$CXX $switch" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +#ifndef __cplusplus +# error "This is not a C++ compiler" +#endif +// or we could test for later than C++03 +#if __cplusplus >= 201103L +# error "This is a compiler for C++11 or later" +#endif + +_ACEOF +if ac_fn_cxx_try_compile "$LINENO"; then : + eval $cachevar=yes +else + eval $cachevar=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + CXX="$ac_save_CXX" +fi +eval ac_res=\$$cachevar + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } + if eval test x\$$cachevar = xyes; then + CXX="$CXX $switch" + if test -n "$CXXCPP" ; then + CXXCPP="$CXXCPP $switch" + fi + ac_success=yes + break + fi + done + if test x$ac_success = xyes; then + break + fi + done + fi + ac_ext=cpp +ac_cpp='$CXXCPP $CPPFLAGS' +ac_compile='$CXX -c $CXXFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CXX -o conftest$ac_exeext $CXXFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_cxx_compiler_gnu + + if test x$ax_cxx_compile_cxx98_required = xtrue; then + if test x$ac_success = xno; then + as_fn_error $? "*** A compiler with support for C++98 language features is required." "$LINENO" 5 + fi + fi + if test x$ac_success = xno; then + HAVE_CXX98=0 + { $as_echo "$as_me:${as_lineno-$LINENO}: No compiler with C++98 support was found" >&5 +$as_echo "$as_me: No compiler with C++98 support was found" >&6;} + else + HAVE_CXX98=1 + fi + + +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu +CXX="${r_save_CXX}" +CXXFLAGS="${r_save_CXXFLAGS}" +if test "${HAVE_CXX98}" = "1"; then + if test "${CXX98STD}"x = "x"; then + CXX98STD="${switch}" + else + CXX98STD="${CXX98STD} ${switch}" + fi +else + CXX98="" + CXX98STD="" + CXX98FLAGS="" + CXX98PICFLAGS="" +fi + + + + + +if test -z "${SHLIB_CXX98LD}"; then + SHLIB_CXX98LD="\$(CXX98) \$(CXX98STD)" +fi + +: ${SHLIB_CXX98LDFLAGS=${SHLIB_CXXLDFLAGS}} + + + + + + + + + +r_save_CXX="${CXX}" +r_save_CXXFLAGS="${CXXFLAGS}" + +: ${CXX11=${CXX}} +: ${CXX11FLAGS=${CXXFLAGS}} +: ${CXX11PICFLAGS=${CXXPICFLAGS}} + +CXX="${CXX11} ${CXX11STD}" +CXXFLAGS="${CXX11FLAGS} ${CXX11PICFLAGS}" +ac_ext=cpp +ac_cpp='$CXXCPP $CPPFLAGS' +ac_compile='$CXX -c $CXXFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CXX -o conftest$ac_exeext $CXXFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_cxx_compiler_gnu + ax_cxx_compile_alternatives="11 0x" ax_cxx_compile_cxx11_required=false + ac_ext=cpp +ac_cpp='$CXXCPP $CPPFLAGS' +ac_compile='$CXX -c $CXXFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CXX -o conftest$ac_exeext $CXXFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_cxx_compiler_gnu + ac_success=no + switch="" + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $CXX supports C++11 features by default" >&5 +$as_echo_n "checking whether $CXX supports C++11 features by default... " >&6; } +if ${ax_cv_cxx_compile_cxx11+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#ifndef __cplusplus +# error "This is not a C++ compiler" +#elif defined(__GNUC__) && __GNUC__ == 4 && __GNUC_MINOR__ < 8 + + + //This is the earlier, less stringent test used in R 3.3.0 + //Keep this for long-term support platforms with older gcc compilers + + template <typename T> + struct check + { + static_assert(sizeof(int) <= sizeof(T), "not big enough"); + }; + + typedef check<check<bool>> right_angle_brackets; + + int a; + decltype(a) b; + + typedef check<int> check_type; + check_type c; + check_type&& cr = static_cast<check_type&&>(c); + + auto d = a; + + +#elif __cplusplus < 201103L +# error "This is not a C++11 compiler" +#elif __cplusplus >= 201402L +# error "This is a C++14 compiler" +#else + + +namespace cxx11 +{ + + namespace test_static_assert + { + + template <typename T> + struct check + { + static_assert(sizeof(int) <= sizeof(T), "not big enough"); + }; + + } + + namespace test_final_override + { + + struct Base + { + virtual void f() {} + }; + + struct Derived : public Base + { + virtual void f() override {} + }; + + } + + namespace test_double_right_angle_brackets + { + + template < typename T > + struct check {}; + + typedef check<void> single_type; + typedef check<check<void>> double_type; + typedef check<check<check<void>>> triple_type; + typedef check<check<check<check<void>>>> quadruple_type; + + } + + namespace test_decltype + { + + int + f() + { + int a = 1; + decltype(a) b = 2; + return a + b; + } + + } + + namespace test_type_deduction + { + + template < typename T1, typename T2 > + struct is_same + { + static const bool value = false; + }; + + template < typename T > + struct is_same<T, T> + { + static const bool value = true; + }; + + template < typename T1, typename T2 > + auto + add(T1 a1, T2 a2) -> decltype(a1 + a2) + { + return a1 + a2; + } + + int + test(const int c, volatile int v) + { + static_assert(is_same<int, decltype(0)>::value == true, ""); + static_assert(is_same<int, decltype(c)>::value == false, ""); + static_assert(is_same<int, decltype(v)>::value == false, ""); + auto ac = c; + auto av = v; + auto sumi = ac + av + 'x'; + auto sumf = ac + av + 1.0; + static_assert(is_same<int, decltype(ac)>::value == true, ""); + static_assert(is_same<int, decltype(av)>::value == true, ""); + static_assert(is_same<int, decltype(sumi)>::value == true, ""); + static_assert(is_same<int, decltype(sumf)>::value == false, ""); + static_assert(is_same<int, decltype(add(c, v))>::value == true, ""); + return (sumf > 0.0) ? sumi : add(c, v); + } + + } + + namespace test_noexcept + { + + int f() { return 0; } + int g() noexcept { return 0; } + + static_assert(noexcept(f()) == false, ""); + static_assert(noexcept(g()) == true, ""); + + } + + namespace test_constexpr + { + + template < typename CharT > + unsigned long constexpr + strlen_c_r(const CharT *const s, const unsigned long acc) noexcept + { + return *s ? strlen_c_r(s + 1, acc + 1) : acc; + } + + template < typename CharT > + unsigned long constexpr + strlen_c(const CharT *const s) noexcept + { + return strlen_c_r(s, 0UL); + } + + static_assert(strlen_c("") == 0UL, ""); + static_assert(strlen_c("1") == 1UL, ""); + static_assert(strlen_c("example") == 7UL, ""); + static_assert(strlen_c("another\0example") == 7UL, ""); + + } + + namespace test_rvalue_references + { + + template < int N > + struct answer + { + static constexpr int value = N; + }; + + answer<1> f(int&) { return answer<1>(); } + answer<2> f(const int&) { return answer<2>(); } + answer<3> f(int&&) { return answer<3>(); } + + void + test() + { + int i = 0; + const int c = 0; + static_assert(decltype(f(i))::value == 1, ""); + static_assert(decltype(f(c))::value == 2, ""); + static_assert(decltype(f(0))::value == 3, ""); + } + + } + + namespace test_uniform_initialization + { + + struct test + { + static const int zero {}; + static const int one {1}; + }; + + static_assert(test::zero == 0, ""); + static_assert(test::one == 1, ""); + + } + + namespace test_lambdas + { + + void + test1() + { + auto lambda1 = [](){}; + auto lambda2 = lambda1; + lambda1(); + lambda2(); + } + + int + test2() + { + auto a = [](int i, int j){ return i + j; }(1, 2); + auto b = []() -> int { return '0'; }(); + auto c = [=](){ return a + b; }(); + auto d = [&](){ return c; }(); + auto e = [a, &b](int x) mutable { + const auto identity = [](int y){ return y; }; + for (auto i = 0; i < a; ++i) + a += b--; + return x + identity(a + b); + }(0); + return a + b + c + d + e; + } + + int + test3() + { + const auto nullary = [](){ return 0; }; + const auto unary = [](int x){ return x; }; + using nullary_t = decltype(nullary); + using unary_t = decltype(unary); + const auto higher1st = [](nullary_t f){ return f(); }; + const auto higher2nd = [unary](nullary_t f1){ + return [unary, f1](unary_t f2){ return f2(unary(f1())); }; + }; + return higher1st(nullary) + higher2nd(nullary)(unary); + } + + } + + namespace test_variadic_templates + { + + template <int...> + struct sum; + + template <int N0, int... N1toN> + struct sum<N0, N1toN...> + { + /* + Original test code used the auto keyword instead of declaring + the type of "value" to be int. This causes Oracle Solaris Studio + 12.4 to fail. This is possibly a compiler bug but in any case + current test code works around it by an explicit declaration. + */ + static constexpr int value = N0 + sum<N1toN...>::value; + }; + + template <> + struct sum<> + { + static constexpr auto value = 0; + }; + + static_assert(sum<>::value == 0, ""); + static_assert(sum<1>::value == 1, ""); + static_assert(sum<23>::value == 23, ""); + static_assert(sum<1, 2>::value == 3, ""); + static_assert(sum<5, 5, 11>::value == 21, ""); + static_assert(sum<2, 3, 5, 7, 11, 13>::value == 41, ""); + + } + + // http://stackoverflow.com/questions/13728184/template-aliases-and-sfinae + // Clang 3.1 fails with headers of libstd++ 4.8.3 when using std::function + // because of this. + namespace test_template_alias_sfinae + { + + struct foo {}; + + template<typename T> + using member = typename T::member_type; + + template<typename T> + void func(...) {} + + template<typename T> + void func(member<T>*) {} + + void test(); + + void test() { func<foo>(0); } + + } + +} // namespace cxx11 + + +#endif + +_ACEOF +if ac_fn_cxx_try_compile "$LINENO"; then : + ax_cv_cxx_compile_cxx11=yes +else + ax_cv_cxx_compile_cxx11=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ax_cv_cxx_compile_cxx11" >&5 +$as_echo "$ax_cv_cxx_compile_cxx11" >&6; } + if test x$ax_cv_cxx_compile_cxx11 = xyes; then + ac_success=yes + fi + + if test x$ac_success = xno; then + for alternative in ${ax_cxx_compile_alternatives}; do + switch="-std=gnu++${alternative}" + cachevar=`$as_echo "ax_cv_cxx_compile_cxx11_$switch" | $as_tr_sh` + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $CXX supports C++11 features with $switch" >&5 +$as_echo_n "checking whether $CXX supports C++11 features with $switch... " >&6; } +if eval \${$cachevar+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_save_CXX="$CXX" + CXX="$CXX $switch" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#ifndef __cplusplus +# error "This is not a C++ compiler" +#elif defined(__GNUC__) && __GNUC__ == 4 && __GNUC_MINOR__ < 8 + + + //This is the earlier, less stringent test used in R 3.3.0 + //Keep this for long-term support platforms with older gcc compilers + + template <typename T> + struct check + { + static_assert(sizeof(int) <= sizeof(T), "not big enough"); + }; + + typedef check<check<bool>> right_angle_brackets; + + int a; + decltype(a) b; + + typedef check<int> check_type; + check_type c; + check_type&& cr = static_cast<check_type&&>(c); + + auto d = a; + + +#elif __cplusplus < 201103L +# error "This is not a C++11 compiler" +#elif __cplusplus >= 201402L +# error "This is a C++14 compiler" +#else + + +namespace cxx11 +{ + + namespace test_static_assert + { + + template <typename T> + struct check + { + static_assert(sizeof(int) <= sizeof(T), "not big enough"); + }; + + } + + namespace test_final_override + { + + struct Base + { + virtual void f() {} + }; + + struct Derived : public Base + { + virtual void f() override {} + }; + + } + + namespace test_double_right_angle_brackets + { + + template < typename T > + struct check {}; + + typedef check<void> single_type; + typedef check<check<void>> double_type; + typedef check<check<check<void>>> triple_type; + typedef check<check<check<check<void>>>> quadruple_type; + + } + + namespace test_decltype + { + + int + f() + { + int a = 1; + decltype(a) b = 2; + return a + b; + } + + } + + namespace test_type_deduction + { + + template < typename T1, typename T2 > + struct is_same + { + static const bool value = false; + }; + + template < typename T > + struct is_same<T, T> + { + static const bool value = true; + }; + + template < typename T1, typename T2 > + auto + add(T1 a1, T2 a2) -> decltype(a1 + a2) + { + return a1 + a2; + } + + int + test(const int c, volatile int v) + { + static_assert(is_same<int, decltype(0)>::value == true, ""); + static_assert(is_same<int, decltype(c)>::value == false, ""); + static_assert(is_same<int, decltype(v)>::value == false, ""); + auto ac = c; + auto av = v; + auto sumi = ac + av + 'x'; + auto sumf = ac + av + 1.0; + static_assert(is_same<int, decltype(ac)>::value == true, ""); + static_assert(is_same<int, decltype(av)>::value == true, ""); + static_assert(is_same<int, decltype(sumi)>::value == true, ""); + static_assert(is_same<int, decltype(sumf)>::value == false, ""); + static_assert(is_same<int, decltype(add(c, v))>::value == true, ""); + return (sumf > 0.0) ? sumi : add(c, v); + } + + } + + namespace test_noexcept + { + + int f() { return 0; } + int g() noexcept { return 0; } + + static_assert(noexcept(f()) == false, ""); + static_assert(noexcept(g()) == true, ""); + + } + + namespace test_constexpr + { + + template < typename CharT > + unsigned long constexpr + strlen_c_r(const CharT *const s, const unsigned long acc) noexcept + { + return *s ? strlen_c_r(s + 1, acc + 1) : acc; + } + + template < typename CharT > + unsigned long constexpr + strlen_c(const CharT *const s) noexcept + { + return strlen_c_r(s, 0UL); + } + + static_assert(strlen_c("") == 0UL, ""); + static_assert(strlen_c("1") == 1UL, ""); + static_assert(strlen_c("example") == 7UL, ""); + static_assert(strlen_c("another\0example") == 7UL, ""); + + } + + namespace test_rvalue_references + { + + template < int N > + struct answer + { + static constexpr int value = N; + }; + + answer<1> f(int&) { return answer<1>(); } + answer<2> f(const int&) { return answer<2>(); } + answer<3> f(int&&) { return answer<3>(); } + + void + test() + { + int i = 0; + const int c = 0; + static_assert(decltype(f(i))::value == 1, ""); + static_assert(decltype(f(c))::value == 2, ""); + static_assert(decltype(f(0))::value == 3, ""); + } + + } + + namespace test_uniform_initialization + { + + struct test + { + static const int zero {}; + static const int one {1}; + }; + + static_assert(test::zero == 0, ""); + static_assert(test::one == 1, ""); + + } + + namespace test_lambdas + { + + void + test1() + { + auto lambda1 = [](){}; + auto lambda2 = lambda1; + lambda1(); + lambda2(); + } + + int + test2() + { + auto a = [](int i, int j){ return i + j; }(1, 2); + auto b = []() -> int { return '0'; }(); + auto c = [=](){ return a + b; }(); + auto d = [&](){ return c; }(); + auto e = [a, &b](int x) mutable { + const auto identity = [](int y){ return y; }; + for (auto i = 0; i < a; ++i) + a += b--; + return x + identity(a + b); + }(0); + return a + b + c + d + e; + } + + int + test3() + { + const auto nullary = [](){ return 0; }; + const auto unary = [](int x){ return x; }; + using nullary_t = decltype(nullary); + using unary_t = decltype(unary); + const auto higher1st = [](nullary_t f){ return f(); }; + const auto higher2nd = [unary](nullary_t f1){ + return [unary, f1](unary_t f2){ return f2(unary(f1())); }; + }; + return higher1st(nullary) + higher2nd(nullary)(unary); + } + + } + + namespace test_variadic_templates + { + + template <int...> + struct sum; + + template <int N0, int... N1toN> + struct sum<N0, N1toN...> + { + /* + Original test code used the auto keyword instead of declaring + the type of "value" to be int. This causes Oracle Solaris Studio + 12.4 to fail. This is possibly a compiler bug but in any case + current test code works around it by an explicit declaration. + */ + static constexpr int value = N0 + sum<N1toN...>::value; + }; + + template <> + struct sum<> + { + static constexpr auto value = 0; + }; + + static_assert(sum<>::value == 0, ""); + static_assert(sum<1>::value == 1, ""); + static_assert(sum<23>::value == 23, ""); + static_assert(sum<1, 2>::value == 3, ""); + static_assert(sum<5, 5, 11>::value == 21, ""); + static_assert(sum<2, 3, 5, 7, 11, 13>::value == 41, ""); + + } + + // http://stackoverflow.com/questions/13728184/template-aliases-and-sfinae + // Clang 3.1 fails with headers of libstd++ 4.8.3 when using std::function + // because of this. + namespace test_template_alias_sfinae + { + + struct foo {}; + + template<typename T> + using member = typename T::member_type; + + template<typename T> + void func(...) {} + + template<typename T> + void func(member<T>*) {} + + void test(); + + void test() { func<foo>(0); } + + } + +} // namespace cxx11 + + +#endif + +_ACEOF +if ac_fn_cxx_try_compile "$LINENO"; then : + eval $cachevar=yes +else + eval $cachevar=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + CXX="$ac_save_CXX" +fi +eval ac_res=\$$cachevar + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } + if eval test x\$$cachevar = xyes; then + CXX="$CXX $switch" + if test -n "$CXXCPP" ; then + CXXCPP="$CXXCPP $switch" + fi + ac_success=yes + break + fi + done + fi + + if test x$ac_success = xno; then + for alternative in ${ax_cxx_compile_alternatives}; do + for switch in -std=c++${alternative}; do + cachevar=`$as_echo "ax_cv_cxx_compile_cxx11_$switch" | $as_tr_sh` + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $CXX supports C++11 features with $switch" >&5 +$as_echo_n "checking whether $CXX supports C++11 features with $switch... " >&6; } +if eval \${$cachevar+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_save_CXX="$CXX" + CXX="$CXX $switch" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#ifndef __cplusplus +# error "This is not a C++ compiler" +#elif defined(__GNUC__) && __GNUC__ == 4 && __GNUC_MINOR__ < 8 + + + //This is the earlier, less stringent test used in R 3.3.0 + //Keep this for long-term support platforms with older gcc compilers + + template <typename T> + struct check + { + static_assert(sizeof(int) <= sizeof(T), "not big enough"); + }; + + typedef check<check<bool>> right_angle_brackets; + + int a; + decltype(a) b; + + typedef check<int> check_type; + check_type c; + check_type&& cr = static_cast<check_type&&>(c); + + auto d = a; + + +#elif __cplusplus < 201103L +# error "This is not a C++11 compiler" +#elif __cplusplus >= 201402L +# error "This is a C++14 compiler" +#else + + +namespace cxx11 +{ + + namespace test_static_assert + { + + template <typename T> + struct check + { + static_assert(sizeof(int) <= sizeof(T), "not big enough"); + }; + + } + + namespace test_final_override + { + + struct Base + { + virtual void f() {} + }; + + struct Derived : public Base + { + virtual void f() override {} + }; + + } + + namespace test_double_right_angle_brackets + { + + template < typename T > + struct check {}; + + typedef check<void> single_type; + typedef check<check<void>> double_type; + typedef check<check<check<void>>> triple_type; + typedef check<check<check<check<void>>>> quadruple_type; + + } + + namespace test_decltype + { + + int + f() + { + int a = 1; + decltype(a) b = 2; + return a + b; + } + + } + + namespace test_type_deduction + { + + template < typename T1, typename T2 > + struct is_same + { + static const bool value = false; + }; + + template < typename T > + struct is_same<T, T> + { + static const bool value = true; + }; + + template < typename T1, typename T2 > + auto + add(T1 a1, T2 a2) -> decltype(a1 + a2) + { + return a1 + a2; + } + + int + test(const int c, volatile int v) + { + static_assert(is_same<int, decltype(0)>::value == true, ""); + static_assert(is_same<int, decltype(c)>::value == false, ""); + static_assert(is_same<int, decltype(v)>::value == false, ""); + auto ac = c; + auto av = v; + auto sumi = ac + av + 'x'; + auto sumf = ac + av + 1.0; + static_assert(is_same<int, decltype(ac)>::value == true, ""); + static_assert(is_same<int, decltype(av)>::value == true, ""); + static_assert(is_same<int, decltype(sumi)>::value == true, ""); + static_assert(is_same<int, decltype(sumf)>::value == false, ""); + static_assert(is_same<int, decltype(add(c, v))>::value == true, ""); + return (sumf > 0.0) ? sumi : add(c, v); + } + + } + + namespace test_noexcept + { + + int f() { return 0; } + int g() noexcept { return 0; } + + static_assert(noexcept(f()) == false, ""); + static_assert(noexcept(g()) == true, ""); + + } + + namespace test_constexpr + { + + template < typename CharT > + unsigned long constexpr + strlen_c_r(const CharT *const s, const unsigned long acc) noexcept + { + return *s ? strlen_c_r(s + 1, acc + 1) : acc; + } + + template < typename CharT > + unsigned long constexpr + strlen_c(const CharT *const s) noexcept + { + return strlen_c_r(s, 0UL); + } + + static_assert(strlen_c("") == 0UL, ""); + static_assert(strlen_c("1") == 1UL, ""); + static_assert(strlen_c("example") == 7UL, ""); + static_assert(strlen_c("another\0example") == 7UL, ""); + + } + + namespace test_rvalue_references + { + + template < int N > + struct answer + { + static constexpr int value = N; + }; + + answer<1> f(int&) { return answer<1>(); } + answer<2> f(const int&) { return answer<2>(); } + answer<3> f(int&&) { return answer<3>(); } + + void + test() + { + int i = 0; + const int c = 0; + static_assert(decltype(f(i))::value == 1, ""); + static_assert(decltype(f(c))::value == 2, ""); + static_assert(decltype(f(0))::value == 3, ""); + } + + } + + namespace test_uniform_initialization + { + + struct test + { + static const int zero {}; + static const int one {1}; + }; + + static_assert(test::zero == 0, ""); + static_assert(test::one == 1, ""); + + } + + namespace test_lambdas + { + + void + test1() + { + auto lambda1 = [](){}; + auto lambda2 = lambda1; + lambda1(); + lambda2(); + } + + int + test2() + { + auto a = [](int i, int j){ return i + j; }(1, 2); + auto b = []() -> int { return '0'; }(); + auto c = [=](){ return a + b; }(); + auto d = [&](){ return c; }(); + auto e = [a, &b](int x) mutable { + const auto identity = [](int y){ return y; }; + for (auto i = 0; i < a; ++i) + a += b--; + return x + identity(a + b); + }(0); + return a + b + c + d + e; + } + + int + test3() + { + const auto nullary = [](){ return 0; }; + const auto unary = [](int x){ return x; }; + using nullary_t = decltype(nullary); + using unary_t = decltype(unary); + const auto higher1st = [](nullary_t f){ return f(); }; + const auto higher2nd = [unary](nullary_t f1){ + return [unary, f1](unary_t f2){ return f2(unary(f1())); }; + }; + return higher1st(nullary) + higher2nd(nullary)(unary); + } + + } + + namespace test_variadic_templates + { + + template <int...> + struct sum; + + template <int N0, int... N1toN> + struct sum<N0, N1toN...> + { + /* + Original test code used the auto keyword instead of declaring + the type of "value" to be int. This causes Oracle Solaris Studio + 12.4 to fail. This is possibly a compiler bug but in any case + current test code works around it by an explicit declaration. + */ + static constexpr int value = N0 + sum<N1toN...>::value; + }; + + template <> + struct sum<> + { + static constexpr auto value = 0; + }; + + static_assert(sum<>::value == 0, ""); + static_assert(sum<1>::value == 1, ""); + static_assert(sum<23>::value == 23, ""); + static_assert(sum<1, 2>::value == 3, ""); + static_assert(sum<5, 5, 11>::value == 21, ""); + static_assert(sum<2, 3, 5, 7, 11, 13>::value == 41, ""); + + } + + // http://stackoverflow.com/questions/13728184/template-aliases-and-sfinae + // Clang 3.1 fails with headers of libstd++ 4.8.3 when using std::function + // because of this. + namespace test_template_alias_sfinae + { + + struct foo {}; + + template<typename T> + using member = typename T::member_type; + + template<typename T> + void func(...) {} + + template<typename T> + void func(member<T>*) {} + + void test(); + + void test() { func<foo>(0); } + + } + +} // namespace cxx11 + + +#endif + +_ACEOF +if ac_fn_cxx_try_compile "$LINENO"; then : + eval $cachevar=yes +else + eval $cachevar=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + CXX="$ac_save_CXX" +fi +eval ac_res=\$$cachevar + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } + if eval test x\$$cachevar = xyes; then + CXX="$CXX $switch" + if test -n "$CXXCPP" ; then + CXXCPP="$CXXCPP $switch" + fi + ac_success=yes + break + fi + done + if test x$ac_success = xyes; then + break + fi + done + fi + ac_ext=cpp +ac_cpp='$CXXCPP $CPPFLAGS' +ac_compile='$CXX -c $CXXFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CXX -o conftest$ac_exeext $CXXFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_cxx_compiler_gnu + + if test x$ax_cxx_compile_cxx11_required = xtrue; then + if test x$ac_success = xno; then + as_fn_error $? "*** A compiler with support for C++11 language features is required." "$LINENO" 5 + fi + fi + if test x$ac_success = xno; then + HAVE_CXX11=0 + { $as_echo "$as_me:${as_lineno-$LINENO}: No compiler with C++11 support was found" >&5 +$as_echo "$as_me: No compiler with C++11 support was found" >&6;} + else + HAVE_CXX11=1 + fi + + +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu +CXX="${r_save_CXX}" +CXXFLAGS="${r_save_CXXFLAGS}" +if test "${HAVE_CXX11}" = "1"; then + if test "${CXX11STD}"x = "x"; then + CXX11STD="${switch}" + else + CXX11STD="${CXX11STD} ${switch}" + fi +else + CXX11="" + CXX11STD="" + CXX11FLAGS="" + CXX11PICFLAGS="" +fi + + + + + +if test -z "${SHLIB_CXX11LD}"; then + SHLIB_CXX11LD="\$(CXX11) \$(CXX11STD)" +fi + +: ${SHLIB_CXX11LDFLAGS=${SHLIB_CXXLDFLAGS}} + + + + + + + + + +r_save_CXX="${CXX}" +r_save_CXXFLAGS="${CXXFLAGS}" + +: ${CXX14=${CXX11}} +: ${CXX14FLAGS=${CXX11FLAGS}} +: ${CXX14PICFLAGS=${CXX11PICFLAGS}} + +CXX="${CXX14} ${CXX14STD}" +CXXFLAGS="${CXX14FLAGS} ${CXX14PICFLAGS}" +ac_ext=cpp +ac_cpp='$CXXCPP $CPPFLAGS' +ac_compile='$CXX -c $CXXFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CXX -o conftest$ac_exeext $CXXFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_cxx_compiler_gnu + ax_cxx_compile_alternatives="14 1y" ax_cxx_compile_cxx14_required=false + ac_ext=cpp +ac_cpp='$CXXCPP $CPPFLAGS' +ac_compile='$CXX -c $CXXFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CXX -o conftest$ac_exeext $CXXFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_cxx_compiler_gnu + ac_success=no + switch="" + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $CXX supports C++14 features by default" >&5 +$as_echo_n "checking whether $CXX supports C++14 features by default... " >&6; } +if ${ax_cv_cxx_compile_cxx14+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#ifndef __cplusplus +# error "This is not a C++ compiler" +#elif __cplusplus < 201402L +# error "This is not a C++14 compiler" +#else + + +namespace cxx11 +{ + + namespace test_static_assert + { + + template <typename T> + struct check + { + static_assert(sizeof(int) <= sizeof(T), "not big enough"); + }; + + } + + namespace test_final_override + { + + struct Base + { + virtual void f() {} + }; + + struct Derived : public Base + { + virtual void f() override {} + }; + + } + + namespace test_double_right_angle_brackets + { + + template < typename T > + struct check {}; + + typedef check<void> single_type; + typedef check<check<void>> double_type; + typedef check<check<check<void>>> triple_type; + typedef check<check<check<check<void>>>> quadruple_type; + + } + + namespace test_decltype + { + + int + f() + { + int a = 1; + decltype(a) b = 2; + return a + b; + } + + } + + namespace test_type_deduction + { + + template < typename T1, typename T2 > + struct is_same + { + static const bool value = false; + }; + + template < typename T > + struct is_same<T, T> + { + static const bool value = true; + }; + + template < typename T1, typename T2 > + auto + add(T1 a1, T2 a2) -> decltype(a1 + a2) + { + return a1 + a2; + } + + int + test(const int c, volatile int v) + { + static_assert(is_same<int, decltype(0)>::value == true, ""); + static_assert(is_same<int, decltype(c)>::value == false, ""); + static_assert(is_same<int, decltype(v)>::value == false, ""); + auto ac = c; + auto av = v; + auto sumi = ac + av + 'x'; + auto sumf = ac + av + 1.0; + static_assert(is_same<int, decltype(ac)>::value == true, ""); + static_assert(is_same<int, decltype(av)>::value == true, ""); + static_assert(is_same<int, decltype(sumi)>::value == true, ""); + static_assert(is_same<int, decltype(sumf)>::value == false, ""); + static_assert(is_same<int, decltype(add(c, v))>::value == true, ""); + return (sumf > 0.0) ? sumi : add(c, v); + } + + } + + namespace test_noexcept + { + + int f() { return 0; } + int g() noexcept { return 0; } + + static_assert(noexcept(f()) == false, ""); + static_assert(noexcept(g()) == true, ""); + + } + + namespace test_constexpr + { + + template < typename CharT > + unsigned long constexpr + strlen_c_r(const CharT *const s, const unsigned long acc) noexcept + { + return *s ? strlen_c_r(s + 1, acc + 1) : acc; + } + + template < typename CharT > + unsigned long constexpr + strlen_c(const CharT *const s) noexcept + { + return strlen_c_r(s, 0UL); + } + + static_assert(strlen_c("") == 0UL, ""); + static_assert(strlen_c("1") == 1UL, ""); + static_assert(strlen_c("example") == 7UL, ""); + static_assert(strlen_c("another\0example") == 7UL, ""); + + } + + namespace test_rvalue_references + { + + template < int N > + struct answer + { + static constexpr int value = N; + }; + + answer<1> f(int&) { return answer<1>(); } + answer<2> f(const int&) { return answer<2>(); } + answer<3> f(int&&) { return answer<3>(); } + + void + test() + { + int i = 0; + const int c = 0; + static_assert(decltype(f(i))::value == 1, ""); + static_assert(decltype(f(c))::value == 2, ""); + static_assert(decltype(f(0))::value == 3, ""); + } + + } + + namespace test_uniform_initialization + { + + struct test + { + static const int zero {}; + static const int one {1}; + }; + + static_assert(test::zero == 0, ""); + static_assert(test::one == 1, ""); + + } + + namespace test_lambdas + { + + void + test1() + { + auto lambda1 = [](){}; + auto lambda2 = lambda1; + lambda1(); + lambda2(); + } + + int + test2() + { + auto a = [](int i, int j){ return i + j; }(1, 2); + auto b = []() -> int { return '0'; }(); + auto c = [=](){ return a + b; }(); + auto d = [&](){ return c; }(); + auto e = [a, &b](int x) mutable { + const auto identity = [](int y){ return y; }; + for (auto i = 0; i < a; ++i) + a += b--; + return x + identity(a + b); + }(0); + return a + b + c + d + e; + } + + int + test3() + { + const auto nullary = [](){ return 0; }; + const auto unary = [](int x){ return x; }; + using nullary_t = decltype(nullary); + using unary_t = decltype(unary); + const auto higher1st = [](nullary_t f){ return f(); }; + const auto higher2nd = [unary](nullary_t f1){ + return [unary, f1](unary_t f2){ return f2(unary(f1())); }; + }; + return higher1st(nullary) + higher2nd(nullary)(unary); + } + + } + + namespace test_variadic_templates + { + + template <int...> + struct sum; + + template <int N0, int... N1toN> + struct sum<N0, N1toN...> + { + /* + Original test code used the auto keyword instead of declaring + the type of "value" to be int. This causes Oracle Solaris Studio + 12.4 to fail. This is possibly a compiler bug but in any case + current test code works around it by an explicit declaration. + */ + static constexpr int value = N0 + sum<N1toN...>::value; + }; + + template <> + struct sum<> + { + static constexpr auto value = 0; + }; + + static_assert(sum<>::value == 0, ""); + static_assert(sum<1>::value == 1, ""); + static_assert(sum<23>::value == 23, ""); + static_assert(sum<1, 2>::value == 3, ""); + static_assert(sum<5, 5, 11>::value == 21, ""); + static_assert(sum<2, 3, 5, 7, 11, 13>::value == 41, ""); + + } + + // http://stackoverflow.com/questions/13728184/template-aliases-and-sfinae + // Clang 3.1 fails with headers of libstd++ 4.8.3 when using std::function + // because of this. + namespace test_template_alias_sfinae + { + + struct foo {}; + + template<typename T> + using member = typename T::member_type; + + template<typename T> + void func(...) {} + + template<typename T> + void func(member<T>*) {} + + void test(); + + void test() { func<foo>(0); } + + } + +} // namespace cxx11 + + + + +namespace cxx14 +{ + + namespace test_polymorphic_lambdas + { + + int + test() + { + const auto lambda = [](auto&&... args){ + const auto istiny = [](auto x){ + return (sizeof(x) == 1UL) ? 1 : 0; + }; + const int aretiny[] = { istiny(args)... }; + return aretiny[0]; + }; + return lambda(1, 1L, 1.0f, '1'); + } + + } + + namespace test_binary_literals + { + + constexpr auto ivii = 0b0000000000101010; + static_assert(ivii == 42, "wrong value"); + + } + + namespace test_generalized_constexpr + { + + template < typename CharT > + constexpr unsigned long + strlen_c(const CharT *const s) noexcept + { + auto length = 0UL; + for (auto p = s; *p; ++p) + ++length; + return length; + } + + static_assert(strlen_c("") == 0UL, ""); + static_assert(strlen_c("x") == 1UL, ""); + static_assert(strlen_c("test") == 4UL, ""); + static_assert(strlen_c("another\0test") == 7UL, ""); + + } + + namespace test_lambda_init_capture + { + + int + test() + { + auto x = 0; + const auto lambda1 = [a = x](int b){ return a + b; }; + const auto lambda2 = [a = lambda1(x)](){ return a; }; + return lambda2(); + } + + } + + namespace test_digit_separators + { + + constexpr auto ten_million = 100'000'000; + static_assert(ten_million == 100000000, ""); + + } + + namespace test_return_type_deduction + { + + auto f(int& x) { return x; } + decltype(auto) g(int& x) { return x; } + + template < typename T1, typename T2 > + struct is_same + { + static constexpr auto value = false; + }; + + template < typename T > + struct is_same<T, T> + { + static constexpr auto value = true; + }; + + int + test() + { + auto x = 0; + static_assert(is_same<int, decltype(f(x))>::value, ""); + static_assert(is_same<int&, decltype(g(x))>::value, ""); + return x; + } + + } + +} // namespace cxx14 + + +#endif + +_ACEOF +if ac_fn_cxx_try_compile "$LINENO"; then : + ax_cv_cxx_compile_cxx14=yes +else + ax_cv_cxx_compile_cxx14=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ax_cv_cxx_compile_cxx14" >&5 +$as_echo "$ax_cv_cxx_compile_cxx14" >&6; } + if test x$ax_cv_cxx_compile_cxx14 = xyes; then + ac_success=yes + fi + + if test x$ac_success = xno; then + for alternative in ${ax_cxx_compile_alternatives}; do + switch="-std=gnu++${alternative}" + cachevar=`$as_echo "ax_cv_cxx_compile_cxx14_$switch" | $as_tr_sh` + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $CXX supports C++14 features with $switch" >&5 +$as_echo_n "checking whether $CXX supports C++14 features with $switch... " >&6; } +if eval \${$cachevar+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_save_CXX="$CXX" + CXX="$CXX $switch" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#ifndef __cplusplus +# error "This is not a C++ compiler" +#elif __cplusplus < 201402L +# error "This is not a C++14 compiler" +#else + + +namespace cxx11 +{ + + namespace test_static_assert + { + + template <typename T> + struct check + { + static_assert(sizeof(int) <= sizeof(T), "not big enough"); + }; + + } + + namespace test_final_override + { + + struct Base + { + virtual void f() {} + }; + + struct Derived : public Base + { + virtual void f() override {} + }; + + } + + namespace test_double_right_angle_brackets + { + + template < typename T > + struct check {}; + + typedef check<void> single_type; + typedef check<check<void>> double_type; + typedef check<check<check<void>>> triple_type; + typedef check<check<check<check<void>>>> quadruple_type; + + } + + namespace test_decltype + { + + int + f() + { + int a = 1; + decltype(a) b = 2; + return a + b; + } + + } + + namespace test_type_deduction + { + + template < typename T1, typename T2 > + struct is_same + { + static const bool value = false; + }; + + template < typename T > + struct is_same<T, T> + { + static const bool value = true; + }; + + template < typename T1, typename T2 > + auto + add(T1 a1, T2 a2) -> decltype(a1 + a2) + { + return a1 + a2; + } + + int + test(const int c, volatile int v) + { + static_assert(is_same<int, decltype(0)>::value == true, ""); + static_assert(is_same<int, decltype(c)>::value == false, ""); + static_assert(is_same<int, decltype(v)>::value == false, ""); + auto ac = c; + auto av = v; + auto sumi = ac + av + 'x'; + auto sumf = ac + av + 1.0; + static_assert(is_same<int, decltype(ac)>::value == true, ""); + static_assert(is_same<int, decltype(av)>::value == true, ""); + static_assert(is_same<int, decltype(sumi)>::value == true, ""); + static_assert(is_same<int, decltype(sumf)>::value == false, ""); + static_assert(is_same<int, decltype(add(c, v))>::value == true, ""); + return (sumf > 0.0) ? sumi : add(c, v); + } + + } + + namespace test_noexcept + { + + int f() { return 0; } + int g() noexcept { return 0; } + + static_assert(noexcept(f()) == false, ""); + static_assert(noexcept(g()) == true, ""); + + } + + namespace test_constexpr + { + + template < typename CharT > + unsigned long constexpr + strlen_c_r(const CharT *const s, const unsigned long acc) noexcept + { + return *s ? strlen_c_r(s + 1, acc + 1) : acc; + } + + template < typename CharT > + unsigned long constexpr + strlen_c(const CharT *const s) noexcept + { + return strlen_c_r(s, 0UL); + } + + static_assert(strlen_c("") == 0UL, ""); + static_assert(strlen_c("1") == 1UL, ""); + static_assert(strlen_c("example") == 7UL, ""); + static_assert(strlen_c("another\0example") == 7UL, ""); + + } + + namespace test_rvalue_references + { + + template < int N > + struct answer + { + static constexpr int value = N; + }; + + answer<1> f(int&) { return answer<1>(); } + answer<2> f(const int&) { return answer<2>(); } + answer<3> f(int&&) { return answer<3>(); } + + void + test() + { + int i = 0; + const int c = 0; + static_assert(decltype(f(i))::value == 1, ""); + static_assert(decltype(f(c))::value == 2, ""); + static_assert(decltype(f(0))::value == 3, ""); + } + + } + + namespace test_uniform_initialization + { + + struct test + { + static const int zero {}; + static const int one {1}; + }; + + static_assert(test::zero == 0, ""); + static_assert(test::one == 1, ""); + + } + + namespace test_lambdas + { + + void + test1() + { + auto lambda1 = [](){}; + auto lambda2 = lambda1; + lambda1(); + lambda2(); + } + + int + test2() + { + auto a = [](int i, int j){ return i + j; }(1, 2); + auto b = []() -> int { return '0'; }(); + auto c = [=](){ return a + b; }(); + auto d = [&](){ return c; }(); + auto e = [a, &b](int x) mutable { + const auto identity = [](int y){ return y; }; + for (auto i = 0; i < a; ++i) + a += b--; + return x + identity(a + b); + }(0); + return a + b + c + d + e; + } + + int + test3() + { + const auto nullary = [](){ return 0; }; + const auto unary = [](int x){ return x; }; + using nullary_t = decltype(nullary); + using unary_t = decltype(unary); + const auto higher1st = [](nullary_t f){ return f(); }; + const auto higher2nd = [unary](nullary_t f1){ + return [unary, f1](unary_t f2){ return f2(unary(f1())); }; + }; + return higher1st(nullary) + higher2nd(nullary)(unary); + } + + } + + namespace test_variadic_templates + { + + template <int...> + struct sum; + + template <int N0, int... N1toN> + struct sum<N0, N1toN...> + { + /* + Original test code used the auto keyword instead of declaring + the type of "value" to be int. This causes Oracle Solaris Studio + 12.4 to fail. This is possibly a compiler bug but in any case + current test code works around it by an explicit declaration. + */ + static constexpr int value = N0 + sum<N1toN...>::value; + }; + + template <> + struct sum<> + { + static constexpr auto value = 0; + }; + + static_assert(sum<>::value == 0, ""); + static_assert(sum<1>::value == 1, ""); + static_assert(sum<23>::value == 23, ""); + static_assert(sum<1, 2>::value == 3, ""); + static_assert(sum<5, 5, 11>::value == 21, ""); + static_assert(sum<2, 3, 5, 7, 11, 13>::value == 41, ""); + + } + + // http://stackoverflow.com/questions/13728184/template-aliases-and-sfinae + // Clang 3.1 fails with headers of libstd++ 4.8.3 when using std::function + // because of this. + namespace test_template_alias_sfinae + { + + struct foo {}; + + template<typename T> + using member = typename T::member_type; + + template<typename T> + void func(...) {} + + template<typename T> + void func(member<T>*) {} + + void test(); + + void test() { func<foo>(0); } + + } + +} // namespace cxx11 + + + + +namespace cxx14 +{ + + namespace test_polymorphic_lambdas + { + + int + test() + { + const auto lambda = [](auto&&... args){ + const auto istiny = [](auto x){ + return (sizeof(x) == 1UL) ? 1 : 0; + }; + const int aretiny[] = { istiny(args)... }; + return aretiny[0]; + }; + return lambda(1, 1L, 1.0f, '1'); + } + + } + + namespace test_binary_literals + { + + constexpr auto ivii = 0b0000000000101010; + static_assert(ivii == 42, "wrong value"); + + } + + namespace test_generalized_constexpr + { + + template < typename CharT > + constexpr unsigned long + strlen_c(const CharT *const s) noexcept + { + auto length = 0UL; + for (auto p = s; *p; ++p) + ++length; + return length; + } + + static_assert(strlen_c("") == 0UL, ""); + static_assert(strlen_c("x") == 1UL, ""); + static_assert(strlen_c("test") == 4UL, ""); + static_assert(strlen_c("another\0test") == 7UL, ""); + + } + + namespace test_lambda_init_capture + { + + int + test() + { + auto x = 0; + const auto lambda1 = [a = x](int b){ return a + b; }; + const auto lambda2 = [a = lambda1(x)](){ return a; }; + return lambda2(); + } + + } + + namespace test_digit_separators + { + + constexpr auto ten_million = 100'000'000; + static_assert(ten_million == 100000000, ""); + + } + + namespace test_return_type_deduction + { + + auto f(int& x) { return x; } + decltype(auto) g(int& x) { return x; } + + template < typename T1, typename T2 > + struct is_same + { + static constexpr auto value = false; + }; + + template < typename T > + struct is_same<T, T> + { + static constexpr auto value = true; + }; + + int + test() + { + auto x = 0; + static_assert(is_same<int, decltype(f(x))>::value, ""); + static_assert(is_same<int&, decltype(g(x))>::value, ""); + return x; + } + + } + +} // namespace cxx14 + + +#endif + +_ACEOF +if ac_fn_cxx_try_compile "$LINENO"; then : + eval $cachevar=yes +else + eval $cachevar=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + CXX="$ac_save_CXX" +fi +eval ac_res=\$$cachevar + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } + if eval test x\$$cachevar = xyes; then + CXX="$CXX $switch" + if test -n "$CXXCPP" ; then + CXXCPP="$CXXCPP $switch" + fi + ac_success=yes + break + fi + done + fi + + if test x$ac_success = xno; then + for alternative in ${ax_cxx_compile_alternatives}; do + for switch in -std=c++${alternative}; do + cachevar=`$as_echo "ax_cv_cxx_compile_cxx14_$switch" | $as_tr_sh` + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $CXX supports C++14 features with $switch" >&5 +$as_echo_n "checking whether $CXX supports C++14 features with $switch... " >&6; } +if eval \${$cachevar+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_save_CXX="$CXX" + CXX="$CXX $switch" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#ifndef __cplusplus +# error "This is not a C++ compiler" +#elif __cplusplus < 201402L +# error "This is not a C++14 compiler" +#else + + +namespace cxx11 +{ + + namespace test_static_assert + { + + template <typename T> + struct check + { + static_assert(sizeof(int) <= sizeof(T), "not big enough"); + }; + + } + + namespace test_final_override + { + + struct Base + { + virtual void f() {} + }; + + struct Derived : public Base + { + virtual void f() override {} + }; + + } + + namespace test_double_right_angle_brackets + { + + template < typename T > + struct check {}; + + typedef check<void> single_type; + typedef check<check<void>> double_type; + typedef check<check<check<void>>> triple_type; + typedef check<check<check<check<void>>>> quadruple_type; + + } + + namespace test_decltype + { + + int + f() + { + int a = 1; + decltype(a) b = 2; + return a + b; + } + + } + + namespace test_type_deduction + { + + template < typename T1, typename T2 > + struct is_same + { + static const bool value = false; + }; + + template < typename T > + struct is_same<T, T> + { + static const bool value = true; + }; + + template < typename T1, typename T2 > + auto + add(T1 a1, T2 a2) -> decltype(a1 + a2) + { + return a1 + a2; + } + + int + test(const int c, volatile int v) + { + static_assert(is_same<int, decltype(0)>::value == true, ""); + static_assert(is_same<int, decltype(c)>::value == false, ""); + static_assert(is_same<int, decltype(v)>::value == false, ""); + auto ac = c; + auto av = v; + auto sumi = ac + av + 'x'; + auto sumf = ac + av + 1.0; + static_assert(is_same<int, decltype(ac)>::value == true, ""); + static_assert(is_same<int, decltype(av)>::value == true, ""); + static_assert(is_same<int, decltype(sumi)>::value == true, ""); + static_assert(is_same<int, decltype(sumf)>::value == false, ""); + static_assert(is_same<int, decltype(add(c, v))>::value == true, ""); + return (sumf > 0.0) ? sumi : add(c, v); + } + + } + + namespace test_noexcept + { + + int f() { return 0; } + int g() noexcept { return 0; } + + static_assert(noexcept(f()) == false, ""); + static_assert(noexcept(g()) == true, ""); + + } + + namespace test_constexpr + { + + template < typename CharT > + unsigned long constexpr + strlen_c_r(const CharT *const s, const unsigned long acc) noexcept + { + return *s ? strlen_c_r(s + 1, acc + 1) : acc; + } + + template < typename CharT > + unsigned long constexpr + strlen_c(const CharT *const s) noexcept + { + return strlen_c_r(s, 0UL); + } + + static_assert(strlen_c("") == 0UL, ""); + static_assert(strlen_c("1") == 1UL, ""); + static_assert(strlen_c("example") == 7UL, ""); + static_assert(strlen_c("another\0example") == 7UL, ""); + + } + + namespace test_rvalue_references + { + + template < int N > + struct answer + { + static constexpr int value = N; + }; + + answer<1> f(int&) { return answer<1>(); } + answer<2> f(const int&) { return answer<2>(); } + answer<3> f(int&&) { return answer<3>(); } + + void + test() + { + int i = 0; + const int c = 0; + static_assert(decltype(f(i))::value == 1, ""); + static_assert(decltype(f(c))::value == 2, ""); + static_assert(decltype(f(0))::value == 3, ""); + } + + } + + namespace test_uniform_initialization + { + + struct test + { + static const int zero {}; + static const int one {1}; + }; + + static_assert(test::zero == 0, ""); + static_assert(test::one == 1, ""); + + } + + namespace test_lambdas + { + + void + test1() + { + auto lambda1 = [](){}; + auto lambda2 = lambda1; + lambda1(); + lambda2(); + } + + int + test2() + { + auto a = [](int i, int j){ return i + j; }(1, 2); + auto b = []() -> int { return '0'; }(); + auto c = [=](){ return a + b; }(); + auto d = [&](){ return c; }(); + auto e = [a, &b](int x) mutable { + const auto identity = [](int y){ return y; }; + for (auto i = 0; i < a; ++i) + a += b--; + return x + identity(a + b); + }(0); + return a + b + c + d + e; + } + + int + test3() + { + const auto nullary = [](){ return 0; }; + const auto unary = [](int x){ return x; }; + using nullary_t = decltype(nullary); + using unary_t = decltype(unary); + const auto higher1st = [](nullary_t f){ return f(); }; + const auto higher2nd = [unary](nullary_t f1){ + return [unary, f1](unary_t f2){ return f2(unary(f1())); }; + }; + return higher1st(nullary) + higher2nd(nullary)(unary); + } + + } + + namespace test_variadic_templates + { + + template <int...> + struct sum; + + template <int N0, int... N1toN> + struct sum<N0, N1toN...> + { + /* + Original test code used the auto keyword instead of declaring + the type of "value" to be int. This causes Oracle Solaris Studio + 12.4 to fail. This is possibly a compiler bug but in any case + current test code works around it by an explicit declaration. + */ + static constexpr int value = N0 + sum<N1toN...>::value; + }; + + template <> + struct sum<> + { + static constexpr auto value = 0; + }; + + static_assert(sum<>::value == 0, ""); + static_assert(sum<1>::value == 1, ""); + static_assert(sum<23>::value == 23, ""); + static_assert(sum<1, 2>::value == 3, ""); + static_assert(sum<5, 5, 11>::value == 21, ""); + static_assert(sum<2, 3, 5, 7, 11, 13>::value == 41, ""); + + } + + // http://stackoverflow.com/questions/13728184/template-aliases-and-sfinae + // Clang 3.1 fails with headers of libstd++ 4.8.3 when using std::function + // because of this. + namespace test_template_alias_sfinae + { + + struct foo {}; + + template<typename T> + using member = typename T::member_type; + + template<typename T> + void func(...) {} + + template<typename T> + void func(member<T>*) {} + + void test(); + + void test() { func<foo>(0); } + + } + +} // namespace cxx11 + + + + +namespace cxx14 +{ + + namespace test_polymorphic_lambdas + { + + int + test() + { + const auto lambda = [](auto&&... args){ + const auto istiny = [](auto x){ + return (sizeof(x) == 1UL) ? 1 : 0; + }; + const int aretiny[] = { istiny(args)... }; + return aretiny[0]; + }; + return lambda(1, 1L, 1.0f, '1'); + } + + } + + namespace test_binary_literals + { + + constexpr auto ivii = 0b0000000000101010; + static_assert(ivii == 42, "wrong value"); + + } + + namespace test_generalized_constexpr + { + + template < typename CharT > + constexpr unsigned long + strlen_c(const CharT *const s) noexcept + { + auto length = 0UL; + for (auto p = s; *p; ++p) + ++length; + return length; + } + + static_assert(strlen_c("") == 0UL, ""); + static_assert(strlen_c("x") == 1UL, ""); + static_assert(strlen_c("test") == 4UL, ""); + static_assert(strlen_c("another\0test") == 7UL, ""); + + } + + namespace test_lambda_init_capture + { + + int + test() + { + auto x = 0; + const auto lambda1 = [a = x](int b){ return a + b; }; + const auto lambda2 = [a = lambda1(x)](){ return a; }; + return lambda2(); + } + + } + + namespace test_digit_separators + { + + constexpr auto ten_million = 100'000'000; + static_assert(ten_million == 100000000, ""); + + } + + namespace test_return_type_deduction + { + + auto f(int& x) { return x; } + decltype(auto) g(int& x) { return x; } + + template < typename T1, typename T2 > + struct is_same + { + static constexpr auto value = false; + }; + + template < typename T > + struct is_same<T, T> + { + static constexpr auto value = true; + }; + + int + test() + { + auto x = 0; + static_assert(is_same<int, decltype(f(x))>::value, ""); + static_assert(is_same<int&, decltype(g(x))>::value, ""); + return x; + } + + } + +} // namespace cxx14 + + +#endif + +_ACEOF +if ac_fn_cxx_try_compile "$LINENO"; then : + eval $cachevar=yes +else + eval $cachevar=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + CXX="$ac_save_CXX" +fi +eval ac_res=\$$cachevar + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } + if eval test x\$$cachevar = xyes; then + CXX="$CXX $switch" + if test -n "$CXXCPP" ; then + CXXCPP="$CXXCPP $switch" + fi + ac_success=yes + break + fi + done + if test x$ac_success = xyes; then + break + fi + done + fi + ac_ext=cpp +ac_cpp='$CXXCPP $CPPFLAGS' +ac_compile='$CXX -c $CXXFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CXX -o conftest$ac_exeext $CXXFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_cxx_compiler_gnu + + if test x$ax_cxx_compile_cxx14_required = xtrue; then + if test x$ac_success = xno; then + as_fn_error $? "*** A compiler with support for C++14 language features is required." "$LINENO" 5 + fi + fi + if test x$ac_success = xno; then + HAVE_CXX14=0 + { $as_echo "$as_me:${as_lineno-$LINENO}: No compiler with C++14 support was found" >&5 +$as_echo "$as_me: No compiler with C++14 support was found" >&6;} + else + HAVE_CXX14=1 + fi + + +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu +CXX="${r_save_CXX}" +CXXFLAGS="${r_save_CXXFLAGS}" +if test "${HAVE_CXX14}" = "1"; then + if test "${CXX14STD}"x = "x"; then + CXX14STD="${switch}" + else + CXX14STD="${CXX14STD} ${switch}" + fi +else + CXX14="" + CXX14STD="" + CXX14FLAGS="" + CXX14PICFLAGS="" +fi + + + + + +if test -z "${SHLIB_CXX14LD}"; then + SHLIB_CXX14LD="\$(CXX14) \$(CXX14STD)" +fi + +: ${SHLIB_CXX14LDFLAGS=${SHLIB_CXX11LDFLAGS}} + + + + + + + + + +r_save_CXX="${CXX}" +r_save_CXXFLAGS="${CXXFLAGS}" + +: ${CXX17=${CXX14}} +: ${CXX17FLAGS=${CXX14FLAGS}} +: ${CXX17PICFLAGS=${CXX14PICFLAGS}} + +CXX="${CXX17} ${CXX17STD}" +CXXFLAGS="${CXX17FLAGS} ${CXX17PICFLAGS}" +ac_ext=cpp +ac_cpp='$CXXCPP $CPPFLAGS' +ac_compile='$CXX -c $CXXFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CXX -o conftest$ac_exeext $CXXFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_cxx_compiler_gnu + ax_cxx_compile_alternatives="17 1z" ax_cxx_compile_cxx17_required=false + ac_ext=cpp +ac_cpp='$CXXCPP $CPPFLAGS' +ac_compile='$CXX -c $CXXFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CXX -o conftest$ac_exeext $CXXFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_cxx_compiler_gnu + ac_success=no + switch="" + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $CXX supports C++17 features by default" >&5 +$as_echo_n "checking whether $CXX supports C++17 features by default... " >&6; } +if ${ax_cv_cxx_compile_cxx17+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#ifndef __cplusplus +#error "This is not a C++ compiler" +#elif __cplusplus <= 201402L +#error "This is not a C++17 compiler" +#else + + +namespace cxx11 +{ + + namespace test_static_assert + { + + template <typename T> + struct check + { + static_assert(sizeof(int) <= sizeof(T), "not big enough"); + }; + + } + + namespace test_final_override + { + + struct Base + { + virtual void f() {} + }; + + struct Derived : public Base + { + virtual void f() override {} + }; + + } + + namespace test_double_right_angle_brackets + { + + template < typename T > + struct check {}; + + typedef check<void> single_type; + typedef check<check<void>> double_type; + typedef check<check<check<void>>> triple_type; + typedef check<check<check<check<void>>>> quadruple_type; + + } + + namespace test_decltype + { + + int + f() + { + int a = 1; + decltype(a) b = 2; + return a + b; + } + + } + + namespace test_type_deduction + { + + template < typename T1, typename T2 > + struct is_same + { + static const bool value = false; + }; + + template < typename T > + struct is_same<T, T> + { + static const bool value = true; + }; + + template < typename T1, typename T2 > + auto + add(T1 a1, T2 a2) -> decltype(a1 + a2) + { + return a1 + a2; + } + + int + test(const int c, volatile int v) + { + static_assert(is_same<int, decltype(0)>::value == true, ""); + static_assert(is_same<int, decltype(c)>::value == false, ""); + static_assert(is_same<int, decltype(v)>::value == false, ""); + auto ac = c; + auto av = v; + auto sumi = ac + av + 'x'; + auto sumf = ac + av + 1.0; + static_assert(is_same<int, decltype(ac)>::value == true, ""); + static_assert(is_same<int, decltype(av)>::value == true, ""); + static_assert(is_same<int, decltype(sumi)>::value == true, ""); + static_assert(is_same<int, decltype(sumf)>::value == false, ""); + static_assert(is_same<int, decltype(add(c, v))>::value == true, ""); + return (sumf > 0.0) ? sumi : add(c, v); + } + + } + + namespace test_noexcept + { + + int f() { return 0; } + int g() noexcept { return 0; } + + static_assert(noexcept(f()) == false, ""); + static_assert(noexcept(g()) == true, ""); + + } + + namespace test_constexpr + { + + template < typename CharT > + unsigned long constexpr + strlen_c_r(const CharT *const s, const unsigned long acc) noexcept + { + return *s ? strlen_c_r(s + 1, acc + 1) : acc; + } + + template < typename CharT > + unsigned long constexpr + strlen_c(const CharT *const s) noexcept + { + return strlen_c_r(s, 0UL); + } + + static_assert(strlen_c("") == 0UL, ""); + static_assert(strlen_c("1") == 1UL, ""); + static_assert(strlen_c("example") == 7UL, ""); + static_assert(strlen_c("another\0example") == 7UL, ""); + + } + + namespace test_rvalue_references + { + + template < int N > + struct answer + { + static constexpr int value = N; + }; + + answer<1> f(int&) { return answer<1>(); } + answer<2> f(const int&) { return answer<2>(); } + answer<3> f(int&&) { return answer<3>(); } + + void + test() + { + int i = 0; + const int c = 0; + static_assert(decltype(f(i))::value == 1, ""); + static_assert(decltype(f(c))::value == 2, ""); + static_assert(decltype(f(0))::value == 3, ""); + } + + } + + namespace test_uniform_initialization + { + + struct test + { + static const int zero {}; + static const int one {1}; + }; + + static_assert(test::zero == 0, ""); + static_assert(test::one == 1, ""); + + } + + namespace test_lambdas + { + + void + test1() + { + auto lambda1 = [](){}; + auto lambda2 = lambda1; + lambda1(); + lambda2(); + } + + int + test2() + { + auto a = [](int i, int j){ return i + j; }(1, 2); + auto b = []() -> int { return '0'; }(); + auto c = [=](){ return a + b; }(); + auto d = [&](){ return c; }(); + auto e = [a, &b](int x) mutable { + const auto identity = [](int y){ return y; }; + for (auto i = 0; i < a; ++i) + a += b--; + return x + identity(a + b); + }(0); + return a + b + c + d + e; + } + + int + test3() + { + const auto nullary = [](){ return 0; }; + const auto unary = [](int x){ return x; }; + using nullary_t = decltype(nullary); + using unary_t = decltype(unary); + const auto higher1st = [](nullary_t f){ return f(); }; + const auto higher2nd = [unary](nullary_t f1){ + return [unary, f1](unary_t f2){ return f2(unary(f1())); }; + }; + return higher1st(nullary) + higher2nd(nullary)(unary); + } + + } + + namespace test_variadic_templates + { + + template <int...> + struct sum; + + template <int N0, int... N1toN> + struct sum<N0, N1toN...> + { + /* + Original test code used the auto keyword instead of declaring + the type of "value" to be int. This causes Oracle Solaris Studio + 12.4 to fail. This is possibly a compiler bug but in any case + current test code works around it by an explicit declaration. + */ + static constexpr int value = N0 + sum<N1toN...>::value; + }; + + template <> + struct sum<> + { + static constexpr auto value = 0; + }; + + static_assert(sum<>::value == 0, ""); + static_assert(sum<1>::value == 1, ""); + static_assert(sum<23>::value == 23, ""); + static_assert(sum<1, 2>::value == 3, ""); + static_assert(sum<5, 5, 11>::value == 21, ""); + static_assert(sum<2, 3, 5, 7, 11, 13>::value == 41, ""); + + } + + // http://stackoverflow.com/questions/13728184/template-aliases-and-sfinae + // Clang 3.1 fails with headers of libstd++ 4.8.3 when using std::function + // because of this. + namespace test_template_alias_sfinae + { + + struct foo {}; + + template<typename T> + using member = typename T::member_type; + + template<typename T> + void func(...) {} + + template<typename T> + void func(member<T>*) {} + + void test(); + + void test() { func<foo>(0); } + + } + +} // namespace cxx11 + + + + +namespace cxx14 +{ + + namespace test_polymorphic_lambdas + { + + int + test() + { + const auto lambda = [](auto&&... args){ + const auto istiny = [](auto x){ + return (sizeof(x) == 1UL) ? 1 : 0; + }; + const int aretiny[] = { istiny(args)... }; + return aretiny[0]; + }; + return lambda(1, 1L, 1.0f, '1'); + } + + } + + namespace test_binary_literals + { + + constexpr auto ivii = 0b0000000000101010; + static_assert(ivii == 42, "wrong value"); + + } + + namespace test_generalized_constexpr + { + + template < typename CharT > + constexpr unsigned long + strlen_c(const CharT *const s) noexcept + { + auto length = 0UL; + for (auto p = s; *p; ++p) + ++length; + return length; + } + + static_assert(strlen_c("") == 0UL, ""); + static_assert(strlen_c("x") == 1UL, ""); + static_assert(strlen_c("test") == 4UL, ""); + static_assert(strlen_c("another\0test") == 7UL, ""); + + } + + namespace test_lambda_init_capture + { + + int + test() + { + auto x = 0; + const auto lambda1 = [a = x](int b){ return a + b; }; + const auto lambda2 = [a = lambda1(x)](){ return a; }; + return lambda2(); + } + + } + + namespace test_digit_separators + { + + constexpr auto ten_million = 100'000'000; + static_assert(ten_million == 100000000, ""); + + } + + namespace test_return_type_deduction + { + + auto f(int& x) { return x; } + decltype(auto) g(int& x) { return x; } + + template < typename T1, typename T2 > + struct is_same + { + static constexpr auto value = false; + }; + + template < typename T > + struct is_same<T, T> + { + static constexpr auto value = true; + }; + + int + test() + { + auto x = 0; + static_assert(is_same<int, decltype(f(x))>::value, ""); + static_assert(is_same<int&, decltype(g(x))>::value, ""); + return x; + } + + } + +} // namespace cxx14 + + + + +/* We don't want compiler-specific tests for R so these conditional + tests are commented out. + + For C++17 features supported by compiler see + https://gcc.gnu.org/projects/cxx-status.html#cxx1z for gcc + http://clang.llvm.org/cxx_status.html for clang + http://en.cppreference.com/w/cpp/compiler_support for an overview + +#if defined(__clang__) + #define REALLY_CLANG +#else + #if defined(__GNUC__) + #define REALLY_GCC + #endif +#endif +*/ + +#include <initializer_list> +#include <utility> +#include <type_traits> + +namespace cxx17 +{ + +/* Not listed as supported by clang 4 - MTP +#if !defined(REALLY_CLANG) + namespace test_constexpr_lambdas + { + + // TODO: test it with clang++ from git + + constexpr int foo = [](){return 42;}(); + + } +#endif // !defined(REALLY_CLANG) +*/ + + namespace test::nested_namespace::definitions + { + + } + + namespace test_fold_expression + { + + template<typename... Args> + int multiply(Args... args) + { + return (args * ... * 1); + } + + template<typename... Args> + bool all(Args... args) + { + return (args && ...); + } + + } + + namespace test_extended_static_assert + { + + static_assert (true); + + } + + namespace test_auto_brace_init_list + { + + auto foo = {5}; + auto bar {5}; + + static_assert(std::is_same<std::initializer_list<int>, decltype(foo)>::value); + static_assert(std::is_same<int, decltype(bar)>::value); + } + + namespace test_typename_in_template_template_parameter + { + + template<template<typename> typename X> struct D; + + } + + namespace test_fallthrough_nodiscard_maybe_unused_attributes + { + + int f1() + { + return 42; + } + + [[nodiscard]] int f2() + { + [[maybe_unused]] auto unused = f1(); + + switch (f1()) + { + case 17: + f1(); + [[fallthrough]]; + case 42: + f1(); + } + return f1(); + } + + } + + namespace test_extended_aggregate_initialization + { + + struct base1 + { + int b1, b2 = 42; + }; + + struct base2 + { + base2() { + b3 = 42; + } + int b3; + }; + + struct derived : base1, base2 + { + int d; + }; + + derived d1 {{1, 2}, {}, 4}; // full initialization + derived d2 {{}, {}, 4}; // value-initialized bases + + } + + namespace test_general_range_based_for_loop + { + + struct iter + { + int i; + + int& operator* () + { + return i; + } + + const int& operator* () const + { + return i; + } + + iter& operator++() + { + ++i; + return *this; + } + }; + + struct sentinel + { + int i; + }; + + bool operator== (const iter& i, const sentinel& s) + { + return i.i == s.i; + } + + bool operator!= (const iter& i, const sentinel& s) + { + return !(i == s); + } + + struct range + { + iter begin() const + { + return {0}; + } + + sentinel end() const + { + return {5}; + } + }; + + void f() + { + range r {}; + + for (auto i : r) + { + [[maybe_unused]] auto v = i; + } + } + + } + + namespace test_lambda_capture_asterisk_this_by_value + { + + struct t + { + int i; + int foo() + { + return [*this]() + { + return i; + }(); + } + }; + + } + + namespace test_enum_class_construction + { + + enum class byte : unsigned char + {}; + + byte foo {42}; + + } + + namespace test_constexpr_if + { + + template <bool cond> + int f () + { + if constexpr(cond) + { + return 13; + } + else + { + return 42; + } + } + + } + + namespace test_selection_statement_with_initializer + { + + int f() + { + return 13; + } + + int f2() + { + if (auto i = f(); i > 0) + { + return 3; + } + + switch (auto i = f(); i + 4) + { + case 17: + return 2; + + default: + return 1; + } + } + + } + +/* P0091R3 not supported by clang 4.0.0 - MTP +#if !defined(REALLY_CLANG) + namespace test_template_argument_deduction_for_class_templates + { + + // TODO: test it with clang++ from git + + template <typename T1, typename T2> + struct pair + { + pair (T1 p1, T2 p2) + : m1 {p1}, + m2 {p2} + {} + + T1 m1; + T2 m2; + }; + + void f() + { + [[maybe_unused]] auto p = pair{13, 42u}; + } + + } +#endif // !defined(REALLY_CLANG) +*/ + + namespace test_non_type_auto_template_parameters + { + + template <auto n> + struct B + {}; + + B<5> b1; + B<'a'> b2; + + } + +/* P0217R3 should be supported in clang 4.0.0, but test code dumps core + In addition, gcc 7.0.1 fails on the last test - MTP +#if !defined(REALLY_CLANG) + namespace test_structured_bindings + { + + // TODO: test it with clang++ from git + + int arr[2] = { 1, 2 }; + std::pair<int, int> pr = { 1, 2 }; + + auto f1() -> int(&)[2] + { + return arr; + } + + auto f2() -> std::pair<int, int>& + { + return pr; + } + + struct S + { + int x1 : 2; + volatile double y1; + }; + + S f3() + { + return {}; + } + + auto [ x1, y1 ] = f1(); + auto& [ xr1, yr1 ] = f1(); + auto [ x2, y2 ] = f2(); + auto& [ xr2, yr2 ] = f2(); + const auto [ x3, y3 ] = f3(); + + } +#endif // !defined(REALLY_CLANG) +*/ + +/* + P0012R1 is supported by clang 4.0.0 - MTP + #if !defined(REALLY_CLANG) +*/ + namespace test_exception_spec_type_system + { + + // TODO: test it with clang++ from git + + struct Good {}; + struct Bad {}; + + void g1() noexcept; + void g2(); + + template<typename T> + Bad + f(T*, T*); + + template<typename T1, typename T2> + Good + f(T1*, T2*); + + static_assert (std::is_same_v<Good, decltype(f(g1, g2))>); + + } +/* + #endif // !defined(REALLY_CLANG) +*/ + + namespace test_inline_variables + { + + template<class T> void f(T) + {} + + template<class T> inline T g(T) + { + return T{}; + } + + template<> inline void f<>(int) + {} + + template<> int g<>(int) + { + return 5; + } + + } + +} // namespace cxx17 + + +#endif + +_ACEOF +if ac_fn_cxx_try_compile "$LINENO"; then : + ax_cv_cxx_compile_cxx17=yes +else + ax_cv_cxx_compile_cxx17=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ax_cv_cxx_compile_cxx17" >&5 +$as_echo "$ax_cv_cxx_compile_cxx17" >&6; } + if test x$ax_cv_cxx_compile_cxx17 = xyes; then + ac_success=yes + fi + + if test x$ac_success = xno; then + for alternative in ${ax_cxx_compile_alternatives}; do + switch="-std=gnu++${alternative}" + cachevar=`$as_echo "ax_cv_cxx_compile_cxx17_$switch" | $as_tr_sh` + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $CXX supports C++17 features with $switch" >&5 +$as_echo_n "checking whether $CXX supports C++17 features with $switch... " >&6; } +if eval \${$cachevar+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_save_CXX="$CXX" + CXX="$CXX $switch" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#ifndef __cplusplus +#error "This is not a C++ compiler" +#elif __cplusplus <= 201402L +#error "This is not a C++17 compiler" +#else + + +namespace cxx11 +{ + + namespace test_static_assert + { + + template <typename T> + struct check + { + static_assert(sizeof(int) <= sizeof(T), "not big enough"); + }; + + } + + namespace test_final_override + { + + struct Base + { + virtual void f() {} + }; + + struct Derived : public Base + { + virtual void f() override {} + }; + + } + + namespace test_double_right_angle_brackets + { + + template < typename T > + struct check {}; + + typedef check<void> single_type; + typedef check<check<void>> double_type; + typedef check<check<check<void>>> triple_type; + typedef check<check<check<check<void>>>> quadruple_type; + + } + + namespace test_decltype + { + + int + f() + { + int a = 1; + decltype(a) b = 2; + return a + b; + } + + } + + namespace test_type_deduction + { + + template < typename T1, typename T2 > + struct is_same + { + static const bool value = false; + }; + + template < typename T > + struct is_same<T, T> + { + static const bool value = true; + }; + + template < typename T1, typename T2 > + auto + add(T1 a1, T2 a2) -> decltype(a1 + a2) + { + return a1 + a2; + } + + int + test(const int c, volatile int v) + { + static_assert(is_same<int, decltype(0)>::value == true, ""); + static_assert(is_same<int, decltype(c)>::value == false, ""); + static_assert(is_same<int, decltype(v)>::value == false, ""); + auto ac = c; + auto av = v; + auto sumi = ac + av + 'x'; + auto sumf = ac + av + 1.0; + static_assert(is_same<int, decltype(ac)>::value == true, ""); + static_assert(is_same<int, decltype(av)>::value == true, ""); + static_assert(is_same<int, decltype(sumi)>::value == true, ""); + static_assert(is_same<int, decltype(sumf)>::value == false, ""); + static_assert(is_same<int, decltype(add(c, v))>::value == true, ""); + return (sumf > 0.0) ? sumi : add(c, v); + } + + } + + namespace test_noexcept + { + + int f() { return 0; } + int g() noexcept { return 0; } + + static_assert(noexcept(f()) == false, ""); + static_assert(noexcept(g()) == true, ""); + + } + + namespace test_constexpr + { + + template < typename CharT > + unsigned long constexpr + strlen_c_r(const CharT *const s, const unsigned long acc) noexcept + { + return *s ? strlen_c_r(s + 1, acc + 1) : acc; + } + + template < typename CharT > + unsigned long constexpr + strlen_c(const CharT *const s) noexcept + { + return strlen_c_r(s, 0UL); + } + + static_assert(strlen_c("") == 0UL, ""); + static_assert(strlen_c("1") == 1UL, ""); + static_assert(strlen_c("example") == 7UL, ""); + static_assert(strlen_c("another\0example") == 7UL, ""); + + } + + namespace test_rvalue_references + { + + template < int N > + struct answer + { + static constexpr int value = N; + }; + + answer<1> f(int&) { return answer<1>(); } + answer<2> f(const int&) { return answer<2>(); } + answer<3> f(int&&) { return answer<3>(); } + + void + test() + { + int i = 0; + const int c = 0; + static_assert(decltype(f(i))::value == 1, ""); + static_assert(decltype(f(c))::value == 2, ""); + static_assert(decltype(f(0))::value == 3, ""); + } + + } + + namespace test_uniform_initialization + { + + struct test + { + static const int zero {}; + static const int one {1}; + }; + + static_assert(test::zero == 0, ""); + static_assert(test::one == 1, ""); + + } + + namespace test_lambdas + { + + void + test1() + { + auto lambda1 = [](){}; + auto lambda2 = lambda1; + lambda1(); + lambda2(); + } + + int + test2() + { + auto a = [](int i, int j){ return i + j; }(1, 2); + auto b = []() -> int { return '0'; }(); + auto c = [=](){ return a + b; }(); + auto d = [&](){ return c; }(); + auto e = [a, &b](int x) mutable { + const auto identity = [](int y){ return y; }; + for (auto i = 0; i < a; ++i) + a += b--; + return x + identity(a + b); + }(0); + return a + b + c + d + e; + } + + int + test3() + { + const auto nullary = [](){ return 0; }; + const auto unary = [](int x){ return x; }; + using nullary_t = decltype(nullary); + using unary_t = decltype(unary); + const auto higher1st = [](nullary_t f){ return f(); }; + const auto higher2nd = [unary](nullary_t f1){ + return [unary, f1](unary_t f2){ return f2(unary(f1())); }; + }; + return higher1st(nullary) + higher2nd(nullary)(unary); + } + + } + + namespace test_variadic_templates + { + + template <int...> + struct sum; + + template <int N0, int... N1toN> + struct sum<N0, N1toN...> + { + /* + Original test code used the auto keyword instead of declaring + the type of "value" to be int. This causes Oracle Solaris Studio + 12.4 to fail. This is possibly a compiler bug but in any case + current test code works around it by an explicit declaration. + */ + static constexpr int value = N0 + sum<N1toN...>::value; + }; + + template <> + struct sum<> + { + static constexpr auto value = 0; + }; + + static_assert(sum<>::value == 0, ""); + static_assert(sum<1>::value == 1, ""); + static_assert(sum<23>::value == 23, ""); + static_assert(sum<1, 2>::value == 3, ""); + static_assert(sum<5, 5, 11>::value == 21, ""); + static_assert(sum<2, 3, 5, 7, 11, 13>::value == 41, ""); + + } + + // http://stackoverflow.com/questions/13728184/template-aliases-and-sfinae + // Clang 3.1 fails with headers of libstd++ 4.8.3 when using std::function + // because of this. + namespace test_template_alias_sfinae + { + + struct foo {}; + + template<typename T> + using member = typename T::member_type; + + template<typename T> + void func(...) {} + + template<typename T> + void func(member<T>*) {} + + void test(); + + void test() { func<foo>(0); } + + } + +} // namespace cxx11 + + + + +namespace cxx14 +{ + + namespace test_polymorphic_lambdas + { + + int + test() + { + const auto lambda = [](auto&&... args){ + const auto istiny = [](auto x){ + return (sizeof(x) == 1UL) ? 1 : 0; + }; + const int aretiny[] = { istiny(args)... }; + return aretiny[0]; + }; + return lambda(1, 1L, 1.0f, '1'); + } + + } + + namespace test_binary_literals + { + + constexpr auto ivii = 0b0000000000101010; + static_assert(ivii == 42, "wrong value"); + + } + + namespace test_generalized_constexpr + { + + template < typename CharT > + constexpr unsigned long + strlen_c(const CharT *const s) noexcept + { + auto length = 0UL; + for (auto p = s; *p; ++p) + ++length; + return length; + } + + static_assert(strlen_c("") == 0UL, ""); + static_assert(strlen_c("x") == 1UL, ""); + static_assert(strlen_c("test") == 4UL, ""); + static_assert(strlen_c("another\0test") == 7UL, ""); + + } + + namespace test_lambda_init_capture + { + + int + test() + { + auto x = 0; + const auto lambda1 = [a = x](int b){ return a + b; }; + const auto lambda2 = [a = lambda1(x)](){ return a; }; + return lambda2(); + } + + } + + namespace test_digit_separators + { + + constexpr auto ten_million = 100'000'000; + static_assert(ten_million == 100000000, ""); + + } + + namespace test_return_type_deduction + { + + auto f(int& x) { return x; } + decltype(auto) g(int& x) { return x; } + + template < typename T1, typename T2 > + struct is_same + { + static constexpr auto value = false; + }; + + template < typename T > + struct is_same<T, T> + { + static constexpr auto value = true; + }; + + int + test() + { + auto x = 0; + static_assert(is_same<int, decltype(f(x))>::value, ""); + static_assert(is_same<int&, decltype(g(x))>::value, ""); + return x; + } + + } + +} // namespace cxx14 + + + + +/* We don't want compiler-specific tests for R so these conditional + tests are commented out. + + For C++17 features supported by compiler see + https://gcc.gnu.org/projects/cxx-status.html#cxx1z for gcc + http://clang.llvm.org/cxx_status.html for clang + http://en.cppreference.com/w/cpp/compiler_support for an overview + +#if defined(__clang__) + #define REALLY_CLANG +#else + #if defined(__GNUC__) + #define REALLY_GCC + #endif +#endif +*/ + +#include <initializer_list> +#include <utility> +#include <type_traits> + +namespace cxx17 +{ + +/* Not listed as supported by clang 4 - MTP +#if !defined(REALLY_CLANG) + namespace test_constexpr_lambdas + { + + // TODO: test it with clang++ from git + + constexpr int foo = [](){return 42;}(); + + } +#endif // !defined(REALLY_CLANG) +*/ + + namespace test::nested_namespace::definitions + { + + } + + namespace test_fold_expression + { + + template<typename... Args> + int multiply(Args... args) + { + return (args * ... * 1); + } + + template<typename... Args> + bool all(Args... args) + { + return (args && ...); + } + + } + + namespace test_extended_static_assert + { + + static_assert (true); + + } + + namespace test_auto_brace_init_list + { + + auto foo = {5}; + auto bar {5}; + + static_assert(std::is_same<std::initializer_list<int>, decltype(foo)>::value); + static_assert(std::is_same<int, decltype(bar)>::value); + } + + namespace test_typename_in_template_template_parameter + { + + template<template<typename> typename X> struct D; + + } + + namespace test_fallthrough_nodiscard_maybe_unused_attributes + { + + int f1() + { + return 42; + } + + [[nodiscard]] int f2() + { + [[maybe_unused]] auto unused = f1(); + + switch (f1()) + { + case 17: + f1(); + [[fallthrough]]; + case 42: + f1(); + } + return f1(); + } + + } + + namespace test_extended_aggregate_initialization + { + + struct base1 + { + int b1, b2 = 42; + }; + + struct base2 + { + base2() { + b3 = 42; + } + int b3; + }; + + struct derived : base1, base2 + { + int d; + }; + + derived d1 {{1, 2}, {}, 4}; // full initialization + derived d2 {{}, {}, 4}; // value-initialized bases + + } + + namespace test_general_range_based_for_loop + { + + struct iter + { + int i; + + int& operator* () + { + return i; + } + + const int& operator* () const + { + return i; + } + + iter& operator++() + { + ++i; + return *this; + } + }; + + struct sentinel + { + int i; + }; + + bool operator== (const iter& i, const sentinel& s) + { + return i.i == s.i; + } + + bool operator!= (const iter& i, const sentinel& s) + { + return !(i == s); + } + + struct range + { + iter begin() const + { + return {0}; + } + + sentinel end() const + { + return {5}; + } + }; + + void f() + { + range r {}; + + for (auto i : r) + { + [[maybe_unused]] auto v = i; + } + } + + } + + namespace test_lambda_capture_asterisk_this_by_value + { + + struct t + { + int i; + int foo() + { + return [*this]() + { + return i; + }(); + } + }; + + } + + namespace test_enum_class_construction + { + + enum class byte : unsigned char + {}; + + byte foo {42}; + + } + + namespace test_constexpr_if + { + + template <bool cond> + int f () + { + if constexpr(cond) + { + return 13; + } + else + { + return 42; + } + } + + } + + namespace test_selection_statement_with_initializer + { + + int f() + { + return 13; + } + + int f2() + { + if (auto i = f(); i > 0) + { + return 3; + } + + switch (auto i = f(); i + 4) + { + case 17: + return 2; + + default: + return 1; + } + } + + } + +/* P0091R3 not supported by clang 4.0.0 - MTP +#if !defined(REALLY_CLANG) + namespace test_template_argument_deduction_for_class_templates + { + + // TODO: test it with clang++ from git + + template <typename T1, typename T2> + struct pair + { + pair (T1 p1, T2 p2) + : m1 {p1}, + m2 {p2} + {} + + T1 m1; + T2 m2; + }; + + void f() + { + [[maybe_unused]] auto p = pair{13, 42u}; + } + + } +#endif // !defined(REALLY_CLANG) +*/ + + namespace test_non_type_auto_template_parameters + { + + template <auto n> + struct B + {}; + + B<5> b1; + B<'a'> b2; + + } + +/* P0217R3 should be supported in clang 4.0.0, but test code dumps core + In addition, gcc 7.0.1 fails on the last test - MTP +#if !defined(REALLY_CLANG) + namespace test_structured_bindings + { + + // TODO: test it with clang++ from git + + int arr[2] = { 1, 2 }; + std::pair<int, int> pr = { 1, 2 }; + + auto f1() -> int(&)[2] + { + return arr; + } + + auto f2() -> std::pair<int, int>& + { + return pr; + } + + struct S + { + int x1 : 2; + volatile double y1; + }; + + S f3() + { + return {}; + } + + auto [ x1, y1 ] = f1(); + auto& [ xr1, yr1 ] = f1(); + auto [ x2, y2 ] = f2(); + auto& [ xr2, yr2 ] = f2(); + const auto [ x3, y3 ] = f3(); + + } +#endif // !defined(REALLY_CLANG) +*/ + +/* + P0012R1 is supported by clang 4.0.0 - MTP + #if !defined(REALLY_CLANG) +*/ + namespace test_exception_spec_type_system + { + + // TODO: test it with clang++ from git + + struct Good {}; + struct Bad {}; + + void g1() noexcept; + void g2(); + + template<typename T> + Bad + f(T*, T*); + + template<typename T1, typename T2> + Good + f(T1*, T2*); + + static_assert (std::is_same_v<Good, decltype(f(g1, g2))>); + + } +/* + #endif // !defined(REALLY_CLANG) +*/ + + namespace test_inline_variables + { + + template<class T> void f(T) + {} + + template<class T> inline T g(T) + { + return T{}; + } + + template<> inline void f<>(int) + {} + + template<> int g<>(int) + { + return 5; + } + + } + +} // namespace cxx17 + + +#endif + +_ACEOF +if ac_fn_cxx_try_compile "$LINENO"; then : + eval $cachevar=yes +else + eval $cachevar=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + CXX="$ac_save_CXX" +fi +eval ac_res=\$$cachevar + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } + if eval test x\$$cachevar = xyes; then + CXX="$CXX $switch" + if test -n "$CXXCPP" ; then + CXXCPP="$CXXCPP $switch" + fi + ac_success=yes + break + fi + done + fi + + if test x$ac_success = xno; then + for alternative in ${ax_cxx_compile_alternatives}; do + for switch in -std=c++${alternative}; do + cachevar=`$as_echo "ax_cv_cxx_compile_cxx17_$switch" | $as_tr_sh` + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $CXX supports C++17 features with $switch" >&5 +$as_echo_n "checking whether $CXX supports C++17 features with $switch... " >&6; } +if eval \${$cachevar+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_save_CXX="$CXX" + CXX="$CXX $switch" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#ifndef __cplusplus +#error "This is not a C++ compiler" +#elif __cplusplus <= 201402L +#error "This is not a C++17 compiler" +#else + + +namespace cxx11 +{ + + namespace test_static_assert + { + + template <typename T> + struct check + { + static_assert(sizeof(int) <= sizeof(T), "not big enough"); + }; + + } + + namespace test_final_override + { + + struct Base + { + virtual void f() {} + }; + + struct Derived : public Base + { + virtual void f() override {} + }; + + } + + namespace test_double_right_angle_brackets + { + + template < typename T > + struct check {}; + + typedef check<void> single_type; + typedef check<check<void>> double_type; + typedef check<check<check<void>>> triple_type; + typedef check<check<check<check<void>>>> quadruple_type; + + } + + namespace test_decltype + { + + int + f() + { + int a = 1; + decltype(a) b = 2; + return a + b; + } + + } + + namespace test_type_deduction + { + + template < typename T1, typename T2 > + struct is_same + { + static const bool value = false; + }; + + template < typename T > + struct is_same<T, T> + { + static const bool value = true; + }; + + template < typename T1, typename T2 > + auto + add(T1 a1, T2 a2) -> decltype(a1 + a2) + { + return a1 + a2; + } + + int + test(const int c, volatile int v) + { + static_assert(is_same<int, decltype(0)>::value == true, ""); + static_assert(is_same<int, decltype(c)>::value == false, ""); + static_assert(is_same<int, decltype(v)>::value == false, ""); + auto ac = c; + auto av = v; + auto sumi = ac + av + 'x'; + auto sumf = ac + av + 1.0; + static_assert(is_same<int, decltype(ac)>::value == true, ""); + static_assert(is_same<int, decltype(av)>::value == true, ""); + static_assert(is_same<int, decltype(sumi)>::value == true, ""); + static_assert(is_same<int, decltype(sumf)>::value == false, ""); + static_assert(is_same<int, decltype(add(c, v))>::value == true, ""); + return (sumf > 0.0) ? sumi : add(c, v); + } + + } + + namespace test_noexcept + { + + int f() { return 0; } + int g() noexcept { return 0; } + + static_assert(noexcept(f()) == false, ""); + static_assert(noexcept(g()) == true, ""); + + } + + namespace test_constexpr + { + + template < typename CharT > + unsigned long constexpr + strlen_c_r(const CharT *const s, const unsigned long acc) noexcept + { + return *s ? strlen_c_r(s + 1, acc + 1) : acc; + } + + template < typename CharT > + unsigned long constexpr + strlen_c(const CharT *const s) noexcept + { + return strlen_c_r(s, 0UL); + } + + static_assert(strlen_c("") == 0UL, ""); + static_assert(strlen_c("1") == 1UL, ""); + static_assert(strlen_c("example") == 7UL, ""); + static_assert(strlen_c("another\0example") == 7UL, ""); + + } + + namespace test_rvalue_references + { + + template < int N > + struct answer + { + static constexpr int value = N; + }; + + answer<1> f(int&) { return answer<1>(); } + answer<2> f(const int&) { return answer<2>(); } + answer<3> f(int&&) { return answer<3>(); } + + void + test() + { + int i = 0; + const int c = 0; + static_assert(decltype(f(i))::value == 1, ""); + static_assert(decltype(f(c))::value == 2, ""); + static_assert(decltype(f(0))::value == 3, ""); + } + + } + + namespace test_uniform_initialization + { + + struct test + { + static const int zero {}; + static const int one {1}; + }; + + static_assert(test::zero == 0, ""); + static_assert(test::one == 1, ""); + + } + + namespace test_lambdas + { + + void + test1() + { + auto lambda1 = [](){}; + auto lambda2 = lambda1; + lambda1(); + lambda2(); + } + + int + test2() + { + auto a = [](int i, int j){ return i + j; }(1, 2); + auto b = []() -> int { return '0'; }(); + auto c = [=](){ return a + b; }(); + auto d = [&](){ return c; }(); + auto e = [a, &b](int x) mutable { + const auto identity = [](int y){ return y; }; + for (auto i = 0; i < a; ++i) + a += b--; + return x + identity(a + b); + }(0); + return a + b + c + d + e; + } + + int + test3() + { + const auto nullary = [](){ return 0; }; + const auto unary = [](int x){ return x; }; + using nullary_t = decltype(nullary); + using unary_t = decltype(unary); + const auto higher1st = [](nullary_t f){ return f(); }; + const auto higher2nd = [unary](nullary_t f1){ + return [unary, f1](unary_t f2){ return f2(unary(f1())); }; + }; + return higher1st(nullary) + higher2nd(nullary)(unary); + } + + } + + namespace test_variadic_templates + { + + template <int...> + struct sum; + + template <int N0, int... N1toN> + struct sum<N0, N1toN...> + { + /* + Original test code used the auto keyword instead of declaring + the type of "value" to be int. This causes Oracle Solaris Studio + 12.4 to fail. This is possibly a compiler bug but in any case + current test code works around it by an explicit declaration. + */ + static constexpr int value = N0 + sum<N1toN...>::value; + }; + + template <> + struct sum<> + { + static constexpr auto value = 0; + }; + + static_assert(sum<>::value == 0, ""); + static_assert(sum<1>::value == 1, ""); + static_assert(sum<23>::value == 23, ""); + static_assert(sum<1, 2>::value == 3, ""); + static_assert(sum<5, 5, 11>::value == 21, ""); + static_assert(sum<2, 3, 5, 7, 11, 13>::value == 41, ""); + + } + + // http://stackoverflow.com/questions/13728184/template-aliases-and-sfinae + // Clang 3.1 fails with headers of libstd++ 4.8.3 when using std::function + // because of this. + namespace test_template_alias_sfinae + { + + struct foo {}; + + template<typename T> + using member = typename T::member_type; + + template<typename T> + void func(...) {} + + template<typename T> + void func(member<T>*) {} + + void test(); + + void test() { func<foo>(0); } + + } + +} // namespace cxx11 + + + + +namespace cxx14 +{ + + namespace test_polymorphic_lambdas + { + + int + test() + { + const auto lambda = [](auto&&... args){ + const auto istiny = [](auto x){ + return (sizeof(x) == 1UL) ? 1 : 0; + }; + const int aretiny[] = { istiny(args)... }; + return aretiny[0]; + }; + return lambda(1, 1L, 1.0f, '1'); + } + + } + + namespace test_binary_literals + { + + constexpr auto ivii = 0b0000000000101010; + static_assert(ivii == 42, "wrong value"); + + } + + namespace test_generalized_constexpr + { + + template < typename CharT > + constexpr unsigned long + strlen_c(const CharT *const s) noexcept + { + auto length = 0UL; + for (auto p = s; *p; ++p) + ++length; + return length; + } + + static_assert(strlen_c("") == 0UL, ""); + static_assert(strlen_c("x") == 1UL, ""); + static_assert(strlen_c("test") == 4UL, ""); + static_assert(strlen_c("another\0test") == 7UL, ""); + + } + + namespace test_lambda_init_capture + { + + int + test() + { + auto x = 0; + const auto lambda1 = [a = x](int b){ return a + b; }; + const auto lambda2 = [a = lambda1(x)](){ return a; }; + return lambda2(); + } + + } + + namespace test_digit_separators + { + + constexpr auto ten_million = 100'000'000; + static_assert(ten_million == 100000000, ""); + + } + + namespace test_return_type_deduction + { + + auto f(int& x) { return x; } + decltype(auto) g(int& x) { return x; } + + template < typename T1, typename T2 > + struct is_same + { + static constexpr auto value = false; + }; + + template < typename T > + struct is_same<T, T> + { + static constexpr auto value = true; + }; + + int + test() + { + auto x = 0; + static_assert(is_same<int, decltype(f(x))>::value, ""); + static_assert(is_same<int&, decltype(g(x))>::value, ""); + return x; + } + + } + +} // namespace cxx14 + + + + +/* We don't want compiler-specific tests for R so these conditional + tests are commented out. + + For C++17 features supported by compiler see + https://gcc.gnu.org/projects/cxx-status.html#cxx1z for gcc + http://clang.llvm.org/cxx_status.html for clang + http://en.cppreference.com/w/cpp/compiler_support for an overview + +#if defined(__clang__) + #define REALLY_CLANG +#else + #if defined(__GNUC__) + #define REALLY_GCC + #endif +#endif +*/ + +#include <initializer_list> +#include <utility> +#include <type_traits> + +namespace cxx17 +{ + +/* Not listed as supported by clang 4 - MTP +#if !defined(REALLY_CLANG) + namespace test_constexpr_lambdas + { + + // TODO: test it with clang++ from git + + constexpr int foo = [](){return 42;}(); + + } +#endif // !defined(REALLY_CLANG) +*/ + + namespace test::nested_namespace::definitions + { + + } + + namespace test_fold_expression + { + + template<typename... Args> + int multiply(Args... args) + { + return (args * ... * 1); + } + + template<typename... Args> + bool all(Args... args) + { + return (args && ...); + } + + } + + namespace test_extended_static_assert + { + + static_assert (true); + + } + + namespace test_auto_brace_init_list + { + + auto foo = {5}; + auto bar {5}; + + static_assert(std::is_same<std::initializer_list<int>, decltype(foo)>::value); + static_assert(std::is_same<int, decltype(bar)>::value); + } + + namespace test_typename_in_template_template_parameter + { + + template<template<typename> typename X> struct D; + + } + + namespace test_fallthrough_nodiscard_maybe_unused_attributes + { + + int f1() + { + return 42; + } + + [[nodiscard]] int f2() + { + [[maybe_unused]] auto unused = f1(); + + switch (f1()) + { + case 17: + f1(); + [[fallthrough]]; + case 42: + f1(); + } + return f1(); + } + + } + + namespace test_extended_aggregate_initialization + { + + struct base1 + { + int b1, b2 = 42; + }; + + struct base2 + { + base2() { + b3 = 42; + } + int b3; + }; + + struct derived : base1, base2 + { + int d; + }; + + derived d1 {{1, 2}, {}, 4}; // full initialization + derived d2 {{}, {}, 4}; // value-initialized bases + + } + + namespace test_general_range_based_for_loop + { + + struct iter + { + int i; + + int& operator* () + { + return i; + } + + const int& operator* () const + { + return i; + } + + iter& operator++() + { + ++i; + return *this; + } + }; + + struct sentinel + { + int i; + }; + + bool operator== (const iter& i, const sentinel& s) + { + return i.i == s.i; + } + + bool operator!= (const iter& i, const sentinel& s) + { + return !(i == s); + } + + struct range + { + iter begin() const + { + return {0}; + } + + sentinel end() const + { + return {5}; + } + }; + + void f() + { + range r {}; + + for (auto i : r) + { + [[maybe_unused]] auto v = i; + } + } + + } + + namespace test_lambda_capture_asterisk_this_by_value + { + + struct t + { + int i; + int foo() + { + return [*this]() + { + return i; + }(); + } + }; + + } + + namespace test_enum_class_construction + { + + enum class byte : unsigned char + {}; + + byte foo {42}; + + } + + namespace test_constexpr_if + { + + template <bool cond> + int f () + { + if constexpr(cond) + { + return 13; + } + else + { + return 42; + } + } + + } + + namespace test_selection_statement_with_initializer + { + + int f() + { + return 13; + } + + int f2() + { + if (auto i = f(); i > 0) + { + return 3; + } + + switch (auto i = f(); i + 4) + { + case 17: + return 2; + + default: + return 1; + } + } + + } + +/* P0091R3 not supported by clang 4.0.0 - MTP +#if !defined(REALLY_CLANG) + namespace test_template_argument_deduction_for_class_templates + { + + // TODO: test it with clang++ from git + + template <typename T1, typename T2> + struct pair + { + pair (T1 p1, T2 p2) + : m1 {p1}, + m2 {p2} + {} + + T1 m1; + T2 m2; + }; + + void f() + { + [[maybe_unused]] auto p = pair{13, 42u}; + } + + } +#endif // !defined(REALLY_CLANG) +*/ + + namespace test_non_type_auto_template_parameters + { + + template <auto n> + struct B + {}; + + B<5> b1; + B<'a'> b2; + + } + +/* P0217R3 should be supported in clang 4.0.0, but test code dumps core + In addition, gcc 7.0.1 fails on the last test - MTP +#if !defined(REALLY_CLANG) + namespace test_structured_bindings + { + + // TODO: test it with clang++ from git + + int arr[2] = { 1, 2 }; + std::pair<int, int> pr = { 1, 2 }; + + auto f1() -> int(&)[2] + { + return arr; + } + + auto f2() -> std::pair<int, int>& + { + return pr; + } + + struct S + { + int x1 : 2; + volatile double y1; + }; + + S f3() + { + return {}; + } + + auto [ x1, y1 ] = f1(); + auto& [ xr1, yr1 ] = f1(); + auto [ x2, y2 ] = f2(); + auto& [ xr2, yr2 ] = f2(); + const auto [ x3, y3 ] = f3(); + + } +#endif // !defined(REALLY_CLANG) +*/ + +/* + P0012R1 is supported by clang 4.0.0 - MTP + #if !defined(REALLY_CLANG) +*/ + namespace test_exception_spec_type_system + { + + // TODO: test it with clang++ from git + + struct Good {}; + struct Bad {}; + + void g1() noexcept; + void g2(); + + template<typename T> + Bad + f(T*, T*); + + template<typename T1, typename T2> + Good + f(T1*, T2*); + + static_assert (std::is_same_v<Good, decltype(f(g1, g2))>); + + } +/* + #endif // !defined(REALLY_CLANG) +*/ + + namespace test_inline_variables + { + + template<class T> void f(T) + {} + + template<class T> inline T g(T) + { + return T{}; + } + + template<> inline void f<>(int) + {} + + template<> int g<>(int) + { + return 5; + } + + } + +} // namespace cxx17 + + +#endif + +_ACEOF +if ac_fn_cxx_try_compile "$LINENO"; then : + eval $cachevar=yes +else + eval $cachevar=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + CXX="$ac_save_CXX" +fi +eval ac_res=\$$cachevar + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } + if eval test x\$$cachevar = xyes; then + CXX="$CXX $switch" + if test -n "$CXXCPP" ; then + CXXCPP="$CXXCPP $switch" + fi + ac_success=yes + break + fi + done + if test x$ac_success = xyes; then + break + fi + done + fi + ac_ext=cpp +ac_cpp='$CXXCPP $CPPFLAGS' +ac_compile='$CXX -c $CXXFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CXX -o conftest$ac_exeext $CXXFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_cxx_compiler_gnu + + if test x$ax_cxx_compile_cxx17_required = xtrue; then + if test x$ac_success = xno; then + as_fn_error $? "*** A compiler with support for C++17 language features is required." "$LINENO" 5 + fi + fi + if test x$ac_success = xno; then + HAVE_CXX17=0 + { $as_echo "$as_me:${as_lineno-$LINENO}: No compiler with C++17 support was found" >&5 +$as_echo "$as_me: No compiler with C++17 support was found" >&6;} + else + HAVE_CXX17=1 + fi + + +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu +CXX="${r_save_CXX}" +CXXFLAGS="${r_save_CXXFLAGS}" +if test "${HAVE_CXX17}" = "1"; then + if test "${CXX17STD}"x = "x"; then + CXX17STD="${switch}" + else + CXX17STD="${CXX17STD} ${switch}" + fi +else + CXX17="" + CXX17STD="" + CXX17FLAGS="" + CXX17PICFLAGS="" +fi + + + + + +if test -z "${SHLIB_CXX17LD}"; then + SHLIB_CXX17LD="\$(CXX17) \$(CXX17STD)" +fi + +: ${SHLIB_CXX17LDFLAGS=${SHLIB_CXX14LDFLAGS}} + + + + + + + + + + +### OpenMP. + +## The basic checking is performed via AC_OPENMP added in Autoconf 2.62, +## which we already called for determining the appropriate flags for the +## C, C++, Fortran 77, Fortran compiler/linker. Note that this gives +## variables OPENMP_CFLAGS etc., which are meant to be used for *both* +## compiling and linking. So we can really only used them provided that +## we use the respective compilers for linking as well (or we need a +## different mechanism for determining what is needed). +## +## For compiling R itself, we use MAIN_LD and DYLIB_LD for linking, both +## defaulting to CC. Hence: +## +## If both MAIN_LD and DYLIB_LD were not specified by the user and +## equal CC and this was determined to support OpenMP, then we (try +## to) provide OpenMP support by adding OPENMP_CFLAGS to the linker +## flags and OPENMP_CFLAGS and OPENMP_FFLAGS to the C and Fortran 77 +## compiler flags, and defining HAVE_OPENMP. +## +## (The Fortran 77 compiler is never used for linking by default.) + +if test -n "${R_OPENMP_CFLAGS+set}"; then + if test -n "${R_OPENMP_CFLAGS}"; then + separator="" +test -z "${separator}" && separator=" " +if test -z "${MAIN_LDFLAGS}"; then + MAIN_LDFLAGS="${R_OPENMP_CFLAGS}" +else + MAIN_LDFLAGS="${MAIN_LDFLAGS}${separator}${R_OPENMP_CFLAGS}" +fi + separator="" +test -z "${separator}" && separator=" " +if test -z "${DYLIB_LDFLAGS}"; then + DYLIB_LDFLAGS="${R_OPENMP_CFLAGS}" +else + DYLIB_LDFLAGS="${DYLIB_LDFLAGS}${separator}${R_OPENMP_CFLAGS}" +fi + +$as_echo "#define HAVE_OPENMP 1" >>confdefs.h + + fi +elif test "x${main_ld_was_given}" = xno -a "${MAIN_LD}" = "\$(CC)" -a \ + "x${dylib_ld_was_given}" = xno -a "${DYLIB_LD}" = "\$(CC)" -a \ + "x${ac_cv_prog_c_openmp}" != "xunsupported"; then + R_OPENMP_CFLAGS="${OPENMP_CFLAGS}" + separator="" +test -z "${separator}" && separator=" " +if test -z "${MAIN_LDFLAGS}"; then + MAIN_LDFLAGS="${OPENMP_CFLAGS}" +else + MAIN_LDFLAGS="${MAIN_LDFLAGS}${separator}${OPENMP_CFLAGS}" +fi + separator="" +test -z "${separator}" && separator=" " +if test -z "${DYLIB_LDFLAGS}"; then + DYLIB_LDFLAGS="${OPENMP_CFLAGS}" +else + DYLIB_LDFLAGS="${DYLIB_LDFLAGS}${separator}${OPENMP_CFLAGS}" +fi + +$as_echo "#define HAVE_OPENMP 1" >>confdefs.h + +else + R_OPENMP_CFLAGS= +fi +## Currently unused: see comment in Makeconf.in +if test -z "${R_OPENMP_FFLAGS+set}" -a \ + "x${ac_cv_prog_f77_openmp}" != "xunsupported"; then + R_OPENMP_FFLAGS="${OPENMP_FFLAGS}" +fi + + + +## For compiling package code, we use SHLIB_FCLD, SHLIB_CXXLD or +## SHLIB_LD for linking, depending on whether the package contains +## Fortran (90/95) code, C++ (or ObjC) code, or "just" C and Fortran 77. +## However, we (currently) do not conditionalize compilation flags. So +## the only "safe" thing we can do for now is: +## +## If none of SHLIB_LD, SHLIB_CXXLD and SHLIB_FCLD were specified by +## the user and equal CC, CXX and FC, respectively, and these were +## determined to support OpenMP, the we try to provide OpenMP support +## for packages by adding OPENMP_FCFLAGS, OPENMP_CXXFLAGS and +## OPENMP_CFLAGS to the respective linker flags, and add the OPENMP +## flags to all (C, C++, Fortran and Fortran 77) compiler flags. + +## <FIXME> +## Need to do this after configuring Fortran 90/95 support, which comes +## way below: should this be moved up to the compiler section? +## </FIXME> + +### Now we have found all the flags, we need to use them to test appropriately. +### We don't currently have any C++ tests, but future-proof. +### In principle we should do this before testing for C-Fortran compatibility. + +CPPFLAGS_KEEP=${CPPFLAGS} +CFLAGS_KEEP=${CFLAGS} +FFLAGS_KEEP=${FFLAGS} +CXXFLAGS_KEEP=${CXXFLAGS} +CPPFLAGS="${CPPFLAGS} ${R_XTRA_CPPFLAGS}" +if test "${want_R_shlib}" = yes; then + CFLAGS="${CFLAGS} ${CPICFLAGS} ${R_XTRA_CFLAGS}" + FFLAGS="${FFLAGS} ${FPICFLAGS} ${R_XTRA_FFLAGS}" + CXXFLAGS="${CXXFLAGS} ${CXXPICFLAGS} ${R_XTRA_CXXFLAGS}" +else + CFLAGS="${CFLAGS} ${R_XTRA_CFLAGS}" + FFLAGS="${FFLAGS} ${R_XTRA_FFLAGS}" + CXXFLAGS="${CXXFLAGS} ${R_XTRA_CXXFLAGS}" +fi + +### * Checks for library functions. + +ac_fn_c_check_type "$LINENO" "off_t" "ac_cv_type_off_t" "$ac_includes_default" +if test "x$ac_cv_type_off_t" = xyes; then : + +cat >>confdefs.h <<_ACEOF +#define HAVE_OFF_T 1 +_ACEOF + + +fi + +# The Ultrix 4.2 mips builtin alloca declared by alloca.h only works +# for constant arguments. Useless! +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for working alloca.h" >&5 +$as_echo_n "checking for working alloca.h... " >&6; } +if ${ac_cv_working_alloca_h+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <alloca.h> +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +char *p = (char *) alloca (2 * sizeof (int)); + if (p) return 0; + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_working_alloca_h=yes +else + ac_cv_working_alloca_h=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_working_alloca_h" >&5 +$as_echo "$ac_cv_working_alloca_h" >&6; } +if test $ac_cv_working_alloca_h = yes; then + +$as_echo "#define HAVE_ALLOCA_H 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for alloca" >&5 +$as_echo_n "checking for alloca... " >&6; } +if ${ac_cv_func_alloca_works+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#ifdef __GNUC__ +# define alloca __builtin_alloca +#else +# ifdef _MSC_VER +# include <malloc.h> +# define alloca _alloca +# else +# ifdef HAVE_ALLOCA_H +# include <alloca.h> +# else +# ifdef _AIX + #pragma alloca +# else +# ifndef alloca /* predefined by HP cc +Olibcalls */ +void *alloca (size_t); +# endif +# endif +# endif +# endif +#endif + +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +char *p = (char *) alloca (1); + if (p) return 0; + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_func_alloca_works=yes +else + ac_cv_func_alloca_works=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_func_alloca_works" >&5 +$as_echo "$ac_cv_func_alloca_works" >&6; } + +if test $ac_cv_func_alloca_works = yes; then + +$as_echo "#define HAVE_ALLOCA 1" >>confdefs.h + +else + # The SVR3 libPW and SVR4 libucb both contain incompatible functions +# that cause trouble. Some versions do not even contain alloca or +# contain a buggy version. If you still want to use their alloca, +# use ar to extract alloca.o from them instead of compiling alloca.c. + +ALLOCA=\${LIBOBJDIR}alloca.$ac_objext + +$as_echo "#define C_ALLOCA 1" >>confdefs.h + + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether \`alloca.c' needs Cray hooks" >&5 +$as_echo_n "checking whether \`alloca.c' needs Cray hooks... " >&6; } +if ${ac_cv_os_cray+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#if defined CRAY && ! defined CRAY2 +webecray +#else +wenotbecray +#endif + +_ACEOF +if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | + $EGREP "webecray" >/dev/null 2>&1; then : + ac_cv_os_cray=yes +else + ac_cv_os_cray=no +fi +rm -f conftest* + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_os_cray" >&5 +$as_echo "$ac_cv_os_cray" >&6; } +if test $ac_cv_os_cray = yes; then + for ac_func in _getb67 GETB67 getb67; do + as_ac_var=`$as_echo "ac_cv_func_$ac_func" | $as_tr_sh` +ac_fn_c_check_func "$LINENO" "$ac_func" "$as_ac_var" +if eval test \"x\$"$as_ac_var"\" = x"yes"; then : + +cat >>confdefs.h <<_ACEOF +#define CRAY_STACKSEG_END $ac_func +_ACEOF + + break +fi + + done +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking stack direction for C alloca" >&5 +$as_echo_n "checking stack direction for C alloca... " >&6; } +if ${ac_cv_c_stack_direction+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test "$cross_compiling" = yes; then : + ac_cv_c_stack_direction=0 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +$ac_includes_default +int +find_stack_direction (int *addr, int depth) +{ + int dir, dummy = 0; + if (! addr) + addr = &dummy; + *addr = addr < &dummy ? 1 : addr == &dummy ? 0 : -1; + dir = depth ? find_stack_direction (addr, depth - 1) : 0; + return dir + dummy; +} + +int +main (int argc, char **argv) +{ + return find_stack_direction (0, argc + !argv + 20) < 0; +} +_ACEOF +if ac_fn_c_try_run "$LINENO"; then : + ac_cv_c_stack_direction=1 +else + ac_cv_c_stack_direction=-1 +fi +rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ + conftest.$ac_objext conftest.beam conftest.$ac_ext +fi + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_c_stack_direction" >&5 +$as_echo "$ac_cv_c_stack_direction" >&6; } +cat >>confdefs.h <<_ACEOF +#define STACK_DIRECTION $ac_cv_c_stack_direction +_ACEOF + + +fi + +ac_fn_c_check_decl "$LINENO" "alloca" "ac_cv_have_decl_alloca" "#ifdef HAVE_ALLOCA_H +# include <alloca.h> +#endif +" +if test "x$ac_cv_have_decl_alloca" = xyes; then : + ac_have_decl=1 +else + ac_have_decl=0 +fi + +cat >>confdefs.h <<_ACEOF +#define HAVE_DECL_ALLOCA $ac_have_decl +_ACEOF + + +## C99 functions: +## not all C99 runtimes are complete, +## but we have substitutes for expm1 hypot log1p and (internally) nearbyint[l] +## FreeBSD used to lack log1pl, but 10 seems to have it. +## FreeBSD 8.2 lacks log2 +## FreeBSD 7.3 lacks nearbyintl/rintl (nearbyint appeared in 5.2) +## Apparently rint was once broken on HP-UX: undefine HAVE_RINT for such platforms +## Cygwin and FreeBSD lacked powl (FreeBSD 10 seems to have it). +## Cygwin had rintl but not nearbyintl +for ac_func in expm1 hypot log1p log1pl log2 log10 nearbyint nearbyintl powl rint rintl +do +as_ac_Symbol=`$as_echo "ac_cv_have_decl_$ac_func" | $as_tr_sh` +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $ac_func exists and is declared" >&5 +$as_echo_n "checking whether $ac_func exists and is declared... " >&6; } +if eval \${$as_ac_Symbol+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <math.h> + +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +#ifndef $ac_func + char *p = (char *) $ac_func; +#endif + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + eval "$as_ac_Symbol=yes" +else + eval "$as_ac_Symbol=no" +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +fi +eval ac_res=\$$as_ac_Symbol + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } +if test `eval 'as_val=${'$as_ac_Symbol'};$as_echo "$as_val"'` = yes; then : + cat >>confdefs.h <<_ACEOF +#define `$as_echo "HAVE_$ac_func" | $as_tr_cpp` 1 +_ACEOF + +fi +done + +## va_copy is C99: required as from R 2.13.0 +for ac_func in va_copy +do +as_ac_Symbol=`$as_echo "ac_cv_have_decl_$ac_func" | $as_tr_sh` +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $ac_func exists and is declared" >&5 +$as_echo_n "checking whether $ac_func exists and is declared... " >&6; } +if eval \${$as_ac_Symbol+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <stdarg.h> + +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +#ifndef $ac_func + char *p = (char *) $ac_func; +#endif + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + eval "$as_ac_Symbol=yes" +else + eval "$as_ac_Symbol=no" +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +fi +eval ac_res=\$$as_ac_Symbol + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } +if test `eval 'as_val=${'$as_ac_Symbol'};$as_echo "$as_val"'` = yes; then : + cat >>confdefs.h <<_ACEOF +#define `$as_echo "HAVE_$ac_func" | $as_tr_cpp` 1 +_ACEOF + +fi +done + +if test "${ac_cv_have_decl_va_copy}" = "no"; then + as_fn_error $? "Building R requires the 'va_copy' system call" "$LINENO" 5 +fi +## isblank should be a macro according to C99. It was missing on Solaris 8 +for ac_func in isblank +do : + ac_fn_c_check_func "$LINENO" "isblank" "ac_cv_func_isblank" +if test "x$ac_cv_func_isblank" = xyes; then : + cat >>confdefs.h <<_ACEOF +#define HAVE_ISBLANK 1 +_ACEOF + +fi +done + + +## Solaris libsunmath +for ac_header in sunmath.h +do : + ac_fn_c_check_header_mongrel "$LINENO" "sunmath.h" "ac_cv_header_sunmath_h" "$ac_includes_default" +if test "x$ac_cv_header_sunmath_h" = xyes; then : + cat >>confdefs.h <<_ACEOF +#define HAVE_SUNMATH_H 1 +_ACEOF + +fi + +done + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for cospi in -lsunmath" >&5 +$as_echo_n "checking for cospi in -lsunmath... " >&6; } +if ${ac_cv_lib_sunmath_cospi+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lsunmath $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char cospi (); +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +return cospi (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_sunmath_cospi=yes +else + ac_cv_lib_sunmath_cospi=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_sunmath_cospi" >&5 +$as_echo "$ac_cv_lib_sunmath_cospi" >&6; } +if test "x$ac_cv_lib_sunmath_cospi" = xyes; then : + cat >>confdefs.h <<_ACEOF +#define HAVE_LIBSUNMATH 1 +_ACEOF + + LIBS="-lsunmath $LIBS" + +fi + + +## Functions from ISO/IEC TS 18661-4:2015 C11 extensions. +## For now, do not define _GNU_SOURCE here. +## All but pown have long been in Solaris' libsunmath +## macOS has __cospi __sinpi __tanpi +for ac_func in atanpi atan2pi cospi exp10 pown sinpi tanpi __cospi __sinpi __tanpi +do : + as_ac_var=`$as_echo "ac_cv_func_$ac_func" | $as_tr_sh` +ac_fn_c_check_func "$LINENO" "$ac_func" "$as_ac_var" +if eval test \"x\$"$as_ac_var"\" = x"yes"; then : + cat >>confdefs.h <<_ACEOF +#define `$as_echo "HAVE_$ac_func" | $as_tr_cpp` 1 +_ACEOF + #define __STDC_WANT_IEC_60559_FUNCS_EXT__ 1 +#include <math.h> +#ifdef HAVE_SUNMATH_H +#include <sunmath.h> +#endif +fi +done + + +## fseeko/ftello are POSIX, may be macros +## matherr is SVID, redefined in arithmetic.c if present +for ac_func in fseeko ftello matherr +do : + as_ac_var=`$as_echo "ac_cv_func_$ac_func" | $as_tr_sh` +ac_fn_c_check_func "$LINENO" "$ac_func" "$as_ac_var" +if eval test \"x\$"$as_ac_var"\" = x"yes"; then : + cat >>confdefs.h <<_ACEOF +#define `$as_echo "HAVE_$ac_func" | $as_tr_cpp` 1 +_ACEOF + +fi +done + + +## POSIX functions +for ac_func in fcntl +do +as_ac_Symbol=`$as_echo "ac_cv_have_decl_$ac_func" | $as_tr_sh` +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $ac_func exists and is declared" >&5 +$as_echo_n "checking whether $ac_func exists and is declared... " >&6; } +if eval \${$as_ac_Symbol+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <fcntl.h> + +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +#ifndef $ac_func + char *p = (char *) $ac_func; +#endif + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + eval "$as_ac_Symbol=yes" +else + eval "$as_ac_Symbol=no" +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +fi +eval ac_res=\$$as_ac_Symbol + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } +if test `eval 'as_val=${'$as_ac_Symbol'};$as_echo "$as_val"'` = yes; then : + cat >>confdefs.h <<_ACEOF +#define `$as_echo "HAVE_$ac_func" | $as_tr_cpp` 1 +_ACEOF + +fi +done + +for ac_func in getgrgid +do +as_ac_Symbol=`$as_echo "ac_cv_have_decl_$ac_func" | $as_tr_sh` +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $ac_func exists and is declared" >&5 +$as_echo_n "checking whether $ac_func exists and is declared... " >&6; } +if eval \${$as_ac_Symbol+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <grp.h> + +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +#ifndef $ac_func + char *p = (char *) $ac_func; +#endif + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + eval "$as_ac_Symbol=yes" +else + eval "$as_ac_Symbol=no" +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +fi +eval ac_res=\$$as_ac_Symbol + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } +if test `eval 'as_val=${'$as_ac_Symbol'};$as_echo "$as_val"'` = yes; then : + cat >>confdefs.h <<_ACEOF +#define `$as_echo "HAVE_$ac_func" | $as_tr_cpp` 1 +_ACEOF + +fi +done + +for ac_func in getpwuid +do +as_ac_Symbol=`$as_echo "ac_cv_have_decl_$ac_func" | $as_tr_sh` +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $ac_func exists and is declared" >&5 +$as_echo_n "checking whether $ac_func exists and is declared... " >&6; } +if eval \${$as_ac_Symbol+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <pwd.h> + +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +#ifndef $ac_func + char *p = (char *) $ac_func; +#endif + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + eval "$as_ac_Symbol=yes" +else + eval "$as_ac_Symbol=no" +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +fi +eval ac_res=\$$as_ac_Symbol + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } +if test `eval 'as_val=${'$as_ac_Symbol'};$as_echo "$as_val"'` = yes; then : + cat >>confdefs.h <<_ACEOF +#define `$as_echo "HAVE_$ac_func" | $as_tr_cpp` 1 +_ACEOF + +fi +done + +for ac_func in kill sigaction sigaltstack sigemptyset +do +as_ac_Symbol=`$as_echo "ac_cv_have_decl_$ac_func" | $as_tr_sh` +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $ac_func exists and is declared" >&5 +$as_echo_n "checking whether $ac_func exists and is declared... " >&6; } +if eval \${$as_ac_Symbol+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <signal.h> + +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +#ifndef $ac_func + char *p = (char *) $ac_func; +#endif + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + eval "$as_ac_Symbol=yes" +else + eval "$as_ac_Symbol=no" +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +fi +eval ac_res=\$$as_ac_Symbol + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } +if test `eval 'as_val=${'$as_ac_Symbol'};$as_echo "$as_val"'` = yes; then : + cat >>confdefs.h <<_ACEOF +#define `$as_echo "HAVE_$ac_func" | $as_tr_cpp` 1 +_ACEOF + +fi +done + +for ac_func in fdopen popen +do +as_ac_Symbol=`$as_echo "ac_cv_have_decl_$ac_func" | $as_tr_sh` +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $ac_func exists and is declared" >&5 +$as_echo_n "checking whether $ac_func exists and is declared... " >&6; } +if eval \${$as_ac_Symbol+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <stdio.h> + +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +#ifndef $ac_func + char *p = (char *) $ac_func; +#endif + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + eval "$as_ac_Symbol=yes" +else + eval "$as_ac_Symbol=no" +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +fi +eval ac_res=\$$as_ac_Symbol + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } +if test `eval 'as_val=${'$as_ac_Symbol'};$as_echo "$as_val"'` = yes; then : + cat >>confdefs.h <<_ACEOF +#define `$as_echo "HAVE_$ac_func" | $as_tr_cpp` 1 +_ACEOF + +fi +done + +if test "${ac_cv_have_decl_popen}" = "no"; then + as_fn_error $? "Building R requires the 'popen' system call" "$LINENO" 5 +fi +for ac_func in getline +do +as_ac_Symbol=`$as_echo "ac_cv_have_decl_$ac_func" | $as_tr_sh` +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $ac_func exists and is declared" >&5 +$as_echo_n "checking whether $ac_func exists and is declared... " >&6; } +if eval \${$as_ac_Symbol+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <stdio.h> + +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +#ifndef $ac_func + char *p = (char *) $ac_func; +#endif + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + eval "$as_ac_Symbol=yes" +else + eval "$as_ac_Symbol=no" +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +fi +eval ac_res=\$$as_ac_Symbol + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } +if test `eval 'as_val=${'$as_ac_Symbol'};$as_echo "$as_val"'` = yes; then : + cat >>confdefs.h <<_ACEOF +#define `$as_echo "HAVE_$ac_func" | $as_tr_cpp` 1 +_ACEOF + +fi +done + +for ac_func in select +do +as_ac_Symbol=`$as_echo "ac_cv_have_decl_$ac_func" | $as_tr_sh` +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $ac_func exists and is declared" >&5 +$as_echo_n "checking whether $ac_func exists and is declared... " >&6; } +if eval \${$as_ac_Symbol+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#ifdef HAVE_SYS_SELECT_H +#include <sys/select.h> /* POSIX >= 2001 */ +#endif +#ifdef HAVE_SYS_TIME_H +#include <sys/time.h> /* Earlier POSIX, HP-UX? */ +#endif + +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +#ifndef $ac_func + char *p = (char *) $ac_func; +#endif + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + eval "$as_ac_Symbol=yes" +else + eval "$as_ac_Symbol=no" +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +fi +eval ac_res=\$$as_ac_Symbol + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } +if test `eval 'as_val=${'$as_ac_Symbol'};$as_echo "$as_val"'` = yes; then : + cat >>confdefs.h <<_ACEOF +#define `$as_echo "HAVE_$ac_func" | $as_tr_cpp` 1 +_ACEOF + +fi +done + +case "${host_os}" in + mingw*|windows*|winnt) + ;; + *) + if test "${ac_cv_have_decl_select}" = "no"; then + as_fn_error $? "Building R on Unix requires the 'select' system call" "$LINENO" 5 + fi + if test "${ac_cv_header_sys_select_h}" = "no" -a "${ac_cv_header_sys_times_h} = "no""; then + as_fn_error $? "Building R on Unix requires either <sys/select.h> or <sys/time.h>" "$LINENO" 5 + fi + ;; +esac +## Windows has neither setenv nor unsetenv +for ac_func in setenv unsetenv +do +as_ac_Symbol=`$as_echo "ac_cv_have_decl_$ac_func" | $as_tr_sh` +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $ac_func exists and is declared" >&5 +$as_echo_n "checking whether $ac_func exists and is declared... " >&6; } +if eval \${$as_ac_Symbol+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <stdlib.h> + +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +#ifndef $ac_func + char *p = (char *) $ac_func; +#endif + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + eval "$as_ac_Symbol=yes" +else + eval "$as_ac_Symbol=no" +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +fi +eval ac_res=\$$as_ac_Symbol + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } +if test `eval 'as_val=${'$as_ac_Symbol'};$as_echo "$as_val"'` = yes; then : + cat >>confdefs.h <<_ACEOF +#define `$as_echo "HAVE_$ac_func" | $as_tr_cpp` 1 +_ACEOF + +fi +done + +for ac_func in getrlimit getrusage getpriority +do +as_ac_Symbol=`$as_echo "ac_cv_have_decl_$ac_func" | $as_tr_sh` +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $ac_func exists and is declared" >&5 +$as_echo_n "checking whether $ac_func exists and is declared... " >&6; } +if eval \${$as_ac_Symbol+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <sys/resource.h> + +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +#ifndef $ac_func + char *p = (char *) $ac_func; +#endif + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + eval "$as_ac_Symbol=yes" +else + eval "$as_ac_Symbol=no" +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +fi +eval ac_res=\$$as_ac_Symbol + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } +if test `eval 'as_val=${'$as_ac_Symbol'};$as_echo "$as_val"'` = yes; then : + cat >>confdefs.h <<_ACEOF +#define `$as_echo "HAVE_$ac_func" | $as_tr_cpp` 1 +_ACEOF + +fi +done + +for ac_func in chmod mkfifo stat umask +do +as_ac_Symbol=`$as_echo "ac_cv_have_decl_$ac_func" | $as_tr_sh` +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $ac_func exists and is declared" >&5 +$as_echo_n "checking whether $ac_func exists and is declared... " >&6; } +if eval \${$as_ac_Symbol+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <sys/stat.h> + +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +#ifndef $ac_func + char *p = (char *) $ac_func; +#endif + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + eval "$as_ac_Symbol=yes" +else + eval "$as_ac_Symbol=no" +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +fi +eval ac_res=\$$as_ac_Symbol + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } +if test `eval 'as_val=${'$as_ac_Symbol'};$as_echo "$as_val"'` = yes; then : + cat >>confdefs.h <<_ACEOF +#define `$as_echo "HAVE_$ac_func" | $as_tr_cpp` 1 +_ACEOF + +fi +done + +if test "${ac_cv_have_decl_stat}" = "no"; then + as_fn_error $? "Building R requires the 'stat' system call" "$LINENO" 5 +fi +for ac_func in gettimeofday utimes +do +as_ac_Symbol=`$as_echo "ac_cv_have_decl_$ac_func" | $as_tr_sh` +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $ac_func exists and is declared" >&5 +$as_echo_n "checking whether $ac_func exists and is declared... " >&6; } +if eval \${$as_ac_Symbol+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <sys/time.h> + +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +#ifndef $ac_func + char *p = (char *) $ac_func; +#endif + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + eval "$as_ac_Symbol=yes" +else + eval "$as_ac_Symbol=no" +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +fi +eval ac_res=\$$as_ac_Symbol + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } +if test `eval 'as_val=${'$as_ac_Symbol'};$as_echo "$as_val"'` = yes; then : + cat >>confdefs.h <<_ACEOF +#define `$as_echo "HAVE_$ac_func" | $as_tr_cpp` 1 +_ACEOF + +fi +done + +for ac_func in times +do +as_ac_Symbol=`$as_echo "ac_cv_have_decl_$ac_func" | $as_tr_sh` +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $ac_func exists and is declared" >&5 +$as_echo_n "checking whether $ac_func exists and is declared... " >&6; } +if eval \${$as_ac_Symbol+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <sys/times.h> + +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +#ifndef $ac_func + char *p = (char *) $ac_func; +#endif + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + eval "$as_ac_Symbol=yes" +else + eval "$as_ac_Symbol=no" +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +fi +eval ac_res=\$$as_ac_Symbol + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } +if test `eval 'as_val=${'$as_ac_Symbol'};$as_echo "$as_val"'` = yes; then : + cat >>confdefs.h <<_ACEOF +#define `$as_echo "HAVE_$ac_func" | $as_tr_cpp` 1 +_ACEOF + +fi +done + +for ac_func in gmtime_r localtime_r +do +as_ac_Symbol=`$as_echo "ac_cv_have_decl_$ac_func" | $as_tr_sh` +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $ac_func exists and is declared" >&5 +$as_echo_n "checking whether $ac_func exists and is declared... " >&6; } +if eval \${$as_ac_Symbol+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <time.h> + +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +#ifndef $ac_func + char *p = (char *) $ac_func; +#endif + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + eval "$as_ac_Symbol=yes" +else + eval "$as_ac_Symbol=no" +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +fi +eval ac_res=\$$as_ac_Symbol + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } +if test `eval 'as_val=${'$as_ac_Symbol'};$as_echo "$as_val"'` = yes; then : + cat >>confdefs.h <<_ACEOF +#define `$as_echo "HAVE_$ac_func" | $as_tr_cpp` 1 +_ACEOF + +fi +done + +for ac_func in nl_langinfo +do +as_ac_Symbol=`$as_echo "ac_cv_have_decl_$ac_func" | $as_tr_sh` +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $ac_func exists and is declared" >&5 +$as_echo_n "checking whether $ac_func exists and is declared... " >&6; } +if eval \${$as_ac_Symbol+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <langinfo.h> + +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +#ifndef $ac_func + char *p = (char *) $ac_func; +#endif + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + eval "$as_ac_Symbol=yes" +else + eval "$as_ac_Symbol=no" +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +fi +eval ac_res=\$$as_ac_Symbol + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } +if test `eval 'as_val=${'$as_ac_Symbol'};$as_echo "$as_val"'` = yes; then : + cat >>confdefs.h <<_ACEOF +#define `$as_echo "HAVE_$ac_func" | $as_tr_cpp` 1 +_ACEOF + +fi +done + +for ac_func in access chdir execv ftruncate getcwd geteuid getuid link readlink symlink sysconf +do +as_ac_Symbol=`$as_echo "ac_cv_have_decl_$ac_func" | $as_tr_sh` +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $ac_func exists and is declared" >&5 +$as_echo_n "checking whether $ac_func exists and is declared... " >&6; } +if eval \${$as_ac_Symbol+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#ifdef HAVE_UNISTD_H +# include <unistd.h> +#endif + +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +#ifndef $ac_func + char *p = (char *) $ac_func; +#endif + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + eval "$as_ac_Symbol=yes" +else + eval "$as_ac_Symbol=no" +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +fi +eval ac_res=\$$as_ac_Symbol + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } +if test `eval 'as_val=${'$as_ac_Symbol'};$as_echo "$as_val"'` = yes; then : + cat >>confdefs.h <<_ACEOF +#define `$as_echo "HAVE_$ac_func" | $as_tr_cpp` 1 +_ACEOF + +fi +done + +## Linux-specific feature allowing us to fix CPU affinity for parallel +for ac_func in sched_setaffinity sched_getaffinity +do +as_ac_Symbol=`$as_echo "ac_cv_have_decl_$ac_func" | $as_tr_sh` +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $ac_func exists and is declared" >&5 +$as_echo_n "checking whether $ac_func exists and is declared... " >&6; } +if eval \${$as_ac_Symbol+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <sched.h> + +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +#ifndef $ac_func + char *p = (char *) $ac_func; +#endif + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + eval "$as_ac_Symbol=yes" +else + eval "$as_ac_Symbol=no" +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +fi +eval ac_res=\$$as_ac_Symbol + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } +if test `eval 'as_val=${'$as_ac_Symbol'};$as_echo "$as_val"'` = yes; then : + cat >>confdefs.h <<_ACEOF +#define `$as_echo "HAVE_$ac_func" | $as_tr_cpp` 1 +_ACEOF + +fi +done + +## utime was declared obsolescent in POSIX 2008 (use utimes instead) +for ac_func in utime +do +as_ac_Symbol=`$as_echo "ac_cv_have_decl_$ac_func" | $as_tr_sh` +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $ac_func exists and is declared" >&5 +$as_echo_n "checking whether $ac_func exists and is declared... " >&6; } +if eval \${$as_ac_Symbol+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <utime.h> + +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +#ifndef $ac_func + char *p = (char *) $ac_func; +#endif + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + eval "$as_ac_Symbol=yes" +else + eval "$as_ac_Symbol=no" +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +fi +eval ac_res=\$$as_ac_Symbol + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } +if test `eval 'as_val=${'$as_ac_Symbol'};$as_echo "$as_val"'` = yes; then : + cat >>confdefs.h <<_ACEOF +#define `$as_echo "HAVE_$ac_func" | $as_tr_cpp` 1 +_ACEOF + +fi +done + +## POSIX.1-2008 preferred form +for ac_func in utimensat +do +as_ac_Symbol=`$as_echo "ac_cv_have_decl_$ac_func" | $as_tr_sh` +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $ac_func exists and is declared" >&5 +$as_echo_n "checking whether $ac_func exists and is declared... " >&6; } +if eval \${$as_ac_Symbol+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <sys/stat.h> + +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +#ifndef $ac_func + char *p = (char *) $ac_func; +#endif + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + eval "$as_ac_Symbol=yes" +else + eval "$as_ac_Symbol=no" +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +fi +eval ac_res=\$$as_ac_Symbol + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } +if test `eval 'as_val=${'$as_ac_Symbol'};$as_echo "$as_val"'` = yes; then : + cat >>confdefs.h <<_ACEOF +#define `$as_echo "HAVE_$ac_func" | $as_tr_cpp` 1 +_ACEOF + +fi +done + +## clock_gettime is POSIX 1993, but not on macOS prior to 10.12 (Sierra) +## Some OSes need -lrt: Linux (for glibc versions before 2.17), Solaris, +## not FreeBSD. +## Unsurprising, as POSIX 2008 moved it from its timers section to base. +## timespec_get is C11. +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for clock_gettime in -lrt" >&5 +$as_echo_n "checking for clock_gettime in -lrt... " >&6; } +if ${ac_cv_lib_rt_clock_gettime+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lrt $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char clock_gettime (); +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +return clock_gettime (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_rt_clock_gettime=yes +else + ac_cv_lib_rt_clock_gettime=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_rt_clock_gettime" >&5 +$as_echo "$ac_cv_lib_rt_clock_gettime" >&6; } +if test "x$ac_cv_lib_rt_clock_gettime" = xyes; then : + cat >>confdefs.h <<_ACEOF +#define HAVE_LIBRT 1 +_ACEOF + + LIBS="-lrt $LIBS" + +fi + +for ac_func in clock_gettime timespec_get +do +as_ac_Symbol=`$as_echo "ac_cv_have_decl_$ac_func" | $as_tr_sh` +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $ac_func exists and is declared" >&5 +$as_echo_n "checking whether $ac_func exists and is declared... " >&6; } +if eval \${$as_ac_Symbol+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <time.h> + +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +#ifndef $ac_func + char *p = (char *) $ac_func; +#endif + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + eval "$as_ac_Symbol=yes" +else + eval "$as_ac_Symbol=no" +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +fi +eval ac_res=\$$as_ac_Symbol + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } +if test `eval 'as_val=${'$as_ac_Symbol'};$as_echo "$as_val"'` = yes; then : + cat >>confdefs.h <<_ACEOF +#define `$as_echo "HAVE_$ac_func" | $as_tr_cpp` 1 +_ACEOF + +fi +done + +## We need setenv or putenv. It seems that everyone does have +## putenv, as earlier versions of R would have failed without it. +## It is not always declared, so we do not require a declaration. +for ac_func in putenv +do : + ac_fn_c_check_func "$LINENO" "putenv" "ac_cv_func_putenv" +if test "x$ac_cv_func_putenv" = xyes; then : + cat >>confdefs.h <<_ACEOF +#define HAVE_PUTENV 1 +_ACEOF + +fi +done + +ac_fn_c_check_decl "$LINENO" "putenv" "ac_cv_have_decl_putenv" "#include <stdlib.h> +" +if test "x$ac_cv_have_decl_putenv" = xyes; then : + ac_have_decl=1 +else + ac_have_decl=0 +fi + +cat >>confdefs.h <<_ACEOF +#define HAVE_DECL_PUTENV $ac_have_decl +_ACEOF + +## this is a GNU extension so usually hidden. Not in Solaris 10 +for ac_func in vasprintf +do : + ac_fn_c_check_func "$LINENO" "vasprintf" "ac_cv_func_vasprintf" +if test "x$ac_cv_func_vasprintf" = xyes; then : + cat >>confdefs.h <<_ACEOF +#define HAVE_VASPRINTF 1 +_ACEOF + +fi +done + +ac_fn_c_check_decl "$LINENO" "vasprintf" "ac_cv_have_decl_vasprintf" "#include <stdio.h> +" +if test "x$ac_cv_have_decl_vasprintf" = xyes; then : + ac_have_decl=1 +else + ac_have_decl=0 +fi + +cat >>confdefs.h <<_ACEOF +#define HAVE_DECL_VASPRINTF $ac_have_decl +_ACEOF + +## mempcpy is a GNU extension used by the included gettext. Not in Solaris 10 +for ac_func in mempcpy +do : + ac_fn_c_check_func "$LINENO" "mempcpy" "ac_cv_func_mempcpy" +if test "x$ac_cv_func_mempcpy" = xyes; then : + cat >>confdefs.h <<_ACEOF +#define HAVE_MEMPCPY 1 +_ACEOF + +fi +done + +## realpath is POSIX 2001 (and BSD) +## Some early GNU libc systems had it in unistd.h. +for ac_func in realpath +do : + ac_fn_c_check_func "$LINENO" "realpath" "ac_cv_func_realpath" +if test "x$ac_cv_func_realpath" = xyes; then : + cat >>confdefs.h <<_ACEOF +#define HAVE_REALPATH 1 +_ACEOF + +fi +done + +ac_fn_c_check_decl "$LINENO" "realpath" "ac_cv_have_decl_realpath" "#include <stdlib.h> +#ifdef HAVE_UNISTD_H +#include <unistd.h> +#endif +" +if test "x$ac_cv_have_decl_realpath" = xyes; then : + ac_have_decl=1 +else + ac_have_decl=0 +fi + +cat >>confdefs.h <<_ACEOF +#define HAVE_DECL_REALPATH $ac_have_decl +_ACEOF + +## glob is POSIX: we have a substitute on Windows +## assume without checking that if we have glob we also have globfree +for ac_func in glob +do +as_ac_Symbol=`$as_echo "ac_cv_have_decl_$ac_func" | $as_tr_sh` +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $ac_func exists and is declared" >&5 +$as_echo_n "checking whether $ac_func exists and is declared... " >&6; } +if eval \${$as_ac_Symbol+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#ifdef HAVE_GLOB_H +# include <glob.h> +#endif + +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +#ifndef $ac_func + char *p = (char *) $ac_func; +#endif + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + eval "$as_ac_Symbol=yes" +else + eval "$as_ac_Symbol=no" +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +fi +eval ac_res=\$$as_ac_Symbol + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } +if test `eval 'as_val=${'$as_ac_Symbol'};$as_echo "$as_val"'` = yes; then : + cat >>confdefs.h <<_ACEOF +#define `$as_echo "HAVE_$ac_func" | $as_tr_cpp` 1 +_ACEOF + +fi +done + +for ac_func in dladdr dlsym +do : + as_ac_var=`$as_echo "ac_cv_func_$ac_func" | $as_tr_sh` +ac_fn_c_check_func "$LINENO" "$ac_func" "$as_ac_var" +if eval test \"x\$"$as_ac_var"\" = x"yes"; then : + cat >>confdefs.h <<_ACEOF +#define `$as_echo "HAVE_$ac_func" | $as_tr_cpp` 1 +_ACEOF + +fi +done + +ac_fn_c_check_decl "$LINENO" "dladdr" "ac_cv_have_decl_dladdr" "#include<dlfcn.h> +" +if test "x$ac_cv_have_decl_dladdr" = xyes; then : + ac_have_decl=1 +else + ac_have_decl=0 +fi + +cat >>confdefs.h <<_ACEOF +#define HAVE_DECL_DLADDR $ac_have_decl +_ACEOF +ac_fn_c_check_decl "$LINENO" "dlsym" "ac_cv_have_decl_dlsym" "#include<dlfcn.h> +" +if test "x$ac_cv_have_decl_dlsym" = xyes; then : + ac_have_decl=1 +else + ac_have_decl=0 +fi + +cat >>confdefs.h <<_ACEOF +#define HAVE_DECL_DLSYM $ac_have_decl +_ACEOF + +ac_fn_c_check_decl "$LINENO" "RTLD_DEFAULT" "ac_cv_have_decl_RTLD_DEFAULT" "#include<dlfcn.h> +" +if test "x$ac_cv_have_decl_RTLD_DEFAULT" = xyes; then : + ac_have_decl=1 +else + ac_have_decl=0 +fi + +cat >>confdefs.h <<_ACEOF +#define HAVE_DECL_RTLD_DEFAULT $ac_have_decl +_ACEOF +ac_fn_c_check_decl "$LINENO" "RTLD_NEXT" "ac_cv_have_decl_RTLD_NEXT" "#include<dlfcn.h> +" +if test "x$ac_cv_have_decl_RTLD_NEXT" = xyes; then : + ac_have_decl=1 +else + ac_have_decl=0 +fi + +cat >>confdefs.h <<_ACEOF +#define HAVE_DECL_RTLD_NEXT $ac_have_decl +_ACEOF + + +## Lots of uses of getwd(), file.access(), Sys.glob(). +## We don't need times() except as a fallback for getrusage and +## clock_gettime/gettimeofday -- but it is older and always there. +case "${host_os}" in + mingw*) + ;; + *) + if test "${ac_cv_search_glob}" = "no"; then + as_fn_error $? "Building R requires the 'glob' system call" "$LINENO" 5 + fi + if test "${ac_cv_search_access}" = "no"; then + as_fn_error $? "Building R requires the 'access' system call" "$LINENO" 5 + fi + if test "${ac_cv_search_getcwd}" = "no"; then + as_fn_error $? "Building R requires the 'getcwd' system call" "$LINENO" 5 + fi + if test "${ac_cv_search_chdir}" = "no"; then + as_fn_error $? "Building R requires the 'chdir' system call" "$LINENO" 5 + fi + if test "${ac_cv_search_times}" = "no"; then + as_fn_error $? "Building R requires the 'times' system call" "$LINENO" 5 + fi + ;; +esac +## We also use getlogin isatty rename unlink without checking. + +## <NOTE> +## No need checking for bcopy bzero memcpy even though ifnames +## might report corresponding HAVE_FOO conditionals. +## </NOTE> + + +if test $ac_cv_type_off_t=yes -a $ac_cv_func_fseeko=yes -a $ac_cv_func_ftello=yes; then + +$as_echo "#define HAVE_OFF_T 1" >>confdefs.h + +fi + +## IEEE 754. We rely on this in e.g. the working log test. +for ac_func in isnan +do : + ac_fn_c_check_func "$LINENO" "isnan" "ac_cv_func_isnan" +if test "x$ac_cv_func_isnan" = xyes; then : + cat >>confdefs.h <<_ACEOF +#define HAVE_ISNAN 1 +_ACEOF + +fi +done + +ac_fn_c_check_decl "$LINENO" "isfinite" "ac_cv_have_decl_isfinite" "#include <math.h> +" +if test "x$ac_cv_have_decl_isfinite" = xyes; then : + ac_have_decl=1 +else + ac_have_decl=0 +fi + +cat >>confdefs.h <<_ACEOF +#define HAVE_DECL_ISFINITE $ac_have_decl +_ACEOF +ac_fn_c_check_decl "$LINENO" "isnan" "ac_cv_have_decl_isnan" "#include <math.h> +" +if test "x$ac_cv_have_decl_isnan" = xyes; then : + ac_have_decl=1 +else + ac_have_decl=0 +fi + +cat >>confdefs.h <<_ACEOF +#define HAVE_DECL_ISNAN $ac_have_decl +_ACEOF + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether you have IEEE 754 floating-point arithmetic" >&5 +$as_echo_n "checking whether you have IEEE 754 floating-point arithmetic... " >&6; } +if ${r_cv_ieee_754+:} false; then : + $as_echo_n "(cached) " >&6 +else + if (test "${ac_cv_func_isnan}" = yes \ + || test "${ac_cv_have_decl_isnan}" = yes); then + r_cv_ieee_754=yes +else + r_cv_ieee_754=no +fi +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $r_cv_ieee_754" >&5 +$as_echo "$r_cv_ieee_754" >&6; } +if test "${r_cv_ieee_754}" = yes; then + +$as_echo "#define IEEE_754 1" >>confdefs.h + +else + as_fn_error $? "IEEE 754 floating-point arithmetic is required" "$LINENO" 5 +fi + + +## check if putenv can substitute for unsetenv + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether putenv(\"FOO\") can unset an environment variable" >&5 +$as_echo_n "checking whether putenv(\"FOO\") can unset an environment variable... " >&6; } +if ${r_cv_putenv_unset+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test "$cross_compiling" = yes; then : + r_cv_putenv_unset=no +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +#include "confdefs.h" +#include <stdlib.h> +#include <string.h> +int main() +{ + char *p; +#ifdef HAVE_PUTENV + putenv("R_TEST=testit"); + p = getenv("R_TEST"); + if(!p) exit(10); + if(strcmp(p, "testit")) exit(11); + putenv("R_TEST"); + p = getenv("R_TEST"); + if(!p) exit(0); +#endif + exit(1); +} + +_ACEOF +if ac_fn_c_try_run "$LINENO"; then : + r_cv_putenv_unset=yes +else + r_cv_putenv_unset=no +fi +rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ + conftest.$ac_objext conftest.beam conftest.$ac_ext +fi + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $r_cv_putenv_unset" >&5 +$as_echo "$r_cv_putenv_unset" >&6; } + + if test $r_cv_putenv_unset = yes; then + +$as_echo "#define HAVE_PUTENV_UNSET 1" >>confdefs.h + + fi + + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether putenv(\"FOO=\") can unset an environment variable" >&5 +$as_echo_n "checking whether putenv(\"FOO=\") can unset an environment variable... " >&6; } +if ${r_cv_putenv_unset2+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test "$cross_compiling" = yes; then : + r_cv_putenv_unset2=no +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +#include "confdefs.h" +#include <stdlib.h> +#include <string.h> +int main() +{ + char *p; +#ifdef HAVE_PUTENV + putenv("R_TEST=testit"); + p = getenv("R_TEST"); + if(!p) exit(10); + if(strcmp(p, "testit")) exit(11); + putenv("R_TEST="); + p = getenv("R_TEST"); + if(!p) exit(0); +#endif + exit(1); +} + +_ACEOF +if ac_fn_c_try_run "$LINENO"; then : + r_cv_putenv_unset2=yes +else + r_cv_putenv_unset2=no +fi +rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ + conftest.$ac_objext conftest.beam conftest.$ac_ext +fi + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $r_cv_putenv_unset2" >&5 +$as_echo "$r_cv_putenv_unset2" >&6; } + + if test $r_cv_putenv_unset2 = yes; then + +$as_echo "#define HAVE_PUTENV_UNSET2 1" >>confdefs.h + + fi + + + + +## check whether nl_langinfo(CODESET) is in langinfo.h +## defines HAVE_LANGINFO_CODESET if it's there + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for nl_langinfo and CODESET" >&5 +$as_echo_n "checking for nl_langinfo and CODESET... " >&6; } +if ${am_cv_langinfo_codeset+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <langinfo.h> +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +char* cs = nl_langinfo(CODESET); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + am_cv_langinfo_codeset=yes +else + am_cv_langinfo_codeset=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $am_cv_langinfo_codeset" >&5 +$as_echo "$am_cv_langinfo_codeset" >&6; } + if test $am_cv_langinfo_codeset = yes; then + +$as_echo "#define HAVE_LANGINFO_CODESET 1" >>confdefs.h + + fi + + +## Used to build src/include/Rmath.h. +## <NOTE> +## we don't use AC_CONFIG_HEADERS on Rmath.h.in because +## a) that would comment out #undef statements in Rmath.h.in and +## b) Rmath.h should be a self-contained file for standalone Rmath use. +## </NOTE> +if test "${ac_cv_have_decl_expm1}" = yes; then + RMATH_HAVE_EXPM1="# define HAVE_EXPM1 1" +else + RMATH_HAVE_EXPM1="# undef HAVE_EXPM1" +fi + +if test "${ac_cv_have_decl_hypot}" = yes; then + RMATH_HAVE_HYPOT="# define HAVE_HYPOT 1" +else + RMATH_HAVE_HYPOT="# undef HAVE_HYPOT" +fi + +if test "${ac_cv_have_decl_log1p}" = yes; then + RMATH_HAVE_LOG1P="# define HAVE_LOG1P 1" +else + RMATH_HAVE_LOG1P="# undef HAVE_LOG1P" +fi + + +## Do we need substitutes? +## mkdtemp is not on Solaris 10, added in POSIX 2008 +## strdup strncasecmp were first required in POSIX 2001. +ac_fn_c_check_func "$LINENO" "mkdtemp" "ac_cv_func_mkdtemp" +if test "x$ac_cv_func_mkdtemp" = xyes; then : + $as_echo "#define HAVE_MKDTEMP 1" >>confdefs.h + +else + case " $LIBOBJS " in + *" mkdtemp.$ac_objext "* ) ;; + *) LIBOBJS="$LIBOBJS mkdtemp.$ac_objext" + ;; +esac + +fi + +ac_fn_c_check_func "$LINENO" "strdup" "ac_cv_func_strdup" +if test "x$ac_cv_func_strdup" = xyes; then : + $as_echo "#define HAVE_STRDUP 1" >>confdefs.h + +else + case " $LIBOBJS " in + *" strdup.$ac_objext "* ) ;; + *) LIBOBJS="$LIBOBJS strdup.$ac_objext" + ;; +esac + +fi + +ac_fn_c_check_func "$LINENO" "strncasecmp" "ac_cv_func_strncasecmp" +if test "x$ac_cv_func_strncasecmp" = xyes; then : + $as_echo "#define HAVE_STRNCASECMP 1" >>confdefs.h + +else + case " $LIBOBJS " in + *" strncasecmp.$ac_objext "* ) ;; + *) LIBOBJS="$LIBOBJS strncasecmp.$ac_objext" + ;; +esac + +fi + + +## Enable declarations in Defn.h? +ac_fn_c_check_decl "$LINENO" "mkdtemp" "ac_cv_have_decl_mkdtemp" "$ac_includes_default" +if test "x$ac_cv_have_decl_mkdtemp" = xyes; then : + ac_have_decl=1 +else + ac_have_decl=0 +fi + +cat >>confdefs.h <<_ACEOF +#define HAVE_DECL_MKDTEMP $ac_have_decl +_ACEOF +ac_fn_c_check_decl "$LINENO" "strdup" "ac_cv_have_decl_strdup" "$ac_includes_default" +if test "x$ac_cv_have_decl_strdup" = xyes; then : + ac_have_decl=1 +else + ac_have_decl=0 +fi + +cat >>confdefs.h <<_ACEOF +#define HAVE_DECL_STRDUP $ac_have_decl +_ACEOF +ac_fn_c_check_decl "$LINENO" "strncasecmp" "ac_cv_have_decl_strncasecmp" "$ac_includes_default" +if test "x$ac_cv_have_decl_strncasecmp" = xyes; then : + ac_have_decl=1 +else + ac_have_decl=0 +fi + +cat >>confdefs.h <<_ACEOF +#define HAVE_DECL_STRNCASECMP $ac_have_decl +_ACEOF + + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for library containing connect" >&5 +$as_echo_n "checking for library containing connect... " >&6; } +if ${ac_cv_search_connect+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_func_search_save_LIBS=$LIBS +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char connect (); +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +return connect (); + ; + return 0; +} +_ACEOF +for ac_lib in '' socket; do + if test -z "$ac_lib"; then + ac_res="none required" + else + ac_res=-l$ac_lib + LIBS="-l$ac_lib $ac_func_search_save_LIBS" + fi + if ac_fn_c_try_link "$LINENO"; then : + ac_cv_search_connect=$ac_res +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext + if ${ac_cv_search_connect+:} false; then : + break +fi +done +if ${ac_cv_search_connect+:} false; then : + +else + ac_cv_search_connect=no +fi +rm conftest.$ac_ext +LIBS=$ac_func_search_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_search_connect" >&5 +$as_echo "$ac_cv_search_connect" >&6; } +ac_res=$ac_cv_search_connect +if test "$ac_res" != no; then : + test "$ac_res" = "none required" || LIBS="$ac_res $LIBS" + +fi + +# gethostbyname was removed in POSIX 2008 (in favour of getaddrinfo, POSIX 2001) +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for library containing gethostbyname" >&5 +$as_echo_n "checking for library containing gethostbyname... " >&6; } +if ${ac_cv_search_gethostbyname+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_func_search_save_LIBS=$LIBS +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char gethostbyname (); +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +return gethostbyname (); + ; + return 0; +} +_ACEOF +for ac_lib in '' nsl socket; do + if test -z "$ac_lib"; then + ac_res="none required" + else + ac_res=-l$ac_lib + LIBS="-l$ac_lib $ac_func_search_save_LIBS" + fi + if ac_fn_c_try_link "$LINENO"; then : + ac_cv_search_gethostbyname=$ac_res +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext + if ${ac_cv_search_gethostbyname+:} false; then : + break +fi +done +if ${ac_cv_search_gethostbyname+:} false; then : + +else + ac_cv_search_gethostbyname=no +fi +rm conftest.$ac_ext +LIBS=$ac_func_search_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_search_gethostbyname" >&5 +$as_echo "$ac_cv_search_gethostbyname" >&6; } +ac_res=$ac_cv_search_gethostbyname +if test "$ac_res" != no; then : + test "$ac_res" = "none required" || LIBS="$ac_res $LIBS" + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for library containing xdr_string" >&5 +$as_echo_n "checking for library containing xdr_string... " >&6; } +if ${ac_cv_search_xdr_string+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_func_search_save_LIBS=$LIBS +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char xdr_string (); +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +return xdr_string (); + ; + return 0; +} +_ACEOF +for ac_lib in '' nsl tirpc; do + if test -z "$ac_lib"; then + ac_res="none required" + else + ac_res=-l$ac_lib + LIBS="-l$ac_lib $ac_func_search_save_LIBS" + fi + if ac_fn_c_try_link "$LINENO"; then : + ac_cv_search_xdr_string=$ac_res +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext + if ${ac_cv_search_xdr_string+:} false; then : + break +fi +done +if ${ac_cv_search_xdr_string+:} false; then : + +else + ac_cv_search_xdr_string=no +fi +rm conftest.$ac_ext +LIBS=$ac_func_search_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_search_xdr_string" >&5 +$as_echo "$ac_cv_search_xdr_string" >&6; } +ac_res=$ac_cv_search_xdr_string +if test "$ac_res" != no; then : + test "$ac_res" = "none required" || LIBS="$ac_res $LIBS" + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for working calloc" >&5 +$as_echo_n "checking for working calloc... " >&6; } +if ${r_cv_func_calloc_works+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test "$cross_compiling" = yes; then : + r_cv_func_calloc_works=no +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +#include <stdlib.h> +int main () { + int *p = calloc(0, sizeof(int)); + exit(p == 0); +} + +_ACEOF +if ac_fn_c_try_run "$LINENO"; then : + r_cv_func_calloc_works=yes +else + r_cv_func_calloc_works=no +fi +rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ + conftest.$ac_objext conftest.beam conftest.$ac_ext +fi + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $r_cv_func_calloc_works" >&5 +$as_echo "$r_cv_func_calloc_works" >&6; } +if test "x${r_cv_func_calloc_works}" = xyes; then + +$as_echo "#define HAVE_WORKING_CALLOC 1" >>confdefs.h + +fi + +if test "${ac_cv_have_decl_isfinite}" = "yes"; then +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for working isfinite" >&5 +$as_echo_n "checking for working isfinite... " >&6; } +if ${r_cv_func_isfinite_works+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test "$cross_compiling" = yes; then : + r_cv_func_isfinite_works=no +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +#include <math.h> +#include <stdlib.h> +#include "confdefs.h" +int main () { +#ifdef HAVE_DECL_ISFINITE + exit(isfinite(1./0.) | isfinite(0./0.) | isfinite(-1./0.)); +#else + exit(1); +#endif +} + +_ACEOF +if ac_fn_c_try_run "$LINENO"; then : + r_cv_func_isfinite_works=yes +else + r_cv_func_isfinite_works=no +fi +rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ + conftest.$ac_objext conftest.beam conftest.$ac_ext +fi + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $r_cv_func_isfinite_works" >&5 +$as_echo "$r_cv_func_isfinite_works" >&6; } +if test "x${r_cv_func_isfinite_works}" = xyes; then + +$as_echo "#define HAVE_WORKING_ISFINITE 1" >>confdefs.h + +fi + +fi +## check accuracy of log1p +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for working log1p" >&5 +$as_echo_n "checking for working log1p... " >&6; } +if ${r_cv_func_log1p_works+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test "$cross_compiling" = yes; then : + r_cv_func_log1p_works=no +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +#include <math.h> +#include <stdlib.h> +#include "confdefs.h" +int main () { +#ifdef HAVE_LOG1P + int k; + double d; + double x = 1.0; + for(k = 0; k < 53; k++) x /= 2.0; + + /* log(1+x) = x - (1/2)x^2 + (1/3)x^3 - (1/4)x^4 ... */ + /* = x for x sufficiently small */ + for(k = -54; k > -1022; --k) { + x /= 2.0; + if(x == 0.0) + exit(0); /* OK: reached underflow limit */ + d = log1p(x); + if(d == 0.0) + exit(1); /* ERROR: inaccurate log1p() */ + /* for large k, ((1/2)x^2)/x might appear in the guard digits */ + if(k < -80 && d != x) + exit(1); /* ERROR: inaccurate log1p() */ + } + exit(0); +#else + exit(1); +#endif +} + +_ACEOF +if ac_fn_c_try_run "$LINENO"; then : + r_cv_func_log1p_works=yes +else + r_cv_func_log1p_works=no +fi +rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ + conftest.$ac_objext conftest.beam conftest.$ac_ext +fi + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $r_cv_func_log1p_works" >&5 +$as_echo "$r_cv_func_log1p_works" >&6; } +if test "x${r_cv_func_log1p_works}" = xyes; then + +$as_echo "#define HAVE_WORKING_LOG1P 1" >>confdefs.h + + RMATH_HAVE_WORKING_LOG1P="# define HAVE_WORKING_LOG1P 1" +else + RMATH_HAVE_WORKING_LOG1P="# undef HAVE_WORKING_LOG1P" +fi + + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether ftell works correctly on files opened for append" >&5 +$as_echo_n "checking whether ftell works correctly on files opened for append... " >&6; } +if ${r_cv_working_ftell+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test "$cross_compiling" = yes; then : + r_cv_working_ftell=no +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +#include <stdlib.h> +#include <stdio.h> + +main() { + FILE *fp; + int pos; + + fp = fopen("testit", "wb"); + fwrite("0123456789\n", 11, 1, fp); + fclose(fp); + fp = fopen("testit", "ab"); + pos = ftell(fp); + fclose(fp); + unlink("testit"); + exit(pos != 11); +} + +_ACEOF +if ac_fn_c_try_run "$LINENO"; then : + r_cv_working_ftell=yes +else + r_cv_working_ftell=no +fi +rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ + conftest.$ac_objext conftest.beam conftest.$ac_ext +fi + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $r_cv_working_ftell" >&5 +$as_echo "$r_cv_working_ftell" >&6; } +if test "x${r_cv_working_ftell}" = xyes; then + +$as_echo "#define HAVE_WORKING_FTELL 1" >>confdefs.h + +fi + + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for working sigaction" >&5 +$as_echo_n "checking for working sigaction... " >&6; } +if ${r_cv_func_sigaction_works+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test "$cross_compiling" = yes; then : + r_cv_func_sigaction_works=no +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +#include "confdefs.h" +#include <stdlib.h> +#include <signal.h> +int main () +{ + struct sigaction sa; + siginfo_t si, *ip; + sigemptyset(&sa.sa_mask); + sa.sa_flags = SA_ONSTACK | SA_SIGINFO; + ip = &si; + { + void *addr = ip->si_addr; + int code = ip->si_code; + } + exit(0); +} + +_ACEOF +if ac_fn_c_try_run "$LINENO"; then : + r_cv_func_sigaction_works=yes +else + r_cv_func_sigaction_works=no +fi +rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ + conftest.$ac_objext conftest.beam conftest.$ac_ext +fi + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $r_cv_func_sigaction_works" >&5 +$as_echo "$r_cv_func_sigaction_works" >&6; } + if test "x${r_cv_func_sigaction_works}" = xyes; then + +$as_echo "#define HAVE_WORKING_SIGACTION 1" >>confdefs.h + + fi + + +if test x${use_internal_tzcode} = xdefault; then +case "${host_os}" in + darwin*) + use_internal_tzcode=yes; + ;; +esac +fi +if test "${use_internal_tzcode}" != yes; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether mktime sets errno" >&5 +$as_echo_n "checking whether mktime sets errno... " >&6; } +if ${r_cv_mktime_errno+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test "$cross_compiling" = yes; then : + r_cv_mktime_errno=no +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +#include <stdlib.h> +#include <time.h> +#include <errno.h> + +int main() +{ + struct tm tm; + /* It's hard to know what is an error, since mktime is allowed to + fix up times and there are 64-bit time_t about. + But this works for now (yes on Solaris, no on glibc). */ + tm.tm_year = 3000; tm.tm_mon = 0; tm.tm_mday = 0; + tm.tm_hour = 0; tm.tm_min = 0; tm.tm_sec = 0; tm.tm_isdst = -1; + errno = 0; + mktime(&tm); + exit(errno == 0); +} + +_ACEOF +if ac_fn_c_try_run "$LINENO"; then : + r_cv_mktime_errno=yes +else + r_cv_mktime_errno=no +fi +rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ + conftest.$ac_objext conftest.beam conftest.$ac_ext +fi + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $r_cv_mktime_errno" >&5 +$as_echo "$r_cv_mktime_errno" >&6; } +if test "${r_cv_mktime_errno}" = yes; then + +$as_echo "#define MKTIME_SETS_ERRNO /**/" >>confdefs.h + +fi + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether mktime works correctly outside 1902-2037" >&5 +$as_echo_n "checking whether mktime works correctly outside 1902-2037... " >&6; } +if ${r_cv_working_mktime+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test "$cross_compiling" = yes; then : + r_cv_working_mktime=no +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +#include <stdlib.h> +#include <time.h> + +main() { + if(sizeof(time_t) < 8) exit(1); + + struct tm tm; + time_t res; + putenv("TZ=Europe/London"); + tm.tm_sec = tm.tm_min = 0; tm.tm_hour = 12; + tm.tm_mday = 1; tm.tm_mon = 0; tm.tm_year = 80; tm.tm_isdst = 0; + res = mktime(&tm); + if(res == (time_t)-1) exit(2); + tm.tm_mday = 1; tm.tm_year = 01; tm.tm_isdst = 0; + res = mktime(&tm); + if(res == (time_t)-1) exit(3); + tm.tm_year = 140; + res = mktime(&tm); + if(res != 2209032000L) exit(4); + tm.tm_mon = 6; tm.tm_isdst = 1; + res = mktime(&tm); + if(res != 2224753200L) exit(5); + + exit(0); +} + +_ACEOF +if ac_fn_c_try_run "$LINENO"; then : + r_cv_working_mktime=yes +else + r_cv_working_mktime=no +fi +rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ + conftest.$ac_objext conftest.beam conftest.$ac_ext +fi + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $r_cv_working_mktime" >&5 +$as_echo "$r_cv_working_mktime" >&6; } +if test "x${r_cv_working_mktime}" = xyes; then + +$as_echo "#define HAVE_WORKING_64BIT_MKTIME 1" >>confdefs.h + +fi + +fi + +ac_fn_c_check_header_mongrel "$LINENO" "complex.h" "ac_cv_header_complex_h" "$ac_includes_default" +if test "x$ac_cv_header_complex_h" = xyes; then : + r_c99_complex=yes +else + r_c99_complex=no +fi + + +if test "${r_c99_complex}" = "yes"; then + ac_fn_c_check_type "$LINENO" "double complex" "ac_cv_type_double_complex" "#include <complex.h> +" +if test "x$ac_cv_type_double_complex" = xyes; then : + +else + r_c99_complex=no +fi + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether C99 double complex is supported" >&5 +$as_echo_n "checking whether C99 double complex is supported... " >&6; } +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: ${r_c99_complex}" >&5 +$as_echo "${r_c99_complex}" >&6; } +if test "${r_c99_complex}" = "no"; then + as_fn_error $? "Support for C99 double complex type is required." "$LINENO" 5 +fi +for ac_func in cabs carg cexp clog csqrt cpow ccos csin ctan \ + cacos casin catan ccosh csinh ctanh +do +as_ac_Symbol=`$as_echo "ac_cv_have_decl_$ac_func" | $as_tr_sh` +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $ac_func exists and is declared" >&5 +$as_echo_n "checking whether $ac_func exists and is declared... " >&6; } +if eval \${$as_ac_Symbol+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <complex.h> + +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +#ifndef $ac_func + char *p = (char *) $ac_func; +#endif + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + eval "$as_ac_Symbol=yes" +else + eval "$as_ac_Symbol=no" +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +fi +eval ac_res=\$$as_ac_Symbol + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } +if test `eval 'as_val=${'$as_ac_Symbol'};$as_echo "$as_val"'` = yes; then : + cat >>confdefs.h <<_ACEOF +#define `$as_echo "HAVE_$ac_func" | $as_tr_cpp` 1 +_ACEOF + +fi +done + + + +## BSD extensions +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether 'struct tm' includes tm_zone" >&5 +$as_echo_n "checking whether 'struct tm' includes tm_zone... " >&6; } +if ${r_cv_have_tm_zone+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +// glibc needs this defined. +#define _BSD_SOURCE +#include <time.h> + +int main() { + struct tm x; + x.tm_zone = ""; +} + +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + r_cv_have_tm_zone=yes +else + r_cv_have_tm_zone=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $r_cv_have_tm_zone" >&5 +$as_echo "$r_cv_have_tm_zone" >&6; } +if test "x${r_cv_have_tm_zone}" = xyes; then + +$as_echo "#define HAVE_TM_ZONE 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether 'struct tm' includes tm_gmtoff" >&5 +$as_echo_n "checking whether 'struct tm' includes tm_gmtoff... " >&6; } +if ${r_cv_have_tm_gmtoff+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +// glibc needs this defined, second for >= 2.20 +#define _BSD_SOURCE +#define _DEFAULT_SOURCE +#include <time.h> + +int main() { + struct tm x; + x.tm_gmtoff = +3600; +} + +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + r_cv_have_tm_gmtoff=yes +else + r_cv_have_tm_gmtoff=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $r_cv_have_tm_gmtoff" >&5 +$as_echo "$r_cv_have_tm_gmtoff" >&6; } +if test "x${r_cv_have_tm_gmtoff}" = xyes; then + +$as_echo "#define HAVE_TM_GMTOFF 1" >>confdefs.h + +fi + +## BLAS. +## <NOTE> +## This has to come *after* checking for Fortran 77 compiler/converter +## characteristics (notably name mangling and FLIBS). +## </NOTE> + +if test "${use_blas}" = yes; then + ## may acx_blas_ok to yes + + + +acx_blas_ok=no +case "${with_blas}" in + yes | "") ;; + no) acx_blas_ok=disable ;; + -* | */* | *.a | *.so | *.so.* | *.sl | *.sl.* | *.o) + BLAS_LIBS="${with_blas}" + ;; + *) BLAS_LIBS="-l${with_blas}" ;; +esac + +if test "${r_cv_prog_f77_append_underscore}" = yes; then + dgemm=dgemm_ + sgemm=sgemm_ + xerbla=xerbla_ +else + dgemm=dgemm + sgemm=sgemm + xerbla=xerbla +fi + +acx_blas_save_LIBS="${LIBS}" +LIBS="${FLIBS} ${LIBS}" + +## First, check BLAS_LIBS environment variable +if test "${acx_blas_ok}" = no; then + if test "x${BLAS_LIBS}" != x; then + r_save_LIBS="${LIBS}"; LIBS="${BLAS_LIBS} ${LIBS}" + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for ${dgemm} in ${BLAS_LIBS}" >&5 +$as_echo_n "checking for ${dgemm} in ${BLAS_LIBS}... " >&6; } + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +void ${xerbla}(char *srname, int *info){} +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +${dgemm}() + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + acx_blas_ok=yes +else + BLAS_LIBS="" +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + { $as_echo "$as_me:${as_lineno-$LINENO}: result: ${acx_blas_ok}" >&5 +$as_echo "${acx_blas_ok}" >&6; } + LIBS="${r_save_LIBS}" + fi +fi + +## BLAS linked to by default? (happens on some supercomputers) +if test "${acx_blas_ok}" = no; then + as_ac_var=`$as_echo "ac_cv_func_${dgemm}" | $as_tr_sh` +ac_fn_c_check_func "$LINENO" "${dgemm}" "$as_ac_var" +if eval test \"x\$"$as_ac_var"\" = x"yes"; then : + acx_blas_ok=yes +fi + +fi + +## BLAS in ATLAS library? (http://math-atlas.sourceforge.net/) +if test "${acx_blas_ok}" = no; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for ATL_xerbla in -latlas" >&5 +$as_echo_n "checking for ATL_xerbla in -latlas... " >&6; } +if ${ac_cv_lib_atlas_ATL_xerbla+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-latlas $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char ATL_xerbla (); +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +return ATL_xerbla (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_atlas_ATL_xerbla=yes +else + ac_cv_lib_atlas_ATL_xerbla=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_atlas_ATL_xerbla" >&5 +$as_echo "$ac_cv_lib_atlas_ATL_xerbla" >&6; } +if test "x$ac_cv_lib_atlas_ATL_xerbla" = xyes; then : + as_ac_Lib=`$as_echo "ac_cv_lib_f77blas_${dgemm}" | $as_tr_sh` +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for ${dgemm} in -lf77blas" >&5 +$as_echo_n "checking for ${dgemm} in -lf77blas... " >&6; } +if eval \${$as_ac_Lib+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lf77blas -latlas $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char ${dgemm} (); +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +return ${dgemm} (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + eval "$as_ac_Lib=yes" +else + eval "$as_ac_Lib=no" +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +eval ac_res=\$$as_ac_Lib + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } +if eval test \"x\$"$as_ac_Lib"\" = x"yes"; then : + acx_blas_ok=yes + BLAS_LIBS="-lf77blas -latlas" +fi + +fi + +fi + +## BLAS in PhiPACK libraries? (requires generic BLAS lib, too) +if test "${acx_blas_ok}" = no; then + as_ac_Lib=`$as_echo "ac_cv_lib_blas_${dgemm}" | $as_tr_sh` +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for ${dgemm} in -lblas" >&5 +$as_echo_n "checking for ${dgemm} in -lblas... " >&6; } +if eval \${$as_ac_Lib+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lblas $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char ${dgemm} (); +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +return ${dgemm} (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + eval "$as_ac_Lib=yes" +else + eval "$as_ac_Lib=no" +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +eval ac_res=\$$as_ac_Lib + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } +if eval test \"x\$"$as_ac_Lib"\" = x"yes"; then : + as_ac_Lib=`$as_echo "ac_cv_lib_dgemm_$dgemm" | $as_tr_sh` +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $dgemm in -ldgemm" >&5 +$as_echo_n "checking for $dgemm in -ldgemm... " >&6; } +if eval \${$as_ac_Lib+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-ldgemm -lblas $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char $dgemm (); +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +return $dgemm (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + eval "$as_ac_Lib=yes" +else + eval "$as_ac_Lib=no" +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +eval ac_res=\$$as_ac_Lib + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } +if eval test \"x\$"$as_ac_Lib"\" = x"yes"; then : + as_ac_Lib=`$as_echo "ac_cv_lib_sgemm_${sgemm}" | $as_tr_sh` +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for ${sgemm} in -lsgemm" >&5 +$as_echo_n "checking for ${sgemm} in -lsgemm... " >&6; } +if eval \${$as_ac_Lib+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lsgemm -lblas $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char ${sgemm} (); +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +return ${sgemm} (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + eval "$as_ac_Lib=yes" +else + eval "$as_ac_Lib=no" +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +eval ac_res=\$$as_ac_Lib + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } +if eval test \"x\$"$as_ac_Lib"\" = x"yes"; then : + acx_blas_ok=yes + BLAS_LIBS="-lsgemm -ldgemm -lblas" +fi + +fi + +fi + +fi + +## <COMMENT> +## ## BLAS in Alpha CXML library? +## if test "${acx_blas_ok}" = no; then +## AC_CHECK_LIB(cxml, ${sgemm}, +## [acx_blas_ok=yes; BLAS_LIBS="-lcxml"]) +## fi +## </COMMENT> + +## <COMMENT> +## # BLAS in Alpha DXML library? (now called CXML, see above) +## if test "${acx_blas_ok}" = no; then +## AC_CHECK_LIB(dxml, ${sgemm}, +## [acx_blas_ok=yes; BLAS_LIBS="-ldxml"]) +## fi +## </COMMENT> + +## BLAS in Sun Performance library? +## Some versions require -xlic_lib=sunperf: -lsunperf will not work +## Not sure whether -lsunmath is required, but it helps anyway +if test "${acx_blas_ok}" = no; then + if test "x$GCC" != xyes; then # only works with Sun CC + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for ${dgemm} in -lsunperf" >&5 +$as_echo_n "checking for ${dgemm} in -lsunperf... " >&6; } + r_save_LIBS="${LIBS}" + LIBS="-xlic_lib=sunperf -lsunmath ${LIBS}" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char ${dgemm} (); +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +return ${dgemm} (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + R_sunperf=yes +else + R_sunperf=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + if test "${R_sunperf}" = yes; then + BLAS_LIBS="-xlic_lib=sunperf -lsunmath" + acx_blas_ok=yes + fi + LIBS="${r_save_LIBS}" + { $as_echo "$as_me:${as_lineno-$LINENO}: result: ${acx_blas_ok}" >&5 +$as_echo "${acx_blas_ok}" >&6; } + fi +fi + +## <COMMENT> +## ## BLAS in SCSL library? (SGI/Cray Scientific Library) +## if test "${acx_blas_ok}" = no; then +## AC_CHECK_LIB(scs, ${sgemm}, +## [acx_blas_ok=yes; BLAS_LIBS="-lscs"]) +## fi +## </COMMENT> + +## <COMMENT> +## ## BLAS in SGIMATH library? +## if test "${acx_blas_ok}" = no; then +## AC_CHECK_LIB(complib.sgimath, ${sgemm}, +## [acx_blas_ok=yes; BLAS_LIBS="-lcomplib.sgimath"]) +## fi +## </COMMENT> + +## BLAS in IBM ESSL library? (requires generic BLAS lib, too) +if test "${acx_blas_ok}" = no; then + as_ac_Lib=`$as_echo "ac_cv_lib_blas_${dgemm}" | $as_tr_sh` +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for ${dgemm} in -lblas" >&5 +$as_echo_n "checking for ${dgemm} in -lblas... " >&6; } +if eval \${$as_ac_Lib+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lblas $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char ${dgemm} (); +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +return ${dgemm} (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + eval "$as_ac_Lib=yes" +else + eval "$as_ac_Lib=no" +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +eval ac_res=\$$as_ac_Lib + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } +if eval test \"x\$"$as_ac_Lib"\" = x"yes"; then : + as_ac_Lib=`$as_echo "ac_cv_lib_essl_${dgemm}" | $as_tr_sh` +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for ${dgemm} in -lessl" >&5 +$as_echo_n "checking for ${dgemm} in -lessl... " >&6; } +if eval \${$as_ac_Lib+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lessl -lblas ${FLIBS} $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char ${dgemm} (); +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +return ${dgemm} (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + eval "$as_ac_Lib=yes" +else + eval "$as_ac_Lib=no" +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +eval ac_res=\$$as_ac_Lib + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } +if eval test \"x\$"$as_ac_Lib"\" = x"yes"; then : + acx_blas_ok=yes + BLAS_LIBS="-lessl -lblas" +fi + +fi + +fi + +## Generic BLAS library? +if test "${acx_blas_ok}" = no; then + as_ac_Lib=`$as_echo "ac_cv_lib_blas_${dgemm}" | $as_tr_sh` +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for ${dgemm} in -lblas" >&5 +$as_echo_n "checking for ${dgemm} in -lblas... " >&6; } +if eval \${$as_ac_Lib+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lblas $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char ${dgemm} (); +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +return ${dgemm} (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + eval "$as_ac_Lib=yes" +else + eval "$as_ac_Lib=no" +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +eval ac_res=\$$as_ac_Lib + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } +if eval test \"x\$"$as_ac_Lib"\" = x"yes"; then : + acx_blas_ok=yes; BLAS_LIBS="-lblas" +fi + +fi + +## Now check if zdotu works (fails on AMD64 with the wrong compiler; +## also fails on macOS with Accelerate/vecLib and gfortran; +## but in that case we have a work-around using USE_VECLIB_G95FIX) + +if test "${acx_blas_ok}" = yes; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether double complex BLAS can be used" >&5 +$as_echo_n "checking whether double complex BLAS can be used... " >&6; } + if ${r_cv_zdotu_is_usable+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat > conftestf.f <<EOF +c Goto's BLAS at least needs a XERBLA + subroutine xerbla(srname, info) + character*6 srname + integer info + end + + subroutine test1(iflag) + double complex zx(2), ztemp, zres, zdotu + integer iflag + zx(1) = (3.1d0,1.7d0) + zx(2) = (1.6d0,-0.6d0) + zres = zdotu(2, zx, 1, zx, 1) + ztemp = (0.0d0,0.0d0) + do 10 i = 1,2 + 10 ztemp = ztemp + zx(i)*zx(i) + if(abs(zres - ztemp) > 1.0d-10) then + iflag = 1 + else + iflag = 0 + endif + end +EOF +${F77} ${FFLAGS} -c conftestf.f 1>&5 2>&5 +## Yes we need to double quote this ... +cat > conftest.c <<EOF +#include <stdlib.h> +#include "confdefs.h" +#ifdef HAVE_F77_UNDERSCORE +# define F77_SYMBOL(x) x ## _ +#else +# define F77_SYMBOL(x) x +#endif +extern void F77_SYMBOL(test1)(int *iflag); + +int main () { + int iflag; + F77_SYMBOL(test1)(&iflag); + exit(iflag); +} +EOF +if ${CC} ${CFLAGS} -c conftest.c 1>&5 2>&5; then + ## <NOTE> + ## This should really use MAIN_LD, and hence come after this is + ## determined (and necessary additions to MAIN_LDFLAGS were made). + ## But it seems that we currently can always use the C compiler. + ## Also, to be defensive there should be a similar test with SHLIB_LD + ## and SHLIB_LDFLAGS (and note that on HPUX with native cc we have to + ## use ld for SHLIB_LD) ... + if ${CC} ${CFLAGS} ${LDFLAGS} ${MAIN_LDFLAGS} -o conftest${ac_exeext} \ + conftest.${ac_objext} conftestf.${ac_objext} ${FLIBS} \ + ${LIBM} ${BLAS_LIBS} 1>&5 2>&5; + ## </NOTE> + then + ## redirect error messages to config.log + output=`./conftest${ac_exeext} 2>&5` + if test ${?} = 0; then + r_cv_zdotu_is_usable=yes + fi + fi +fi + +fi + + rm -rf conftest conftest.* conftestf.* core + if test -n "${r_cv_zdotu_is_usable}"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +$as_echo "yes" >&6; } + else + case "${BLAS_LIBS}" in + *Accelerate* | *vecLib*) + ## for vecLib we have a work-around by using cblas_..._sub + { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +$as_echo "yes" >&6; } + use_veclib_g95fix=yes + ;; + *) + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } + BLAS_LIBS= + acx_blas_ok="no" + ;; + esac + fi +fi +if test "${acx_blas_ok}" = yes; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether the BLAS is complete" >&5 +$as_echo_n "checking whether the BLAS is complete... " >&6; } + if ${r_cv_complete_blas+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat > conftest.c <<EOF +#include <stdlib.h> +#include "confdefs.h" +#ifdef HAVE_F77_UNDERSCORE +# define F77_SYMBOL(x) x ## _ +#else +# define F77_SYMBOL(x) x +#endif +void F77_SYMBOL(xerbla)(char *srname, int *info) +{} +void blas_set () { + F77_SYMBOL(dasum)(); + F77_SYMBOL(daxpy)(); + F77_SYMBOL(dcopy)(); + F77_SYMBOL(ddot)(); + F77_SYMBOL(dgbmv)(); + F77_SYMBOL(dgemm)(); + F77_SYMBOL(dgemv)(); + F77_SYMBOL(dger)(); + F77_SYMBOL(dnrm2)(); + F77_SYMBOL(drot)(); + F77_SYMBOL(drotg)(); + F77_SYMBOL(drotm)(); + F77_SYMBOL(drotmg)(); + F77_SYMBOL(dsbmv)(); + F77_SYMBOL(dscal)(); + F77_SYMBOL(dsdot)(); + F77_SYMBOL(dspmv)(); + F77_SYMBOL(dspr)(); + F77_SYMBOL(dspr2)(); + F77_SYMBOL(dswap)(); + F77_SYMBOL(dsymm)(); + F77_SYMBOL(dsymv)(); + F77_SYMBOL(dsyr)(); + F77_SYMBOL(dsyr2)(); + F77_SYMBOL(dsyr2k)(); + F77_SYMBOL(dsyrk)(); + F77_SYMBOL(dtbmv)(); + F77_SYMBOL(dtbsv)(); + F77_SYMBOL(dtpmv)(); + F77_SYMBOL(dtpsv)(); + F77_SYMBOL(dtrmm)(); + F77_SYMBOL(dtrmv)(); + F77_SYMBOL(dtrsm)(); + F77_SYMBOL(dtrsv)(); + F77_SYMBOL(idamax)(); + F77_SYMBOL(lsame)(); +#ifdef HAVE_FORTRAN_DOUBLE_COMPLEX +/* cmplxblas */ + F77_SYMBOL(dcabs1)(); + F77_SYMBOL(dzasum)(); + F77_SYMBOL(dznrm2)(); + F77_SYMBOL(izamax)(); + F77_SYMBOL(zaxpy)(); + F77_SYMBOL(zcopy)(); + F77_SYMBOL(zdotc)(); + F77_SYMBOL(zdotu)(); + F77_SYMBOL(zdrot)(); + F77_SYMBOL(zdscal)(); + F77_SYMBOL(zgbmv)(); + F77_SYMBOL(zgemm)(); + F77_SYMBOL(zgemv)(); + F77_SYMBOL(zgerc)(); + F77_SYMBOL(zgeru)(); + F77_SYMBOL(zhbmv)(); + F77_SYMBOL(zhemm)(); + F77_SYMBOL(zhemv)(); + F77_SYMBOL(zher)(); + F77_SYMBOL(zherk)(); + F77_SYMBOL(zher2)(); + F77_SYMBOL(zher2k)(); + F77_SYMBOL(zhpmv)(); + F77_SYMBOL(zhpr)(); + F77_SYMBOL(zhpr2)(); + F77_SYMBOL(zrotg)(); + F77_SYMBOL(zscal)(); + F77_SYMBOL(zswap)(); + F77_SYMBOL(zsymm)(); + F77_SYMBOL(zsyr2k)(); + F77_SYMBOL(zsyrk)(); + F77_SYMBOL(ztbmv)(); + F77_SYMBOL(ztbsv)(); + F77_SYMBOL(ztpmv)(); + F77_SYMBOL(ztpsv)(); + F77_SYMBOL(ztrmm)(); + F77_SYMBOL(ztrmv)(); + F77_SYMBOL(ztrsm)(); + F77_SYMBOL(ztrsv)(); +#endif +} +int main () +{ + exit(0); +} +EOF +if ${CC} ${CFLAGS} -c conftest.c 1>&5 2>&5; then + ## <NOTE> + ## This should really use MAIN_LD, and hence come after this is + ## determined (and necessary additions to MAIN_LDFLAGS were made). + ## But it seems that we currently can always use the C compiler. + ## Also, to be defensive there should be a similar test with SHLIB_LD + ## and SHLIB_LDFLAGS (and note that on HPUX with native cc we have to + ## use ld for SHLIB_LD) ... + if ${CC} ${CFLAGS} ${LDFLAGS} ${MAIN_LDFLAGS} -o conftest${ac_exeext} \ + conftest.${ac_objext} ${FLIBS} \ + ${LIBM} ${BLAS_LIBS} 1>&5 2>&5; + ## </NOTE> + then + r_cv_complete_blas=yes + fi +fi + +fi + + if test x"${r_cv_complete_blas}" != xyes; then + acx_blas_ok="no" + r_cv_complete_blas=no + BLAS_LIBS="" + fi + { $as_echo "$as_me:${as_lineno-$LINENO}: result: ${r_cv_complete_blas}" >&5 +$as_echo "${r_cv_complete_blas}" >&6; } +fi + +LIBS="${acx_blas_save_LIBS}" + + + +fi + +if test "${acx_blas_ok}" != "yes"; then + case "${host_os}" in + aix*) + ;; + *) + if test "${use_blas_shlib}" = "unset"; then + use_blas_shlib="yes" + fi + ;; + esac +fi + + if test "x${use_blas_shlib}" = xyes; then + BLAS_SHLIB_TRUE= + BLAS_SHLIB_FALSE='#' +else + BLAS_SHLIB_TRUE='#' + BLAS_SHLIB_FALSE= +fi + + +case "${host_os}" in + darwin*) + ## In order to allow the R build to be relocatable, we strip paths + ## from all shlibs and rely on DYLD_LIBRARY_PATH. Unfortunately + ## Darwin linker ignores it at build-time and doesn't use -L to + ## resolve dylib dependencies, so libRblas will not be found unless + ## we tell ld where it lives. I don't know of any more elegant solution :/ + if test "x${use_blas_shlib}" = xyes; then + LIBR="${LIBR} -dylib_file libRblas.dylib:\$(R_HOME)/lib\$(R_ARCH)/libRblas.dylib" + fi + ;; +esac +## LIBR0 is for the -L part, LIBR1 for -lR (if needed) + + + +## This version is used to build a shared BLAS lib +BLAS_LIBS0=${BLAS_LIBS} + +## external BLAS + shared BLAS lib = we need to pass symbols through +## this may require some magic +if test "${acx_blas_ok}" = yes -a "${use_blas_shlib}" = yes; then + case "${host_os}" in + darwin*) + ## test whether we can see symbols through the proxy BLAS library + ## this test could be modified to not be Darwin-specific, + ## however the fix is darwin-specific + if test "${r_cv_prog_f77_append_underscore}" = yes; then + dgemm=dgemm_ + xerbla=xerbla_ + else + dgemm=dgemm + xerbla=xerbla + fi + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether external BLAS is visible through libRblas" >&5 +$as_echo_n "checking whether external BLAS is visible through libRblas... " >&6; } + if ${r_cv_blas0_passthrough+:} false; then : + $as_echo_n "(cached) " >&6 +else + +cat > conftestl.c <<EOF + void ${dgemm}(); + void dummy() { ${dgemm}(); } +EOF +echo "${CC} ${CFLAGS} conftestl.c ${SHLIB_LDFLAGS} -o libconftest${DYLIB_EXT} ${LIBS} ${BLAS_LIBS}" >&5 +${CC} ${CFLAGS} conftestl.c ${SHLIB_LDFLAGS} -o libconftest${DYLIB_EXT} ${LIBS} ${BLAS_LIBS} 1>&5 2>&5 +cat > conftest.c <<EOF +void ${dgemm}(); +void ${xerbla}(char *srname, int *info){}; +int main(int argc, char **argv) { if (argc<0) ${dgemm}(); return 0; } +EOF +if ${CC} ${CFLAGS} -c conftest.c 1>&5 2>&5; then + if ${CC} ${LDFLAGS} -o conftest${ac_exeext} \ + conftest.${ac_objext} -L. -lconftest \ + 1>&5 2>&5; + then + ## redirect error messages to config.log + output=`./conftest${ac_exeext} 2>&5` + if test ${?} = 0; then + r_cv_blas0_passthrough=yes + fi + fi +fi + +fi + +if test -n "${r_cv_blas0_passthrough}"; then +r_cv_blas0_passthrough=yes +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +$as_echo "yes" >&6; } +else +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking can it be fixed by using -sub_umbrella" >&5 +$as_echo_n "checking can it be fixed by using -sub_umbrella... " >&6; } +ac_test_BLAS_LIBS=`echo "${BLAS_LIBS}"|sed -e s/-framework/-sub_umbrella/` +rm -f libconftest.dylib +echo "${CC} ${CFLAGS} conftestl.c ${SHLIB_LDFLAGS} -o libconftest${DYLIB_EXT} ${LIBS} ${BLAS_LIBS} ${ac_test_BLAS_LIBS}" >&5 +${CC} ${CFLAGS} conftestl.c ${SHLIB_LDFLAGS} -o libconftest${DYLIB_EXT} ${LIBS} ${BLAS_LIBS} ${ac_test_BLAS_LIBS} 1>&5 2>&5 +if ${CC} ${CFLAGS} -c conftest.c 1>&5 2>&5; then + if ${CC} ${LDFLAGS} -o conftest${ac_exeext} \ + conftest.${ac_objext} -L. -lconftest \ + 1>&5 2>&5; + then + ## redirect error messages to config.log + output=`./conftest${ac_exeext} 2>&5` + if test ${?} = 0; then + r_cv_blas0_passthrough=yes + fi + fi +fi +if test -n "${r_cv_blas0_passthrough}"; then +r_cv_blas0_passthrough=yes +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +$as_echo "yes" >&6; } +BLAS_LIBS0="${BLAS_LIBS} ${ac_test_BLAS_LIBS}" +else +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +as_fn_error $? "Cannot build Rblas shared library such that it makes external BLAS visible. +An alternative is to use internal BLAS instead and replace +libRblas.dylib with the external BLAS library after R is built." "$LINENO" 5 +fi +fi + rm -f conftest.c conftest.o conftestl.c libconftest.dylib + ;; + esac +fi + + +if test "${use_blas_shlib}" = yes; then + ## set BLAS_LIBS to point at local version + BLAS_LIBS="-L\$(R_HOME)/lib\$(R_ARCH) -lRblas" +fi + + if test "x${use_veclib_g95fix}" = xyes; then + USE_VECLIB_G95FIX_TRUE= + USE_VECLIB_G95FIX_FALSE='#' +else + USE_VECLIB_G95FIX_TRUE='#' + USE_VECLIB_G95FIX_FALSE= +fi + + if test "${acx_blas_ok}" = "yes"; then + USE_EXTERNAL_BLAS_TRUE= + USE_EXTERNAL_BLAS_FALSE='#' +else + USE_EXTERNAL_BLAS_TRUE='#' + USE_EXTERNAL_BLAS_FALSE= +fi + + +## LAPACK. +## The default has already been set on macOS: otherwise it is "no" +## and so this test fails. +if test "${use_lapack}" = "yes"; then + + + + +acx_lapack_ok=no +case "${with_lapack}" in + yes | "") ;; + no) acx_lapack_ok=disable ;; + -* | */* | *.a | *.so | *.so.* | *.sl | *.sl.* | *.o) + LAPACK_LIBS="${with_lapack}" + ;; + *) LAPACK_LIBS="-l${with_lapack}" ;; +esac + +if test "${r_cv_prog_f77_append_underscore}" = yes; then + lapack=dpstrf_ +else + lapack=dpstrf +fi + +# We cannot use LAPACK if BLAS is not found +if test "x${acx_blas_ok}" != xyes; then + acx_lapack_ok=noblas +fi + +acx_lapack_save_LIBS="${LIBS}" +LIBS="${BLAS_LIBS} ${FLIBS} ${LIBS}" + +## LAPACK linked to by default? (Could be in the BLAS libs.) +if test "${acx_lapack_ok}" = no; then + as_ac_var=`$as_echo "ac_cv_func_${lapack}" | $as_tr_sh` +ac_fn_c_check_func "$LINENO" "${lapack}" "$as_ac_var" +if eval test \"x\$"$as_ac_var"\" = x"yes"; then : + acx_lapack_ok=yes +fi + +fi + +## Next, check LAPACK_LIBS environment variable +if test "${acx_lapack_ok}" = no; then + if test "x${LAPACK_LIBS}" != x; then + r_save_LIBS="${LIBS}"; LIBS="${LAPACK_LIBS} ${LIBS}" + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for ${lapack} in ${LAPACK_LIBS}" >&5 +$as_echo_n "checking for ${lapack} in ${LAPACK_LIBS}... " >&6; } + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char ${lapack} (); +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +return ${lapack} (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + acx_lapack_ok=yes +else + LAPACK_LIBS="" +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + { $as_echo "$as_me:${as_lineno-$LINENO}: result: ${acx_lapack_ok}" >&5 +$as_echo "${acx_lapack_ok}" >&6; } + LIBS="${r_save_LIBS}" + fi +fi + +## LAPACK in Sun Performance library? +## No longer test here as will be picked up by the default test. + +## Generic LAPACK library? +if test "${acx_lapack_ok}" = no; then + as_ac_Lib=`$as_echo "ac_cv_lib_lapack_${lapack}" | $as_tr_sh` +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for ${lapack} in -llapack" >&5 +$as_echo_n "checking for ${lapack} in -llapack... " >&6; } +if eval \${$as_ac_Lib+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-llapack $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char ${lapack} (); +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +return ${lapack} (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + eval "$as_ac_Lib=yes" +else + eval "$as_ac_Lib=no" +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +eval ac_res=\$$as_ac_Lib + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } +if eval test \"x\$"$as_ac_Lib"\" = x"yes"; then : + acx_lapack_ok=yes; LAPACK_LIBS="-llapack" +fi + +fi + +LIBS="${acx_lapack_save_LIBS}" + + + +fi +if test "${acx_lapack_ok}" != "yes"; then + LAPACK_LIBS="-L\$(R_HOME)/lib\$(R_ARCH) -lRlapack" +fi + + if test "${acx_lapack_ok}" = "yes"; then + USE_EXTERNAL_LAPACK_TRUE= + USE_EXTERNAL_LAPACK_FALSE='#' +else + USE_EXTERNAL_LAPACK_TRUE='#' + USE_EXTERNAL_LAPACK_FALSE= +fi + + +### * Checks for system services. + +## iconv headers and function. +for ac_header in iconv.h +do : + ac_fn_c_check_header_mongrel "$LINENO" "iconv.h" "ac_cv_header_iconv_h" "$ac_includes_default" +if test "x$ac_cv_header_iconv_h" = xyes; then : + cat >>confdefs.h <<_ACEOF +#define HAVE_ICONV_H 1 +_ACEOF + +fi + +done + +## need to ignore cache for this as it may set LIBS +unset ac_cv_func_iconv +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for iconv" >&5 +$as_echo_n "checking for iconv... " >&6; } +if ${ac_cv_func_iconv+:} false; then : + $as_echo_n "(cached) " >&6 +else + + ac_cv_func_iconv="no" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <stdlib.h> +#ifdef HAVE_ICONV_H +#include <iconv.h> +#endif +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +iconv_t cd = iconv_open("",""); + iconv(cd,NULL,NULL,NULL,NULL); + iconv_close(cd); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_func_iconv=yes +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + if test "$ac_cv_func_iconv" != yes; then + r_save_LIBS="$LIBS" + LIBS="$LIBS -liconv" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <stdlib.h> +#ifdef HAVE_ICONV_H +#include <iconv.h> +#endif +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +iconv_t cd = iconv_open("",""); + iconv(cd,NULL,NULL,NULL,NULL); + iconv_close(cd); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_func_iconv="in libiconv" +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + if test "$ac_cv_func_iconv" = no; then + LIBS="$r_save_LIBS" + fi + fi + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_func_iconv" >&5 +$as_echo "$ac_cv_func_iconv" >&6; } +if test "$ac_cv_func_iconv" != no; then + +$as_echo "#define HAVE_ICONV 1" >>confdefs.h + + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether iconv accepts \"UTF-8\", \"latin1\", \"ASCII\" and \"UCS-*\"" >&5 +$as_echo_n "checking whether iconv accepts \"UTF-8\", \"latin1\", \"ASCII\" and \"UCS-*\"... " >&6; } +if ${r_cv_iconv_latin1+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test "$cross_compiling" = yes; then : + r_cv_iconv_latin1=yes +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +#include "confdefs.h" +#include <stdlib.h> +#ifdef HAVE_ICONV_H +#include <iconv.h> +#endif + +int main () { + iconv_t cd; + cd = iconv_open("latin1","UTF-8"); + if(cd == (iconv_t)(-1)) exit(1); + iconv_close(cd); + cd = iconv_open("UTF-8","latin1"); + if(cd == (iconv_t)(-1)) exit(1); + iconv_close(cd); + cd = iconv_open("","latin1"); + if(cd == (iconv_t)(-1)) exit(1); + iconv_close(cd); + cd = iconv_open("","UTF-8"); + if(cd == (iconv_t)(-1)) exit(1); + iconv_close(cd); + cd = iconv_open("latin1", ""); + if(cd == (iconv_t)(-1)) exit(1); + iconv_close(cd); + cd = iconv_open("UTF-8",""); + if(cd == (iconv_t)(-1)) exit(1); + iconv_close(cd); + cd = iconv_open("ASCII",""); + if(cd == (iconv_t)(-1)) exit(1); + iconv_close(cd); + cd = iconv_open("UCS-2LE",""); + if(cd == (iconv_t)(-1)) exit(1); + iconv_close(cd); + cd = iconv_open("", "UCS-2LE"); + if(cd == (iconv_t)(-1)) exit(1); + iconv_close(cd); + cd = iconv_open("UCS-2BE",""); + if(cd == (iconv_t)(-1)) exit(1); + iconv_close(cd); + cd = iconv_open("", "UCS-2BE"); + if(cd == (iconv_t)(-1)) exit(1); + iconv_close(cd); + cd = iconv_open("UCS-4LE",""); + if(cd == (iconv_t)(-1)) exit(1); + iconv_close(cd); + cd = iconv_open("", "UCS-4LE"); + if(cd == (iconv_t)(-1)) exit(1); + iconv_close(cd); + cd = iconv_open("UCS-4BE",""); + if(cd == (iconv_t)(-1)) exit(1); + iconv_close(cd); + cd = iconv_open("", "UCS-4BE"); + if(cd == (iconv_t)(-1)) exit(1); + iconv_close(cd); + exit(0); +} + +_ACEOF +if ac_fn_c_try_run "$LINENO"; then : + r_cv_iconv_latin1=yes +else + r_cv_iconv_latin1=no +fi +rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ + conftest.$ac_objext conftest.beam conftest.$ac_ext +fi + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $r_cv_iconv_latin1" >&5 +$as_echo "$r_cv_iconv_latin1" >&6; } + + ## on Windows we supply iconv ourselves + case "${host_os}" in + mingw*) + r_cv_iconv_latin1=yes + ;; + esac + if test "$r_cv_iconv_latin1" != yes; then + as_fn_error $? "a suitable iconv is essential" "$LINENO" 5 + fi +fi +## if the iconv we are using was in libiconv we have already included -liconv +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for iconvlist" >&5 +$as_echo_n "checking for iconvlist... " >&6; } +if ${ac_cv_func_iconvlist+:} false; then : + $as_echo_n "(cached) " >&6 +else + + ac_cv_func_iconvlist="no" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <stdlib.h> +#ifdef HAVE_ICONV_H +#include <iconv.h> +#endif +static int count_one (unsigned int namescount, char * *names, void *data) +{return 0;} +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +iconvlist(count_one, NULL); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_func_iconvlist=yes +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_func_iconvlist" >&5 +$as_echo "$ac_cv_func_iconvlist" >&6; } +if test "$ac_cv_func_iconvlist" = yes; then + +$as_echo "#define HAVE_ICONVLIST 1" >>confdefs.h + +fi + + + + + am_save_CPPFLAGS="$CPPFLAGS" + + for element in $INCICONV; do + haveit= + for x in $CPPFLAGS; do + + acl_save_prefix="$prefix" + prefix="$acl_final_prefix" + acl_save_exec_prefix="$exec_prefix" + exec_prefix="$acl_final_exec_prefix" + eval x=\"$x\" + exec_prefix="$acl_save_exec_prefix" + prefix="$acl_save_prefix" + + if test "X$x" = "X$element"; then + haveit=yes + break + fi + done + if test -z "$haveit"; then + CPPFLAGS="${CPPFLAGS}${CPPFLAGS:+ }$element" + fi + done + + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for iconv" >&5 +$as_echo_n "checking for iconv... " >&6; } +if ${am_cv_func_iconv+:} false; then : + $as_echo_n "(cached) " >&6 +else + + am_cv_func_iconv="no, consider installing GNU libiconv" + am_cv_lib_iconv=no + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <stdlib.h> +#include <iconv.h> +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +iconv_t cd = iconv_open("",""); + iconv(cd,NULL,NULL,NULL,NULL); + iconv_close(cd); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + am_cv_func_iconv=yes +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + if test "$am_cv_func_iconv" != yes; then + am_save_LIBS="$LIBS" + LIBS="$LIBS $LIBICONV" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <stdlib.h> +#include <iconv.h> +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +iconv_t cd = iconv_open("",""); + iconv(cd,NULL,NULL,NULL,NULL); + iconv_close(cd); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + am_cv_lib_iconv=yes + am_cv_func_iconv=yes +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + LIBS="$am_save_LIBS" + fi + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $am_cv_func_iconv" >&5 +$as_echo "$am_cv_func_iconv" >&6; } + if test "$am_cv_func_iconv" = yes; then + +$as_echo "#define HAVE_ICONV 1" >>confdefs.h + + fi + if test "$am_cv_lib_iconv" = yes; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking how to link with libiconv" >&5 +$as_echo_n "checking how to link with libiconv... " >&6; } + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $LIBICONV" >&5 +$as_echo "$LIBICONV" >&6; } + else + CPPFLAGS="$am_save_CPPFLAGS" + LIBICONV= + LTLIBICONV= + fi + + + + if test "$am_cv_func_iconv" = yes; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for iconv declaration" >&5 +$as_echo_n "checking for iconv declaration... " >&6; } + if ${am_cv_proto_iconv+:} false; then : + $as_echo_n "(cached) " >&6 +else + + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +#include <stdlib.h> +#include <iconv.h> +extern +#ifdef __cplusplus +"C" +#endif +#if defined(__STDC__) || defined(__cplusplus) +size_t iconv (iconv_t cd, char * *inbuf, size_t *inbytesleft, char * *outbuf, size_t *outbytesleft); +#else +size_t iconv(); +#endif + +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + am_cv_proto_iconv_arg1="" +else + am_cv_proto_iconv_arg1="const" +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + am_cv_proto_iconv="extern size_t iconv (iconv_t cd, $am_cv_proto_iconv_arg1 char * *inbuf, size_t *inbytesleft, char * *outbuf, size_t *outbytesleft);" +fi + + am_cv_proto_iconv=`echo "$am_cv_proto_iconv" | tr -s ' ' | sed -e 's/( /(/'` + { $as_echo "$as_me:${as_lineno-$LINENO}: result: ${ac_t:- + }$am_cv_proto_iconv" >&5 +$as_echo "${ac_t:- + }$am_cv_proto_iconv" >&6; } + +cat >>confdefs.h <<_ACEOF +#define ICONV_CONST $am_cv_proto_iconv_arg1 +_ACEOF + + fi + + +## check sufficient support for MBCS + +want_mbcs_support=yes +## Wide character support -- first test for headers (which are assumed in code) +for ac_header in wchar.h wctype.h +do : + as_ac_Header=`$as_echo "ac_cv_header_$ac_header" | $as_tr_sh` +ac_fn_c_check_header_mongrel "$LINENO" "$ac_header" "$as_ac_Header" "$ac_includes_default" +if eval test \"x\$"$as_ac_Header"\" = x"yes"; then : + cat >>confdefs.h <<_ACEOF +#define `$as_echo "HAVE_$ac_header" | $as_tr_cpp` 1 +_ACEOF + +fi + +done + +for ac_header in wchar wctype; do + as_ac_var=`echo "ac_cv_header_${ac_header}_h"` + this=`eval echo '${'$as_ac_var'}'` + if test "x$this" = xno; then + want_mbcs_support=no + fi +done +if test "$want_mbcs_support" = yes ; then +## Solaris 8 is missing iswblank, but we can make it from iswctype. +## These are all C99, but Cygwin lacks wcsftime & wcstod + for ac_func in mbrtowc wcrtomb wcscoll wcsftime wcstod +do +as_ac_Symbol=`$as_echo "ac_cv_have_decl_$ac_func" | $as_tr_sh` +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $ac_func exists and is declared" >&5 +$as_echo_n "checking whether $ac_func exists and is declared... " >&6; } +if eval \${$as_ac_Symbol+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <wchar.h> + +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +#ifndef $ac_func + char *p = (char *) $ac_func; +#endif + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + eval "$as_ac_Symbol=yes" +else + eval "$as_ac_Symbol=no" +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +fi +eval ac_res=\$$as_ac_Symbol + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } +if test `eval 'as_val=${'$as_ac_Symbol'};$as_echo "$as_val"'` = yes; then : + cat >>confdefs.h <<_ACEOF +#define `$as_echo "HAVE_$ac_func" | $as_tr_cpp` 1 +_ACEOF + +fi +done + + for ac_func in mbstowcs wcstombs +do +as_ac_Symbol=`$as_echo "ac_cv_have_decl_$ac_func" | $as_tr_sh` +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $ac_func exists and is declared" >&5 +$as_echo_n "checking whether $ac_func exists and is declared... " >&6; } +if eval \${$as_ac_Symbol+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <stdlib.h> + +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +#ifndef $ac_func + char *p = (char *) $ac_func; +#endif + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + eval "$as_ac_Symbol=yes" +else + eval "$as_ac_Symbol=no" +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +fi +eval ac_res=\$$as_ac_Symbol + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } +if test `eval 'as_val=${'$as_ac_Symbol'};$as_echo "$as_val"'` = yes; then : + cat >>confdefs.h <<_ACEOF +#define `$as_echo "HAVE_$ac_func" | $as_tr_cpp` 1 +_ACEOF + +fi +done + + for ac_func in wctrans iswblank wctype iswctype +do +as_ac_Symbol=`$as_echo "ac_cv_have_decl_$ac_func" | $as_tr_sh` +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $ac_func exists and is declared" >&5 +$as_echo_n "checking whether $ac_func exists and is declared... " >&6; } +if eval \${$as_ac_Symbol+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <wchar.h> +#include <wctype.h> + +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +#ifndef $ac_func + char *p = (char *) $ac_func; +#endif + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + eval "$as_ac_Symbol=yes" +else + eval "$as_ac_Symbol=no" +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +fi +eval ac_res=\$$as_ac_Symbol + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } +if test `eval 'as_val=${'$as_ac_Symbol'};$as_echo "$as_val"'` = yes; then : + cat >>confdefs.h <<_ACEOF +#define `$as_echo "HAVE_$ac_func" | $as_tr_cpp` 1 +_ACEOF + +fi +done + + for ac_func in mbrtowc mbstowcs wcrtomb wcscoll wcstombs \ + wctrans wctype iswctype + do + as_ac_var=`echo "ac_cv_have_decl_$ac_func"` + this=`eval echo '${'$as_ac_var'}'` + if test "x$this" = xno; then + want_mbcs_support=no + fi + done +fi +## it seems IRIX once had wctrans but not wctrans_t: we check this when we +## know we have the headers and wctrans(). +## Also Solaris 2.6 (very old) seems to be missing mbstate_t +if test "$want_mbcs_support" = yes ; then + ac_fn_c_check_type "$LINENO" "wctrans_t" "ac_cv_type_wctrans_t" "#include <wchar.h> + #include <wctype.h> +" +if test "x$ac_cv_type_wctrans_t" = xyes; then : + +cat >>confdefs.h <<_ACEOF +#define HAVE_WCTRANS_T 1 +_ACEOF + + +fi +ac_fn_c_check_type "$LINENO" "mbstate_t" "ac_cv_type_mbstate_t" "#include <wchar.h> + #include <wctype.h> +" +if test "x$ac_cv_type_mbstate_t" = xyes; then : + +cat >>confdefs.h <<_ACEOF +#define HAVE_MBSTATE_T 1 +_ACEOF + + +fi + + if test $ac_cv_type_wctrans_t != yes; then + want_mbcs_support=no + fi + if test $ac_cv_type_mbstate_t != yes; then + want_mbcs_support=no + fi +fi +if test "x${want_mbcs_support}" != xyes; then +as_fn_error $? "Support for MBCS locales is required." "$LINENO" 5 +fi + + +## support for ICU +if test "$use_ICU" = yes ; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for ICU" >&5 +$as_echo_n "checking for ICU... " >&6; } +if ${r_cv_icu+:} false; then : + $as_echo_n "(cached) " >&6 +else + r_save_LIBS="${LIBS}" +LIBS="${LIBS} -licuuc -licui18n" +if test "$cross_compiling" = yes; then : + r_cv_icu=no +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +#include <unicode/utypes.h> +#include <unicode/ucol.h> +#include <unicode/uloc.h> +#include <unicode/uiter.h> + +#include <stdlib.h> + +int main () { + UErrorCode status = U_ZERO_ERROR; + UCollator *collator; + UCharIterator aIter; + + collator = ucol_open(NULL, &status); + if (U_FAILURE(status)) exit(1); + /* check if ICU is complete enough */ + uiter_setUTF8(&aIter, "abc", 3); + int result = ucol_strcollIter(collator, &aIter, &aIter, &status); + if (U_FAILURE(status)) exit(1); + exit(0); +} + +_ACEOF +if ac_fn_c_try_run "$LINENO"; then : + r_cv_icu=yes +else + r_cv_icu=no +fi +rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ + conftest.$ac_objext conftest.beam conftest.$ac_ext +fi + +LIBS="${r_save_LIBS}" + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $r_cv_icu" >&5 +$as_echo "$r_cv_icu" >&6; } +if test "x${r_cv_icu}" = xyes; then + +$as_echo "#define USE_ICU 1" >>confdefs.h + + LIBS="${LIBS} -licuuc -licui18n" +else + use_ICU=no +fi + + if test "$use_ICU" = no ; then + case "${host_os}" in + darwin*) + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for ucol_open in -licucore" >&5 +$as_echo_n "checking for ucol_open in -licucore... " >&6; } +if ${ac_cv_lib_icucore_ucol_open+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-licucore $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char ucol_open (); +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +return ucol_open (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_icucore_ucol_open=yes +else + ac_cv_lib_icucore_ucol_open=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_icucore_ucol_open" >&5 +$as_echo "$ac_cv_lib_icucore_ucol_open" >&6; } +if test "x$ac_cv_lib_icucore_ucol_open" = xyes; then : + cat >>confdefs.h <<_ACEOF +#define HAVE_LIBICUCORE 1 +_ACEOF + + LIBS="-licucore $LIBS" + +else + as_fn_error $? "library 'icucore' is required for ICU" "$LINENO" 5 +fi + + +$as_echo "#define USE_ICU_APPLE 1" >>confdefs.h + + +$as_echo "#define USE_ICU 1" >>confdefs.h + + use_ICU=yes + ;; + esac + fi +fi + + + +## X11. +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for X" >&5 +$as_echo_n "checking for X... " >&6; } + + +# Check whether --with-x was given. +if test "${with_x+set}" = set; then : + withval=$with_x; +fi + +# $have_x is `yes', `no', `disabled', or empty when we do not yet know. +if test "x$with_x" = xno; then + # The user explicitly disabled X. + have_x=disabled +else + case $x_includes,$x_libraries in #( + *\'*) as_fn_error $? "cannot use X directory names containing '" "$LINENO" 5;; #( + *,NONE | NONE,*) if ${ac_cv_have_x+:} false; then : + $as_echo_n "(cached) " >&6 +else + # One or both of the vars are not set, and there is no cached value. +ac_x_includes=no ac_x_libraries=no +rm -f -r conftest.dir +if mkdir conftest.dir; then + cd conftest.dir + cat >Imakefile <<'_ACEOF' +incroot: + @echo incroot='${INCROOT}' +usrlibdir: + @echo usrlibdir='${USRLIBDIR}' +libdir: + @echo libdir='${LIBDIR}' +_ACEOF + if (export CC; ${XMKMF-xmkmf}) >/dev/null 2>/dev/null && test -f Makefile; then + # GNU make sometimes prints "make[1]: Entering ...", which would confuse us. + for ac_var in incroot usrlibdir libdir; do + eval "ac_im_$ac_var=\`\${MAKE-make} $ac_var 2>/dev/null | sed -n 's/^$ac_var=//p'\`" + done + # Open Windows xmkmf reportedly sets LIBDIR instead of USRLIBDIR. + for ac_extension in a so sl dylib la dll; do + if test ! -f "$ac_im_usrlibdir/libX11.$ac_extension" && + test -f "$ac_im_libdir/libX11.$ac_extension"; then + ac_im_usrlibdir=$ac_im_libdir; break + fi + done + # Screen out bogus values from the imake configuration. They are + # bogus both because they are the default anyway, and because + # using them would break gcc on systems where it needs fixed includes. + case $ac_im_incroot in + /usr/include) ac_x_includes= ;; + *) test -f "$ac_im_incroot/X11/Xos.h" && ac_x_includes=$ac_im_incroot;; + esac + case $ac_im_usrlibdir in + /usr/lib | /usr/lib64 | /lib | /lib64) ;; + *) test -d "$ac_im_usrlibdir" && ac_x_libraries=$ac_im_usrlibdir ;; + esac + fi + cd .. + rm -f -r conftest.dir +fi + +# Standard set of common directories for X headers. +# Check X11 before X11Rn because it is often a symlink to the current release. +ac_x_header_dirs=' +/usr/X11/include +/usr/X11R7/include +/usr/X11R6/include +/usr/X11R5/include +/usr/X11R4/include + +/usr/include/X11 +/usr/include/X11R7 +/usr/include/X11R6 +/usr/include/X11R5 +/usr/include/X11R4 + +/usr/local/X11/include +/usr/local/X11R7/include +/usr/local/X11R6/include +/usr/local/X11R5/include +/usr/local/X11R4/include + +/usr/local/include/X11 +/usr/local/include/X11R7 +/usr/local/include/X11R6 +/usr/local/include/X11R5 +/usr/local/include/X11R4 + +/usr/X386/include +/usr/x386/include +/usr/XFree86/include/X11 + +/usr/include +/usr/local/include +/usr/unsupported/include +/usr/athena/include +/usr/local/x11r5/include +/usr/lpp/Xamples/include + +/usr/openwin/include +/usr/openwin/share/include' + +if test "$ac_x_includes" = no; then + # Guess where to find include files, by looking for Xlib.h. + # First, try using that file with no special directory specified. + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <X11/Xlib.h> +_ACEOF +if ac_fn_c_try_cpp "$LINENO"; then : + # We can compile using X headers with no special include directory. +ac_x_includes= +else + for ac_dir in $ac_x_header_dirs; do + if test -r "$ac_dir/X11/Xlib.h"; then + ac_x_includes=$ac_dir + break + fi +done +fi +rm -f conftest.err conftest.i conftest.$ac_ext +fi # $ac_x_includes = no + +if test "$ac_x_libraries" = no; then + # Check for the libraries. + # See if we find them without any special options. + # Don't add to $LIBS permanently. + ac_save_LIBS=$LIBS + LIBS="-lX11 $LIBS" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <X11/Xlib.h> +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +XrmInitialize () + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + LIBS=$ac_save_LIBS +# We can link X programs with no special library path. +ac_x_libraries= +else + LIBS=$ac_save_LIBS +for ac_dir in `$as_echo "$ac_x_includes $ac_x_header_dirs" | sed s/include/lib/g` +do + # Don't even attempt the hair of trying to link an X program! + for ac_extension in a so sl dylib la dll; do + if test -r "$ac_dir/libX11.$ac_extension"; then + ac_x_libraries=$ac_dir + break 2 + fi + done +done +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +fi # $ac_x_libraries = no + +case $ac_x_includes,$ac_x_libraries in #( + no,* | *,no | *\'*) + # Didn't find X, or a directory has "'" in its name. + ac_cv_have_x="have_x=no";; #( + *) + # Record where we found X for the cache. + ac_cv_have_x="have_x=yes\ + ac_x_includes='$ac_x_includes'\ + ac_x_libraries='$ac_x_libraries'" +esac +fi +;; #( + *) have_x=yes;; + esac + eval "$ac_cv_have_x" +fi # $with_x != no + +if test "$have_x" != yes; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $have_x" >&5 +$as_echo "$have_x" >&6; } + no_x=yes +else + # If each of the values was on the command line, it overrides each guess. + test "x$x_includes" = xNONE && x_includes=$ac_x_includes + test "x$x_libraries" = xNONE && x_libraries=$ac_x_libraries + # Update the cache value to reflect the command line values. + ac_cv_have_x="have_x=yes\ + ac_x_includes='$x_includes'\ + ac_x_libraries='$x_libraries'" + { $as_echo "$as_me:${as_lineno-$LINENO}: result: libraries $x_libraries, headers $x_includes" >&5 +$as_echo "libraries $x_libraries, headers $x_includes" >&6; } +fi + +if test "$no_x" = yes; then + # Not all programs may use this symbol, but it does not hurt to define it. + +$as_echo "#define X_DISPLAY_MISSING 1" >>confdefs.h + + X_CFLAGS= X_PRE_LIBS= X_LIBS= X_EXTRA_LIBS= +else + if test -n "$x_includes"; then + X_CFLAGS="$X_CFLAGS -I$x_includes" + fi + + # It would also be nice to do this for all -L options, not just this one. + if test -n "$x_libraries"; then + X_LIBS="$X_LIBS -L$x_libraries" + # For Solaris; some versions of Sun CC require a space after -R and + # others require no space. Words are not sufficient . . . . + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether -R must be followed by a space" >&5 +$as_echo_n "checking whether -R must be followed by a space... " >&6; } + ac_xsave_LIBS=$LIBS; LIBS="$LIBS -R$x_libraries" + ac_xsave_c_werror_flag=$ac_c_werror_flag + ac_c_werror_flag=yes + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } + X_LIBS="$X_LIBS -R$x_libraries" +else + LIBS="$ac_xsave_LIBS -R $x_libraries" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +$as_echo "yes" >&6; } + X_LIBS="$X_LIBS -R $x_libraries" +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: neither works" >&5 +$as_echo "neither works" >&6; } +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + ac_c_werror_flag=$ac_xsave_c_werror_flag + LIBS=$ac_xsave_LIBS + fi + + # Check for system-dependent libraries X programs must link with. + # Do this before checking for the system-independent R6 libraries + # (-lICE), since we may need -lsocket or whatever for X linking. + + if test "$ISC" = yes; then + X_EXTRA_LIBS="$X_EXTRA_LIBS -lnsl_s -linet" + else + # Martyn Johnson says this is needed for Ultrix, if the X + # libraries were built with DECnet support. And Karl Berry says + # the Alpha needs dnet_stub (dnet does not exist). + ac_xsave_LIBS="$LIBS"; LIBS="$LIBS $X_LIBS -lX11" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char XOpenDisplay (); +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +return XOpenDisplay (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + +else + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for dnet_ntoa in -ldnet" >&5 +$as_echo_n "checking for dnet_ntoa in -ldnet... " >&6; } +if ${ac_cv_lib_dnet_dnet_ntoa+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-ldnet $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char dnet_ntoa (); +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +return dnet_ntoa (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_dnet_dnet_ntoa=yes +else + ac_cv_lib_dnet_dnet_ntoa=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_dnet_dnet_ntoa" >&5 +$as_echo "$ac_cv_lib_dnet_dnet_ntoa" >&6; } +if test "x$ac_cv_lib_dnet_dnet_ntoa" = xyes; then : + X_EXTRA_LIBS="$X_EXTRA_LIBS -ldnet" +fi + + if test $ac_cv_lib_dnet_dnet_ntoa = no; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for dnet_ntoa in -ldnet_stub" >&5 +$as_echo_n "checking for dnet_ntoa in -ldnet_stub... " >&6; } +if ${ac_cv_lib_dnet_stub_dnet_ntoa+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-ldnet_stub $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char dnet_ntoa (); +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +return dnet_ntoa (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_dnet_stub_dnet_ntoa=yes +else + ac_cv_lib_dnet_stub_dnet_ntoa=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_dnet_stub_dnet_ntoa" >&5 +$as_echo "$ac_cv_lib_dnet_stub_dnet_ntoa" >&6; } +if test "x$ac_cv_lib_dnet_stub_dnet_ntoa" = xyes; then : + X_EXTRA_LIBS="$X_EXTRA_LIBS -ldnet_stub" +fi + + fi +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + LIBS="$ac_xsave_LIBS" + + # msh@cis.ufl.edu says -lnsl (and -lsocket) are needed for his 386/AT, + # to get the SysV transport functions. + # Chad R. Larson says the Pyramis MIS-ES running DC/OSx (SVR4) + # needs -lnsl. + # The nsl library prevents programs from opening the X display + # on Irix 5.2, according to T.E. Dickey. + # The functions gethostbyname, getservbyname, and inet_addr are + # in -lbsd on LynxOS 3.0.1/i386, according to Lars Hecking. + ac_fn_c_check_func "$LINENO" "gethostbyname" "ac_cv_func_gethostbyname" +if test "x$ac_cv_func_gethostbyname" = xyes; then : + +fi + + if test $ac_cv_func_gethostbyname = no; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for gethostbyname in -lnsl" >&5 +$as_echo_n "checking for gethostbyname in -lnsl... " >&6; } +if ${ac_cv_lib_nsl_gethostbyname+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lnsl $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char gethostbyname (); +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +return gethostbyname (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_nsl_gethostbyname=yes +else + ac_cv_lib_nsl_gethostbyname=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_nsl_gethostbyname" >&5 +$as_echo "$ac_cv_lib_nsl_gethostbyname" >&6; } +if test "x$ac_cv_lib_nsl_gethostbyname" = xyes; then : + X_EXTRA_LIBS="$X_EXTRA_LIBS -lnsl" +fi + + if test $ac_cv_lib_nsl_gethostbyname = no; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for gethostbyname in -lbsd" >&5 +$as_echo_n "checking for gethostbyname in -lbsd... " >&6; } +if ${ac_cv_lib_bsd_gethostbyname+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lbsd $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char gethostbyname (); +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +return gethostbyname (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_bsd_gethostbyname=yes +else + ac_cv_lib_bsd_gethostbyname=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_bsd_gethostbyname" >&5 +$as_echo "$ac_cv_lib_bsd_gethostbyname" >&6; } +if test "x$ac_cv_lib_bsd_gethostbyname" = xyes; then : + X_EXTRA_LIBS="$X_EXTRA_LIBS -lbsd" +fi + + fi + fi + + # lieder@skyler.mavd.honeywell.com says without -lsocket, + # socket/setsockopt and other routines are undefined under SCO ODT + # 2.0. But -lsocket is broken on IRIX 5.2 (and is not necessary + # on later versions), says Simon Leinen: it contains gethostby* + # variants that don't use the name server (or something). -lsocket + # must be given before -lnsl if both are needed. We assume that + # if connect needs -lnsl, so does gethostbyname. + ac_fn_c_check_func "$LINENO" "connect" "ac_cv_func_connect" +if test "x$ac_cv_func_connect" = xyes; then : + +fi + + if test $ac_cv_func_connect = no; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for connect in -lsocket" >&5 +$as_echo_n "checking for connect in -lsocket... " >&6; } +if ${ac_cv_lib_socket_connect+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lsocket $X_EXTRA_LIBS $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char connect (); +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +return connect (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_socket_connect=yes +else + ac_cv_lib_socket_connect=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_socket_connect" >&5 +$as_echo "$ac_cv_lib_socket_connect" >&6; } +if test "x$ac_cv_lib_socket_connect" = xyes; then : + X_EXTRA_LIBS="-lsocket $X_EXTRA_LIBS" +fi + + fi + + # Guillermo Gomez says -lposix is necessary on A/UX. + ac_fn_c_check_func "$LINENO" "remove" "ac_cv_func_remove" +if test "x$ac_cv_func_remove" = xyes; then : + +fi + + if test $ac_cv_func_remove = no; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for remove in -lposix" >&5 +$as_echo_n "checking for remove in -lposix... " >&6; } +if ${ac_cv_lib_posix_remove+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lposix $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char remove (); +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +return remove (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_posix_remove=yes +else + ac_cv_lib_posix_remove=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_posix_remove" >&5 +$as_echo "$ac_cv_lib_posix_remove" >&6; } +if test "x$ac_cv_lib_posix_remove" = xyes; then : + X_EXTRA_LIBS="$X_EXTRA_LIBS -lposix" +fi + + fi + + # BSDI BSD/OS 2.1 needs -lipc for XOpenDisplay. + ac_fn_c_check_func "$LINENO" "shmat" "ac_cv_func_shmat" +if test "x$ac_cv_func_shmat" = xyes; then : + +fi + + if test $ac_cv_func_shmat = no; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for shmat in -lipc" >&5 +$as_echo_n "checking for shmat in -lipc... " >&6; } +if ${ac_cv_lib_ipc_shmat+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lipc $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char shmat (); +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +return shmat (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_ipc_shmat=yes +else + ac_cv_lib_ipc_shmat=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_ipc_shmat" >&5 +$as_echo "$ac_cv_lib_ipc_shmat" >&6; } +if test "x$ac_cv_lib_ipc_shmat" = xyes; then : + X_EXTRA_LIBS="$X_EXTRA_LIBS -lipc" +fi + + fi + fi + + # Check for libraries that X11R6 Xt/Xaw programs need. + ac_save_LDFLAGS=$LDFLAGS + test -n "$x_libraries" && LDFLAGS="$LDFLAGS -L$x_libraries" + # SM needs ICE to (dynamically) link under SunOS 4.x (so we have to + # check for ICE first), but we must link in the order -lSM -lICE or + # we get undefined symbols. So assume we have SM if we have ICE. + # These have to be linked with before -lX11, unlike the other + # libraries we check for below, so use a different variable. + # John Interrante, Karl Berry + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for IceConnectionNumber in -lICE" >&5 +$as_echo_n "checking for IceConnectionNumber in -lICE... " >&6; } +if ${ac_cv_lib_ICE_IceConnectionNumber+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lICE $X_EXTRA_LIBS $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char IceConnectionNumber (); +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +return IceConnectionNumber (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_ICE_IceConnectionNumber=yes +else + ac_cv_lib_ICE_IceConnectionNumber=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_ICE_IceConnectionNumber" >&5 +$as_echo "$ac_cv_lib_ICE_IceConnectionNumber" >&6; } +if test "x$ac_cv_lib_ICE_IceConnectionNumber" = xyes; then : + X_PRE_LIBS="$X_PRE_LIBS -lSM -lICE" +fi + + LDFLAGS=$ac_save_LDFLAGS + +fi + # standard X11 search macro +use_X11="no" +if test -z "${no_x}"; then + ## now we look for Xt and its header: it seems Intrinsic.h is key. + r_save_CPPFLAGS="${CPPFLAGS}" + CPPFLAGS="${CPPFLAGS} ${X_CFLAGS}" + ac_fn_c_check_header_mongrel "$LINENO" "X11/Intrinsic.h" "ac_cv_header_X11_Intrinsic_h" "$ac_includes_default" +if test "x$ac_cv_header_X11_Intrinsic_h" = xyes; then : + +fi + + + CPPFLAGS="${r_save_CPPFLAGS}" + if test "${ac_cv_header_X11_Intrinsic_h}" = yes ; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for XtToolkitInitialize in -lXt" >&5 +$as_echo_n "checking for XtToolkitInitialize in -lXt... " >&6; } +if ${ac_cv_lib_Xt_XtToolkitInitialize+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lXt ${X_LIBS} -lX11 $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char XtToolkitInitialize (); +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +return XtToolkitInitialize (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_Xt_XtToolkitInitialize=yes +else + ac_cv_lib_Xt_XtToolkitInitialize=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_Xt_XtToolkitInitialize" >&5 +$as_echo "$ac_cv_lib_Xt_XtToolkitInitialize" >&6; } +if test "x$ac_cv_lib_Xt_XtToolkitInitialize" = xyes; then : + have_Xt=yes +else + have_Xt=no +fi + + if test "${have_Xt}" = yes; then + use_X11="yes" + fi + fi +fi +if test "x${use_X11}" = "xyes"; then + +$as_echo "#define HAVE_X11 1" >>confdefs.h + + X_LIBS="${X_LIBS} -lX11 -lXt" +else + if test "x${with_x}" != "xno"; then + as_fn_error $? "--with-x=yes (default) and X11 headers/libs are not available" "$LINENO" 5 + fi +fi + { $as_echo "$as_me:${as_lineno-$LINENO}: result: using X11 ... ${use_X11}" >&5 +$as_echo "using X11 ... ${use_X11}" >&6; } + + if test "x${use_X11}" = "xyes"; then + BUILD_X11_TRUE= + BUILD_X11_FALSE='#' +else + BUILD_X11_TRUE='#' + BUILD_X11_FALSE= +fi + +## check if X11 typedefs KeySym + +if test "${use_X11}" = yes; then + r_save_CPPFLAGS="${CPPFLAGS}" + CPPFLAGS="${CPPFLAGS} ${X_CFLAGS}" + ac_fn_c_check_type "$LINENO" "KeySym" "ac_cv_type_KeySym" "#include <X11/X.h> +" +if test "x$ac_cv_type_KeySym" = xyes; then : + r_cv_type_keysym=yes +else + r_cv_type_keysym=no +fi + + CPPFLAGS="${r_save_CPPFLAGS}" + if test "${r_cv_type_keysym}" = yes; then + +$as_echo "#define HAVE_KEYSYM 1" >>confdefs.h + + fi +fi +## check if Xmu is supported +if test "${use_X11}" = yes; then + r_save_CPPFLAGS="${CPPFLAGS}" + CPPFLAGS="${CPPFLAGS} ${X_CFLAGS}" + ac_fn_c_check_header_mongrel "$LINENO" "X11/Xmu/Atoms.h" "ac_cv_header_X11_Xmu_Atoms_h" "$ac_includes_default" +if test "x$ac_cv_header_X11_Xmu_Atoms_h" = xyes; then : + +fi + + + CPPFLAGS="${r_save_CPPFLAGS}" + if test "${ac_cv_header_X11_Xmu_Atoms_h}" = yes ; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for XmuInternAtom in -lXmu" >&5 +$as_echo_n "checking for XmuInternAtom in -lXmu... " >&6; } +if ${ac_cv_lib_Xmu_XmuInternAtom+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lXmu ${X_LIBS} $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char XmuInternAtom (); +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +return XmuInternAtom (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_Xmu_XmuInternAtom=yes +else + ac_cv_lib_Xmu_XmuInternAtom=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_Xmu_XmuInternAtom" >&5 +$as_echo "$ac_cv_lib_Xmu_XmuInternAtom" >&6; } +if test "x$ac_cv_lib_Xmu_XmuInternAtom" = xyes; then : + use_Xmu=yes +else + use_Xmu=no +fi + + if test "${use_Xmu}" = yes; then + +$as_echo "#define HAVE_X11_Xmu 1" >>confdefs.h + + X_LIBS="${X_LIBS} -lXmu" + fi + fi +fi + +if test "x${want_cairo}" = "xyes"; then + +if test "x${PKGCONF}" = "x"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: not checking for cairo as pkg-config is not present" >&5 +$as_echo "$as_me: not checking for cairo as pkg-config is not present" >&6;} +else + save_CPPFLAGS=${CPPFLAGS} + save_LIBS=${LIBS} + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether pkg-config knows about cairo and pango" >&5 +$as_echo_n "checking whether pkg-config knows about cairo and pango... " >&6; } +if ${r_cv_has_pangocairo+:} false; then : + $as_echo_n "(cached) " >&6 +else + if "${PKGCONF}" --exists pangocairo; then + r_cv_has_pangocairo="yes" + else + r_cv_has_pangocairo="no" + fi + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $r_cv_has_pangocairo" >&5 +$as_echo "$r_cv_has_pangocairo" >&6; } + if test "x${r_cv_has_pangocairo}" = "xyes"; then + modlist="pangocairo" + for module in cairo-png; do + if "${PKGCONF}" --exists ${module}; then + modlist="${modlist} ${module}" + fi + done + if "${PKGCONF}" --exists cairo-pdf; then + modlist="${modlist} cairo-pdf" + r_cairo_pdf=yes + fi + if "${PKGCONF}" --exists cairo-ps; then + modlist="${modlist} cairo-ps" + r_cairo_ps=yes + fi + if "${PKGCONF}" --exists cairo-svg; then + modlist="${modlist} cairo-svg" + r_cairo_svg=yes + fi + if "${PKGCONF}" --exists cairo-xlib; then + xmodlist="${modlist} cairo-xlib" + else + xmodlist="${modlist}" + fi + CAIRO_CPPFLAGS=`"${PKGCONF}" --cflags ${modlist}` + CAIROX11_CPPFLAGS=`"${PKGCONF}" --cflags ${xmodlist}` + CAIRO_LIBS=`"${PKGCONF}" --libs ${modlist}` + CAIROX11_LIBS=`"${PKGCONF}" --libs ${xmodlist}` + + CPPFLAGS="${CPPFLAGS} ${CAIRO_CPPFLAGS}" + LIBS="${LIBS} ${CAIRO_LIBS}" + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether cairo including pango is >= 1.2 and works" >&5 +$as_echo_n "checking whether cairo including pango is >= 1.2 and works... " >&6; } +if ${r_cv_cairo_works+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +#include <pango/pango.h> +#include <pango/pangocairo.h> +#include <cairo-xlib.h> +#if CAIRO_VERSION < 10200 +#error cairo version >= 1.2 required +#endif +int main(void) { + cairo_t *CC = NULL; // silence picky compilers + cairo_arc(CC, 0.0, 0.0, 1.0, 0.0, 6.28); + pango_cairo_create_layout(CC); + pango_font_description_new(); + return 0; + } + +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + r_cv_cairo_works=yes +else + r_cv_cairo_works=no + CAIRO_LIBS= + CAIRO_CFLAGS= + +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $r_cv_cairo_works" >&5 +$as_echo "$r_cv_cairo_works" >&6; } + CPPFLAGS=${save_CPPFLAGS} + LIBS=${save_LIBS} + else ## no pangocairo, check for just cairo + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether pkg-config knows about cairo" >&5 +$as_echo_n "checking whether pkg-config knows about cairo... " >&6; } +if ${r_cv_has_cairo+:} false; then : + $as_echo_n "(cached) " >&6 +else + if "${PKGCONF}" --exists cairo; then + r_cv_has_cairo="yes" + else + r_cv_has_cairo="no" + fi + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $r_cv_has_cairo" >&5 +$as_echo "$r_cv_has_cairo" >&6; } + if test "x${r_cv_has_cairo}" = "xyes"; then + modlist="cairo" + ## on Linux, cairo-ft brings in header paths <cairo-ft.h>: + ## the code which needs this is currently conditionalized + for module in cairo-png cairo-ft; do + if "${PKGCONF}" --exists ${module}; then + modlist="${modlist} ${module}" + fi + done + if "${PKGCONF}" --exists cairo-pdf; then + modlist="${modlist} cairo-pdf" + r_cairo_pdf=yes + fi + if "${PKGCONF}" --exists cairo-ps; then + modlist="${modlist} cairo-ps" + r_cairo_ps=yes + fi + if "${PKGCONF}" --exists cairo-svg; then + modlist="${modlist} cairo-svg" + r_cairo_svg=yes + fi + if "${PKGCONF}" --exists cairo-xlib; then + xmodlist="${modlist} cairo-xlib" + else + xmodlist="${modlist}" + fi + CAIRO_CPPFLAGS=`"${PKGCONF}" --cflags ${modlist}` + CAIROX11_CPPFLAGS=`"${PKGCONF}" --cflags ${xmodlist}` + case "${host_os}" in + darwin*) + ## This is for static macOS build + ## FIXME: doing that unconditionally is really not a good idea + CAIRO_LIBS=`"${PKGCONF}" --static --libs ${modlist}` + CAIROX11_LIBS=`"${PKGCONF}" --static --libs ${xmodlist}` + ;; + *) + CAIRO_LIBS=`"${PKGCONF}" --libs ${modlist}` + CAIROX11_LIBS=`"${PKGCONF}" --libs ${xmodlist}` + ;; + esac + + CPPFLAGS="${CPPFLAGS} ${CAIRO_CPPFLAGS}" + LIBS="${LIBS} ${CAIRO_LIBS}" + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether cairo is >= 1.2 and works" >&5 +$as_echo_n "checking whether cairo is >= 1.2 and works... " >&6; } +if ${r_cv_cairo_works+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +#include <cairo.h> +#include <cairo-xlib.h> +#if CAIRO_VERSION < 10200 +#error cairo version >= 1.2 required +#endif +int main(void) { + cairo_t *CC; + cairo_arc(CC, 0.0, 0.0, 1.0, 0.0, 6.28); + cairo_select_font_face (CC, "Helvetica", CAIRO_FONT_SLANT_NORMAL, + CAIRO_FONT_WEIGHT_BOLD); + return 0; + } + +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + r_cv_cairo_works=yes +else + r_cv_cairo_works=no + CAIRO_LIBS= + CAIRO_CFLAGS= + +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $r_cv_cairo_works" >&5 +$as_echo "$r_cv_cairo_works" >&6; } + CPPFLAGS=${save_CPPFLAGS} + LIBS=${save_LIBS} + fi + fi +fi + +if test "x${r_cv_has_pangocairo}" = xyes; then + +$as_echo "#define HAVE_PANGOCAIRO 1" >>confdefs.h + +fi +if test "x${r_cv_cairo_works}" = xyes; then + +$as_echo "#define HAVE_WORKING_CAIRO 1" >>confdefs.h + +fi +if test "x${r_cairo_pdf}" = xyes; then + +$as_echo "#define HAVE_CAIRO_PDF 1" >>confdefs.h + +fi +if test "x${r_cairo_ps}" = xyes; then + +$as_echo "#define HAVE_CAIRO_PS 1" >>confdefs.h + +fi +if test "x${r_cairo_svg}" = xyes; then + +$as_echo "#define HAVE_CAIRO_SVG 1" >>confdefs.h + +fi + + + + + +fi + if test "x${r_cv_cairo_works}" = xyes; then + BUILD_DEVCAIRO_TRUE= + BUILD_DEVCAIRO_FALSE='#' +else + BUILD_DEVCAIRO_TRUE='#' + BUILD_DEVCAIRO_FALSE= +fi + + + +## Aqua +case "${host_os}" in + darwin*) + ## check for CoreFoundation framework (chances are much higher + ## that we can build AQUA if this one is present) + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for CFStringGetSystemEncoding in CoreFoundation framework" >&5 +$as_echo_n "checking for CFStringGetSystemEncoding in CoreFoundation framework... " >&6; } +if ${r_cv_check_fw_CoreFoundation+:} false; then : + $as_echo_n "(cached) " >&6 +else + r_cv_check_fw_save_LIBS=$LIBS + r_cv_check_fw_CoreFoundation=no + LIBS="-framework CoreFoundation $LIBS" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char CFStringGetSystemEncoding (); +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +return CFStringGetSystemEncoding (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + r_cv_check_fw_CoreFoundation="-framework CoreFoundation" +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + LIBS=$r_cv_check_fw_save_LIBS + if test "$r_cv_check_fw_CoreFoundation" != no; then : + +cat >>confdefs.h <<_ACEOF +#define HAVE_COREFOUNDATION_FW 1 +_ACEOF + + have_CoreFoundation_fw=yes +else + have_CoreFoundation_fw=no +fi + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $r_cv_check_fw_CoreFoundation" >&5 +$as_echo "$r_cv_check_fw_CoreFoundation" >&6; } + + ## FIXME: we should verify that we can use Obj-C exceptions + ## such as @try and friends. The OBJC compiler tests + ## above add -fobjc-exceptions where possible, but + ## they don't check that the exceptions are available. + use_aqua=no +if test "${want_aqua}" = yes; then + case "${host_os}" in + darwin*) + ## we can build AQUA only with CoreFoundation, otherwise + ## Quartz device won't build + if test -n "${r_cv_check_fw_CoreFoundation}" ; then + use_aqua=yes + else + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: requested 'aqua' but CoreFoundation was not found" >&5 +$as_echo "$as_me: WARNING: requested 'aqua' but CoreFoundation was not found" >&2;} + fi + ;; + esac +fi +if test "${use_aqua}" = yes; then + +$as_echo "#define HAVE_AQUA 1" >>confdefs.h + +fi + + ## That sets HAVE_AQUA, which is used to enable support of R.app + ## and also in C headers and files related to quartz() + ;; + *) + use_aqua=no + ;; +esac +## Now used: +## - to compile src/unix/aqua.c +## - in etc/Renviron to set the personal library, +## - in grDevices to select building quartz() + if test "x${use_aqua}" = xyes; then + BUILD_AQUA_TRUE= + BUILD_AQUA_FALSE='#' +else + BUILD_AQUA_TRUE='#' + BUILD_AQUA_FALSE= +fi + + +## Tcl/Tk. +if test "${want_tcltk}" = yes; then + have_tcltk=yes + ## (Note that the subsequent 3 macros assume that have_tcltk has been + ## set appropriately.) + for ac_prog in ${TCL_CONFIG} tclConfig.sh +do + # Extract the first word of "$ac_prog", so it can be a program name with args. +set dummy $ac_prog; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_path_TCL_CONFIG+:} false; then : + $as_echo_n "(cached) " >&6 +else + case $TCL_CONFIG in + [\\/]* | ?:[\\/]*) + ac_cv_path_TCL_CONFIG="$TCL_CONFIG" # Let the user override the test with a path. + ;; + *) + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_path_TCL_CONFIG="$as_dir/$ac_word$ac_exec_ext" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + + ;; +esac +fi +TCL_CONFIG=$ac_cv_path_TCL_CONFIG +if test -n "$TCL_CONFIG"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $TCL_CONFIG" >&5 +$as_echo "$TCL_CONFIG" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + test -n "$TCL_CONFIG" && break +done + +if test -z "${TCL_CONFIG}"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for tclConfig.sh in library (sub)directories" >&5 +$as_echo_n "checking for tclConfig.sh in library (sub)directories... " >&6; } +if ${r_cv_path_TCL_CONFIG+:} false; then : + $as_echo_n "(cached) " >&6 +else + for ldir in /usr/local/${LIBnn} /usr/${LIBnn} /${LIBnn} /opt/lib /sw/lib /opt/csw/lib /usr/sfw/lib /opt/freeware/lib; do + for dir in \ + ${ldir} \ + `ls -d ${ldir}/tcl[8-9].[0-9]* 2>/dev/null | sort -r`; do + if test -f ${dir}/tclConfig.sh; then + r_cv_path_TCL_CONFIG="${dir}/tclConfig.sh" + break 2 + fi + done +done +fi + +if test -n "${r_cv_path_TCL_CONFIG}"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: ${r_cv_path_TCL_CONFIG}" >&5 +$as_echo "${r_cv_path_TCL_CONFIG}" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + if test -n "${r_cv_path_TCL_CONFIG}"; then + TCL_CONFIG="${r_cv_path_TCL_CONFIG}" + fi +fi +for ac_prog in ${TK_CONFIG} tkConfig.sh +do + # Extract the first word of "$ac_prog", so it can be a program name with args. +set dummy $ac_prog; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_path_TK_CONFIG+:} false; then : + $as_echo_n "(cached) " >&6 +else + case $TK_CONFIG in + [\\/]* | ?:[\\/]*) + ac_cv_path_TK_CONFIG="$TK_CONFIG" # Let the user override the test with a path. + ;; + *) + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_path_TK_CONFIG="$as_dir/$ac_word$ac_exec_ext" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + + ;; +esac +fi +TK_CONFIG=$ac_cv_path_TK_CONFIG +if test -n "$TK_CONFIG"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $TK_CONFIG" >&5 +$as_echo "$TK_CONFIG" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + test -n "$TK_CONFIG" && break +done + +if test -z "${TK_CONFIG}"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for tkConfig.sh in library (sub)directories" >&5 +$as_echo_n "checking for tkConfig.sh in library (sub)directories... " >&6; } +if ${r_cv_path_TK_CONFIG+:} false; then : + $as_echo_n "(cached) " >&6 +else + for ldir in /usr/local/${LIBnn} /usr/${LIBnn} /${LIBnn} /opt/lib /sw/lib /opt/csw/lib /usr/sfw/lib /opt/freeware/lib; do + for dir in \ + ${ldir} \ + `ls -d ${ldir}/tk[8-9].[0-9]* 2>/dev/null | sort -r`; do + if test -f ${dir}/tkConfig.sh; then + r_cv_path_TK_CONFIG="${dir}/tkConfig.sh" + break 2 + fi + done +done +fi + +if test -n "${r_cv_path_TK_CONFIG}"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: ${r_cv_path_TK_CONFIG}" >&5 +$as_echo "${r_cv_path_TK_CONFIG}" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + if test -n "${r_cv_path_TK_CONFIG}"; then + TK_CONFIG="${r_cv_path_TK_CONFIG}" + fi +fi +if test -z "${TCLTK_CPPFLAGS}" \ + || test -z "${TCLTK_LIBS}"; then + ## Check whether the versions found via the *Config.sh files are at + ## least 8; otherwise, issue a warning and turn off Tcl/Tk support. + ## Note that in theory a system could have outdated versions of the + ## *Config.sh scripts and yet up-to-date installations of Tcl/Tk in + ## standard places ... + ## This doesn't make a great deal of sense: on past form + ## we don't even expect future versions of 8.x to work, let alone 9.0 + if test -n "${TCL_CONFIG}"; then + . ${TCL_CONFIG} + if test ${TCL_MAJOR_VERSION} -lt 8; then + warn_tcltk_version="Tcl/Tk support requires Tcl version >= 8" + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: ${warn_tcltk_version}" >&5 +$as_echo "$as_me: WARNING: ${warn_tcltk_version}" >&2;} + have_tcltk=no + fi + fi + if test -n "${TK_CONFIG}" \ + && test -z "${warn_tcltk_version}"; then + . ${TK_CONFIG} + if test ${TK_MAJOR_VERSION} -lt 8; then + warn_tcltk_version="Tcl/Tk support requires Tk version >= 8" + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: ${warn_tcltk_version}" >&5 +$as_echo "$as_me: WARNING: ${warn_tcltk_version}" >&2;} + have_tcltk=no + fi + fi + if test -n "${TCL_CONFIG}" \ + && test -n "${TK_CONFIG}" \ + && test -z "${warn_tcltk_version}"; then + if test ${TCL_MAJOR_VERSION} -ne ${TK_MAJOR_VERSION} \ + || test ${TCL_MINOR_VERSION} -ne ${TK_MINOR_VERSION}; then + warn_tcltk_version="Tcl and Tk major or minor versions disagree" + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: ${warn_tcltk_version}" >&5 +$as_echo "$as_me: WARNING: ${warn_tcltk_version}" >&2;} + have_tcltk=no + fi + fi +fi + + +if test -z "${TCLTK_CPPFLAGS}"; then + ## We have to do the work. + if test "${have_tcltk}" = yes; then + ## Part 1. Check for tcl.h. + found_tcl_h=no + if test -n "${TCL_CONFIG}"; then + . ${TCL_CONFIG} + ## TCL_INCLUDE_SPEC (if set) is what we want. + if test -n ${TCL_INCLUDE_SPEC} ; then + r_save_CPPFLAGS="${CPPFLAGS}" + CPPFLAGS="${CPPFLAGS} ${TCL_INCLUDE_SPEC}" + ac_fn_c_check_header_mongrel "$LINENO" "tcl.h" "ac_cv_header_tcl_h" "$ac_includes_default" +if test "x$ac_cv_header_tcl_h" = xyes; then : + TCLTK_CPPFLAGS="${TCL_INCLUDE_SPEC}" + found_tcl_h=yes +fi + + + CPPFLAGS="${r_save_CPPFLAGS}" + fi + if test "${found_tcl_h}" = no; then + ## Look for tcl.h in + ## ${TCL_PREFIX}/include/tcl${TCL_VERSION} + ## ${TCL_PREFIX}/include + ## Also look in + ## ${TCL_PREFIX}/include/tcl${TCL_VERSION}/generic + ## to deal with current FreeBSD layouts. These also link the real + ## thing to the version subdir, but the link cannot be used as it + ## fails to include 'tclDecls.h' which is not linked. Hence we + ## must look for the real thing first. Argh ... + for dir in \ + ${TCL_PREFIX}/include/tcl${TCL_VERSION}/generic \ + ${TCL_PREFIX}/include/tcl${TCL_VERSION} \ + ${TCL_PREFIX}/include; do + as_ac_Header=`$as_echo "ac_cv_header_${dir}/tcl.h" | $as_tr_sh` +ac_fn_c_check_header_mongrel "$LINENO" "${dir}/tcl.h" "$as_ac_Header" "$ac_includes_default" +if eval test \"x\$"$as_ac_Header"\" = x"yes"; then : + TCLTK_CPPFLAGS="-I${dir}" + found_tcl_h=yes + break +fi + + + done + fi + fi + if test "${found_tcl_h}" = no; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for tcl.h" >&5 +$as_echo_n "checking for tcl.h... " >&6; } +if ${r_cv_header_tcl_h+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <tcl.h> +/* Revise if 9.x ever appears (and 8.x seems to increment only + every few years). */ +#if (TCL_MAJOR_VERSION >= 8) && (TCL_MINOR_VERSION >= 4) + yes +#endif + +_ACEOF +if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | + $EGREP "yes" >/dev/null 2>&1; then : + r_cv_header_tcl_h=yes +else + r_cv_header_tcl_h=no +fi +rm -f conftest* + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $r_cv_header_tcl_h" >&5 +$as_echo "$r_cv_header_tcl_h" >&6; } + + if test "${r_cv_header_tcl_h}" = yes; then + found_tcl_h=yes + else + have_tcltk=no + fi + fi + fi + if test "${have_tcltk}" = yes; then + ## Part 2. Check for tk.h. + found_tk_h=no + found_tk_by_config=no + if test -n "${TK_CONFIG}"; then + . ${TK_CONFIG} + ## TK_INCLUDE_SPEC (if set) is what we want. + if test -n ${TK_INCLUDE_SPEC} ; then + r_save_CPPFLAGS="${CPPFLAGS}" + CPPFLAGS="${CPPFLAGS} ${TCLTK_CPPFLAGS} ${TK_XINCLUDES} ${TK_INCLUDE_SPEC}" + ac_fn_c_check_header_mongrel "$LINENO" "tk.h" "ac_cv_header_tk_h" "$ac_includes_default" +if test "x$ac_cv_header_tk_h" = xyes; then : + TCLTK_CPPFLAGS="${TCLTK_CPPFLAGS} ${TK_INCLUDE_SPEC}" + found_tk_h=yes +fi + + + found_tk_by_config=yes + CPPFLAGS="${r_save_CPPFLAGS}" + fi + if test "${found_tk_h}" = no; then + ## Look for tk.h in + ## ${TK_PREFIX}/include/tk${TK_VERSION} + ## ${TK_PREFIX}/include + ## Also look in + ## ${TK_PREFIX}/include/tcl${TK_VERSION} + ## to compensate for Debian madness ... + ## Also look in + ## ${TK_PREFIX}/include/tk${TK_VERSION}/generic + ## to deal with current FreeBSD layouts. See above for details. + ## + ## As the AC_CHECK_HEADER test tries including the header file and + ## tk.h includes tcl.h and X11/Xlib.h, we need to change CPPFLAGS + ## for the check. + r_save_CPPFLAGS="${CPPFLAGS}" + CPPFLAGS="${CPPFLAGS} ${TK_XINCLUDES} ${TCLTK_CPPFLAGS}" + for dir in \ + ${TK_PREFIX}/include/tk${TK_VERSION}/generic \ + ${TK_PREFIX}/include/tk${TK_VERSION} \ + ${TK_PREFIX}/include/tcl${TK_VERSION} \ + ${TK_PREFIX}/include; do + as_ac_Header=`$as_echo "ac_cv_header_${dir}/tk.h" | $as_tr_sh` +ac_fn_c_check_header_mongrel "$LINENO" "${dir}/tk.h" "$as_ac_Header" "$ac_includes_default" +if eval test \"x\$"$as_ac_Header"\" = x"yes"; then : + TCLTK_CPPFLAGS="${TCLTK_CPPFLAGS} -I${dir}" + found_tk_h=yes + break +fi + + + done + CPPFLAGS="${r_save_CPPFLAGS}" + fi + fi + if test "${found_tk_h}" = no; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for tk.h" >&5 +$as_echo_n "checking for tk.h... " >&6; } +if ${r_cv_header_tk_h+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <tk.h> +/* Revise if 9.x ever appears (and 8.x seems to increment only + every few years). */ +#if (TK_MAJOR_VERSION >= 8) && (TK_MINOR_VERSION >= 4) + yes +#endif + +_ACEOF +if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | + $EGREP "yes" >/dev/null 2>&1; then : + r_cv_header_tk_h=yes +else + r_cv_header_tk_h=no +fi +rm -f conftest* + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $r_cv_header_tk_h" >&5 +$as_echo "$r_cv_header_tk_h" >&6; } + + if test "{r_cv_header_tk_h}" = yes; then + found_tk_h=yes + else + have_tcltk=no + fi + fi + fi +fi +## TK_XINCLUDES should be empty for Aqua Tk, so earlier test was wrong +## Our code does not include any X headers, but tk.h may .... +## That is true even on macOS, but Aqua Tk has a private version of +## X11 headers, and we want that one and not the XQuartz one. +if test "${have_tcltk}" = yes; then + if test "${found_tk_by_config}" = yes; then + TCLTK_CPPFLAGS="${TCLTK_CPPFLAGS} ${TK_XINCLUDES}" + else + TCLTK_CPPFLAGS="${TCLTK_CPPFLAGS} ${X_CFLAGS}" + fi +fi + + +if test -z "${TCLTK_LIBS}"; then + ## We have to do the work. + if test "${have_tcltk}" = yes; then + ## Part 1. Try finding the tcl library. + if test -n "${TCL_CONFIG}"; then + . ${TCL_CONFIG} + TCLTK_LIBS="${TCL_LIB_SPEC}" + else + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for Tcl_CreateInterp in -ltcl" >&5 +$as_echo_n "checking for Tcl_CreateInterp in -ltcl... " >&6; } +if ${ac_cv_lib_tcl_Tcl_CreateInterp+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-ltcl $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char Tcl_CreateInterp (); +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +return Tcl_CreateInterp (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_tcl_Tcl_CreateInterp=yes +else + ac_cv_lib_tcl_Tcl_CreateInterp=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_tcl_Tcl_CreateInterp" >&5 +$as_echo "$ac_cv_lib_tcl_Tcl_CreateInterp" >&6; } +if test "x$ac_cv_lib_tcl_Tcl_CreateInterp" = xyes; then : + TCLTK_LIBS=-ltcl +else + have_tcltk=no +fi + + fi + fi + if test "${have_tcltk}" = yes; then + ## Part 2. Try finding the tk library. + if test -n "${TK_CONFIG}"; then + . ${TK_CONFIG} + TCLTK_LIBS="${TCLTK_LIBS} ${TK_LIB_SPEC} ${TK_XLIBSW}" + else + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for Tk_Init in -ltk" >&5 +$as_echo_n "checking for Tk_Init in -ltk... " >&6; } +if ${ac_cv_lib_tk_Tk_Init+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-ltk ${TCLTK_LIBS} $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char Tk_Init (); +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +return Tk_Init (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_tk_Tk_Init=yes +else + ac_cv_lib_tk_Tk_Init=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_tk_Tk_Init" >&5 +$as_echo "$ac_cv_lib_tk_Tk_Init" >&6; } +if test "x$ac_cv_lib_tk_Tk_Init" = xyes; then : + cat >>confdefs.h <<_ACEOF +#define HAVE_LIBTK 1 +_ACEOF + + LIBS="-ltk $LIBS" + +fi + + if test "${ac_cv_lib_tk_Tk_Init}" = no; then + ## Grr, simple -ltk does not work. + ## But maybe we simply need to add X11 libs. + ## Note that we cannot simply repeat the above test with extra + ## libs, because AC_CHECK_LIB uses the corresponding cache var + ## (ac_cv_lib_tk_Tk_Init in our case) if set. As using unset + ## is not portable shell programming according to the Autoconf + ## docs, we use Tk_SafeInit in the test with X11 libs added. + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for Tk_SafeInit in -ltk" >&5 +$as_echo_n "checking for Tk_SafeInit in -ltk... " >&6; } +if ${ac_cv_lib_tk_Tk_SafeInit+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-ltk ${TCLTK_LIBS} ${X_LIBS} $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char Tk_SafeInit (); +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +return Tk_SafeInit (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_tk_Tk_SafeInit=yes +else + ac_cv_lib_tk_Tk_SafeInit=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_tk_Tk_SafeInit" >&5 +$as_echo "$ac_cv_lib_tk_Tk_SafeInit" >&6; } +if test "x$ac_cv_lib_tk_Tk_SafeInit" = xyes; then : + TCLTK_LIBS="${TCLTK_LIBS} -ltk ${X_LIBS}" +else + have_tcltk=no +fi + + fi + fi + fi + ## Postprocessing for AIX. + ## On AIX, the *_LIB_SPEC variables need to contain '-bI:' flags for + ## the Tcl export file. These are really flags for ld rather than the + ## C/C++ compilers, and hence may need protection via '-Wl,'. + ## We have two ways of doing that: + ## * Recording whether '-Wl,' is needed for the C or C++ compilers, + ## and getting this info into the TCLTK_LIBS make variable ... mess! + ## * Protecting all entries in TCLTK_LIBS that do not start with '-l' + ## or '-L' with '-Wl,' (hoping that all compilers understand this). + ## Easy, hence ... + case "${host_os}" in + aix*) + orig_TCLTK_LIBS="${TCLTK_LIBS}" + TCLTK_LIBS= + for flag in ${orig_TCLTK_LIBS}; do + case "${flag}" in + -l*|-L*|-Wl,*) ;; + *) flag="-Wl,${flag}" ;; + esac + TCLTK_LIBS="${TCLTK_LIBS} ${flag}" + done + ;; + esac + ## Force evaluation ('-ltcl8.3${TCL_DBGX}' and friends ...). + eval "TCLTK_LIBS=\"${TCLTK_LIBS}\"" +fi + + if test "${have_tcltk}" = yes; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether compiling/linking Tcl/Tk code works" >&5 +$as_echo_n "checking whether compiling/linking Tcl/Tk code works... " >&6; } +if ${r_cv_tcltk_works+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + +r_save_CPPFLAGS="${CPPFLAGS}" +r_save_LIBS="${LIBS}" +CPPFLAGS="${CPPFLAGS} ${TCLTK_CPPFLAGS}" +LIBS="${LIBS} ${TCLTK_LIBS}" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <tcl.h> +#include <tk.h> + +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +static char * p1 = (char *) Tcl_Init; +static char * p2 = (char *) Tk_Init; + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + r_cv_tcltk_works=yes +else + r_cv_tcltk_works=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +CPPFLAGS="${r_save_CPPFLAGS}" +LIBS="${r_save_LIBS}" +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $r_cv_tcltk_works" >&5 +$as_echo "$r_cv_tcltk_works" >&6; } + + have_tcltk=${r_cv_tcltk_works} + fi +else + have_tcltk=no + ## Just making sure. + TCLTK_CPPFLAGS= + TCLTK_LIBS= +fi +if test "${have_tcltk}" = yes; then + +$as_echo "#define HAVE_TCLTK 1" >>confdefs.h + + use_tcltk=yes +else + use_tcltk=no +fi + + + + + +## BSD networking. +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for BSD networking" >&5 +$as_echo_n "checking for BSD networking... " >&6; } +if ${r_cv_bsd_networking+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test "${ac_cv_header_netdb_h}" = yes \ + && test "${ac_cv_header_arpa_inet_h}" = yes \ + && test "${ac_cv_header_netinet_in_h}" = yes \ + && test "${ac_cv_header_sys_socket_h}" = yes \ + && test "${ac_cv_search_connect}" != no \ + && test "${ac_cv_search_gethostbyname}" != no; then + r_cv_bsd_networking=yes +else + as_fn_error $? "BSD networking functions are required" "$LINENO" 5 +fi +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $r_cv_bsd_networking" >&5 +$as_echo "$r_cv_bsd_networking" >&6; } + + +## XDR headers and library routines. +ac_fn_c_check_header_mongrel "$LINENO" "rpc/types.h" "ac_cv_header_rpc_types_h" "$ac_includes_default" +if test "x$ac_cv_header_rpc_types_h" = xyes; then : + +fi + + +if test "${ac_cv_header_rpc_types_h}" = yes ; then + ac_fn_c_check_header_compile "$LINENO" "rpc/xdr.h" "ac_cv_header_rpc_xdr_h" "#include <rpc/types.h> +" +if test "x$ac_cv_header_rpc_xdr_h" = xyes; then : + +fi + + +fi +if test "${ac_cv_header_rpc_types_h}" = yes && \ + test "${ac_cv_header_rpc_xdr_h}" = yes && \ + test "${ac_cv_search_xdr_string}" != no ; then + r_xdr=yes +else + r_xdr=no +fi +TIRPC_CPPFLAGS= +if test "${r_xdr}" = no ; then + ## No RPC headers, so try for TI-RPC headers: need /usr/include/tirpc + ## on include path to find /usr/include/tirpc/netconfig.h + save_CPPFLAGS=${CPPFLAGS} + CPPFLAGS="${CPPFLAGS} -I/usr/include/tirpc" + ac_fn_c_check_header_mongrel "$LINENO" "tirpc/rpc/types.h" "ac_cv_header_tirpc_rpc_types_h" "$ac_includes_default" +if test "x$ac_cv_header_tirpc_rpc_types_h" = xyes; then : + +fi + + + if test "${ac_cv_header_tirpc_rpc_types_h}" = yes ; then + ac_fn_c_check_header_compile "$LINENO" "tirpc/rpc/xdr.h" "ac_cv_header_tirpc_rpc_xdr_h" "#include <tirpc/rpc/types.h> +" +if test "x$ac_cv_header_tirpc_rpc_xdr_h" = xyes; then : + +fi + + + fi + if test "${ac_cv_header_tirpc_rpc_types_h}" = yes && \ + test "${ac_cv_header_tirpc_rpc_xdr_h}" = yes && + test "${ac_cv_search_xdr_string}" != no ; then + TIRPC_CPPFLAGS=-I/usr/include/tirpc + r_xdr=yes + fi + CPPFLAGS="${save_CPPFLAGS}" +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for XDR support" >&5 +$as_echo_n "checking for XDR support... " >&6; } +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: ${r_xdr}" >&5 +$as_echo "${r_xdr}" >&6; } + if test "x${r_xdr}" = xno; then + BUILD_XDR_TRUE= + BUILD_XDR_FALSE='#' +else + BUILD_XDR_TRUE='#' + BUILD_XDR_FALSE= +fi + + + + +## zlib headers and libraries. +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for inflateInit2_ in -lz" >&5 +$as_echo_n "checking for inflateInit2_ in -lz... " >&6; } +if ${ac_cv_lib_z_inflateInit2_+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lz $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char inflateInit2_ (); +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +return inflateInit2_ (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_z_inflateInit2_=yes +else + ac_cv_lib_z_inflateInit2_=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_z_inflateInit2_" >&5 +$as_echo "$ac_cv_lib_z_inflateInit2_" >&6; } +if test "x$ac_cv_lib_z_inflateInit2_" = xyes; then : + have_zlib=yes +else + have_zlib=no +fi + +if test "${have_zlib}" = yes; then + ac_fn_c_check_header_mongrel "$LINENO" "zlib.h" "ac_cv_header_zlib_h" "$ac_includes_default" +if test "x$ac_cv_header_zlib_h" = xyes; then : + have_zlib=yes +else + have_zlib=no +fi + + +fi +if test "${have_zlib}" = yes; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking if zlib version >= 1.2.5" >&5 +$as_echo_n "checking if zlib version >= 1.2.5... " >&6; } +if ${r_cv_header_zlib_h+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test "$cross_compiling" = yes; then : + r_cv_header_zlib_h=no +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +#include <stdlib.h> +#include <string.h> +#include <zlib.h> +int main() { +#ifdef ZLIB_VERNUM + if (ZLIB_VERNUM < 0x1250) { + exit(1); + } + exit(0); +#else + exit(1); +#endif +} + +_ACEOF +if ac_fn_c_try_run "$LINENO"; then : + r_cv_header_zlib_h=yes +else + r_cv_header_zlib_h=no +fi +rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ + conftest.$ac_objext conftest.beam conftest.$ac_ext +fi + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $r_cv_header_zlib_h" >&5 +$as_echo "$r_cv_header_zlib_h" >&6; } + + have_zlib=${r_cv_header_zlib_h} +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether zlib support suffices" >&5 +$as_echo_n "checking whether zlib support suffices... " >&6; } +if test "${have_zlib}" != yes; then + as_fn_error $? "zlib library and headers are required" "$LINENO" 5 +else + LIBS="-lz ${LIBS}" + { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +$as_echo "yes" >&6; } + { $as_echo "$as_me:${as_lineno-$LINENO}: checking mmap support for zlib" >&5 +$as_echo_n "checking mmap support for zlib... " >&6; } +if ${r_cv_zlib_mmap+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test "$cross_compiling" = yes; then : + r_cv_zlib_mmap=yes +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +#include <stdlib.h> +#include <sys/types.h> +#include <sys/mman.h> +#include <sys/stat.h> +caddr_t hello() { + exit(mmap((caddr_t)0, (off_t)0, PROT_READ, MAP_SHARED, 0, (off_t)0)); +} + +_ACEOF +if ac_fn_c_try_run "$LINENO"; then : + r_cv_zlib_mmap=no +else + r_cv_zlib_mmap=yes +fi +rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ + conftest.$ac_objext conftest.beam conftest.$ac_ext +fi + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $r_cv_zlib_mmap" >&5 +$as_echo "$r_cv_zlib_mmap" >&6; } + +fi + if test "x${have_zlib}" = xno && test "x${r_cv_zlib_mmap}" = xyes; then + USE_MMAP_ZLIB_TRUE= + USE_MMAP_ZLIB_FALSE='#' +else + USE_MMAP_ZLIB_TRUE='#' + USE_MMAP_ZLIB_FALSE= +fi + + + +## bzlib headers and libraries. +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for BZ2_bzlibVersion in -lbz2" >&5 +$as_echo_n "checking for BZ2_bzlibVersion in -lbz2... " >&6; } +if ${ac_cv_lib_bz2_BZ2_bzlibVersion+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lbz2 $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char BZ2_bzlibVersion (); +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +return BZ2_bzlibVersion (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_bz2_BZ2_bzlibVersion=yes +else + ac_cv_lib_bz2_BZ2_bzlibVersion=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_bz2_BZ2_bzlibVersion" >&5 +$as_echo "$ac_cv_lib_bz2_BZ2_bzlibVersion" >&6; } +if test "x$ac_cv_lib_bz2_BZ2_bzlibVersion" = xyes; then : + have_bzlib=yes +else + have_bzlib=no +fi + +if test "${have_bzlib}" = yes; then + for ac_header in bzlib.h +do : + ac_fn_c_check_header_mongrel "$LINENO" "bzlib.h" "ac_cv_header_bzlib_h" "$ac_includes_default" +if test "x$ac_cv_header_bzlib_h" = xyes; then : + cat >>confdefs.h <<_ACEOF +#define HAVE_BZLIB_H 1 +_ACEOF + have_bzlib=yes +else + have_bzlib=no +fi + +done + +fi +if test "x${have_bzlib}" = xyes; then +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking if bzip2 version >= 1.0.6" >&5 +$as_echo_n "checking if bzip2 version >= 1.0.6... " >&6; } +if ${r_cv_have_bzlib+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + +r_save_LIBS="${LIBS}" +LIBS="-lbz2 ${LIBS}" +if test "$cross_compiling" = yes; then : + r_cv_have_bzlib=no +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +#ifdef HAVE_BZLIB_H +#include <bzlib.h> +#endif +int main() { + char *ver = BZ2_bzlibVersion(); + exit(strcmp(ver, "1.0.6") < 0); +} + +_ACEOF +if ac_fn_c_try_run "$LINENO"; then : + r_cv_have_bzlib=yes +else + r_cv_have_bzlib=no +fi +rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ + conftest.$ac_objext conftest.beam conftest.$ac_ext +fi + +LIBS="${r_save_LIBS}" +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $r_cv_have_bzlib" >&5 +$as_echo "$r_cv_have_bzlib" >&6; } +fi +if test "x${r_cv_have_bzlib}" = xno; then + have_bzlib=no +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether bzip2 support suffices" >&5 +$as_echo_n "checking whether bzip2 support suffices... " >&6; } +if test "x${have_bzlib}" = xyes; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +$as_echo "yes" >&6; } + LIBS="-lbz2 ${LIBS}" +else + as_fn_error $? "bzip2 library and headers are required" "$LINENO" 5 +fi + + +## LZMA headers and libraries from xz-utils +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for lzma_version_number in -llzma" >&5 +$as_echo_n "checking for lzma_version_number in -llzma... " >&6; } +if ${ac_cv_lib_lzma_lzma_version_number+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-llzma $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char lzma_version_number (); +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +return lzma_version_number (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_lzma_lzma_version_number=yes +else + ac_cv_lib_lzma_lzma_version_number=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_lzma_lzma_version_number" >&5 +$as_echo "$ac_cv_lib_lzma_lzma_version_number" >&6; } +if test "x$ac_cv_lib_lzma_lzma_version_number" = xyes; then : + have_lzma=yes +else + have_lzma=no +fi + +if test "${have_lzma}" = yes; then + for ac_header in lzma.h +do : + ac_fn_c_check_header_mongrel "$LINENO" "lzma.h" "ac_cv_header_lzma_h" "$ac_includes_default" +if test "x$ac_cv_header_lzma_h" = xyes; then : + cat >>confdefs.h <<_ACEOF +#define HAVE_LZMA_H 1 +_ACEOF + have_lzma=yes +else + have_lzma=no +fi + +done + +fi +if test "x${have_lzma}" = xyes; then +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking if lzma version >= 5.0.3" >&5 +$as_echo_n "checking if lzma version >= 5.0.3... " >&6; } +if ${r_cv_have_lzma+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + +r_save_LIBS="${LIBS}" +LIBS="-llzma ${LIBS}" +if test "$cross_compiling" = yes; then : + r_cv_have_lzma=no +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +#ifdef HAVE_LZMA_H +#include <lzma.h> +#endif +#include <stdlib.h> +int main() { + unsigned int ver = lzma_version_number(); + // This is 10000000*major + 10000*minor + 10*revision + [012] + // I.e. xyyyzzzs and 5.1.2 would be 50010020 + exit(ver < 50000030); +} + +_ACEOF +if ac_fn_c_try_run "$LINENO"; then : + r_cv_have_lzma=yes +else + r_cv_have_lzma=no +fi +rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ + conftest.$ac_objext conftest.beam conftest.$ac_ext +fi + +LIBS="${r_save_LIBS}" +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $r_cv_have_lzma" >&5 +$as_echo "$r_cv_have_lzma" >&6; } +fi +if test "x${r_cv_have_lzma}" = xno; then + have_lzma=no +fi +if test "x${have_lzma}" = xyes; then + +$as_echo "#define HAVE_LZMA 1" >>confdefs.h + + LIBS="-llzma ${LIBS}" +else + as_fn_error $? "\"liblzma library and headers are required\"" "$LINENO" 5 +fi + + +## PCRE headers and libraries. +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for pcre_fullinfo in -lpcre" >&5 +$as_echo_n "checking for pcre_fullinfo in -lpcre... " >&6; } +if ${ac_cv_lib_pcre_pcre_fullinfo+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lpcre $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char pcre_fullinfo (); +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +return pcre_fullinfo (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_pcre_pcre_fullinfo=yes +else + ac_cv_lib_pcre_pcre_fullinfo=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_pcre_pcre_fullinfo" >&5 +$as_echo "$ac_cv_lib_pcre_pcre_fullinfo" >&6; } +if test "x$ac_cv_lib_pcre_pcre_fullinfo" = xyes; then : + have_pcre=yes +else + have_pcre=no +fi + +if test "${have_pcre}" = yes; then + for ac_header in pcre.h pcre/pcre.h +do : + as_ac_Header=`$as_echo "ac_cv_header_$ac_header" | $as_tr_sh` +ac_fn_c_check_header_mongrel "$LINENO" "$ac_header" "$as_ac_Header" "$ac_includes_default" +if eval test \"x\$"$as_ac_Header"\" = x"yes"; then : + cat >>confdefs.h <<_ACEOF +#define `$as_echo "HAVE_$ac_header" | $as_tr_cpp` 1 +_ACEOF + +fi + +done + + if test "${ac_cv_header_pcre_h}" = no \ + && test "${ac_cv_header_pcre_pcre_h}" = no; then + have_pcre=no + fi +fi +if test "x${have_pcre}" = xyes; then +r_save_LIBS="${LIBS}" +LIBS="-lpcre ${LIBS}" +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking if PCRE version >= 8.10, < 10.0 and has UTF-8 support" >&5 +$as_echo_n "checking if PCRE version >= 8.10, < 10.0 and has UTF-8 support... " >&6; } +if ${r_cv_have_pcre810+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test "$cross_compiling" = yes; then : + r_cv_have_pcre810=no +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +#ifdef HAVE_PCRE_PCRE_H +#include <pcre/pcre.h> +#else +#ifdef HAVE_PCRE_H +#include <pcre.h> +#endif +#endif +int main() { +#ifdef PCRE_MAJOR +#if PCRE_MAJOR > 8 + exit(1); +#elif PCRE_MAJOR == 8 && PCRE_MINOR >= 10 +{ + int ans; + int res = pcre_config(PCRE_CONFIG_UTF8, &ans); + if (res || ans != 1) exit(1); else exit(0); +} +#else + exit(1); +#endif +#else + exit(1); +#endif +} + +_ACEOF +if ac_fn_c_try_run "$LINENO"; then : + r_cv_have_pcre810=yes +else + r_cv_have_pcre810=no +fi +rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ + conftest.$ac_objext conftest.beam conftest.$ac_ext +fi + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $r_cv_have_pcre810" >&5 +$as_echo "$r_cv_have_pcre810" >&6; } +fi +if test "x${r_cv_have_pcre810}" != xyes; then + have_pcre=no + LIBS="${r_save_LIBS}" +else +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking if PCRE version >= 8.32" >&5 +$as_echo_n "checking if PCRE version >= 8.32... " >&6; } +if ${r_cv_have_pcre832+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test "$cross_compiling" = yes; then : + r_cv_have_pcre832=no +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +#ifdef HAVE_PCRE_PCRE_H +#include <pcre/pcre.h> +#else +#ifdef HAVE_PCRE_H +#include <pcre.h> +#endif +#endif +int main() { +#if PCRE_MAJOR == 8 && PCRE_MINOR >= 32 + exit(0); +#else + exit(1); +#endif +} + +_ACEOF +if ac_fn_c_try_run "$LINENO"; then : + r_cv_have_pcre832=yes +else + r_cv_have_pcre832=no +fi +rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ + conftest.$ac_objext conftest.beam conftest.$ac_ext +fi + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $r_cv_have_pcre832" >&5 +$as_echo "$r_cv_have_pcre832" >&6; } +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether PCRE support suffices" >&5 +$as_echo_n "checking whether PCRE support suffices... " >&6; } +if test "x${r_cv_have_pcre810}" != xyes; then + as_fn_error $? "pcre >= 8.10 library and headers are required" "$LINENO" 5 +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +$as_echo "yes" >&6; } +fi +if test "x${r_cv_have_pcre832}" != xyes; then + warn_pcre_version="pcre < 8.32 is deprecated" + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: ${warn_pcre_version}" >&5 +$as_echo "$as_me: WARNING: ${warn_pcre_version}" >&2;} +fi + + +## tre headers and libraries. +if test "x${use_system_tre}" = xyes; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for tre_regncompb in -ltre" >&5 +$as_echo_n "checking for tre_regncompb in -ltre... " >&6; } +if ${ac_cv_lib_tre_tre_regncompb+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-ltre $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char tre_regncompb (); +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +return tre_regncompb (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_tre_tre_regncompb=yes +else + ac_cv_lib_tre_tre_regncompb=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_tre_tre_regncompb" >&5 +$as_echo "$ac_cv_lib_tre_tre_regncompb" >&6; } +if test "x$ac_cv_lib_tre_tre_regncompb" = xyes; then : + have_tre=yes +else + have_tre=no +fi + + if test "${have_tre}" = yes; then + for ac_header in tre/tre.h +do : + ac_fn_c_check_header_mongrel "$LINENO" "tre/tre.h" "ac_cv_header_tre_tre_h" "$ac_includes_default" +if test "x$ac_cv_header_tre_tre_h" = xyes; then : + cat >>confdefs.h <<_ACEOF +#define HAVE_TRE_TRE_H 1 +_ACEOF + have_tre=yes +else + have_tre=no +fi + +done + + fi +if test "x${have_tre}" = xyes; then + +$as_echo "#define HAVE_TRE 1" >>confdefs.h + + LIBS="-ltre ${LIBS}" +fi +else + have_tre="no" +fi + if test x${have_tre} != xyes; then + BUILD_TRE_TRUE= + BUILD_TRE_FALSE='#' +else + BUILD_TRE_TRUE='#' + BUILD_TRE_FALSE= +fi + + + +## libcurl +## curl-config might not match the installed libcurl, +## so we allow the user to set CURL_CPPFLAGS, CURL_LIBS +## and check the version directly rather than by curl-config --checkfor +# Extract the first word of "curl-config", so it can be a program name with args. +set dummy curl-config; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_path_CURL_CONFIG+:} false; then : + $as_echo_n "(cached) " >&6 +else + case $CURL_CONFIG in + [\\/]* | ?:[\\/]*) + ac_cv_path_CURL_CONFIG="$CURL_CONFIG" # Let the user override the test with a path. + ;; + *) + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_path_CURL_CONFIG="$as_dir/$ac_word$ac_exec_ext" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + + ;; +esac +fi +CURL_CONFIG=$ac_cv_path_CURL_CONFIG +if test -n "$CURL_CONFIG"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CURL_CONFIG" >&5 +$as_echo "$CURL_CONFIG" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + +if test -n "${CURL_CONFIG}"; then + echo "checking libcurl version ..." \ + `${CURL_CONFIG} --version | sed -e 's,^[^0-9]*,,'` + if test -z "${CURL_CPPFLAGS}"; then + CURL_CPPFLAGS=`${CURL_CONFIG} --cflags` + fi + ## This should be correct for a static-only build, user will + ## need to override to specify static linking (see config.site) + if test -z "${CURL_LIBS}"; then + CURL_LIBS=`${CURL_CONFIG} --libs` + fi +fi +r_save_CPPFLAGS="${CPPFLAGS}" +CPPFLAGS="${CURL_CPPFLAGS} ${CPPFLAGS}" +r_save_LIBS="${LIBS}" +LIBS="${CURL_LIBS} ${LIBS}" +for ac_header in curl/curl.h +do : + ac_fn_c_check_header_mongrel "$LINENO" "curl/curl.h" "ac_cv_header_curl_curl_h" "$ac_includes_default" +if test "x$ac_cv_header_curl_curl_h" = xyes; then : + cat >>confdefs.h <<_ACEOF +#define HAVE_CURL_CURL_H 1 +_ACEOF + have_libcurl=yes +else + have_libcurl=no +fi + +done + + +if test "x${have_libcurl}" = "xyes"; then +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking if libcurl is version 7 and >= 7.22.0" >&5 +$as_echo_n "checking if libcurl is version 7 and >= 7.22.0... " >&6; } +if ${r_cv_have_curl722+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test "$cross_compiling" = yes; then : + r_cv_have_curl722=no +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +#include <stdlib.h> +#include <curl/curl.h> +int main() +{ +#ifdef LIBCURL_VERSION_MAJOR +#if LIBCURL_VERSION_MAJOR > 7 + exit(1); +#elif LIBCURL_VERSION_MAJOR == 7 && LIBCURL_VERSION_MINOR >= 22 + exit(0); +#else + exit(1); +#endif +#else + exit(1); +#endif +} + +_ACEOF +if ac_fn_c_try_run "$LINENO"; then : + r_cv_have_curl722=yes +else + r_cv_have_curl722=no +fi +rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ + conftest.$ac_objext conftest.beam conftest.$ac_ext +fi + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $r_cv_have_curl722" >&5 +$as_echo "$r_cv_have_curl722" >&6; } +fi +if test "x${r_cv_have_curl722}" = xno; then + have_libcurl=no +fi + +if test "x${have_libcurl}" = "xyes"; then +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking if libcurl supports https" >&5 +$as_echo_n "checking if libcurl supports https... " >&6; } +if ${r_cv_have_curl_https+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test "$cross_compiling" = yes; then : + r_cv_have_curl_https=no +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +#include <string.h> +#include <curl/curl.h> +int main() +{ + curl_version_info_data *data = curl_version_info(CURLVERSION_NOW); + const char * const *p = data->protocols; + int found = 0; + for (; *p; p++) + if(strcmp(*p, "https") == 0) {found = 1; break;} + exit(found ? 0 : 1); +} + +_ACEOF +if ac_fn_c_try_run "$LINENO"; then : + r_cv_have_curl_https=yes +else + r_cv_have_curl_https=no +fi +rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ + conftest.$ac_objext conftest.beam conftest.$ac_ext +fi + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $r_cv_have_curl_https" >&5 +$as_echo "$r_cv_have_curl_https" >&6; } +fi +if test "x${r_cv_have_curl_https}" = xno; then + have_libcurl=no +fi +if test "x${have_libcurl}" = xyes; then + +$as_echo "#define HAVE_LIBCURL 1" >>confdefs.h + + CPPFLAGS="${r_save_CPPFLAGS}" + LIBS="${r_save_LIBS}" + + +else + as_fn_error $? "libcurl >= 7.22.0 library and headers are required with support for https" "$LINENO" 5 +fi + + + +## Bitmap headers and libraries. +if test -n "${PKGCONF}"; then +BITMAP_CPPFLAGS= +BITMAP_LIBS= +if test "${use_jpeglib}" = yes; then + save_CPPFLAGS=${CPPFLAGS} + ## jpeglib does not support pkg-config, although some OSes add it. + ## This is untested. + if "${PKGCONF}" --exists jpeg; then + JPG_CPPFLAGS=`"${PKGCONF}" --cflags jpeg` + JPG_LIBS=`"${PKGCONF}" --libs jpeg` + CPPFLAGS="${CPPFLAGS} ${JPG_CPPFLAGS}" + fi + { $as_echo "$as_me:${as_lineno-$LINENO}: checking if jpeglib version >= 6b" >&5 +$as_echo_n "checking if jpeglib version >= 6b... " >&6; } +if ${r_cv_header_jpeglib_h+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <jpeglib.h> +#if (JPEG_LIB_VERSION >= 62) + yes +#endif + +_ACEOF +if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | + $EGREP "yes" >/dev/null 2>&1; then : + r_cv_header_jpeglib_h=yes +else + r_cv_header_jpeglib_h=no +fi +rm -f conftest* + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $r_cv_header_jpeglib_h" >&5 +$as_echo "$r_cv_header_jpeglib_h" >&6; } + + CPPFLAGS=${save_CPPFLAGS} + have_jpeg=${r_cv_header_jpeglib_h} + if test "${have_jpeg}" = yes; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for jpeg_destroy_compress in -ljpeg" >&5 +$as_echo_n "checking for jpeg_destroy_compress in -ljpeg... " >&6; } +if ${ac_cv_lib_jpeg_jpeg_destroy_compress+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-ljpeg ${JPG_LIBS} ${LIBS} $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char jpeg_destroy_compress (); +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +return jpeg_destroy_compress (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_jpeg_jpeg_destroy_compress=yes +else + ac_cv_lib_jpeg_jpeg_destroy_compress=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_jpeg_jpeg_destroy_compress" >&5 +$as_echo "$ac_cv_lib_jpeg_jpeg_destroy_compress" >&6; } +if test "x$ac_cv_lib_jpeg_jpeg_destroy_compress" = xyes; then : + have_jpeg=yes +else + have_jpeg=no +fi + + fi + if test "${have_jpeg}" = yes; then + if test -n "${JPG_LIBS}"; then + BITMAP_LIBS="${JPG_LIBS}" + else + BITMAP_LIBS=-ljpeg + fi + +$as_echo "#define HAVE_JPEG 1" >>confdefs.h + + fi +fi +if test "${use_libpng}" = yes; then + if "${PKGCONF}" --exists libpng; then + save_CPPFLAGS=${CPPFLAGS} + PNG_CPPFLAGS=`"${PKGCONF}" --cflags libpng` + CPPFLAGS="${CPPFLAGS} ${PNG_CPPFLAGS}" + { $as_echo "$as_me:${as_lineno-$LINENO}: checking if libpng version >= 1.2.7" >&5 +$as_echo_n "checking if libpng version >= 1.2.7... " >&6; } +if ${r_cv_header_png_h+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <png.h> +#if (PNG_LIBPNG_VER >= 10207) + yes +#endif + +_ACEOF +if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | + $EGREP "yes" >/dev/null 2>&1; then : + r_cv_header_png_h=yes +else + r_cv_header_png_h=no +fi +rm -f conftest* + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $r_cv_header_png_h" >&5 +$as_echo "$r_cv_header_png_h" >&6; } + + have_png=${r_cv_header_png_h} + CPPFLAGS=${save_CPPFLAGS} + if test "${have_png}" = yes; then + PNG_LIBS=`"${PKGCONF}" --libs libpng` + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for png_create_write_struct in -lpng" >&5 +$as_echo_n "checking for png_create_write_struct in -lpng... " >&6; } +if ${ac_cv_lib_png_png_create_write_struct+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lpng ${PNG_LIBS} ${LIBS} $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char png_create_write_struct (); +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +return png_create_write_struct (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_png_png_create_write_struct=yes +else + ac_cv_lib_png_png_create_write_struct=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_png_png_create_write_struct" >&5 +$as_echo "$ac_cv_lib_png_png_create_write_struct" >&6; } +if test "x$ac_cv_lib_png_png_create_write_struct" = xyes; then : + have_png=yes +else + have_png=no +fi + + if test "${have_png}" = no; then + PNG_LIBS=`"${PKGCONF}" --static --libs libpng` + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for png_create_write_struct in -lpng" >&5 +$as_echo_n "checking for png_create_write_struct in -lpng... " >&6; } +if ${ac_cv_lib_png_png_create_write_struct+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lpng ${PNG_LIBS} ${LIBS} $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char png_create_write_struct (); +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +return png_create_write_struct (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_png_png_create_write_struct=yes +else + ac_cv_lib_png_png_create_write_struct=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_png_png_create_write_struct" >&5 +$as_echo "$ac_cv_lib_png_png_create_write_struct" >&6; } +if test "x$ac_cv_lib_png_png_create_write_struct" = xyes; then : + have_png=yes +else + have_png=no +fi + + fi + fi + if test "${have_png}" = yes; then + BITMAP_CPPFLAGS="${BITMAP_CPPFLAGS} ${PNG_CPPFLAGS}" + BITMAP_LIBS="${BITMAP_LIBS} ${PNG_LIBS}" + +$as_echo "#define HAVE_PNG 1" >>confdefs.h + + fi + fi +fi +if test "${use_libtiff}" = yes; then + mod= + ## pkg-config support was introduced in libtiff 4.0.0 + ## I guess the module name might change in future, so + ## program defensively here. + if "${PKGCONF}" --exists libtiff-4; then + mod=libtiff-4 + fi + if test -n "${mod}"; then + save_CPPFLAGS=${CPPFLAGS} + TIF_CPPFLAGS=`"${PKGCONF}" --cflags ${mod}` + CPPFLAGS="${CPPFLAGS} ${TIF_CPPFLAGS}" + for ac_header in tiffio.h +do : + ac_fn_c_check_header_mongrel "$LINENO" "tiffio.h" "ac_cv_header_tiffio_h" "$ac_includes_default" +if test "x$ac_cv_header_tiffio_h" = xyes; then : + cat >>confdefs.h <<_ACEOF +#define HAVE_TIFFIO_H 1 +_ACEOF + +fi + +done + + CPPFLAGS=${save_CPPFLAGS} + if test "x${ac_cv_header_tiffio_h}" = xyes ; then + TIF_LIBS=`"${PKGCONF}" --libs ${mod}` + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for TIFFOpen in -ltiff" >&5 +$as_echo_n "checking for TIFFOpen in -ltiff... " >&6; } +if ${ac_cv_lib_tiff_TIFFOpen+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-ltiff ${TIF_LIBS} ${BITMAP_LIBS} $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char TIFFOpen (); +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +return TIFFOpen (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_tiff_TIFFOpen=yes +else + ac_cv_lib_tiff_TIFFOpen=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_tiff_TIFFOpen" >&5 +$as_echo "$ac_cv_lib_tiff_TIFFOpen" >&6; } +if test "x$ac_cv_lib_tiff_TIFFOpen" = xyes; then : + have_tiff=yes +else + have_tiff=no +fi + + if test "x${have_tiff}" = xno; then + TIF_LIBS=`"${PKGCONF}" --static --libs ${mod}` + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for TIFFOpen in -ltiff" >&5 +$as_echo_n "checking for TIFFOpen in -ltiff... " >&6; } +if ${ac_cv_lib_tiff_TIFFOpen+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-ltiff ${TIF_LIBS} ${BITMAP_LIBS} $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char TIFFOpen (); +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +return TIFFOpen (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_tiff_TIFFOpen=yes +else + ac_cv_lib_tiff_TIFFOpen=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_tiff_TIFFOpen" >&5 +$as_echo "$ac_cv_lib_tiff_TIFFOpen" >&6; } +if test "x$ac_cv_lib_tiff_TIFFOpen" = xyes; then : + have_tiff=yes +else + have_tiff=no +fi + + fi + if test "x${have_tiff}" = xyes; then + +$as_echo "#define HAVE_TIFF 1" >>confdefs.h + + BITMAP_LIBS="${TIF_LIBS} ${BITMAP_LIBS}" + BITMAP_CPPFLAGS="${BITMAP_CPPFLAGS} ${TIF_CPPFLAGS}" + fi + fi + fi +fi + + + +else +BITMAP_CPPFLAGS= +BITMAP_LIBS= +if test "${use_jpeglib}" = yes; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking if jpeglib version >= 6b" >&5 +$as_echo_n "checking if jpeglib version >= 6b... " >&6; } +if ${r_cv_header_jpeglib_h+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <jpeglib.h> +#if (JPEG_LIB_VERSION >= 62) + yes +#endif + +_ACEOF +if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | + $EGREP "yes" >/dev/null 2>&1; then : + r_cv_header_jpeglib_h=yes +else + r_cv_header_jpeglib_h=no +fi +rm -f conftest* + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $r_cv_header_jpeglib_h" >&5 +$as_echo "$r_cv_header_jpeglib_h" >&6; } + + have_jpeg=${r_cv_header_jpeglib_h} + if test "${have_jpeg}" = yes; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for jpeg_destroy_compress in -ljpeg" >&5 +$as_echo_n "checking for jpeg_destroy_compress in -ljpeg... " >&6; } +if ${ac_cv_lib_jpeg_jpeg_destroy_compress+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-ljpeg ${LIBS} $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char jpeg_destroy_compress (); +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +return jpeg_destroy_compress (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_jpeg_jpeg_destroy_compress=yes +else + ac_cv_lib_jpeg_jpeg_destroy_compress=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_jpeg_jpeg_destroy_compress" >&5 +$as_echo "$ac_cv_lib_jpeg_jpeg_destroy_compress" >&6; } +if test "x$ac_cv_lib_jpeg_jpeg_destroy_compress" = xyes; then : + have_jpeg=yes +else + have_jpeg=no +fi + + fi + if test "${have_jpeg}" = yes; then + BITMAP_LIBS="-ljpeg" + +$as_echo "#define HAVE_JPEG 1" >>confdefs.h + + fi +fi +if test "${use_libpng}" = yes; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for main in -lz" >&5 +$as_echo_n "checking for main in -lz... " >&6; } +if ${ac_cv_lib_z_main+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lz $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + + +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +return main (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_z_main=yes +else + ac_cv_lib_z_main=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_z_main" >&5 +$as_echo "$ac_cv_lib_z_main" >&6; } +if test "x$ac_cv_lib_z_main" = xyes; then : + have_png=yes +else + have_png=no +fi + + if test "${have_png}" = yes; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking if libpng version >= 1.2.7" >&5 +$as_echo_n "checking if libpng version >= 1.2.7... " >&6; } +if ${r_cv_header_png_h+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <png.h> +#if (PNG_LIBPNG_VER >= 10207) + yes +#endif + +_ACEOF +if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | + $EGREP "yes" >/dev/null 2>&1; then : + r_cv_header_png_h=yes +else + r_cv_header_png_h=no +fi +rm -f conftest* + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $r_cv_header_png_h" >&5 +$as_echo "$r_cv_header_png_h" >&6; } + + have_png=${r_cv_header_png_h} + fi + if test "${have_png}" = yes; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for png_create_write_struct in -lpng" >&5 +$as_echo_n "checking for png_create_write_struct in -lpng... " >&6; } +if ${ac_cv_lib_png_png_create_write_struct+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lpng -lz ${LIBS} $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char png_create_write_struct (); +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +return png_create_write_struct (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_png_png_create_write_struct=yes +else + ac_cv_lib_png_png_create_write_struct=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_png_png_create_write_struct" >&5 +$as_echo "$ac_cv_lib_png_png_create_write_struct" >&6; } +if test "x$ac_cv_lib_png_png_create_write_struct" = xyes; then : + have_png=yes +else + have_png=no +fi + + fi + if test "${have_png}" = yes; then + BITMAP_LIBS="${BITMAP_LIBS} -lpng -lz" + +$as_echo "#define HAVE_PNG 1" >>confdefs.h + + fi +fi +if test "${use_libtiff}" = yes; then + for ac_header in tiffio.h +do : + ac_fn_c_check_header_mongrel "$LINENO" "tiffio.h" "ac_cv_header_tiffio_h" "$ac_includes_default" +if test "x$ac_cv_header_tiffio_h" = xyes; then : + cat >>confdefs.h <<_ACEOF +#define HAVE_TIFFIO_H 1 +_ACEOF + +fi + +done + + if test "x${ac_cv_header_tiffio_h}" = xyes ; then + # may need to resolve jpeg routines + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for TIFFOpen in -ltiff" >&5 +$as_echo_n "checking for TIFFOpen in -ltiff... " >&6; } +if ${ac_cv_lib_tiff_TIFFOpen+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-ltiff ${BITMAP_LIBS} $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char TIFFOpen (); +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +return TIFFOpen (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_tiff_TIFFOpen=yes +else + ac_cv_lib_tiff_TIFFOpen=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_tiff_TIFFOpen" >&5 +$as_echo "$ac_cv_lib_tiff_TIFFOpen" >&6; } +if test "x$ac_cv_lib_tiff_TIFFOpen" = xyes; then : + have_tiff=yes +else + have_tiff=no +fi + + if test "x${have_tiff}" = xyes; then + +$as_echo "#define HAVE_TIFF 1" >>confdefs.h + + BITMAP_LIBS="-ltiff ${BITMAP_LIBS}" + else + # tiff 4.0.x may need lzma too: SU's static build does + unset ac_cv_lib_tiff_TIFFOpen + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for TIFFOpen in -ltiff" >&5 +$as_echo_n "checking for TIFFOpen in -ltiff... " >&6; } +if ${ac_cv_lib_tiff_TIFFOpen+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-ltiff -llzma ${BITMAP_LIBS} -llzma $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char TIFFOpen (); +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +return TIFFOpen (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_tiff_TIFFOpen=yes +else + ac_cv_lib_tiff_TIFFOpen=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_tiff_TIFFOpen" >&5 +$as_echo "$ac_cv_lib_tiff_TIFFOpen" >&6; } +if test "x$ac_cv_lib_tiff_TIFFOpen" = xyes; then : + have_tiff=yes +else + have_tiff=no +fi + + if test "x${have_tiff}" = xyes; then + +$as_echo "#define HAVE_TIFF 1" >>confdefs.h + + BITMAP_LIBS="-ltiff -llzma ${BITMAP_LIBS}" + else + have_tiff=no + fi + fi + fi +fi + + + +fi + +## POSIX times. +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether leap seconds are treated according to POSIX" >&5 +$as_echo_n "checking whether leap seconds are treated according to POSIX... " >&6; } +if ${r_cv_sys_posix_leapseconds+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test "$cross_compiling" = yes; then : + r_cv_sys_posix_leapseconds=yes +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +#include <stdlib.h> +#include <time.h> +#include <stdio.h> +#include "confdefs.h" + +int main () { + struct tm *tm; + time_t ct = 0; /* required on 64bit AIX */ + + ctime(&ct); + ct = ct - (ct % 60); + tm = gmtime(&ct); + if(tm->tm_sec == 0) exit(1); else exit(0); +} + +_ACEOF +if ac_fn_c_try_run "$LINENO"; then : + r_cv_sys_posix_leapseconds=no +else + r_cv_sys_posix_leapseconds=yes +fi +rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ + conftest.$ac_objext conftest.beam conftest.$ac_ext +fi + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $r_cv_sys_posix_leapseconds" >&5 +$as_echo "$r_cv_sys_posix_leapseconds" >&6; } +if test "x${r_cv_sys_posix_leapseconds}" = xyes; then + +$as_echo "#define HAVE_POSIX_LEAPSECONDS 1" >>confdefs.h + +fi + + +## stat times +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for inline" >&5 +$as_echo_n "checking for inline... " >&6; } +if ${ac_cv_c_inline+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_cv_c_inline=no +for ac_kw in inline __inline__ __inline; do + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#ifndef __cplusplus +typedef int foo_t; +static $ac_kw foo_t static_foo () {return 0; } +$ac_kw foo_t foo () {return 0; } +#endif + +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_cv_c_inline=$ac_kw +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + test "$ac_cv_c_inline" != no && break +done + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_c_inline" >&5 +$as_echo "$ac_cv_c_inline" >&6; } + +case $ac_cv_c_inline in + inline | yes) ;; + *) + case $ac_cv_c_inline in + no) ac_val=;; + *) ac_val=$ac_cv_c_inline;; + esac + cat >>confdefs.h <<_ACEOF +#ifndef __cplusplus +#define inline $ac_val +#endif +_ACEOF + ;; +esac + + + + + for ac_header in $ac_header_list +do : + as_ac_Header=`$as_echo "ac_cv_header_$ac_header" | $as_tr_sh` +ac_fn_c_check_header_compile "$LINENO" "$ac_header" "$as_ac_Header" "$ac_includes_default +" +if eval test \"x\$"$as_ac_Header"\" = x"yes"; then : + cat >>confdefs.h <<_ACEOF +#define `$as_echo "HAVE_$ac_header" | $as_tr_cpp` 1 +_ACEOF + +fi + +done + + + + + + + + ac_fn_c_check_member "$LINENO" "struct stat" "st_atim.tv_nsec" "ac_cv_member_struct_stat_st_atim_tv_nsec" "#include <sys/types.h> + #include <sys/stat.h> +" +if test "x$ac_cv_member_struct_stat_st_atim_tv_nsec" = xyes; then : + +cat >>confdefs.h <<_ACEOF +#define HAVE_STRUCT_STAT_ST_ATIM_TV_NSEC 1 +_ACEOF + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether struct stat.st_atim is of type struct timespec" >&5 +$as_echo_n "checking whether struct stat.st_atim is of type struct timespec... " >&6; } +if ${ac_cv_typeof_struct_stat_st_atim_is_struct_timespec+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + + #include <sys/types.h> + #include <sys/stat.h> + #if HAVE_SYS_TIME_H + # include <sys/time.h> + #endif + #include <time.h> + struct timespec ts; + struct stat st; + +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ + + st.st_atim = ts; + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_cv_typeof_struct_stat_st_atim_is_struct_timespec=yes +else + ac_cv_typeof_struct_stat_st_atim_is_struct_timespec=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_typeof_struct_stat_st_atim_is_struct_timespec" >&5 +$as_echo "$ac_cv_typeof_struct_stat_st_atim_is_struct_timespec" >&6; } + if test $ac_cv_typeof_struct_stat_st_atim_is_struct_timespec = yes; then + +$as_echo "#define TYPEOF_STRUCT_STAT_ST_ATIM_IS_STRUCT_TIMESPEC 1" >>confdefs.h + + fi +else + ac_fn_c_check_member "$LINENO" "struct stat" "st_atimespec.tv_nsec" "ac_cv_member_struct_stat_st_atimespec_tv_nsec" "#include <sys/types.h> + #include <sys/stat.h> +" +if test "x$ac_cv_member_struct_stat_st_atimespec_tv_nsec" = xyes; then : + +cat >>confdefs.h <<_ACEOF +#define HAVE_STRUCT_STAT_ST_ATIMESPEC_TV_NSEC 1 +_ACEOF + + +else + ac_fn_c_check_member "$LINENO" "struct stat" "st_atimensec" "ac_cv_member_struct_stat_st_atimensec" "#include <sys/types.h> + #include <sys/stat.h> +" +if test "x$ac_cv_member_struct_stat_st_atimensec" = xyes; then : + +cat >>confdefs.h <<_ACEOF +#define HAVE_STRUCT_STAT_ST_ATIMENSEC 1 +_ACEOF + + +else + ac_fn_c_check_member "$LINENO" "struct stat" "st_atim.st__tim.tv_nsec" "ac_cv_member_struct_stat_st_atim_st__tim_tv_nsec" "#include <sys/types.h> + #include <sys/stat.h> +" +if test "x$ac_cv_member_struct_stat_st_atim_st__tim_tv_nsec" = xyes; then : + +cat >>confdefs.h <<_ACEOF +#define HAVE_STRUCT_STAT_ST_ATIM_ST__TIM_TV_NSEC 1 +_ACEOF + + +fi + +fi + +fi + +fi + + + +## R profiling. +if test "${want_R_profiling}" = yes; then + for ac_func in setitimer +do : + ac_fn_c_check_func "$LINENO" "setitimer" "ac_cv_func_setitimer" +if test "x$ac_cv_func_setitimer" = xyes; then : + cat >>confdefs.h <<_ACEOF +#define HAVE_SETITIMER 1 +_ACEOF + +$as_echo "#define R_PROFILING 1" >>confdefs.h + +else + want_R_profiling="no" +fi +done + +fi + + +## R profiling. +if test "${want_memory_profiling}" = yes; then + +$as_echo "#define R_MEMORY_PROFILING 1" >>confdefs.h + +fi + +## Large-file-support +# Check whether --enable-largefile was given. +if test "${enable_largefile+set}" = set; then : + enableval=$enable_largefile; +fi + +if test "$enable_largefile" != no; then + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for special C compiler options needed for large files" >&5 +$as_echo_n "checking for special C compiler options needed for large files... " >&6; } +if ${ac_cv_sys_largefile_CC+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_cv_sys_largefile_CC=no + if test "$GCC" != yes; then + ac_save_CC=$CC + while :; do + # IRIX 6.2 and later do not support large files by default, + # so use the C compiler's -n32 option if that helps. + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <sys/types.h> + /* Check that off_t can represent 2**63 - 1 correctly. + We can't simply define LARGE_OFF_T to be 9223372036854775807, + since some C++ compilers masquerading as C compilers + incorrectly reject 9223372036854775807. */ +#define LARGE_OFF_T (((off_t) 1 << 62) - 1 + ((off_t) 1 << 62)) + int off_t_is_large[(LARGE_OFF_T % 2147483629 == 721 + && LARGE_OFF_T % 2147483647 == 1) + ? 1 : -1]; +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ + + ; + return 0; +} +_ACEOF + if ac_fn_c_try_compile "$LINENO"; then : + break +fi +rm -f core conftest.err conftest.$ac_objext + CC="$CC -n32" + if ac_fn_c_try_compile "$LINENO"; then : + ac_cv_sys_largefile_CC=' -n32'; break +fi +rm -f core conftest.err conftest.$ac_objext + break + done + CC=$ac_save_CC + rm -f conftest.$ac_ext + fi +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_sys_largefile_CC" >&5 +$as_echo "$ac_cv_sys_largefile_CC" >&6; } + if test "$ac_cv_sys_largefile_CC" != no; then + CC=$CC$ac_cv_sys_largefile_CC + fi + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for _FILE_OFFSET_BITS value needed for large files" >&5 +$as_echo_n "checking for _FILE_OFFSET_BITS value needed for large files... " >&6; } +if ${ac_cv_sys_file_offset_bits+:} false; then : + $as_echo_n "(cached) " >&6 +else + while :; do + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <sys/types.h> + /* Check that off_t can represent 2**63 - 1 correctly. + We can't simply define LARGE_OFF_T to be 9223372036854775807, + since some C++ compilers masquerading as C compilers + incorrectly reject 9223372036854775807. */ +#define LARGE_OFF_T (((off_t) 1 << 62) - 1 + ((off_t) 1 << 62)) + int off_t_is_large[(LARGE_OFF_T % 2147483629 == 721 + && LARGE_OFF_T % 2147483647 == 1) + ? 1 : -1]; +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_cv_sys_file_offset_bits=no; break +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#define _FILE_OFFSET_BITS 64 +#include <sys/types.h> + /* Check that off_t can represent 2**63 - 1 correctly. + We can't simply define LARGE_OFF_T to be 9223372036854775807, + since some C++ compilers masquerading as C compilers + incorrectly reject 9223372036854775807. */ +#define LARGE_OFF_T (((off_t) 1 << 62) - 1 + ((off_t) 1 << 62)) + int off_t_is_large[(LARGE_OFF_T % 2147483629 == 721 + && LARGE_OFF_T % 2147483647 == 1) + ? 1 : -1]; +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_cv_sys_file_offset_bits=64; break +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + ac_cv_sys_file_offset_bits=unknown + break +done +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_sys_file_offset_bits" >&5 +$as_echo "$ac_cv_sys_file_offset_bits" >&6; } +case $ac_cv_sys_file_offset_bits in #( + no | unknown) ;; + *) +cat >>confdefs.h <<_ACEOF +#define _FILE_OFFSET_BITS $ac_cv_sys_file_offset_bits +_ACEOF +;; +esac +rm -rf conftest* + if test $ac_cv_sys_file_offset_bits = unknown; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for _LARGE_FILES value needed for large files" >&5 +$as_echo_n "checking for _LARGE_FILES value needed for large files... " >&6; } +if ${ac_cv_sys_large_files+:} false; then : + $as_echo_n "(cached) " >&6 +else + while :; do + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <sys/types.h> + /* Check that off_t can represent 2**63 - 1 correctly. + We can't simply define LARGE_OFF_T to be 9223372036854775807, + since some C++ compilers masquerading as C compilers + incorrectly reject 9223372036854775807. */ +#define LARGE_OFF_T (((off_t) 1 << 62) - 1 + ((off_t) 1 << 62)) + int off_t_is_large[(LARGE_OFF_T % 2147483629 == 721 + && LARGE_OFF_T % 2147483647 == 1) + ? 1 : -1]; +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_cv_sys_large_files=no; break +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#define _LARGE_FILES 1 +#include <sys/types.h> + /* Check that off_t can represent 2**63 - 1 correctly. + We can't simply define LARGE_OFF_T to be 9223372036854775807, + since some C++ compilers masquerading as C compilers + incorrectly reject 9223372036854775807. */ +#define LARGE_OFF_T (((off_t) 1 << 62) - 1 + ((off_t) 1 << 62)) + int off_t_is_large[(LARGE_OFF_T % 2147483629 == 721 + && LARGE_OFF_T % 2147483647 == 1) + ? 1 : -1]; +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_cv_sys_large_files=1; break +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + ac_cv_sys_large_files=unknown + break +done +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_sys_large_files" >&5 +$as_echo "$ac_cv_sys_large_files" >&6; } +case $ac_cv_sys_large_files in #( + no | unknown) ;; + *) +cat >>confdefs.h <<_ACEOF +#define _LARGE_FILES $ac_cv_sys_large_files +_ACEOF +;; +esac +rm -rf conftest* + fi + + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for _LARGEFILE_SOURCE value needed for large files" >&5 +$as_echo_n "checking for _LARGEFILE_SOURCE value needed for large files... " >&6; } +if ${ac_cv_sys_largefile_source+:} false; then : + $as_echo_n "(cached) " >&6 +else + while :; do + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <sys/types.h> /* for off_t */ + #include <stdio.h> +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +int (*fp) (FILE *, off_t, int) = fseeko; + return fseeko (stdin, 0, 0) && fp (stdin, 0, 0); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_sys_largefile_source=no; break +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#define _LARGEFILE_SOURCE 1 +#include <sys/types.h> /* for off_t */ + #include <stdio.h> +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +int (*fp) (FILE *, off_t, int) = fseeko; + return fseeko (stdin, 0, 0) && fp (stdin, 0, 0); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_sys_largefile_source=1; break +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + ac_cv_sys_largefile_source=unknown + break +done +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_sys_largefile_source" >&5 +$as_echo "$ac_cv_sys_largefile_source" >&6; } +case $ac_cv_sys_largefile_source in #( + no | unknown) ;; + *) +cat >>confdefs.h <<_ACEOF +#define _LARGEFILE_SOURCE $ac_cv_sys_largefile_source +_ACEOF +;; +esac +rm -rf conftest* + +# We used to try defining _XOPEN_SOURCE=500 too, to work around a bug +# in glibc 2.1.3, but that breaks too many other things. +# If you want fseeko and ftello with glibc, upgrade to a fixed glibc. +if test $ac_cv_sys_largefile_source != unknown; then + +$as_echo "#define HAVE_FSEEKO 1" >>confdefs.h + +fi + + +## Valgrind instrumentation +if test ${valgrind_level} -eq 0; then + +$as_echo "#define NVALGRIND 1" >>confdefs.h + +elif test "${use_system_valgrind}" = yes; then + for ac_header in valgrind/memcheck.h +do : + ac_fn_c_check_header_mongrel "$LINENO" "valgrind/memcheck.h" "ac_cv_header_valgrind_memcheck_h" "$ac_includes_default" +if test "x$ac_cv_header_valgrind_memcheck_h" = xyes; then : + cat >>confdefs.h <<_ACEOF +#define HAVE_VALGRIND_MEMCHECK_H 1 +_ACEOF + +fi + +done + +fi + + +cat >>confdefs.h <<_ACEOF +#define VALGRIND_LEVEL ${valgrind_level} +_ACEOF + + + +if test "x${use_internal_tzcode}" = xyes; then + +$as_echo "#define USE_INTERNAL_MKTIME 1" >>confdefs.h + +fi + if test "x${use_internal_tzcode}" = xyes; then + BUILD_TZONE_TRUE= + BUILD_TZONE_FALSE='#' +else + BUILD_TZONE_TRUE='#' + BUILD_TZONE_FALSE= +fi + + + +## KERN_USRSTACK support (BSD, Darwin, ...) + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether KERN_USRSTACK sysctl is supported" >&5 +$as_echo_n "checking whether KERN_USRSTACK sysctl is supported... " >&6; } +if ${r_cv_kern_usrstack+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test "$cross_compiling" = yes; then : + r_cv_kern_usrstack=no +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +#include "confdefs.h" +#include <unistd.h> +#include <stdlib.h> +#include <sys/types.h> +#include <sys/sysctl.h> + +int main () { + int nm[2] = {CTL_KERN, KERN_USRSTACK}; + void * base; + size_t len = sizeof(void *); + int r = sysctl(nm, 2, &base, &len, NULL, 0); + + exit((r==0)?0:1); +} + +_ACEOF +if ac_fn_c_try_run "$LINENO"; then : + r_cv_kern_usrstack=yes +else + r_cv_kern_usrstack=no +fi +rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ + conftest.$ac_objext conftest.beam conftest.$ac_ext +fi + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $r_cv_kern_usrstack" >&5 +$as_echo "$r_cv_kern_usrstack" >&6; } + + if test $r_cv_kern_usrstack = yes; then + +$as_echo "#define HAVE_KERN_USRSTACK 1" >>confdefs.h + + fi + + +## check for visible __libc_stack_end on Linux +case "${host_os}" in + linux*) + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for visible __lib_stack_end" >&5 +$as_echo_n "checking for visible __lib_stack_end... " >&6; } +if ${r_cv_libc_stack_end+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test "$cross_compiling" = yes; then : + r_cv_libc_stack_end=no +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +#include "confdefs.h" +#include <stdlib.h> +/* This might get optimized out if not used */ +extern void * __libc_stack_end; + +int main () { + if(!__libc_stack_end) exit(1); + exit(0); +} + +_ACEOF +if ac_fn_c_try_run "$LINENO"; then : + r_cv_libc_stack_end=yes +else + r_cv_libc_stack_end=no +fi +rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ + conftest.$ac_objext conftest.beam conftest.$ac_ext +fi + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $r_cv_libc_stack_end" >&5 +$as_echo "$r_cv_libc_stack_end" >&6; } + + if test "${r_cv_libc_stack_end}" = yes; then + +$as_echo "#define HAVE_LIBC_STACK_END 1" >>confdefs.h + + fi +esac + +### * Miscellaneous. + +## Printing. +## We look to see whether we have 'lpr' or 'lp'. Some platforms +## provide both (SunOS and HPUX), and in those cases we choose lpr. +if test -z "${R_PRINTCMD}"; then + for ac_prog in lpr lp +do + # Extract the first word of "$ac_prog", so it can be a program name with args. +set dummy $ac_prog; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_R_PRINTCMD+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$R_PRINTCMD"; then + ac_cv_prog_R_PRINTCMD="$R_PRINTCMD" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_R_PRINTCMD="$ac_prog" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +R_PRINTCMD=$ac_cv_prog_R_PRINTCMD +if test -n "$R_PRINTCMD"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $R_PRINTCMD" >&5 +$as_echo "$R_PRINTCMD" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + test -n "$R_PRINTCMD" && break +done + +fi + +cat >>confdefs.h <<_ACEOF +#define R_PRINTCMD "${R_PRINTCMD}" +_ACEOF + + +## Default paper size. +# Extract the first word of "paperconf", so it can be a program name with args. +set dummy paperconf; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_path_PAPERCONF+:} false; then : + $as_echo_n "(cached) " >&6 +else + case $PAPERCONF in + [\\/]* | ?:[\\/]*) + ac_cv_path_PAPERCONF="$PAPERCONF" # Let the user override the test with a path. + ;; + *) + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_path_PAPERCONF="$as_dir/$ac_word$ac_exec_ext" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + + test -z "$ac_cv_path_PAPERCONF" && ac_cv_path_PAPERCONF="false" + ;; +esac +fi +PAPERCONF=$ac_cv_path_PAPERCONF +if test -n "$PAPERCONF"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $PAPERCONF" >&5 +$as_echo "$PAPERCONF" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + +: ${PAPERSIZE=a4} +papersize=`${PAPERCONF}` +test -z "${papersize}" && papersize="${PAPERSIZE}" +: ${R_PAPERSIZE="${papersize}"} + + +## Saving. + + +## Java support +## R_JAVA +custom_JAVA_HOME="${JAVA_HOME}" +: ${JAVA_LIBS=~autodetect~} +: ${JAVA_CPPFLAGS=~autodetect~} +: ${JAVA_LD_LIBRARY_PATH=~autodetect~} +custom_JAVA_LIBS="${JAVA_LIBS}" +custom_JAVA_CPPFLAGS="${JAVA_CPPFLAGS}" +custom_JAVA_LD_LIBRARY_PATH="${JAVA_LD_LIBRARY_PATH}" + + + + +JAVA_LD_LIBRARY_PATH= + + + + + + + + + + +## F90/F95 support +ac_ext=${ac_fc_srcext-f} +ac_compile='$FC -c $FCFLAGS $ac_fcflags_srcext conftest.$ac_ext >&5' +ac_link='$FC -o conftest$ac_exeext $FCFLAGS $LDFLAGS $ac_fcflags_srcext conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_fc_compiler_gnu +if test -n "$ac_tool_prefix"; then + for ac_prog in gfortran g95 xlf95 f95 fort ifort ifc efc pgfortran pgf95 lf95 ftn nagfor xlf90 f90 pgf90 pghpf epcf90 g77 xlf f77 frt pgf77 cf77 fort77 fl32 af77 + do + # Extract the first word of "$ac_tool_prefix$ac_prog", so it can be a program name with args. +set dummy $ac_tool_prefix$ac_prog; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_FC+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$FC"; then + ac_cv_prog_FC="$FC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_FC="$ac_tool_prefix$ac_prog" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +FC=$ac_cv_prog_FC +if test -n "$FC"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $FC" >&5 +$as_echo "$FC" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + test -n "$FC" && break + done +fi +if test -z "$FC"; then + ac_ct_FC=$FC + for ac_prog in gfortran g95 xlf95 f95 fort ifort ifc efc pgfortran pgf95 lf95 ftn nagfor xlf90 f90 pgf90 pghpf epcf90 g77 xlf f77 frt pgf77 cf77 fort77 fl32 af77 +do + # Extract the first word of "$ac_prog", so it can be a program name with args. +set dummy $ac_prog; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_ac_ct_FC+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$ac_ct_FC"; then + ac_cv_prog_ac_ct_FC="$ac_ct_FC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_ac_ct_FC="$ac_prog" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +ac_ct_FC=$ac_cv_prog_ac_ct_FC +if test -n "$ac_ct_FC"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_FC" >&5 +$as_echo "$ac_ct_FC" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + test -n "$ac_ct_FC" && break +done + + if test "x$ac_ct_FC" = x; then + FC="" + else + case $cross_compiling:$ac_tool_warned in +yes:) +{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 +$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} +ac_tool_warned=yes ;; +esac + FC=$ac_ct_FC + fi +fi + + +# Provide some information about the compiler. +$as_echo "$as_me:${as_lineno-$LINENO}: checking for Fortran compiler version" >&5 +set X $ac_compile +ac_compiler=$2 +for ac_option in --version -v -V -qversion; do + { { ac_try="$ac_compiler $ac_option >&5" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_compiler $ac_option >&5") 2>conftest.err + ac_status=$? + if test -s conftest.err; then + sed '10a\ +... rest of stderr output deleted ... + 10q' conftest.err >conftest.er1 + cat conftest.er1 >&5 + fi + rm -f conftest.er1 conftest.err + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } +done +rm -f a.out + +# If we don't use `.F' as extension, the preprocessor is not run on the +# input file. (Note that this only needs to work for GNU compilers.) +ac_save_ext=$ac_ext +ac_ext=F +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether we are using the GNU Fortran compiler" >&5 +$as_echo_n "checking whether we are using the GNU Fortran compiler... " >&6; } +if ${ac_cv_fc_compiler_gnu+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat > conftest.$ac_ext <<_ACEOF + program main +#ifndef __GNUC__ + choke me +#endif + + end +_ACEOF +if ac_fn_fc_try_compile "$LINENO"; then : + ac_compiler_gnu=yes +else + ac_compiler_gnu=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +ac_cv_fc_compiler_gnu=$ac_compiler_gnu + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_fc_compiler_gnu" >&5 +$as_echo "$ac_cv_fc_compiler_gnu" >&6; } +ac_ext=$ac_save_ext +ac_test_FCFLAGS=${FCFLAGS+set} +ac_save_FCFLAGS=$FCFLAGS +FCFLAGS= +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $FC accepts -g" >&5 +$as_echo_n "checking whether $FC accepts -g... " >&6; } +if ${ac_cv_prog_fc_g+:} false; then : + $as_echo_n "(cached) " >&6 +else + FCFLAGS=-g +cat > conftest.$ac_ext <<_ACEOF + program main + + end +_ACEOF +if ac_fn_fc_try_compile "$LINENO"; then : + ac_cv_prog_fc_g=yes +else + ac_cv_prog_fc_g=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_fc_g" >&5 +$as_echo "$ac_cv_prog_fc_g" >&6; } +if test "$ac_test_FCFLAGS" = set; then + FCFLAGS=$ac_save_FCFLAGS +elif test $ac_cv_prog_fc_g = yes; then + if test "x$ac_cv_fc_compiler_gnu" = xyes; then + FCFLAGS="-g -O2" + else + FCFLAGS="-g" + fi +else + if test "x$ac_cv_fc_compiler_gnu" = xyes; then + FCFLAGS="-O2" + else + FCFLAGS= + fi +fi + +if test $ac_compiler_gnu = yes; then + GFC=yes +else + GFC= +fi +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + + ac_ext=${ac_fc_srcext-f} +ac_compile='$FC -c $FCFLAGS $ac_fcflags_srcext conftest.$ac_ext >&5' +ac_link='$FC -o conftest$ac_exeext $FCFLAGS $LDFLAGS $ac_fcflags_srcext conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_fc_compiler_gnu + + +if test -z "$FC" || test no = "$FC"; then + _lt_disable_FC=yes +fi + +archive_cmds_need_lc_FC=no +allow_undefined_flag_FC= +always_export_symbols_FC=no +archive_expsym_cmds_FC= +export_dynamic_flag_spec_FC= +hardcode_direct_FC=no +hardcode_direct_absolute_FC=no +hardcode_libdir_flag_spec_FC= +hardcode_libdir_separator_FC= +hardcode_minus_L_FC=no +hardcode_automatic_FC=no +inherit_rpath_FC=no +module_cmds_FC= +module_expsym_cmds_FC= +link_all_deplibs_FC=unknown +old_archive_cmds_FC=$old_archive_cmds +reload_flag_FC=$reload_flag +reload_cmds_FC=$reload_cmds +no_undefined_flag_FC= +whole_archive_flag_spec_FC= +enable_shared_with_static_runtimes_FC=no + +# Source file extension for fc test sources. +ac_ext=${ac_fc_srcext-f} + +# Object file extension for compiled fc test sources. +objext=o +objext_FC=$objext + +# No sense in running all these tests if we already determined that +# the FC compiler isn't working. Some variables (like enable_shared) +# are currently assumed to apply to all compilers on this platform, +# and will be corrupted by setting them based on a non-working compiler. +if test yes != "$_lt_disable_FC"; then + # Code to be used in simple compile tests + lt_simple_compile_test_code="\ + subroutine t + return + end +" + + # Code to be used in simple link tests + lt_simple_link_test_code="\ + program t + end +" + + # ltmain only uses $CC for tagged configurations so make sure $CC is set. + + + + + + +# If no C compiler was specified, use CC. +LTCC=${LTCC-"$CC"} + +# If no C compiler flags were specified, use CFLAGS. +LTCFLAGS=${LTCFLAGS-"$CFLAGS"} + +# Allow CC to be a program name with arguments. +compiler=$CC + + + # save warnings/boilerplate of simple test code + ac_outfile=conftest.$ac_objext +echo "$lt_simple_compile_test_code" >conftest.$ac_ext +eval "$ac_compile" 2>&1 >/dev/null | $SED '/^$/d; /^ *+/d' >conftest.err +_lt_compiler_boilerplate=`cat conftest.err` +$RM conftest* + + ac_outfile=conftest.$ac_objext +echo "$lt_simple_link_test_code" >conftest.$ac_ext +eval "$ac_link" 2>&1 >/dev/null | $SED '/^$/d; /^ *+/d' >conftest.err +_lt_linker_boilerplate=`cat conftest.err` +$RM -r conftest* + + + # Allow CC to be a program name with arguments. + lt_save_CC=$CC + lt_save_GCC=$GCC + lt_save_CFLAGS=$CFLAGS + CC=${FC-"f95"} + CFLAGS=$FCFLAGS + compiler=$CC + GCC=$ac_cv_fc_compiler_gnu + + compiler_FC=$CC + func_cc_basename $compiler +cc_basename=$func_cc_basename_result + + + if test -n "$compiler"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking if libtool supports shared libraries" >&5 +$as_echo_n "checking if libtool supports shared libraries... " >&6; } + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $can_build_shared" >&5 +$as_echo "$can_build_shared" >&6; } + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether to build shared libraries" >&5 +$as_echo_n "checking whether to build shared libraries... " >&6; } + test no = "$can_build_shared" && enable_shared=no + + # On AIX, shared libraries and static libraries use the same namespace, and + # are all built from PIC. + case $host_os in + aix3*) + test yes = "$enable_shared" && enable_static=no + if test -n "$RANLIB"; then + archive_cmds="$archive_cmds~\$RANLIB \$lib" + postinstall_cmds='$RANLIB $lib' + fi + ;; + aix[4-9]*) + if test ia64 != "$host_cpu"; then + case $enable_shared,$with_aix_soname,$aix_use_runtimelinking in + yes,aix,yes) ;; # shared object as lib.so file only + yes,svr4,*) ;; # shared object as lib.so archive member only + yes,*) enable_static=no ;; # shared object in lib.a archive as well + esac + fi + ;; + esac + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $enable_shared" >&5 +$as_echo "$enable_shared" >&6; } + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether to build static libraries" >&5 +$as_echo_n "checking whether to build static libraries... " >&6; } + # Make sure either enable_shared or enable_static is yes. + test yes = "$enable_shared" || enable_static=yes + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $enable_static" >&5 +$as_echo "$enable_static" >&6; } + + GCC_FC=$ac_cv_fc_compiler_gnu + LD_FC=$LD + + ## CAVEAT EMPTOR: + ## There is no encapsulation within the following macros, do not change + ## the running order or otherwise move them around unless you know exactly + ## what you are doing... + # Dependencies to place before and after the object being linked: +predep_objects_FC= +postdep_objects_FC= +predeps_FC= +postdeps_FC= +compiler_lib_search_path_FC= + +cat > conftest.$ac_ext <<_LT_EOF + subroutine foo + implicit none + integer a + a=0 + return + end +_LT_EOF + + +_lt_libdeps_save_CFLAGS=$CFLAGS +case "$CC $CFLAGS " in #( +*\ -flto*\ *) CFLAGS="$CFLAGS -fno-lto" ;; +*\ -fwhopr*\ *) CFLAGS="$CFLAGS -fno-whopr" ;; +*\ -fuse-linker-plugin*\ *) CFLAGS="$CFLAGS -fno-use-linker-plugin" ;; +esac + +if { { eval echo "\"\$as_me\":${as_lineno-$LINENO}: \"$ac_compile\""; } >&5 + (eval $ac_compile) 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; }; then + # Parse the compiler output and extract the necessary + # objects, libraries and library flags. + + # Sentinel used to keep track of whether or not we are before + # the conftest object file. + pre_test_object_deps_done=no + + for p in `eval "$output_verbose_link_cmd"`; do + case $prev$p in + + -L* | -R* | -l*) + # Some compilers place space between "-{L,R}" and the path. + # Remove the space. + if test x-L = "$p" || + test x-R = "$p"; then + prev=$p + continue + fi + + # Expand the sysroot to ease extracting the directories later. + if test -z "$prev"; then + case $p in + -L*) func_stripname_cnf '-L' '' "$p"; prev=-L; p=$func_stripname_result ;; + -R*) func_stripname_cnf '-R' '' "$p"; prev=-R; p=$func_stripname_result ;; + -l*) func_stripname_cnf '-l' '' "$p"; prev=-l; p=$func_stripname_result ;; + esac + fi + case $p in + =*) func_stripname_cnf '=' '' "$p"; p=$lt_sysroot$func_stripname_result ;; + esac + if test no = "$pre_test_object_deps_done"; then + case $prev in + -L | -R) + # Internal compiler library paths should come after those + # provided the user. The postdeps already come after the + # user supplied libs so there is no need to process them. + if test -z "$compiler_lib_search_path_FC"; then + compiler_lib_search_path_FC=$prev$p + else + compiler_lib_search_path_FC="${compiler_lib_search_path_FC} $prev$p" + fi + ;; + # The "-l" case would never come before the object being + # linked, so don't bother handling this case. + esac + else + if test -z "$postdeps_FC"; then + postdeps_FC=$prev$p + else + postdeps_FC="${postdeps_FC} $prev$p" + fi + fi + prev= + ;; + + *.lto.$objext) ;; # Ignore GCC LTO objects + *.$objext) + # This assumes that the test object file only shows up + # once in the compiler output. + if test "$p" = "conftest.$objext"; then + pre_test_object_deps_done=yes + continue + fi + + if test no = "$pre_test_object_deps_done"; then + if test -z "$predep_objects_FC"; then + predep_objects_FC=$p + else + predep_objects_FC="$predep_objects_FC $p" + fi + else + if test -z "$postdep_objects_FC"; then + postdep_objects_FC=$p + else + postdep_objects_FC="$postdep_objects_FC $p" + fi + fi + ;; + + *) ;; # Ignore the rest. + + esac + done + + # Clean up. + rm -f a.out a.exe +else + echo "libtool.m4: error: problem compiling FC test program" +fi + +$RM -f confest.$objext +CFLAGS=$_lt_libdeps_save_CFLAGS + +# PORTME: override above test on systems where it is broken + + +case " $postdeps_FC " in +*" -lc "*) archive_cmds_need_lc_FC=no ;; +esac + compiler_lib_search_dirs_FC= +if test -n "${compiler_lib_search_path_FC}"; then + compiler_lib_search_dirs_FC=`echo " ${compiler_lib_search_path_FC}" | $SED -e 's! -L! !g' -e 's!^ !!'` +fi + + + + + + + + + + + + + + lt_prog_compiler_wl_FC= +lt_prog_compiler_pic_FC= +lt_prog_compiler_static_FC= + + + if test yes = "$GCC"; then + lt_prog_compiler_wl_FC='-Wl,' + lt_prog_compiler_static_FC='-static' + + case $host_os in + aix*) + # All AIX code is PIC. + if test ia64 = "$host_cpu"; then + # AIX 5 now supports IA64 processor + lt_prog_compiler_static_FC='-Bstatic' + fi + lt_prog_compiler_pic_FC='-fPIC' + ;; + + amigaos*) + case $host_cpu in + powerpc) + # see comment about AmigaOS4 .so support + lt_prog_compiler_pic_FC='-fPIC' + ;; + m68k) + # FIXME: we need at least 68020 code to build shared libraries, but + # adding the '-m68020' flag to GCC prevents building anything better, + # like '-m68040'. + lt_prog_compiler_pic_FC='-m68020 -resident32 -malways-restore-a4' + ;; + esac + ;; + + beos* | irix5* | irix6* | nonstopux* | osf3* | osf4* | osf5*) + # PIC is the default for these OSes. + ;; + + mingw* | cygwin* | pw32* | os2* | cegcc*) + # This hack is so that the source file can tell whether it is being + # built for inclusion in a dll (and should export symbols for example). + # Although the cygwin gcc ignores -fPIC, still need this for old-style + # (--disable-auto-import) libraries + lt_prog_compiler_pic_FC='-DDLL_EXPORT' + case $host_os in + os2*) + lt_prog_compiler_static_FC='$wl-static' + ;; + esac + ;; + + darwin* | rhapsody*) + # PIC is the default on this platform + # Common symbols not allowed in MH_DYLIB files + lt_prog_compiler_pic_FC='-fno-common' + ;; + + haiku*) + # PIC is the default for Haiku. + # The "-static" flag exists, but is broken. + lt_prog_compiler_static_FC= + ;; + + hpux*) + # PIC is the default for 64-bit PA HP-UX, but not for 32-bit + # PA HP-UX. On IA64 HP-UX, PIC is the default but the pic flag + # sets the default TLS model and affects inlining. + case $host_cpu in + hppa*64*) + # +Z the default + ;; + *) + lt_prog_compiler_pic_FC='-fPIC' + ;; + esac + ;; + + interix[3-9]*) + # Interix 3.x gcc -fpic/-fPIC options generate broken code. + # Instead, we relocate shared libraries at runtime. + ;; + + msdosdjgpp*) + # Just because we use GCC doesn't mean we suddenly get shared libraries + # on systems that don't support them. + lt_prog_compiler_can_build_shared_FC=no + enable_shared=no + ;; + + *nto* | *qnx*) + # QNX uses GNU C++, but need to define -shared option too, otherwise + # it will coredump. + lt_prog_compiler_pic_FC='-fPIC -shared' + ;; + + sysv4*MP*) + if test -d /usr/nec; then + lt_prog_compiler_pic_FC=-Kconform_pic + fi + ;; + + *) + lt_prog_compiler_pic_FC='-fPIC' + ;; + esac + + case $cc_basename in + nvcc*) # Cuda Compiler Driver 2.2 + lt_prog_compiler_wl_FC='-Xlinker ' + if test -n "$lt_prog_compiler_pic_FC"; then + lt_prog_compiler_pic_FC="-Xcompiler $lt_prog_compiler_pic_FC" + fi + ;; + esac + else + # PORTME Check for flag to pass linker flags through the system compiler. + case $host_os in + aix*) + lt_prog_compiler_wl_FC='-Wl,' + if test ia64 = "$host_cpu"; then + # AIX 5 now supports IA64 processor + lt_prog_compiler_static_FC='-Bstatic' + else + lt_prog_compiler_static_FC='-bnso -bI:/lib/syscalls.exp' + fi + ;; + + darwin* | rhapsody*) + # PIC is the default on this platform + # Common symbols not allowed in MH_DYLIB files + lt_prog_compiler_pic_FC='-fno-common' + case $cc_basename in + nagfor*) + # NAG Fortran compiler + lt_prog_compiler_wl_FC='-Wl,-Wl,,' + lt_prog_compiler_pic_FC='-PIC' + lt_prog_compiler_static_FC='-Bstatic' + ;; + esac + ;; + + mingw* | cygwin* | pw32* | os2* | cegcc*) + # This hack is so that the source file can tell whether it is being + # built for inclusion in a dll (and should export symbols for example). + lt_prog_compiler_pic_FC='-DDLL_EXPORT' + case $host_os in + os2*) + lt_prog_compiler_static_FC='$wl-static' + ;; + esac + ;; + + hpux9* | hpux10* | hpux11*) + lt_prog_compiler_wl_FC='-Wl,' + # PIC is the default for IA64 HP-UX and 64-bit HP-UX, but + # not for PA HP-UX. + case $host_cpu in + hppa*64*|ia64*) + # +Z the default + ;; + *) + lt_prog_compiler_pic_FC='+Z' + ;; + esac + # Is there a better lt_prog_compiler_static that works with the bundled CC? + lt_prog_compiler_static_FC='$wl-a ${wl}archive' + ;; + + irix5* | irix6* | nonstopux*) + lt_prog_compiler_wl_FC='-Wl,' + # PIC (with -KPIC) is the default. + lt_prog_compiler_static_FC='-non_shared' + ;; + + linux* | k*bsd*-gnu | kopensolaris*-gnu | gnu*) + case $cc_basename in + # old Intel for x86_64, which still supported -KPIC. + ecc*) + lt_prog_compiler_wl_FC='-Wl,' + lt_prog_compiler_pic_FC='-KPIC' + lt_prog_compiler_static_FC='-static' + ;; + # icc used to be incompatible with GCC. + # ICC 10 doesn't accept -KPIC any more. + icc* | ifort*) + lt_prog_compiler_wl_FC='-Wl,' + lt_prog_compiler_pic_FC='-fPIC' + lt_prog_compiler_static_FC='-static' + ;; + # Lahey Fortran 8.1. + lf95*) + lt_prog_compiler_wl_FC='-Wl,' + lt_prog_compiler_pic_FC='--shared' + lt_prog_compiler_static_FC='--static' + ;; + nagfor*) + # NAG Fortran compiler + lt_prog_compiler_wl_FC='-Wl,-Wl,,' + lt_prog_compiler_pic_FC='-PIC' + lt_prog_compiler_static_FC='-Bstatic' + ;; + tcc*) + # Fabrice Bellard et al's Tiny C Compiler + lt_prog_compiler_wl_FC='-Wl,' + lt_prog_compiler_pic_FC='-fPIC' + lt_prog_compiler_static_FC='-static' + ;; + pgcc* | pgf77* | pgf90* | pgf95* | pgfortran*) + # Portland Group compilers (*not* the Pentium gcc compiler, + # which looks to be a dead project) + lt_prog_compiler_wl_FC='-Wl,' + lt_prog_compiler_pic_FC='-fpic' + lt_prog_compiler_static_FC='-Bstatic' + ;; + ccc*) + lt_prog_compiler_wl_FC='-Wl,' + # All Alpha code is PIC. + lt_prog_compiler_static_FC='-non_shared' + ;; + xl* | bgxl* | bgf* | mpixl*) + # IBM XL C 8.0/Fortran 10.1, 11.1 on PPC and BlueGene + lt_prog_compiler_wl_FC='-Wl,' + lt_prog_compiler_pic_FC='-qpic' + lt_prog_compiler_static_FC='-qstaticlink' + ;; + *) + case `$CC -V 2>&1 | sed 5q` in + *Sun\ Ceres\ Fortran* | *Sun*Fortran*\ [1-7].* | *Sun*Fortran*\ 8.[0-3]*) + # Sun Fortran 8.3 passes all unrecognized flags to the linker + lt_prog_compiler_pic_FC='-KPIC' + lt_prog_compiler_static_FC='-Bstatic' + lt_prog_compiler_wl_FC='' + ;; + *Sun\ F* | *Sun*Fortran*) + lt_prog_compiler_pic_FC='-KPIC' + lt_prog_compiler_static_FC='-Bstatic' + lt_prog_compiler_wl_FC='-Qoption ld ' + ;; + *Sun\ C*) + # Sun C 5.9 + lt_prog_compiler_pic_FC='-KPIC' + lt_prog_compiler_static_FC='-Bstatic' + lt_prog_compiler_wl_FC='-Wl,' + ;; + *Intel*\ [CF]*Compiler*) + lt_prog_compiler_wl_FC='-Wl,' + lt_prog_compiler_pic_FC='-fPIC' + lt_prog_compiler_static_FC='-static' + ;; + *Portland\ Group*) + lt_prog_compiler_wl_FC='-Wl,' + lt_prog_compiler_pic_FC='-fpic' + lt_prog_compiler_static_FC='-Bstatic' + ;; + esac + ;; + esac + ;; + + newsos6) + lt_prog_compiler_pic_FC='-KPIC' + lt_prog_compiler_static_FC='-Bstatic' + ;; + + *nto* | *qnx*) + # QNX uses GNU C++, but need to define -shared option too, otherwise + # it will coredump. + lt_prog_compiler_pic_FC='-fPIC -shared' + ;; + + osf3* | osf4* | osf5*) + lt_prog_compiler_wl_FC='-Wl,' + # All OSF/1 code is PIC. + lt_prog_compiler_static_FC='-non_shared' + ;; + + rdos*) + lt_prog_compiler_static_FC='-non_shared' + ;; + + solaris*) + lt_prog_compiler_pic_FC='-KPIC' + lt_prog_compiler_static_FC='-Bstatic' + case $cc_basename in + f77* | f90* | f95* | sunf77* | sunf90* | sunf95*) + lt_prog_compiler_wl_FC='-Qoption ld ';; + *) + lt_prog_compiler_wl_FC='-Wl,';; + esac + ;; + + sunos4*) + lt_prog_compiler_wl_FC='-Qoption ld ' + lt_prog_compiler_pic_FC='-PIC' + lt_prog_compiler_static_FC='-Bstatic' + ;; + + sysv4 | sysv4.2uw2* | sysv4.3*) + lt_prog_compiler_wl_FC='-Wl,' + lt_prog_compiler_pic_FC='-KPIC' + lt_prog_compiler_static_FC='-Bstatic' + ;; + + sysv4*MP*) + if test -d /usr/nec; then + lt_prog_compiler_pic_FC='-Kconform_pic' + lt_prog_compiler_static_FC='-Bstatic' + fi + ;; + + sysv5* | unixware* | sco3.2v5* | sco5v6* | OpenUNIX*) + lt_prog_compiler_wl_FC='-Wl,' + lt_prog_compiler_pic_FC='-KPIC' + lt_prog_compiler_static_FC='-Bstatic' + ;; + + unicos*) + lt_prog_compiler_wl_FC='-Wl,' + lt_prog_compiler_can_build_shared_FC=no + ;; + + uts4*) + lt_prog_compiler_pic_FC='-pic' + lt_prog_compiler_static_FC='-Bstatic' + ;; + + *) + lt_prog_compiler_can_build_shared_FC=no + ;; + esac + fi + +case $host_os in + # For platforms that do not support PIC, -DPIC is meaningless: + *djgpp*) + lt_prog_compiler_pic_FC= + ;; + *) + lt_prog_compiler_pic_FC="$lt_prog_compiler_pic_FC" + ;; +esac + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $compiler option to produce PIC" >&5 +$as_echo_n "checking for $compiler option to produce PIC... " >&6; } +if ${lt_cv_prog_compiler_pic_FC+:} false; then : + $as_echo_n "(cached) " >&6 +else + lt_cv_prog_compiler_pic_FC=$lt_prog_compiler_pic_FC +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_prog_compiler_pic_FC" >&5 +$as_echo "$lt_cv_prog_compiler_pic_FC" >&6; } +lt_prog_compiler_pic_FC=$lt_cv_prog_compiler_pic_FC + +# +# Check to make sure the PIC flag actually works. +# +if test -n "$lt_prog_compiler_pic_FC"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking if $compiler PIC flag $lt_prog_compiler_pic_FC works" >&5 +$as_echo_n "checking if $compiler PIC flag $lt_prog_compiler_pic_FC works... " >&6; } +if ${lt_cv_prog_compiler_pic_works_FC+:} false; then : + $as_echo_n "(cached) " >&6 +else + lt_cv_prog_compiler_pic_works_FC=no + ac_outfile=conftest.$ac_objext + echo "$lt_simple_compile_test_code" > conftest.$ac_ext + lt_compiler_flag="$lt_prog_compiler_pic_FC" ## exclude from sc_useless_quotes_in_assignment + # Insert the option either (1) after the last *FLAGS variable, or + # (2) before a word containing "conftest.", or (3) at the end. + # Note that $ac_compile itself does not contain backslashes and begins + # with a dollar sign (not a hyphen), so the echo should work correctly. + # The option is referenced via a variable to avoid confusing sed. + lt_compile=`echo "$ac_compile" | $SED \ + -e 's:.*FLAGS}\{0,1\} :&$lt_compiler_flag :; t' \ + -e 's: [^ ]*conftest\.: $lt_compiler_flag&:; t' \ + -e 's:$: $lt_compiler_flag:'` + (eval echo "\"\$as_me:$LINENO: $lt_compile\"" >&5) + (eval "$lt_compile" 2>conftest.err) + ac_status=$? + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + if (exit $ac_status) && test -s "$ac_outfile"; then + # The compiler can only warn and ignore the option if not recognized + # So say no if there are warnings other than the usual output. + $ECHO "$_lt_compiler_boilerplate" | $SED '/^$/d' >conftest.exp + $SED '/^$/d; /^ *+/d' conftest.err >conftest.er2 + if test ! -s conftest.er2 || diff conftest.exp conftest.er2 >/dev/null; then + lt_cv_prog_compiler_pic_works_FC=yes + fi + fi + $RM conftest* + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_prog_compiler_pic_works_FC" >&5 +$as_echo "$lt_cv_prog_compiler_pic_works_FC" >&6; } + +if test yes = "$lt_cv_prog_compiler_pic_works_FC"; then + case $lt_prog_compiler_pic_FC in + "" | " "*) ;; + *) lt_prog_compiler_pic_FC=" $lt_prog_compiler_pic_FC" ;; + esac +else + lt_prog_compiler_pic_FC= + lt_prog_compiler_can_build_shared_FC=no +fi + +fi + + + + + +# +# Check to make sure the static flag actually works. +# +wl=$lt_prog_compiler_wl_FC eval lt_tmp_static_flag=\"$lt_prog_compiler_static_FC\" +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking if $compiler static flag $lt_tmp_static_flag works" >&5 +$as_echo_n "checking if $compiler static flag $lt_tmp_static_flag works... " >&6; } +if ${lt_cv_prog_compiler_static_works_FC+:} false; then : + $as_echo_n "(cached) " >&6 +else + lt_cv_prog_compiler_static_works_FC=no + save_LDFLAGS=$LDFLAGS + LDFLAGS="$LDFLAGS $lt_tmp_static_flag" + echo "$lt_simple_link_test_code" > conftest.$ac_ext + if (eval $ac_link 2>conftest.err) && test -s conftest$ac_exeext; then + # The linker can only warn and ignore the option if not recognized + # So say no if there are warnings + if test -s conftest.err; then + # Append any errors to the config.log. + cat conftest.err 1>&5 + $ECHO "$_lt_linker_boilerplate" | $SED '/^$/d' > conftest.exp + $SED '/^$/d; /^ *+/d' conftest.err >conftest.er2 + if diff conftest.exp conftest.er2 >/dev/null; then + lt_cv_prog_compiler_static_works_FC=yes + fi + else + lt_cv_prog_compiler_static_works_FC=yes + fi + fi + $RM -r conftest* + LDFLAGS=$save_LDFLAGS + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_prog_compiler_static_works_FC" >&5 +$as_echo "$lt_cv_prog_compiler_static_works_FC" >&6; } + +if test yes = "$lt_cv_prog_compiler_static_works_FC"; then + : +else + lt_prog_compiler_static_FC= +fi + + + + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking if $compiler supports -c -o file.$ac_objext" >&5 +$as_echo_n "checking if $compiler supports -c -o file.$ac_objext... " >&6; } +if ${lt_cv_prog_compiler_c_o_FC+:} false; then : + $as_echo_n "(cached) " >&6 +else + lt_cv_prog_compiler_c_o_FC=no + $RM -r conftest 2>/dev/null + mkdir conftest + cd conftest + mkdir out + echo "$lt_simple_compile_test_code" > conftest.$ac_ext + + lt_compiler_flag="-o out/conftest2.$ac_objext" + # Insert the option either (1) after the last *FLAGS variable, or + # (2) before a word containing "conftest.", or (3) at the end. + # Note that $ac_compile itself does not contain backslashes and begins + # with a dollar sign (not a hyphen), so the echo should work correctly. + lt_compile=`echo "$ac_compile" | $SED \ + -e 's:.*FLAGS}\{0,1\} :&$lt_compiler_flag :; t' \ + -e 's: [^ ]*conftest\.: $lt_compiler_flag&:; t' \ + -e 's:$: $lt_compiler_flag:'` + (eval echo "\"\$as_me:$LINENO: $lt_compile\"" >&5) + (eval "$lt_compile" 2>out/conftest.err) + ac_status=$? + cat out/conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + if (exit $ac_status) && test -s out/conftest2.$ac_objext + then + # The compiler can only warn and ignore the option if not recognized + # So say no if there are warnings + $ECHO "$_lt_compiler_boilerplate" | $SED '/^$/d' > out/conftest.exp + $SED '/^$/d; /^ *+/d' out/conftest.err >out/conftest.er2 + if test ! -s out/conftest.er2 || diff out/conftest.exp out/conftest.er2 >/dev/null; then + lt_cv_prog_compiler_c_o_FC=yes + fi + fi + chmod u+w . 2>&5 + $RM conftest* + # SGI C++ compiler will create directory out/ii_files/ for + # template instantiation + test -d out/ii_files && $RM out/ii_files/* && rmdir out/ii_files + $RM out/* && rmdir out + cd .. + $RM -r conftest + $RM conftest* + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_prog_compiler_c_o_FC" >&5 +$as_echo "$lt_cv_prog_compiler_c_o_FC" >&6; } + + + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking if $compiler supports -c -o file.$ac_objext" >&5 +$as_echo_n "checking if $compiler supports -c -o file.$ac_objext... " >&6; } +if ${lt_cv_prog_compiler_c_o_FC+:} false; then : + $as_echo_n "(cached) " >&6 +else + lt_cv_prog_compiler_c_o_FC=no + $RM -r conftest 2>/dev/null + mkdir conftest + cd conftest + mkdir out + echo "$lt_simple_compile_test_code" > conftest.$ac_ext + + lt_compiler_flag="-o out/conftest2.$ac_objext" + # Insert the option either (1) after the last *FLAGS variable, or + # (2) before a word containing "conftest.", or (3) at the end. + # Note that $ac_compile itself does not contain backslashes and begins + # with a dollar sign (not a hyphen), so the echo should work correctly. + lt_compile=`echo "$ac_compile" | $SED \ + -e 's:.*FLAGS}\{0,1\} :&$lt_compiler_flag :; t' \ + -e 's: [^ ]*conftest\.: $lt_compiler_flag&:; t' \ + -e 's:$: $lt_compiler_flag:'` + (eval echo "\"\$as_me:$LINENO: $lt_compile\"" >&5) + (eval "$lt_compile" 2>out/conftest.err) + ac_status=$? + cat out/conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + if (exit $ac_status) && test -s out/conftest2.$ac_objext + then + # The compiler can only warn and ignore the option if not recognized + # So say no if there are warnings + $ECHO "$_lt_compiler_boilerplate" | $SED '/^$/d' > out/conftest.exp + $SED '/^$/d; /^ *+/d' out/conftest.err >out/conftest.er2 + if test ! -s out/conftest.er2 || diff out/conftest.exp out/conftest.er2 >/dev/null; then + lt_cv_prog_compiler_c_o_FC=yes + fi + fi + chmod u+w . 2>&5 + $RM conftest* + # SGI C++ compiler will create directory out/ii_files/ for + # template instantiation + test -d out/ii_files && $RM out/ii_files/* && rmdir out/ii_files + $RM out/* && rmdir out + cd .. + $RM -r conftest + $RM conftest* + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_prog_compiler_c_o_FC" >&5 +$as_echo "$lt_cv_prog_compiler_c_o_FC" >&6; } + + + + +hard_links=nottested +if test no = "$lt_cv_prog_compiler_c_o_FC" && test no != "$need_locks"; then + # do not overwrite the value of need_locks provided by the user + { $as_echo "$as_me:${as_lineno-$LINENO}: checking if we can lock with hard links" >&5 +$as_echo_n "checking if we can lock with hard links... " >&6; } + hard_links=yes + $RM conftest* + ln conftest.a conftest.b 2>/dev/null && hard_links=no + touch conftest.a + ln conftest.a conftest.b 2>&5 || hard_links=no + ln conftest.a conftest.b 2>/dev/null && hard_links=no + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $hard_links" >&5 +$as_echo "$hard_links" >&6; } + if test no = "$hard_links"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: '$CC' does not support '-c -o', so 'make -j' may be unsafe" >&5 +$as_echo "$as_me: WARNING: '$CC' does not support '-c -o', so 'make -j' may be unsafe" >&2;} + need_locks=warn + fi +else + need_locks=no +fi + + + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether the $compiler linker ($LD) supports shared libraries" >&5 +$as_echo_n "checking whether the $compiler linker ($LD) supports shared libraries... " >&6; } + + runpath_var= + allow_undefined_flag_FC= + always_export_symbols_FC=no + archive_cmds_FC= + archive_expsym_cmds_FC= + compiler_needs_object_FC=no + enable_shared_with_static_runtimes_FC=no + export_dynamic_flag_spec_FC= + export_symbols_cmds_FC='$NM $libobjs $convenience | $global_symbol_pipe | $SED '\''s/.* //'\'' | sort | uniq > $export_symbols' + hardcode_automatic_FC=no + hardcode_direct_FC=no + hardcode_direct_absolute_FC=no + hardcode_libdir_flag_spec_FC= + hardcode_libdir_separator_FC= + hardcode_minus_L_FC=no + hardcode_shlibpath_var_FC=unsupported + inherit_rpath_FC=no + link_all_deplibs_FC=unknown + module_cmds_FC= + module_expsym_cmds_FC= + old_archive_from_new_cmds_FC= + old_archive_from_expsyms_cmds_FC= + thread_safe_flag_spec_FC= + whole_archive_flag_spec_FC= + # include_expsyms should be a list of space-separated symbols to be *always* + # included in the symbol list + include_expsyms_FC= + # exclude_expsyms can be an extended regexp of symbols to exclude + # it will be wrapped by ' (' and ')$', so one must not match beginning or + # end of line. Example: 'a|bc|.*d.*' will exclude the symbols 'a' and 'bc', + # as well as any symbol that contains 'd'. + exclude_expsyms_FC='_GLOBAL_OFFSET_TABLE_|_GLOBAL__F[ID]_.*' + # Although _GLOBAL_OFFSET_TABLE_ is a valid symbol C name, most a.out + # platforms (ab)use it in PIC code, but their linkers get confused if + # the symbol is explicitly referenced. Since portable code cannot + # rely on this symbol name, it's probably fine to never include it in + # preloaded symbol tables. + # Exclude shared library initialization/finalization symbols. + extract_expsyms_cmds= + + case $host_os in + cygwin* | mingw* | pw32* | cegcc*) + # FIXME: the MSVC++ port hasn't been tested in a loooong time + # When not using gcc, we currently assume that we are using + # Microsoft Visual C++. + if test yes != "$GCC"; then + with_gnu_ld=no + fi + ;; + interix*) + # we just hope/assume this is gcc and not c89 (= MSVC++) + with_gnu_ld=yes + ;; + openbsd* | bitrig*) + with_gnu_ld=no + ;; + esac + + ld_shlibs_FC=yes + + # On some targets, GNU ld is compatible enough with the native linker + # that we're better off using the native interface for both. + lt_use_gnu_ld_interface=no + if test yes = "$with_gnu_ld"; then + case $host_os in + aix*) + # The AIX port of GNU ld has always aspired to compatibility + # with the native linker. However, as the warning in the GNU ld + # block says, versions before 2.19.5* couldn't really create working + # shared libraries, regardless of the interface used. + case `$LD -v 2>&1` in + *\ \(GNU\ Binutils\)\ 2.19.5*) ;; + *\ \(GNU\ Binutils\)\ 2.[2-9]*) ;; + *\ \(GNU\ Binutils\)\ [3-9]*) ;; + *) + lt_use_gnu_ld_interface=yes + ;; + esac + ;; + *) + lt_use_gnu_ld_interface=yes + ;; + esac + fi + + if test yes = "$lt_use_gnu_ld_interface"; then + # If archive_cmds runs LD, not CC, wlarc should be empty + wlarc='$wl' + + # Set some defaults for GNU ld with shared library support. These + # are reset later if shared libraries are not supported. Putting them + # here allows them to be overridden if necessary. + runpath_var=LD_RUN_PATH + hardcode_libdir_flag_spec_FC='$wl-rpath $wl$libdir' + export_dynamic_flag_spec_FC='$wl--export-dynamic' + # ancient GNU ld didn't support --whole-archive et. al. + if $LD --help 2>&1 | $GREP 'no-whole-archive' > /dev/null; then + whole_archive_flag_spec_FC=$wlarc'--whole-archive$convenience '$wlarc'--no-whole-archive' + else + whole_archive_flag_spec_FC= + fi + supports_anon_versioning=no + case `$LD -v | $SED -e 's/(^)\+)\s\+//' 2>&1` in + *GNU\ gold*) supports_anon_versioning=yes ;; + *\ [01].* | *\ 2.[0-9].* | *\ 2.10.*) ;; # catch versions < 2.11 + *\ 2.11.93.0.2\ *) supports_anon_versioning=yes ;; # RH7.3 ... + *\ 2.11.92.0.12\ *) supports_anon_versioning=yes ;; # Mandrake 8.2 ... + *\ 2.11.*) ;; # other 2.11 versions + *) supports_anon_versioning=yes ;; + esac + + # See if GNU ld supports shared libraries. + case $host_os in + aix[3-9]*) + # On AIX/PPC, the GNU linker is very broken + if test ia64 != "$host_cpu"; then + ld_shlibs_FC=no + cat <<_LT_EOF 1>&2 + +*** Warning: the GNU linker, at least up to release 2.19, is reported +*** to be unable to reliably create shared libraries on AIX. +*** Therefore, libtool is disabling shared libraries support. If you +*** really care for shared libraries, you may want to install binutils +*** 2.20 or above, or modify your PATH so that a non-GNU linker is found. +*** You will then need to restart the configuration process. + +_LT_EOF + fi + ;; + + amigaos*) + case $host_cpu in + powerpc) + # see comment about AmigaOS4 .so support + archive_cmds_FC='$CC -shared $libobjs $deplibs $compiler_flags $wl-soname $wl$soname -o $lib' + archive_expsym_cmds_FC='' + ;; + m68k) + archive_cmds_FC='$RM $output_objdir/a2ixlibrary.data~$ECHO "#define NAME $libname" > $output_objdir/a2ixlibrary.data~$ECHO "#define LIBRARY_ID 1" >> $output_objdir/a2ixlibrary.data~$ECHO "#define VERSION $major" >> $output_objdir/a2ixlibrary.data~$ECHO "#define REVISION $revision" >> $output_objdir/a2ixlibrary.data~$AR $AR_FLAGS $lib $libobjs~$RANLIB $lib~(cd $output_objdir && a2ixlibrary -32)' + hardcode_libdir_flag_spec_FC='-L$libdir' + hardcode_minus_L_FC=yes + ;; + esac + ;; + + beos*) + if $LD --help 2>&1 | $GREP ': supported targets:.* elf' > /dev/null; then + allow_undefined_flag_FC=unsupported + # Joseph Beckenbach <jrb3@best.com> says some releases of gcc + # support --undefined. This deserves some investigation. FIXME + archive_cmds_FC='$CC -nostart $libobjs $deplibs $compiler_flags $wl-soname $wl$soname -o $lib' + else + ld_shlibs_FC=no + fi + ;; + + cygwin* | mingw* | pw32* | cegcc*) + # _LT_TAGVAR(hardcode_libdir_flag_spec, FC) is actually meaningless, + # as there is no search path for DLLs. + hardcode_libdir_flag_spec_FC='-L$libdir' + export_dynamic_flag_spec_FC='$wl--export-all-symbols' + allow_undefined_flag_FC=unsupported + always_export_symbols_FC=no + enable_shared_with_static_runtimes_FC=yes + export_symbols_cmds_FC='$NM $libobjs $convenience | $global_symbol_pipe | $SED -e '\''/^[BCDGRS][ ]/s/.*[ ]\([^ ]*\)/\1 DATA/;s/^.*[ ]__nm__\([^ ]*\)[ ][^ ]*/\1 DATA/;/^I[ ]/d;/^[AITW][ ]/s/.* //'\'' | sort | uniq > $export_symbols' + exclude_expsyms_FC='[_]+GLOBAL_OFFSET_TABLE_|[_]+GLOBAL__[FID]_.*|[_]+head_[A-Za-z0-9_]+_dll|[A-Za-z0-9_]+_dll_iname' + + if $LD --help 2>&1 | $GREP 'auto-import' > /dev/null; then + archive_cmds_FC='$CC -shared $libobjs $deplibs $compiler_flags -o $output_objdir/$soname $wl--enable-auto-image-base -Xlinker --out-implib -Xlinker $lib' + # If the export-symbols file already is a .def file, use it as + # is; otherwise, prepend EXPORTS... + archive_expsym_cmds_FC='if test DEF = "`$SED -n -e '\''s/^[ ]*//'\'' -e '\''/^\(;.*\)*$/d'\'' -e '\''s/^\(EXPORTS\|LIBRARY\)\([ ].*\)*$/DEF/p'\'' -e q $export_symbols`" ; then + cp $export_symbols $output_objdir/$soname.def; + else + echo EXPORTS > $output_objdir/$soname.def; + cat $export_symbols >> $output_objdir/$soname.def; + fi~ + $CC -shared $output_objdir/$soname.def $libobjs $deplibs $compiler_flags -o $output_objdir/$soname $wl--enable-auto-image-base -Xlinker --out-implib -Xlinker $lib' + else + ld_shlibs_FC=no + fi + ;; + + haiku*) + archive_cmds_FC='$CC -shared $libobjs $deplibs $compiler_flags $wl-soname $wl$soname -o $lib' + link_all_deplibs_FC=yes + ;; + + os2*) + hardcode_libdir_flag_spec_FC='-L$libdir' + hardcode_minus_L_FC=yes + allow_undefined_flag_FC=unsupported + shrext_cmds=.dll + archive_cmds_FC='$ECHO "LIBRARY ${soname%$shared_ext} INITINSTANCE TERMINSTANCE" > $output_objdir/$libname.def~ + $ECHO "DESCRIPTION \"$libname\"" >> $output_objdir/$libname.def~ + $ECHO "DATA MULTIPLE NONSHARED" >> $output_objdir/$libname.def~ + $ECHO EXPORTS >> $output_objdir/$libname.def~ + emxexp $libobjs | $SED /"_DLL_InitTerm"/d >> $output_objdir/$libname.def~ + $CC -Zdll -Zcrtdll -o $output_objdir/$soname $libobjs $deplibs $compiler_flags $output_objdir/$libname.def~ + emximp -o $lib $output_objdir/$libname.def' + archive_expsym_cmds_FC='$ECHO "LIBRARY ${soname%$shared_ext} INITINSTANCE TERMINSTANCE" > $output_objdir/$libname.def~ + $ECHO "DESCRIPTION \"$libname\"" >> $output_objdir/$libname.def~ + $ECHO "DATA MULTIPLE NONSHARED" >> $output_objdir/$libname.def~ + $ECHO EXPORTS >> $output_objdir/$libname.def~ + prefix_cmds="$SED"~ + if test EXPORTS = "`$SED 1q $export_symbols`"; then + prefix_cmds="$prefix_cmds -e 1d"; + fi~ + prefix_cmds="$prefix_cmds -e \"s/^\(.*\)$/_\1/g\""~ + cat $export_symbols | $prefix_cmds >> $output_objdir/$libname.def~ + $CC -Zdll -Zcrtdll -o $output_objdir/$soname $libobjs $deplibs $compiler_flags $output_objdir/$libname.def~ + emximp -o $lib $output_objdir/$libname.def' + old_archive_From_new_cmds_FC='emximp -o $output_objdir/${libname}_dll.a $output_objdir/$libname.def' + enable_shared_with_static_runtimes_FC=yes + ;; + + interix[3-9]*) + hardcode_direct_FC=no + hardcode_shlibpath_var_FC=no + hardcode_libdir_flag_spec_FC='$wl-rpath,$libdir' + export_dynamic_flag_spec_FC='$wl-E' + # Hack: On Interix 3.x, we cannot compile PIC because of a broken gcc. + # Instead, shared libraries are loaded at an image base (0x10000000 by + # default) and relocated if they conflict, which is a slow very memory + # consuming and fragmenting process. To avoid this, we pick a random, + # 256 KiB-aligned image base between 0x50000000 and 0x6FFC0000 at link + # time. Moving up from 0x10000000 also allows more sbrk(2) space. + archive_cmds_FC='$CC -shared $pic_flag $libobjs $deplibs $compiler_flags $wl-h,$soname $wl--image-base,`expr ${RANDOM-$$} % 4096 / 2 \* 262144 + 1342177280` -o $lib' + archive_expsym_cmds_FC='sed "s|^|_|" $export_symbols >$output_objdir/$soname.expsym~$CC -shared $pic_flag $libobjs $deplibs $compiler_flags $wl-h,$soname $wl--retain-symbols-file,$output_objdir/$soname.expsym $wl--image-base,`expr ${RANDOM-$$} % 4096 / 2 \* 262144 + 1342177280` -o $lib' + ;; + + gnu* | linux* | tpf* | k*bsd*-gnu | kopensolaris*-gnu) + tmp_diet=no + if test linux-dietlibc = "$host_os"; then + case $cc_basename in + diet\ *) tmp_diet=yes;; # linux-dietlibc with static linking (!diet-dyn) + esac + fi + if $LD --help 2>&1 | $EGREP ': supported targets:.* elf' > /dev/null \ + && test no = "$tmp_diet" + then + tmp_addflag=' $pic_flag' + tmp_sharedflag='-shared' + case $cc_basename,$host_cpu in + pgcc*) # Portland Group C compiler + whole_archive_flag_spec_FC='$wl--whole-archive`for conv in $convenience\"\"; do test -n \"$conv\" && new_convenience=\"$new_convenience,$conv\"; done; func_echo_all \"$new_convenience\"` $wl--no-whole-archive' + tmp_addflag=' $pic_flag' + ;; + pgf77* | pgf90* | pgf95* | pgfortran*) + # Portland Group f77 and f90 compilers + whole_archive_flag_spec_FC='$wl--whole-archive`for conv in $convenience\"\"; do test -n \"$conv\" && new_convenience=\"$new_convenience,$conv\"; done; func_echo_all \"$new_convenience\"` $wl--no-whole-archive' + tmp_addflag=' $pic_flag -Mnomain' ;; + ecc*,ia64* | icc*,ia64*) # Intel C compiler on ia64 + tmp_addflag=' -i_dynamic' ;; + efc*,ia64* | ifort*,ia64*) # Intel Fortran compiler on ia64 + tmp_addflag=' -i_dynamic -nofor_main' ;; + ifc* | ifort*) # Intel Fortran compiler + tmp_addflag=' -nofor_main' ;; + lf95*) # Lahey Fortran 8.1 + whole_archive_flag_spec_FC= + tmp_sharedflag='--shared' ;; + nagfor*) # NAGFOR 5.3 + tmp_sharedflag='-Wl,-shared' ;; + xl[cC]* | bgxl[cC]* | mpixl[cC]*) # IBM XL C 8.0 on PPC (deal with xlf below) + tmp_sharedflag='-qmkshrobj' + tmp_addflag= ;; + nvcc*) # Cuda Compiler Driver 2.2 + whole_archive_flag_spec_FC='$wl--whole-archive`for conv in $convenience\"\"; do test -n \"$conv\" && new_convenience=\"$new_convenience,$conv\"; done; func_echo_all \"$new_convenience\"` $wl--no-whole-archive' + compiler_needs_object_FC=yes + ;; + esac + case `$CC -V 2>&1 | sed 5q` in + *Sun\ C*) # Sun C 5.9 + whole_archive_flag_spec_FC='$wl--whole-archive`new_convenience=; for conv in $convenience\"\"; do test -z \"$conv\" || new_convenience=\"$new_convenience,$conv\"; done; func_echo_all \"$new_convenience\"` $wl--no-whole-archive' + compiler_needs_object_FC=yes + tmp_sharedflag='-G' ;; + *Sun\ F*) # Sun Fortran 8.3 + tmp_sharedflag='-G' ;; + esac + archive_cmds_FC='$CC '"$tmp_sharedflag""$tmp_addflag"' $libobjs $deplibs $compiler_flags $wl-soname $wl$soname -o $lib' + + if test yes = "$supports_anon_versioning"; then + archive_expsym_cmds_FC='echo "{ global:" > $output_objdir/$libname.ver~ + cat $export_symbols | sed -e "s/\(.*\)/\1;/" >> $output_objdir/$libname.ver~ + echo "local: *; };" >> $output_objdir/$libname.ver~ + $CC '"$tmp_sharedflag""$tmp_addflag"' $libobjs $deplibs $compiler_flags $wl-soname $wl$soname $wl-version-script $wl$output_objdir/$libname.ver -o $lib' + fi + + case $cc_basename in + tcc*) + export_dynamic_flag_spec_FC='-rdynamic' + ;; + xlf* | bgf* | bgxlf* | mpixlf*) + # IBM XL Fortran 10.1 on PPC cannot create shared libs itself + whole_archive_flag_spec_FC='--whole-archive$convenience --no-whole-archive' + hardcode_libdir_flag_spec_FC='$wl-rpath $wl$libdir' + archive_cmds_FC='$LD -shared $libobjs $deplibs $linker_flags -soname $soname -o $lib' + if test yes = "$supports_anon_versioning"; then + archive_expsym_cmds_FC='echo "{ global:" > $output_objdir/$libname.ver~ + cat $export_symbols | sed -e "s/\(.*\)/\1;/" >> $output_objdir/$libname.ver~ + echo "local: *; };" >> $output_objdir/$libname.ver~ + $LD -shared $libobjs $deplibs $linker_flags -soname $soname -version-script $output_objdir/$libname.ver -o $lib' + fi + ;; + esac + else + ld_shlibs_FC=no + fi + ;; + + netbsd*) + if echo __ELF__ | $CC -E - | $GREP __ELF__ >/dev/null; then + archive_cmds_FC='$LD -Bshareable $libobjs $deplibs $linker_flags -o $lib' + wlarc= + else + archive_cmds_FC='$CC -shared $pic_flag $libobjs $deplibs $compiler_flags $wl-soname $wl$soname -o $lib' + archive_expsym_cmds_FC='$CC -shared $pic_flag $libobjs $deplibs $compiler_flags $wl-soname $wl$soname $wl-retain-symbols-file $wl$export_symbols -o $lib' + fi + ;; + + solaris*) + if $LD -v 2>&1 | $GREP 'BFD 2\.8' > /dev/null; then + ld_shlibs_FC=no + cat <<_LT_EOF 1>&2 + +*** Warning: The releases 2.8.* of the GNU linker cannot reliably +*** create shared libraries on Solaris systems. Therefore, libtool +*** is disabling shared libraries support. We urge you to upgrade GNU +*** binutils to release 2.9.1 or newer. Another option is to modify +*** your PATH or compiler configuration so that the native linker is +*** used, and then restart. + +_LT_EOF + elif $LD --help 2>&1 | $GREP ': supported targets:.* elf' > /dev/null; then + archive_cmds_FC='$CC -shared $pic_flag $libobjs $deplibs $compiler_flags $wl-soname $wl$soname -o $lib' + archive_expsym_cmds_FC='$CC -shared $pic_flag $libobjs $deplibs $compiler_flags $wl-soname $wl$soname $wl-retain-symbols-file $wl$export_symbols -o $lib' + else + ld_shlibs_FC=no + fi + ;; + + sysv5* | sco3.2v5* | sco5v6* | unixware* | OpenUNIX*) + case `$LD -v 2>&1` in + *\ [01].* | *\ 2.[0-9].* | *\ 2.1[0-5].*) + ld_shlibs_FC=no + cat <<_LT_EOF 1>&2 + +*** Warning: Releases of the GNU linker prior to 2.16.91.0.3 cannot +*** reliably create shared libraries on SCO systems. Therefore, libtool +*** is disabling shared libraries support. We urge you to upgrade GNU +*** binutils to release 2.16.91.0.3 or newer. Another option is to modify +*** your PATH or compiler configuration so that the native linker is +*** used, and then restart. + +_LT_EOF + ;; + *) + # For security reasons, it is highly recommended that you always + # use absolute paths for naming shared libraries, and exclude the + # DT_RUNPATH tag from executables and libraries. But doing so + # requires that you compile everything twice, which is a pain. + if $LD --help 2>&1 | $GREP ': supported targets:.* elf' > /dev/null; then + hardcode_libdir_flag_spec_FC='$wl-rpath $wl$libdir' + archive_cmds_FC='$CC -shared $libobjs $deplibs $compiler_flags $wl-soname $wl$soname -o $lib' + archive_expsym_cmds_FC='$CC -shared $libobjs $deplibs $compiler_flags $wl-soname $wl$soname $wl-retain-symbols-file $wl$export_symbols -o $lib' + else + ld_shlibs_FC=no + fi + ;; + esac + ;; + + sunos4*) + archive_cmds_FC='$LD -assert pure-text -Bshareable -o $lib $libobjs $deplibs $linker_flags' + wlarc= + hardcode_direct_FC=yes + hardcode_shlibpath_var_FC=no + ;; + + *) + if $LD --help 2>&1 | $GREP ': supported targets:.* elf' > /dev/null; then + archive_cmds_FC='$CC -shared $pic_flag $libobjs $deplibs $compiler_flags $wl-soname $wl$soname -o $lib' + archive_expsym_cmds_FC='$CC -shared $pic_flag $libobjs $deplibs $compiler_flags $wl-soname $wl$soname $wl-retain-symbols-file $wl$export_symbols -o $lib' + else + ld_shlibs_FC=no + fi + ;; + esac + + if test no = "$ld_shlibs_FC"; then + runpath_var= + hardcode_libdir_flag_spec_FC= + export_dynamic_flag_spec_FC= + whole_archive_flag_spec_FC= + fi + else + # PORTME fill in a description of your system's linker (not GNU ld) + case $host_os in + aix3*) + allow_undefined_flag_FC=unsupported + always_export_symbols_FC=yes + archive_expsym_cmds_FC='$LD -o $output_objdir/$soname $libobjs $deplibs $linker_flags -bE:$export_symbols -T512 -H512 -bM:SRE~$AR $AR_FLAGS $lib $output_objdir/$soname' + # Note: this linker hardcodes the directories in LIBPATH if there + # are no directories specified by -L. + hardcode_minus_L_FC=yes + if test yes = "$GCC" && test -z "$lt_prog_compiler_static"; then + # Neither direct hardcoding nor static linking is supported with a + # broken collect2. + hardcode_direct_FC=unsupported + fi + ;; + + aix[4-9]*) + if test ia64 = "$host_cpu"; then + # On IA64, the linker does run time linking by default, so we don't + # have to do anything special. + aix_use_runtimelinking=no + exp_sym_flag='-Bexport' + no_entry_flag= + else + # If we're using GNU nm, then we don't want the "-C" option. + # -C means demangle to GNU nm, but means don't demangle to AIX nm. + # Without the "-l" option, or with the "-B" option, AIX nm treats + # weak defined symbols like other global defined symbols, whereas + # GNU nm marks them as "W". + # While the 'weak' keyword is ignored in the Export File, we need + # it in the Import File for the 'aix-soname' feature, so we have + # to replace the "-B" option with "-P" for AIX nm. + if $NM -V 2>&1 | $GREP 'GNU' > /dev/null; then + export_symbols_cmds_FC='$NM -Bpg $libobjs $convenience | awk '\''{ if (((\$ 2 == "T") || (\$ 2 == "D") || (\$ 2 == "B") || (\$ 2 == "W")) && (substr(\$ 3,1,1) != ".")) { if (\$ 2 == "W") { print \$ 3 " weak" } else { print \$ 3 } } }'\'' | sort -u > $export_symbols' + else + export_symbols_cmds_FC='`func_echo_all $NM | $SED -e '\''s/B\([^B]*\)$/P\1/'\''` -PCpgl $libobjs $convenience | awk '\''{ if (((\$ 2 == "T") || (\$ 2 == "D") || (\$ 2 == "B") || (\$ 2 == "W") || (\$ 2 == "V") || (\$ 2 == "Z")) && (substr(\$ 1,1,1) != ".")) { if ((\$ 2 == "W") || (\$ 2 == "V") || (\$ 2 == "Z")) { print \$ 1 " weak" } else { print \$ 1 } } }'\'' | sort -u > $export_symbols' + fi + aix_use_runtimelinking=no + + # Test if we are trying to use run time linking or normal + # AIX style linking. If -brtl is somewhere in LDFLAGS, we + # have runtime linking enabled, and use it for executables. + # For shared libraries, we enable/disable runtime linking + # depending on the kind of the shared library created - + # when "with_aix_soname,aix_use_runtimelinking" is: + # "aix,no" lib.a(lib.so.V) shared, rtl:no, for executables + # "aix,yes" lib.so shared, rtl:yes, for executables + # lib.a static archive + # "both,no" lib.so.V(shr.o) shared, rtl:yes + # lib.a(lib.so.V) shared, rtl:no, for executables + # "both,yes" lib.so.V(shr.o) shared, rtl:yes, for executables + # lib.a(lib.so.V) shared, rtl:no + # "svr4,*" lib.so.V(shr.o) shared, rtl:yes, for executables + # lib.a static archive + case $host_os in aix4.[23]|aix4.[23].*|aix[5-9]*) + for ld_flag in $LDFLAGS; do + if (test x-brtl = "x$ld_flag" || test x-Wl,-brtl = "x$ld_flag"); then + aix_use_runtimelinking=yes + break + fi + done + if test svr4,no = "$with_aix_soname,$aix_use_runtimelinking"; then + # With aix-soname=svr4, we create the lib.so.V shared archives only, + # so we don't have lib.a shared libs to link our executables. + # We have to force runtime linking in this case. + aix_use_runtimelinking=yes + LDFLAGS="$LDFLAGS -Wl,-brtl" + fi + ;; + esac + + exp_sym_flag='-bexport' + no_entry_flag='-bnoentry' + fi + + # When large executables or shared objects are built, AIX ld can + # have problems creating the table of contents. If linking a library + # or program results in "error TOC overflow" add -mminimal-toc to + # CXXFLAGS/CFLAGS for g++/gcc. In the cases where that is not + # enough to fix the problem, add -Wl,-bbigtoc to LDFLAGS. + + archive_cmds_FC='' + hardcode_direct_FC=yes + hardcode_direct_absolute_FC=yes + hardcode_libdir_separator_FC=':' + link_all_deplibs_FC=yes + file_list_spec_FC='$wl-f,' + case $with_aix_soname,$aix_use_runtimelinking in + aix,*) ;; # traditional, no import file + svr4,* | *,yes) # use import file + # The Import File defines what to hardcode. + hardcode_direct_FC=no + hardcode_direct_absolute_FC=no + ;; + esac + + if test yes = "$GCC"; then + case $host_os in aix4.[012]|aix4.[012].*) + # We only want to do this on AIX 4.2 and lower, the check + # below for broken collect2 doesn't work under 4.3+ + collect2name=`$CC -print-prog-name=collect2` + if test -f "$collect2name" && + strings "$collect2name" | $GREP resolve_lib_name >/dev/null + then + # We have reworked collect2 + : + else + # We have old collect2 + hardcode_direct_FC=unsupported + # It fails to find uninstalled libraries when the uninstalled + # path is not listed in the libpath. Setting hardcode_minus_L + # to unsupported forces relinking + hardcode_minus_L_FC=yes + hardcode_libdir_flag_spec_FC='-L$libdir' + hardcode_libdir_separator_FC= + fi + ;; + esac + shared_flag='-shared' + if test yes = "$aix_use_runtimelinking"; then + shared_flag="$shared_flag "'$wl-G' + fi + # Need to ensure runtime linking is disabled for the traditional + # shared library, or the linker may eventually find shared libraries + # /with/ Import File - we do not want to mix them. + shared_flag_aix='-shared' + shared_flag_svr4='-shared $wl-G' + else + # not using gcc + if test ia64 = "$host_cpu"; then + # VisualAge C++, Version 5.5 for AIX 5L for IA-64, Beta 3 Release + # chokes on -Wl,-G. The following line is correct: + shared_flag='-G' + else + if test yes = "$aix_use_runtimelinking"; then + shared_flag='$wl-G' + else + shared_flag='$wl-bM:SRE' + fi + shared_flag_aix='$wl-bM:SRE' + shared_flag_svr4='$wl-G' + fi + fi + + export_dynamic_flag_spec_FC='$wl-bexpall' + # It seems that -bexpall does not export symbols beginning with + # underscore (_), so it is better to generate a list of symbols to export. + always_export_symbols_FC=yes + if test aix,yes = "$with_aix_soname,$aix_use_runtimelinking"; then + # Warning - without using the other runtime loading flags (-brtl), + # -berok will link without error, but may produce a broken library. + allow_undefined_flag_FC='-berok' + # Determine the default libpath from the value encoded in an + # empty executable. + if test set = "${lt_cv_aix_libpath+set}"; then + aix_libpath=$lt_cv_aix_libpath +else + if ${lt_cv_aix_libpath__FC+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat > conftest.$ac_ext <<_ACEOF + program main + + end +_ACEOF +if ac_fn_fc_try_link "$LINENO"; then : + + lt_aix_libpath_sed=' + /Import File Strings/,/^$/ { + /^0/ { + s/^0 *\([^ ]*\) *$/\1/ + p + } + }' + lt_cv_aix_libpath__FC=`dump -H conftest$ac_exeext 2>/dev/null | $SED -n -e "$lt_aix_libpath_sed"` + # Check for a 64-bit object if we didn't find anything. + if test -z "$lt_cv_aix_libpath__FC"; then + lt_cv_aix_libpath__FC=`dump -HX64 conftest$ac_exeext 2>/dev/null | $SED -n -e "$lt_aix_libpath_sed"` + fi +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + if test -z "$lt_cv_aix_libpath__FC"; then + lt_cv_aix_libpath__FC=/usr/lib:/lib + fi + +fi + + aix_libpath=$lt_cv_aix_libpath__FC +fi + + hardcode_libdir_flag_spec_FC='$wl-blibpath:$libdir:'"$aix_libpath" + archive_expsym_cmds_FC='$CC -o $output_objdir/$soname $libobjs $deplibs $wl'$no_entry_flag' $compiler_flags `if test -n "$allow_undefined_flag"; then func_echo_all "$wl$allow_undefined_flag"; else :; fi` $wl'$exp_sym_flag:\$export_symbols' '$shared_flag + else + if test ia64 = "$host_cpu"; then + hardcode_libdir_flag_spec_FC='$wl-R $libdir:/usr/lib:/lib' + allow_undefined_flag_FC="-z nodefs" + archive_expsym_cmds_FC="\$CC $shared_flag"' -o $output_objdir/$soname $libobjs $deplibs '"\$wl$no_entry_flag"' $compiler_flags $wl$allow_undefined_flag '"\$wl$exp_sym_flag:\$export_symbols" + else + # Determine the default libpath from the value encoded in an + # empty executable. + if test set = "${lt_cv_aix_libpath+set}"; then + aix_libpath=$lt_cv_aix_libpath +else + if ${lt_cv_aix_libpath__FC+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat > conftest.$ac_ext <<_ACEOF + program main + + end +_ACEOF +if ac_fn_fc_try_link "$LINENO"; then : + + lt_aix_libpath_sed=' + /Import File Strings/,/^$/ { + /^0/ { + s/^0 *\([^ ]*\) *$/\1/ + p + } + }' + lt_cv_aix_libpath__FC=`dump -H conftest$ac_exeext 2>/dev/null | $SED -n -e "$lt_aix_libpath_sed"` + # Check for a 64-bit object if we didn't find anything. + if test -z "$lt_cv_aix_libpath__FC"; then + lt_cv_aix_libpath__FC=`dump -HX64 conftest$ac_exeext 2>/dev/null | $SED -n -e "$lt_aix_libpath_sed"` + fi +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + if test -z "$lt_cv_aix_libpath__FC"; then + lt_cv_aix_libpath__FC=/usr/lib:/lib + fi + +fi + + aix_libpath=$lt_cv_aix_libpath__FC +fi + + hardcode_libdir_flag_spec_FC='$wl-blibpath:$libdir:'"$aix_libpath" + # Warning - without using the other run time loading flags, + # -berok will link without error, but may produce a broken library. + no_undefined_flag_FC=' $wl-bernotok' + allow_undefined_flag_FC=' $wl-berok' + if test yes = "$with_gnu_ld"; then + # We only use this code for GNU lds that support --whole-archive. + whole_archive_flag_spec_FC='$wl--whole-archive$convenience $wl--no-whole-archive' + else + # Exported symbols can be pulled into shared objects from archives + whole_archive_flag_spec_FC='$convenience' + fi + archive_cmds_need_lc_FC=yes + archive_expsym_cmds_FC='$RM -r $output_objdir/$realname.d~$MKDIR $output_objdir/$realname.d' + # -brtl affects multiple linker settings, -berok does not and is overridden later + compiler_flags_filtered='`func_echo_all "$compiler_flags " | $SED -e "s%-brtl\\([, ]\\)%-berok\\1%g"`' + if test svr4 != "$with_aix_soname"; then + # This is similar to how AIX traditionally builds its shared libraries. + archive_expsym_cmds_FC="$archive_expsym_cmds_FC"'~$CC '$shared_flag_aix' -o $output_objdir/$realname.d/$soname $libobjs $deplibs $wl-bnoentry '$compiler_flags_filtered'$wl-bE:$export_symbols$allow_undefined_flag~$AR $AR_FLAGS $output_objdir/$libname$release.a $output_objdir/$realname.d/$soname' + fi + if test aix != "$with_aix_soname"; then + archive_expsym_cmds_FC="$archive_expsym_cmds_FC"'~$CC '$shared_flag_svr4' -o $output_objdir/$realname.d/$shared_archive_member_spec.o $libobjs $deplibs $wl-bnoentry '$compiler_flags_filtered'$wl-bE:$export_symbols$allow_undefined_flag~$STRIP -e $output_objdir/$realname.d/$shared_archive_member_spec.o~( func_echo_all "#! $soname($shared_archive_member_spec.o)"; if test shr_64 = "$shared_archive_member_spec"; then func_echo_all "# 64"; else func_echo_all "# 32"; fi; cat $export_symbols ) > $output_objdir/$realname.d/$shared_archive_member_spec.imp~$AR $AR_FLAGS $output_objdir/$soname $output_objdir/$realname.d/$shared_archive_member_spec.o $output_objdir/$realname.d/$shared_archive_member_spec.imp' + else + # used by -dlpreopen to get the symbols + archive_expsym_cmds_FC="$archive_expsym_cmds_FC"'~$MV $output_objdir/$realname.d/$soname $output_objdir' + fi + archive_expsym_cmds_FC="$archive_expsym_cmds_FC"'~$RM -r $output_objdir/$realname.d' + fi + fi + ;; + + amigaos*) + case $host_cpu in + powerpc) + # see comment about AmigaOS4 .so support + archive_cmds_FC='$CC -shared $libobjs $deplibs $compiler_flags $wl-soname $wl$soname -o $lib' + archive_expsym_cmds_FC='' + ;; + m68k) + archive_cmds_FC='$RM $output_objdir/a2ixlibrary.data~$ECHO "#define NAME $libname" > $output_objdir/a2ixlibrary.data~$ECHO "#define LIBRARY_ID 1" >> $output_objdir/a2ixlibrary.data~$ECHO "#define VERSION $major" >> $output_objdir/a2ixlibrary.data~$ECHO "#define REVISION $revision" >> $output_objdir/a2ixlibrary.data~$AR $AR_FLAGS $lib $libobjs~$RANLIB $lib~(cd $output_objdir && a2ixlibrary -32)' + hardcode_libdir_flag_spec_FC='-L$libdir' + hardcode_minus_L_FC=yes + ;; + esac + ;; + + bsdi[45]*) + export_dynamic_flag_spec_FC=-rdynamic + ;; + + cygwin* | mingw* | pw32* | cegcc*) + # When not using gcc, we currently assume that we are using + # Microsoft Visual C++. + # hardcode_libdir_flag_spec is actually meaningless, as there is + # no search path for DLLs. + case $cc_basename in + cl*) + # Native MSVC + hardcode_libdir_flag_spec_FC=' ' + allow_undefined_flag_FC=unsupported + always_export_symbols_FC=yes + file_list_spec_FC='@' + # Tell ltmain to make .lib files, not .a files. + libext=lib + # Tell ltmain to make .dll files, not .so files. + shrext_cmds=.dll + # FIXME: Setting linknames here is a bad hack. + archive_cmds_FC='$CC -o $output_objdir/$soname $libobjs $compiler_flags $deplibs -Wl,-DLL,-IMPLIB:"$tool_output_objdir$libname.dll.lib"~linknames=' + archive_expsym_cmds_FC='if test DEF = "`$SED -n -e '\''s/^[ ]*//'\'' -e '\''/^\(;.*\)*$/d'\'' -e '\''s/^\(EXPORTS\|LIBRARY\)\([ ].*\)*$/DEF/p'\'' -e q $export_symbols`" ; then + cp "$export_symbols" "$output_objdir/$soname.def"; + echo "$tool_output_objdir$soname.def" > "$output_objdir/$soname.exp"; + else + $SED -e '\''s/^/-link -EXPORT:/'\'' < $export_symbols > $output_objdir/$soname.exp; + fi~ + $CC -o $tool_output_objdir$soname $libobjs $compiler_flags $deplibs "@$tool_output_objdir$soname.exp" -Wl,-DLL,-IMPLIB:"$tool_output_objdir$libname.dll.lib"~ + linknames=' + # The linker will not automatically build a static lib if we build a DLL. + # _LT_TAGVAR(old_archive_from_new_cmds, FC)='true' + enable_shared_with_static_runtimes_FC=yes + exclude_expsyms_FC='_NULL_IMPORT_DESCRIPTOR|_IMPORT_DESCRIPTOR_.*' + export_symbols_cmds_FC='$NM $libobjs $convenience | $global_symbol_pipe | $SED -e '\''/^[BCDGRS][ ]/s/.*[ ]\([^ ]*\)/\1,DATA/'\'' | $SED -e '\''/^[AITW][ ]/s/.*[ ]//'\'' | sort | uniq > $export_symbols' + # Don't use ranlib + old_postinstall_cmds_FC='chmod 644 $oldlib' + postlink_cmds_FC='lt_outputfile="@OUTPUT@"~ + lt_tool_outputfile="@TOOL_OUTPUT@"~ + case $lt_outputfile in + *.exe|*.EXE) ;; + *) + lt_outputfile=$lt_outputfile.exe + lt_tool_outputfile=$lt_tool_outputfile.exe + ;; + esac~ + if test : != "$MANIFEST_TOOL" && test -f "$lt_outputfile.manifest"; then + $MANIFEST_TOOL -manifest "$lt_tool_outputfile.manifest" -outputresource:"$lt_tool_outputfile" || exit 1; + $RM "$lt_outputfile.manifest"; + fi' + ;; + *) + # Assume MSVC wrapper + hardcode_libdir_flag_spec_FC=' ' + allow_undefined_flag_FC=unsupported + # Tell ltmain to make .lib files, not .a files. + libext=lib + # Tell ltmain to make .dll files, not .so files. + shrext_cmds=.dll + # FIXME: Setting linknames here is a bad hack. + archive_cmds_FC='$CC -o $lib $libobjs $compiler_flags `func_echo_all "$deplibs" | $SED '\''s/ -lc$//'\''` -link -dll~linknames=' + # The linker will automatically build a .lib file if we build a DLL. + old_archive_from_new_cmds_FC='true' + # FIXME: Should let the user specify the lib program. + old_archive_cmds_FC='lib -OUT:$oldlib$oldobjs$old_deplibs' + enable_shared_with_static_runtimes_FC=yes + ;; + esac + ;; + + darwin* | rhapsody*) + + + archive_cmds_need_lc_FC=no + hardcode_direct_FC=no + hardcode_automatic_FC=yes + hardcode_shlibpath_var_FC=unsupported + if test yes = "$lt_cv_ld_force_load"; then + whole_archive_flag_spec_FC='`for conv in $convenience\"\"; do test -n \"$conv\" && new_convenience=\"$new_convenience $wl-force_load,$conv\"; done; func_echo_all \"$new_convenience\"`' + compiler_needs_object_FC=yes + else + whole_archive_flag_spec_FC='' + fi + link_all_deplibs_FC=yes + allow_undefined_flag_FC=$_lt_dar_allow_undefined + case $cc_basename in + ifort*|nagfor*) _lt_dar_can_shared=yes ;; + *) _lt_dar_can_shared=$GCC ;; + esac + if test yes = "$_lt_dar_can_shared"; then + output_verbose_link_cmd=func_echo_all + archive_cmds_FC="\$CC -dynamiclib \$allow_undefined_flag -o \$lib \$libobjs \$deplibs \$compiler_flags -install_name \$rpath/\$soname \$verstring $_lt_dar_single_mod$_lt_dsymutil" + module_cmds_FC="\$CC \$allow_undefined_flag -o \$lib -bundle \$libobjs \$deplibs \$compiler_flags$_lt_dsymutil" + archive_expsym_cmds_FC="sed 's|^|_|' < \$export_symbols > \$output_objdir/\$libname-symbols.expsym~\$CC -dynamiclib \$allow_undefined_flag -o \$lib \$libobjs \$deplibs \$compiler_flags -install_name \$rpath/\$soname \$verstring $_lt_dar_single_mod$_lt_dar_export_syms$_lt_dsymutil" + module_expsym_cmds_FC="sed -e 's|^|_|' < \$export_symbols > \$output_objdir/\$libname-symbols.expsym~\$CC \$allow_undefined_flag -o \$lib -bundle \$libobjs \$deplibs \$compiler_flags$_lt_dar_export_syms$_lt_dsymutil" + + else + ld_shlibs_FC=no + fi + + ;; + + dgux*) + archive_cmds_FC='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags' + hardcode_libdir_flag_spec_FC='-L$libdir' + hardcode_shlibpath_var_FC=no + ;; + + # FreeBSD 2.2.[012] allows us to include c++rt0.o to get C++ constructor + # support. Future versions do this automatically, but an explicit c++rt0.o + # does not break anything, and helps significantly (at the cost of a little + # extra space). + freebsd2.2*) + archive_cmds_FC='$LD -Bshareable -o $lib $libobjs $deplibs $linker_flags /usr/lib/c++rt0.o' + hardcode_libdir_flag_spec_FC='-R$libdir' + hardcode_direct_FC=yes + hardcode_shlibpath_var_FC=no + ;; + + # Unfortunately, older versions of FreeBSD 2 do not have this feature. + freebsd2.*) + archive_cmds_FC='$LD -Bshareable -o $lib $libobjs $deplibs $linker_flags' + hardcode_direct_FC=yes + hardcode_minus_L_FC=yes + hardcode_shlibpath_var_FC=no + ;; + + # FreeBSD 3 and greater uses gcc -shared to do shared libraries. + freebsd* | dragonfly*) + archive_cmds_FC='$CC -shared $pic_flag -o $lib $libobjs $deplibs $compiler_flags' + hardcode_libdir_flag_spec_FC='-R$libdir' + hardcode_direct_FC=yes + hardcode_shlibpath_var_FC=no + ;; + + hpux9*) + if test yes = "$GCC"; then + archive_cmds_FC='$RM $output_objdir/$soname~$CC -shared $pic_flag $wl+b $wl$install_libdir -o $output_objdir/$soname $libobjs $deplibs $compiler_flags~test "x$output_objdir/$soname" = "x$lib" || mv $output_objdir/$soname $lib' + else + archive_cmds_FC='$RM $output_objdir/$soname~$LD -b +b $install_libdir -o $output_objdir/$soname $libobjs $deplibs $linker_flags~test "x$output_objdir/$soname" = "x$lib" || mv $output_objdir/$soname $lib' + fi + hardcode_libdir_flag_spec_FC='$wl+b $wl$libdir' + hardcode_libdir_separator_FC=: + hardcode_direct_FC=yes + + # hardcode_minus_L: Not really in the search PATH, + # but as the default location of the library. + hardcode_minus_L_FC=yes + export_dynamic_flag_spec_FC='$wl-E' + ;; + + hpux10*) + if test yes,no = "$GCC,$with_gnu_ld"; then + archive_cmds_FC='$CC -shared $pic_flag $wl+h $wl$soname $wl+b $wl$install_libdir -o $lib $libobjs $deplibs $compiler_flags' + else + archive_cmds_FC='$LD -b +h $soname +b $install_libdir -o $lib $libobjs $deplibs $linker_flags' + fi + if test no = "$with_gnu_ld"; then + hardcode_libdir_flag_spec_FC='$wl+b $wl$libdir' + hardcode_libdir_separator_FC=: + hardcode_direct_FC=yes + hardcode_direct_absolute_FC=yes + export_dynamic_flag_spec_FC='$wl-E' + # hardcode_minus_L: Not really in the search PATH, + # but as the default location of the library. + hardcode_minus_L_FC=yes + fi + ;; + + hpux11*) + if test yes,no = "$GCC,$with_gnu_ld"; then + case $host_cpu in + hppa*64*) + archive_cmds_FC='$CC -shared $wl+h $wl$soname -o $lib $libobjs $deplibs $compiler_flags' + ;; + ia64*) + archive_cmds_FC='$CC -shared $pic_flag $wl+h $wl$soname $wl+nodefaultrpath -o $lib $libobjs $deplibs $compiler_flags' + ;; + *) + archive_cmds_FC='$CC -shared $pic_flag $wl+h $wl$soname $wl+b $wl$install_libdir -o $lib $libobjs $deplibs $compiler_flags' + ;; + esac + else + case $host_cpu in + hppa*64*) + archive_cmds_FC='$CC -b $wl+h $wl$soname -o $lib $libobjs $deplibs $compiler_flags' + ;; + ia64*) + archive_cmds_FC='$CC -b $wl+h $wl$soname $wl+nodefaultrpath -o $lib $libobjs $deplibs $compiler_flags' + ;; + *) + archive_cmds_FC='$CC -b $wl+h $wl$soname $wl+b $wl$install_libdir -o $lib $libobjs $deplibs $compiler_flags' + ;; + esac + fi + if test no = "$with_gnu_ld"; then + hardcode_libdir_flag_spec_FC='$wl+b $wl$libdir' + hardcode_libdir_separator_FC=: + + case $host_cpu in + hppa*64*|ia64*) + hardcode_direct_FC=no + hardcode_shlibpath_var_FC=no + ;; + *) + hardcode_direct_FC=yes + hardcode_direct_absolute_FC=yes + export_dynamic_flag_spec_FC='$wl-E' + + # hardcode_minus_L: Not really in the search PATH, + # but as the default location of the library. + hardcode_minus_L_FC=yes + ;; + esac + fi + ;; + + irix5* | irix6* | nonstopux*) + if test yes = "$GCC"; then + archive_cmds_FC='$CC -shared $pic_flag $libobjs $deplibs $compiler_flags $wl-soname $wl$soname `test -n "$verstring" && func_echo_all "$wl-set_version $wl$verstring"` $wl-update_registry $wl$output_objdir/so_locations -o $lib' + # Try to use the -exported_symbol ld option, if it does not + # work, assume that -exports_file does not work either and + # implicitly export all symbols. + # This should be the same for all languages, so no per-tag cache variable. + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether the $host_os linker accepts -exported_symbol" >&5 +$as_echo_n "checking whether the $host_os linker accepts -exported_symbol... " >&6; } +if ${lt_cv_irix_exported_symbol+:} false; then : + $as_echo_n "(cached) " >&6 +else + save_LDFLAGS=$LDFLAGS + LDFLAGS="$LDFLAGS -shared $wl-exported_symbol ${wl}foo $wl-update_registry $wl/dev/null" + cat > conftest.$ac_ext <<_ACEOF + + subroutine foo + end +_ACEOF +if ac_fn_fc_try_link "$LINENO"; then : + lt_cv_irix_exported_symbol=yes +else + lt_cv_irix_exported_symbol=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + LDFLAGS=$save_LDFLAGS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_irix_exported_symbol" >&5 +$as_echo "$lt_cv_irix_exported_symbol" >&6; } + if test yes = "$lt_cv_irix_exported_symbol"; then + archive_expsym_cmds_FC='$CC -shared $pic_flag $libobjs $deplibs $compiler_flags $wl-soname $wl$soname `test -n "$verstring" && func_echo_all "$wl-set_version $wl$verstring"` $wl-update_registry $wl$output_objdir/so_locations $wl-exports_file $wl$export_symbols -o $lib' + fi + else + archive_cmds_FC='$CC -shared $libobjs $deplibs $compiler_flags -soname $soname `test -n "$verstring" && func_echo_all "-set_version $verstring"` -update_registry $output_objdir/so_locations -o $lib' + archive_expsym_cmds_FC='$CC -shared $libobjs $deplibs $compiler_flags -soname $soname `test -n "$verstring" && func_echo_all "-set_version $verstring"` -update_registry $output_objdir/so_locations -exports_file $export_symbols -o $lib' + fi + archive_cmds_need_lc_FC='no' + hardcode_libdir_flag_spec_FC='$wl-rpath $wl$libdir' + hardcode_libdir_separator_FC=: + inherit_rpath_FC=yes + link_all_deplibs_FC=yes + ;; + + linux*) + case $cc_basename in + tcc*) + # Fabrice Bellard et al's Tiny C Compiler + ld_shlibs_FC=yes + archive_cmds_FC='$CC -shared $pic_flag -o $lib $libobjs $deplibs $compiler_flags' + ;; + esac + ;; + + netbsd*) + if echo __ELF__ | $CC -E - | $GREP __ELF__ >/dev/null; then + archive_cmds_FC='$LD -Bshareable -o $lib $libobjs $deplibs $linker_flags' # a.out + else + archive_cmds_FC='$LD -shared -o $lib $libobjs $deplibs $linker_flags' # ELF + fi + hardcode_libdir_flag_spec_FC='-R$libdir' + hardcode_direct_FC=yes + hardcode_shlibpath_var_FC=no + ;; + + newsos6) + archive_cmds_FC='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags' + hardcode_direct_FC=yes + hardcode_libdir_flag_spec_FC='$wl-rpath $wl$libdir' + hardcode_libdir_separator_FC=: + hardcode_shlibpath_var_FC=no + ;; + + *nto* | *qnx*) + ;; + + openbsd* | bitrig*) + if test -f /usr/libexec/ld.so; then + hardcode_direct_FC=yes + hardcode_shlibpath_var_FC=no + hardcode_direct_absolute_FC=yes + if test -z "`echo __ELF__ | $CC -E - | $GREP __ELF__`"; then + archive_cmds_FC='$CC -shared $pic_flag -o $lib $libobjs $deplibs $compiler_flags' + archive_expsym_cmds_FC='$CC -shared $pic_flag -o $lib $libobjs $deplibs $compiler_flags $wl-retain-symbols-file,$export_symbols' + hardcode_libdir_flag_spec_FC='$wl-rpath,$libdir' + export_dynamic_flag_spec_FC='$wl-E' + else + archive_cmds_FC='$CC -shared $pic_flag -o $lib $libobjs $deplibs $compiler_flags' + hardcode_libdir_flag_spec_FC='$wl-rpath,$libdir' + fi + else + ld_shlibs_FC=no + fi + ;; + + os2*) + hardcode_libdir_flag_spec_FC='-L$libdir' + hardcode_minus_L_FC=yes + allow_undefined_flag_FC=unsupported + shrext_cmds=.dll + archive_cmds_FC='$ECHO "LIBRARY ${soname%$shared_ext} INITINSTANCE TERMINSTANCE" > $output_objdir/$libname.def~ + $ECHO "DESCRIPTION \"$libname\"" >> $output_objdir/$libname.def~ + $ECHO "DATA MULTIPLE NONSHARED" >> $output_objdir/$libname.def~ + $ECHO EXPORTS >> $output_objdir/$libname.def~ + emxexp $libobjs | $SED /"_DLL_InitTerm"/d >> $output_objdir/$libname.def~ + $CC -Zdll -Zcrtdll -o $output_objdir/$soname $libobjs $deplibs $compiler_flags $output_objdir/$libname.def~ + emximp -o $lib $output_objdir/$libname.def' + archive_expsym_cmds_FC='$ECHO "LIBRARY ${soname%$shared_ext} INITINSTANCE TERMINSTANCE" > $output_objdir/$libname.def~ + $ECHO "DESCRIPTION \"$libname\"" >> $output_objdir/$libname.def~ + $ECHO "DATA MULTIPLE NONSHARED" >> $output_objdir/$libname.def~ + $ECHO EXPORTS >> $output_objdir/$libname.def~ + prefix_cmds="$SED"~ + if test EXPORTS = "`$SED 1q $export_symbols`"; then + prefix_cmds="$prefix_cmds -e 1d"; + fi~ + prefix_cmds="$prefix_cmds -e \"s/^\(.*\)$/_\1/g\""~ + cat $export_symbols | $prefix_cmds >> $output_objdir/$libname.def~ + $CC -Zdll -Zcrtdll -o $output_objdir/$soname $libobjs $deplibs $compiler_flags $output_objdir/$libname.def~ + emximp -o $lib $output_objdir/$libname.def' + old_archive_From_new_cmds_FC='emximp -o $output_objdir/${libname}_dll.a $output_objdir/$libname.def' + enable_shared_with_static_runtimes_FC=yes + ;; + + osf3*) + if test yes = "$GCC"; then + allow_undefined_flag_FC=' $wl-expect_unresolved $wl\*' + archive_cmds_FC='$CC -shared$allow_undefined_flag $libobjs $deplibs $compiler_flags $wl-soname $wl$soname `test -n "$verstring" && func_echo_all "$wl-set_version $wl$verstring"` $wl-update_registry $wl$output_objdir/so_locations -o $lib' + else + allow_undefined_flag_FC=' -expect_unresolved \*' + archive_cmds_FC='$CC -shared$allow_undefined_flag $libobjs $deplibs $compiler_flags -soname $soname `test -n "$verstring" && func_echo_all "-set_version $verstring"` -update_registry $output_objdir/so_locations -o $lib' + fi + archive_cmds_need_lc_FC='no' + hardcode_libdir_flag_spec_FC='$wl-rpath $wl$libdir' + hardcode_libdir_separator_FC=: + ;; + + osf4* | osf5*) # as osf3* with the addition of -msym flag + if test yes = "$GCC"; then + allow_undefined_flag_FC=' $wl-expect_unresolved $wl\*' + archive_cmds_FC='$CC -shared$allow_undefined_flag $pic_flag $libobjs $deplibs $compiler_flags $wl-msym $wl-soname $wl$soname `test -n "$verstring" && func_echo_all "$wl-set_version $wl$verstring"` $wl-update_registry $wl$output_objdir/so_locations -o $lib' + hardcode_libdir_flag_spec_FC='$wl-rpath $wl$libdir' + else + allow_undefined_flag_FC=' -expect_unresolved \*' + archive_cmds_FC='$CC -shared$allow_undefined_flag $libobjs $deplibs $compiler_flags -msym -soname $soname `test -n "$verstring" && func_echo_all "-set_version $verstring"` -update_registry $output_objdir/so_locations -o $lib' + archive_expsym_cmds_FC='for i in `cat $export_symbols`; do printf "%s %s\\n" -exported_symbol "\$i" >> $lib.exp; done; printf "%s\\n" "-hidden">> $lib.exp~ + $CC -shared$allow_undefined_flag $wl-input $wl$lib.exp $compiler_flags $libobjs $deplibs -soname $soname `test -n "$verstring" && $ECHO "-set_version $verstring"` -update_registry $output_objdir/so_locations -o $lib~$RM $lib.exp' + + # Both c and cxx compiler support -rpath directly + hardcode_libdir_flag_spec_FC='-rpath $libdir' + fi + archive_cmds_need_lc_FC='no' + hardcode_libdir_separator_FC=: + ;; + + solaris*) + no_undefined_flag_FC=' -z defs' + if test yes = "$GCC"; then + wlarc='$wl' + archive_cmds_FC='$CC -shared $pic_flag $wl-z ${wl}text $wl-h $wl$soname -o $lib $libobjs $deplibs $compiler_flags' + archive_expsym_cmds_FC='echo "{ global:" > $lib.exp~cat $export_symbols | $SED -e "s/\(.*\)/\1;/" >> $lib.exp~echo "local: *; };" >> $lib.exp~ + $CC -shared $pic_flag $wl-z ${wl}text $wl-M $wl$lib.exp $wl-h $wl$soname -o $lib $libobjs $deplibs $compiler_flags~$RM $lib.exp' + else + case `$CC -V 2>&1` in + *"Compilers 5.0"*) + wlarc='' + archive_cmds_FC='$LD -G$allow_undefined_flag -h $soname -o $lib $libobjs $deplibs $linker_flags' + archive_expsym_cmds_FC='echo "{ global:" > $lib.exp~cat $export_symbols | $SED -e "s/\(.*\)/\1;/" >> $lib.exp~echo "local: *; };" >> $lib.exp~ + $LD -G$allow_undefined_flag -M $lib.exp -h $soname -o $lib $libobjs $deplibs $linker_flags~$RM $lib.exp' + ;; + *) + wlarc='$wl' + archive_cmds_FC='$CC -G$allow_undefined_flag -h $soname -o $lib $libobjs $deplibs $compiler_flags' + archive_expsym_cmds_FC='echo "{ global:" > $lib.exp~cat $export_symbols | $SED -e "s/\(.*\)/\1;/" >> $lib.exp~echo "local: *; };" >> $lib.exp~ + $CC -G$allow_undefined_flag -M $lib.exp -h $soname -o $lib $libobjs $deplibs $compiler_flags~$RM $lib.exp' + ;; + esac + fi + hardcode_libdir_flag_spec_FC='-R$libdir' + hardcode_shlibpath_var_FC=no + case $host_os in + solaris2.[0-5] | solaris2.[0-5].*) ;; + *) + # The compiler driver will combine and reorder linker options, + # but understands '-z linker_flag'. GCC discards it without '$wl', + # but is careful enough not to reorder. + # Supported since Solaris 2.6 (maybe 2.5.1?) + if test yes = "$GCC"; then + whole_archive_flag_spec_FC='$wl-z ${wl}allextract$convenience $wl-z ${wl}defaultextract' + else + whole_archive_flag_spec_FC='-z allextract$convenience -z defaultextract' + fi + ;; + esac + link_all_deplibs_FC=yes + ;; + + sunos4*) + if test sequent = "$host_vendor"; then + # Use $CC to link under sequent, because it throws in some extra .o + # files that make .init and .fini sections work. + archive_cmds_FC='$CC -G $wl-h $soname -o $lib $libobjs $deplibs $compiler_flags' + else + archive_cmds_FC='$LD -assert pure-text -Bstatic -o $lib $libobjs $deplibs $linker_flags' + fi + hardcode_libdir_flag_spec_FC='-L$libdir' + hardcode_direct_FC=yes + hardcode_minus_L_FC=yes + hardcode_shlibpath_var_FC=no + ;; + + sysv4) + case $host_vendor in + sni) + archive_cmds_FC='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags' + hardcode_direct_FC=yes # is this really true??? + ;; + siemens) + ## LD is ld it makes a PLAMLIB + ## CC just makes a GrossModule. + archive_cmds_FC='$LD -G -o $lib $libobjs $deplibs $linker_flags' + reload_cmds_FC='$CC -r -o $output$reload_objs' + hardcode_direct_FC=no + ;; + motorola) + archive_cmds_FC='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags' + hardcode_direct_FC=no #Motorola manual says yes, but my tests say they lie + ;; + esac + runpath_var='LD_RUN_PATH' + hardcode_shlibpath_var_FC=no + ;; + + sysv4.3*) + archive_cmds_FC='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags' + hardcode_shlibpath_var_FC=no + export_dynamic_flag_spec_FC='-Bexport' + ;; + + sysv4*MP*) + if test -d /usr/nec; then + archive_cmds_FC='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags' + hardcode_shlibpath_var_FC=no + runpath_var=LD_RUN_PATH + hardcode_runpath_var=yes + ld_shlibs_FC=yes + fi + ;; + + sysv4*uw2* | sysv5OpenUNIX* | sysv5UnixWare7.[01].[10]* | unixware7* | sco3.2v5.0.[024]*) + no_undefined_flag_FC='$wl-z,text' + archive_cmds_need_lc_FC=no + hardcode_shlibpath_var_FC=no + runpath_var='LD_RUN_PATH' + + if test yes = "$GCC"; then + archive_cmds_FC='$CC -shared $wl-h,$soname -o $lib $libobjs $deplibs $compiler_flags' + archive_expsym_cmds_FC='$CC -shared $wl-Bexport:$export_symbols $wl-h,$soname -o $lib $libobjs $deplibs $compiler_flags' + else + archive_cmds_FC='$CC -G $wl-h,$soname -o $lib $libobjs $deplibs $compiler_flags' + archive_expsym_cmds_FC='$CC -G $wl-Bexport:$export_symbols $wl-h,$soname -o $lib $libobjs $deplibs $compiler_flags' + fi + ;; + + sysv5* | sco3.2v5* | sco5v6*) + # Note: We CANNOT use -z defs as we might desire, because we do not + # link with -lc, and that would cause any symbols used from libc to + # always be unresolved, which means just about no library would + # ever link correctly. If we're not using GNU ld we use -z text + # though, which does catch some bad symbols but isn't as heavy-handed + # as -z defs. + no_undefined_flag_FC='$wl-z,text' + allow_undefined_flag_FC='$wl-z,nodefs' + archive_cmds_need_lc_FC=no + hardcode_shlibpath_var_FC=no + hardcode_libdir_flag_spec_FC='$wl-R,$libdir' + hardcode_libdir_separator_FC=':' + link_all_deplibs_FC=yes + export_dynamic_flag_spec_FC='$wl-Bexport' + runpath_var='LD_RUN_PATH' + + if test yes = "$GCC"; then + archive_cmds_FC='$CC -shared $wl-h,$soname -o $lib $libobjs $deplibs $compiler_flags' + archive_expsym_cmds_FC='$CC -shared $wl-Bexport:$export_symbols $wl-h,$soname -o $lib $libobjs $deplibs $compiler_flags' + else + archive_cmds_FC='$CC -G $wl-h,$soname -o $lib $libobjs $deplibs $compiler_flags' + archive_expsym_cmds_FC='$CC -G $wl-Bexport:$export_symbols $wl-h,$soname -o $lib $libobjs $deplibs $compiler_flags' + fi + ;; + + uts4*) + archive_cmds_FC='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags' + hardcode_libdir_flag_spec_FC='-L$libdir' + hardcode_shlibpath_var_FC=no + ;; + + *) + ld_shlibs_FC=no + ;; + esac + + if test sni = "$host_vendor"; then + case $host in + sysv4 | sysv4.2uw2* | sysv4.3* | sysv5*) + export_dynamic_flag_spec_FC='$wl-Blargedynsym' + ;; + esac + fi + fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ld_shlibs_FC" >&5 +$as_echo "$ld_shlibs_FC" >&6; } +test no = "$ld_shlibs_FC" && can_build_shared=no + +with_gnu_ld_FC=$with_gnu_ld + + + + + + +# +# Do we need to explicitly link libc? +# +case "x$archive_cmds_need_lc_FC" in +x|xyes) + # Assume -lc should be added + archive_cmds_need_lc_FC=yes + + if test yes,yes = "$GCC,$enable_shared"; then + case $archive_cmds_FC in + *'~'*) + # FIXME: we may have to deal with multi-command sequences. + ;; + '$CC '*) + # Test whether the compiler implicitly links with -lc since on some + # systems, -lgcc has to come before -lc. If gcc already passes -lc + # to ld, don't add -lc before -lgcc. + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether -lc should be explicitly linked in" >&5 +$as_echo_n "checking whether -lc should be explicitly linked in... " >&6; } +if ${lt_cv_archive_cmds_need_lc_FC+:} false; then : + $as_echo_n "(cached) " >&6 +else + $RM conftest* + echo "$lt_simple_compile_test_code" > conftest.$ac_ext + + if { { eval echo "\"\$as_me\":${as_lineno-$LINENO}: \"$ac_compile\""; } >&5 + (eval $ac_compile) 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } 2>conftest.err; then + soname=conftest + lib=conftest + libobjs=conftest.$ac_objext + deplibs= + wl=$lt_prog_compiler_wl_FC + pic_flag=$lt_prog_compiler_pic_FC + compiler_flags=-v + linker_flags=-v + verstring= + output_objdir=. + libname=conftest + lt_save_allow_undefined_flag=$allow_undefined_flag_FC + allow_undefined_flag_FC= + if { { eval echo "\"\$as_me\":${as_lineno-$LINENO}: \"$archive_cmds_FC 2\>\&1 \| $GREP \" -lc \" \>/dev/null 2\>\&1\""; } >&5 + (eval $archive_cmds_FC 2\>\&1 \| $GREP \" -lc \" \>/dev/null 2\>\&1) 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } + then + lt_cv_archive_cmds_need_lc_FC=no + else + lt_cv_archive_cmds_need_lc_FC=yes + fi + allow_undefined_flag_FC=$lt_save_allow_undefined_flag + else + cat conftest.err 1>&5 + fi + $RM conftest* + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_archive_cmds_need_lc_FC" >&5 +$as_echo "$lt_cv_archive_cmds_need_lc_FC" >&6; } + archive_cmds_need_lc_FC=$lt_cv_archive_cmds_need_lc_FC + ;; + esac + fi + ;; +esac + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking dynamic linker characteristics" >&5 +$as_echo_n "checking dynamic linker characteristics... " >&6; } + +library_names_spec= +libname_spec='lib$name' +soname_spec= +shrext_cmds=.so +postinstall_cmds= +postuninstall_cmds= +finish_cmds= +finish_eval= +shlibpath_var= +shlibpath_overrides_runpath=unknown +version_type=none +dynamic_linker="$host_os ld.so" +sys_lib_dlsearch_path_spec="/lib /usr/lib" +need_lib_prefix=unknown +hardcode_into_libs=no + +# when you set need_version to no, make sure it does not cause -set_version +# flags to be left without arguments +need_version=unknown + + + +case $host_os in +aix3*) + version_type=linux # correct to gnu/linux during the next big refactor + library_names_spec='$libname$release$shared_ext$versuffix $libname.a' + shlibpath_var=LIBPATH + + # AIX 3 has no versioning support, so we append a major version to the name. + soname_spec='$libname$release$shared_ext$major' + ;; + +aix[4-9]*) + version_type=linux # correct to gnu/linux during the next big refactor + need_lib_prefix=no + need_version=no + hardcode_into_libs=yes + if test ia64 = "$host_cpu"; then + # AIX 5 supports IA64 + library_names_spec='$libname$release$shared_ext$major $libname$release$shared_ext$versuffix $libname$shared_ext' + shlibpath_var=LD_LIBRARY_PATH + else + # With GCC up to 2.95.x, collect2 would create an import file + # for dependence libraries. The import file would start with + # the line '#! .'. This would cause the generated library to + # depend on '.', always an invalid library. This was fixed in + # development snapshots of GCC prior to 3.0. + case $host_os in + aix4 | aix4.[01] | aix4.[01].*) + if { echo '#if __GNUC__ > 2 || (__GNUC__ == 2 && __GNUC_MINOR__ >= 97)' + echo ' yes ' + echo '#endif'; } | $CC -E - | $GREP yes > /dev/null; then + : + else + can_build_shared=no + fi + ;; + esac + # Using Import Files as archive members, it is possible to support + # filename-based versioning of shared library archives on AIX. While + # this would work for both with and without runtime linking, it will + # prevent static linking of such archives. So we do filename-based + # shared library versioning with .so extension only, which is used + # when both runtime linking and shared linking is enabled. + # Unfortunately, runtime linking may impact performance, so we do + # not want this to be the default eventually. Also, we use the + # versioned .so libs for executables only if there is the -brtl + # linker flag in LDFLAGS as well, or --with-aix-soname=svr4 only. + # To allow for filename-based versioning support, we need to create + # libNAME.so.V as an archive file, containing: + # *) an Import File, referring to the versioned filename of the + # archive as well as the shared archive member, telling the + # bitwidth (32 or 64) of that shared object, and providing the + # list of exported symbols of that shared object, eventually + # decorated with the 'weak' keyword + # *) the shared object with the F_LOADONLY flag set, to really avoid + # it being seen by the linker. + # At run time we better use the real file rather than another symlink, + # but for link time we create the symlink libNAME.so -> libNAME.so.V + + case $with_aix_soname,$aix_use_runtimelinking in + # AIX (on Power*) has no versioning support, so currently we cannot hardcode correct + # soname into executable. Probably we can add versioning support to + # collect2, so additional links can be useful in future. + aix,yes) # traditional libtool + dynamic_linker='AIX unversionable lib.so' + # If using run time linking (on AIX 4.2 or later) use lib<name>.so + # instead of lib<name>.a to let people know that these are not + # typical AIX shared libraries. + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' + ;; + aix,no) # traditional AIX only + dynamic_linker='AIX lib.a(lib.so.V)' + # We preserve .a as extension for shared libraries through AIX4.2 + # and later when we are not doing run time linking. + library_names_spec='$libname$release.a $libname.a' + soname_spec='$libname$release$shared_ext$major' + ;; + svr4,*) # full svr4 only + dynamic_linker="AIX lib.so.V($shared_archive_member_spec.o)" + library_names_spec='$libname$release$shared_ext$major $libname$shared_ext' + # We do not specify a path in Import Files, so LIBPATH fires. + shlibpath_overrides_runpath=yes + ;; + *,yes) # both, prefer svr4 + dynamic_linker="AIX lib.so.V($shared_archive_member_spec.o), lib.a(lib.so.V)" + library_names_spec='$libname$release$shared_ext$major $libname$shared_ext' + # unpreferred sharedlib libNAME.a needs extra handling + postinstall_cmds='test -n "$linkname" || linkname="$realname"~func_stripname "" ".so" "$linkname"~$install_shared_prog "$dir/$func_stripname_result.$libext" "$destdir/$func_stripname_result.$libext"~test -z "$tstripme" || test -z "$striplib" || $striplib "$destdir/$func_stripname_result.$libext"' + postuninstall_cmds='for n in $library_names $old_library; do :; done~func_stripname "" ".so" "$n"~test "$func_stripname_result" = "$n" || func_append rmfiles " $odir/$func_stripname_result.$libext"' + # We do not specify a path in Import Files, so LIBPATH fires. + shlibpath_overrides_runpath=yes + ;; + *,no) # both, prefer aix + dynamic_linker="AIX lib.a(lib.so.V), lib.so.V($shared_archive_member_spec.o)" + library_names_spec='$libname$release.a $libname.a' + soname_spec='$libname$release$shared_ext$major' + # unpreferred sharedlib libNAME.so.V and symlink libNAME.so need extra handling + postinstall_cmds='test -z "$dlname" || $install_shared_prog $dir/$dlname $destdir/$dlname~test -z "$tstripme" || test -z "$striplib" || $striplib $destdir/$dlname~test -n "$linkname" || linkname=$realname~func_stripname "" ".a" "$linkname"~(cd "$destdir" && $LN_S -f $dlname $func_stripname_result.so)' + postuninstall_cmds='test -z "$dlname" || func_append rmfiles " $odir/$dlname"~for n in $old_library $library_names; do :; done~func_stripname "" ".a" "$n"~func_append rmfiles " $odir/$func_stripname_result.so"' + ;; + esac + shlibpath_var=LIBPATH + fi + ;; + +amigaos*) + case $host_cpu in + powerpc) + # Since July 2007 AmigaOS4 officially supports .so libraries. + # When compiling the executable, add -use-dynld -Lsobjs: to the compileline. + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' + ;; + m68k) + library_names_spec='$libname.ixlibrary $libname.a' + # Create ${libname}_ixlibrary.a entries in /sys/libs. + finish_eval='for lib in `ls $libdir/*.ixlibrary 2>/dev/null`; do libname=`func_echo_all "$lib" | $SED '\''s%^.*/\([^/]*\)\.ixlibrary$%\1%'\''`; $RM /sys/libs/${libname}_ixlibrary.a; $show "cd /sys/libs && $LN_S $lib ${libname}_ixlibrary.a"; cd /sys/libs && $LN_S $lib ${libname}_ixlibrary.a || exit 1; done' + ;; + esac + ;; + +beos*) + library_names_spec='$libname$shared_ext' + dynamic_linker="$host_os ld.so" + shlibpath_var=LIBRARY_PATH + ;; + +bsdi[45]*) + version_type=linux # correct to gnu/linux during the next big refactor + need_version=no + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' + soname_spec='$libname$release$shared_ext$major' + finish_cmds='PATH="\$PATH:/sbin" ldconfig $libdir' + shlibpath_var=LD_LIBRARY_PATH + sys_lib_search_path_spec="/shlib /usr/lib /usr/X11/lib /usr/contrib/lib /lib /usr/local/lib" + sys_lib_dlsearch_path_spec="/shlib /usr/lib /usr/local/lib" + # the default ld.so.conf also contains /usr/contrib/lib and + # /usr/X11R6/lib (/usr/X11 is a link to /usr/X11R6), but let us allow + # libtool to hard-code these into programs + ;; + +cygwin* | mingw* | pw32* | cegcc*) + version_type=windows + shrext_cmds=.dll + need_version=no + need_lib_prefix=no + + case $GCC,$cc_basename in + yes,*) + # gcc + library_names_spec='$libname.dll.a' + # DLL is installed to $(libdir)/../bin by postinstall_cmds + postinstall_cmds='base_file=`basename \$file`~ + dlpath=`$SHELL 2>&1 -c '\''. $dir/'\''\$base_file'\''i; echo \$dlname'\''`~ + dldir=$destdir/`dirname \$dlpath`~ + test -d \$dldir || mkdir -p \$dldir~ + $install_prog $dir/$dlname \$dldir/$dlname~ + chmod a+x \$dldir/$dlname~ + if test -n '\''$stripme'\'' && test -n '\''$striplib'\''; then + eval '\''$striplib \$dldir/$dlname'\'' || exit \$?; + fi' + postuninstall_cmds='dldll=`$SHELL 2>&1 -c '\''. $file; echo \$dlname'\''`~ + dlpath=$dir/\$dldll~ + $RM \$dlpath' + shlibpath_overrides_runpath=yes + + case $host_os in + cygwin*) + # Cygwin DLLs use 'cyg' prefix rather than 'lib' + soname_spec='`echo $libname | sed -e 's/^lib/cyg/'``echo $release | $SED -e 's/[.]/-/g'`$versuffix$shared_ext' + + ;; + mingw* | cegcc*) + # MinGW DLLs use traditional 'lib' prefix + soname_spec='$libname`echo $release | $SED -e 's/[.]/-/g'`$versuffix$shared_ext' + ;; + pw32*) + # pw32 DLLs use 'pw' prefix rather than 'lib' + library_names_spec='`echo $libname | sed -e 's/^lib/pw/'``echo $release | $SED -e 's/[.]/-/g'`$versuffix$shared_ext' + ;; + esac + dynamic_linker='Win32 ld.exe' + ;; + + *,cl*) + # Native MSVC + libname_spec='$name' + soname_spec='$libname`echo $release | $SED -e 's/[.]/-/g'`$versuffix$shared_ext' + library_names_spec='$libname.dll.lib' + + case $build_os in + mingw*) + sys_lib_search_path_spec= + lt_save_ifs=$IFS + IFS=';' + for lt_path in $LIB + do + IFS=$lt_save_ifs + # Let DOS variable expansion print the short 8.3 style file name. + lt_path=`cd "$lt_path" 2>/dev/null && cmd //C "for %i in (".") do @echo %~si"` + sys_lib_search_path_spec="$sys_lib_search_path_spec $lt_path" + done + IFS=$lt_save_ifs + # Convert to MSYS style. + sys_lib_search_path_spec=`$ECHO "$sys_lib_search_path_spec" | sed -e 's|\\\\|/|g' -e 's| \\([a-zA-Z]\\):| /\\1|g' -e 's|^ ||'` + ;; + cygwin*) + # Convert to unix form, then to dos form, then back to unix form + # but this time dos style (no spaces!) so that the unix form looks + # like /cygdrive/c/PROGRA~1:/cygdr... + sys_lib_search_path_spec=`cygpath --path --unix "$LIB"` + sys_lib_search_path_spec=`cygpath --path --dos "$sys_lib_search_path_spec" 2>/dev/null` + sys_lib_search_path_spec=`cygpath --path --unix "$sys_lib_search_path_spec" | $SED -e "s/$PATH_SEPARATOR/ /g"` + ;; + *) + sys_lib_search_path_spec=$LIB + if $ECHO "$sys_lib_search_path_spec" | $GREP ';[c-zC-Z]:/' >/dev/null; then + # It is most probably a Windows format PATH. + sys_lib_search_path_spec=`$ECHO "$sys_lib_search_path_spec" | $SED -e 's/;/ /g'` + else + sys_lib_search_path_spec=`$ECHO "$sys_lib_search_path_spec" | $SED -e "s/$PATH_SEPARATOR/ /g"` + fi + # FIXME: find the short name or the path components, as spaces are + # common. (e.g. "Program Files" -> "PROGRA~1") + ;; + esac + + # DLL is installed to $(libdir)/../bin by postinstall_cmds + postinstall_cmds='base_file=`basename \$file`~ + dlpath=`$SHELL 2>&1 -c '\''. $dir/'\''\$base_file'\''i; echo \$dlname'\''`~ + dldir=$destdir/`dirname \$dlpath`~ + test -d \$dldir || mkdir -p \$dldir~ + $install_prog $dir/$dlname \$dldir/$dlname' + postuninstall_cmds='dldll=`$SHELL 2>&1 -c '\''. $file; echo \$dlname'\''`~ + dlpath=$dir/\$dldll~ + $RM \$dlpath' + shlibpath_overrides_runpath=yes + dynamic_linker='Win32 link.exe' + ;; + + *) + # Assume MSVC wrapper + library_names_spec='$libname`echo $release | $SED -e 's/[.]/-/g'`$versuffix$shared_ext $libname.lib' + dynamic_linker='Win32 ld.exe' + ;; + esac + # FIXME: first we should search . and the directory the executable is in + shlibpath_var=PATH + ;; + +darwin* | rhapsody*) + dynamic_linker="$host_os dyld" + version_type=darwin + need_lib_prefix=no + need_version=no + library_names_spec='$libname$release$major$shared_ext $libname$shared_ext' + soname_spec='$libname$release$major$shared_ext' + shlibpath_overrides_runpath=yes + shlibpath_var=DYLD_LIBRARY_PATH + shrext_cmds='`test .$module = .yes && echo .so || echo .dylib`' + + sys_lib_dlsearch_path_spec='/usr/local/lib /lib /usr/lib' + ;; + +dgux*) + version_type=linux # correct to gnu/linux during the next big refactor + need_lib_prefix=no + need_version=no + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' + soname_spec='$libname$release$shared_ext$major' + shlibpath_var=LD_LIBRARY_PATH + ;; + +freebsd* | dragonfly*) + # DragonFly does not have aout. When/if they implement a new + # versioning mechanism, adjust this. + if test -x /usr/bin/objformat; then + objformat=`/usr/bin/objformat` + else + case $host_os in + freebsd[23].*) objformat=aout ;; + *) objformat=elf ;; + esac + fi + version_type=freebsd-$objformat + case $version_type in + freebsd-elf*) + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' + soname_spec='$libname$release$shared_ext$major' + need_version=no + need_lib_prefix=no + ;; + freebsd-*) + library_names_spec='$libname$release$shared_ext$versuffix $libname$shared_ext$versuffix' + need_version=yes + ;; + esac + shlibpath_var=LD_LIBRARY_PATH + case $host_os in + freebsd2.*) + shlibpath_overrides_runpath=yes + ;; + freebsd3.[01]* | freebsdelf3.[01]*) + shlibpath_overrides_runpath=yes + hardcode_into_libs=yes + ;; + freebsd3.[2-9]* | freebsdelf3.[2-9]* | \ + freebsd4.[0-5] | freebsdelf4.[0-5] | freebsd4.1.1 | freebsdelf4.1.1) + shlibpath_overrides_runpath=no + hardcode_into_libs=yes + ;; + *) # from 4.6 on, and DragonFly + shlibpath_overrides_runpath=yes + hardcode_into_libs=yes + ;; + esac + ;; + +haiku*) + version_type=linux # correct to gnu/linux during the next big refactor + need_lib_prefix=no + need_version=no + dynamic_linker="$host_os runtime_loader" + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' + soname_spec='$libname$release$shared_ext$major' + shlibpath_var=LIBRARY_PATH + shlibpath_overrides_runpath=no + sys_lib_dlsearch_path_spec='/boot/home/config/lib /boot/common/lib /boot/system/lib' + hardcode_into_libs=yes + ;; + +hpux9* | hpux10* | hpux11*) + # Give a soname corresponding to the major version so that dld.sl refuses to + # link against other versions. + version_type=sunos + need_lib_prefix=no + need_version=no + case $host_cpu in + ia64*) + shrext_cmds='.so' + hardcode_into_libs=yes + dynamic_linker="$host_os dld.so" + shlibpath_var=LD_LIBRARY_PATH + shlibpath_overrides_runpath=yes # Unless +noenvvar is specified. + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' + soname_spec='$libname$release$shared_ext$major' + if test 32 = "$HPUX_IA64_MODE"; then + sys_lib_search_path_spec="/usr/lib/hpux32 /usr/local/lib/hpux32 /usr/local/lib" + sys_lib_dlsearch_path_spec=/usr/lib/hpux32 + else + sys_lib_search_path_spec="/usr/lib/hpux64 /usr/local/lib/hpux64" + sys_lib_dlsearch_path_spec=/usr/lib/hpux64 + fi + ;; + hppa*64*) + shrext_cmds='.sl' + hardcode_into_libs=yes + dynamic_linker="$host_os dld.sl" + shlibpath_var=LD_LIBRARY_PATH # How should we handle SHLIB_PATH + shlibpath_overrides_runpath=yes # Unless +noenvvar is specified. + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' + soname_spec='$libname$release$shared_ext$major' + sys_lib_search_path_spec="/usr/lib/pa20_64 /usr/ccs/lib/pa20_64" + sys_lib_dlsearch_path_spec=$sys_lib_search_path_spec + ;; + *) + shrext_cmds='.sl' + dynamic_linker="$host_os dld.sl" + shlibpath_var=SHLIB_PATH + shlibpath_overrides_runpath=no # +s is required to enable SHLIB_PATH + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' + soname_spec='$libname$release$shared_ext$major' + ;; + esac + # HP-UX runs *really* slowly unless shared libraries are mode 555, ... + postinstall_cmds='chmod 555 $lib' + # or fails outright, so override atomically: + install_override_mode=555 + ;; + +interix[3-9]*) + version_type=linux # correct to gnu/linux during the next big refactor + need_lib_prefix=no + need_version=no + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' + soname_spec='$libname$release$shared_ext$major' + dynamic_linker='Interix 3.x ld.so.1 (PE, like ELF)' + shlibpath_var=LD_LIBRARY_PATH + shlibpath_overrides_runpath=no + hardcode_into_libs=yes + ;; + +irix5* | irix6* | nonstopux*) + case $host_os in + nonstopux*) version_type=nonstopux ;; + *) + if test yes = "$lt_cv_prog_gnu_ld"; then + version_type=linux # correct to gnu/linux during the next big refactor + else + version_type=irix + fi ;; + esac + need_lib_prefix=no + need_version=no + soname_spec='$libname$release$shared_ext$major' + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$release$shared_ext $libname$shared_ext' + case $host_os in + irix5* | nonstopux*) + libsuff= shlibsuff= + ;; + *) + case $LD in # libtool.m4 will add one of these switches to LD + *-32|*"-32 "|*-melf32bsmip|*"-melf32bsmip ") + libsuff= shlibsuff= libmagic=32-bit;; + *-n32|*"-n32 "|*-melf32bmipn32|*"-melf32bmipn32 ") + libsuff=32 shlibsuff=N32 libmagic=N32;; + *-64|*"-64 "|*-melf64bmip|*"-melf64bmip ") + libsuff=64 shlibsuff=64 libmagic=64-bit;; + *) libsuff= shlibsuff= libmagic=never-match;; + esac + ;; + esac + shlibpath_var=LD_LIBRARY${shlibsuff}_PATH + shlibpath_overrides_runpath=no + sys_lib_search_path_spec="/usr/lib$libsuff /lib$libsuff /usr/local/lib$libsuff" + sys_lib_dlsearch_path_spec="/usr/lib$libsuff /lib$libsuff" + hardcode_into_libs=yes + ;; + +# No shared lib support for Linux oldld, aout, or coff. +linux*oldld* | linux*aout* | linux*coff*) + dynamic_linker=no + ;; + +linux*android*) + version_type=none # Android doesn't support versioned libraries. + need_lib_prefix=no + need_version=no + library_names_spec='$libname$release$shared_ext' + soname_spec='$libname$release$shared_ext' + finish_cmds= + shlibpath_var=LD_LIBRARY_PATH + shlibpath_overrides_runpath=yes + + # This implies no fast_install, which is unacceptable. + # Some rework will be needed to allow for fast_install + # before this can be enabled. + hardcode_into_libs=yes + + dynamic_linker='Android linker' + # Don't embed -rpath directories since the linker doesn't support them. + hardcode_libdir_flag_spec_FC='-L$libdir' + ;; + +# This must be glibc/ELF. +linux* | k*bsd*-gnu | kopensolaris*-gnu | gnu*) + version_type=linux # correct to gnu/linux during the next big refactor + need_lib_prefix=no + need_version=no + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' + soname_spec='$libname$release$shared_ext$major' + finish_cmds='PATH="\$PATH:/sbin" ldconfig -n $libdir' + shlibpath_var=LD_LIBRARY_PATH + shlibpath_overrides_runpath=no + + # Some binutils ld are patched to set DT_RUNPATH + if ${lt_cv_shlibpath_overrides_runpath+:} false; then : + $as_echo_n "(cached) " >&6 +else + lt_cv_shlibpath_overrides_runpath=no + save_LDFLAGS=$LDFLAGS + save_libdir=$libdir + eval "libdir=/foo; wl=\"$lt_prog_compiler_wl_FC\"; \ + LDFLAGS=\"\$LDFLAGS $hardcode_libdir_flag_spec_FC\"" + cat > conftest.$ac_ext <<_ACEOF + program main + + end +_ACEOF +if ac_fn_fc_try_link "$LINENO"; then : + if ($OBJDUMP -p conftest$ac_exeext) 2>/dev/null | grep "RUNPATH.*$libdir" >/dev/null; then : + lt_cv_shlibpath_overrides_runpath=yes +fi +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + LDFLAGS=$save_LDFLAGS + libdir=$save_libdir + +fi + + shlibpath_overrides_runpath=$lt_cv_shlibpath_overrides_runpath + + # This implies no fast_install, which is unacceptable. + # Some rework will be needed to allow for fast_install + # before this can be enabled. + hardcode_into_libs=yes + + # Ideally, we could use ldconfig to report *all* directores which are + # searched for libraries, however this is still not possible. Aside from not + # being certain /sbin/ldconfig is available, command + # 'ldconfig -N -X -v | grep ^/' on 64bit Fedora does not report /usr/lib64, + # even though it is searched at run-time. Try to do the best guess by + # appending ld.so.conf contents (and includes) to the search path. + if test -f /etc/ld.so.conf; then + lt_ld_extra=`awk '/^include / { system(sprintf("cd /etc; cat %s 2>/dev/null", \$2)); skip = 1; } { if (!skip) print \$0; skip = 0; }' < /etc/ld.so.conf | $SED -e 's/#.*//;/^[ ]*hwcap[ ]/d;s/[:, ]/ /g;s/=[^=]*$//;s/=[^= ]* / /g;s/"//g;/^$/d' | tr '\n' ' '` + sys_lib_dlsearch_path_spec="/lib /usr/lib $lt_ld_extra" + fi + + # We used to test for /lib/ld.so.1 and disable shared libraries on + # powerpc, because MkLinux only supported shared libraries with the + # GNU dynamic linker. Since this was broken with cross compilers, + # most powerpc-linux boxes support dynamic linking these days and + # people can always --disable-shared, the test was removed, and we + # assume the GNU/Linux dynamic linker is in use. + dynamic_linker='GNU/Linux ld.so' + ;; + +netbsd*) + version_type=sunos + need_lib_prefix=no + need_version=no + if echo __ELF__ | $CC -E - | $GREP __ELF__ >/dev/null; then + library_names_spec='$libname$release$shared_ext$versuffix $libname$shared_ext$versuffix' + finish_cmds='PATH="\$PATH:/sbin" ldconfig -m $libdir' + dynamic_linker='NetBSD (a.out) ld.so' + else + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' + soname_spec='$libname$release$shared_ext$major' + dynamic_linker='NetBSD ld.elf_so' + fi + shlibpath_var=LD_LIBRARY_PATH + shlibpath_overrides_runpath=yes + hardcode_into_libs=yes + ;; + +newsos6) + version_type=linux # correct to gnu/linux during the next big refactor + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' + shlibpath_var=LD_LIBRARY_PATH + shlibpath_overrides_runpath=yes + ;; + +*nto* | *qnx*) + version_type=qnx + need_lib_prefix=no + need_version=no + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' + soname_spec='$libname$release$shared_ext$major' + shlibpath_var=LD_LIBRARY_PATH + shlibpath_overrides_runpath=no + hardcode_into_libs=yes + dynamic_linker='ldqnx.so' + ;; + +openbsd* | bitrig*) + version_type=sunos + sys_lib_dlsearch_path_spec=/usr/lib + need_lib_prefix=no + if test -z "`echo __ELF__ | $CC -E - | $GREP __ELF__`"; then + need_version=no + else + need_version=yes + fi + library_names_spec='$libname$release$shared_ext$versuffix $libname$shared_ext$versuffix' + finish_cmds='PATH="\$PATH:/sbin" ldconfig -m $libdir' + shlibpath_var=LD_LIBRARY_PATH + shlibpath_overrides_runpath=yes + ;; + +os2*) + libname_spec='$name' + version_type=windows + shrext_cmds=.dll + need_version=no + need_lib_prefix=no + # OS/2 can only load a DLL with a base name of 8 characters or less. + soname_spec='`test -n "$os2dllname" && libname="$os2dllname"; + v=$($ECHO $release$versuffix | tr -d .-); + n=$($ECHO $libname | cut -b -$((8 - ${#v})) | tr . _); + $ECHO $n$v`$shared_ext' + library_names_spec='${libname}_dll.$libext' + dynamic_linker='OS/2 ld.exe' + shlibpath_var=BEGINLIBPATH + sys_lib_search_path_spec="/lib /usr/lib /usr/local/lib" + sys_lib_dlsearch_path_spec=$sys_lib_search_path_spec + postinstall_cmds='base_file=`basename \$file`~ + dlpath=`$SHELL 2>&1 -c '\''. $dir/'\''\$base_file'\''i; $ECHO \$dlname'\''`~ + dldir=$destdir/`dirname \$dlpath`~ + test -d \$dldir || mkdir -p \$dldir~ + $install_prog $dir/$dlname \$dldir/$dlname~ + chmod a+x \$dldir/$dlname~ + if test -n '\''$stripme'\'' && test -n '\''$striplib'\''; then + eval '\''$striplib \$dldir/$dlname'\'' || exit \$?; + fi' + postuninstall_cmds='dldll=`$SHELL 2>&1 -c '\''. $file; $ECHO \$dlname'\''`~ + dlpath=$dir/\$dldll~ + $RM \$dlpath' + ;; + +osf3* | osf4* | osf5*) + version_type=osf + need_lib_prefix=no + need_version=no + soname_spec='$libname$release$shared_ext$major' + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' + shlibpath_var=LD_LIBRARY_PATH + sys_lib_search_path_spec="/usr/shlib /usr/ccs/lib /usr/lib/cmplrs/cc /usr/lib /usr/local/lib /var/shlib" + sys_lib_dlsearch_path_spec=$sys_lib_search_path_spec + ;; + +rdos*) + dynamic_linker=no + ;; + +solaris*) + version_type=linux # correct to gnu/linux during the next big refactor + need_lib_prefix=no + need_version=no + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' + soname_spec='$libname$release$shared_ext$major' + shlibpath_var=LD_LIBRARY_PATH + shlibpath_overrides_runpath=yes + hardcode_into_libs=yes + # ldd complains unless libraries are executable + postinstall_cmds='chmod +x $lib' + ;; + +sunos4*) + version_type=sunos + library_names_spec='$libname$release$shared_ext$versuffix $libname$shared_ext$versuffix' + finish_cmds='PATH="\$PATH:/usr/etc" ldconfig $libdir' + shlibpath_var=LD_LIBRARY_PATH + shlibpath_overrides_runpath=yes + if test yes = "$with_gnu_ld"; then + need_lib_prefix=no + fi + need_version=yes + ;; + +sysv4 | sysv4.3*) + version_type=linux # correct to gnu/linux during the next big refactor + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' + soname_spec='$libname$release$shared_ext$major' + shlibpath_var=LD_LIBRARY_PATH + case $host_vendor in + sni) + shlibpath_overrides_runpath=no + need_lib_prefix=no + runpath_var=LD_RUN_PATH + ;; + siemens) + need_lib_prefix=no + ;; + motorola) + need_lib_prefix=no + need_version=no + shlibpath_overrides_runpath=no + sys_lib_search_path_spec='/lib /usr/lib /usr/ccs/lib' + ;; + esac + ;; + +sysv4*MP*) + if test -d /usr/nec; then + version_type=linux # correct to gnu/linux during the next big refactor + library_names_spec='$libname$shared_ext.$versuffix $libname$shared_ext.$major $libname$shared_ext' + soname_spec='$libname$shared_ext.$major' + shlibpath_var=LD_LIBRARY_PATH + fi + ;; + +sysv5* | sco3.2v5* | sco5v6* | unixware* | OpenUNIX* | sysv4*uw2*) + version_type=sco + need_lib_prefix=no + need_version=no + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext $libname$shared_ext' + soname_spec='$libname$release$shared_ext$major' + shlibpath_var=LD_LIBRARY_PATH + shlibpath_overrides_runpath=yes + hardcode_into_libs=yes + if test yes = "$with_gnu_ld"; then + sys_lib_search_path_spec='/usr/local/lib /usr/gnu/lib /usr/ccs/lib /usr/lib /lib' + else + sys_lib_search_path_spec='/usr/ccs/lib /usr/lib' + case $host_os in + sco3.2v5*) + sys_lib_search_path_spec="$sys_lib_search_path_spec /lib" + ;; + esac + fi + sys_lib_dlsearch_path_spec='/usr/lib' + ;; + +tpf*) + # TPF is a cross-target only. Preferred cross-host = GNU/Linux. + version_type=linux # correct to gnu/linux during the next big refactor + need_lib_prefix=no + need_version=no + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' + shlibpath_var=LD_LIBRARY_PATH + shlibpath_overrides_runpath=no + hardcode_into_libs=yes + ;; + +uts4*) + version_type=linux # correct to gnu/linux during the next big refactor + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' + soname_spec='$libname$release$shared_ext$major' + shlibpath_var=LD_LIBRARY_PATH + ;; + +*) + dynamic_linker=no + ;; +esac +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $dynamic_linker" >&5 +$as_echo "$dynamic_linker" >&6; } +test no = "$dynamic_linker" && can_build_shared=no + +variables_saved_for_relink="PATH $shlibpath_var $runpath_var" +if test yes = "$GCC"; then + variables_saved_for_relink="$variables_saved_for_relink GCC_EXEC_PREFIX COMPILER_PATH LIBRARY_PATH" +fi + +if test set = "${lt_cv_sys_lib_search_path_spec+set}"; then + sys_lib_search_path_spec=$lt_cv_sys_lib_search_path_spec +fi + +if test set = "${lt_cv_sys_lib_dlsearch_path_spec+set}"; then + sys_lib_dlsearch_path_spec=$lt_cv_sys_lib_dlsearch_path_spec +fi + +# remember unaugmented sys_lib_dlsearch_path content for libtool script decls... +configure_time_dlsearch_path=$sys_lib_dlsearch_path_spec + +# ... but it needs LT_SYS_LIBRARY_PATH munging for other configure-time code +func_munge_path_list sys_lib_dlsearch_path_spec "$LT_SYS_LIBRARY_PATH" + +# to be used as default LT_SYS_LIBRARY_PATH value in generated libtool +configure_time_lt_sys_library_path=$LT_SYS_LIBRARY_PATH + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking how to hardcode library paths into programs" >&5 +$as_echo_n "checking how to hardcode library paths into programs... " >&6; } +hardcode_action_FC= +if test -n "$hardcode_libdir_flag_spec_FC" || + test -n "$runpath_var_FC" || + test yes = "$hardcode_automatic_FC"; then + + # We can hardcode non-existent directories. + if test no != "$hardcode_direct_FC" && + # If the only mechanism to avoid hardcoding is shlibpath_var, we + # have to relink, otherwise we might link with an installed library + # when we should be linking with a yet-to-be-installed one + ## test no != "$_LT_TAGVAR(hardcode_shlibpath_var, FC)" && + test no != "$hardcode_minus_L_FC"; then + # Linking always hardcodes the temporary library directory. + hardcode_action_FC=relink + else + # We can link without hardcoding, and we can hardcode nonexisting dirs. + hardcode_action_FC=immediate + fi +else + # We cannot hardcode anything, or else we can only hardcode existing + # directories. + hardcode_action_FC=unsupported +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $hardcode_action_FC" >&5 +$as_echo "$hardcode_action_FC" >&6; } + +if test relink = "$hardcode_action_FC" || + test yes = "$inherit_rpath_FC"; then + # Fast installation is not supported + enable_fast_install=no +elif test yes = "$shlibpath_overrides_runpath" || + test no = "$enable_shared"; then + # Fast installation is not necessary + enable_fast_install=needless +fi + + + + + + + + fi # test -n "$compiler" + + GCC=$lt_save_GCC + CC=$lt_save_CC + CFLAGS=$lt_save_CFLAGS +fi # test yes != "$_lt_disable_FC" + +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + + +ac_ext=${ac_fc_srcext-f} +ac_compile='$FC -c $FCFLAGS $ac_fcflags_srcext conftest.$ac_ext >&5' +ac_link='$FC -o conftest$ac_exeext $FCFLAGS $LDFLAGS $ac_fcflags_srcext conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_fc_compiler_gnu + +ac_ext=${ac_fc_srcext-f} +ac_compile='$FC -c $FCFLAGS $ac_fcflags_srcext conftest.$ac_ext >&5' +ac_link='$FC -o conftest$ac_exeext $FCFLAGS $LDFLAGS $ac_fcflags_srcext conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_fc_compiler_gnu +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for Fortran flag to compile .f90 files" >&5 +$as_echo_n "checking for Fortran flag to compile .f90 files... " >&6; } +if ${ac_cv_fc_srcext_f90+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_ext=f90 +ac_fcflags_srcext_save=$ac_fcflags_srcext +ac_fcflags_srcext= +ac_cv_fc_srcext_f90=unknown +case $ac_ext in #( + [fF]77) ac_try=f77;; #( + *) ac_try=f95;; +esac +for ac_flag in none -qsuffix=f=f90 -Tf "-x $ac_try"; do + test "x$ac_flag" != xnone && ac_fcflags_srcext="$ac_flag" + cat > conftest.$ac_ext <<_ACEOF + program main + + end +_ACEOF +if ac_fn_fc_try_compile "$LINENO"; then : + ac_cv_fc_srcext_f90=$ac_flag; break +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +done +rm -f conftest.$ac_objext conftest.f90 +ac_fcflags_srcext=$ac_fcflags_srcext_save + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_fc_srcext_f90" >&5 +$as_echo "$ac_cv_fc_srcext_f90" >&6; } +if test "x$ac_cv_fc_srcext_f90" = xunknown; then + dummy=0 +else + ac_fc_srcext=f90 + if test "x$ac_cv_fc_srcext_f90" = xnone; then + ac_fcflags_srcext="" + FCFLAGS_f90="" + else + ac_fcflags_srcext=$ac_cv_fc_srcext_f90 + FCFLAGS_f90=$ac_cv_fc_srcext_f90 + fi + + dummy=1 +fi +ac_ext=${ac_fc_srcext-f} +ac_compile='$FC -c $FCFLAGS $ac_fcflags_srcext conftest.$ac_ext >&5' +ac_link='$FC -o conftest$ac_exeext $FCFLAGS $LDFLAGS $ac_fcflags_srcext conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_fc_compiler_gnu + +ac_ext=${ac_fc_srcext-f} +ac_compile='$FC -c $FCFLAGS $ac_fcflags_srcext conftest.$ac_ext >&5' +ac_link='$FC -o conftest$ac_exeext $FCFLAGS $LDFLAGS $ac_fcflags_srcext conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_fc_compiler_gnu +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for Fortran flag to compile .f95 files" >&5 +$as_echo_n "checking for Fortran flag to compile .f95 files... " >&6; } +if ${ac_cv_fc_srcext_f95+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_ext=f95 +ac_fcflags_srcext_save=$ac_fcflags_srcext +ac_fcflags_srcext= +ac_cv_fc_srcext_f95=unknown +case $ac_ext in #( + [fF]77) ac_try=f77;; #( + *) ac_try=f95;; +esac +for ac_flag in none -qsuffix=f=f95 -Tf "-x $ac_try"; do + test "x$ac_flag" != xnone && ac_fcflags_srcext="$ac_flag" + cat > conftest.$ac_ext <<_ACEOF + program main + + end +_ACEOF +if ac_fn_fc_try_compile "$LINENO"; then : + ac_cv_fc_srcext_f95=$ac_flag; break +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +done +rm -f conftest.$ac_objext conftest.f95 +ac_fcflags_srcext=$ac_fcflags_srcext_save + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_fc_srcext_f95" >&5 +$as_echo "$ac_cv_fc_srcext_f95" >&6; } +if test "x$ac_cv_fc_srcext_f95" = xunknown; then + dummy=0 +else + ac_fc_srcext=f95 + if test "x$ac_cv_fc_srcext_f95" = xnone; then + ac_fcflags_srcext="" + FCFLAGS_f95="" + else + ac_fcflags_srcext=$ac_cv_fc_srcext_f95 + FCFLAGS_f95=$ac_cv_fc_srcext_f95 + fi + + dummy=1 +fi +ac_ext=${ac_fc_srcext-f} +ac_compile='$FC -c $FCFLAGS $ac_fcflags_srcext conftest.$ac_ext >&5' +ac_link='$FC -o conftest$ac_exeext $FCFLAGS $LDFLAGS $ac_fcflags_srcext conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_fc_compiler_gnu + + + OPENMP_FCFLAGS= + # Check whether --enable-openmp was given. +if test "${enable_openmp+set}" = set; then : + enableval=$enable_openmp; +fi + + if test "$enable_openmp" != no; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $FC option to support OpenMP" >&5 +$as_echo_n "checking for $FC option to support OpenMP... " >&6; } +if ${ac_cv_prog_fc_openmp+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat > conftest.$ac_ext <<_ACEOF + + program main + implicit none +!$ integer tid + tid = 42 + call omp_set_num_threads(2) + end + +_ACEOF +if ac_fn_fc_try_link "$LINENO"; then : + ac_cv_prog_fc_openmp='none needed' +else + ac_cv_prog_fc_openmp='unsupported' + for ac_option in -fopenmp -xopenmp -qopenmp \ + -openmp -mp -omp -qsmp=omp -homp \ + -fopenmp=libomp \ + -Popenmp --openmp; do + ac_save_FCFLAGS=$FCFLAGS + FCFLAGS="$FCFLAGS $ac_option" + cat > conftest.$ac_ext <<_ACEOF + + program main + implicit none +!$ integer tid + tid = 42 + call omp_set_num_threads(2) + end + +_ACEOF +if ac_fn_fc_try_link "$LINENO"; then : + ac_cv_prog_fc_openmp=$ac_option +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + FCFLAGS=$ac_save_FCFLAGS + if test "$ac_cv_prog_fc_openmp" != unsupported; then + break + fi + done +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_fc_openmp" >&5 +$as_echo "$ac_cv_prog_fc_openmp" >&6; } + case $ac_cv_prog_fc_openmp in #( + "none needed" | unsupported) + ;; #( + *) + OPENMP_FCFLAGS=$ac_cv_prog_fc_openmp ;; + esac + fi + + +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + +if test -z "${SHLIB_FCLD}"; then + shlib_fcld_was_given=no + SHLIB_FCLD="\$(FC)" +fi +: ${SHLIB_FCLDFLAGS="${SHLIB_LDFLAGS}"} + + +## x86 Solaris' f95 needs additional libs when building a DSO +FCLIBS=${FCLIBS} + + +## OpenMP package stuff (needs to come *after* configuration of all +## compilers). +## We allow the users to override this for packages only (for now) +## FIXME: what if SHLIB_OPENMP_?FLAGS is set but empty? (could use -n "${VAR+set}") +if test "x${shlib_ld_was_given}" = xno -a \ + "${SHLIB_LD}" = "\$(CC)" -a \ + "x${ac_cv_prog_c_openmp}" != "xunsupported" -a \ + "x${ac_cv_prog_c_openmp}" != "x" -a \ + "x${shlib_cxxld_was_given}" = xno -a \ + "${SHLIB_CXXLD}" = "\$(CXX)" -a \ + "x${ac_cv_prog_cxx_openmp}" != "xunsupported" -a \ + "x${shlib_fcld_was_given}" = xno -a \ + "${SHLIB_FCLD}" = "\$(FC)" -a \ + "x${ac_cv_prog_fc_openmp}" != "xunsupported"; then + ## next macro is copied into Rconfig.h + +$as_echo "#define SUPPORT_OPENMP 1" >>confdefs.h + +fi +## This assumes that OpenMP support in the C compiler includes compilation by F77 +if test -z "${SHLIB_OPENMP_CFLAGS+set}" -a \ + "x${shlib_ld_was_given}" = xno -a \ + "${SHLIB_LD}" = "\$(CC)" -a \ + "x${ac_cv_prog_c_openmp}" != "xunsupported" -a \ + "x${ac_cv_prog_c_openmp}" != "x"; then + SHLIB_OPENMP_CFLAGS="${OPENMP_CFLAGS}" + if test -z "${SHLIB_OPENMP_FFLAGS+set}" -a \ + "x${ac_cv_prog_f77_openmp}" != "xunsupported"; then + SHLIB_OPENMP_FFLAGS="${OPENMP_FFLAGS}" + fi +fi +if test -z "${SHLIB_OPENMP_CXXFLAGS+set}" -a \ + "x${shlib_cxxld_was_given}" = xno -a \ + "${SHLIB_CXXLD}" = "\$(CXX)" -a \ + "x${ac_cv_prog_cxx_openmp}" != "xunsupported"; then + SHLIB_OPENMP_CXXFLAGS="${OPENMP_CXXFLAGS}" +fi +if test -z "${SHLIB_OPENMP_FCFLAGS+set}" -a \ + "x${shlib_fcld_was_given}" = xno -a \ + "${SHLIB_FCLD}" = "\$(FC)" -a \ + "x${ac_cv_prog_fc_openmp}" != "xunsupported"; then + SHLIB_OPENMP_FCFLAGS="${OPENMP_FCFLAGS}" +fi + + + + + + + +## Look for FCPICFLAGS +## Debian in their wisdom have f95 as a link to gfortran, so +## use this to pick out gfortran (even though it is unreliable). +if test "${ac_cv_fc_compiler_gnu}" = yes; then + case "${host_cpu}" in + sparc*|ppc64*|powerpc64*|s390*) + fcpicflags="-fPIC" + ;; + *) + fcpicflags="-fpic" + ;; + esac +fi +case "${host_os}" in + darwin*) + ## macOS does not have a Fortran compiler, so this is speculative + fcpicflags="${darwin_pic}" + ;; + hpux*) + case "${FC}" in + f90) + fcpicflags="+Z" + ;; + esac + ;; + linux*) + case "${FC}" in + ## Intel compilers: probably get identified as GNU, but make sure. + *ifc|*ifort) + fcpicflags="-fpic" + ;; + ## Portland Group + *pgf95|*pgf90) + fcpicflags="-fpic" + ;; + esac + ;; + solaris*) + if test "${ac_cv_fc_compiler_gnu}" = yes; then + fcpicflags="-fPIC" + else + fcpicflags="-PIC" + fi + ;; +esac +: ${FCPICFLAGS="${fcpicflags}"} +if test -z "${FCPICFLAGS}"; then + case "${host_os}" in + aix*|mingw*) + ;; + *) + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: I could not determine FCPICFLAGS." >&5 +$as_echo "$as_me: WARNING: I could not determine FCPICFLAGS." >&2;} + ;; + esac +fi + + +## Make sure -L terms come first in LIBS. +LIBS1="" +LIBS2="" +for arg in ${LIBS}; do + case "${arg}" in + -L*) + separator="" +test -z "${separator}" && separator=" " +if test -z "${LIBS1}"; then + LIBS1="${arg}" +else + LIBS1="${LIBS1}${separator}${arg}" +fi + ;; + *) + separator="" +test -z "${separator}" && separator=" " +if test -z "${LIBS2}"; then + LIBS2="${arg}" +else + LIBS2="${LIBS2}${separator}${arg}" +fi + ;; + esac +done +LIBS="${LIBS1} ${LIBS2}" + +## R_LD_LIBRARY_PATH. + +## On Linux, do not add the ld.so system directories such as '/lib' and +## '/usr/lib', so that the entries from '/etc/ld.so.conf' are not +## shadowed (otherwise, e.g. optimized ATLAS libs would not be used). + +## On macOS (Darwin) this used to have /usr/X11R6/lib +## which shadows the OpenGL framework but we add nothing on macOS .... +case "${host_os}" in + linux*) + r_ld_library_defaults="/usr/lib64:/lib64:/usr/lib:/lib" + ;; + solaris*) + r_ld_library_defaults="/usr/lib:/lib" + ;; + *) + r_ld_library_defaults= + ;; +esac +if test -n "${R_LD_LIBRARY_PATH_save}"; then + R_LD_LIBRARY_PATH=${R_LD_LIBRARY_PATH_save} +else +## We already added -L's from LDFLAGS (except on Darwin): +## seem to be doing it again +for arg in ${LDFLAGS} ${FLIBS} ${BLAS_LIBS} ${LAPACK_LIBS} ${X_LIBS} \ + ${TCLTK_LIBS}; do + case "${arg}" in + -L*) + lib=`echo ${arg} | sed "s/^-L//"` + r_want_lib=true + ## don't add anything for Darwin + case "${host_os}" in darwin*) r_want_lib=false ;; esac + ## Do not add non-existent directories. + test -d "${lib}" || r_want_lib=false + if test x"${r_want_lib}" = xtrue; then + ## Canonicalize (/usr/lib/gcc-lib/i486-linux/3.3.4/../../..). + lib=`cd "${lib}" && ${GETWD}` + ## Do not add something twice, or default paths. + r_save_IFS="${IFS}"; IFS="${PATH_SEPARATOR}" + for dir in ${R_LD_LIBRARY_PATH}${IFS}${r_ld_library_defaults}; do + if test x"${dir}" = x"${lib}"; then + r_want_lib=false + break + fi + done + IFS="${r_save_IFS}" + if test x"${r_want_lib}" = xtrue; then + separator="${PATH_SEPARATOR}" +test -z "${separator}" && separator=" " +if test -z "${R_LD_LIBRARY_PATH}"; then + R_LD_LIBRARY_PATH="${lib}" +else + R_LD_LIBRARY_PATH="${R_LD_LIBRARY_PATH}${separator}${lib}" +fi + fi + fi + ;; + esac +done +fi + + + +## Recommended packages. +if test "${use_recommended_packages}" = yes; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for recommended packages" >&5 +$as_echo_n "checking for recommended packages... " >&6; } +if ${r_cv_misc_recommended_packages+:} false; then : + $as_echo_n "(cached) " >&6 +else + r_cv_misc_recommended_packages=yes +recommended_pkgs=`grep '^R_PKGS_RECOMMENDED *=' \ + ${srcdir}/share/make/vars.mk | sed 's/.*=//'` +for pkg in ${recommended_pkgs}; do + n_pkg=`ls ${srcdir}/src/library/Recommended/${pkg}_*.tar.gz | wc -l` + if test ${n_pkg} -ne 1; then + r_cv_misc_recommended_packages=no + break + fi +done +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $r_cv_misc_recommended_packages" >&5 +$as_echo "$r_cv_misc_recommended_packages" >&6; } +use_recommended_packages=${r_cv_misc_recommended_packages} +if test "x${r_cv_misc_recommended_packages}" = xno; then + as_fn_error $? "Some of the recommended packages are missing + Use --without-recommended-packages if this was intentional" "$LINENO" 5 +fi + +fi + if test "x${use_recommended_packages}" = xyes; then + USE_RECOMMENDED_PACKAGES_TRUE= + USE_RECOMMENDED_PACKAGES_FALSE='#' +else + USE_RECOMMENDED_PACKAGES_TRUE='#' + USE_RECOMMENDED_PACKAGES_FALSE= +fi + + +# i18n support. + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether NLS is requested" >&5 +$as_echo_n "checking whether NLS is requested... " >&6; } + # Check whether --enable-nls was given. +if test "${enable_nls+set}" = set; then : + enableval=$enable_nls; USE_NLS=$enableval +else + USE_NLS=yes +fi + + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $USE_NLS" >&5 +$as_echo "$USE_NLS" >&6; } + + +if test "${USE_NLS}" = "yes"; then + echo + echo "Configuring src/extra/intl directory" + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for a thread-safe mkdir -p" >&5 +$as_echo_n "checking for a thread-safe mkdir -p... " >&6; } +if test -z "$MKDIR_P"; then + if ${ac_cv_path_mkdir+:} false; then : + $as_echo_n "(cached) " >&6 +else + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH$PATH_SEPARATOR/opt/sfw/bin +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_prog in mkdir gmkdir; do + for ac_exec_ext in '' $ac_executable_extensions; do + as_fn_executable_p "$as_dir/$ac_prog$ac_exec_ext" || continue + case `"$as_dir/$ac_prog$ac_exec_ext" --version 2>&1` in #( + 'mkdir (GNU coreutils) '* | \ + 'mkdir (coreutils) '* | \ + 'mkdir (fileutils) '4.1*) + ac_cv_path_mkdir=$as_dir/$ac_prog$ac_exec_ext + break 3;; + esac + done + done + done +IFS=$as_save_IFS + +fi + + test -d ./--version && rmdir ./--version + if test "${ac_cv_path_mkdir+set}" = set; then + MKDIR_P="$ac_cv_path_mkdir -p" + else + # As a last resort, use the slow shell script. Don't cache a + # value for MKDIR_P within a source directory, because that will + # break other packages using the cache if that directory is + # removed, or if the value is a relative name. + MKDIR_P="$ac_install_sh -d" + fi +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $MKDIR_P" >&5 +$as_echo "$MKDIR_P" >&6; } + + +mkdir_p="$MKDIR_P" +case $mkdir_p in + [\\/$]* | ?:[\\/]*) ;; + */*) mkdir_p="\$(top_builddir)/$mkdir_p" ;; +esac + + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether we are using the GNU C Library 2 or newer" >&5 +$as_echo_n "checking whether we are using the GNU C Library 2 or newer... " >&6; } +if ${ac_cv_gnu_library_2+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +#include <features.h> +#ifdef __GNU_LIBRARY__ + #if (__GLIBC__ >= 2) + Lucky GNU user + #endif +#endif + +_ACEOF +if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | + $EGREP "Lucky GNU user" >/dev/null 2>&1; then : + ac_cv_gnu_library_2=yes +else + ac_cv_gnu_library_2=no +fi +rm -f conftest* + + + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_gnu_library_2" >&5 +$as_echo "$ac_cv_gnu_library_2" >&6; } + + GLIBC2="$ac_cv_gnu_library_2" + + +if test -n "$ac_tool_prefix"; then + # Extract the first word of "${ac_tool_prefix}ranlib", so it can be a program name with args. +set dummy ${ac_tool_prefix}ranlib; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_RANLIB+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$RANLIB"; then + ac_cv_prog_RANLIB="$RANLIB" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_RANLIB="${ac_tool_prefix}ranlib" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +RANLIB=$ac_cv_prog_RANLIB +if test -n "$RANLIB"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $RANLIB" >&5 +$as_echo "$RANLIB" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + +fi +if test -z "$ac_cv_prog_RANLIB"; then + ac_ct_RANLIB=$RANLIB + # Extract the first word of "ranlib", so it can be a program name with args. +set dummy ranlib; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_ac_ct_RANLIB+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$ac_ct_RANLIB"; then + ac_cv_prog_ac_ct_RANLIB="$ac_ct_RANLIB" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_ac_ct_RANLIB="ranlib" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +ac_ct_RANLIB=$ac_cv_prog_ac_ct_RANLIB +if test -n "$ac_ct_RANLIB"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_RANLIB" >&5 +$as_echo "$ac_ct_RANLIB" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + if test "x$ac_ct_RANLIB" = x; then + RANLIB=":" + else + case $cross_compiling:$ac_tool_warned in +yes:) +{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 +$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} +ac_tool_warned=yes ;; +esac + RANLIB=$ac_ct_RANLIB + fi +else + RANLIB="$ac_cv_prog_RANLIB" +fi + + + + CFLAG_VISIBILITY= + HAVE_VISIBILITY=0 + if test -n "$GCC"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for simple visibility declarations" >&5 +$as_echo_n "checking for simple visibility declarations... " >&6; } + if ${gl_cv_cc_visibility+:} false; then : + $as_echo_n "(cached) " >&6 +else + + gl_save_CFLAGS="$CFLAGS" + CFLAGS="$CFLAGS -fvisibility=hidden" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +extern __attribute__((__visibility__("hidden"))) int hiddenvar; + extern __attribute__((__visibility__("default"))) int exportedvar; + extern __attribute__((__visibility__("hidden"))) int hiddenfunc (void); + extern __attribute__((__visibility__("default"))) int exportedfunc (void); +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + gl_cv_cc_visibility=yes +else + gl_cv_cc_visibility=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + CFLAGS="$gl_save_CFLAGS" +fi + + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_cc_visibility" >&5 +$as_echo "$gl_cv_cc_visibility" >&6; } + if test $gl_cv_cc_visibility = yes; then + CFLAG_VISIBILITY="-fvisibility=hidden" + HAVE_VISIBILITY=1 + fi + fi + + + +cat >>confdefs.h <<_ACEOF +#define HAVE_VISIBILITY $HAVE_VISIBILITY +_ACEOF + + + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for stdint.h" >&5 +$as_echo_n "checking for stdint.h... " >&6; } +if ${gl_cv_header_stdint_h+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <sys/types.h> +#include <stdint.h> +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +uintmax_t i = (uintmax_t) -1; return !i; + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + gl_cv_header_stdint_h=yes +else + gl_cv_header_stdint_h=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_header_stdint_h" >&5 +$as_echo "$gl_cv_header_stdint_h" >&6; } + if test $gl_cv_header_stdint_h = yes; then + +cat >>confdefs.h <<_ACEOF +#define HAVE_STDINT_H_WITH_UINTMAX 1 +_ACEOF + + fi + + + + + + + + +for ac_func in getpagesize +do : + ac_fn_c_check_func "$LINENO" "getpagesize" "ac_cv_func_getpagesize" +if test "x$ac_cv_func_getpagesize" = xyes; then : + cat >>confdefs.h <<_ACEOF +#define HAVE_GETPAGESIZE 1 +_ACEOF + +fi +done + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for working mmap" >&5 +$as_echo_n "checking for working mmap... " >&6; } +if ${ac_cv_func_mmap_fixed_mapped+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test "$cross_compiling" = yes; then : + ac_cv_func_mmap_fixed_mapped=no +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +$ac_includes_default +/* malloc might have been renamed as rpl_malloc. */ +#undef malloc + +/* Thanks to Mike Haertel and Jim Avera for this test. + Here is a matrix of mmap possibilities: + mmap private not fixed + mmap private fixed at somewhere currently unmapped + mmap private fixed at somewhere already mapped + mmap shared not fixed + mmap shared fixed at somewhere currently unmapped + mmap shared fixed at somewhere already mapped + For private mappings, we should verify that changes cannot be read() + back from the file, nor mmap's back from the file at a different + address. (There have been systems where private was not correctly + implemented like the infamous i386 svr4.0, and systems where the + VM page cache was not coherent with the file system buffer cache + like early versions of FreeBSD and possibly contemporary NetBSD.) + For shared mappings, we should conversely verify that changes get + propagated back to all the places they're supposed to be. + + Grep wants private fixed already mapped. + The main things grep needs to know about mmap are: + * does it exist and is it safe to write into the mmap'd area + * how to use it (BSD variants) */ + +#include <fcntl.h> +#include <sys/mman.h> + +#if !defined STDC_HEADERS && !defined HAVE_STDLIB_H +char *malloc (); +#endif + +/* This mess was copied from the GNU getpagesize.h. */ +#ifndef HAVE_GETPAGESIZE +# ifdef _SC_PAGESIZE +# define getpagesize() sysconf(_SC_PAGESIZE) +# else /* no _SC_PAGESIZE */ +# ifdef HAVE_SYS_PARAM_H +# include <sys/param.h> +# ifdef EXEC_PAGESIZE +# define getpagesize() EXEC_PAGESIZE +# else /* no EXEC_PAGESIZE */ +# ifdef NBPG +# define getpagesize() NBPG * CLSIZE +# ifndef CLSIZE +# define CLSIZE 1 +# endif /* no CLSIZE */ +# else /* no NBPG */ +# ifdef NBPC +# define getpagesize() NBPC +# else /* no NBPC */ +# ifdef PAGESIZE +# define getpagesize() PAGESIZE +# endif /* PAGESIZE */ +# endif /* no NBPC */ +# endif /* no NBPG */ +# endif /* no EXEC_PAGESIZE */ +# else /* no HAVE_SYS_PARAM_H */ +# define getpagesize() 8192 /* punt totally */ +# endif /* no HAVE_SYS_PARAM_H */ +# endif /* no _SC_PAGESIZE */ + +#endif /* no HAVE_GETPAGESIZE */ + +int +main () +{ + char *data, *data2, *data3; + const char *cdata2; + int i, pagesize; + int fd, fd2; + + pagesize = getpagesize (); + + /* First, make a file with some known garbage in it. */ + data = (char *) malloc (pagesize); + if (!data) + return 1; + for (i = 0; i < pagesize; ++i) + *(data + i) = rand (); + umask (0); + fd = creat ("conftest.mmap", 0600); + if (fd < 0) + return 2; + if (write (fd, data, pagesize) != pagesize) + return 3; + close (fd); + + /* Next, check that the tail of a page is zero-filled. File must have + non-zero length, otherwise we risk SIGBUS for entire page. */ + fd2 = open ("conftest.txt", O_RDWR | O_CREAT | O_TRUNC, 0600); + if (fd2 < 0) + return 4; + cdata2 = ""; + if (write (fd2, cdata2, 1) != 1) + return 5; + data2 = (char *) mmap (0, pagesize, PROT_READ | PROT_WRITE, MAP_SHARED, fd2, 0L); + if (data2 == MAP_FAILED) + return 6; + for (i = 0; i < pagesize; ++i) + if (*(data2 + i)) + return 7; + close (fd2); + if (munmap (data2, pagesize)) + return 8; + + /* Next, try to mmap the file at a fixed address which already has + something else allocated at it. If we can, also make sure that + we see the same garbage. */ + fd = open ("conftest.mmap", O_RDWR); + if (fd < 0) + return 9; + if (data2 != mmap (data2, pagesize, PROT_READ | PROT_WRITE, + MAP_PRIVATE | MAP_FIXED, fd, 0L)) + return 10; + for (i = 0; i < pagesize; ++i) + if (*(data + i) != *(data2 + i)) + return 11; + + /* Finally, make sure that changes to the mapped area do not + percolate back to the file as seen by read(). (This is a bug on + some variants of i386 svr4.0.) */ + for (i = 0; i < pagesize; ++i) + *(data2 + i) = *(data2 + i) + 1; + data3 = (char *) malloc (pagesize); + if (!data3) + return 12; + if (read (fd, data3, pagesize) != pagesize) + return 13; + for (i = 0; i < pagesize; ++i) + if (*(data + i) != *(data3 + i)) + return 14; + close (fd); + return 0; +} +_ACEOF +if ac_fn_c_try_run "$LINENO"; then : + ac_cv_func_mmap_fixed_mapped=yes +else + ac_cv_func_mmap_fixed_mapped=no +fi +rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ + conftest.$ac_objext conftest.beam conftest.$ac_ext +fi + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_func_mmap_fixed_mapped" >&5 +$as_echo "$ac_cv_func_mmap_fixed_mapped" >&6; } +if test $ac_cv_func_mmap_fixed_mapped = yes; then + +$as_echo "#define HAVE_MMAP 1" >>confdefs.h + +fi +rm -f conftest.mmap conftest.txt + + + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether integer division by zero raises SIGFPE" >&5 +$as_echo_n "checking whether integer division by zero raises SIGFPE... " >&6; } +if ${gt_cv_int_divbyzero_sigfpe+:} false; then : + $as_echo_n "(cached) " >&6 +else + + if test "$cross_compiling" = yes; then : + + # Guess based on the CPU. + case "$host_cpu" in + alpha* | i3456786 | m68k | s390*) + gt_cv_int_divbyzero_sigfpe="guessing yes";; + *) + gt_cv_int_divbyzero_sigfpe="guessing no";; + esac + +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +#include <stdlib.h> +#include <signal.h> + +static void +#ifdef __cplusplus +sigfpe_handler (int sig) +#else +sigfpe_handler (sig) int sig; +#endif +{ + /* Exit with code 0 if SIGFPE, with code 1 if any other signal. */ + exit (sig != SIGFPE); +} + +int x = 1; +int y = 0; +int z; +int nan; + +int main () +{ + signal (SIGFPE, sigfpe_handler); +/* IRIX and AIX (when "xlc -qcheck" is used) yield signal SIGTRAP. */ +#if (defined (__sgi) || defined (_AIX)) && defined (SIGTRAP) + signal (SIGTRAP, sigfpe_handler); +#endif +/* Linux/SPARC yields signal SIGILL. */ +#if defined (__sparc__) && defined (__linux__) + signal (SIGILL, sigfpe_handler); +#endif + + z = x / y; + nan = y / y; + exit (1); +} + +_ACEOF +if ac_fn_c_try_run "$LINENO"; then : + gt_cv_int_divbyzero_sigfpe=yes +else + gt_cv_int_divbyzero_sigfpe=no +fi +rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ + conftest.$ac_objext conftest.beam conftest.$ac_ext +fi + + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gt_cv_int_divbyzero_sigfpe" >&5 +$as_echo "$gt_cv_int_divbyzero_sigfpe" >&6; } + case "$gt_cv_int_divbyzero_sigfpe" in + *yes) value=1;; + *) value=0;; + esac + +cat >>confdefs.h <<_ACEOF +#define INTDIV0_RAISES_SIGFPE $value +_ACEOF + + + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for inttypes.h" >&5 +$as_echo_n "checking for inttypes.h... " >&6; } +if ${gl_cv_header_inttypes_h+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <sys/types.h> +#include <inttypes.h> +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +uintmax_t i = (uintmax_t) -1; return !i; + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + gl_cv_header_inttypes_h=yes +else + gl_cv_header_inttypes_h=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_header_inttypes_h" >&5 +$as_echo "$gl_cv_header_inttypes_h" >&6; } + if test $gl_cv_header_inttypes_h = yes; then + +cat >>confdefs.h <<_ACEOF +#define HAVE_INTTYPES_H_WITH_UINTMAX 1 +_ACEOF + + fi + + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for unsigned long long int" >&5 +$as_echo_n "checking for unsigned long long int... " >&6; } +if ${ac_cv_type_unsigned_long_long_int+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +unsigned long long int ull = 18446744073709551615ULL; + typedef int a[(18446744073709551615ULL <= (unsigned long long int) -1 + ? 1 : -1)]; + int i = 63; +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +unsigned long long int ullmax = 18446744073709551615ull; + return (ull << 63 | ull >> 63 | ull << i | ull >> i + | ullmax / ull | ullmax % ull); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_type_unsigned_long_long_int=yes +else + ac_cv_type_unsigned_long_long_int=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_type_unsigned_long_long_int" >&5 +$as_echo "$ac_cv_type_unsigned_long_long_int" >&6; } + if test $ac_cv_type_unsigned_long_long_int = yes; then + +$as_echo "#define HAVE_UNSIGNED_LONG_LONG_INT 1" >>confdefs.h + + fi + + + + ac_cv_type_unsigned_long_long=$ac_cv_type_unsigned_long_long_int + if test $ac_cv_type_unsigned_long_long = yes; then + +$as_echo "#define HAVE_UNSIGNED_LONG_LONG 1" >>confdefs.h + + fi + + + + + if test $gl_cv_header_inttypes_h = no && test $gl_cv_header_stdint_h = no; then + + test $ac_cv_type_unsigned_long_long = yes \ + && ac_type='unsigned long long' \ + || ac_type='unsigned long' + +cat >>confdefs.h <<_ACEOF +#define uintmax_t $ac_type +_ACEOF + + else + +$as_echo "#define HAVE_UINTMAX_T 1" >>confdefs.h + + fi + + + for ac_header in inttypes.h +do : + ac_fn_c_check_header_mongrel "$LINENO" "inttypes.h" "ac_cv_header_inttypes_h" "$ac_includes_default" +if test "x$ac_cv_header_inttypes_h" = xyes; then : + cat >>confdefs.h <<_ACEOF +#define HAVE_INTTYPES_H 1 +_ACEOF + +fi + +done + + if test $ac_cv_header_inttypes_h = yes; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether the inttypes.h PRIxNN macros are broken" >&5 +$as_echo_n "checking whether the inttypes.h PRIxNN macros are broken... " >&6; } +if ${gt_cv_inttypes_pri_broken+:} false; then : + $as_echo_n "(cached) " >&6 +else + + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <inttypes.h> +#ifdef PRId32 +char *p = PRId32; +#endif + +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + gt_cv_inttypes_pri_broken=no +else + gt_cv_inttypes_pri_broken=yes +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gt_cv_inttypes_pri_broken" >&5 +$as_echo "$gt_cv_inttypes_pri_broken" >&6; } + fi + if test "$gt_cv_inttypes_pri_broken" = yes; then + +cat >>confdefs.h <<_ACEOF +#define PRI_MACROS_BROKEN 1 +_ACEOF + + PRI_MACROS_BROKEN=1 + else + PRI_MACROS_BROKEN=0 + fi + + + + + + # Check whether --enable-threads was given. +if test "${enable_threads+set}" = set; then : + enableval=$enable_threads; case "$host_os" in + osf*) gl_use_threads=no ;; + *) gl_use_threads=yes ;; + esac + +fi + + if test "$gl_use_threads" = yes || test "$gl_use_threads" = posix; then + # For using <pthread.h>: + case "$host_os" in + osf*) + # On OSF/1, the compiler needs the flag -D_REENTRANT so that it + # groks <pthread.h>. cc also understands the flag -pthread, but + # we don't use it because 1. gcc-2.95 doesn't understand -pthread, + # 2. putting a flag into CPPFLAGS that has an effect on the linker + # causes the AC_TRY_LINK test below to succeed unexpectedly, + # leading to wrong values of LIBTHREAD and LTLIBTHREAD. + CPPFLAGS="$CPPFLAGS -D_REENTRANT" + ;; + esac + # Some systems optimize for single-threaded programs by default, and + # need special flags to disable these optimizations. For example, the + # definition of 'errno' in <errno.h>. + case "$host_os" in + aix* | freebsd*) CPPFLAGS="$CPPFLAGS -D_THREAD_SAFE" ;; + solaris*) CPPFLAGS="$CPPFLAGS -D_REENTRANT" ;; + esac + fi + + + + + + if test "X$prefix" = "XNONE"; then + acl_final_prefix="$ac_default_prefix" + else + acl_final_prefix="$prefix" + fi + if test "X$exec_prefix" = "XNONE"; then + acl_final_exec_prefix='${prefix}' + else + acl_final_exec_prefix="$exec_prefix" + fi + acl_save_prefix="$prefix" + prefix="$acl_final_prefix" + eval acl_final_exec_prefix=\"$acl_final_exec_prefix\" + prefix="$acl_save_prefix" + + + +# Check whether --with-gnu-ld was given. +if test "${with_gnu_ld+set}" = set; then : + withval=$with_gnu_ld; test "$withval" = no || with_gnu_ld=yes +else + with_gnu_ld=no +fi + +# Prepare PATH_SEPARATOR. +# The user is always right. +if test "${PATH_SEPARATOR+set}" != set; then + # Determine PATH_SEPARATOR by trying to find /bin/sh in a PATH which + # contains only /bin. Note that ksh looks also at the FPATH variable, + # so we have to set that as well for the test. + PATH_SEPARATOR=: + (PATH='/bin;/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 \ + && { (PATH='/bin:/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 \ + || PATH_SEPARATOR=';' + } +fi + +ac_prog=ld +if test "$GCC" = yes; then + # Check if gcc -print-prog-name=ld gives a path. + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for ld used by $CC" >&5 +$as_echo_n "checking for ld used by $CC... " >&6; } + case $host in + *-*-mingw*) + # gcc leaves a trailing carriage return which upsets mingw + ac_prog=`($CC -print-prog-name=ld) 2>&5 | tr -d '\015'` ;; + *) + ac_prog=`($CC -print-prog-name=ld) 2>&5` ;; + esac + case $ac_prog in + # Accept absolute paths. + [\\/]* | ?:[\\/]*) + re_direlt='/[^/][^/]*/\.\./' + # Canonicalize the pathname of ld + ac_prog=`echo "$ac_prog"| sed 's%\\\\%/%g'` + while echo "$ac_prog" | grep "$re_direlt" > /dev/null 2>&1; do + ac_prog=`echo $ac_prog| sed "s%$re_direlt%/%"` + done + test -z "$LD" && LD="$ac_prog" + ;; + "") + # If it fails, then pretend we aren't using GCC. + ac_prog=ld + ;; + *) + # If it is relative, then search for the first ld in PATH. + with_gnu_ld=unknown + ;; + esac +elif test "$with_gnu_ld" = yes; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for GNU ld" >&5 +$as_echo_n "checking for GNU ld... " >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for non-GNU ld" >&5 +$as_echo_n "checking for non-GNU ld... " >&6; } +fi +if ${acl_cv_path_LD+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -z "$LD"; then + acl_save_ifs="$IFS"; IFS=$PATH_SEPARATOR + for ac_dir in $PATH; do + IFS="$acl_save_ifs" + test -z "$ac_dir" && ac_dir=. + if test -f "$ac_dir/$ac_prog" || test -f "$ac_dir/$ac_prog$ac_exeext"; then + acl_cv_path_LD="$ac_dir/$ac_prog" + # Check to see if the program is GNU ld. I'd rather use --version, + # but apparently some variants of GNU ld only accept -v. + # Break only if it was the GNU/non-GNU ld that we prefer. + case `"$acl_cv_path_LD" -v 2>&1 </dev/null` in + *GNU* | *'with BFD'*) + test "$with_gnu_ld" != no && break + ;; + *) + test "$with_gnu_ld" != yes && break + ;; + esac + fi + done + IFS="$acl_save_ifs" +else + acl_cv_path_LD="$LD" # Let the user override the test with a path. +fi +fi + +LD="$acl_cv_path_LD" +if test -n "$LD"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $LD" >&5 +$as_echo "$LD" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi +test -z "$LD" && as_fn_error $? "no acceptable ld found in \$PATH" "$LINENO" 5 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking if the linker ($LD) is GNU ld" >&5 +$as_echo_n "checking if the linker ($LD) is GNU ld... " >&6; } +if ${acl_cv_prog_gnu_ld+:} false; then : + $as_echo_n "(cached) " >&6 +else + # I'd rather use --version here, but apparently some GNU lds only accept -v. +case `$LD -v 2>&1 </dev/null` in +*GNU* | *'with BFD'*) + acl_cv_prog_gnu_ld=yes + ;; +*) + acl_cv_prog_gnu_ld=no + ;; +esac +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $acl_cv_prog_gnu_ld" >&5 +$as_echo "$acl_cv_prog_gnu_ld" >&6; } +with_gnu_ld=$acl_cv_prog_gnu_ld + + + + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for shared library run path origin" >&5 +$as_echo_n "checking for shared library run path origin... " >&6; } +if ${acl_cv_rpath+:} false; then : + $as_echo_n "(cached) " >&6 +else + + CC="$CC" GCC="$GCC" LDFLAGS="$LDFLAGS" LD="$LD" with_gnu_ld="$with_gnu_ld" \ + ${CONFIG_SHELL-/bin/sh} "$ac_aux_dir/config.rpath" "$host" > conftest.sh + . ./conftest.sh + rm -f ./conftest.sh + acl_cv_rpath=done + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $acl_cv_rpath" >&5 +$as_echo "$acl_cv_rpath" >&6; } + wl="$acl_cv_wl" + acl_libext="$acl_cv_libext" + acl_shlibext="$acl_cv_shlibext" + acl_libname_spec="$acl_cv_libname_spec" + acl_library_names_spec="$acl_cv_library_names_spec" + acl_hardcode_libdir_flag_spec="$acl_cv_hardcode_libdir_flag_spec" + acl_hardcode_libdir_separator="$acl_cv_hardcode_libdir_separator" + acl_hardcode_direct="$acl_cv_hardcode_direct" + acl_hardcode_minus_L="$acl_cv_hardcode_minus_L" + # Check whether --enable-rpath was given. +if test "${enable_rpath+set}" = set; then : + enableval=$enable_rpath; : +else + enable_rpath=yes +fi + + + + + acl_libdirstem=lib + acl_libdirstem2= + case "$host_os" in + solaris*) + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for 64-bit host" >&5 +$as_echo_n "checking for 64-bit host... " >&6; } +if ${gl_cv_solaris_64bit+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +#ifdef _LP64 +sixtyfour bits +#endif + +_ACEOF +if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | + $EGREP "sixtyfour bits" >/dev/null 2>&1; then : + gl_cv_solaris_64bit=yes +else + gl_cv_solaris_64bit=no +fi +rm -f conftest* + + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_solaris_64bit" >&5 +$as_echo "$gl_cv_solaris_64bit" >&6; } + if test $gl_cv_solaris_64bit = yes; then + acl_libdirstem=lib/64 + case "$host_cpu" in + sparc*) acl_libdirstem2=lib/sparcv9 ;; + i*86 | x86_64) acl_libdirstem2=lib/amd64 ;; + esac + fi + ;; + *) + searchpath=`(LC_ALL=C $CC -print-search-dirs) 2>/dev/null | sed -n -e 's,^libraries: ,,p' | sed -e 's,^=,,'` + if test -n "$searchpath"; then + acl_save_IFS="${IFS= }"; IFS=":" + for searchdir in $searchpath; do + if test -d "$searchdir"; then + case "$searchdir" in + */lib64/ | */lib64 ) acl_libdirstem=lib64 ;; + */../ | */.. ) + # Better ignore directories of this form. They are misleading. + ;; + *) searchdir=`cd "$searchdir" && pwd` + case "$searchdir" in + */lib64 ) acl_libdirstem=lib64 ;; + esac ;; + esac + fi + done + IFS="$acl_save_IFS" + fi + ;; + esac + test -n "$acl_libdirstem2" || acl_libdirstem2="$acl_libdirstem" + + + + gl_threads_api=none + LIBTHREAD= + LTLIBTHREAD= + LIBMULTITHREAD= + LTLIBMULTITHREAD= + if test "$gl_use_threads" != no; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether imported symbols can be declared weak" >&5 +$as_echo_n "checking whether imported symbols can be declared weak... " >&6; } + gl_have_weak=no + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +extern void xyzzy (); +#pragma weak xyzzy +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +xyzzy(); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + gl_have_weak=yes +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_have_weak" >&5 +$as_echo "$gl_have_weak" >&6; } + if test "$gl_use_threads" = yes || test "$gl_use_threads" = posix; then + # On OSF/1, the compiler needs the flag -pthread or -D_REENTRANT so that + # it groks <pthread.h>. It's added above, in gl_LOCK_EARLY_BODY. + ac_fn_c_check_header_mongrel "$LINENO" "pthread.h" "ac_cv_header_pthread_h" "$ac_includes_default" +if test "x$ac_cv_header_pthread_h" = xyes; then : + gl_have_pthread_h=yes +else + gl_have_pthread_h=no +fi + + + if test "$gl_have_pthread_h" = yes; then + # Other possible tests: + # -lpthreads (FSU threads, PCthreads) + # -lgthreads + gl_have_pthread= + # Test whether both pthread_mutex_lock and pthread_mutexattr_init exist + # in libc. IRIX 6.5 has the first one in both libc and libpthread, but + # the second one only in libpthread, and lock.c needs it. + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <pthread.h> +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +pthread_mutex_lock((pthread_mutex_t*)0); + pthread_mutexattr_init((pthread_mutexattr_t*)0); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + gl_have_pthread=yes +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + # Test for libpthread by looking for pthread_kill. (Not pthread_self, + # since it is defined as a macro on OSF/1.) + if test -n "$gl_have_pthread"; then + # The program links fine without libpthread. But it may actually + # need to link with libpthread in order to create multiple threads. + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for pthread_kill in -lpthread" >&5 +$as_echo_n "checking for pthread_kill in -lpthread... " >&6; } +if ${ac_cv_lib_pthread_pthread_kill+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lpthread $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char pthread_kill (); +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +return pthread_kill (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_pthread_pthread_kill=yes +else + ac_cv_lib_pthread_pthread_kill=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_pthread_pthread_kill" >&5 +$as_echo "$ac_cv_lib_pthread_pthread_kill" >&6; } +if test "x$ac_cv_lib_pthread_pthread_kill" = xyes; then : + LIBMULTITHREAD=-lpthread LTLIBMULTITHREAD=-lpthread + # On Solaris and HP-UX, most pthread functions exist also in libc. + # Therefore pthread_in_use() needs to actually try to create a + # thread: pthread_create from libc will fail, whereas + # pthread_create will actually create a thread. + case "$host_os" in + solaris* | hpux*) + +$as_echo "#define PTHREAD_IN_USE_DETECTION_HARD 1" >>confdefs.h + + esac + +fi + + else + # Some library is needed. Try libpthread and libc_r. + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for pthread_kill in -lpthread" >&5 +$as_echo_n "checking for pthread_kill in -lpthread... " >&6; } +if ${ac_cv_lib_pthread_pthread_kill+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lpthread $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char pthread_kill (); +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +return pthread_kill (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_pthread_pthread_kill=yes +else + ac_cv_lib_pthread_pthread_kill=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_pthread_pthread_kill" >&5 +$as_echo "$ac_cv_lib_pthread_pthread_kill" >&6; } +if test "x$ac_cv_lib_pthread_pthread_kill" = xyes; then : + gl_have_pthread=yes + LIBTHREAD=-lpthread LTLIBTHREAD=-lpthread + LIBMULTITHREAD=-lpthread LTLIBMULTITHREAD=-lpthread +fi + + if test -z "$gl_have_pthread"; then + # For FreeBSD 4. + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for pthread_kill in -lc_r" >&5 +$as_echo_n "checking for pthread_kill in -lc_r... " >&6; } +if ${ac_cv_lib_c_r_pthread_kill+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lc_r $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char pthread_kill (); +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +return pthread_kill (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_c_r_pthread_kill=yes +else + ac_cv_lib_c_r_pthread_kill=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_c_r_pthread_kill" >&5 +$as_echo "$ac_cv_lib_c_r_pthread_kill" >&6; } +if test "x$ac_cv_lib_c_r_pthread_kill" = xyes; then : + gl_have_pthread=yes + LIBTHREAD=-lc_r LTLIBTHREAD=-lc_r + LIBMULTITHREAD=-lc_r LTLIBMULTITHREAD=-lc_r +fi + + fi + fi + if test -n "$gl_have_pthread"; then + gl_threads_api=posix + +$as_echo "#define USE_POSIX_THREADS 1" >>confdefs.h + + if test -n "$LIBMULTITHREAD" || test -n "$LTLIBMULTITHREAD"; then + if test $gl_have_weak = yes; then + +$as_echo "#define USE_POSIX_THREADS_WEAK 1" >>confdefs.h + + LIBTHREAD= + LTLIBTHREAD= + fi + fi + # OSF/1 4.0 and OS X 10.1 lack the pthread_rwlock_t type and the + # pthread_rwlock_* functions. + ac_fn_c_check_type "$LINENO" "pthread_rwlock_t" "ac_cv_type_pthread_rwlock_t" "#include <pthread.h> +" +if test "x$ac_cv_type_pthread_rwlock_t" = xyes; then : + +$as_echo "#define HAVE_PTHREAD_RWLOCK 1" >>confdefs.h + +fi + + # glibc defines PTHREAD_MUTEX_RECURSIVE as enum, not as a macro. + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <pthread.h> +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +#if __FreeBSD__ == 4 +error "No, in FreeBSD 4.0 recursive mutexes actually don't work." +#else +int x = (int)PTHREAD_MUTEX_RECURSIVE; +return !x; +#endif + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + +$as_echo "#define HAVE_PTHREAD_MUTEX_RECURSIVE 1" >>confdefs.h + +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + fi + fi + fi + if test -z "$gl_have_pthread"; then + if test "$gl_use_threads" = yes || test "$gl_use_threads" = solaris; then + gl_have_solaristhread= + gl_save_LIBS="$LIBS" + LIBS="$LIBS -lthread" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <thread.h> +#include <synch.h> +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +thr_self(); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + gl_have_solaristhread=yes +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + LIBS="$gl_save_LIBS" + if test -n "$gl_have_solaristhread"; then + gl_threads_api=solaris + LIBTHREAD=-lthread + LTLIBTHREAD=-lthread + LIBMULTITHREAD="$LIBTHREAD" + LTLIBMULTITHREAD="$LTLIBTHREAD" + +$as_echo "#define USE_SOLARIS_THREADS 1" >>confdefs.h + + if test $gl_have_weak = yes; then + +$as_echo "#define USE_SOLARIS_THREADS_WEAK 1" >>confdefs.h + + LIBTHREAD= + LTLIBTHREAD= + fi + fi + fi + fi + if test "$gl_use_threads" = pth; then + gl_save_CPPFLAGS="$CPPFLAGS" + + + + + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking how to link with libpth" >&5 +$as_echo_n "checking how to link with libpth... " >&6; } +if ${ac_cv_libpth_libs+:} false; then : + $as_echo_n "(cached) " >&6 +else + + + + + + + + + use_additional=yes + + acl_save_prefix="$prefix" + prefix="$acl_final_prefix" + acl_save_exec_prefix="$exec_prefix" + exec_prefix="$acl_final_exec_prefix" + + eval additional_includedir=\"$includedir\" + eval additional_libdir=\"$libdir\" + + exec_prefix="$acl_save_exec_prefix" + prefix="$acl_save_prefix" + + +# Check whether --with-libpth-prefix was given. +if test "${with_libpth_prefix+set}" = set; then : + withval=$with_libpth_prefix; + if test "X$withval" = "Xno"; then + use_additional=no + else + if test "X$withval" = "X"; then + + acl_save_prefix="$prefix" + prefix="$acl_final_prefix" + acl_save_exec_prefix="$exec_prefix" + exec_prefix="$acl_final_exec_prefix" + + eval additional_includedir=\"$includedir\" + eval additional_libdir=\"$libdir\" + + exec_prefix="$acl_save_exec_prefix" + prefix="$acl_save_prefix" + + else + additional_includedir="$withval/include" + additional_libdir="$withval/$acl_libdirstem" + if test "$acl_libdirstem2" != "$acl_libdirstem" \ + && ! test -d "$withval/$acl_libdirstem"; then + additional_libdir="$withval/$acl_libdirstem2" + fi + fi + fi + +fi + + LIBPTH= + LTLIBPTH= + INCPTH= + LIBPTH_PREFIX= + HAVE_LIBPTH= + rpathdirs= + ltrpathdirs= + names_already_handled= + names_next_round='pth ' + while test -n "$names_next_round"; do + names_this_round="$names_next_round" + names_next_round= + for name in $names_this_round; do + already_handled= + for n in $names_already_handled; do + if test "$n" = "$name"; then + already_handled=yes + break + fi + done + if test -z "$already_handled"; then + names_already_handled="$names_already_handled $name" + uppername=`echo "$name" | sed -e 'y|abcdefghijklmnopqrstuvwxyz./+-|ABCDEFGHIJKLMNOPQRSTUVWXYZ____|'` + eval value=\"\$HAVE_LIB$uppername\" + if test -n "$value"; then + if test "$value" = yes; then + eval value=\"\$LIB$uppername\" + test -z "$value" || LIBPTH="${LIBPTH}${LIBPTH:+ }$value" + eval value=\"\$LTLIB$uppername\" + test -z "$value" || LTLIBPTH="${LTLIBPTH}${LTLIBPTH:+ }$value" + else + : + fi + else + found_dir= + found_la= + found_so= + found_a= + eval libname=\"$acl_libname_spec\" # typically: libname=lib$name + if test -n "$acl_shlibext"; then + shrext=".$acl_shlibext" # typically: shrext=.so + else + shrext= + fi + if test $use_additional = yes; then + dir="$additional_libdir" + if test -n "$acl_shlibext"; then + if test -f "$dir/$libname$shrext"; then + found_dir="$dir" + found_so="$dir/$libname$shrext" + else + if test "$acl_library_names_spec" = '$libname$shrext$versuffix'; then + ver=`(cd "$dir" && \ + for f in "$libname$shrext".*; do echo "$f"; done \ + | sed -e "s,^$libname$shrext\\\\.,," \ + | sort -t '.' -n -r -k1,1 -k2,2 -k3,3 -k4,4 -k5,5 \ + | sed 1q ) 2>/dev/null` + if test -n "$ver" && test -f "$dir/$libname$shrext.$ver"; then + found_dir="$dir" + found_so="$dir/$libname$shrext.$ver" + fi + else + eval library_names=\"$acl_library_names_spec\" + for f in $library_names; do + if test -f "$dir/$f"; then + found_dir="$dir" + found_so="$dir/$f" + break + fi + done + fi + fi + fi + if test "X$found_dir" = "X"; then + if test -f "$dir/$libname.$acl_libext"; then + found_dir="$dir" + found_a="$dir/$libname.$acl_libext" + fi + fi + if test "X$found_dir" != "X"; then + if test -f "$dir/$libname.la"; then + found_la="$dir/$libname.la" + fi + fi + fi + if test "X$found_dir" = "X"; then + for x in $LDFLAGS $LTLIBPTH; do + + acl_save_prefix="$prefix" + prefix="$acl_final_prefix" + acl_save_exec_prefix="$exec_prefix" + exec_prefix="$acl_final_exec_prefix" + eval x=\"$x\" + exec_prefix="$acl_save_exec_prefix" + prefix="$acl_save_prefix" + + case "$x" in + -L*) + dir=`echo "X$x" | sed -e 's/^X-L//'` + if test -n "$acl_shlibext"; then + if test -f "$dir/$libname$shrext"; then + found_dir="$dir" + found_so="$dir/$libname$shrext" + else + if test "$acl_library_names_spec" = '$libname$shrext$versuffix'; then + ver=`(cd "$dir" && \ + for f in "$libname$shrext".*; do echo "$f"; done \ + | sed -e "s,^$libname$shrext\\\\.,," \ + | sort -t '.' -n -r -k1,1 -k2,2 -k3,3 -k4,4 -k5,5 \ + | sed 1q ) 2>/dev/null` + if test -n "$ver" && test -f "$dir/$libname$shrext.$ver"; then + found_dir="$dir" + found_so="$dir/$libname$shrext.$ver" + fi + else + eval library_names=\"$acl_library_names_spec\" + for f in $library_names; do + if test -f "$dir/$f"; then + found_dir="$dir" + found_so="$dir/$f" + break + fi + done + fi + fi + fi + if test "X$found_dir" = "X"; then + if test -f "$dir/$libname.$acl_libext"; then + found_dir="$dir" + found_a="$dir/$libname.$acl_libext" + fi + fi + if test "X$found_dir" != "X"; then + if test -f "$dir/$libname.la"; then + found_la="$dir/$libname.la" + fi + fi + ;; + esac + if test "X$found_dir" != "X"; then + break + fi + done + fi + if test "X$found_dir" != "X"; then + LTLIBPTH="${LTLIBPTH}${LTLIBPTH:+ }-L$found_dir -l$name" + if test "X$found_so" != "X"; then + if test "$enable_rpath" = no \ + || test "X$found_dir" = "X/usr/$acl_libdirstem" \ + || test "X$found_dir" = "X/usr/$acl_libdirstem2"; then + LIBPTH="${LIBPTH}${LIBPTH:+ }$found_so" + else + haveit= + for x in $ltrpathdirs; do + if test "X$x" = "X$found_dir"; then + haveit=yes + break + fi + done + if test -z "$haveit"; then + ltrpathdirs="$ltrpathdirs $found_dir" + fi + if test "$acl_hardcode_direct" = yes; then + LIBPTH="${LIBPTH}${LIBPTH:+ }$found_so" + else + if test -n "$acl_hardcode_libdir_flag_spec" && test "$acl_hardcode_minus_L" = no; then + LIBPTH="${LIBPTH}${LIBPTH:+ }$found_so" + haveit= + for x in $rpathdirs; do + if test "X$x" = "X$found_dir"; then + haveit=yes + break + fi + done + if test -z "$haveit"; then + rpathdirs="$rpathdirs $found_dir" + fi + else + haveit= + for x in $LDFLAGS $LIBPTH; do + + acl_save_prefix="$prefix" + prefix="$acl_final_prefix" + acl_save_exec_prefix="$exec_prefix" + exec_prefix="$acl_final_exec_prefix" + eval x=\"$x\" + exec_prefix="$acl_save_exec_prefix" + prefix="$acl_save_prefix" + + if test "X$x" = "X-L$found_dir"; then + haveit=yes + break + fi + done + if test -z "$haveit"; then + LIBPTH="${LIBPTH}${LIBPTH:+ }-L$found_dir" + fi + if test "$acl_hardcode_minus_L" != no; then + LIBPTH="${LIBPTH}${LIBPTH:+ }$found_so" + else + LIBPTH="${LIBPTH}${LIBPTH:+ }-l$name" + fi + fi + fi + fi + else + if test "X$found_a" != "X"; then + LIBPTH="${LIBPTH}${LIBPTH:+ }$found_a" + else + LIBPTH="${LIBPTH}${LIBPTH:+ }-L$found_dir -l$name" + fi + fi + additional_includedir= + case "$found_dir" in + */$acl_libdirstem | */$acl_libdirstem/) + basedir=`echo "X$found_dir" | sed -e 's,^X,,' -e "s,/$acl_libdirstem/"'*$,,'` + if test "$name" = 'pth'; then + LIBPTH_PREFIX="$basedir" + fi + additional_includedir="$basedir/include" + ;; + */$acl_libdirstem2 | */$acl_libdirstem2/) + basedir=`echo "X$found_dir" | sed -e 's,^X,,' -e "s,/$acl_libdirstem2/"'*$,,'` + if test "$name" = 'pth'; then + LIBPTH_PREFIX="$basedir" + fi + additional_includedir="$basedir/include" + ;; + esac + if test "X$additional_includedir" != "X"; then + if test "X$additional_includedir" != "X/usr/include"; then + haveit= + if test "X$additional_includedir" = "X/usr/local/include"; then + if test -n "$GCC"; then + case $host_os in + linux* | gnu* | k*bsd*-gnu) haveit=yes;; + esac + fi + fi + if test -z "$haveit"; then + for x in $CPPFLAGS $INCPTH; do + + acl_save_prefix="$prefix" + prefix="$acl_final_prefix" + acl_save_exec_prefix="$exec_prefix" + exec_prefix="$acl_final_exec_prefix" + eval x=\"$x\" + exec_prefix="$acl_save_exec_prefix" + prefix="$acl_save_prefix" + + if test "X$x" = "X-I$additional_includedir"; then + haveit=yes + break + fi + done + if test -z "$haveit"; then + if test -d "$additional_includedir"; then + INCPTH="${INCPTH}${INCPTH:+ }-I$additional_includedir" + fi + fi + fi + fi + fi + if test -n "$found_la"; then + save_libdir="$libdir" + case "$found_la" in + */* | *\\*) . "$found_la" ;; + *) . "./$found_la" ;; + esac + libdir="$save_libdir" + for dep in $dependency_libs; do + case "$dep" in + -L*) + additional_libdir=`echo "X$dep" | sed -e 's/^X-L//'` + if test "X$additional_libdir" != "X/usr/$acl_libdirstem" \ + && test "X$additional_libdir" != "X/usr/$acl_libdirstem2"; then + haveit= + if test "X$additional_libdir" = "X/usr/local/$acl_libdirstem" \ + || test "X$additional_libdir" = "X/usr/local/$acl_libdirstem2"; then + if test -n "$GCC"; then + case $host_os in + linux* | gnu* | k*bsd*-gnu) haveit=yes;; + esac + fi + fi + if test -z "$haveit"; then + haveit= + for x in $LDFLAGS $LIBPTH; do + + acl_save_prefix="$prefix" + prefix="$acl_final_prefix" + acl_save_exec_prefix="$exec_prefix" + exec_prefix="$acl_final_exec_prefix" + eval x=\"$x\" + exec_prefix="$acl_save_exec_prefix" + prefix="$acl_save_prefix" + + if test "X$x" = "X-L$additional_libdir"; then + haveit=yes + break + fi + done + if test -z "$haveit"; then + if test -d "$additional_libdir"; then + LIBPTH="${LIBPTH}${LIBPTH:+ }-L$additional_libdir" + fi + fi + haveit= + for x in $LDFLAGS $LTLIBPTH; do + + acl_save_prefix="$prefix" + prefix="$acl_final_prefix" + acl_save_exec_prefix="$exec_prefix" + exec_prefix="$acl_final_exec_prefix" + eval x=\"$x\" + exec_prefix="$acl_save_exec_prefix" + prefix="$acl_save_prefix" + + if test "X$x" = "X-L$additional_libdir"; then + haveit=yes + break + fi + done + if test -z "$haveit"; then + if test -d "$additional_libdir"; then + LTLIBPTH="${LTLIBPTH}${LTLIBPTH:+ }-L$additional_libdir" + fi + fi + fi + fi + ;; + -R*) + dir=`echo "X$dep" | sed -e 's/^X-R//'` + if test "$enable_rpath" != no; then + haveit= + for x in $rpathdirs; do + if test "X$x" = "X$dir"; then + haveit=yes + break + fi + done + if test -z "$haveit"; then + rpathdirs="$rpathdirs $dir" + fi + haveit= + for x in $ltrpathdirs; do + if test "X$x" = "X$dir"; then + haveit=yes + break + fi + done + if test -z "$haveit"; then + ltrpathdirs="$ltrpathdirs $dir" + fi + fi + ;; + -l*) + names_next_round="$names_next_round "`echo "X$dep" | sed -e 's/^X-l//'` + ;; + *.la) + names_next_round="$names_next_round "`echo "X$dep" | sed -e 's,^X.*/,,' -e 's,^lib,,' -e 's,\.la$,,'` + ;; + *) + LIBPTH="${LIBPTH}${LIBPTH:+ }$dep" + LTLIBPTH="${LTLIBPTH}${LTLIBPTH:+ }$dep" + ;; + esac + done + fi + else + LIBPTH="${LIBPTH}${LIBPTH:+ }-l$name" + LTLIBPTH="${LTLIBPTH}${LTLIBPTH:+ }-l$name" + fi + fi + fi + done + done + if test "X$rpathdirs" != "X"; then + if test -n "$acl_hardcode_libdir_separator"; then + alldirs= + for found_dir in $rpathdirs; do + alldirs="${alldirs}${alldirs:+$acl_hardcode_libdir_separator}$found_dir" + done + acl_save_libdir="$libdir" + libdir="$alldirs" + eval flag=\"$acl_hardcode_libdir_flag_spec\" + libdir="$acl_save_libdir" + LIBPTH="${LIBPTH}${LIBPTH:+ }$flag" + else + for found_dir in $rpathdirs; do + acl_save_libdir="$libdir" + libdir="$found_dir" + eval flag=\"$acl_hardcode_libdir_flag_spec\" + libdir="$acl_save_libdir" + LIBPTH="${LIBPTH}${LIBPTH:+ }$flag" + done + fi + fi + if test "X$ltrpathdirs" != "X"; then + for found_dir in $ltrpathdirs; do + LTLIBPTH="${LTLIBPTH}${LTLIBPTH:+ }-R$found_dir" + done + fi + + + + + + + ac_cv_libpth_libs="$LIBPTH" + ac_cv_libpth_ltlibs="$LTLIBPTH" + ac_cv_libpth_cppflags="$INCPTH" + ac_cv_libpth_prefix="$LIBPTH_PREFIX" + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_libpth_libs" >&5 +$as_echo "$ac_cv_libpth_libs" >&6; } + LIBPTH="$ac_cv_libpth_libs" + LTLIBPTH="$ac_cv_libpth_ltlibs" + INCPTH="$ac_cv_libpth_cppflags" + LIBPTH_PREFIX="$ac_cv_libpth_prefix" + + for element in $INCPTH; do + haveit= + for x in $CPPFLAGS; do + + acl_save_prefix="$prefix" + prefix="$acl_final_prefix" + acl_save_exec_prefix="$exec_prefix" + exec_prefix="$acl_final_exec_prefix" + eval x=\"$x\" + exec_prefix="$acl_save_exec_prefix" + prefix="$acl_save_prefix" + + if test "X$x" = "X$element"; then + haveit=yes + break + fi + done + if test -z "$haveit"; then + CPPFLAGS="${CPPFLAGS}${CPPFLAGS:+ }$element" + fi + done + + + + + HAVE_LIBPTH=yes + + + + gl_have_pth= + gl_save_LIBS="$LIBS" + LIBS="$LIBS -lpth" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <pth.h> +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +pth_self(); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + gl_have_pth=yes +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + LIBS="$gl_save_LIBS" + if test -n "$gl_have_pth"; then + gl_threads_api=pth + LIBTHREAD="$LIBPTH" + LTLIBTHREAD="$LTLIBPTH" + LIBMULTITHREAD="$LIBTHREAD" + LTLIBMULTITHREAD="$LTLIBTHREAD" + +$as_echo "#define USE_PTH_THREADS 1" >>confdefs.h + + if test -n "$LIBMULTITHREAD" || test -n "$LTLIBMULTITHREAD"; then + if test $gl_have_weak = yes; then + +$as_echo "#define USE_PTH_THREADS_WEAK 1" >>confdefs.h + + LIBTHREAD= + LTLIBTHREAD= + fi + fi + else + CPPFLAGS="$gl_save_CPPFLAGS" + fi + fi + if test -z "$gl_have_pthread"; then + if test "$gl_use_threads" = yes || test "$gl_use_threads" = win32; then + if { case "$host_os" in + mingw*) true;; + *) false;; + esac + }; then + gl_threads_api=win32 + +$as_echo "#define USE_WIN32_THREADS 1" >>confdefs.h + + fi + fi + fi + fi + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for multithread API to use" >&5 +$as_echo_n "checking for multithread API to use... " >&6; } + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_threads_api" >&5 +$as_echo "$gl_threads_api" >&6; } + + + + + + + + + + + + + + + + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +int foo (int a) { a = __builtin_expect (a, 10); return a == 10 ? 0 : 1; } +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + +$as_echo "#define HAVE_BUILTIN_EXPECT 1" >>confdefs.h + +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + + for ac_header in argz.h inttypes.h limits.h unistd.h sys/param.h +do : + as_ac_Header=`$as_echo "ac_cv_header_$ac_header" | $as_tr_sh` +ac_fn_c_check_header_mongrel "$LINENO" "$ac_header" "$as_ac_Header" "$ac_includes_default" +if eval test \"x\$"$as_ac_Header"\" = x"yes"; then : + cat >>confdefs.h <<_ACEOF +#define `$as_echo "HAVE_$ac_header" | $as_tr_cpp` 1 +_ACEOF + +fi + +done + + for ac_func in getcwd getegid geteuid getgid getuid mempcpy munmap \ + stpcpy strcasecmp strdup strtoul tsearch argz_count argz_stringify \ + argz_next __fsetlocking +do : + as_ac_var=`$as_echo "ac_cv_func_$ac_func" | $as_tr_sh` +ac_fn_c_check_func "$LINENO" "$ac_func" "$as_ac_var" +if eval test \"x\$"$as_ac_var"\" = x"yes"; then : + cat >>confdefs.h <<_ACEOF +#define `$as_echo "HAVE_$ac_func" | $as_tr_cpp` 1 +_ACEOF + +fi +done + + + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether feof_unlocked is declared" >&5 +$as_echo_n "checking whether feof_unlocked is declared... " >&6; } +if ${ac_cv_have_decl_feof_unlocked+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <stdio.h> +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ + +#ifndef feof_unlocked + char *p = (char *) feof_unlocked; +#endif + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_cv_have_decl_feof_unlocked=yes +else + ac_cv_have_decl_feof_unlocked=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_have_decl_feof_unlocked" >&5 +$as_echo "$ac_cv_have_decl_feof_unlocked" >&6; } + if test $ac_cv_have_decl_feof_unlocked = yes; then + gt_value=1 + else + gt_value=0 + fi + +cat >>confdefs.h <<_ACEOF +#define HAVE_DECL_FEOF_UNLOCKED $gt_value +_ACEOF + + + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether fgets_unlocked is declared" >&5 +$as_echo_n "checking whether fgets_unlocked is declared... " >&6; } +if ${ac_cv_have_decl_fgets_unlocked+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <stdio.h> +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ + +#ifndef fgets_unlocked + char *p = (char *) fgets_unlocked; +#endif + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_cv_have_decl_fgets_unlocked=yes +else + ac_cv_have_decl_fgets_unlocked=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_have_decl_fgets_unlocked" >&5 +$as_echo "$ac_cv_have_decl_fgets_unlocked" >&6; } + if test $ac_cv_have_decl_fgets_unlocked = yes; then + gt_value=1 + else + gt_value=0 + fi + +cat >>confdefs.h <<_ACEOF +#define HAVE_DECL_FGETS_UNLOCKED $gt_value +_ACEOF + + + + + + + + am_save_CPPFLAGS="$CPPFLAGS" + + for element in $INCICONV; do + haveit= + for x in $CPPFLAGS; do + + acl_save_prefix="$prefix" + prefix="$acl_final_prefix" + acl_save_exec_prefix="$exec_prefix" + exec_prefix="$acl_final_exec_prefix" + eval x=\"$x\" + exec_prefix="$acl_save_exec_prefix" + prefix="$acl_save_prefix" + + if test "X$x" = "X$element"; then + haveit=yes + break + fi + done + if test -z "$haveit"; then + CPPFLAGS="${CPPFLAGS}${CPPFLAGS:+ }$element" + fi + done + + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for iconv" >&5 +$as_echo_n "checking for iconv... " >&6; } +if ${am_cv_func_iconv+:} false; then : + $as_echo_n "(cached) " >&6 +else + + am_cv_func_iconv="no, consider installing GNU libiconv" + am_cv_lib_iconv=no + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <stdlib.h> +#include <iconv.h> +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +iconv_t cd = iconv_open("",""); + iconv(cd,NULL,NULL,NULL,NULL); + iconv_close(cd); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + am_cv_func_iconv=yes +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + if test "$am_cv_func_iconv" != yes; then + am_save_LIBS="$LIBS" + LIBS="$LIBS $LIBICONV" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <stdlib.h> +#include <iconv.h> +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +iconv_t cd = iconv_open("",""); + iconv(cd,NULL,NULL,NULL,NULL); + iconv_close(cd); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + am_cv_lib_iconv=yes + am_cv_func_iconv=yes +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + LIBS="$am_save_LIBS" + fi + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $am_cv_func_iconv" >&5 +$as_echo "$am_cv_func_iconv" >&6; } + if test "$am_cv_func_iconv" = yes; then + +$as_echo "#define HAVE_ICONV 1" >>confdefs.h + + fi + if test "$am_cv_lib_iconv" = yes; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking how to link with libiconv" >&5 +$as_echo_n "checking how to link with libiconv... " >&6; } + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $LIBICONV" >&5 +$as_echo "$LIBICONV" >&6; } + else + CPPFLAGS="$am_save_CPPFLAGS" + LIBICONV= + LTLIBICONV= + fi + + + + if test "$am_cv_func_iconv" = yes; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for iconv declaration" >&5 +$as_echo_n "checking for iconv declaration... " >&6; } + if ${am_cv_proto_iconv+:} false; then : + $as_echo_n "(cached) " >&6 +else + + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +#include <stdlib.h> +#include <iconv.h> +extern +#ifdef __cplusplus +"C" +#endif +#if defined(__STDC__) || defined(__cplusplus) +size_t iconv (iconv_t cd, char * *inbuf, size_t *inbytesleft, char * *outbuf, size_t *outbytesleft); +#else +size_t iconv(); +#endif + +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + am_cv_proto_iconv_arg1="" +else + am_cv_proto_iconv_arg1="const" +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + am_cv_proto_iconv="extern size_t iconv (iconv_t cd, $am_cv_proto_iconv_arg1 char * *inbuf, size_t *inbytesleft, char * *outbuf, size_t *outbytesleft);" +fi + + am_cv_proto_iconv=`echo "$am_cv_proto_iconv" | tr -s ' ' | sed -e 's/( /(/'` + { $as_echo "$as_me:${as_lineno-$LINENO}: result: ${ac_t:- + }$am_cv_proto_iconv" >&5 +$as_echo "${ac_t:- + }$am_cv_proto_iconv" >&6; } + +cat >>confdefs.h <<_ACEOF +#define ICONV_CONST $am_cv_proto_iconv_arg1 +_ACEOF + + fi + + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for NL_LOCALE_NAME macro" >&5 +$as_echo_n "checking for NL_LOCALE_NAME macro... " >&6; } +if ${gt_cv_nl_locale_name+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <langinfo.h> +#include <locale.h> +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +char* cs = nl_langinfo(_NL_LOCALE_NAME(LC_MESSAGES)); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + gt_cv_nl_locale_name=yes +else + gt_cv_nl_locale_name=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gt_cv_nl_locale_name" >&5 +$as_echo "$gt_cv_nl_locale_name" >&6; } + if test $gt_cv_nl_locale_name = yes; then + +$as_echo "#define HAVE_NL_LOCALE_NAME 1" >>confdefs.h + + fi + + for ac_prog in bison +do + # Extract the first word of "$ac_prog", so it can be a program name with args. +set dummy $ac_prog; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_INTLBISON+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$INTLBISON"; then + ac_cv_prog_INTLBISON="$INTLBISON" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_INTLBISON="$ac_prog" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +INTLBISON=$ac_cv_prog_INTLBISON +if test -n "$INTLBISON"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $INTLBISON" >&5 +$as_echo "$INTLBISON" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + test -n "$INTLBISON" && break +done + + if test -z "$INTLBISON"; then + ac_verc_fail=yes + else + { $as_echo "$as_me:${as_lineno-$LINENO}: checking version of bison" >&5 +$as_echo_n "checking version of bison... " >&6; } + ac_prog_version=`$INTLBISON --version 2>&1 | sed -n 's/^.*GNU Bison.* \([0-9]*\.[0-9.]*\).*$/\1/p'` + case $ac_prog_version in + '') ac_prog_version="v. ?.??, bad"; ac_verc_fail=yes;; + 1.2[6-9]* | 1.[3-9][0-9]* | [2-9].*) + ac_prog_version="$ac_prog_version, ok"; ac_verc_fail=no;; + *) ac_prog_version="$ac_prog_version, bad"; ac_verc_fail=yes;; + esac + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_prog_version" >&5 +$as_echo "$ac_prog_version" >&6; } + fi + if test $ac_verc_fail = yes; then + INTLBISON=: + fi + + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for long long int" >&5 +$as_echo_n "checking for long long int... " >&6; } +if ${ac_cv_type_long_long_int+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +long long int ll = 9223372036854775807ll; + long long int nll = -9223372036854775807LL; + typedef int a[((-9223372036854775807LL < 0 + && 0 < 9223372036854775807ll) + ? 1 : -1)]; + int i = 63; +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +long long int llmax = 9223372036854775807ll; + return ((ll << 63) | (ll >> 63) | (ll < i) | (ll > i) + | (llmax / ll) | (llmax % ll)); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_type_long_long_int=yes +else + ac_cv_type_long_long_int=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_type_long_long_int" >&5 +$as_echo "$ac_cv_type_long_long_int" >&6; } + if test $ac_cv_type_long_long_int = yes; then + +$as_echo "#define HAVE_LONG_LONG_INT 1" >>confdefs.h + + fi + + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for long double" >&5 +$as_echo_n "checking for long double... " >&6; } +if ${gt_cv_c_long_double+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test "$GCC" = yes; then + gt_cv_c_long_double=yes + else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + + /* The Stardent Vistra knows sizeof(long double), but does not support it. */ + long double foo = 0.0; + /* On Ultrix 4.3 cc, long double is 4 and double is 8. */ + int array [2*(sizeof(long double) >= sizeof(double)) - 1]; + +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + gt_cv_c_long_double=yes +else + gt_cv_c_long_double=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + fi +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gt_cv_c_long_double" >&5 +$as_echo "$gt_cv_c_long_double" >&6; } + + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for wchar_t" >&5 +$as_echo_n "checking for wchar_t... " >&6; } +if ${gt_cv_c_wchar_t+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <stddef.h> + wchar_t foo = (wchar_t)'\0'; +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + gt_cv_c_wchar_t=yes +else + gt_cv_c_wchar_t=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gt_cv_c_wchar_t" >&5 +$as_echo "$gt_cv_c_wchar_t" >&6; } + if test $gt_cv_c_wchar_t = yes; then + +$as_echo "#define HAVE_WCHAR_T 1" >>confdefs.h + + fi + + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for wint_t" >&5 +$as_echo_n "checking for wint_t... " >&6; } +if ${gt_cv_c_wint_t+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <wchar.h> + wint_t foo = (wchar_t)'\0'; +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + gt_cv_c_wint_t=yes +else + gt_cv_c_wint_t=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gt_cv_c_wint_t" >&5 +$as_echo "$gt_cv_c_wint_t" >&6; } + if test $gt_cv_c_wint_t = yes; then + +$as_echo "#define HAVE_WINT_T 1" >>confdefs.h + + fi + + + + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for intmax_t" >&5 +$as_echo_n "checking for intmax_t... " >&6; } +if ${gt_cv_c_intmax_t+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +#include <stddef.h> +#include <stdlib.h> +#if HAVE_STDINT_H_WITH_UINTMAX +#include <stdint.h> +#endif +#if HAVE_INTTYPES_H_WITH_UINTMAX +#include <inttypes.h> +#endif + +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +intmax_t x = -1; + return !x; + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + gt_cv_c_intmax_t=yes +else + gt_cv_c_intmax_t=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gt_cv_c_intmax_t" >&5 +$as_echo "$gt_cv_c_intmax_t" >&6; } + if test $gt_cv_c_intmax_t = yes; then + +$as_echo "#define HAVE_INTMAX_T 1" >>confdefs.h + + fi + + + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether printf() supports POSIX/XSI format strings" >&5 +$as_echo_n "checking whether printf() supports POSIX/XSI format strings... " >&6; } +if ${gt_cv_func_printf_posix+:} false; then : + $as_echo_n "(cached) " >&6 +else + + if test "$cross_compiling" = yes; then : + + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +#if defined __NetBSD__ || defined _MSC_VER || defined __MINGW32__ || defined __CYGWIN__ + notposix +#endif + +_ACEOF +if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | + $EGREP "notposix" >/dev/null 2>&1; then : + gt_cv_func_printf_posix="guessing no" +else + gt_cv_func_printf_posix="guessing yes" +fi +rm -f conftest* + + +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +#include <stdio.h> +#include <string.h> +/* The string "%2$d %1$d", with dollar characters protected from the shell's + dollar expansion (possibly an autoconf bug). */ +static char format[] = { '%', '2', '$', 'd', ' ', '%', '1', '$', 'd', '\0' }; +static char buf[100]; +int main () +{ + sprintf (buf, format, 33, 55); + return (strcmp (buf, "55 33") != 0); +} +_ACEOF +if ac_fn_c_try_run "$LINENO"; then : + gt_cv_func_printf_posix=yes +else + gt_cv_func_printf_posix=no +fi +rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ + conftest.$ac_objext conftest.beam conftest.$ac_ext +fi + + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gt_cv_func_printf_posix" >&5 +$as_echo "$gt_cv_func_printf_posix" >&6; } + case $gt_cv_func_printf_posix in + *yes) + +$as_echo "#define HAVE_POSIX_PRINTF 1" >>confdefs.h + + ;; + esac + + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether we are using the GNU C Library 2.1 or newer" >&5 +$as_echo_n "checking whether we are using the GNU C Library 2.1 or newer... " >&6; } +if ${ac_cv_gnu_library_2_1+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +#include <features.h> +#ifdef __GNU_LIBRARY__ + #if (__GLIBC__ == 2 && __GLIBC_MINOR__ >= 1) || (__GLIBC__ > 2) + Lucky GNU user + #endif +#endif + +_ACEOF +if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | + $EGREP "Lucky GNU user" >/dev/null 2>&1; then : + ac_cv_gnu_library_2_1=yes +else + ac_cv_gnu_library_2_1=no +fi +rm -f conftest* + + + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_gnu_library_2_1" >&5 +$as_echo "$ac_cv_gnu_library_2_1" >&6; } + + GLIBC21="$ac_cv_gnu_library_2_1" + + + + for ac_header in stdint.h +do : + ac_fn_c_check_header_mongrel "$LINENO" "stdint.h" "ac_cv_header_stdint_h" "$ac_includes_default" +if test "x$ac_cv_header_stdint_h" = xyes; then : + cat >>confdefs.h <<_ACEOF +#define HAVE_STDINT_H 1 +_ACEOF + +fi + +done + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for SIZE_MAX" >&5 +$as_echo_n "checking for SIZE_MAX... " >&6; } + if ${gl_cv_size_max+:} false; then : + $as_echo_n "(cached) " >&6 +else + + gl_cv_size_max= + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +#include <limits.h> +#if HAVE_STDINT_H +#include <stdint.h> +#endif +#ifdef SIZE_MAX +Found it +#endif + +_ACEOF +if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | + $EGREP "Found it" >/dev/null 2>&1; then : + gl_cv_size_max=yes +fi +rm -f conftest* + + if test -z "$gl_cv_size_max"; then + if ac_fn_c_compute_int "$LINENO" "sizeof (size_t) * CHAR_BIT - 1" "size_t_bits_minus_1" "#include <stddef.h> +#include <limits.h>"; then : + +else + size_t_bits_minus_1= +fi + + + if ac_fn_c_compute_int "$LINENO" "sizeof (size_t) <= sizeof (unsigned int)" "fits_in_uint" "#include <stddef.h>"; then : + +else + fits_in_uint= +fi + + + if test -n "$size_t_bits_minus_1" && test -n "$fits_in_uint"; then + if test $fits_in_uint = 1; then + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <stddef.h> + extern size_t foo; + extern unsigned long foo; + +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + fits_in_uint=0 +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + fi + if test $fits_in_uint = 1; then + gl_cv_size_max="(((1U << $size_t_bits_minus_1) - 1) * 2 + 1)" + else + gl_cv_size_max="(((1UL << $size_t_bits_minus_1) - 1) * 2 + 1)" + fi + else + gl_cv_size_max='((size_t)~(size_t)0)' + fi + fi + +fi + + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_size_max" >&5 +$as_echo "$gl_cv_size_max" >&6; } + if test "$gl_cv_size_max" != yes; then + +cat >>confdefs.h <<_ACEOF +#define SIZE_MAX $gl_cv_size_max +_ACEOF + + fi + + + + + for ac_header in stdint.h +do : + ac_fn_c_check_header_mongrel "$LINENO" "stdint.h" "ac_cv_header_stdint_h" "$ac_includes_default" +if test "x$ac_cv_header_stdint_h" = xyes; then : + cat >>confdefs.h <<_ACEOF +#define HAVE_STDINT_H 1 +_ACEOF + +fi + +done + + + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for CFPreferencesCopyAppValue" >&5 +$as_echo_n "checking for CFPreferencesCopyAppValue... " >&6; } +if ${gt_cv_func_CFPreferencesCopyAppValue+:} false; then : + $as_echo_n "(cached) " >&6 +else + gt_save_LIBS="$LIBS" + LIBS="$LIBS -Wl,-framework -Wl,CoreFoundation" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <CoreFoundation/CFPreferences.h> +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +CFPreferencesCopyAppValue(NULL, NULL) + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + gt_cv_func_CFPreferencesCopyAppValue=yes +else + gt_cv_func_CFPreferencesCopyAppValue=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + LIBS="$gt_save_LIBS" +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gt_cv_func_CFPreferencesCopyAppValue" >&5 +$as_echo "$gt_cv_func_CFPreferencesCopyAppValue" >&6; } + if test $gt_cv_func_CFPreferencesCopyAppValue = yes; then + +$as_echo "#define HAVE_CFPREFERENCESCOPYAPPVALUE 1" >>confdefs.h + + fi + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for CFLocaleCopyCurrent" >&5 +$as_echo_n "checking for CFLocaleCopyCurrent... " >&6; } +if ${gt_cv_func_CFLocaleCopyCurrent+:} false; then : + $as_echo_n "(cached) " >&6 +else + gt_save_LIBS="$LIBS" + LIBS="$LIBS -Wl,-framework -Wl,CoreFoundation" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <CoreFoundation/CFLocale.h> +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +CFLocaleCopyCurrent(); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + gt_cv_func_CFLocaleCopyCurrent=yes +else + gt_cv_func_CFLocaleCopyCurrent=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + LIBS="$gt_save_LIBS" +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gt_cv_func_CFLocaleCopyCurrent" >&5 +$as_echo "$gt_cv_func_CFLocaleCopyCurrent" >&6; } + if test $gt_cv_func_CFLocaleCopyCurrent = yes; then + +$as_echo "#define HAVE_CFLOCALECOPYCURRENT 1" >>confdefs.h + + fi + INTL_MACOSX_LIBS= + if test $gt_cv_func_CFPreferencesCopyAppValue = yes || test $gt_cv_func_CFLocaleCopyCurrent = yes; then + INTL_MACOSX_LIBS="-Wl,-framework -Wl,CoreFoundation" + fi + + + + + + + + ac_fn_c_check_type "$LINENO" "ptrdiff_t" "ac_cv_type_ptrdiff_t" "$ac_includes_default" +if test "x$ac_cv_type_ptrdiff_t" = xyes; then : + +else + +$as_echo "#define ptrdiff_t long" >>confdefs.h + + +fi + + for ac_header in stddef.h stdlib.h string.h +do : + as_ac_Header=`$as_echo "ac_cv_header_$ac_header" | $as_tr_sh` +ac_fn_c_check_header_mongrel "$LINENO" "$ac_header" "$as_ac_Header" "$ac_includes_default" +if eval test \"x\$"$as_ac_Header"\" = x"yes"; then : + cat >>confdefs.h <<_ACEOF +#define `$as_echo "HAVE_$ac_header" | $as_tr_cpp` 1 +_ACEOF + +fi + +done + + for ac_func in asprintf fwprintf putenv setenv setlocale snprintf wcslen +do : + as_ac_var=`$as_echo "ac_cv_func_$ac_func" | $as_tr_sh` +ac_fn_c_check_func "$LINENO" "$ac_func" "$as_ac_var" +if eval test \"x\$"$as_ac_var"\" = x"yes"; then : + cat >>confdefs.h <<_ACEOF +#define `$as_echo "HAVE_$ac_func" | $as_tr_cpp` 1 +_ACEOF + +fi +done + + + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether _snprintf is declared" >&5 +$as_echo_n "checking whether _snprintf is declared... " >&6; } +if ${ac_cv_have_decl__snprintf+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <stdio.h> +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ + +#ifndef _snprintf + char *p = (char *) _snprintf; +#endif + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_cv_have_decl__snprintf=yes +else + ac_cv_have_decl__snprintf=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_have_decl__snprintf" >&5 +$as_echo "$ac_cv_have_decl__snprintf" >&6; } + if test $ac_cv_have_decl__snprintf = yes; then + gt_value=1 + else + gt_value=0 + fi + +cat >>confdefs.h <<_ACEOF +#define HAVE_DECL__SNPRINTF $gt_value +_ACEOF + + + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether _snwprintf is declared" >&5 +$as_echo_n "checking whether _snwprintf is declared... " >&6; } +if ${ac_cv_have_decl__snwprintf+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <stdio.h> +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ + +#ifndef _snwprintf + char *p = (char *) _snwprintf; +#endif + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_cv_have_decl__snwprintf=yes +else + ac_cv_have_decl__snwprintf=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_have_decl__snwprintf" >&5 +$as_echo "$ac_cv_have_decl__snwprintf" >&6; } + if test $ac_cv_have_decl__snwprintf = yes; then + gt_value=1 + else + gt_value=0 + fi + +cat >>confdefs.h <<_ACEOF +#define HAVE_DECL__SNWPRINTF $gt_value +_ACEOF + + + + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether getc_unlocked is declared" >&5 +$as_echo_n "checking whether getc_unlocked is declared... " >&6; } +if ${ac_cv_have_decl_getc_unlocked+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <stdio.h> +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ + +#ifndef getc_unlocked + char *p = (char *) getc_unlocked; +#endif + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_cv_have_decl_getc_unlocked=yes +else + ac_cv_have_decl_getc_unlocked=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_have_decl_getc_unlocked" >&5 +$as_echo "$ac_cv_have_decl_getc_unlocked" >&6; } + if test $ac_cv_have_decl_getc_unlocked = yes; then + gt_value=1 + else + gt_value=0 + fi + +cat >>confdefs.h <<_ACEOF +#define HAVE_DECL_GETC_UNLOCKED $gt_value +_ACEOF + + + + case $gt_cv_func_printf_posix in + *yes) HAVE_POSIX_PRINTF=1 ;; + *) HAVE_POSIX_PRINTF=0 ;; + esac + + if test "$ac_cv_func_asprintf" = yes; then + HAVE_ASPRINTF=1 + else + HAVE_ASPRINTF=0 + fi + + if test "$ac_cv_func_snprintf" = yes; then + HAVE_SNPRINTF=1 + else + HAVE_SNPRINTF=0 + fi + + if test "$ac_cv_func_wprintf" = yes; then + HAVE_WPRINTF=1 + else + HAVE_WPRINTF=0 + fi + + + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for nl_langinfo and CODESET" >&5 +$as_echo_n "checking for nl_langinfo and CODESET... " >&6; } +if ${am_cv_langinfo_codeset+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <langinfo.h> +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +char* cs = nl_langinfo(CODESET); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + am_cv_langinfo_codeset=yes +else + am_cv_langinfo_codeset=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $am_cv_langinfo_codeset" >&5 +$as_echo "$am_cv_langinfo_codeset" >&6; } + if test $am_cv_langinfo_codeset = yes; then + +$as_echo "#define HAVE_LANGINFO_CODESET 1" >>confdefs.h + + fi + + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for LC_MESSAGES" >&5 +$as_echo_n "checking for LC_MESSAGES... " >&6; } +if ${gt_cv_val_LC_MESSAGES+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <locale.h> +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +return LC_MESSAGES + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + gt_cv_val_LC_MESSAGES=yes +else + gt_cv_val_LC_MESSAGES=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gt_cv_val_LC_MESSAGES" >&5 +$as_echo "$gt_cv_val_LC_MESSAGES" >&6; } + if test $gt_cv_val_LC_MESSAGES = yes; then + +$as_echo "#define HAVE_LC_MESSAGES 1" >>confdefs.h + + fi + + + if test "$enable_shared" = yes; then + case "$host_os" in + cygwin*) is_woe32dll=yes ;; + *) is_woe32dll=no ;; + esac + else + is_woe32dll=no + fi + WOE32DLL=$is_woe32dll + + + + + + + + + + + + + + + + + + + + + + + + + + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for CFPreferencesCopyAppValue" >&5 +$as_echo_n "checking for CFPreferencesCopyAppValue... " >&6; } +if ${gt_cv_func_CFPreferencesCopyAppValue+:} false; then : + $as_echo_n "(cached) " >&6 +else + gt_save_LIBS="$LIBS" + LIBS="$LIBS -Wl,-framework -Wl,CoreFoundation" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <CoreFoundation/CFPreferences.h> +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +CFPreferencesCopyAppValue(NULL, NULL) + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + gt_cv_func_CFPreferencesCopyAppValue=yes +else + gt_cv_func_CFPreferencesCopyAppValue=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + LIBS="$gt_save_LIBS" +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gt_cv_func_CFPreferencesCopyAppValue" >&5 +$as_echo "$gt_cv_func_CFPreferencesCopyAppValue" >&6; } + if test $gt_cv_func_CFPreferencesCopyAppValue = yes; then + +$as_echo "#define HAVE_CFPREFERENCESCOPYAPPVALUE 1" >>confdefs.h + + fi + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for CFLocaleCopyCurrent" >&5 +$as_echo_n "checking for CFLocaleCopyCurrent... " >&6; } +if ${gt_cv_func_CFLocaleCopyCurrent+:} false; then : + $as_echo_n "(cached) " >&6 +else + gt_save_LIBS="$LIBS" + LIBS="$LIBS -Wl,-framework -Wl,CoreFoundation" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <CoreFoundation/CFLocale.h> +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +CFLocaleCopyCurrent(); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + gt_cv_func_CFLocaleCopyCurrent=yes +else + gt_cv_func_CFLocaleCopyCurrent=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + LIBS="$gt_save_LIBS" +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gt_cv_func_CFLocaleCopyCurrent" >&5 +$as_echo "$gt_cv_func_CFLocaleCopyCurrent" >&6; } + if test $gt_cv_func_CFLocaleCopyCurrent = yes; then + +$as_echo "#define HAVE_CFLOCALECOPYCURRENT 1" >>confdefs.h + + fi + INTL_MACOSX_LIBS= + if test $gt_cv_func_CFPreferencesCopyAppValue = yes || test $gt_cv_func_CFLocaleCopyCurrent = yes; then + INTL_MACOSX_LIBS="-Wl,-framework -Wl,CoreFoundation" + fi + + + + + + + BUILD_INCLUDED_LIBINTL=no + USE_INCLUDED_LIBINTL=no + + LIBINTL= + LTLIBINTL= + POSUB= + + case " $gt_needs " in + *" need-formatstring-macros "*) gt_api_version=3 ;; + *" need-ngettext "*) gt_api_version=2 ;; + *) gt_api_version=1 ;; + esac + gt_func_gnugettext_libc="gt_cv_func_gnugettext${gt_api_version}_libc" + gt_func_gnugettext_libintl="gt_cv_func_gnugettext${gt_api_version}_libintl" + + if test "$USE_NLS" = "yes"; then + gt_use_preinstalled_gnugettext=no + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether included gettext is requested" >&5 +$as_echo_n "checking whether included gettext is requested... " >&6; } + +# Check whether --with-included-gettext was given. +if test "${with_included_gettext+set}" = set; then : + withval=$with_included_gettext; nls_cv_force_use_gnu_gettext=$withval +else + nls_cv_force_use_gnu_gettext=no +fi + + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $nls_cv_force_use_gnu_gettext" >&5 +$as_echo "$nls_cv_force_use_gnu_gettext" >&6; } + + nls_cv_use_gnu_gettext="$nls_cv_force_use_gnu_gettext" + if test "$nls_cv_force_use_gnu_gettext" != "yes"; then + + + if test $gt_api_version -ge 3; then + gt_revision_test_code=' +#ifndef __GNU_GETTEXT_SUPPORTED_REVISION +#define __GNU_GETTEXT_SUPPORTED_REVISION(major) ((major) == 0 ? 0 : -1) +#endif +typedef int array [2 * (__GNU_GETTEXT_SUPPORTED_REVISION(0) >= 1) - 1]; +' + else + gt_revision_test_code= + fi + if test $gt_api_version -ge 2; then + gt_expression_test_code=' + * ngettext ("", "", 0)' + else + gt_expression_test_code= + fi + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for GNU gettext in libc" >&5 +$as_echo_n "checking for GNU gettext in libc... " >&6; } +if eval \${$gt_func_gnugettext_libc+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <libintl.h> +$gt_revision_test_code +extern int _nl_msg_cat_cntr; +extern int *_nl_domain_bindings; +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +bindtextdomain ("", ""); +return * gettext ("")$gt_expression_test_code + _nl_msg_cat_cntr + *_nl_domain_bindings + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + eval "$gt_func_gnugettext_libc=yes" +else + eval "$gt_func_gnugettext_libc=no" +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +fi +eval ac_res=\$$gt_func_gnugettext_libc + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } + + if { eval "gt_val=\$$gt_func_gnugettext_libc"; test "$gt_val" != "yes"; }; then + + + + + + + + + use_additional=yes + + acl_save_prefix="$prefix" + prefix="$acl_final_prefix" + acl_save_exec_prefix="$exec_prefix" + exec_prefix="$acl_final_exec_prefix" + + eval additional_includedir=\"$includedir\" + eval additional_libdir=\"$libdir\" + + exec_prefix="$acl_save_exec_prefix" + prefix="$acl_save_prefix" + + +# Check whether --with-libintl-prefix was given. +if test "${with_libintl_prefix+set}" = set; then : + withval=$with_libintl_prefix; + if test "X$withval" = "Xno"; then + use_additional=no + else + if test "X$withval" = "X"; then + + acl_save_prefix="$prefix" + prefix="$acl_final_prefix" + acl_save_exec_prefix="$exec_prefix" + exec_prefix="$acl_final_exec_prefix" + + eval additional_includedir=\"$includedir\" + eval additional_libdir=\"$libdir\" + + exec_prefix="$acl_save_exec_prefix" + prefix="$acl_save_prefix" + + else + additional_includedir="$withval/include" + additional_libdir="$withval/$acl_libdirstem" + if test "$acl_libdirstem2" != "$acl_libdirstem" \ + && ! test -d "$withval/$acl_libdirstem"; then + additional_libdir="$withval/$acl_libdirstem2" + fi + fi + fi + +fi + + LIBINTL= + LTLIBINTL= + INCINTL= + LIBINTL_PREFIX= + HAVE_LIBINTL= + rpathdirs= + ltrpathdirs= + names_already_handled= + names_next_round='intl ' + while test -n "$names_next_round"; do + names_this_round="$names_next_round" + names_next_round= + for name in $names_this_round; do + already_handled= + for n in $names_already_handled; do + if test "$n" = "$name"; then + already_handled=yes + break + fi + done + if test -z "$already_handled"; then + names_already_handled="$names_already_handled $name" + uppername=`echo "$name" | sed -e 'y|abcdefghijklmnopqrstuvwxyz./+-|ABCDEFGHIJKLMNOPQRSTUVWXYZ____|'` + eval value=\"\$HAVE_LIB$uppername\" + if test -n "$value"; then + if test "$value" = yes; then + eval value=\"\$LIB$uppername\" + test -z "$value" || LIBINTL="${LIBINTL}${LIBINTL:+ }$value" + eval value=\"\$LTLIB$uppername\" + test -z "$value" || LTLIBINTL="${LTLIBINTL}${LTLIBINTL:+ }$value" + else + : + fi + else + found_dir= + found_la= + found_so= + found_a= + eval libname=\"$acl_libname_spec\" # typically: libname=lib$name + if test -n "$acl_shlibext"; then + shrext=".$acl_shlibext" # typically: shrext=.so + else + shrext= + fi + if test $use_additional = yes; then + dir="$additional_libdir" + if test -n "$acl_shlibext"; then + if test -f "$dir/$libname$shrext"; then + found_dir="$dir" + found_so="$dir/$libname$shrext" + else + if test "$acl_library_names_spec" = '$libname$shrext$versuffix'; then + ver=`(cd "$dir" && \ + for f in "$libname$shrext".*; do echo "$f"; done \ + | sed -e "s,^$libname$shrext\\\\.,," \ + | sort -t '.' -n -r -k1,1 -k2,2 -k3,3 -k4,4 -k5,5 \ + | sed 1q ) 2>/dev/null` + if test -n "$ver" && test -f "$dir/$libname$shrext.$ver"; then + found_dir="$dir" + found_so="$dir/$libname$shrext.$ver" + fi + else + eval library_names=\"$acl_library_names_spec\" + for f in $library_names; do + if test -f "$dir/$f"; then + found_dir="$dir" + found_so="$dir/$f" + break + fi + done + fi + fi + fi + if test "X$found_dir" = "X"; then + if test -f "$dir/$libname.$acl_libext"; then + found_dir="$dir" + found_a="$dir/$libname.$acl_libext" + fi + fi + if test "X$found_dir" != "X"; then + if test -f "$dir/$libname.la"; then + found_la="$dir/$libname.la" + fi + fi + fi + if test "X$found_dir" = "X"; then + for x in $LDFLAGS $LTLIBINTL; do + + acl_save_prefix="$prefix" + prefix="$acl_final_prefix" + acl_save_exec_prefix="$exec_prefix" + exec_prefix="$acl_final_exec_prefix" + eval x=\"$x\" + exec_prefix="$acl_save_exec_prefix" + prefix="$acl_save_prefix" + + case "$x" in + -L*) + dir=`echo "X$x" | sed -e 's/^X-L//'` + if test -n "$acl_shlibext"; then + if test -f "$dir/$libname$shrext"; then + found_dir="$dir" + found_so="$dir/$libname$shrext" + else + if test "$acl_library_names_spec" = '$libname$shrext$versuffix'; then + ver=`(cd "$dir" && \ + for f in "$libname$shrext".*; do echo "$f"; done \ + | sed -e "s,^$libname$shrext\\\\.,," \ + | sort -t '.' -n -r -k1,1 -k2,2 -k3,3 -k4,4 -k5,5 \ + | sed 1q ) 2>/dev/null` + if test -n "$ver" && test -f "$dir/$libname$shrext.$ver"; then + found_dir="$dir" + found_so="$dir/$libname$shrext.$ver" + fi + else + eval library_names=\"$acl_library_names_spec\" + for f in $library_names; do + if test -f "$dir/$f"; then + found_dir="$dir" + found_so="$dir/$f" + break + fi + done + fi + fi + fi + if test "X$found_dir" = "X"; then + if test -f "$dir/$libname.$acl_libext"; then + found_dir="$dir" + found_a="$dir/$libname.$acl_libext" + fi + fi + if test "X$found_dir" != "X"; then + if test -f "$dir/$libname.la"; then + found_la="$dir/$libname.la" + fi + fi + ;; + esac + if test "X$found_dir" != "X"; then + break + fi + done + fi + if test "X$found_dir" != "X"; then + LTLIBINTL="${LTLIBINTL}${LTLIBINTL:+ }-L$found_dir -l$name" + if test "X$found_so" != "X"; then + if test "$enable_rpath" = no \ + || test "X$found_dir" = "X/usr/$acl_libdirstem" \ + || test "X$found_dir" = "X/usr/$acl_libdirstem2"; then + LIBINTL="${LIBINTL}${LIBINTL:+ }$found_so" + else + haveit= + for x in $ltrpathdirs; do + if test "X$x" = "X$found_dir"; then + haveit=yes + break + fi + done + if test -z "$haveit"; then + ltrpathdirs="$ltrpathdirs $found_dir" + fi + if test "$acl_hardcode_direct" = yes; then + LIBINTL="${LIBINTL}${LIBINTL:+ }$found_so" + else + if test -n "$acl_hardcode_libdir_flag_spec" && test "$acl_hardcode_minus_L" = no; then + LIBINTL="${LIBINTL}${LIBINTL:+ }$found_so" + haveit= + for x in $rpathdirs; do + if test "X$x" = "X$found_dir"; then + haveit=yes + break + fi + done + if test -z "$haveit"; then + rpathdirs="$rpathdirs $found_dir" + fi + else + haveit= + for x in $LDFLAGS $LIBINTL; do + + acl_save_prefix="$prefix" + prefix="$acl_final_prefix" + acl_save_exec_prefix="$exec_prefix" + exec_prefix="$acl_final_exec_prefix" + eval x=\"$x\" + exec_prefix="$acl_save_exec_prefix" + prefix="$acl_save_prefix" + + if test "X$x" = "X-L$found_dir"; then + haveit=yes + break + fi + done + if test -z "$haveit"; then + LIBINTL="${LIBINTL}${LIBINTL:+ }-L$found_dir" + fi + if test "$acl_hardcode_minus_L" != no; then + LIBINTL="${LIBINTL}${LIBINTL:+ }$found_so" + else + LIBINTL="${LIBINTL}${LIBINTL:+ }-l$name" + fi + fi + fi + fi + else + if test "X$found_a" != "X"; then + LIBINTL="${LIBINTL}${LIBINTL:+ }$found_a" + else + LIBINTL="${LIBINTL}${LIBINTL:+ }-L$found_dir -l$name" + fi + fi + additional_includedir= + case "$found_dir" in + */$acl_libdirstem | */$acl_libdirstem/) + basedir=`echo "X$found_dir" | sed -e 's,^X,,' -e "s,/$acl_libdirstem/"'*$,,'` + if test "$name" = 'intl'; then + LIBINTL_PREFIX="$basedir" + fi + additional_includedir="$basedir/include" + ;; + */$acl_libdirstem2 | */$acl_libdirstem2/) + basedir=`echo "X$found_dir" | sed -e 's,^X,,' -e "s,/$acl_libdirstem2/"'*$,,'` + if test "$name" = 'intl'; then + LIBINTL_PREFIX="$basedir" + fi + additional_includedir="$basedir/include" + ;; + esac + if test "X$additional_includedir" != "X"; then + if test "X$additional_includedir" != "X/usr/include"; then + haveit= + if test "X$additional_includedir" = "X/usr/local/include"; then + if test -n "$GCC"; then + case $host_os in + linux* | gnu* | k*bsd*-gnu) haveit=yes;; + esac + fi + fi + if test -z "$haveit"; then + for x in $CPPFLAGS $INCINTL; do + + acl_save_prefix="$prefix" + prefix="$acl_final_prefix" + acl_save_exec_prefix="$exec_prefix" + exec_prefix="$acl_final_exec_prefix" + eval x=\"$x\" + exec_prefix="$acl_save_exec_prefix" + prefix="$acl_save_prefix" + + if test "X$x" = "X-I$additional_includedir"; then + haveit=yes + break + fi + done + if test -z "$haveit"; then + if test -d "$additional_includedir"; then + INCINTL="${INCINTL}${INCINTL:+ }-I$additional_includedir" + fi + fi + fi + fi + fi + if test -n "$found_la"; then + save_libdir="$libdir" + case "$found_la" in + */* | *\\*) . "$found_la" ;; + *) . "./$found_la" ;; + esac + libdir="$save_libdir" + for dep in $dependency_libs; do + case "$dep" in + -L*) + additional_libdir=`echo "X$dep" | sed -e 's/^X-L//'` + if test "X$additional_libdir" != "X/usr/$acl_libdirstem" \ + && test "X$additional_libdir" != "X/usr/$acl_libdirstem2"; then + haveit= + if test "X$additional_libdir" = "X/usr/local/$acl_libdirstem" \ + || test "X$additional_libdir" = "X/usr/local/$acl_libdirstem2"; then + if test -n "$GCC"; then + case $host_os in + linux* | gnu* | k*bsd*-gnu) haveit=yes;; + esac + fi + fi + if test -z "$haveit"; then + haveit= + for x in $LDFLAGS $LIBINTL; do + + acl_save_prefix="$prefix" + prefix="$acl_final_prefix" + acl_save_exec_prefix="$exec_prefix" + exec_prefix="$acl_final_exec_prefix" + eval x=\"$x\" + exec_prefix="$acl_save_exec_prefix" + prefix="$acl_save_prefix" + + if test "X$x" = "X-L$additional_libdir"; then + haveit=yes + break + fi + done + if test -z "$haveit"; then + if test -d "$additional_libdir"; then + LIBINTL="${LIBINTL}${LIBINTL:+ }-L$additional_libdir" + fi + fi + haveit= + for x in $LDFLAGS $LTLIBINTL; do + + acl_save_prefix="$prefix" + prefix="$acl_final_prefix" + acl_save_exec_prefix="$exec_prefix" + exec_prefix="$acl_final_exec_prefix" + eval x=\"$x\" + exec_prefix="$acl_save_exec_prefix" + prefix="$acl_save_prefix" + + if test "X$x" = "X-L$additional_libdir"; then + haveit=yes + break + fi + done + if test -z "$haveit"; then + if test -d "$additional_libdir"; then + LTLIBINTL="${LTLIBINTL}${LTLIBINTL:+ }-L$additional_libdir" + fi + fi + fi + fi + ;; + -R*) + dir=`echo "X$dep" | sed -e 's/^X-R//'` + if test "$enable_rpath" != no; then + haveit= + for x in $rpathdirs; do + if test "X$x" = "X$dir"; then + haveit=yes + break + fi + done + if test -z "$haveit"; then + rpathdirs="$rpathdirs $dir" + fi + haveit= + for x in $ltrpathdirs; do + if test "X$x" = "X$dir"; then + haveit=yes + break + fi + done + if test -z "$haveit"; then + ltrpathdirs="$ltrpathdirs $dir" + fi + fi + ;; + -l*) + names_next_round="$names_next_round "`echo "X$dep" | sed -e 's/^X-l//'` + ;; + *.la) + names_next_round="$names_next_round "`echo "X$dep" | sed -e 's,^X.*/,,' -e 's,^lib,,' -e 's,\.la$,,'` + ;; + *) + LIBINTL="${LIBINTL}${LIBINTL:+ }$dep" + LTLIBINTL="${LTLIBINTL}${LTLIBINTL:+ }$dep" + ;; + esac + done + fi + else + LIBINTL="${LIBINTL}${LIBINTL:+ }-l$name" + LTLIBINTL="${LTLIBINTL}${LTLIBINTL:+ }-l$name" + fi + fi + fi + done + done + if test "X$rpathdirs" != "X"; then + if test -n "$acl_hardcode_libdir_separator"; then + alldirs= + for found_dir in $rpathdirs; do + alldirs="${alldirs}${alldirs:+$acl_hardcode_libdir_separator}$found_dir" + done + acl_save_libdir="$libdir" + libdir="$alldirs" + eval flag=\"$acl_hardcode_libdir_flag_spec\" + libdir="$acl_save_libdir" + LIBINTL="${LIBINTL}${LIBINTL:+ }$flag" + else + for found_dir in $rpathdirs; do + acl_save_libdir="$libdir" + libdir="$found_dir" + eval flag=\"$acl_hardcode_libdir_flag_spec\" + libdir="$acl_save_libdir" + LIBINTL="${LIBINTL}${LIBINTL:+ }$flag" + done + fi + fi + if test "X$ltrpathdirs" != "X"; then + for found_dir in $ltrpathdirs; do + LTLIBINTL="${LTLIBINTL}${LTLIBINTL:+ }-R$found_dir" + done + fi + + + + + + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for GNU gettext in libintl" >&5 +$as_echo_n "checking for GNU gettext in libintl... " >&6; } +if eval \${$gt_func_gnugettext_libintl+:} false; then : + $as_echo_n "(cached) " >&6 +else + gt_save_CPPFLAGS="$CPPFLAGS" + CPPFLAGS="$CPPFLAGS $INCINTL" + gt_save_LIBS="$LIBS" + LIBS="$LIBS $LIBINTL" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <libintl.h> +$gt_revision_test_code +extern int _nl_msg_cat_cntr; +extern +#ifdef __cplusplus +"C" +#endif +const char *_nl_expand_alias (const char *); +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +bindtextdomain ("", ""); +return * gettext ("")$gt_expression_test_code + _nl_msg_cat_cntr + *_nl_expand_alias ("") + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + eval "$gt_func_gnugettext_libintl=yes" +else + eval "$gt_func_gnugettext_libintl=no" +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + if { eval "gt_val=\$$gt_func_gnugettext_libintl"; test "$gt_val" != yes; } && test -n "$LIBICONV"; then + LIBS="$LIBS $LIBICONV" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <libintl.h> +$gt_revision_test_code +extern int _nl_msg_cat_cntr; +extern +#ifdef __cplusplus +"C" +#endif +const char *_nl_expand_alias (const char *); +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +bindtextdomain ("", ""); +return * gettext ("")$gt_expression_test_code + _nl_msg_cat_cntr + *_nl_expand_alias ("") + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + LIBINTL="$LIBINTL $LIBICONV" + LTLIBINTL="$LTLIBINTL $LTLIBICONV" + eval "$gt_func_gnugettext_libintl=yes" + +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + fi + CPPFLAGS="$gt_save_CPPFLAGS" + LIBS="$gt_save_LIBS" +fi +eval ac_res=\$$gt_func_gnugettext_libintl + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } + fi + + if { eval "gt_val=\$$gt_func_gnugettext_libc"; test "$gt_val" = "yes"; } \ + || { { eval "gt_val=\$$gt_func_gnugettext_libintl"; test "$gt_val" = "yes"; } \ + && test "$PACKAGE" != gettext-runtime \ + && test "$PACKAGE" != gettext-tools; }; then + gt_use_preinstalled_gnugettext=yes + else + LIBINTL= + LTLIBINTL= + INCINTL= + fi + + + if test "$gt_use_preinstalled_gnugettext" != "yes"; then + nls_cv_use_gnu_gettext=yes + fi + fi + + if test "$nls_cv_use_gnu_gettext" = "yes"; then + BUILD_INCLUDED_LIBINTL=yes + USE_INCLUDED_LIBINTL=yes + LIBINTL="$LIBICONV $LIBTHREAD" + LTLIBINTL="../extra/intl/libintl.a $LTLIBICONV $LTLIBTHREAD" + LIBS=`echo " $LIBS " | sed -e 's/ -lintl / /' -e 's/^ //' -e 's/ $//'` + fi + + CATOBJEXT= + if test "$gt_use_preinstalled_gnugettext" = "yes" \ + || test "$nls_cv_use_gnu_gettext" = "yes"; then + CATOBJEXT=.gmo + fi + + + if test -n "$INTL_MACOSX_LIBS"; then + if test "$gt_use_preinstalled_gnugettext" = "yes" \ + || test "$nls_cv_use_gnu_gettext" = "yes"; then + LIBINTL="$LIBINTL $INTL_MACOSX_LIBS" + LTLIBINTL="$LTLIBINTL $INTL_MACOSX_LIBS" + fi + fi + + if test "$gt_use_preinstalled_gnugettext" = "yes" \ + || test "$nls_cv_use_gnu_gettext" = "yes"; then + +$as_echo "#define ENABLE_NLS 1" >>confdefs.h + + else + USE_NLS=no + fi + fi + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether to use NLS" >&5 +$as_echo_n "checking whether to use NLS... " >&6; } + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $USE_NLS" >&5 +$as_echo "$USE_NLS" >&6; } + if test "$USE_NLS" = "yes"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking where the gettext function comes from" >&5 +$as_echo_n "checking where the gettext function comes from... " >&6; } + if test "$gt_use_preinstalled_gnugettext" = "yes"; then + if { eval "gt_val=\$$gt_func_gnugettext_libintl"; test "$gt_val" = "yes"; }; then + gt_source="external libintl" + else + gt_source="libc" + fi + else + gt_source="included intl directory" + fi + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $gt_source" >&5 +$as_echo "$gt_source" >&6; } + fi + + if test "$USE_NLS" = "yes"; then + + if test "$gt_use_preinstalled_gnugettext" = "yes"; then + if { eval "gt_val=\$$gt_func_gnugettext_libintl"; test "$gt_val" = "yes"; }; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking how to link with libintl" >&5 +$as_echo_n "checking how to link with libintl... " >&6; } + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $LIBINTL" >&5 +$as_echo "$LIBINTL" >&6; } + + for element in $INCINTL; do + haveit= + for x in $CPPFLAGS; do + + acl_save_prefix="$prefix" + prefix="$acl_final_prefix" + acl_save_exec_prefix="$exec_prefix" + exec_prefix="$acl_final_exec_prefix" + eval x=\"$x\" + exec_prefix="$acl_save_exec_prefix" + prefix="$acl_save_prefix" + + if test "X$x" = "X$element"; then + haveit=yes + break + fi + done + if test -z "$haveit"; then + CPPFLAGS="${CPPFLAGS}${CPPFLAGS:+ }$element" + fi + done + + fi + + +$as_echo "#define HAVE_GETTEXT 1" >>confdefs.h + + +$as_echo "#define HAVE_DCGETTEXT 1" >>confdefs.h + + fi + + POSUB=po + fi + + + if test "$PACKAGE" = gettext-runtime || test "$PACKAGE" = gettext-tools; then + BUILD_INCLUDED_LIBINTL=yes + fi + + + + + + nls_cv_header_intl= + nls_cv_header_libgt= + + DATADIRNAME=share + + + INSTOBJEXT=.mo + + + GENCAT=gencat + + + INTLOBJS= + if test "$USE_INCLUDED_LIBINTL" = yes; then + INTLOBJS="\$(GETTOBJS)" + fi + + + INTL_LIBTOOL_SUFFIX_PREFIX= + + + + INTLLIBS="$LIBINTL" + + + + + + + if test -n "$INTL_MACOSX_LIBS"; then + XTRA_INTL_CPPFLAGS=-I/System/Library/Frameworks/CoreFoundation.framework/Headers + fi + echo "Finished configuring src/extra/intl directory" + echo +else + USE_INCLUDED_LIBINTL=no +fi + + + if test "x${USE_NLS}" = xyes; then + USE_NLS_TRUE= + USE_NLS_FALSE='#' +else + USE_NLS_TRUE='#' + USE_NLS_FALSE= +fi + + if test "x${USE_INCLUDED_LIBINTL}" = xyes; then + BUILD_LIBINTL_TRUE= + BUILD_LIBINTL_FALSE='#' +else + BUILD_LIBINTL_TRUE='#' + BUILD_LIBINTL_FALSE= +fi + + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether OpenMP SIMD reduction is supported" >&5 +$as_echo_n "checking whether OpenMP SIMD reduction is supported... " >&6; } +if ${r_cv_openmp_simdred+:} false; then : + $as_echo_n "(cached) " >&6 +else + +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + +r_save_CFLAGS="${CFLAGS}" +CFLAGS="${CFLAGS} ${R_OPENMP_CFLAGS}" +if test "$cross_compiling" = yes; then : + r_cv_openmp_simdred=no +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +#include <stdlib.h> + +double ssum(double *x, int n) { +/* SIMD reduction is supported since OpenMP 4.0. The value of _OPENMP is + unreliable in some compilers, so we do not test its value. */ +#if defined(_OPENMP) + double s = 0; + #pragma omp simd reduction(+:s) + for(int i = 0; i < n; i++) + s += x[i]; + return s; +#else + exit(1); + return 0; /* not reachable */ +#endif +} + +int main() { + /* use volatiles to reduce the risk of the + computation being inlined and constant-folded */ + volatile double xv[8] = {1, 2, 3, 4, 5, 6, 7, 8}; + volatile int n = 8; + double x[8], s; + int i; + + for(i = 0; i < 8; i++) x[i] = xv[i]; + s = ssum(x, n); + if (s == 36) exit(0); + exit(2); +} + +_ACEOF +if ac_fn_c_try_run "$LINENO"; then : + r_cv_openmp_simdred=yes +else + r_cv_openmp_simdred=no +fi +rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ + conftest.$ac_objext conftest.beam conftest.$ac_ext +fi + +CFLAGS="${r_save_CFLAGS}" + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $r_cv_openmp_simdred" >&5 +$as_echo "$r_cv_openmp_simdred" >&6; } +if test "x${r_cv_openmp_simdred}" = xyes; then + +$as_echo "#define HAVE_OPENMP_SIMDRED 1" >>confdefs.h + +fi + + +### shell for use in scripts: we allow R_SHELL to set the script, +### since some AIX systems have zsh as sh. +: ${R_SHELL=${SHELL}} + +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: using as R_SHELL for scripts ... ${R_SHELL}" >&5 +$as_echo "using as R_SHELL for scripts ... ${R_SHELL}" >&6; } + + +### * Win32 overrides +case "${host_os}" in + mingw*) + +$as_echo "#define HAVE_ICONV 1" >>confdefs.h + + +$as_echo "#define HAVE_ICONVLIST 1" >>confdefs.h + + +$as_echo "#define HAVE_ICONV_H 1" >>confdefs.h + + +$as_echo "#define HAVE_JPEG 1" >>confdefs.h + + +$as_echo "#define HAVE_PNG 1" >>confdefs.h + + +$as_echo "#define HAVE_POSIX_SETJMP 1" >>confdefs.h + + +$as_echo "#define HAVE_TCLTK 1" >>confdefs.h + + +$as_echo "#define HAVE_TIFF 1" >>confdefs.h + + +$as_echo "#define HAVE_TIMES 1" >>confdefs.h + + want_R_profiling=yes + +$as_echo "#define R_PROFILING 1" >>confdefs.h + + ;; +esac + +### * Output. + +ac_config_headers="$ac_config_headers src/include/config.h" + +ac_config_files="$ac_config_files Makeconf Makefile doc/Makefile doc/html/Makefile doc/manual/Makefile etc/Makefile etc/Makeconf etc/Renviron etc/javaconf etc/ldpaths m4/Makefile po/Makefile share/Makefile src/Makefile src/appl/Makefile src/extra/Makefile src/extra/blas/Makefile src/extra/intl/Makefile src/extra/tre/Makefile src/extra/tzone/Makefile src/extra/xdr/Makefile src/include/Makefile src/include/Rmath.h0 src/include/R_ext/Makefile src/library/Recommended/Makefile src/library/Makefile src/library/base/DESCRIPTION src/library/base/Makefile src/library/compiler/DESCRIPTION src/library/compiler/Makefile src/library/datasets/DESCRIPTION src/library/datasets/Makefile src/library/graphics/DESCRIPTION src/library/graphics/Makefile src/library/graphics/src/Makefile src/library/grDevices/DESCRIPTION src/library/grDevices/Makefile src/library/grDevices/src/Makefile src/library/grDevices/src/cairo/Makefile src/library/grid/DESCRIPTION src/library/grid/Makefile src/library/grid/src/Makefile src/library/methods/DESCRIPTION src/library/methods/Makefile src/library/methods/src/Makefile src/library/parallel/DESCRIPTION src/library/parallel/Makefile src/library/parallel/src/Makefile src/library/profile/Makefile src/library/stats/DESCRIPTION src/library/stats/Makefile src/library/stats/src/Makefile src/library/stats4/DESCRIPTION src/library/stats4/Makefile src/library/splines/DESCRIPTION src/library/splines/Makefile src/library/splines/src/Makefile src/library/tcltk/DESCRIPTION src/library/tcltk/Makefile src/library/tcltk/src/Makefile src/library/tools/DESCRIPTION src/library/tools/Makefile src/library/tools/src/Makefile src/library/translations/DESCRIPTION src/library/translations/Makefile src/library/utils/DESCRIPTION src/library/utils/Makefile src/library/utils/src/Makefile src/main/Makefile src/modules/Makefile src/modules/X11/Makefile src/modules/internet/Makefile src/modules/lapack/Makefile src/nmath/Makefile src/nmath/standalone/Makefile src/scripts/Makefile src/scripts/R.sh src/scripts/Rcmd src/scripts/f77_f2c src/scripts/javareconf src/scripts/mkinstalldirs src/scripts/pager src/scripts/rtags src/unix/Makefile tests/Makefile tests/Embedding/Makefile tests/Examples/Makefile tools/Makefile" + + +ac_config_commands="$ac_config_commands stamp-h" + + +### now reset flags +CPPFLAGS=${CPPFLAGS_KEEP} +CFLAGS=${CFLAGS_KEEP} +FFLAGS=${FFLAGS_KEEP} +CXXFLAGS=${CXXFLAGS_KEEP} + +cat >confcache <<\_ACEOF +# 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, see configure's option --config-cache. +# It is not useful on other systems. If it contains results you don't +# want to keep, you may remove or edit it. +# +# config.status only pays attention to the cache file if you give it +# the --recheck option to rerun configure. +# +# `ac_cv_env_foo' variables (set or unset) will be overridden when +# loading this file, other *unset* `ac_cv_foo' will be assigned the +# following values. + +_ACEOF + +# The following way of writing the cache mishandles newlines in values, +# but we know of no workaround that is simple, portable, and efficient. +# So, we kill variables containing newlines. +# 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. +( + for ac_var in `(set) 2>&1 | sed -n 's/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'`; do + eval ac_val=\$$ac_var + case $ac_val in #( + *${as_nl}*) + case $ac_var in #( + *_cv_*) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: cache variable $ac_var contains a newline" >&5 +$as_echo "$as_me: WARNING: cache variable $ac_var contains a newline" >&2;} ;; + esac + case $ac_var in #( + _ | IFS | as_nl) ;; #( + BASH_ARGV | BASH_SOURCE) eval $ac_var= ;; #( + *) { eval $ac_var=; unset $ac_var;} ;; + esac ;; + esac + done + + (set) 2>&1 | + case $as_nl`(ac_space=' '; set) 2>&1` in #( + *${as_nl}ac_space=\ *) + # `set' does not quote correctly, so add quotes: double-quote + # substitution turns \\\\ into \\, and sed turns \\ into \. + sed -n \ + "s/'/'\\\\''/g; + s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\\2'/p" + ;; #( + *) + # `set' quotes correctly as required by POSIX, so do not add quotes. + sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p" + ;; + esac | + sort +) | + sed ' + /^ac_cv_env_/b end + t clear + :clear + s/^\([^=]*\)=\(.*[{}].*\)$/test "${\1+set}" = set || &/ + t end + s/^\([^=]*\)=\(.*\)$/\1=${\1=\2}/ + :end' >>confcache +if diff "$cache_file" confcache >/dev/null 2>&1; then :; else + if test -w "$cache_file"; then + if test "x$cache_file" != "x/dev/null"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: updating cache $cache_file" >&5 +$as_echo "$as_me: updating cache $cache_file" >&6;} + if test ! -f "$cache_file" || test -h "$cache_file"; then + cat confcache >"$cache_file" + else + case $cache_file in #( + */* | ?:*) + mv -f confcache "$cache_file"$$ && + mv -f "$cache_file"$$ "$cache_file" ;; #( + *) + mv -f confcache "$cache_file" ;; + esac + fi + fi + else + { $as_echo "$as_me:${as_lineno-$LINENO}: not updating unwritable cache $cache_file" >&5 +$as_echo "$as_me: not updating unwritable cache $cache_file" >&6;} + fi +fi +rm -f confcache + +test "x$prefix" = xNONE && prefix=$ac_default_prefix +# Let make expand exec_prefix. +test "x$exec_prefix" = xNONE && exec_prefix='${prefix}' + +DEFS=-DHAVE_CONFIG_H + +ac_libobjs= +ac_ltlibobjs= +U= +for ac_i in : $LIBOBJS; do test "x$ac_i" = x: && continue + # 1. Remove the extension, and $U if already installed. + ac_script='s/\$U\././;s/\.o$//;s/\.obj$//' + ac_i=`$as_echo "$ac_i" | sed "$ac_script"` + # 2. Prepend LIBOBJDIR. When used with automake>=1.10 LIBOBJDIR + # will be set to the directory where LIBOBJS objects are built. + as_fn_append ac_libobjs " \${LIBOBJDIR}$ac_i\$U.$ac_objext" + as_fn_append ac_ltlibobjs " \${LIBOBJDIR}$ac_i"'$U.lo' +done +LIBOBJS=$ac_libobjs + +LTLIBOBJS=$ac_ltlibobjs + + +if test -z "${WANT_R_FRAMEWORK_TRUE}" && test -z "${WANT_R_FRAMEWORK_FALSE}"; then + as_fn_error $? "conditional \"WANT_R_FRAMEWORK\" was never defined. +Usually this means the macro was only invoked conditionally." "$LINENO" 5 +fi +if test -z "${WANT_R_SHLIB_TRUE}" && test -z "${WANT_R_SHLIB_FALSE}"; then + as_fn_error $? "conditional \"WANT_R_SHLIB\" was never defined. +Usually this means the macro was only invoked conditionally." "$LINENO" 5 +fi +if test -z "${WANT_R_STATIC_TRUE}" && test -z "${WANT_R_STATIC_FALSE}"; then + as_fn_error $? "conditional \"WANT_R_STATIC\" was never defined. +Usually this means the macro was only invoked conditionally." "$LINENO" 5 +fi +if test -z "${MAINTAINER_MODE_TRUE}" && test -z "${MAINTAINER_MODE_FALSE}"; then + as_fn_error $? "conditional \"MAINTAINER_MODE\" was never defined. +Usually this means the macro was only invoked conditionally." "$LINENO" 5 +fi +if test -z "${BUILD_HTML_TRUE}" && test -z "${BUILD_HTML_FALSE}"; then + as_fn_error $? "conditional \"BUILD_HTML\" was never defined. +Usually this means the macro was only invoked conditionally." "$LINENO" 5 +fi +if test -z "${BUILD_LTO_TRUE}" && test -z "${BUILD_LTO_FALSE}"; then + as_fn_error $? "conditional \"BUILD_LTO\" was never defined. +Usually this means the macro was only invoked conditionally." "$LINENO" 5 +fi +if test -z "${WANT_JAVA_TRUE}" && test -z "${WANT_JAVA_FALSE}"; then + as_fn_error $? "conditional \"WANT_JAVA\" was never defined. +Usually this means the macro was only invoked conditionally." "$LINENO" 5 +fi +if test -z "${BYTE_COMPILE_PACKAGES_TRUE}" && test -z "${BYTE_COMPILE_PACKAGES_FALSE}"; then + as_fn_error $? "conditional \"BYTE_COMPILE_PACKAGES\" was never defined. +Usually this means the macro was only invoked conditionally." "$LINENO" 5 +fi +if test -z "${CROSS_COMPILING_TRUE}" && test -z "${CROSS_COMPILING_FALSE}"; then + as_fn_error $? "conditional \"CROSS_COMPILING\" was never defined. +Usually this means the macro was only invoked conditionally." "$LINENO" 5 +fi +if test -z "${COMPILE_FORTRAN_DOUBLE_COMPLEX_TRUE}" && test -z "${COMPILE_FORTRAN_DOUBLE_COMPLEX_FALSE}"; then + as_fn_error $? "conditional \"COMPILE_FORTRAN_DOUBLE_COMPLEX\" was never defined. +Usually this means the macro was only invoked conditionally." "$LINENO" 5 +fi +if test -z "${DYLIB_UNDEFINED_ALLOWED_TRUE}" && test -z "${DYLIB_UNDEFINED_ALLOWED_FALSE}"; then + as_fn_error $? "conditional \"DYLIB_UNDEFINED_ALLOWED\" was never defined. +Usually this means the macro was only invoked conditionally." "$LINENO" 5 +fi +if test -z "${USE_EXPORTFILES_TRUE}" && test -z "${USE_EXPORTFILES_FALSE}"; then + as_fn_error $? "conditional \"USE_EXPORTFILES\" was never defined. +Usually this means the macro was only invoked conditionally." "$LINENO" 5 +fi +if test -z "${BLAS_SHLIB_TRUE}" && test -z "${BLAS_SHLIB_FALSE}"; then + as_fn_error $? "conditional \"BLAS_SHLIB\" was never defined. +Usually this means the macro was only invoked conditionally." "$LINENO" 5 +fi +if test -z "${USE_VECLIB_G95FIX_TRUE}" && test -z "${USE_VECLIB_G95FIX_FALSE}"; then + as_fn_error $? "conditional \"USE_VECLIB_G95FIX\" was never defined. +Usually this means the macro was only invoked conditionally." "$LINENO" 5 +fi +if test -z "${USE_EXTERNAL_BLAS_TRUE}" && test -z "${USE_EXTERNAL_BLAS_FALSE}"; then + as_fn_error $? "conditional \"USE_EXTERNAL_BLAS\" was never defined. +Usually this means the macro was only invoked conditionally." "$LINENO" 5 +fi +if test -z "${USE_EXTERNAL_LAPACK_TRUE}" && test -z "${USE_EXTERNAL_LAPACK_FALSE}"; then + as_fn_error $? "conditional \"USE_EXTERNAL_LAPACK\" was never defined. +Usually this means the macro was only invoked conditionally." "$LINENO" 5 +fi +if test -z "${BUILD_X11_TRUE}" && test -z "${BUILD_X11_FALSE}"; then + as_fn_error $? "conditional \"BUILD_X11\" was never defined. +Usually this means the macro was only invoked conditionally." "$LINENO" 5 +fi +if test -z "${BUILD_DEVCAIRO_TRUE}" && test -z "${BUILD_DEVCAIRO_FALSE}"; then + as_fn_error $? "conditional \"BUILD_DEVCAIRO\" was never defined. +Usually this means the macro was only invoked conditionally." "$LINENO" 5 +fi +if test -z "${BUILD_AQUA_TRUE}" && test -z "${BUILD_AQUA_FALSE}"; then + as_fn_error $? "conditional \"BUILD_AQUA\" was never defined. +Usually this means the macro was only invoked conditionally." "$LINENO" 5 +fi +if test -z "${BUILD_XDR_TRUE}" && test -z "${BUILD_XDR_FALSE}"; then + as_fn_error $? "conditional \"BUILD_XDR\" was never defined. +Usually this means the macro was only invoked conditionally." "$LINENO" 5 +fi +if test -z "${USE_MMAP_ZLIB_TRUE}" && test -z "${USE_MMAP_ZLIB_FALSE}"; then + as_fn_error $? "conditional \"USE_MMAP_ZLIB\" was never defined. +Usually this means the macro was only invoked conditionally." "$LINENO" 5 +fi +if test -z "${BUILD_TRE_TRUE}" && test -z "${BUILD_TRE_FALSE}"; then + as_fn_error $? "conditional \"BUILD_TRE\" was never defined. +Usually this means the macro was only invoked conditionally." "$LINENO" 5 +fi +if test -z "${BUILD_TZONE_TRUE}" && test -z "${BUILD_TZONE_FALSE}"; then + as_fn_error $? "conditional \"BUILD_TZONE\" was never defined. +Usually this means the macro was only invoked conditionally." "$LINENO" 5 +fi +if test -z "${USE_RECOMMENDED_PACKAGES_TRUE}" && test -z "${USE_RECOMMENDED_PACKAGES_FALSE}"; then + as_fn_error $? "conditional \"USE_RECOMMENDED_PACKAGES\" was never defined. +Usually this means the macro was only invoked conditionally." "$LINENO" 5 +fi +if test -z "${USE_NLS_TRUE}" && test -z "${USE_NLS_FALSE}"; then + as_fn_error $? "conditional \"USE_NLS\" was never defined. +Usually this means the macro was only invoked conditionally." "$LINENO" 5 +fi +if test -z "${BUILD_LIBINTL_TRUE}" && test -z "${BUILD_LIBINTL_FALSE}"; then + as_fn_error $? "conditional \"BUILD_LIBINTL\" was never defined. +Usually this means the macro was only invoked conditionally." "$LINENO" 5 +fi + +: "${CONFIG_STATUS=./config.status}" +ac_write_fail=0 +ac_clean_files_save=$ac_clean_files +ac_clean_files="$ac_clean_files $CONFIG_STATUS" +{ $as_echo "$as_me:${as_lineno-$LINENO}: creating $CONFIG_STATUS" >&5 +$as_echo "$as_me: creating $CONFIG_STATUS" >&6;} +as_write_fail=0 +cat >$CONFIG_STATUS <<_ASEOF || as_write_fail=1 +#! $SHELL +# Generated by $as_me. +# Run this file to recreate the current configuration. +# Compiler output produced by configure, useful for debugging +# configure, is in config.log if it exists. + +debug=false +ac_cs_recheck=false +ac_cs_silent=false + +SHELL=\${CONFIG_SHELL-$SHELL} +export SHELL +_ASEOF +cat >>$CONFIG_STATUS <<\_ASEOF || as_write_fail=1 +## -------------------- ## +## M4sh Initialization. ## +## -------------------- ## + +# Be more Bourne compatible +DUALCASE=1; export DUALCASE # for MKS sh +if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then : + emulate sh + NULLCMD=: + # Pre-4.2 versions of Zsh do word splitting on ${1+"$@"}, which + # is contrary to our usage. Disable this feature. + alias -g '${1+"$@"}'='"$@"' + setopt NO_GLOB_SUBST +else + case `(set -o) 2>/dev/null` in #( + *posix*) : + set -o posix ;; #( + *) : + ;; +esac +fi + + +as_nl=' +' +export as_nl +# Printing a long string crashes Solaris 7 /usr/bin/printf. +as_echo='\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\' +as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo +as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo$as_echo +# Prefer a ksh shell builtin over an external printf program on Solaris, +# but without wasting forks for bash or zsh. +if test -z "$BASH_VERSION$ZSH_VERSION" \ + && (test "X`print -r -- $as_echo`" = "X$as_echo") 2>/dev/null; then + as_echo='print -r --' + as_echo_n='print -rn --' +elif (test "X`printf %s $as_echo`" = "X$as_echo") 2>/dev/null; then + as_echo='printf %s\n' + as_echo_n='printf %s' +else + if test "X`(/usr/ucb/echo -n -n $as_echo) 2>/dev/null`" = "X-n $as_echo"; then + as_echo_body='eval /usr/ucb/echo -n "$1$as_nl"' + as_echo_n='/usr/ucb/echo -n' + else + as_echo_body='eval expr "X$1" : "X\\(.*\\)"' + as_echo_n_body='eval + arg=$1; + case $arg in #( + *"$as_nl"*) + expr "X$arg" : "X\\(.*\\)$as_nl"; + arg=`expr "X$arg" : ".*$as_nl\\(.*\\)"`;; + esac; + expr "X$arg" : "X\\(.*\\)" | tr -d "$as_nl" + ' + export as_echo_n_body + as_echo_n='sh -c $as_echo_n_body as_echo' + fi + export as_echo_body + as_echo='sh -c $as_echo_body as_echo' +fi + +# The user is always right. +if test "${PATH_SEPARATOR+set}" != set; then + PATH_SEPARATOR=: + (PATH='/bin;/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 && { + (PATH='/bin:/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 || + PATH_SEPARATOR=';' + } +fi + + +# IFS +# We need space, tab and new line, in precisely that order. Quoting is +# there to prevent editors from complaining about space-tab. +# (If _AS_PATH_WALK were called with IFS unset, it would disable word +# splitting by setting IFS to empty value.) +IFS=" "" $as_nl" + +# Find who we are. Look in the path if we contain no directory separator. +as_myself= +case $0 in #(( + *[\\/]* ) as_myself=$0 ;; + *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break + done +IFS=$as_save_IFS + + ;; +esac +# We did not find ourselves, most probably we were run as `sh COMMAND' +# in which case we are not to be found in the path. +if test "x$as_myself" = x; then + as_myself=$0 +fi +if test ! -f "$as_myself"; then + $as_echo "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2 + exit 1 +fi + +# Unset variables that we do not need and which cause bugs (e.g. in +# pre-3.0 UWIN ksh). But do not cause bugs in bash 2.01; the "|| exit 1" +# suppresses any "Segmentation fault" message there. '((' could +# trigger a bug in pdksh 5.2.14. +for as_var in BASH_ENV ENV MAIL MAILPATH +do eval test x\${$as_var+set} = xset \ + && ( (unset $as_var) || exit 1) >/dev/null 2>&1 && unset $as_var || : +done +PS1='$ ' +PS2='> ' +PS4='+ ' + +# NLS nuisances. +LC_ALL=C +export LC_ALL +LANGUAGE=C +export LANGUAGE + +# CDPATH. +(unset CDPATH) >/dev/null 2>&1 && unset CDPATH + + +# as_fn_error STATUS ERROR [LINENO LOG_FD] +# ---------------------------------------- +# Output "`basename $0`: error: ERROR" to stderr. If LINENO and LOG_FD are +# provided, also output the error to LOG_FD, referencing LINENO. Then exit the +# script with STATUS, using 1 if that was 0. +as_fn_error () +{ + as_status=$1; test $as_status -eq 0 && as_status=1 + if test "$4"; then + as_lineno=${as_lineno-"$3"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + $as_echo "$as_me:${as_lineno-$LINENO}: error: $2" >&$4 + fi + $as_echo "$as_me: error: $2" >&2 + as_fn_exit $as_status +} # as_fn_error + + +# as_fn_set_status STATUS +# ----------------------- +# Set $? to STATUS, without forking. +as_fn_set_status () +{ + return $1 +} # as_fn_set_status + +# as_fn_exit STATUS +# ----------------- +# Exit the shell with STATUS, even in a "trap 0" or "set -e" context. +as_fn_exit () +{ + set +e + as_fn_set_status $1 + exit $1 +} # as_fn_exit + +# as_fn_unset VAR +# --------------- +# Portably unset VAR. +as_fn_unset () +{ + { eval $1=; unset $1;} +} +as_unset=as_fn_unset +# as_fn_append VAR VALUE +# ---------------------- +# Append the text in VALUE to the end of the definition contained in VAR. Take +# advantage of any shell optimizations that allow amortized linear growth over +# repeated appends, instead of the typical quadratic growth present in naive +# implementations. +if (eval "as_var=1; as_var+=2; test x\$as_var = x12") 2>/dev/null; then : + eval 'as_fn_append () + { + eval $1+=\$2 + }' +else + as_fn_append () + { + eval $1=\$$1\$2 + } +fi # as_fn_append + +# as_fn_arith ARG... +# ------------------ +# Perform arithmetic evaluation on the ARGs, and store the result in the +# global $as_val. Take advantage of shells that can avoid forks. The arguments +# must be portable across $(()) and expr. +if (eval "test \$(( 1 + 1 )) = 2") 2>/dev/null; then : + eval 'as_fn_arith () + { + as_val=$(( $* )) + }' +else + as_fn_arith () + { + as_val=`expr "$@" || test $? -eq 1` + } +fi # as_fn_arith + + +if expr a : '\(a\)' >/dev/null 2>&1 && + test "X`expr 00001 : '.*\(...\)'`" = X001; then + as_expr=expr +else + as_expr=false +fi + +if (basename -- /) >/dev/null 2>&1 && test "X`basename -- / 2>&1`" = "X/"; then + as_basename=basename +else + as_basename=false +fi + +if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then + as_dirname=dirname +else + as_dirname=false +fi + +as_me=`$as_basename -- "$0" || +$as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \ + X"$0" : 'X\(//\)$' \| \ + X"$0" : 'X\(/\)' \| . 2>/dev/null || +$as_echo X/"$0" | + sed '/^.*\/\([^/][^/]*\)\/*$/{ + s//\1/ + q + } + /^X\/\(\/\/\)$/{ + s//\1/ + q + } + /^X\/\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q'` + +# Avoid depending upon Character Ranges. +as_cr_letters='abcdefghijklmnopqrstuvwxyz' +as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ' +as_cr_Letters=$as_cr_letters$as_cr_LETTERS +as_cr_digits='0123456789' +as_cr_alnum=$as_cr_Letters$as_cr_digits + +ECHO_C= ECHO_N= ECHO_T= +case `echo -n x` in #((((( +-n*) + case `echo 'xy\c'` in + *c*) ECHO_T=' ';; # ECHO_T is single tab character. + xy) ECHO_C='\c';; + *) echo `echo ksh88 bug on AIX 6.1` > /dev/null + ECHO_T=' ';; + esac;; +*) + ECHO_N='-n';; +esac + +rm -f conf$$ conf$$.exe conf$$.file +if test -d conf$$.dir; then + rm -f conf$$.dir/conf$$.file +else + rm -f conf$$.dir + mkdir conf$$.dir 2>/dev/null +fi +if (echo >conf$$.file) 2>/dev/null; then + if ln -s conf$$.file conf$$ 2>/dev/null; then + as_ln_s='ln -s' + # ... but there are two gotchas: + # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail. + # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable. + # In both cases, we have to default to `cp -pR'. + ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe || + as_ln_s='cp -pR' + elif ln conf$$.file conf$$ 2>/dev/null; then + as_ln_s=ln + else + as_ln_s='cp -pR' + fi +else + as_ln_s='cp -pR' +fi +rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file +rmdir conf$$.dir 2>/dev/null + + +# as_fn_mkdir_p +# ------------- +# Create "$as_dir" as a directory, including parents if necessary. +as_fn_mkdir_p () +{ + + case $as_dir in #( + -*) as_dir=./$as_dir;; + esac + test -d "$as_dir" || eval $as_mkdir_p || { + as_dirs= + while :; do + case $as_dir in #( + *\'*) as_qdir=`$as_echo "$as_dir" | sed "s/'/'\\\\\\\\''/g"`;; #'( + *) as_qdir=$as_dir;; + esac + as_dirs="'$as_qdir' $as_dirs" + as_dir=`$as_dirname -- "$as_dir" || +$as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ + X"$as_dir" : 'X\(//\)[^/]' \| \ + X"$as_dir" : 'X\(//\)$' \| \ + X"$as_dir" : 'X\(/\)' \| . 2>/dev/null || +$as_echo X"$as_dir" | + sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ + s//\1/ + q + } + /^X\(\/\/\)[^/].*/{ + s//\1/ + q + } + /^X\(\/\/\)$/{ + s//\1/ + q + } + /^X\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q'` + test -d "$as_dir" && break + done + test -z "$as_dirs" || eval "mkdir $as_dirs" + } || test -d "$as_dir" || as_fn_error $? "cannot create directory $as_dir" + + +} # as_fn_mkdir_p +if mkdir -p . 2>/dev/null; then + as_mkdir_p='mkdir -p "$as_dir"' +else + test -d ./-p && rmdir ./-p + as_mkdir_p=false +fi + + +# as_fn_executable_p FILE +# ----------------------- +# Test if FILE is an executable regular file. +as_fn_executable_p () +{ + test -f "$1" && test -x "$1" +} # as_fn_executable_p +as_test_x='test -x' +as_executable_p=as_fn_executable_p + +# Sed expression to map a string onto a valid CPP name. +as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'" + +# Sed expression to map a string onto a valid variable name. +as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'" + + +exec 6>&1 +## ----------------------------------- ## +## Main body of $CONFIG_STATUS script. ## +## ----------------------------------- ## +_ASEOF +test $as_write_fail = 0 && chmod +x $CONFIG_STATUS || ac_write_fail=1 + +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +# Save the log message, to keep $0 and so on meaningful, and to +# report actual input values of CONFIG_FILES etc. instead of their +# values after options handling. +ac_log=" +This file was extended by R $as_me 3.4.0, which was +generated by GNU Autoconf 2.69. Invocation command line was + + CONFIG_FILES = $CONFIG_FILES + CONFIG_HEADERS = $CONFIG_HEADERS + CONFIG_LINKS = $CONFIG_LINKS + CONFIG_COMMANDS = $CONFIG_COMMANDS + $ $0 $@ + +on `(hostname || uname -n) 2>/dev/null | sed 1q` +" + +_ACEOF + +case $ac_config_files in *" +"*) set x $ac_config_files; shift; ac_config_files=$*;; +esac + +case $ac_config_headers in *" +"*) set x $ac_config_headers; shift; ac_config_headers=$*;; +esac + + +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +# Files that config.status was made for. +config_files="$ac_config_files" +config_headers="$ac_config_headers" +config_commands="$ac_config_commands" + +_ACEOF + +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +ac_cs_usage="\ +\`$as_me' instantiates files and other configuration actions +from templates according to the current configuration. Unless the files +and actions are specified as TAGs, all are instantiated by default. + +Usage: $0 [OPTION]... [TAG]... + + -h, --help print this help, then exit + -V, --version print version number and configuration settings, then exit + --config print configuration, then exit + -q, --quiet, --silent + do not print progress messages + -d, --debug don't remove temporary files + --recheck update $as_me by reconfiguring in the same conditions + --file=FILE[:TEMPLATE] + instantiate the configuration file FILE + --header=FILE[:TEMPLATE] + instantiate the configuration header FILE + +Configuration files: +$config_files + +Configuration headers: +$config_headers + +Configuration commands: +$config_commands + +Report bugs to <https://bugs.r-project.org>. +R home page: <https://www.r-project.org>." + +_ACEOF +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +ac_cs_config="`$as_echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`" +ac_cs_version="\\ +R config.status 3.4.0 +configured by $0, generated by GNU Autoconf 2.69, + with options \\"\$ac_cs_config\\" + +Copyright (C) 2012 Free Software Foundation, Inc. +This config.status script is free software; the Free Software Foundation +gives unlimited permission to copy, distribute and modify it." + +ac_pwd='$ac_pwd' +srcdir='$srcdir' +INSTALL='$INSTALL' +MKDIR_P='$MKDIR_P' +AWK='$AWK' +test -n "\$AWK" || AWK=awk +_ACEOF + +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +# The default lists apply if the user does not specify any file. +ac_need_defaults=: +while test $# != 0 +do + case $1 in + --*=?*) + ac_option=`expr "X$1" : 'X\([^=]*\)='` + ac_optarg=`expr "X$1" : 'X[^=]*=\(.*\)'` + ac_shift=: + ;; + --*=) + ac_option=`expr "X$1" : 'X\([^=]*\)='` + ac_optarg= + ac_shift=: + ;; + *) + ac_option=$1 + ac_optarg=$2 + ac_shift=shift + ;; + esac + + case $ac_option in + # Handling of the options. + -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r) + ac_cs_recheck=: ;; + --version | --versio | --versi | --vers | --ver | --ve | --v | -V ) + $as_echo "$ac_cs_version"; exit ;; + --config | --confi | --conf | --con | --co | --c ) + $as_echo "$ac_cs_config"; exit ;; + --debug | --debu | --deb | --de | --d | -d ) + debug=: ;; + --file | --fil | --fi | --f ) + $ac_shift + case $ac_optarg in + *\'*) ac_optarg=`$as_echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"` ;; + '') as_fn_error $? "missing file argument" ;; + esac + as_fn_append CONFIG_FILES " '$ac_optarg'" + ac_need_defaults=false;; + --header | --heade | --head | --hea ) + $ac_shift + case $ac_optarg in + *\'*) ac_optarg=`$as_echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"` ;; + esac + as_fn_append CONFIG_HEADERS " '$ac_optarg'" + ac_need_defaults=false;; + --he | --h) + # Conflict between --help and --header + as_fn_error $? "ambiguous option: \`$1' +Try \`$0 --help' for more information.";; + --help | --hel | -h ) + $as_echo "$ac_cs_usage"; exit ;; + -q | -quiet | --quiet | --quie | --qui | --qu | --q \ + | -silent | --silent | --silen | --sile | --sil | --si | --s) + ac_cs_silent=: ;; + + # This is an error. + -*) as_fn_error $? "unrecognized option: \`$1' +Try \`$0 --help' for more information." ;; + + *) as_fn_append ac_config_targets " $1" + ac_need_defaults=false ;; + + esac + shift +done + +ac_configure_extra_args= + +if $ac_cs_silent; then + exec 6>/dev/null + ac_configure_extra_args="$ac_configure_extra_args --silent" +fi + +_ACEOF +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +if \$ac_cs_recheck; then + set X $SHELL '$0' $ac_configure_args \$ac_configure_extra_args --no-create --no-recursion + shift + \$as_echo "running CONFIG_SHELL=$SHELL \$*" >&6 + CONFIG_SHELL='$SHELL' + export CONFIG_SHELL + exec "\$@" +fi + +_ACEOF +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +exec 5>>config.log +{ + echo + sed 'h;s/./-/g;s/^.../## /;s/...$/ ##/;p;x;p;x' <<_ASBOX +## Running $as_me. ## +_ASBOX + $as_echo "$ac_log" +} >&5 + +_ACEOF +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +# +# INIT-COMMANDS +# + + +# The HP-UX ksh and POSIX shell print the target directory to stdout +# if CDPATH is set. +(unset CDPATH) >/dev/null 2>&1 && unset CDPATH + +sed_quote_subst='$sed_quote_subst' +double_quote_subst='$double_quote_subst' +delay_variable_subst='$delay_variable_subst' +enable_static='`$ECHO "$enable_static" | $SED "$delay_single_quote_subst"`' +macro_version='`$ECHO "$macro_version" | $SED "$delay_single_quote_subst"`' +macro_revision='`$ECHO "$macro_revision" | $SED "$delay_single_quote_subst"`' +enable_shared='`$ECHO "$enable_shared" | $SED "$delay_single_quote_subst"`' +pic_mode='`$ECHO "$pic_mode" | $SED "$delay_single_quote_subst"`' +enable_fast_install='`$ECHO "$enable_fast_install" | $SED "$delay_single_quote_subst"`' +shared_archive_member_spec='`$ECHO "$shared_archive_member_spec" | $SED "$delay_single_quote_subst"`' +SHELL='`$ECHO "$SHELL" | $SED "$delay_single_quote_subst"`' +ECHO='`$ECHO "$ECHO" | $SED "$delay_single_quote_subst"`' +PATH_SEPARATOR='`$ECHO "$PATH_SEPARATOR" | $SED "$delay_single_quote_subst"`' +host_alias='`$ECHO "$host_alias" | $SED "$delay_single_quote_subst"`' +host='`$ECHO "$host" | $SED "$delay_single_quote_subst"`' +host_os='`$ECHO "$host_os" | $SED "$delay_single_quote_subst"`' +build_alias='`$ECHO "$build_alias" | $SED "$delay_single_quote_subst"`' +build='`$ECHO "$build" | $SED "$delay_single_quote_subst"`' +build_os='`$ECHO "$build_os" | $SED "$delay_single_quote_subst"`' +SED='`$ECHO "$SED" | $SED "$delay_single_quote_subst"`' +Xsed='`$ECHO "$Xsed" | $SED "$delay_single_quote_subst"`' +GREP='`$ECHO "$GREP" | $SED "$delay_single_quote_subst"`' +EGREP='`$ECHO "$EGREP" | $SED "$delay_single_quote_subst"`' +FGREP='`$ECHO "$FGREP" | $SED "$delay_single_quote_subst"`' +LD='`$ECHO "$LD" | $SED "$delay_single_quote_subst"`' +NM='`$ECHO "$NM" | $SED "$delay_single_quote_subst"`' +LN_S='`$ECHO "$LN_S" | $SED "$delay_single_quote_subst"`' +max_cmd_len='`$ECHO "$max_cmd_len" | $SED "$delay_single_quote_subst"`' +ac_objext='`$ECHO "$ac_objext" | $SED "$delay_single_quote_subst"`' +exeext='`$ECHO "$exeext" | $SED "$delay_single_quote_subst"`' +lt_unset='`$ECHO "$lt_unset" | $SED "$delay_single_quote_subst"`' +lt_SP2NL='`$ECHO "$lt_SP2NL" | $SED "$delay_single_quote_subst"`' +lt_NL2SP='`$ECHO "$lt_NL2SP" | $SED "$delay_single_quote_subst"`' +lt_cv_to_host_file_cmd='`$ECHO "$lt_cv_to_host_file_cmd" | $SED "$delay_single_quote_subst"`' +lt_cv_to_tool_file_cmd='`$ECHO "$lt_cv_to_tool_file_cmd" | $SED "$delay_single_quote_subst"`' +reload_flag='`$ECHO "$reload_flag" | $SED "$delay_single_quote_subst"`' +reload_cmds='`$ECHO "$reload_cmds" | $SED "$delay_single_quote_subst"`' +OBJDUMP='`$ECHO "$OBJDUMP" | $SED "$delay_single_quote_subst"`' +deplibs_check_method='`$ECHO "$deplibs_check_method" | $SED "$delay_single_quote_subst"`' +file_magic_cmd='`$ECHO "$file_magic_cmd" | $SED "$delay_single_quote_subst"`' +file_magic_glob='`$ECHO "$file_magic_glob" | $SED "$delay_single_quote_subst"`' +want_nocaseglob='`$ECHO "$want_nocaseglob" | $SED "$delay_single_quote_subst"`' +DLLTOOL='`$ECHO "$DLLTOOL" | $SED "$delay_single_quote_subst"`' +sharedlib_from_linklib_cmd='`$ECHO "$sharedlib_from_linklib_cmd" | $SED "$delay_single_quote_subst"`' +AR='`$ECHO "$AR" | $SED "$delay_single_quote_subst"`' +AR_FLAGS='`$ECHO "$AR_FLAGS" | $SED "$delay_single_quote_subst"`' +archiver_list_spec='`$ECHO "$archiver_list_spec" | $SED "$delay_single_quote_subst"`' +STRIP='`$ECHO "$STRIP" | $SED "$delay_single_quote_subst"`' +RANLIB='`$ECHO "$RANLIB" | $SED "$delay_single_quote_subst"`' +old_postinstall_cmds='`$ECHO "$old_postinstall_cmds" | $SED "$delay_single_quote_subst"`' +old_postuninstall_cmds='`$ECHO "$old_postuninstall_cmds" | $SED "$delay_single_quote_subst"`' +old_archive_cmds='`$ECHO "$old_archive_cmds" | $SED "$delay_single_quote_subst"`' +lock_old_archive_extraction='`$ECHO "$lock_old_archive_extraction" | $SED "$delay_single_quote_subst"`' +CC='`$ECHO "$CC" | $SED "$delay_single_quote_subst"`' +CFLAGS='`$ECHO "$CFLAGS" | $SED "$delay_single_quote_subst"`' +compiler='`$ECHO "$compiler" | $SED "$delay_single_quote_subst"`' +GCC='`$ECHO "$GCC" | $SED "$delay_single_quote_subst"`' +lt_cv_sys_global_symbol_pipe='`$ECHO "$lt_cv_sys_global_symbol_pipe" | $SED "$delay_single_quote_subst"`' +lt_cv_sys_global_symbol_to_cdecl='`$ECHO "$lt_cv_sys_global_symbol_to_cdecl" | $SED "$delay_single_quote_subst"`' +lt_cv_sys_global_symbol_to_import='`$ECHO "$lt_cv_sys_global_symbol_to_import" | $SED "$delay_single_quote_subst"`' +lt_cv_sys_global_symbol_to_c_name_address='`$ECHO "$lt_cv_sys_global_symbol_to_c_name_address" | $SED "$delay_single_quote_subst"`' +lt_cv_sys_global_symbol_to_c_name_address_lib_prefix='`$ECHO "$lt_cv_sys_global_symbol_to_c_name_address_lib_prefix" | $SED "$delay_single_quote_subst"`' +lt_cv_nm_interface='`$ECHO "$lt_cv_nm_interface" | $SED "$delay_single_quote_subst"`' +nm_file_list_spec='`$ECHO "$nm_file_list_spec" | $SED "$delay_single_quote_subst"`' +lt_sysroot='`$ECHO "$lt_sysroot" | $SED "$delay_single_quote_subst"`' +lt_cv_truncate_bin='`$ECHO "$lt_cv_truncate_bin" | $SED "$delay_single_quote_subst"`' +objdir='`$ECHO "$objdir" | $SED "$delay_single_quote_subst"`' +MAGIC_CMD='`$ECHO "$MAGIC_CMD" | $SED "$delay_single_quote_subst"`' +lt_prog_compiler_no_builtin_flag='`$ECHO "$lt_prog_compiler_no_builtin_flag" | $SED "$delay_single_quote_subst"`' +lt_prog_compiler_pic='`$ECHO "$lt_prog_compiler_pic" | $SED "$delay_single_quote_subst"`' +lt_prog_compiler_wl='`$ECHO "$lt_prog_compiler_wl" | $SED "$delay_single_quote_subst"`' +lt_prog_compiler_static='`$ECHO "$lt_prog_compiler_static" | $SED "$delay_single_quote_subst"`' +lt_cv_prog_compiler_c_o='`$ECHO "$lt_cv_prog_compiler_c_o" | $SED "$delay_single_quote_subst"`' +need_locks='`$ECHO "$need_locks" | $SED "$delay_single_quote_subst"`' +MANIFEST_TOOL='`$ECHO "$MANIFEST_TOOL" | $SED "$delay_single_quote_subst"`' +DSYMUTIL='`$ECHO "$DSYMUTIL" | $SED "$delay_single_quote_subst"`' +NMEDIT='`$ECHO "$NMEDIT" | $SED "$delay_single_quote_subst"`' +LIPO='`$ECHO "$LIPO" | $SED "$delay_single_quote_subst"`' +OTOOL='`$ECHO "$OTOOL" | $SED "$delay_single_quote_subst"`' +OTOOL64='`$ECHO "$OTOOL64" | $SED "$delay_single_quote_subst"`' +libext='`$ECHO "$libext" | $SED "$delay_single_quote_subst"`' +shrext_cmds='`$ECHO "$shrext_cmds" | $SED "$delay_single_quote_subst"`' +extract_expsyms_cmds='`$ECHO "$extract_expsyms_cmds" | $SED "$delay_single_quote_subst"`' +archive_cmds_need_lc='`$ECHO "$archive_cmds_need_lc" | $SED "$delay_single_quote_subst"`' +enable_shared_with_static_runtimes='`$ECHO "$enable_shared_with_static_runtimes" | $SED "$delay_single_quote_subst"`' +export_dynamic_flag_spec='`$ECHO "$export_dynamic_flag_spec" | $SED "$delay_single_quote_subst"`' +whole_archive_flag_spec='`$ECHO "$whole_archive_flag_spec" | $SED "$delay_single_quote_subst"`' +compiler_needs_object='`$ECHO "$compiler_needs_object" | $SED "$delay_single_quote_subst"`' +old_archive_from_new_cmds='`$ECHO "$old_archive_from_new_cmds" | $SED "$delay_single_quote_subst"`' +old_archive_from_expsyms_cmds='`$ECHO "$old_archive_from_expsyms_cmds" | $SED "$delay_single_quote_subst"`' +archive_cmds='`$ECHO "$archive_cmds" | $SED "$delay_single_quote_subst"`' +archive_expsym_cmds='`$ECHO "$archive_expsym_cmds" | $SED "$delay_single_quote_subst"`' +module_cmds='`$ECHO "$module_cmds" | $SED "$delay_single_quote_subst"`' +module_expsym_cmds='`$ECHO "$module_expsym_cmds" | $SED "$delay_single_quote_subst"`' +with_gnu_ld='`$ECHO "$with_gnu_ld" | $SED "$delay_single_quote_subst"`' +allow_undefined_flag='`$ECHO "$allow_undefined_flag" | $SED "$delay_single_quote_subst"`' +no_undefined_flag='`$ECHO "$no_undefined_flag" | $SED "$delay_single_quote_subst"`' +hardcode_libdir_flag_spec='`$ECHO "$hardcode_libdir_flag_spec" | $SED "$delay_single_quote_subst"`' +hardcode_libdir_separator='`$ECHO "$hardcode_libdir_separator" | $SED "$delay_single_quote_subst"`' +hardcode_direct='`$ECHO "$hardcode_direct" | $SED "$delay_single_quote_subst"`' +hardcode_direct_absolute='`$ECHO "$hardcode_direct_absolute" | $SED "$delay_single_quote_subst"`' +hardcode_minus_L='`$ECHO "$hardcode_minus_L" | $SED "$delay_single_quote_subst"`' +hardcode_shlibpath_var='`$ECHO "$hardcode_shlibpath_var" | $SED "$delay_single_quote_subst"`' +hardcode_automatic='`$ECHO "$hardcode_automatic" | $SED "$delay_single_quote_subst"`' +inherit_rpath='`$ECHO "$inherit_rpath" | $SED "$delay_single_quote_subst"`' +link_all_deplibs='`$ECHO "$link_all_deplibs" | $SED "$delay_single_quote_subst"`' +always_export_symbols='`$ECHO "$always_export_symbols" | $SED "$delay_single_quote_subst"`' +export_symbols_cmds='`$ECHO "$export_symbols_cmds" | $SED "$delay_single_quote_subst"`' +exclude_expsyms='`$ECHO "$exclude_expsyms" | $SED "$delay_single_quote_subst"`' +include_expsyms='`$ECHO "$include_expsyms" | $SED "$delay_single_quote_subst"`' +prelink_cmds='`$ECHO "$prelink_cmds" | $SED "$delay_single_quote_subst"`' +postlink_cmds='`$ECHO "$postlink_cmds" | $SED "$delay_single_quote_subst"`' +file_list_spec='`$ECHO "$file_list_spec" | $SED "$delay_single_quote_subst"`' +variables_saved_for_relink='`$ECHO "$variables_saved_for_relink" | $SED "$delay_single_quote_subst"`' +need_lib_prefix='`$ECHO "$need_lib_prefix" | $SED "$delay_single_quote_subst"`' +need_version='`$ECHO "$need_version" | $SED "$delay_single_quote_subst"`' +version_type='`$ECHO "$version_type" | $SED "$delay_single_quote_subst"`' +runpath_var='`$ECHO "$runpath_var" | $SED "$delay_single_quote_subst"`' +shlibpath_var='`$ECHO "$shlibpath_var" | $SED "$delay_single_quote_subst"`' +shlibpath_overrides_runpath='`$ECHO "$shlibpath_overrides_runpath" | $SED "$delay_single_quote_subst"`' +libname_spec='`$ECHO "$libname_spec" | $SED "$delay_single_quote_subst"`' +library_names_spec='`$ECHO "$library_names_spec" | $SED "$delay_single_quote_subst"`' +soname_spec='`$ECHO "$soname_spec" | $SED "$delay_single_quote_subst"`' +install_override_mode='`$ECHO "$install_override_mode" | $SED "$delay_single_quote_subst"`' +postinstall_cmds='`$ECHO "$postinstall_cmds" | $SED "$delay_single_quote_subst"`' +postuninstall_cmds='`$ECHO "$postuninstall_cmds" | $SED "$delay_single_quote_subst"`' +finish_cmds='`$ECHO "$finish_cmds" | $SED "$delay_single_quote_subst"`' +finish_eval='`$ECHO "$finish_eval" | $SED "$delay_single_quote_subst"`' +hardcode_into_libs='`$ECHO "$hardcode_into_libs" | $SED "$delay_single_quote_subst"`' +sys_lib_search_path_spec='`$ECHO "$sys_lib_search_path_spec" | $SED "$delay_single_quote_subst"`' +configure_time_dlsearch_path='`$ECHO "$configure_time_dlsearch_path" | $SED "$delay_single_quote_subst"`' +configure_time_lt_sys_library_path='`$ECHO "$configure_time_lt_sys_library_path" | $SED "$delay_single_quote_subst"`' +hardcode_action='`$ECHO "$hardcode_action" | $SED "$delay_single_quote_subst"`' +enable_dlopen='`$ECHO "$enable_dlopen" | $SED "$delay_single_quote_subst"`' +enable_dlopen_self='`$ECHO "$enable_dlopen_self" | $SED "$delay_single_quote_subst"`' +enable_dlopen_self_static='`$ECHO "$enable_dlopen_self_static" | $SED "$delay_single_quote_subst"`' +old_striplib='`$ECHO "$old_striplib" | $SED "$delay_single_quote_subst"`' +striplib='`$ECHO "$striplib" | $SED "$delay_single_quote_subst"`' +compiler_lib_search_dirs='`$ECHO "$compiler_lib_search_dirs" | $SED "$delay_single_quote_subst"`' +predep_objects='`$ECHO "$predep_objects" | $SED "$delay_single_quote_subst"`' +postdep_objects='`$ECHO "$postdep_objects" | $SED "$delay_single_quote_subst"`' +predeps='`$ECHO "$predeps" | $SED "$delay_single_quote_subst"`' +postdeps='`$ECHO "$postdeps" | $SED "$delay_single_quote_subst"`' +compiler_lib_search_path='`$ECHO "$compiler_lib_search_path" | $SED "$delay_single_quote_subst"`' +LD_CXX='`$ECHO "$LD_CXX" | $SED "$delay_single_quote_subst"`' +LD_F77='`$ECHO "$LD_F77" | $SED "$delay_single_quote_subst"`' +LD_FC='`$ECHO "$LD_FC" | $SED "$delay_single_quote_subst"`' +reload_flag_CXX='`$ECHO "$reload_flag_CXX" | $SED "$delay_single_quote_subst"`' +reload_flag_F77='`$ECHO "$reload_flag_F77" | $SED "$delay_single_quote_subst"`' +reload_flag_FC='`$ECHO "$reload_flag_FC" | $SED "$delay_single_quote_subst"`' +reload_cmds_CXX='`$ECHO "$reload_cmds_CXX" | $SED "$delay_single_quote_subst"`' +reload_cmds_F77='`$ECHO "$reload_cmds_F77" | $SED "$delay_single_quote_subst"`' +reload_cmds_FC='`$ECHO "$reload_cmds_FC" | $SED "$delay_single_quote_subst"`' +old_archive_cmds_CXX='`$ECHO "$old_archive_cmds_CXX" | $SED "$delay_single_quote_subst"`' +old_archive_cmds_F77='`$ECHO "$old_archive_cmds_F77" | $SED "$delay_single_quote_subst"`' +old_archive_cmds_FC='`$ECHO "$old_archive_cmds_FC" | $SED "$delay_single_quote_subst"`' +compiler_CXX='`$ECHO "$compiler_CXX" | $SED "$delay_single_quote_subst"`' +compiler_F77='`$ECHO "$compiler_F77" | $SED "$delay_single_quote_subst"`' +compiler_FC='`$ECHO "$compiler_FC" | $SED "$delay_single_quote_subst"`' +GCC_CXX='`$ECHO "$GCC_CXX" | $SED "$delay_single_quote_subst"`' +GCC_F77='`$ECHO "$GCC_F77" | $SED "$delay_single_quote_subst"`' +GCC_FC='`$ECHO "$GCC_FC" | $SED "$delay_single_quote_subst"`' +lt_prog_compiler_no_builtin_flag_CXX='`$ECHO "$lt_prog_compiler_no_builtin_flag_CXX" | $SED "$delay_single_quote_subst"`' +lt_prog_compiler_no_builtin_flag_F77='`$ECHO "$lt_prog_compiler_no_builtin_flag_F77" | $SED "$delay_single_quote_subst"`' +lt_prog_compiler_no_builtin_flag_FC='`$ECHO "$lt_prog_compiler_no_builtin_flag_FC" | $SED "$delay_single_quote_subst"`' +lt_prog_compiler_pic_CXX='`$ECHO "$lt_prog_compiler_pic_CXX" | $SED "$delay_single_quote_subst"`' +lt_prog_compiler_pic_F77='`$ECHO "$lt_prog_compiler_pic_F77" | $SED "$delay_single_quote_subst"`' +lt_prog_compiler_pic_FC='`$ECHO "$lt_prog_compiler_pic_FC" | $SED "$delay_single_quote_subst"`' +lt_prog_compiler_wl_CXX='`$ECHO "$lt_prog_compiler_wl_CXX" | $SED "$delay_single_quote_subst"`' +lt_prog_compiler_wl_F77='`$ECHO "$lt_prog_compiler_wl_F77" | $SED "$delay_single_quote_subst"`' +lt_prog_compiler_wl_FC='`$ECHO "$lt_prog_compiler_wl_FC" | $SED "$delay_single_quote_subst"`' +lt_prog_compiler_static_CXX='`$ECHO "$lt_prog_compiler_static_CXX" | $SED "$delay_single_quote_subst"`' +lt_prog_compiler_static_F77='`$ECHO "$lt_prog_compiler_static_F77" | $SED "$delay_single_quote_subst"`' +lt_prog_compiler_static_FC='`$ECHO "$lt_prog_compiler_static_FC" | $SED "$delay_single_quote_subst"`' +lt_cv_prog_compiler_c_o_CXX='`$ECHO "$lt_cv_prog_compiler_c_o_CXX" | $SED "$delay_single_quote_subst"`' +lt_cv_prog_compiler_c_o_F77='`$ECHO "$lt_cv_prog_compiler_c_o_F77" | $SED "$delay_single_quote_subst"`' +lt_cv_prog_compiler_c_o_FC='`$ECHO "$lt_cv_prog_compiler_c_o_FC" | $SED "$delay_single_quote_subst"`' +archive_cmds_need_lc_CXX='`$ECHO "$archive_cmds_need_lc_CXX" | $SED "$delay_single_quote_subst"`' +archive_cmds_need_lc_F77='`$ECHO "$archive_cmds_need_lc_F77" | $SED "$delay_single_quote_subst"`' +archive_cmds_need_lc_FC='`$ECHO "$archive_cmds_need_lc_FC" | $SED "$delay_single_quote_subst"`' +enable_shared_with_static_runtimes_CXX='`$ECHO "$enable_shared_with_static_runtimes_CXX" | $SED "$delay_single_quote_subst"`' +enable_shared_with_static_runtimes_F77='`$ECHO "$enable_shared_with_static_runtimes_F77" | $SED "$delay_single_quote_subst"`' +enable_shared_with_static_runtimes_FC='`$ECHO "$enable_shared_with_static_runtimes_FC" | $SED "$delay_single_quote_subst"`' +export_dynamic_flag_spec_CXX='`$ECHO "$export_dynamic_flag_spec_CXX" | $SED "$delay_single_quote_subst"`' +export_dynamic_flag_spec_F77='`$ECHO "$export_dynamic_flag_spec_F77" | $SED "$delay_single_quote_subst"`' +export_dynamic_flag_spec_FC='`$ECHO "$export_dynamic_flag_spec_FC" | $SED "$delay_single_quote_subst"`' +whole_archive_flag_spec_CXX='`$ECHO "$whole_archive_flag_spec_CXX" | $SED "$delay_single_quote_subst"`' +whole_archive_flag_spec_F77='`$ECHO "$whole_archive_flag_spec_F77" | $SED "$delay_single_quote_subst"`' +whole_archive_flag_spec_FC='`$ECHO "$whole_archive_flag_spec_FC" | $SED "$delay_single_quote_subst"`' +compiler_needs_object_CXX='`$ECHO "$compiler_needs_object_CXX" | $SED "$delay_single_quote_subst"`' +compiler_needs_object_F77='`$ECHO "$compiler_needs_object_F77" | $SED "$delay_single_quote_subst"`' +compiler_needs_object_FC='`$ECHO "$compiler_needs_object_FC" | $SED "$delay_single_quote_subst"`' +old_archive_from_new_cmds_CXX='`$ECHO "$old_archive_from_new_cmds_CXX" | $SED "$delay_single_quote_subst"`' +old_archive_from_new_cmds_F77='`$ECHO "$old_archive_from_new_cmds_F77" | $SED "$delay_single_quote_subst"`' +old_archive_from_new_cmds_FC='`$ECHO "$old_archive_from_new_cmds_FC" | $SED "$delay_single_quote_subst"`' +old_archive_from_expsyms_cmds_CXX='`$ECHO "$old_archive_from_expsyms_cmds_CXX" | $SED "$delay_single_quote_subst"`' +old_archive_from_expsyms_cmds_F77='`$ECHO "$old_archive_from_expsyms_cmds_F77" | $SED "$delay_single_quote_subst"`' +old_archive_from_expsyms_cmds_FC='`$ECHO "$old_archive_from_expsyms_cmds_FC" | $SED "$delay_single_quote_subst"`' +archive_cmds_CXX='`$ECHO "$archive_cmds_CXX" | $SED "$delay_single_quote_subst"`' +archive_cmds_F77='`$ECHO "$archive_cmds_F77" | $SED "$delay_single_quote_subst"`' +archive_cmds_FC='`$ECHO "$archive_cmds_FC" | $SED "$delay_single_quote_subst"`' +archive_expsym_cmds_CXX='`$ECHO "$archive_expsym_cmds_CXX" | $SED "$delay_single_quote_subst"`' +archive_expsym_cmds_F77='`$ECHO "$archive_expsym_cmds_F77" | $SED "$delay_single_quote_subst"`' +archive_expsym_cmds_FC='`$ECHO "$archive_expsym_cmds_FC" | $SED "$delay_single_quote_subst"`' +module_cmds_CXX='`$ECHO "$module_cmds_CXX" | $SED "$delay_single_quote_subst"`' +module_cmds_F77='`$ECHO "$module_cmds_F77" | $SED "$delay_single_quote_subst"`' +module_cmds_FC='`$ECHO "$module_cmds_FC" | $SED "$delay_single_quote_subst"`' +module_expsym_cmds_CXX='`$ECHO "$module_expsym_cmds_CXX" | $SED "$delay_single_quote_subst"`' +module_expsym_cmds_F77='`$ECHO "$module_expsym_cmds_F77" | $SED "$delay_single_quote_subst"`' +module_expsym_cmds_FC='`$ECHO "$module_expsym_cmds_FC" | $SED "$delay_single_quote_subst"`' +with_gnu_ld_CXX='`$ECHO "$with_gnu_ld_CXX" | $SED "$delay_single_quote_subst"`' +with_gnu_ld_F77='`$ECHO "$with_gnu_ld_F77" | $SED "$delay_single_quote_subst"`' +with_gnu_ld_FC='`$ECHO "$with_gnu_ld_FC" | $SED "$delay_single_quote_subst"`' +allow_undefined_flag_CXX='`$ECHO "$allow_undefined_flag_CXX" | $SED "$delay_single_quote_subst"`' +allow_undefined_flag_F77='`$ECHO "$allow_undefined_flag_F77" | $SED "$delay_single_quote_subst"`' +allow_undefined_flag_FC='`$ECHO "$allow_undefined_flag_FC" | $SED "$delay_single_quote_subst"`' +no_undefined_flag_CXX='`$ECHO "$no_undefined_flag_CXX" | $SED "$delay_single_quote_subst"`' +no_undefined_flag_F77='`$ECHO "$no_undefined_flag_F77" | $SED "$delay_single_quote_subst"`' +no_undefined_flag_FC='`$ECHO "$no_undefined_flag_FC" | $SED "$delay_single_quote_subst"`' +hardcode_libdir_flag_spec_CXX='`$ECHO "$hardcode_libdir_flag_spec_CXX" | $SED "$delay_single_quote_subst"`' +hardcode_libdir_flag_spec_F77='`$ECHO "$hardcode_libdir_flag_spec_F77" | $SED "$delay_single_quote_subst"`' +hardcode_libdir_flag_spec_FC='`$ECHO "$hardcode_libdir_flag_spec_FC" | $SED "$delay_single_quote_subst"`' +hardcode_libdir_separator_CXX='`$ECHO "$hardcode_libdir_separator_CXX" | $SED "$delay_single_quote_subst"`' +hardcode_libdir_separator_F77='`$ECHO "$hardcode_libdir_separator_F77" | $SED "$delay_single_quote_subst"`' +hardcode_libdir_separator_FC='`$ECHO "$hardcode_libdir_separator_FC" | $SED "$delay_single_quote_subst"`' +hardcode_direct_CXX='`$ECHO "$hardcode_direct_CXX" | $SED "$delay_single_quote_subst"`' +hardcode_direct_F77='`$ECHO "$hardcode_direct_F77" | $SED "$delay_single_quote_subst"`' +hardcode_direct_FC='`$ECHO "$hardcode_direct_FC" | $SED "$delay_single_quote_subst"`' +hardcode_direct_absolute_CXX='`$ECHO "$hardcode_direct_absolute_CXX" | $SED "$delay_single_quote_subst"`' +hardcode_direct_absolute_F77='`$ECHO "$hardcode_direct_absolute_F77" | $SED "$delay_single_quote_subst"`' +hardcode_direct_absolute_FC='`$ECHO "$hardcode_direct_absolute_FC" | $SED "$delay_single_quote_subst"`' +hardcode_minus_L_CXX='`$ECHO "$hardcode_minus_L_CXX" | $SED "$delay_single_quote_subst"`' +hardcode_minus_L_F77='`$ECHO "$hardcode_minus_L_F77" | $SED "$delay_single_quote_subst"`' +hardcode_minus_L_FC='`$ECHO "$hardcode_minus_L_FC" | $SED "$delay_single_quote_subst"`' +hardcode_shlibpath_var_CXX='`$ECHO "$hardcode_shlibpath_var_CXX" | $SED "$delay_single_quote_subst"`' +hardcode_shlibpath_var_F77='`$ECHO "$hardcode_shlibpath_var_F77" | $SED "$delay_single_quote_subst"`' +hardcode_shlibpath_var_FC='`$ECHO "$hardcode_shlibpath_var_FC" | $SED "$delay_single_quote_subst"`' +hardcode_automatic_CXX='`$ECHO "$hardcode_automatic_CXX" | $SED "$delay_single_quote_subst"`' +hardcode_automatic_F77='`$ECHO "$hardcode_automatic_F77" | $SED "$delay_single_quote_subst"`' +hardcode_automatic_FC='`$ECHO "$hardcode_automatic_FC" | $SED "$delay_single_quote_subst"`' +inherit_rpath_CXX='`$ECHO "$inherit_rpath_CXX" | $SED "$delay_single_quote_subst"`' +inherit_rpath_F77='`$ECHO "$inherit_rpath_F77" | $SED "$delay_single_quote_subst"`' +inherit_rpath_FC='`$ECHO "$inherit_rpath_FC" | $SED "$delay_single_quote_subst"`' +link_all_deplibs_CXX='`$ECHO "$link_all_deplibs_CXX" | $SED "$delay_single_quote_subst"`' +link_all_deplibs_F77='`$ECHO "$link_all_deplibs_F77" | $SED "$delay_single_quote_subst"`' +link_all_deplibs_FC='`$ECHO "$link_all_deplibs_FC" | $SED "$delay_single_quote_subst"`' +always_export_symbols_CXX='`$ECHO "$always_export_symbols_CXX" | $SED "$delay_single_quote_subst"`' +always_export_symbols_F77='`$ECHO "$always_export_symbols_F77" | $SED "$delay_single_quote_subst"`' +always_export_symbols_FC='`$ECHO "$always_export_symbols_FC" | $SED "$delay_single_quote_subst"`' +export_symbols_cmds_CXX='`$ECHO "$export_symbols_cmds_CXX" | $SED "$delay_single_quote_subst"`' +export_symbols_cmds_F77='`$ECHO "$export_symbols_cmds_F77" | $SED "$delay_single_quote_subst"`' +export_symbols_cmds_FC='`$ECHO "$export_symbols_cmds_FC" | $SED "$delay_single_quote_subst"`' +exclude_expsyms_CXX='`$ECHO "$exclude_expsyms_CXX" | $SED "$delay_single_quote_subst"`' +exclude_expsyms_F77='`$ECHO "$exclude_expsyms_F77" | $SED "$delay_single_quote_subst"`' +exclude_expsyms_FC='`$ECHO "$exclude_expsyms_FC" | $SED "$delay_single_quote_subst"`' +include_expsyms_CXX='`$ECHO "$include_expsyms_CXX" | $SED "$delay_single_quote_subst"`' +include_expsyms_F77='`$ECHO "$include_expsyms_F77" | $SED "$delay_single_quote_subst"`' +include_expsyms_FC='`$ECHO "$include_expsyms_FC" | $SED "$delay_single_quote_subst"`' +prelink_cmds_CXX='`$ECHO "$prelink_cmds_CXX" | $SED "$delay_single_quote_subst"`' +prelink_cmds_F77='`$ECHO "$prelink_cmds_F77" | $SED "$delay_single_quote_subst"`' +prelink_cmds_FC='`$ECHO "$prelink_cmds_FC" | $SED "$delay_single_quote_subst"`' +postlink_cmds_CXX='`$ECHO "$postlink_cmds_CXX" | $SED "$delay_single_quote_subst"`' +postlink_cmds_F77='`$ECHO "$postlink_cmds_F77" | $SED "$delay_single_quote_subst"`' +postlink_cmds_FC='`$ECHO "$postlink_cmds_FC" | $SED "$delay_single_quote_subst"`' +file_list_spec_CXX='`$ECHO "$file_list_spec_CXX" | $SED "$delay_single_quote_subst"`' +file_list_spec_F77='`$ECHO "$file_list_spec_F77" | $SED "$delay_single_quote_subst"`' +file_list_spec_FC='`$ECHO "$file_list_spec_FC" | $SED "$delay_single_quote_subst"`' +hardcode_action_CXX='`$ECHO "$hardcode_action_CXX" | $SED "$delay_single_quote_subst"`' +hardcode_action_F77='`$ECHO "$hardcode_action_F77" | $SED "$delay_single_quote_subst"`' +hardcode_action_FC='`$ECHO "$hardcode_action_FC" | $SED "$delay_single_quote_subst"`' +compiler_lib_search_dirs_CXX='`$ECHO "$compiler_lib_search_dirs_CXX" | $SED "$delay_single_quote_subst"`' +compiler_lib_search_dirs_F77='`$ECHO "$compiler_lib_search_dirs_F77" | $SED "$delay_single_quote_subst"`' +compiler_lib_search_dirs_FC='`$ECHO "$compiler_lib_search_dirs_FC" | $SED "$delay_single_quote_subst"`' +predep_objects_CXX='`$ECHO "$predep_objects_CXX" | $SED "$delay_single_quote_subst"`' +predep_objects_F77='`$ECHO "$predep_objects_F77" | $SED "$delay_single_quote_subst"`' +predep_objects_FC='`$ECHO "$predep_objects_FC" | $SED "$delay_single_quote_subst"`' +postdep_objects_CXX='`$ECHO "$postdep_objects_CXX" | $SED "$delay_single_quote_subst"`' +postdep_objects_F77='`$ECHO "$postdep_objects_F77" | $SED "$delay_single_quote_subst"`' +postdep_objects_FC='`$ECHO "$postdep_objects_FC" | $SED "$delay_single_quote_subst"`' +predeps_CXX='`$ECHO "$predeps_CXX" | $SED "$delay_single_quote_subst"`' +predeps_F77='`$ECHO "$predeps_F77" | $SED "$delay_single_quote_subst"`' +predeps_FC='`$ECHO "$predeps_FC" | $SED "$delay_single_quote_subst"`' +postdeps_CXX='`$ECHO "$postdeps_CXX" | $SED "$delay_single_quote_subst"`' +postdeps_F77='`$ECHO "$postdeps_F77" | $SED "$delay_single_quote_subst"`' +postdeps_FC='`$ECHO "$postdeps_FC" | $SED "$delay_single_quote_subst"`' +compiler_lib_search_path_CXX='`$ECHO "$compiler_lib_search_path_CXX" | $SED "$delay_single_quote_subst"`' +compiler_lib_search_path_F77='`$ECHO "$compiler_lib_search_path_F77" | $SED "$delay_single_quote_subst"`' +compiler_lib_search_path_FC='`$ECHO "$compiler_lib_search_path_FC" | $SED "$delay_single_quote_subst"`' + +LTCC='$LTCC' +LTCFLAGS='$LTCFLAGS' +compiler='$compiler_DEFAULT' + +# A function that is used when there is no print builtin or printf. +func_fallback_echo () +{ + eval 'cat <<_LTECHO_EOF +\$1 +_LTECHO_EOF' +} + +# Quote evaled strings. +for var in SHELL \ +ECHO \ +PATH_SEPARATOR \ +SED \ +GREP \ +EGREP \ +FGREP \ +LD \ +NM \ +LN_S \ +lt_SP2NL \ +lt_NL2SP \ +reload_flag \ +OBJDUMP \ +deplibs_check_method \ +file_magic_cmd \ +file_magic_glob \ +want_nocaseglob \ +DLLTOOL \ +sharedlib_from_linklib_cmd \ +AR \ +AR_FLAGS \ +archiver_list_spec \ +STRIP \ +RANLIB \ +CC \ +CFLAGS \ +compiler \ +lt_cv_sys_global_symbol_pipe \ +lt_cv_sys_global_symbol_to_cdecl \ +lt_cv_sys_global_symbol_to_import \ +lt_cv_sys_global_symbol_to_c_name_address \ +lt_cv_sys_global_symbol_to_c_name_address_lib_prefix \ +lt_cv_nm_interface \ +nm_file_list_spec \ +lt_cv_truncate_bin \ +lt_prog_compiler_no_builtin_flag \ +lt_prog_compiler_pic \ +lt_prog_compiler_wl \ +lt_prog_compiler_static \ +lt_cv_prog_compiler_c_o \ +need_locks \ +MANIFEST_TOOL \ +DSYMUTIL \ +NMEDIT \ +LIPO \ +OTOOL \ +OTOOL64 \ +shrext_cmds \ +export_dynamic_flag_spec \ +whole_archive_flag_spec \ +compiler_needs_object \ +with_gnu_ld \ +allow_undefined_flag \ +no_undefined_flag \ +hardcode_libdir_flag_spec \ +hardcode_libdir_separator \ +exclude_expsyms \ +include_expsyms \ +file_list_spec \ +variables_saved_for_relink \ +libname_spec \ +library_names_spec \ +soname_spec \ +install_override_mode \ +finish_eval \ +old_striplib \ +striplib \ +compiler_lib_search_dirs \ +predep_objects \ +postdep_objects \ +predeps \ +postdeps \ +compiler_lib_search_path \ +LD_CXX \ +LD_F77 \ +LD_FC \ +reload_flag_CXX \ +reload_flag_F77 \ +reload_flag_FC \ +compiler_CXX \ +compiler_F77 \ +compiler_FC \ +lt_prog_compiler_no_builtin_flag_CXX \ +lt_prog_compiler_no_builtin_flag_F77 \ +lt_prog_compiler_no_builtin_flag_FC \ +lt_prog_compiler_pic_CXX \ +lt_prog_compiler_pic_F77 \ +lt_prog_compiler_pic_FC \ +lt_prog_compiler_wl_CXX \ +lt_prog_compiler_wl_F77 \ +lt_prog_compiler_wl_FC \ +lt_prog_compiler_static_CXX \ +lt_prog_compiler_static_F77 \ +lt_prog_compiler_static_FC \ +lt_cv_prog_compiler_c_o_CXX \ +lt_cv_prog_compiler_c_o_F77 \ +lt_cv_prog_compiler_c_o_FC \ +export_dynamic_flag_spec_CXX \ +export_dynamic_flag_spec_F77 \ +export_dynamic_flag_spec_FC \ +whole_archive_flag_spec_CXX \ +whole_archive_flag_spec_F77 \ +whole_archive_flag_spec_FC \ +compiler_needs_object_CXX \ +compiler_needs_object_F77 \ +compiler_needs_object_FC \ +with_gnu_ld_CXX \ +with_gnu_ld_F77 \ +with_gnu_ld_FC \ +allow_undefined_flag_CXX \ +allow_undefined_flag_F77 \ +allow_undefined_flag_FC \ +no_undefined_flag_CXX \ +no_undefined_flag_F77 \ +no_undefined_flag_FC \ +hardcode_libdir_flag_spec_CXX \ +hardcode_libdir_flag_spec_F77 \ +hardcode_libdir_flag_spec_FC \ +hardcode_libdir_separator_CXX \ +hardcode_libdir_separator_F77 \ +hardcode_libdir_separator_FC \ +exclude_expsyms_CXX \ +exclude_expsyms_F77 \ +exclude_expsyms_FC \ +include_expsyms_CXX \ +include_expsyms_F77 \ +include_expsyms_FC \ +file_list_spec_CXX \ +file_list_spec_F77 \ +file_list_spec_FC \ +compiler_lib_search_dirs_CXX \ +compiler_lib_search_dirs_F77 \ +compiler_lib_search_dirs_FC \ +predep_objects_CXX \ +predep_objects_F77 \ +predep_objects_FC \ +postdep_objects_CXX \ +postdep_objects_F77 \ +postdep_objects_FC \ +predeps_CXX \ +predeps_F77 \ +predeps_FC \ +postdeps_CXX \ +postdeps_F77 \ +postdeps_FC \ +compiler_lib_search_path_CXX \ +compiler_lib_search_path_F77 \ +compiler_lib_search_path_FC; do + case \`eval \\\\\$ECHO \\\\""\\\\\$\$var"\\\\"\` in + *[\\\\\\\`\\"\\\$]*) + eval "lt_\$var=\\\\\\"\\\`\\\$ECHO \\"\\\$\$var\\" | \\\$SED \\"\\\$sed_quote_subst\\"\\\`\\\\\\"" ## exclude from sc_prohibit_nested_quotes + ;; + *) + eval "lt_\$var=\\\\\\"\\\$\$var\\\\\\"" + ;; + esac +done + +# Double-quote double-evaled strings. +for var in reload_cmds \ +old_postinstall_cmds \ +old_postuninstall_cmds \ +old_archive_cmds \ +extract_expsyms_cmds \ +old_archive_from_new_cmds \ +old_archive_from_expsyms_cmds \ +archive_cmds \ +archive_expsym_cmds \ +module_cmds \ +module_expsym_cmds \ +export_symbols_cmds \ +prelink_cmds \ +postlink_cmds \ +postinstall_cmds \ +postuninstall_cmds \ +finish_cmds \ +sys_lib_search_path_spec \ +configure_time_dlsearch_path \ +configure_time_lt_sys_library_path \ +reload_cmds_CXX \ +reload_cmds_F77 \ +reload_cmds_FC \ +old_archive_cmds_CXX \ +old_archive_cmds_F77 \ +old_archive_cmds_FC \ +old_archive_from_new_cmds_CXX \ +old_archive_from_new_cmds_F77 \ +old_archive_from_new_cmds_FC \ +old_archive_from_expsyms_cmds_CXX \ +old_archive_from_expsyms_cmds_F77 \ +old_archive_from_expsyms_cmds_FC \ +archive_cmds_CXX \ +archive_cmds_F77 \ +archive_cmds_FC \ +archive_expsym_cmds_CXX \ +archive_expsym_cmds_F77 \ +archive_expsym_cmds_FC \ +module_cmds_CXX \ +module_cmds_F77 \ +module_cmds_FC \ +module_expsym_cmds_CXX \ +module_expsym_cmds_F77 \ +module_expsym_cmds_FC \ +export_symbols_cmds_CXX \ +export_symbols_cmds_F77 \ +export_symbols_cmds_FC \ +prelink_cmds_CXX \ +prelink_cmds_F77 \ +prelink_cmds_FC \ +postlink_cmds_CXX \ +postlink_cmds_F77 \ +postlink_cmds_FC; do + case \`eval \\\\\$ECHO \\\\""\\\\\$\$var"\\\\"\` in + *[\\\\\\\`\\"\\\$]*) + eval "lt_\$var=\\\\\\"\\\`\\\$ECHO \\"\\\$\$var\\" | \\\$SED -e \\"\\\$double_quote_subst\\" -e \\"\\\$sed_quote_subst\\" -e \\"\\\$delay_variable_subst\\"\\\`\\\\\\"" ## exclude from sc_prohibit_nested_quotes + ;; + *) + eval "lt_\$var=\\\\\\"\\\$\$var\\\\\\"" + ;; + esac +done + +ac_aux_dir='$ac_aux_dir' + +# See if we are running on zsh, and set the options that allow our +# commands through without removal of \ escapes INIT. +if test -n "\${ZSH_VERSION+set}"; then + setopt NO_GLOB_SUBST +fi + + + PACKAGE='$PACKAGE' + VERSION='$VERSION' + RM='$RM' + ofile='$ofile' + + + + + + + + + + +_ACEOF + +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 + +# Handling of arguments. +for ac_config_target in $ac_config_targets +do + case $ac_config_target in + "libtool") CONFIG_COMMANDS="$CONFIG_COMMANDS libtool" ;; + "src/include/config.h") CONFIG_HEADERS="$CONFIG_HEADERS src/include/config.h" ;; + "Makeconf") CONFIG_FILES="$CONFIG_FILES Makeconf" ;; + "Makefile") CONFIG_FILES="$CONFIG_FILES Makefile" ;; + "doc/Makefile") CONFIG_FILES="$CONFIG_FILES doc/Makefile" ;; + "doc/html/Makefile") CONFIG_FILES="$CONFIG_FILES doc/html/Makefile" ;; + "doc/manual/Makefile") CONFIG_FILES="$CONFIG_FILES doc/manual/Makefile" ;; + "etc/Makefile") CONFIG_FILES="$CONFIG_FILES etc/Makefile" ;; + "etc/Makeconf") CONFIG_FILES="$CONFIG_FILES etc/Makeconf" ;; + "etc/Renviron") CONFIG_FILES="$CONFIG_FILES etc/Renviron" ;; + "etc/javaconf") CONFIG_FILES="$CONFIG_FILES etc/javaconf" ;; + "etc/ldpaths") CONFIG_FILES="$CONFIG_FILES etc/ldpaths" ;; + "m4/Makefile") CONFIG_FILES="$CONFIG_FILES m4/Makefile" ;; + "po/Makefile") CONFIG_FILES="$CONFIG_FILES po/Makefile" ;; + "share/Makefile") CONFIG_FILES="$CONFIG_FILES share/Makefile" ;; + "src/Makefile") CONFIG_FILES="$CONFIG_FILES src/Makefile" ;; + "src/appl/Makefile") CONFIG_FILES="$CONFIG_FILES src/appl/Makefile" ;; + "src/extra/Makefile") CONFIG_FILES="$CONFIG_FILES src/extra/Makefile" ;; + "src/extra/blas/Makefile") CONFIG_FILES="$CONFIG_FILES src/extra/blas/Makefile" ;; + "src/extra/intl/Makefile") CONFIG_FILES="$CONFIG_FILES src/extra/intl/Makefile" ;; + "src/extra/tre/Makefile") CONFIG_FILES="$CONFIG_FILES src/extra/tre/Makefile" ;; + "src/extra/tzone/Makefile") CONFIG_FILES="$CONFIG_FILES src/extra/tzone/Makefile" ;; + "src/extra/xdr/Makefile") CONFIG_FILES="$CONFIG_FILES src/extra/xdr/Makefile" ;; + "src/include/Makefile") CONFIG_FILES="$CONFIG_FILES src/include/Makefile" ;; + "src/include/Rmath.h0") CONFIG_FILES="$CONFIG_FILES src/include/Rmath.h0" ;; + "src/include/R_ext/Makefile") CONFIG_FILES="$CONFIG_FILES src/include/R_ext/Makefile" ;; + "src/library/Recommended/Makefile") CONFIG_FILES="$CONFIG_FILES src/library/Recommended/Makefile" ;; + "src/library/Makefile") CONFIG_FILES="$CONFIG_FILES src/library/Makefile" ;; + "src/library/base/DESCRIPTION") CONFIG_FILES="$CONFIG_FILES src/library/base/DESCRIPTION" ;; + "src/library/base/Makefile") CONFIG_FILES="$CONFIG_FILES src/library/base/Makefile" ;; + "src/library/compiler/DESCRIPTION") CONFIG_FILES="$CONFIG_FILES src/library/compiler/DESCRIPTION" ;; + "src/library/compiler/Makefile") CONFIG_FILES="$CONFIG_FILES src/library/compiler/Makefile" ;; + "src/library/datasets/DESCRIPTION") CONFIG_FILES="$CONFIG_FILES src/library/datasets/DESCRIPTION" ;; + "src/library/datasets/Makefile") CONFIG_FILES="$CONFIG_FILES src/library/datasets/Makefile" ;; + "src/library/graphics/DESCRIPTION") CONFIG_FILES="$CONFIG_FILES src/library/graphics/DESCRIPTION" ;; + "src/library/graphics/Makefile") CONFIG_FILES="$CONFIG_FILES src/library/graphics/Makefile" ;; + "src/library/graphics/src/Makefile") CONFIG_FILES="$CONFIG_FILES src/library/graphics/src/Makefile" ;; + "src/library/grDevices/DESCRIPTION") CONFIG_FILES="$CONFIG_FILES src/library/grDevices/DESCRIPTION" ;; + "src/library/grDevices/Makefile") CONFIG_FILES="$CONFIG_FILES src/library/grDevices/Makefile" ;; + "src/library/grDevices/src/Makefile") CONFIG_FILES="$CONFIG_FILES src/library/grDevices/src/Makefile" ;; + "src/library/grDevices/src/cairo/Makefile") CONFIG_FILES="$CONFIG_FILES src/library/grDevices/src/cairo/Makefile" ;; + "src/library/grid/DESCRIPTION") CONFIG_FILES="$CONFIG_FILES src/library/grid/DESCRIPTION" ;; + "src/library/grid/Makefile") CONFIG_FILES="$CONFIG_FILES src/library/grid/Makefile" ;; + "src/library/grid/src/Makefile") CONFIG_FILES="$CONFIG_FILES src/library/grid/src/Makefile" ;; + "src/library/methods/DESCRIPTION") CONFIG_FILES="$CONFIG_FILES src/library/methods/DESCRIPTION" ;; + "src/library/methods/Makefile") CONFIG_FILES="$CONFIG_FILES src/library/methods/Makefile" ;; + "src/library/methods/src/Makefile") CONFIG_FILES="$CONFIG_FILES src/library/methods/src/Makefile" ;; + "src/library/parallel/DESCRIPTION") CONFIG_FILES="$CONFIG_FILES src/library/parallel/DESCRIPTION" ;; + "src/library/parallel/Makefile") CONFIG_FILES="$CONFIG_FILES src/library/parallel/Makefile" ;; + "src/library/parallel/src/Makefile") CONFIG_FILES="$CONFIG_FILES src/library/parallel/src/Makefile" ;; + "src/library/profile/Makefile") CONFIG_FILES="$CONFIG_FILES src/library/profile/Makefile" ;; + "src/library/stats/DESCRIPTION") CONFIG_FILES="$CONFIG_FILES src/library/stats/DESCRIPTION" ;; + "src/library/stats/Makefile") CONFIG_FILES="$CONFIG_FILES src/library/stats/Makefile" ;; + "src/library/stats/src/Makefile") CONFIG_FILES="$CONFIG_FILES src/library/stats/src/Makefile" ;; + "src/library/stats4/DESCRIPTION") CONFIG_FILES="$CONFIG_FILES src/library/stats4/DESCRIPTION" ;; + "src/library/stats4/Makefile") CONFIG_FILES="$CONFIG_FILES src/library/stats4/Makefile" ;; + "src/library/splines/DESCRIPTION") CONFIG_FILES="$CONFIG_FILES src/library/splines/DESCRIPTION" ;; + "src/library/splines/Makefile") CONFIG_FILES="$CONFIG_FILES src/library/splines/Makefile" ;; + "src/library/splines/src/Makefile") CONFIG_FILES="$CONFIG_FILES src/library/splines/src/Makefile" ;; + "src/library/tcltk/DESCRIPTION") CONFIG_FILES="$CONFIG_FILES src/library/tcltk/DESCRIPTION" ;; + "src/library/tcltk/Makefile") CONFIG_FILES="$CONFIG_FILES src/library/tcltk/Makefile" ;; + "src/library/tcltk/src/Makefile") CONFIG_FILES="$CONFIG_FILES src/library/tcltk/src/Makefile" ;; + "src/library/tools/DESCRIPTION") CONFIG_FILES="$CONFIG_FILES src/library/tools/DESCRIPTION" ;; + "src/library/tools/Makefile") CONFIG_FILES="$CONFIG_FILES src/library/tools/Makefile" ;; + "src/library/tools/src/Makefile") CONFIG_FILES="$CONFIG_FILES src/library/tools/src/Makefile" ;; + "src/library/translations/DESCRIPTION") CONFIG_FILES="$CONFIG_FILES src/library/translations/DESCRIPTION" ;; + "src/library/translations/Makefile") CONFIG_FILES="$CONFIG_FILES src/library/translations/Makefile" ;; + "src/library/utils/DESCRIPTION") CONFIG_FILES="$CONFIG_FILES src/library/utils/DESCRIPTION" ;; + "src/library/utils/Makefile") CONFIG_FILES="$CONFIG_FILES src/library/utils/Makefile" ;; + "src/library/utils/src/Makefile") CONFIG_FILES="$CONFIG_FILES src/library/utils/src/Makefile" ;; + "src/main/Makefile") CONFIG_FILES="$CONFIG_FILES src/main/Makefile" ;; + "src/modules/Makefile") CONFIG_FILES="$CONFIG_FILES src/modules/Makefile" ;; + "src/modules/X11/Makefile") CONFIG_FILES="$CONFIG_FILES src/modules/X11/Makefile" ;; + "src/modules/internet/Makefile") CONFIG_FILES="$CONFIG_FILES src/modules/internet/Makefile" ;; + "src/modules/lapack/Makefile") CONFIG_FILES="$CONFIG_FILES src/modules/lapack/Makefile" ;; + "src/nmath/Makefile") CONFIG_FILES="$CONFIG_FILES src/nmath/Makefile" ;; + "src/nmath/standalone/Makefile") CONFIG_FILES="$CONFIG_FILES src/nmath/standalone/Makefile" ;; + "src/scripts/Makefile") CONFIG_FILES="$CONFIG_FILES src/scripts/Makefile" ;; + "src/scripts/R.sh") CONFIG_FILES="$CONFIG_FILES src/scripts/R.sh" ;; + "src/scripts/Rcmd") CONFIG_FILES="$CONFIG_FILES src/scripts/Rcmd" ;; + "src/scripts/f77_f2c") CONFIG_FILES="$CONFIG_FILES src/scripts/f77_f2c" ;; + "src/scripts/javareconf") CONFIG_FILES="$CONFIG_FILES src/scripts/javareconf" ;; + "src/scripts/mkinstalldirs") CONFIG_FILES="$CONFIG_FILES src/scripts/mkinstalldirs" ;; + "src/scripts/pager") CONFIG_FILES="$CONFIG_FILES src/scripts/pager" ;; + "src/scripts/rtags") CONFIG_FILES="$CONFIG_FILES src/scripts/rtags" ;; + "src/unix/Makefile") CONFIG_FILES="$CONFIG_FILES src/unix/Makefile" ;; + "tests/Makefile") CONFIG_FILES="$CONFIG_FILES tests/Makefile" ;; + "tests/Embedding/Makefile") CONFIG_FILES="$CONFIG_FILES tests/Embedding/Makefile" ;; + "tests/Examples/Makefile") CONFIG_FILES="$CONFIG_FILES tests/Examples/Makefile" ;; + "tools/Makefile") CONFIG_FILES="$CONFIG_FILES tools/Makefile" ;; + "stamp-h") CONFIG_COMMANDS="$CONFIG_COMMANDS stamp-h" ;; + + *) as_fn_error $? "invalid argument: \`$ac_config_target'" "$LINENO" 5;; + esac +done + + +# If the user did not use the arguments to specify the items to instantiate, +# then the envvar interface is used. Set only those that are not. +# We use the long form for the default assignment because of an extremely +# bizarre bug on SunOS 4.1.3. +if $ac_need_defaults; then + test "${CONFIG_FILES+set}" = set || CONFIG_FILES=$config_files + test "${CONFIG_HEADERS+set}" = set || CONFIG_HEADERS=$config_headers + test "${CONFIG_COMMANDS+set}" = set || CONFIG_COMMANDS=$config_commands +fi + +# Have a temporary directory for convenience. Make it in the build tree +# simply because there is no reason against having it here, and in addition, +# creating and moving files from /tmp can sometimes cause problems. +# Hook for its removal unless debugging. +# Note that there is a small window in which the directory will not be cleaned: +# after its creation but before its name has been assigned to `$tmp'. +$debug || +{ + tmp= ac_tmp= + trap 'exit_status=$? + : "${ac_tmp:=$tmp}" + { test ! -d "$ac_tmp" || rm -fr "$ac_tmp"; } && exit $exit_status +' 0 + trap 'as_fn_exit 1' 1 2 13 15 +} +# Create a (secure) tmp directory for tmp files. + +{ + tmp=`(umask 077 && mktemp -d "./confXXXXXX") 2>/dev/null` && + test -d "$tmp" +} || +{ + tmp=./conf$$-$RANDOM + (umask 077 && mkdir "$tmp") +} || as_fn_error $? "cannot create a temporary directory in ." "$LINENO" 5 +ac_tmp=$tmp + +# Set up the scripts for CONFIG_FILES section. +# No need to generate them if there are no CONFIG_FILES. +# This happens for instance with `./config.status config.h'. +if test -n "$CONFIG_FILES"; then + +if $AWK 'BEGIN { getline <"/dev/null" }' </dev/null 2>/dev/null; then + ac_cs_awk_getline=: + ac_cs_awk_pipe_init= + ac_cs_awk_read_file=' + while ((getline aline < (F[key])) > 0) + print(aline) + close(F[key])' + ac_cs_awk_pipe_fini= +else + ac_cs_awk_getline=false + ac_cs_awk_pipe_init="print \"cat <<'|#_!!_#|' &&\"" + ac_cs_awk_read_file=' + print "|#_!!_#|" + print "cat " F[key] " &&" + '$ac_cs_awk_pipe_init + # The final `:' finishes the AND list. + ac_cs_awk_pipe_fini='END { print "|#_!!_#|"; print ":" }' +fi +ac_cr=`echo X | tr X '\015'` +# On cygwin, bash can eat \r inside `` if the user requested igncr. +# But we know of no other shell where ac_cr would be empty at this +# point, so we can use a bashism as a fallback. +if test "x$ac_cr" = x; then + eval ac_cr=\$\'\\r\' +fi +ac_cs_awk_cr=`$AWK 'BEGIN { print "a\rb" }' </dev/null 2>/dev/null` +if test "$ac_cs_awk_cr" = "a${ac_cr}b"; then + ac_cs_awk_cr='\\r' +else + ac_cs_awk_cr=$ac_cr +fi + +echo 'BEGIN {' >"$ac_tmp/subs1.awk" && +_ACEOF + +# Create commands to substitute file output variables. +{ + echo "cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1" && + echo 'cat >>"\$ac_tmp/subs1.awk" <<\\_ACAWK &&' && + echo "$ac_subst_files" | sed 's/.*/F["&"]="$&"/' && + echo "_ACAWK" && + echo "_ACEOF" +} >conf$$files.sh && +. ./conf$$files.sh || + as_fn_error $? "could not make $CONFIG_STATUS" "$LINENO" 5 +rm -f conf$$files.sh + +{ + echo "cat >conf$$subs.awk <<_ACEOF" && + echo "$ac_subst_vars" | sed 's/.*/&!$&$ac_delim/' && + echo "_ACEOF" +} >conf$$subs.sh || + as_fn_error $? "could not make $CONFIG_STATUS" "$LINENO" 5 +ac_delim_num=`echo "$ac_subst_vars" | grep -c '^'` +ac_delim='%!_!# ' +for ac_last_try in false false false false false :; do + . ./conf$$subs.sh || + as_fn_error $? "could not make $CONFIG_STATUS" "$LINENO" 5 + + ac_delim_n=`sed -n "s/.*$ac_delim\$/X/p" conf$$subs.awk | grep -c X` + if test $ac_delim_n = $ac_delim_num; then + break + elif $ac_last_try; then + as_fn_error $? "could not make $CONFIG_STATUS" "$LINENO" 5 + else + ac_delim="$ac_delim!$ac_delim _$ac_delim!! " + fi +done +rm -f conf$$subs.sh + +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +cat >>"\$ac_tmp/subs1.awk" <<\\_ACAWK && +_ACEOF +sed -n ' +h +s/^/S["/; s/!.*/"]=/ +p +g +s/^[^!]*!// +:repl +t repl +s/'"$ac_delim"'$// +t delim +:nl +h +s/\(.\{148\}\)..*/\1/ +t more1 +s/["\\]/\\&/g; s/^/"/; s/$/\\n"\\/ +p +n +b repl +:more1 +s/["\\]/\\&/g; s/^/"/; s/$/"\\/ +p +g +s/.\{148\}// +t nl +:delim +h +s/\(.\{148\}\)..*/\1/ +t more2 +s/["\\]/\\&/g; s/^/"/; s/$/"/ +p +b +:more2 +s/["\\]/\\&/g; s/^/"/; s/$/"\\/ +p +g +s/.\{148\}// +t delim +' <conf$$subs.awk | sed ' +/^[^""]/{ + N + s/\n// +} +' >>$CONFIG_STATUS || ac_write_fail=1 +rm -f conf$$subs.awk +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +_ACAWK +cat >>"\$ac_tmp/subs1.awk" <<_ACAWK && + for (key in S) S_is_set[key] = 1 + FS = "" + \$ac_cs_awk_pipe_init +} +{ + line = $ 0 + nfields = split(line, field, "@") + substed = 0 + len = length(field[1]) + for (i = 2; i < nfields; i++) { + key = field[i] + keylen = length(key) + if (S_is_set[key]) { + value = S[key] + line = substr(line, 1, len) "" value "" substr(line, len + keylen + 3) + len += length(value) + length(field[++i]) + substed = 1 + } else + len += 1 + keylen + } + if (nfields == 3 && !substed) { + key = field[2] + if (F[key] != "" && line ~ /^[ ]*@.*@[ ]*$/) { + \$ac_cs_awk_read_file + next + } + } + print line +} +\$ac_cs_awk_pipe_fini +_ACAWK +_ACEOF +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +if sed "s/$ac_cr//" < /dev/null > /dev/null 2>&1; then + sed "s/$ac_cr\$//; s/$ac_cr/$ac_cs_awk_cr/g" +else + cat +fi < "$ac_tmp/subs1.awk" > "$ac_tmp/subs.awk" \ + || as_fn_error $? "could not setup config files machinery" "$LINENO" 5 +_ACEOF + +# VPATH may cause trouble with some makes, so we remove sole $(srcdir), +# ${srcdir} and @srcdir@ entries from VPATH if srcdir is ".", strip leading and +# trailing colons and then remove the whole line if VPATH becomes empty +# (actually we leave an empty line to preserve line numbers). +if test "x$srcdir" = x.; then + ac_vpsub='/^[ ]*VPATH[ ]*=[ ]*/{ +h +s/// +s/^/:/ +s/[ ]*$/:/ +s/:\$(srcdir):/:/g +s/:\${srcdir}:/:/g +s/:@srcdir@:/:/g +s/^:*// +s/:*$// +x +s/\(=[ ]*\).*/\1/ +G +s/\n// +s/^[^=]*=[ ]*$// +}' +fi + +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +fi # test -n "$CONFIG_FILES" + +# Set up the scripts for CONFIG_HEADERS section. +# No need to generate them if there are no CONFIG_HEADERS. +# This happens for instance with `./config.status Makefile'. +if test -n "$CONFIG_HEADERS"; then +cat >"$ac_tmp/defines.awk" <<\_ACAWK || +BEGIN { +_ACEOF + +# Transform confdefs.h into an awk script `defines.awk', embedded as +# here-document in config.status, that substitutes the proper values into +# config.h.in to produce config.h. + +# Create a delimiter string that does not exist in confdefs.h, to ease +# handling of long lines. +ac_delim='%!_!# ' +for ac_last_try in false false :; do + ac_tt=`sed -n "/$ac_delim/p" confdefs.h` + if test -z "$ac_tt"; then + break + elif $ac_last_try; then + as_fn_error $? "could not make $CONFIG_HEADERS" "$LINENO" 5 + else + ac_delim="$ac_delim!$ac_delim _$ac_delim!! " + fi +done + +# For the awk script, D is an array of macro values keyed by name, +# likewise P contains macro parameters if any. Preserve backslash +# newline sequences. + +ac_word_re=[_$as_cr_Letters][_$as_cr_alnum]* +sed -n ' +s/.\{148\}/&'"$ac_delim"'/g +t rset +:rset +s/^[ ]*#[ ]*define[ ][ ]*/ / +t def +d +:def +s/\\$// +t bsnl +s/["\\]/\\&/g +s/^ \('"$ac_word_re"'\)\(([^()]*)\)[ ]*\(.*\)/P["\1"]="\2"\ +D["\1"]=" \3"/p +s/^ \('"$ac_word_re"'\)[ ]*\(.*\)/D["\1"]=" \2"/p +d +:bsnl +s/["\\]/\\&/g +s/^ \('"$ac_word_re"'\)\(([^()]*)\)[ ]*\(.*\)/P["\1"]="\2"\ +D["\1"]=" \3\\\\\\n"\\/p +t cont +s/^ \('"$ac_word_re"'\)[ ]*\(.*\)/D["\1"]=" \2\\\\\\n"\\/p +t cont +d +:cont +n +s/.\{148\}/&'"$ac_delim"'/g +t clear +:clear +s/\\$// +t bsnlc +s/["\\]/\\&/g; s/^/"/; s/$/"/p +d +:bsnlc +s/["\\]/\\&/g; s/^/"/; s/$/\\\\\\n"\\/p +b cont +' <confdefs.h | sed ' +s/'"$ac_delim"'/"\\\ +"/g' >>$CONFIG_STATUS || ac_write_fail=1 + +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 + for (key in D) D_is_set[key] = 1 + FS = "" +} +/^[\t ]*#[\t ]*(define|undef)[\t ]+$ac_word_re([\t (]|\$)/ { + line = \$ 0 + split(line, arg, " ") + if (arg[1] == "#") { + defundef = arg[2] + mac1 = arg[3] + } else { + defundef = substr(arg[1], 2) + mac1 = arg[2] + } + split(mac1, mac2, "(") #) + macro = mac2[1] + prefix = substr(line, 1, index(line, defundef) - 1) + if (D_is_set[macro]) { + # Preserve the white space surrounding the "#". + print prefix "define", macro P[macro] D[macro] + next + } else { + # Replace #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. + if (defundef == "undef") { + print "/*", prefix defundef, macro, "*/" + next + } + } +} +{ print } +_ACAWK +_ACEOF +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 + as_fn_error $? "could not setup config headers machinery" "$LINENO" 5 +fi # test -n "$CONFIG_HEADERS" + + +eval set X " :F $CONFIG_FILES :H $CONFIG_HEADERS :C $CONFIG_COMMANDS" +shift +for ac_tag +do + case $ac_tag in + :[FHLC]) ac_mode=$ac_tag; continue;; + esac + case $ac_mode$ac_tag in + :[FHL]*:*);; + :L* | :C*:*) as_fn_error $? "invalid tag \`$ac_tag'" "$LINENO" 5;; + :[FH]-) ac_tag=-:-;; + :[FH]*) ac_tag=$ac_tag:$ac_tag.in;; + esac + ac_save_IFS=$IFS + IFS=: + set x $ac_tag + IFS=$ac_save_IFS + shift + ac_file=$1 + shift + + case $ac_mode in + :L) ac_source=$1;; + :[FH]) + ac_file_inputs= + for ac_f + do + case $ac_f in + -) ac_f="$ac_tmp/stdin";; + *) # Look for the file first in the build tree, then in the source tree + # (if the path is not absolute). The absolute path cannot be DOS-style, + # because $ac_f cannot contain `:'. + test -f "$ac_f" || + case $ac_f in + [\\/$]*) false;; + *) test -f "$srcdir/$ac_f" && ac_f="$srcdir/$ac_f";; + esac || + as_fn_error 1 "cannot find input file: \`$ac_f'" "$LINENO" 5;; + esac + case $ac_f in *\'*) ac_f=`$as_echo "$ac_f" | sed "s/'/'\\\\\\\\''/g"`;; esac + as_fn_append ac_file_inputs " '$ac_f'" + done + + # Let's still pretend it is `configure' which instantiates (i.e., don't + # use $as_me), people would be surprised to read: + # /* config.h. Generated by config.status. */ + configure_input='Generated from '` + $as_echo "$*" | sed 's|^[^:]*/||;s|:[^:]*/|, |g' + `' by configure.' + if test x"$ac_file" != x-; then + configure_input="$ac_file. $configure_input" + { $as_echo "$as_me:${as_lineno-$LINENO}: creating $ac_file" >&5 +$as_echo "$as_me: creating $ac_file" >&6;} + fi + # Neutralize special characters interpreted by sed in replacement strings. + case $configure_input in #( + *\&* | *\|* | *\\* ) + ac_sed_conf_input=`$as_echo "$configure_input" | + sed 's/[\\\\&|]/\\\\&/g'`;; #( + *) ac_sed_conf_input=$configure_input;; + esac + + case $ac_tag in + *:-:* | *:-) cat >"$ac_tmp/stdin" \ + || as_fn_error $? "could not create $ac_file" "$LINENO" 5 ;; + esac + ;; + esac + + ac_dir=`$as_dirname -- "$ac_file" || +$as_expr X"$ac_file" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ + X"$ac_file" : 'X\(//\)[^/]' \| \ + X"$ac_file" : 'X\(//\)$' \| \ + X"$ac_file" : 'X\(/\)' \| . 2>/dev/null || +$as_echo X"$ac_file" | + sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ + s//\1/ + q + } + /^X\(\/\/\)[^/].*/{ + s//\1/ + q + } + /^X\(\/\/\)$/{ + s//\1/ + q + } + /^X\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q'` + as_dir="$ac_dir"; as_fn_mkdir_p + ac_builddir=. + +case "$ac_dir" in +.) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;; +*) + ac_dir_suffix=/`$as_echo "$ac_dir" | sed 's|^\.[\\/]||'` + # A ".." for each directory in $ac_dir_suffix. + ac_top_builddir_sub=`$as_echo "$ac_dir_suffix" | sed 's|/[^\\/]*|/..|g;s|/||'` + case $ac_top_builddir_sub in + "") ac_top_builddir_sub=. ac_top_build_prefix= ;; + *) ac_top_build_prefix=$ac_top_builddir_sub/ ;; + esac ;; +esac +ac_abs_top_builddir=$ac_pwd +ac_abs_builddir=$ac_pwd$ac_dir_suffix +# for backward compatibility: +ac_top_builddir=$ac_top_build_prefix + +case $srcdir in + .) # We are building in place. + ac_srcdir=. + ac_top_srcdir=$ac_top_builddir_sub + ac_abs_top_srcdir=$ac_pwd ;; + [\\/]* | ?:[\\/]* ) # Absolute name. + ac_srcdir=$srcdir$ac_dir_suffix; + ac_top_srcdir=$srcdir + ac_abs_top_srcdir=$srcdir ;; + *) # Relative name. + ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix + ac_top_srcdir=$ac_top_build_prefix$srcdir + ac_abs_top_srcdir=$ac_pwd/$srcdir ;; +esac +ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix + + + case $ac_mode in + :F) + # + # CONFIG_FILE + # + + case $INSTALL in + [\\/$]* | ?:[\\/]* ) ac_INSTALL=$INSTALL ;; + *) ac_INSTALL=$ac_top_build_prefix$INSTALL ;; + esac + ac_MKDIR_P=$MKDIR_P + case $MKDIR_P in + [\\/$]* | ?:[\\/]* ) ;; + */*) ac_MKDIR_P=$ac_top_build_prefix$MKDIR_P ;; + esac +_ACEOF + +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +# If the template does not know about datarootdir, expand it. +# FIXME: This hack should be removed a few years after 2.60. +ac_datarootdir_hack=; ac_datarootdir_seen= +ac_sed_dataroot=' +/datarootdir/ { + p + q +} +/@datadir@/p +/@docdir@/p +/@infodir@/p +/@localedir@/p +/@mandir@/p' +case `eval "sed -n \"\$ac_sed_dataroot\" $ac_file_inputs"` in +*datarootdir*) ac_datarootdir_seen=yes;; +*@datadir@*|*@docdir@*|*@infodir@*|*@localedir@*|*@mandir@*) + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&5 +$as_echo "$as_me: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&2;} +_ACEOF +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 + ac_datarootdir_hack=' + s&@datadir@&$datadir&g + s&@docdir@&$docdir&g + s&@infodir@&$infodir&g + s&@localedir@&$localedir&g + s&@mandir@&$mandir&g + s&\\\${datarootdir}&$datarootdir&g' ;; +esac +_ACEOF + +# Neutralize VPATH when `$srcdir' = `.'. +# Shell code in configure.ac might set extrasub. +# FIXME: do we really want to maintain this feature? +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +ac_sed_extra="$ac_vpsub +$extrasub +_ACEOF +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +:t +/@[a-zA-Z_][a-zA-Z_0-9]*@/!b +s|@configure_input@|$ac_sed_conf_input|;t t +s&@top_builddir@&$ac_top_builddir_sub&;t t +s&@top_build_prefix@&$ac_top_build_prefix&;t t +s&@srcdir@&$ac_srcdir&;t t +s&@abs_srcdir@&$ac_abs_srcdir&;t t +s&@top_srcdir@&$ac_top_srcdir&;t t +s&@abs_top_srcdir@&$ac_abs_top_srcdir&;t t +s&@builddir@&$ac_builddir&;t t +s&@abs_builddir@&$ac_abs_builddir&;t t +s&@abs_top_builddir@&$ac_abs_top_builddir&;t t +s&@INSTALL@&$ac_INSTALL&;t t +s&@MKDIR_P@&$ac_MKDIR_P&;t t +$ac_datarootdir_hack +" +eval sed \"\$ac_sed_extra\" "$ac_file_inputs" | +if $ac_cs_awk_getline; then + $AWK -f "$ac_tmp/subs.awk" +else + $AWK -f "$ac_tmp/subs.awk" | $SHELL +fi \ + >$ac_tmp/out || as_fn_error $? "could not create $ac_file" "$LINENO" 5 + +test -z "$ac_datarootdir_hack$ac_datarootdir_seen" && + { ac_out=`sed -n '/\${datarootdir}/p' "$ac_tmp/out"`; test -n "$ac_out"; } && + { ac_out=`sed -n '/^[ ]*datarootdir[ ]*:*=/p' \ + "$ac_tmp/out"`; test -z "$ac_out"; } && + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $ac_file contains a reference to the variable \`datarootdir' +which seems to be undefined. Please make sure it is defined" >&5 +$as_echo "$as_me: WARNING: $ac_file contains a reference to the variable \`datarootdir' +which seems to be undefined. Please make sure it is defined" >&2;} + + rm -f "$ac_tmp/stdin" + case $ac_file in + -) cat "$ac_tmp/out" && rm -f "$ac_tmp/out";; + *) rm -f "$ac_file" && mv "$ac_tmp/out" "$ac_file";; + esac \ + || as_fn_error $? "could not create $ac_file" "$LINENO" 5 + ;; + :H) + # + # CONFIG_HEADER + # + if test x"$ac_file" != x-; then + { + $as_echo "/* $configure_input */" \ + && eval '$AWK -f "$ac_tmp/defines.awk"' "$ac_file_inputs" + } >"$ac_tmp/config.h" \ + || as_fn_error $? "could not create $ac_file" "$LINENO" 5 + if diff "$ac_file" "$ac_tmp/config.h" >/dev/null 2>&1; then + { $as_echo "$as_me:${as_lineno-$LINENO}: $ac_file is unchanged" >&5 +$as_echo "$as_me: $ac_file is unchanged" >&6;} + else + rm -f "$ac_file" + mv "$ac_tmp/config.h" "$ac_file" \ + || as_fn_error $? "could not create $ac_file" "$LINENO" 5 + fi + else + $as_echo "/* $configure_input */" \ + && eval '$AWK -f "$ac_tmp/defines.awk"' "$ac_file_inputs" \ + || as_fn_error $? "could not create -" "$LINENO" 5 + fi + ;; + + :C) { $as_echo "$as_me:${as_lineno-$LINENO}: executing $ac_file commands" >&5 +$as_echo "$as_me: executing $ac_file commands" >&6;} + ;; + esac + + + case $ac_file$ac_mode in + "libtool":C) + + # See if we are running on zsh, and set the options that allow our + # commands through without removal of \ escapes. + if test -n "${ZSH_VERSION+set}"; then + setopt NO_GLOB_SUBST + fi + + cfgfile=${ofile}T + trap "$RM \"$cfgfile\"; exit 1" 1 2 15 + $RM "$cfgfile" + + cat <<_LT_EOF >> "$cfgfile" +#! $SHELL +# Generated automatically by $as_me ($PACKAGE) $VERSION +# Libtool was configured on host `(hostname || uname -n) 2>/dev/null | sed 1q`: +# NOTE: Changes made to this file will be lost: look at ltmain.sh. + +# Provide generalized library-building support services. +# Written by Gordon Matzigkeit, 1996 + +# Copyright (C) 2014 Free Software Foundation, Inc. +# This is free software; see the source for copying conditions. There is NO +# warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + +# GNU Libtool is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of of the License, or +# (at your option) any later version. +# +# As a special exception to the GNU General Public License, if you +# distribute this file as part of a program or library that is built +# using GNU Libtool, you may include this file under the same +# distribution terms that you use for the rest of that program. +# +# GNU Libtool 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 this program. If not, see <http://www.gnu.org/licenses/>. + + +# The names of the tagged configurations supported by this script. +available_tags='CXX F77 FC ' + +# Configured defaults for sys_lib_dlsearch_path munging. +: \${LT_SYS_LIBRARY_PATH="$configure_time_lt_sys_library_path"} + +# ### BEGIN LIBTOOL CONFIG + +# Whether or not to build static libraries. +build_old_libs=$enable_static + +# Which release of libtool.m4 was used? +macro_version=$macro_version +macro_revision=$macro_revision + +# Whether or not to build shared libraries. +build_libtool_libs=$enable_shared + +# What type of objects to build. +pic_mode=$pic_mode + +# Whether or not to optimize for fast installation. +fast_install=$enable_fast_install + +# Shared archive member basename,for filename based shared library versioning on AIX. +shared_archive_member_spec=$shared_archive_member_spec + +# Shell to use when invoking shell scripts. +SHELL=$lt_SHELL + +# An echo program that protects backslashes. +ECHO=$lt_ECHO + +# The PATH separator for the build system. +PATH_SEPARATOR=$lt_PATH_SEPARATOR + +# The host system. +host_alias=$host_alias +host=$host +host_os=$host_os + +# The build system. +build_alias=$build_alias +build=$build +build_os=$build_os + +# A sed program that does not truncate output. +SED=$lt_SED + +# Sed that helps us avoid accidentally triggering echo(1) options like -n. +Xsed="\$SED -e 1s/^X//" + +# A grep program that handles long lines. +GREP=$lt_GREP + +# An ERE matcher. +EGREP=$lt_EGREP + +# A literal string matcher. +FGREP=$lt_FGREP + +# A BSD- or MS-compatible name lister. +NM=$lt_NM + +# Whether we need soft or hard links. +LN_S=$lt_LN_S + +# What is the maximum length of a command? +max_cmd_len=$max_cmd_len + +# Object file suffix (normally "o"). +objext=$ac_objext + +# Executable file suffix (normally ""). +exeext=$exeext + +# whether the shell understands "unset". +lt_unset=$lt_unset + +# turn spaces into newlines. +SP2NL=$lt_lt_SP2NL + +# turn newlines into spaces. +NL2SP=$lt_lt_NL2SP + +# convert \$build file names to \$host format. +to_host_file_cmd=$lt_cv_to_host_file_cmd + +# convert \$build files to toolchain format. +to_tool_file_cmd=$lt_cv_to_tool_file_cmd + +# An object symbol dumper. +OBJDUMP=$lt_OBJDUMP + +# Method to check whether dependent libraries are shared objects. +deplibs_check_method=$lt_deplibs_check_method + +# Command to use when deplibs_check_method = "file_magic". +file_magic_cmd=$lt_file_magic_cmd + +# How to find potential files when deplibs_check_method = "file_magic". +file_magic_glob=$lt_file_magic_glob + +# Find potential files using nocaseglob when deplibs_check_method = "file_magic". +want_nocaseglob=$lt_want_nocaseglob + +# DLL creation program. +DLLTOOL=$lt_DLLTOOL + +# Command to associate shared and link libraries. +sharedlib_from_linklib_cmd=$lt_sharedlib_from_linklib_cmd + +# The archiver. +AR=$lt_AR + +# Flags to create an archive. +AR_FLAGS=$lt_AR_FLAGS + +# How to feed a file listing to the archiver. +archiver_list_spec=$lt_archiver_list_spec + +# A symbol stripping program. +STRIP=$lt_STRIP + +# Commands used to install an old-style archive. +RANLIB=$lt_RANLIB +old_postinstall_cmds=$lt_old_postinstall_cmds +old_postuninstall_cmds=$lt_old_postuninstall_cmds + +# Whether to use a lock for old archive extraction. +lock_old_archive_extraction=$lock_old_archive_extraction + +# A C compiler. +LTCC=$lt_CC + +# LTCC compiler flags. +LTCFLAGS=$lt_CFLAGS + +# Take the output of nm and produce a listing of raw symbols and C names. +global_symbol_pipe=$lt_lt_cv_sys_global_symbol_pipe + +# Transform the output of nm in a proper C declaration. +global_symbol_to_cdecl=$lt_lt_cv_sys_global_symbol_to_cdecl + +# Transform the output of nm into a list of symbols to manually relocate. +global_symbol_to_import=$lt_lt_cv_sys_global_symbol_to_import + +# Transform the output of nm in a C name address pair. +global_symbol_to_c_name_address=$lt_lt_cv_sys_global_symbol_to_c_name_address + +# Transform the output of nm in a C name address pair when lib prefix is needed. +global_symbol_to_c_name_address_lib_prefix=$lt_lt_cv_sys_global_symbol_to_c_name_address_lib_prefix + +# The name lister interface. +nm_interface=$lt_lt_cv_nm_interface + +# Specify filename containing input files for \$NM. +nm_file_list_spec=$lt_nm_file_list_spec + +# The root where to search for dependent libraries,and where our libraries should be installed. +lt_sysroot=$lt_sysroot + +# Command to truncate a binary pipe. +lt_truncate_bin=$lt_lt_cv_truncate_bin + +# The name of the directory that contains temporary libtool files. +objdir=$objdir + +# Used to examine libraries when file_magic_cmd begins with "file". +MAGIC_CMD=$MAGIC_CMD + +# Must we lock files when doing compilation? +need_locks=$lt_need_locks + +# Manifest tool. +MANIFEST_TOOL=$lt_MANIFEST_TOOL + +# Tool to manipulate archived DWARF debug symbol files on Mac OS X. +DSYMUTIL=$lt_DSYMUTIL + +# Tool to change global to local symbols on Mac OS X. +NMEDIT=$lt_NMEDIT + +# Tool to manipulate fat objects and archives on Mac OS X. +LIPO=$lt_LIPO + +# ldd/readelf like tool for Mach-O binaries on Mac OS X. +OTOOL=$lt_OTOOL + +# ldd/readelf like tool for 64 bit Mach-O binaries on Mac OS X 10.4. +OTOOL64=$lt_OTOOL64 + +# Old archive suffix (normally "a"). +libext=$libext + +# Shared library suffix (normally ".so"). +shrext_cmds=$lt_shrext_cmds + +# The commands to extract the exported symbol list from a shared archive. +extract_expsyms_cmds=$lt_extract_expsyms_cmds + +# Variables whose values should be saved in libtool wrapper scripts and +# restored at link time. +variables_saved_for_relink=$lt_variables_saved_for_relink + +# Do we need the "lib" prefix for modules? +need_lib_prefix=$need_lib_prefix + +# Do we need a version for libraries? +need_version=$need_version + +# Library versioning type. +version_type=$version_type + +# Shared library runtime path variable. +runpath_var=$runpath_var + +# Shared library path variable. +shlibpath_var=$shlibpath_var + +# Is shlibpath searched before the hard-coded library search path? +shlibpath_overrides_runpath=$shlibpath_overrides_runpath + +# Format of library name prefix. +libname_spec=$lt_libname_spec + +# List of archive names. First name is the real one, the rest are links. +# The last name is the one that the linker finds with -lNAME +library_names_spec=$lt_library_names_spec + +# The coded name of the library, if different from the real name. +soname_spec=$lt_soname_spec + +# Permission mode override for installation of shared libraries. +install_override_mode=$lt_install_override_mode + +# Command to use after installation of a shared archive. +postinstall_cmds=$lt_postinstall_cmds + +# Command to use after uninstallation of a shared archive. +postuninstall_cmds=$lt_postuninstall_cmds + +# Commands used to finish a libtool library installation in a directory. +finish_cmds=$lt_finish_cmds + +# As "finish_cmds", except a single script fragment to be evaled but +# not shown. +finish_eval=$lt_finish_eval + +# Whether we should hardcode library paths into libraries. +hardcode_into_libs=$hardcode_into_libs + +# Compile-time system search path for libraries. +sys_lib_search_path_spec=$lt_sys_lib_search_path_spec + +# Detected run-time system search path for libraries. +sys_lib_dlsearch_path_spec=$lt_configure_time_dlsearch_path + +# Explicit LT_SYS_LIBRARY_PATH set during ./configure time. +configure_time_lt_sys_library_path=$lt_configure_time_lt_sys_library_path + +# Whether dlopen is supported. +dlopen_support=$enable_dlopen + +# Whether dlopen of programs is supported. +dlopen_self=$enable_dlopen_self + +# Whether dlopen of statically linked programs is supported. +dlopen_self_static=$enable_dlopen_self_static + +# Commands to strip libraries. +old_striplib=$lt_old_striplib +striplib=$lt_striplib + + +# The linker used to build libraries. +LD=$lt_LD + +# How to create reloadable object files. +reload_flag=$lt_reload_flag +reload_cmds=$lt_reload_cmds + +# Commands used to build an old-style archive. +old_archive_cmds=$lt_old_archive_cmds + +# A language specific compiler. +CC=$lt_compiler + +# Is the compiler the GNU compiler? +with_gcc=$GCC + +# Compiler flag to turn off builtin functions. +no_builtin_flag=$lt_lt_prog_compiler_no_builtin_flag + +# Additional compiler flags for building library objects. +pic_flag=$lt_lt_prog_compiler_pic + +# How to pass a linker flag through the compiler. +wl=$lt_lt_prog_compiler_wl + +# Compiler flag to prevent dynamic linking. +link_static_flag=$lt_lt_prog_compiler_static + +# Does compiler simultaneously support -c and -o options? +compiler_c_o=$lt_lt_cv_prog_compiler_c_o + +# Whether or not to add -lc for building shared libraries. +build_libtool_need_lc=$archive_cmds_need_lc + +# Whether or not to disallow shared libs when runtime libs are static. +allow_libtool_libs_with_static_runtimes=$enable_shared_with_static_runtimes + +# Compiler flag to allow reflexive dlopens. +export_dynamic_flag_spec=$lt_export_dynamic_flag_spec + +# Compiler flag to generate shared objects directly from archives. +whole_archive_flag_spec=$lt_whole_archive_flag_spec + +# Whether the compiler copes with passing no objects directly. +compiler_needs_object=$lt_compiler_needs_object + +# Create an old-style archive from a shared archive. +old_archive_from_new_cmds=$lt_old_archive_from_new_cmds + +# Create a temporary old-style archive to link instead of a shared archive. +old_archive_from_expsyms_cmds=$lt_old_archive_from_expsyms_cmds + +# Commands used to build a shared archive. +archive_cmds=$lt_archive_cmds +archive_expsym_cmds=$lt_archive_expsym_cmds + +# Commands used to build a loadable module if different from building +# a shared archive. +module_cmds=$lt_module_cmds +module_expsym_cmds=$lt_module_expsym_cmds + +# Whether we are building with GNU ld or not. +with_gnu_ld=$lt_with_gnu_ld + +# Flag that allows shared libraries with undefined symbols to be built. +allow_undefined_flag=$lt_allow_undefined_flag + +# Flag that enforces no undefined symbols. +no_undefined_flag=$lt_no_undefined_flag + +# Flag to hardcode \$libdir into a binary during linking. +# This must work even if \$libdir does not exist +hardcode_libdir_flag_spec=$lt_hardcode_libdir_flag_spec + +# Whether we need a single "-rpath" flag with a separated argument. +hardcode_libdir_separator=$lt_hardcode_libdir_separator + +# Set to "yes" if using DIR/libNAME\$shared_ext during linking hardcodes +# DIR into the resulting binary. +hardcode_direct=$hardcode_direct + +# Set to "yes" if using DIR/libNAME\$shared_ext during linking hardcodes +# DIR into the resulting binary and the resulting library dependency is +# "absolute",i.e impossible to change by setting \$shlibpath_var if the +# library is relocated. +hardcode_direct_absolute=$hardcode_direct_absolute + +# Set to "yes" if using the -LDIR flag during linking hardcodes DIR +# into the resulting binary. +hardcode_minus_L=$hardcode_minus_L + +# Set to "yes" if using SHLIBPATH_VAR=DIR during linking hardcodes DIR +# into the resulting binary. +hardcode_shlibpath_var=$hardcode_shlibpath_var + +# Set to "yes" if building a shared library automatically hardcodes DIR +# into the library and all subsequent libraries and executables linked +# against it. +hardcode_automatic=$hardcode_automatic + +# Set to yes if linker adds runtime paths of dependent libraries +# to runtime path list. +inherit_rpath=$inherit_rpath + +# Whether libtool must link a program against all its dependency libraries. +link_all_deplibs=$link_all_deplibs + +# Set to "yes" if exported symbols are required. +always_export_symbols=$always_export_symbols + +# The commands to list exported symbols. +export_symbols_cmds=$lt_export_symbols_cmds + +# Symbols that should not be listed in the preloaded symbols. +exclude_expsyms=$lt_exclude_expsyms + +# Symbols that must always be exported. +include_expsyms=$lt_include_expsyms + +# Commands necessary for linking programs (against libraries) with templates. +prelink_cmds=$lt_prelink_cmds + +# Commands necessary for finishing linking programs. +postlink_cmds=$lt_postlink_cmds + +# Specify filename containing input files. +file_list_spec=$lt_file_list_spec + +# How to hardcode a shared library path into an executable. +hardcode_action=$hardcode_action + +# The directories searched by this compiler when creating a shared library. +compiler_lib_search_dirs=$lt_compiler_lib_search_dirs + +# Dependencies to place before and after the objects being linked to +# create a shared library. +predep_objects=$lt_predep_objects +postdep_objects=$lt_postdep_objects +predeps=$lt_predeps +postdeps=$lt_postdeps + +# The library search path used internally by the compiler when linking +# a shared library. +compiler_lib_search_path=$lt_compiler_lib_search_path + +# ### END LIBTOOL CONFIG + +_LT_EOF + + cat <<'_LT_EOF' >> "$cfgfile" + +# ### BEGIN FUNCTIONS SHARED WITH CONFIGURE + +# func_munge_path_list VARIABLE PATH +# ----------------------------------- +# VARIABLE is name of variable containing _space_ separated list of +# directories to be munged by the contents of PATH, which is string +# having a format: +# "DIR[:DIR]:" +# string "DIR[ DIR]" will be prepended to VARIABLE +# ":DIR[:DIR]" +# string "DIR[ DIR]" will be appended to VARIABLE +# "DIRP[:DIRP]::[DIRA:]DIRA" +# string "DIRP[ DIRP]" will be prepended to VARIABLE and string +# "DIRA[ DIRA]" will be appended to VARIABLE +# "DIR[:DIR]" +# VARIABLE will be replaced by "DIR[ DIR]" +func_munge_path_list () +{ + case x$2 in + x) + ;; + *:) + eval $1=\"`$ECHO $2 | $SED 's/:/ /g'` \$$1\" + ;; + x:*) + eval $1=\"\$$1 `$ECHO $2 | $SED 's/:/ /g'`\" + ;; + *::*) + eval $1=\"\$$1\ `$ECHO $2 | $SED -e 's/.*:://' -e 's/:/ /g'`\" + eval $1=\"`$ECHO $2 | $SED -e 's/::.*//' -e 's/:/ /g'`\ \$$1\" + ;; + *) + eval $1=\"`$ECHO $2 | $SED 's/:/ /g'`\" + ;; + esac +} + + +# Calculate cc_basename. Skip known compiler wrappers and cross-prefix. +func_cc_basename () +{ + for cc_temp in $*""; do + case $cc_temp in + compile | *[\\/]compile | ccache | *[\\/]ccache ) ;; + distcc | *[\\/]distcc | purify | *[\\/]purify ) ;; + \-*) ;; + *) break;; + esac + done + func_cc_basename_result=`$ECHO "$cc_temp" | $SED "s%.*/%%; s%^$host_alias-%%"` +} + + +# ### END FUNCTIONS SHARED WITH CONFIGURE + +_LT_EOF + + case $host_os in + aix3*) + cat <<\_LT_EOF >> "$cfgfile" +# AIX sometimes has problems with the GCC collect2 program. For some +# reason, if we set the COLLECT_NAMES environment variable, the problems +# vanish in a puff of smoke. +if test set != "${COLLECT_NAMES+set}"; then + COLLECT_NAMES= + export COLLECT_NAMES +fi +_LT_EOF + ;; + esac + + +ltmain=$ac_aux_dir/ltmain.sh + + + # We use sed instead of cat because bash on DJGPP gets confused if + # if finds mixed CR/LF and LF-only lines. Since sed operates in + # text mode, it properly converts lines to CR/LF. This bash problem + # is reportedly fixed, but why not run on old versions too? + sed '$q' "$ltmain" >> "$cfgfile" \ + || (rm -f "$cfgfile"; exit 1) + + mv -f "$cfgfile" "$ofile" || + (rm -f "$ofile" && cp "$cfgfile" "$ofile" && rm -f "$cfgfile") + chmod +x "$ofile" + + + cat <<_LT_EOF >> "$ofile" + +# ### BEGIN LIBTOOL TAG CONFIG: CXX + +# The linker used to build libraries. +LD=$lt_LD_CXX + +# How to create reloadable object files. +reload_flag=$lt_reload_flag_CXX +reload_cmds=$lt_reload_cmds_CXX + +# Commands used to build an old-style archive. +old_archive_cmds=$lt_old_archive_cmds_CXX + +# A language specific compiler. +CC=$lt_compiler_CXX + +# Is the compiler the GNU compiler? +with_gcc=$GCC_CXX + +# Compiler flag to turn off builtin functions. +no_builtin_flag=$lt_lt_prog_compiler_no_builtin_flag_CXX + +# Additional compiler flags for building library objects. +pic_flag=$lt_lt_prog_compiler_pic_CXX + +# How to pass a linker flag through the compiler. +wl=$lt_lt_prog_compiler_wl_CXX + +# Compiler flag to prevent dynamic linking. +link_static_flag=$lt_lt_prog_compiler_static_CXX + +# Does compiler simultaneously support -c and -o options? +compiler_c_o=$lt_lt_cv_prog_compiler_c_o_CXX + +# Whether or not to add -lc for building shared libraries. +build_libtool_need_lc=$archive_cmds_need_lc_CXX + +# Whether or not to disallow shared libs when runtime libs are static. +allow_libtool_libs_with_static_runtimes=$enable_shared_with_static_runtimes_CXX + +# Compiler flag to allow reflexive dlopens. +export_dynamic_flag_spec=$lt_export_dynamic_flag_spec_CXX + +# Compiler flag to generate shared objects directly from archives. +whole_archive_flag_spec=$lt_whole_archive_flag_spec_CXX + +# Whether the compiler copes with passing no objects directly. +compiler_needs_object=$lt_compiler_needs_object_CXX + +# Create an old-style archive from a shared archive. +old_archive_from_new_cmds=$lt_old_archive_from_new_cmds_CXX + +# Create a temporary old-style archive to link instead of a shared archive. +old_archive_from_expsyms_cmds=$lt_old_archive_from_expsyms_cmds_CXX + +# Commands used to build a shared archive. +archive_cmds=$lt_archive_cmds_CXX +archive_expsym_cmds=$lt_archive_expsym_cmds_CXX + +# Commands used to build a loadable module if different from building +# a shared archive. +module_cmds=$lt_module_cmds_CXX +module_expsym_cmds=$lt_module_expsym_cmds_CXX + +# Whether we are building with GNU ld or not. +with_gnu_ld=$lt_with_gnu_ld_CXX + +# Flag that allows shared libraries with undefined symbols to be built. +allow_undefined_flag=$lt_allow_undefined_flag_CXX + +# Flag that enforces no undefined symbols. +no_undefined_flag=$lt_no_undefined_flag_CXX + +# Flag to hardcode \$libdir into a binary during linking. +# This must work even if \$libdir does not exist +hardcode_libdir_flag_spec=$lt_hardcode_libdir_flag_spec_CXX + +# Whether we need a single "-rpath" flag with a separated argument. +hardcode_libdir_separator=$lt_hardcode_libdir_separator_CXX + +# Set to "yes" if using DIR/libNAME\$shared_ext during linking hardcodes +# DIR into the resulting binary. +hardcode_direct=$hardcode_direct_CXX + +# Set to "yes" if using DIR/libNAME\$shared_ext during linking hardcodes +# DIR into the resulting binary and the resulting library dependency is +# "absolute",i.e impossible to change by setting \$shlibpath_var if the +# library is relocated. +hardcode_direct_absolute=$hardcode_direct_absolute_CXX + +# Set to "yes" if using the -LDIR flag during linking hardcodes DIR +# into the resulting binary. +hardcode_minus_L=$hardcode_minus_L_CXX + +# Set to "yes" if using SHLIBPATH_VAR=DIR during linking hardcodes DIR +# into the resulting binary. +hardcode_shlibpath_var=$hardcode_shlibpath_var_CXX + +# Set to "yes" if building a shared library automatically hardcodes DIR +# into the library and all subsequent libraries and executables linked +# against it. +hardcode_automatic=$hardcode_automatic_CXX + +# Set to yes if linker adds runtime paths of dependent libraries +# to runtime path list. +inherit_rpath=$inherit_rpath_CXX + +# Whether libtool must link a program against all its dependency libraries. +link_all_deplibs=$link_all_deplibs_CXX + +# Set to "yes" if exported symbols are required. +always_export_symbols=$always_export_symbols_CXX + +# The commands to list exported symbols. +export_symbols_cmds=$lt_export_symbols_cmds_CXX + +# Symbols that should not be listed in the preloaded symbols. +exclude_expsyms=$lt_exclude_expsyms_CXX + +# Symbols that must always be exported. +include_expsyms=$lt_include_expsyms_CXX + +# Commands necessary for linking programs (against libraries) with templates. +prelink_cmds=$lt_prelink_cmds_CXX + +# Commands necessary for finishing linking programs. +postlink_cmds=$lt_postlink_cmds_CXX + +# Specify filename containing input files. +file_list_spec=$lt_file_list_spec_CXX + +# How to hardcode a shared library path into an executable. +hardcode_action=$hardcode_action_CXX + +# The directories searched by this compiler when creating a shared library. +compiler_lib_search_dirs=$lt_compiler_lib_search_dirs_CXX + +# Dependencies to place before and after the objects being linked to +# create a shared library. +predep_objects=$lt_predep_objects_CXX +postdep_objects=$lt_postdep_objects_CXX +predeps=$lt_predeps_CXX +postdeps=$lt_postdeps_CXX + +# The library search path used internally by the compiler when linking +# a shared library. +compiler_lib_search_path=$lt_compiler_lib_search_path_CXX + +# ### END LIBTOOL TAG CONFIG: CXX +_LT_EOF + + + cat <<_LT_EOF >> "$ofile" + +# ### BEGIN LIBTOOL TAG CONFIG: F77 + +# The linker used to build libraries. +LD=$lt_LD_F77 + +# How to create reloadable object files. +reload_flag=$lt_reload_flag_F77 +reload_cmds=$lt_reload_cmds_F77 + +# Commands used to build an old-style archive. +old_archive_cmds=$lt_old_archive_cmds_F77 + +# A language specific compiler. +CC=$lt_compiler_F77 + +# Is the compiler the GNU compiler? +with_gcc=$GCC_F77 + +# Compiler flag to turn off builtin functions. +no_builtin_flag=$lt_lt_prog_compiler_no_builtin_flag_F77 + +# Additional compiler flags for building library objects. +pic_flag=$lt_lt_prog_compiler_pic_F77 + +# How to pass a linker flag through the compiler. +wl=$lt_lt_prog_compiler_wl_F77 + +# Compiler flag to prevent dynamic linking. +link_static_flag=$lt_lt_prog_compiler_static_F77 + +# Does compiler simultaneously support -c and -o options? +compiler_c_o=$lt_lt_cv_prog_compiler_c_o_F77 + +# Whether or not to add -lc for building shared libraries. +build_libtool_need_lc=$archive_cmds_need_lc_F77 + +# Whether or not to disallow shared libs when runtime libs are static. +allow_libtool_libs_with_static_runtimes=$enable_shared_with_static_runtimes_F77 + +# Compiler flag to allow reflexive dlopens. +export_dynamic_flag_spec=$lt_export_dynamic_flag_spec_F77 + +# Compiler flag to generate shared objects directly from archives. +whole_archive_flag_spec=$lt_whole_archive_flag_spec_F77 + +# Whether the compiler copes with passing no objects directly. +compiler_needs_object=$lt_compiler_needs_object_F77 + +# Create an old-style archive from a shared archive. +old_archive_from_new_cmds=$lt_old_archive_from_new_cmds_F77 + +# Create a temporary old-style archive to link instead of a shared archive. +old_archive_from_expsyms_cmds=$lt_old_archive_from_expsyms_cmds_F77 + +# Commands used to build a shared archive. +archive_cmds=$lt_archive_cmds_F77 +archive_expsym_cmds=$lt_archive_expsym_cmds_F77 + +# Commands used to build a loadable module if different from building +# a shared archive. +module_cmds=$lt_module_cmds_F77 +module_expsym_cmds=$lt_module_expsym_cmds_F77 + +# Whether we are building with GNU ld or not. +with_gnu_ld=$lt_with_gnu_ld_F77 + +# Flag that allows shared libraries with undefined symbols to be built. +allow_undefined_flag=$lt_allow_undefined_flag_F77 + +# Flag that enforces no undefined symbols. +no_undefined_flag=$lt_no_undefined_flag_F77 + +# Flag to hardcode \$libdir into a binary during linking. +# This must work even if \$libdir does not exist +hardcode_libdir_flag_spec=$lt_hardcode_libdir_flag_spec_F77 + +# Whether we need a single "-rpath" flag with a separated argument. +hardcode_libdir_separator=$lt_hardcode_libdir_separator_F77 + +# Set to "yes" if using DIR/libNAME\$shared_ext during linking hardcodes +# DIR into the resulting binary. +hardcode_direct=$hardcode_direct_F77 + +# Set to "yes" if using DIR/libNAME\$shared_ext during linking hardcodes +# DIR into the resulting binary and the resulting library dependency is +# "absolute",i.e impossible to change by setting \$shlibpath_var if the +# library is relocated. +hardcode_direct_absolute=$hardcode_direct_absolute_F77 + +# Set to "yes" if using the -LDIR flag during linking hardcodes DIR +# into the resulting binary. +hardcode_minus_L=$hardcode_minus_L_F77 + +# Set to "yes" if using SHLIBPATH_VAR=DIR during linking hardcodes DIR +# into the resulting binary. +hardcode_shlibpath_var=$hardcode_shlibpath_var_F77 + +# Set to "yes" if building a shared library automatically hardcodes DIR +# into the library and all subsequent libraries and executables linked +# against it. +hardcode_automatic=$hardcode_automatic_F77 + +# Set to yes if linker adds runtime paths of dependent libraries +# to runtime path list. +inherit_rpath=$inherit_rpath_F77 + +# Whether libtool must link a program against all its dependency libraries. +link_all_deplibs=$link_all_deplibs_F77 + +# Set to "yes" if exported symbols are required. +always_export_symbols=$always_export_symbols_F77 + +# The commands to list exported symbols. +export_symbols_cmds=$lt_export_symbols_cmds_F77 + +# Symbols that should not be listed in the preloaded symbols. +exclude_expsyms=$lt_exclude_expsyms_F77 + +# Symbols that must always be exported. +include_expsyms=$lt_include_expsyms_F77 + +# Commands necessary for linking programs (against libraries) with templates. +prelink_cmds=$lt_prelink_cmds_F77 + +# Commands necessary for finishing linking programs. +postlink_cmds=$lt_postlink_cmds_F77 + +# Specify filename containing input files. +file_list_spec=$lt_file_list_spec_F77 + +# How to hardcode a shared library path into an executable. +hardcode_action=$hardcode_action_F77 + +# The directories searched by this compiler when creating a shared library. +compiler_lib_search_dirs=$lt_compiler_lib_search_dirs_F77 + +# Dependencies to place before and after the objects being linked to +# create a shared library. +predep_objects=$lt_predep_objects_F77 +postdep_objects=$lt_postdep_objects_F77 +predeps=$lt_predeps_F77 +postdeps=$lt_postdeps_F77 + +# The library search path used internally by the compiler when linking +# a shared library. +compiler_lib_search_path=$lt_compiler_lib_search_path_F77 + +# ### END LIBTOOL TAG CONFIG: F77 +_LT_EOF + + + cat <<_LT_EOF >> "$ofile" + +# ### BEGIN LIBTOOL TAG CONFIG: FC + +# The linker used to build libraries. +LD=$lt_LD_FC + +# How to create reloadable object files. +reload_flag=$lt_reload_flag_FC +reload_cmds=$lt_reload_cmds_FC + +# Commands used to build an old-style archive. +old_archive_cmds=$lt_old_archive_cmds_FC + +# A language specific compiler. +CC=$lt_compiler_FC + +# Is the compiler the GNU compiler? +with_gcc=$GCC_FC + +# Compiler flag to turn off builtin functions. +no_builtin_flag=$lt_lt_prog_compiler_no_builtin_flag_FC + +# Additional compiler flags for building library objects. +pic_flag=$lt_lt_prog_compiler_pic_FC + +# How to pass a linker flag through the compiler. +wl=$lt_lt_prog_compiler_wl_FC + +# Compiler flag to prevent dynamic linking. +link_static_flag=$lt_lt_prog_compiler_static_FC + +# Does compiler simultaneously support -c and -o options? +compiler_c_o=$lt_lt_cv_prog_compiler_c_o_FC + +# Whether or not to add -lc for building shared libraries. +build_libtool_need_lc=$archive_cmds_need_lc_FC + +# Whether or not to disallow shared libs when runtime libs are static. +allow_libtool_libs_with_static_runtimes=$enable_shared_with_static_runtimes_FC + +# Compiler flag to allow reflexive dlopens. +export_dynamic_flag_spec=$lt_export_dynamic_flag_spec_FC + +# Compiler flag to generate shared objects directly from archives. +whole_archive_flag_spec=$lt_whole_archive_flag_spec_FC + +# Whether the compiler copes with passing no objects directly. +compiler_needs_object=$lt_compiler_needs_object_FC + +# Create an old-style archive from a shared archive. +old_archive_from_new_cmds=$lt_old_archive_from_new_cmds_FC + +# Create a temporary old-style archive to link instead of a shared archive. +old_archive_from_expsyms_cmds=$lt_old_archive_from_expsyms_cmds_FC + +# Commands used to build a shared archive. +archive_cmds=$lt_archive_cmds_FC +archive_expsym_cmds=$lt_archive_expsym_cmds_FC + +# Commands used to build a loadable module if different from building +# a shared archive. +module_cmds=$lt_module_cmds_FC +module_expsym_cmds=$lt_module_expsym_cmds_FC + +# Whether we are building with GNU ld or not. +with_gnu_ld=$lt_with_gnu_ld_FC + +# Flag that allows shared libraries with undefined symbols to be built. +allow_undefined_flag=$lt_allow_undefined_flag_FC + +# Flag that enforces no undefined symbols. +no_undefined_flag=$lt_no_undefined_flag_FC + +# Flag to hardcode \$libdir into a binary during linking. +# This must work even if \$libdir does not exist +hardcode_libdir_flag_spec=$lt_hardcode_libdir_flag_spec_FC + +# Whether we need a single "-rpath" flag with a separated argument. +hardcode_libdir_separator=$lt_hardcode_libdir_separator_FC + +# Set to "yes" if using DIR/libNAME\$shared_ext during linking hardcodes +# DIR into the resulting binary. +hardcode_direct=$hardcode_direct_FC + +# Set to "yes" if using DIR/libNAME\$shared_ext during linking hardcodes +# DIR into the resulting binary and the resulting library dependency is +# "absolute",i.e impossible to change by setting \$shlibpath_var if the +# library is relocated. +hardcode_direct_absolute=$hardcode_direct_absolute_FC + +# Set to "yes" if using the -LDIR flag during linking hardcodes DIR +# into the resulting binary. +hardcode_minus_L=$hardcode_minus_L_FC + +# Set to "yes" if using SHLIBPATH_VAR=DIR during linking hardcodes DIR +# into the resulting binary. +hardcode_shlibpath_var=$hardcode_shlibpath_var_FC + +# Set to "yes" if building a shared library automatically hardcodes DIR +# into the library and all subsequent libraries and executables linked +# against it. +hardcode_automatic=$hardcode_automatic_FC + +# Set to yes if linker adds runtime paths of dependent libraries +# to runtime path list. +inherit_rpath=$inherit_rpath_FC + +# Whether libtool must link a program against all its dependency libraries. +link_all_deplibs=$link_all_deplibs_FC + +# Set to "yes" if exported symbols are required. +always_export_symbols=$always_export_symbols_FC + +# The commands to list exported symbols. +export_symbols_cmds=$lt_export_symbols_cmds_FC + +# Symbols that should not be listed in the preloaded symbols. +exclude_expsyms=$lt_exclude_expsyms_FC + +# Symbols that must always be exported. +include_expsyms=$lt_include_expsyms_FC + +# Commands necessary for linking programs (against libraries) with templates. +prelink_cmds=$lt_prelink_cmds_FC + +# Commands necessary for finishing linking programs. +postlink_cmds=$lt_postlink_cmds_FC + +# Specify filename containing input files. +file_list_spec=$lt_file_list_spec_FC + +# How to hardcode a shared library path into an executable. +hardcode_action=$hardcode_action_FC + +# The directories searched by this compiler when creating a shared library. +compiler_lib_search_dirs=$lt_compiler_lib_search_dirs_FC + +# Dependencies to place before and after the objects being linked to +# create a shared library. +predep_objects=$lt_predep_objects_FC +postdep_objects=$lt_postdep_objects_FC +predeps=$lt_predeps_FC +postdeps=$lt_postdeps_FC + +# The library search path used internally by the compiler when linking +# a shared library. +compiler_lib_search_path=$lt_compiler_lib_search_path_FC + +# ### END LIBTOOL TAG CONFIG: FC +_LT_EOF + + ;; + "stamp-h":C) test -f src/include/stamp-h || echo timestamp > src/include/stamp-h ;; + + esac +done # for ac_tag + + +as_fn_exit 0 +_ACEOF +ac_clean_files=$ac_clean_files_save + +test $ac_write_fail = 0 || + as_fn_error $? "write failure creating $CONFIG_STATUS" "$LINENO" 5 + + +# configure is writing to config.log, and then calls config.status. +# config.status does its own redirection, appending to config.log. +# Unfortunately, on DOS this fails, as config.log is still kept open +# by configure, so config.status won't be able to write to it; its +# output is simply discarded. So we exec the FD to /dev/null, +# effectively closing config.log, so it can be properly (re)opened and +# appended to by config.status. When coming back to configure, we +# need to make the FD available again. +if test "$no_create" != yes; then + ac_cs_success=: + ac_config_status_args= + test "$silent" = yes && + ac_config_status_args="$ac_config_status_args --quiet" + exec 5>/dev/null + $SHELL $CONFIG_STATUS $ac_config_status_args || ac_cs_success=false + exec 5>>config.log + # Use ||, not &&, to avoid exiting from the if with $? = 1, which + # would make configure fail if this is the last instruction. + $ac_cs_success || as_fn_exit 1 +fi +if test -n "$ac_unrecognized_opts" && test "$enable_option_checking" != no; then + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: unrecognized options: $ac_unrecognized_opts" >&5 +$as_echo "$as_me: WARNING: unrecognized options: $ac_unrecognized_opts" >&2;} +fi + + +## Summarize configure results. +## <NOTE> +## Doing this via AC_CONFIG_COMMANDS would require explicitly passing all +## configure variables to config.status. +## </NOTE> +r_c_compiler="${CC} ${R_XTRA_CFLAGS} ${CFLAGS}" +r_cxx_compiler="${CXX} ${CXXSTD} ${R_XTRA_CXXFLAGS} ${CXXFLAGS}" +r_cxx98_compiler="${CXX98} ${CXX98STD} ${CXX98FLAGS}" +r_cxx11_compiler="${CXX11} ${CXX11STD} ${CXX11FLAGS}" +r_cxx14_compiler="${CXX14} ${CXX14STD} ${CXX14FLAGS}" +r_cxx17_compiler="${CXX17} ${CXX17STD} ${CXX17FLAGS}" +r_f77_compiler="${F77} ${R_XTRA_FFLAGS} ${FFLAGS}" +r_f95_compiler="${FC} ${FCFLAGS}" +r_objc_compiler="${OBJC} ${OBJCFLAGS}" +r_interfaces= +## we will not have tested for X11 under some configure options, so +## need to test protect the test. +for item in X11 aqua tcltk; do + if eval "test x\${use_${item}} = xyes"; then + separator=", " +test -z "${separator}" && separator=" " +if test -z "${r_interfaces}"; then + r_interfaces="${item}" +else + r_interfaces="${r_interfaces}${separator}${item}" +fi + fi +done +r_external_libs= +if test "${use_readline}" = yes; then + r_external_libs=readline +fi +if test "${acx_blas_ok}" = "yes"; then + ## Try to figure out which BLAS was used. + case "${BLAS_LIBS0}" in + *-latlas*) r_blas=ATLAS ;; + *-lgoto*) r_blas=Goto ;; + *-lopenblas*) r_blas=OpenBLAS ;; + *-lacml*) r_blas=ACML ;; + *-lmkl*) r_blas=MKL ;; + *-lsgemm*) r_blas=PhiPack ;; + *sunperf*) r_blas=SunPerf ;; + *-lessl*) r_blas=ESSL ;; + *Accelerate*) r_blas=Accelerate ;; + "") r_blas=none ;; + *) r_blas=generic ;; + esac + separator=", " +test -z "${separator}" && separator=" " +if test -z "${r_external_libs}"; then + r_external_libs="BLAS(${r_blas})" +else + r_external_libs="${r_external_libs}${separator}BLAS(${r_blas})" +fi +fi +if test "${acx_lapack_ok}" = "yes"; then + ## Try to figure out which LAPACK was used. + case "${LAPACK_LIBS}" in + *sunperf*) r_lapack=SunPerf ;; + "") r_lapack="in blas" ;; + *) r_lapack=generic ;; + esac + separator=", " +test -z "${separator}" && separator=" " +if test -z "${r_external_libs}"; then + r_external_libs="LAPACK(${r_lapack})" +else + r_external_libs="${r_external_libs}${separator}LAPACK(${r_lapack})" +fi +fi +if test "${have_tre}" = yes; then + separator=", " +test -z "${separator}" && separator=" " +if test -z "${r_external_libs}"; then + r_external_libs="tre" +else + r_external_libs="${r_external_libs}${separator}tre" +fi +fi +if test "x$ac_cv_header_curl_curl_h" = xyes; then + separator=", " +test -z "${separator}" && separator=" " +if test -z "${r_external_libs}"; then + r_external_libs="curl" +else + r_external_libs="${r_external_libs}${separator}curl" +fi +fi + +r_capabilities= +r_no_capabilities= +if test "${have_png}" = yes; then + separator=", " +test -z "${separator}" && separator=" " +if test -z "${r_capabilities}"; then + r_capabilities="PNG" +else + r_capabilities="${r_capabilities}${separator}PNG" +fi +else + separator=", " +test -z "${separator}" && separator=" " +if test -z "${r_no_capabilities}"; then + r_no_capabilities="PNG" +else + r_no_capabilities="${r_no_capabilities}${separator}PNG" +fi +fi +if test "${have_jpeg}" = yes; then + separator=", " +test -z "${separator}" && separator=" " +if test -z "${r_capabilities}"; then + r_capabilities="JPEG" +else + r_capabilities="${r_capabilities}${separator}JPEG" +fi +else + separator=", " +test -z "${separator}" && separator=" " +if test -z "${r_no_capabilities}"; then + r_no_capabilities="JPEG" +else + r_no_capabilities="${r_no_capabilities}${separator}JPEG" +fi +fi +if test "${have_tiff}" = yes; then + separator=", " +test -z "${separator}" && separator=" " +if test -z "${r_capabilities}"; then + r_capabilities="TIFF" +else + r_capabilities="${r_capabilities}${separator}TIFF" +fi +else + separator=", " +test -z "${separator}" && separator=" " +if test -z "${r_no_capabilities}"; then + r_no_capabilities="TIFF" +else + r_no_capabilities="${r_no_capabilities}${separator}TIFF" +fi +fi +if test "${USE_NLS}" = yes; then + separator=", " +test -z "${separator}" && separator=" " +if test -z "${r_capabilities}"; then + r_capabilities="NLS" +else + r_capabilities="${r_capabilities}${separator}NLS" +fi +else + separator=", " +test -z "${separator}" && separator=" " +if test -z "${r_no_capabilities}"; then + r_no_capabilities="NLS" +else + r_no_capabilities="${r_no_capabilities}${separator}NLS" +fi +fi +if test "${r_cv_cairo_works}" = yes; then + separator=", " +test -z "${separator}" && separator=" " +if test -z "${r_capabilities}"; then + r_capabilities="cairo" +else + r_capabilities="${r_capabilities}${separator}cairo" +fi +else + separator=", " +test -z "${separator}" && separator=" " +if test -z "${r_no_capabilities}"; then + r_no_capabilities="cairo" +else + r_no_capabilities="${r_no_capabilities}${separator}cairo" +fi +fi +if test "${use_ICU}" = yes; then + separator=", " +test -z "${separator}" && separator=" " +if test -z "${r_capabilities}"; then + r_capabilities="ICU" +else + r_capabilities="${r_capabilities}${separator}ICU" +fi +else + separator=", " +test -z "${separator}" && separator=" " +if test -z "${r_no_capabilities}"; then + r_no_capabilities="ICU" +else + r_no_capabilities="${r_no_capabilities}${separator}ICU" +fi +fi + +r_options= +r_no_options= +if test "${want_R_framework}" = yes; then + separator=", " +test -z "${separator}" && separator=" " +if test -z "${r_options}"; then + r_options="framework" +else + r_options="${r_options}${separator}framework" +fi +elif test "${want_R_shlib}" = yes; then + separator=", " +test -z "${separator}" && separator=" " +if test -z "${r_options}"; then + r_options="shared R library" +else + r_options="${r_options}${separator}shared R library" +fi +elif test "${want_R_static}" = yes; then + separator=", " +test -z "${separator}" && separator=" " +if test -z "${r_options}"; then + r_options="static R library" +else + r_options="${r_options}${separator}static R library" +fi +fi +if test "${use_blas_shlib}" = yes; then + separator=", " +test -z "${separator}" && separator=" " +if test -z "${r_options}"; then + r_options="shared BLAS" +else + r_options="${r_options}${separator}shared BLAS" +fi +else + separator=", " +test -z "${separator}" && separator=" " +if test -z "${r_no_options}"; then + r_no_options="shared BLAS" +else + r_no_options="${r_no_options}${separator}shared BLAS" +fi +fi +if test "${want_R_profiling}" = yes; then + separator=", " +test -z "${separator}" && separator=" " +if test -z "${r_options}"; then + r_options="R profiling" +else + r_options="${r_options}${separator}R profiling" +fi +else + separator=", " +test -z "${separator}" && separator=" " +if test -z "${r_no_options}"; then + r_no_options="R profiling" +else + r_no_options="${r_no_options}${separator}R profiling" +fi +fi +if test "${want_memory_profiling}" = yes; then + separator=", " +test -z "${separator}" && separator=" " +if test -z "${r_options}"; then + r_options="memory profiling" +else + r_options="${r_options}${separator}memory profiling" +fi +else + separator=", " +test -z "${separator}" && separator=" " +if test -z "${r_no_options}"; then + r_no_options="memory profiling" +else + r_no_options="${r_no_options}${separator}memory profiling" +fi +fi +if test "${use_maintainer_mode}" = yes; then + separator=", " +test -z "${separator}" && separator=" " +if test -z "${r_options}"; then + r_options="maintainer mode" +else + r_options="${r_options}${separator}maintainer mode" +fi +fi +if test "${use_strict_barrier}" = yes; then + separator=", " +test -z "${separator}" && separator=" " +if test -z "${r_options}"; then + r_options="strict barrier" +else + r_options="${r_options}${separator}strict barrier" +fi +fi +if test "${want_prebuilt_html}" = yes; then + separator=", " +test -z "${separator}" && separator=" " +if test -z "${r_options}"; then + r_options="static HTML" +else + r_options="${r_options}${separator}static HTML" +fi +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: +R is now configured for ${host} + + Source directory: ${srcdir} + Installation directory: ${prefix} + + C compiler: ${r_c_compiler} + Fortran 77 compiler: ${r_f77_compiler} + + Default C++ compiler: ${r_cxx_compiler} + C++98 compiler: ${r_cxx98_compiler} + C++11 compiler: ${r_cxx11_compiler} + C++14 compiler: ${r_cxx14_compiler} + C++17 compiler: ${r_cxx17_compiler} + Fortran 90/95 compiler: ${r_f95_compiler} + Obj-C compiler: ${r_objc_compiler} + + Interfaces supported: ${r_interfaces} + External libraries: ${r_external_libs} + Additional capabilities: ${r_capabilities} + Options enabled: ${r_options} + + Capabilities skipped: ${r_no_capabilities} + Options not enabled: ${r_no_options} + + Recommended packages: ${use_recommended_packages} +" >&5 +$as_echo " +R is now configured for ${host} + + Source directory: ${srcdir} + Installation directory: ${prefix} + + C compiler: ${r_c_compiler} + Fortran 77 compiler: ${r_f77_compiler} + + Default C++ compiler: ${r_cxx_compiler} + C++98 compiler: ${r_cxx98_compiler} + C++11 compiler: ${r_cxx11_compiler} + C++14 compiler: ${r_cxx14_compiler} + C++17 compiler: ${r_cxx17_compiler} + Fortran 90/95 compiler: ${r_f95_compiler} + Obj-C compiler: ${r_objc_compiler} + + Interfaces supported: ${r_interfaces} + External libraries: ${r_external_libs} + Additional capabilities: ${r_capabilities} + Options enabled: ${r_options} + + Capabilities skipped: ${r_no_capabilities} + Options not enabled: ${r_no_options} + + Recommended packages: ${use_recommended_packages} +" >&6; } +if test -n "${warn_f77_cc_double_complex}"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: ${warn_f77_cc_double_complex}" >&5 +$as_echo "$as_me: WARNING: ${warn_f77_cc_double_complex}" >&2;} +fi +if test -n "${warn_xcompile_sizeof_long}"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: ${warn_xcompile_sizeof_long}" >&5 +$as_echo "$as_me: WARNING: ${warn_xcompile_sizeof_long}" >&2;} +fi +if test -n "${warn_type_socklen}"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: ${warn_type_socklen}" >&5 +$as_echo "$as_me: WARNING: ${warn_type_socklen}" >&2;} +fi +if test -n "${warn_cxxpicflags}"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: ${warn_cxxpicflags}" >&5 +$as_echo "$as_me: WARNING: ${warn_cxxpicflags}" >&2;} +fi +if test -n "${warn_shlib_cxxldflags}"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: ${warn_shlib_cxxldflags}" >&5 +$as_echo "$as_me: WARNING: ${warn_shlib_cxxldflags}" >&2;} +fi +if test -n "${warn_cxxpicflags}"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: ${warn_cxxpicflags}" >&5 +$as_echo "$as_me: WARNING: ${warn_cxxpicflags}" >&2;} +fi +if test -n "${warn_fcpicflags}"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: ${warn_fcpicflags}" >&5 +$as_echo "$as_me: WARNING: ${warn_fcpicflags}" >&2;} +fi +if test -n "${warn_tcltk_version}"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: ${warn_tcltk_version}" >&5 +$as_echo "$as_me: WARNING: ${warn_tcltk_version}" >&2;} +fi +if test -n "${warn_pcre_version}"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: ${warn_pcre_version}" >&5 +$as_echo "$as_me: WARNING: ${warn_pcre_version}" >&2;} +fi +if test -n "${warn_info}"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: ${warn_info}" >&5 +$as_echo "$as_me: WARNING: ${warn_info}" >&2;} +fi +if test -n "${warn_pdf1}"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: ${warn_pdf1}" >&5 +$as_echo "$as_me: WARNING: ${warn_pdf1}" >&2;} +fi +if test -n "${warn_pdf2}"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: ${warn_pdf2}" >&5 +$as_echo "$as_me: WARNING: ${warn_pdf2}" >&2;} +fi +if test -n "${warn_pdf3}"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: ${warn_pdf3}" >&5 +$as_echo "$as_me: WARNING: ${warn_pdf3}" >&2;} +fi +if test -n "${warn_pager}"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: ${warn_pager}" >&5 +$as_echo "$as_me: WARNING: ${warn_pager}" >&2;} +fi +if test -n "${warn_browser}"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: ${warn_browser}" >&5 +$as_echo "$as_me: WARNING: ${warn_browser}" >&2;} +fi +if test -n "${warn_pdfviewer}"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: ${warn_pdfviewer}" >&5 +$as_echo "$as_me: WARNING: ${warn_pdfviewer}" >&2;} +fi + +### Local variables: *** +### mode: outline-minor *** +### outline-regexp: "### [*]+" *** +### End: *** diff --git a/com.oracle.truffle.r.native/gnur/patch/configure.ac b/com.oracle.truffle.r.native/gnur/patch/configure.ac new file mode 100644 index 0000000000000000000000000000000000000000..3f84e0ed24df19713da5de37874d48321c728f9b --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/configure.ac @@ -0,0 +1,2968 @@ +### configure.ac -*- Autoconf -*- +### +### Process this file with autoconf to produce a configure script. +### +### Copyright (C) 1998-2017 R Core Team +### +### This file is part of R. +### +### R is free software; you can redistribute it and/or modify it under +### the terms of the GNU General Public License as published by the Free +### Software Foundation; either version 2 of the License, or (at your +### option) any later version. +### +### R 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 R; if not, a copy is available at +### https://www.r-project.org/Licenses/ + +AC_PREREQ(2.62) + +## We want to get the version number from file 'VERSION' (rather than +## specifying the version info in 'configure.ac'. Hence, we need a bit +## of M4 magic. Note that M4 esyscmd has a trailing newline because the +## shell command output has one, hence the patsubst() trick. +m4_define([R_VERSION], + m4_bpatsubst(m4_esyscmd([cat VERSION]), + [\([0-9.]*\)\(\w\|\W\)*], + [\1])) +AC_INIT([R],[R_VERSION],[https://bugs.r-project.org],[R],[https://www.r-project.org]) +AC_CONFIG_SRCDIR([src/include/Defn.h]) +AC_CONFIG_AUX_DIR([tools]) + +### * Information on the package. + +dnl ## Automake initialization. +dnl Not needed, and possibly resulting in non-portable configure scripts +dnl with hard-wired Automake API numbers (aclocal-1.x) ... +dnl AM_INIT_AUTOMAKE(AC_PACKAGE_NAME, AC_PACKAGE_VERSION) +dnl Nevertheless, we need to provide PACKAGE and VERSION ... +PACKAGE=[${PACKAGE_NAME}] +AC_DEFINE_UNQUOTED(PACKAGE, "${PACKAGE}", [Name of package]) +AC_SUBST(PACKAGE) +VERSION=[${PACKAGE_VERSION}] +AC_DEFINE_UNQUOTED(VERSION, "${VERSION}", [Version number of package]) +AC_SUBST(VERSION) +MAJ_MIN_VERSION=`echo ${VERSION} | sed 's/\.[[0-9]]$//'` +AC_SUBST(MAJ_MIN_VERSION) + +## Autoheader initialization. +AH_TOP([#ifndef R_CONFIG_H +#define R_CONFIG_H]) +AH_BOTTOM([ +#endif /* not R_CONFIG_H */]) + +## We call AC_GNU_SOURCE early (it is a prerequisite for the gettext +## macros), so all the C compiling makes use of that. Nowadays it calls +## AC_USE_SYSTEM_EXTENSIONS .... +## This sets _GNU_SOURCE, so glibc defines all its extensions +## (_POSIX_C_SOURCE, _XOPEN_SOURCE, _BSD_SOURCE, __USE_MISC) and these +## unlock declarations of non-C99 functions and constants. +## Ditto for __EXTENSIONS__ on Solaris and _ALL_SOURCE on AIX. + +### ** Platform. + +AC_CANONICAL_HOST +AC_DEFINE_UNQUOTED(R_PLATFORM, "${host}", +[Define this to be the canonical name (cpu-vendor-os) of your system.]) +AC_DEFINE_UNQUOTED(R_CPU, "${host_cpu}", +[Define this to be the name of the CPU of your system.]) +AC_DEFINE_UNQUOTED(R_VENDOR, "${host_vendor}", +[Define this to be the name of the vendor of your system.]) +AC_DEFINE_UNQUOTED(R_OS, "${host_os}", +[Define this to be the name of the OS of your system.]) + +## exclude some unsupported OSes +case "${host_os}" in + ## Darwin 1.3.1 was macOS 10.0, 1.4.1 was 10.1, 5 is 10.2 etc + ## with 13 being 10.9. We no longer support < 10.6 (Snow Leopard) + ## https://en.wikipedia.org/wiki/Darwin_OS + darwin1.*) + AC_MSG_ERROR([The earliest supported macOS is 10.6.] + ;; + darwin[[56789]]*) + AC_MSG_ERROR([The earliest supported macOS is 10.6.] + ;; + aix[123]*|aix4.[01]*) + ## These need a form of linking we no longer support + AC_MSG_ERROR([AIX prior to 4.2 is not supported]) + ;; +esac + +R_PLATFORM="${host}" +AC_SUBST(R_PLATFORM) +R_OS="${host_os}" +AC_SUBST(R_OS) + +case "${host_os}" in + mingw*|windows*|winnt) + AC_DEFINE(Win32, 1, + [Define according to your operating system type.]) + R_OSTYPE="windows" + ;; + *) + AC_DEFINE(Unix, 1, + [Define according to your operating system type.]) + R_OSTYPE="unix" + ;; +esac +AC_SUBST(R_OSTYPE) + +R_CONFIG_ARGS="${ac_configure_args}" +AC_SUBST(R_CONFIG_ARGS) + +### ** Defaults. + +## NB: autoconf loads such files too +cfile="${srcdir}/config.site" +if test -r "${cfile}"; then + echo "loading site script '${cfile}'" + . "${cfile}" +fi +cfile="${HOME}/.R/config" +if test -r "${cfile}"; then + echo "loading user script '${cfile}'" + . "${cfile}" +fi +cfile="./config.site" +if test -r "${cfile}"; then + echo "loading build-specific script '${cfile}'" + . "${cfile}" +fi + +## We need to establish suitable defaults for a 64-bit OS +libnn=lib +case "${host_os}" in + linux*) + ## Not all distros use this: some choose to march out of step + ## Allow for ppc64le (Debian calls ppc64el), powerpc64le ... + case "${host_cpu}" in + x86_64|mips64|ppc64*|powerpc64*|sparc64|s390x) + if test -d /usr/lib64; then + libnn=lib64 + fi + ;; + esac + ;; + solaris*) + ## libnn=lib/sparcv9 ## on 64-bit only, but that's compiler-specific + ;; +esac +: ${LIBnn=$libnn} +## We provide these defaults so that headers and libraries in +## '/usr/local' are found (by the native tools, mostly). +if test -f "/sw/etc/fink.conf"; then + : ${CPPFLAGS="-I/sw/include -I/usr/local/include"} + : ${LDFLAGS="-L/sw/lib -L/usr/local/lib"} +else + : ${CPPFLAGS="-I/usr/local/include"} + : ${LDFLAGS="-L/usr/local/${LIBnn}"} +fi +AC_SUBST(LIBnn) +## take care not to override the command-line setting +if test "${libdir}" = '${exec_prefix}/lib'; then + libdir='${exec_prefix}/${LIBnn}' +fi + +## R installation directories +m4_divert_once([HELP_BEGIN], [ +R installation directories: + --libdir=DIR R files to R_HOME=DIR/R @<:@EPREFIX/$LIBnn@:>@ + rdocdir=DIR R doc files to DIR @<:@R_HOME/doc@:>@ + rincludedir=DIR R include files to DIR @<:@R_HOME/include@:>@ + rsharedir=DIR R share files to DIR @<:@R_HOME/share@:>@])dnl + +if test -z "${rdocdir}"; then + rdocdir='${rhome}/doc' +fi +AC_SUBST([rdocdir]) + +if test -z "${rincludedir}"; then + rincludedir='${rhome}/include' +fi +AC_SUBST([rincludedir]) + +if test -z "${rsharedir}"; then + rsharedir='${rhome}/share' +fi +AC_SUBST([rsharedir]) + +### ** Handle arguments to configure. + +config_opts="${ac_configure_args}" +AC_SUBST(config_opts) + +### ** Optional features. + +## Allow the user to specify support for R profiling. +AC_ARG_ENABLE([R-profiling], +[AS_HELP_STRING([--enable-R-profiling],[attempt to compile support for Rprof() @<:@yes@:>@])], +[if test "${enableval}" = no; then + want_R_profiling=no +elif test "${enableval}" = yes; then + want_R_profiling=yes +else + want_R_profiling=yes +fi], +[want_R_profiling=yes]) + +## Allow the user to specify support for memory profiling. +AC_ARG_ENABLE([memory-profiling], +[AS_HELP_STRING([--enable-memory-profiling],[attempt to compile support for Rprofmem(), tracemem() @<:@no@:>@])], +[if test "${enableval}" = no; then + want_memory_profiling=no +elif test "${enableval}" = yes; then + want_memory_profiling=yes +else + want_memory_profiling=no +fi], +[want_memory_profiling=no]) + +## Allow the user to specify building an R framework (Darwin). +AC_ARG_ENABLE([R-framework], +[AS_HELP_STRING([--enable-R-framework@<:@=DIR@:>@],[macOS only: build R framework (if possible), and specify + its installation prefix @<:@no, /Library/Frameworks@:>@])], +[want_R_framework="${enableval}"], +[want_R_framework=no]) +## Can only build frameworks on Darwin. +if test "${want_R_framework}" != no; then + case "${host_os}" in + darwin*) + if test "${want_R_framework}" = yes; then + ## If we build a framework and 'prefix' was not given, we need + ## to set it to '/Library/Frameworks' rather than '/usr/local'. + ## Note that Autoconf sets things up so that by default, prefix + ## and exec_prefix are set to 'NONE'. Let's hope for no change. + if test "x${prefix}" = xNONE; then + prefix="/Library/Frameworks" + fi + else + prefix="${want_R_framework}" + want_R_framework=yes + fi + ## FW_VERSION is the sub-directory name used in R.framework/Version + ## By default it's the a.b form of the full a.b.c version to simplify + ## binary updates. + : ${FW_VERSION=`echo "${PACKAGE_VERSION}" | sed -e "s/[[\.]][[0-9]]$//"`} + ;; + *) + want_R_framework=no + ;; + esac +fi +AM_CONDITIONAL(WANT_R_FRAMEWORK, [test "x${want_R_framework}" = xyes]) + +## Allow the user to specify building R as a shared library. +## (but a 'dynamic library' in the terminology of macOS). +## <NOTE> +## Building a framework implies building R shared libraries, hence the +## strange default. +## We might want to warn about the case where '--disable-R-shlib' was +## given explicitly ... +## </NOTE> +AC_ARG_ENABLE([R-shlib], +[AS_HELP_STRING([--enable-R-shlib],[build the shared/dynamic library 'libR' @<:@no@:>@])], +[want_R_shlib="${enableval}"], +[want_R_shlib="${want_R_framework}"]) +AM_CONDITIONAL(WANT_R_SHLIB, [test "x${want_R_shlib}" = xyes]) + +AC_ARG_ENABLE([R-static-lib], +[AS_HELP_STRING([--enable-R-static-lib],[build the static library 'libR.a' @<:@no@:>@])], +[want_R_static="${enableval}"], +[want_R_static="no"]) +if test "x${want_R_static}" = xyes; then + if test "x${want_R_shlib}" = xyes; then + AC_MSG_WARN([--enable-R-static-lib conflicts with --enable-R-shlib and will be ignored]) + want_R_static=no + fi +fi +AM_CONDITIONAL(WANT_R_STATIC, [test "x${want_R_static}" = xyes]) + +## Build separate shared/dynamic library containing R's BLAS if desired +AC_ARG_ENABLE([BLAS-shlib], +[AS_HELP_STRING([--enable-BLAS-shlib],[build BLAS into a shared/dynamic library @<:@perhaps@:>@])], +[use_blas_shlib="${enableval}"], +[use_blas_shlib="unset"]) + +## As from R 3.2.0 split up -L... and -lR +if test "${want_R_shlib}" = yes; then + LIBR0="-L\$(R_HOME)/lib\$(R_ARCH)" + LIBR1=-lR +else + LIBR0= + LIBR1= +fi + +## Enable maintainer-specific portions of Makefiles. +AC_ARG_ENABLE([maintainer-mode], +[AS_HELP_STRING([--enable-maintainer-mode],[enable make rules and dependencies not useful (and + maybe confusing) to the casual installer @<:@no@:>@])], +[use_maintainer_mode="${enableval}"], +[use_maintainer_mode=no]) +AM_CONDITIONAL(MAINTAINER_MODE, [test "x${use_maintainer_mode}" = xyes]) + +## Enable testing the write barrier. +AC_ARG_ENABLE([strict-barrier], +[AS_HELP_STRING([--enable-strict-barrier],[provoke compile error on write barrier violation + @<:@no@:>@])], +[use_strict_barrier="${enableval}"], +[use_strict_barrier=no]) +if test x"${use_strict_barrier}" = xyes; then + AC_DEFINE(TESTING_WRITE_BARRIER, 1, + [Define to enable provoking compile errors on write barrier + violation.]) +fi + +AC_ARG_ENABLE([prebuilt-html], +[AS_HELP_STRING([--enable-prebuilt-html],[build static HTML help pages @<:@no@:>@])], +[want_prebuilt_html="${enableval}"], +[want_prebuilt_html=no]) +AM_CONDITIONAL(BUILD_HTML, [test "x${want_prebuilt_html}" = xyes]) + +AC_ARG_ENABLE([lto], +[AS_HELP_STRING([--enable-lto],[enable link-time optimization @<:@no@:>@])], +[want_lto="${enableval}"], [want_lto=no]) +## FIXME: add a test for gcc >= 4.5.0 +if test "x${want_lto}" != xno; then + LTO=-flto +fi +if test "x${want_lto}" = xyes; then + LTOALL=-flto +fi +AC_SUBST(LTO) +AC_SUBST(LTOALL) +AM_CONDITIONAL(BUILD_LTO, [test "x${want_lto}" != xno]) + +AC_ARG_ENABLE([java], +[AS_HELP_STRING([--enable-java],[enable Java @<:@yes@:>@])], +[want_java="${enableval}"], +[want_java=yes]) +AM_CONDITIONAL(WANT_JAVA, [test "x${want_java}" = xyes]) + +### ** Optional packages. + +## BLAS. +AC_ARG_WITH([blas], +[AS_HELP_STRING([--with-blas],[use system BLAS library (if available), or specify it @<:@no@:>@])], +[R_ARG_USE(blas)], +[use_blas=unset]) +# default is "no" except on macOS + +## LAPACK. +AC_ARG_WITH([lapack], +[AS_HELP_STRING([--with-lapack],[use system LAPACK library (if available), or specify it @<:@no@:>@])], +[R_ARG_USE(lapack)], +[use_lapack=unset]) +# default is "no" except on macOS + +## Readline. +AC_ARG_WITH([readline], +[AS_HELP_STRING([--with-readline],[use readline library @<:@yes@:>@])], +[R_ARG_USE(readline)], +[use_readline=yes]) + +## Aqua. +AC_ARG_WITH([aqua], +[AS_HELP_STRING([--with-aqua],[macOS only: use Aqua (if available) @<:@yes@:>@])], +[if test "${withval}" = no; then + want_aqua=no +else + want_aqua=yes +fi], +[want_aqua=yes]) + +## Tcl/Tk. +AC_ARG_WITH([tcltk], +[AS_HELP_STRING([--with-tcltk],[use Tcl/Tk (if available), or specify its library dir @<:@yes@:>@])], +[if test "${withval}" = no; then + want_tcltk=no +elif test "${withval}" = yes; then + want_tcltk=yes +else + want_tcltk=yes + LDFLAGS="${LDFLAGS} -L${withval}" + tcltk_prefix="${withval}" +fi], +[want_tcltk=yes]) +AC_ARG_WITH([tcl-config], +[AS_HELP_STRING([--with-tcl-config=TCL_CONFIG],[specify location of tclConfig.sh @<:@@:>@])], +[TCL_CONFIG="${withval}"], +[TCL_CONFIG=""]) +AC_ARG_WITH([tk-config], +[AS_HELP_STRING([--with-tk-config=TK_CONFIG],[specify location of tkConfig.sh @<:@@:>@])], +[TK_CONFIG="${withval}"], +[TK_CONFIG=""]) + +## cairographics etc +AC_ARG_WITH([cairo], +[AS_HELP_STRING([--with-cairo],[use cairo (and pango) if available @<:@yes@:>@])], +[if test "${withval}" = no; then + want_cairo=no +else + want_cairo=yes +fi], [want_cairo=yes]) + +## other libraries +AC_ARG_WITH([libpng], +[AS_HELP_STRING([--with-libpng],[use libpng library (if available) @<:@yes@:>@])], +[R_ARG_USE(libpng)], +[use_libpng=yes]) +AC_ARG_WITH([jpeglib], +[AS_HELP_STRING([--with-jpeglib],[use jpeglib library (if available) @<:@yes@:>@])], +[R_ARG_USE(jpeglib)], +[use_jpeglib=yes]) +AC_ARG_WITH([libtiff], +[AS_HELP_STRING([--with-libtiff],[use libtiff library (if available) @<:@yes@:>@])], +[R_ARG_USE(libtiff)], +[use_libtiff=yes]) +AC_ARG_WITH([system-tre], +[AS_HELP_STRING([--with-system-tre],[use system tre library (if available) @<:@no@:>@])], +[R_ARG_USE_SYSTEM(tre)], +[use_system_tre=no]) + +## Valgrind instrumentation +AC_ARG_WITH([valgrind-instrumentation], +[AS_HELP_STRING([--with-valgrind-instrumentation],[Level of additional instrumentation for Valgrind (0/1/2) @<:@0@:>@])], +[valgrind_level=${withval}], +[valgrind_level=0]) + +AC_ARG_WITH([system-valgrind-headers], +[AS_HELP_STRING([--with-system-valgrind-headers],[use system valgrind headers (if available) @<:@no@:>@])], +[R_ARG_USE_SYSTEM(valgrind)], +[use_system_valgrind=no]) + +AC_ARG_WITH([internal-tzcode], +[AS_HELP_STRING([--with-internal-tzcode],[use internal time-zone code @<:@no@:>@])], +[use_internal_tzcode=${withval}], +[use_internal_tzcode=default]) + + +## <FIXME> +## Completely disable using libtool for building shlibs until libtool +## fully supports Fortran and C++. +## AC_ARG_WITH([libtool], +## [AS_HELP_STRING([--with-libtool],[use libtool for building shared libraries @<:@yes@:>@])], +## [use_libtool="${withval}"], +## [use_libtool=yes]) +## AM_CONDITIONAL(USE_LIBTOOL, [test "x${use_libtool}" = xyes]) +## </FIXME> + +## Recommended R packages. +AC_ARG_WITH([recommended-packages], +[AS_HELP_STRING([--with-recommended-packages],[use/install recommended R packages @<:@yes@:>@])], +[R_ARG_USE(recommended_packages)], +[use_recommended_packages=yes]) + +## ICU +AC_ARG_WITH([ICU], +[AS_HELP_STRING([--with-ICU],[use ICU library (if available) @<:@yes@:>@])], +[R_ARG_USE(ICU)], +[use_ICU=yes]) + +## Byte-compilation of packages. +AC_ARG_ENABLE([byte-compiled-packages], +[AS_HELP_STRING([--enable-byte-compiled-packages], + [byte-compile base and recommended packages @<:@yes@:>@])], +[want_byte_compiled_packages="${enableval}"], +[want_byte_compiled_packages=yes]) +AM_CONDITIONAL(BYTE_COMPILE_PACKAGES, + [test "x${want_byte_compiled_packages}" = xyes]) + +### ** Precious variables. + +AC_ARG_VAR([R_PRINTCMD], + [command used to spool PostScript files to the printer]) +AC_ARG_VAR([R_PAPERSIZE], + [paper size for the local (PostScript) printer]) +AC_ARG_VAR([R_BATCHSAVE], + [set default behavior of R when ending a session]) +AC_ARG_VAR([MAIN_CFLAGS], + [additional CFLAGS used when compiling the main binary]) +AC_ARG_VAR([SHLIB_CFLAGS], + [additional CFLAGS used when building shared objects]) +AC_ARG_VAR([MAIN_FFLAGS], + [additional FFLAGS used when compiling the main binary]) +AC_ARG_VAR([SHLIB_FFLAGS], + [additional FFLAGS used when building shared objects]) +AC_ARG_VAR([MAIN_LD], + [command used to link the main binary]) +AC_ARG_VAR([MAIN_LDFLAGS], + [flags which are necessary for loading a main program which + will load shared objects (DLLs) at runtime]) +AC_ARG_VAR([CPICFLAGS], + [special flags for compiling C code to be turned into a + shared object.]) +AC_ARG_VAR([FPICFLAGS], + [special flags for compiling Fortran code to be turned into a + shared object.]) +AC_ARG_VAR([FCPICFLAGS], + [special flags for compiling Fortran 95 code to be turned into a + shared object.]) +AC_ARG_VAR([SHLIB_LD], + [command for linking shared objects which contain object + files from a C or Fortran compiler only]) +AC_ARG_VAR([SHLIB_LDFLAGS], + [special flags used by SHLIB_LD]) +AC_ARG_VAR([DYLIB_LD], + [command for linking dynamic libraries which contain object + files from a C or Fortran compiler only]) +AC_ARG_VAR([DYLIB_LDFLAGS], + [special flags used for make a dynamic library]) +AC_ARG_VAR([CXXPICFLAGS], + [special flags for compiling C++ code to be turned into a + shared object]) +AC_ARG_VAR([SHLIB_CXXLD], + [command for linking shared objects which contain object + files from the C++ compiler]) +AC_ARG_VAR([SHLIB_CXXLDFLAGS], + [special flags used by SHLIB_CXXLD]) +AC_ARG_VAR([SHLIB_FCLD], + [command for linking shared objects which contain object + files from the Fortran 95 compiler]) +AC_ARG_VAR([SHLIB_FCLDFLAGS], + [special flags used by SHLIB_FCLD]) +AC_ARG_VAR([TCLTK_LIBS], + [flags needed for linking against the Tcl and Tk libraries]) +AC_ARG_VAR([TCLTK_CPPFLAGS], + [flags needed for finding the tcl.h and tk.h headers]) +AC_ARG_VAR([MAKE], [make command]) +AC_ARG_VAR([TAR], [tar command]) +AC_ARG_VAR([R_BROWSER], [default browser]) +AC_ARG_VAR([R_PDFVIEWER], [default PDF viewer]) +AC_ARG_VAR([BLAS_LIBS], + [flags needed for linking against external BLAS libraries]) +AC_ARG_VAR([LAPACK_LIBS], + [flags needed for linking against external LAPACK libraries]) +AC_ARG_VAR([LIBnn], ['lib' or 'lib64' for dynamic libraries]) +AC_ARG_VAR([SAFE_FFLAGS], + [Safe Fortran 77 compiler flags for e.g. dlamc.f]) +AC_ARG_VAR([r_arch], + [Use architecture-dependent subdirs with this name]) +AC_ARG_VAR([DEFS], [C defines for use when compiling R]) +AC_ARG_VAR([JAVA_HOME], + [Path to the root of the Java environment]) +AC_ARG_VAR([R_SHELL], + [shell to be used for shell scripts, including 'R']) + +if test -z "${r_arch}"; then + R_ARCH= + R_XTRA_CPPFLAGS2="-I\$(R_INCLUDE_DIR)" +else + R_ARCH="/${r_arch}" + R_XTRA_CPPFLAGS2="-I\$(R_INCLUDE_DIR) -I\$(R_INCLUDE_DIR)/${r_arch}" +fi +AC_DEFINE_UNQUOTED(R_ARCH, "${r_arch}", +[Define this to use architecture-dependent subdirectories of this name.]) +AC_SUBST([R_ARCH]) +AC_SUBST([R_XTRA_CPPFLAGS2]) + +### ** Check whether we build in srcdir. + +AC_PATH_PROG(GETWD, pwd, pwd) +AC_MSG_CHECKING([whether builddir is srcdir]) +if test "`cd \"${srcdir}\" && ${GETWD}`" = "`${GETWD}`"; then + BUILDDIR_IS_SRCDIR=yes +else + BUILDDIR_IS_SRCDIR=no +fi +AC_SUBST(BUILDDIR_IS_SRCDIR) +AC_MSG_RESULT([${BUILDDIR_IS_SRCDIR}]) + +### * Checks for programs. + +R_MISSING_PROG(ACLOCAL, aclocal) +R_MISSING_PROG(AUTOCONF, autoconf) +R_MISSING_PROG(AUTOMAKE, automake) +R_MISSING_PROG(AUTOHEADER, autoheader) +AC_PROG_LN_S +AC_PROG_YACC +R_PROG_AR +R_PROG_INSTALL + +## we would like a POSIX sed, and need one on Solaris +AC_PATH_PROGS(SED, sed, /bin/sed, [/usr/xpg4/bin:$PATH]) +## 'which' is not POSIX, and might be a shell builtin or alias +## (but should not be in 'sh') +AC_PATH_PROGS(WHICH, which, which) +## Make +: ${MAKE=make} +AC_SUBST(MAKE) +## Pager +R_PROG_PAGER +## Tar -- we prefer a GNU version +AC_PATH_PROGS(TAR, [${TAR} gtar gnutar tar], "") +## TeXMF stuff +R_PROG_TEXMF +## Unzip & zip & gzip & bip2 +AC_PATH_PROGS(R_UNZIPCMD, [${UNZIP} unzip], "") +AC_PATH_PROGS(R_ZIPCMD, [${ZIP} zip], "") +AC_PATH_PROGS(R_GZIPCMD, [${GZIP} gzip], true) +AC_PATH_PROGS(R_BZIPCMD, [${BZIP} bzip2], "") +## Browser +R_PROG_BROWSER +## PDF viewer +R_PROG_PDFVIEWER +## Noweb - used for maintainer mode only +AC_PATH_PROG(NOTANGLE, notangle, false) +if test "x${use_maintainer_mode}" = xyes; then + if test "${NOTANGLE}" = false ; then + AC_MSG_ERROR([Building R in maintainer mode requires notangle.]) + fi +fi +## javareconf needs this +AC_PATH_PROG(REALPATH, realpath, false) + + +## Search for cairographics needs pkg-config, +## helps find jpeg, libpng and libtiff. +AC_PATH_PROG(PKGCONF, pkg-config , [], + [$PATH:/usr/local/bin:/ext/bin:/ext:/sw/bin:/opt/bin]) +AC_ARG_VAR([PKGCONF], [path to pkg-config utility]) +AC_ARG_VAR([PKG_CONFIG_PATH], [directories to add to pkg-config's search path]) +AC_ARG_VAR([PKG_CONFIG_LIBDIR], [path overriding pkg-config's default search path]) + +AC_PROG_CC +AC_PROG_GCC_TRADITIONAL +AC_GNU_SOURCE ## see note above + +AC_PROG_CPP +R_PROG_CPP_CPPFLAGS + +## see if the user set FFLAGS: used for Intel compilers below +userFFLAGS=${FFLAGS} +R_PROG_F77 + +AC_PROG_CXX +## check this actually compiles +R_PROG_CXX + +### R_PROG_CXX98FLAG + +AC_PROG_CXXCPP +if test "${CXXCPP}" = "${CXX} -E"; then + CXXCPP0="\$(CXX) -E" +else + CXXCPP0=${CXXCPP} +fi +AC_SUBST(CXXCPP0) + +R_GCC4_VISIBILITY + +AC_PROG_OBJC +## unfortunately autoconf sets OBJC to gcc even if there is no working compiler +if test "${OBJC}" = gcc; then + AC_LANG_PUSH([Objective C]) + AC_COMPILE_IFELSE([AC_LANG_PROGRAM(,[id foo;])],,[OBJC='']) + AC_LANG_POP([Objective C]) +fi +R_PROG_OBJCXX + +## This has to be R_DEFS as autoconf overrrides DEFS +R_DEFS=${DEFS} +AC_SUBST(R_DEFS) + +## Libtool. +## (Run this after R_PROG_F77, as AC_PROG_LIBTOOL checks for a +## Fortran 77 compiler and sets F77 accordingly.) +AC_DISABLE_STATIC +LT_INIT +AC_SUBST(LIBTOOL_DEPS) + +## cross-compiling: added May 2007, not actually used +R_CROSS_COMPILING +AC_SUBST(BUILD_CC) +AC_SUBST(BUILD_R) +AM_CONDITIONAL(CROSS_COMPILING, [test "${cross_compiling}" = yes]) + +### * Checks for libraries. + +## Set up LD_LIBRARY_PATH or equivalent. +## <FIXME> +## What is this doing *HERE*? +## Should be needed for tests using AC_RUN_IFELSE()? +## Make sure that non-standard directories specified via '-L' are really +## searched in the tests. +## OTOH, R_LD_LIBRARY_PATH in the environment is meant to be the final version. +R_LD_LIBRARY_PATH_save=${R_LD_LIBRARY_PATH} +R_LD_LIBRARY_PATH= +case "${host_os}" in + darwin*) + ## Darwin provides a full path in the ID of each library such + ## that the linker can add library's path to the binary at link time. + ## This allows the dyld to find libraries even without xx_LIBRARY_PATH. + ## No paths should be added to R_LD_LIBRARY_PATH (which in turn + ## changes DYLD_LIBRARY_PATH), because they override the system + ## look-up sequence. Such automatic override has proven to break things + ## like system frameworks (e.g. ImageIO or OpenGL framework). + ## Not so bad in later versions of Darwin, + ## where DYLD_FALLBACK_LIBRARY_PATH is used (see below). + ;; + *) + for arg in ${LDFLAGS}; do + case "${arg}" in + -L*) + lib=`echo ${arg} | sed "s/^-L//"` + R_SH_VAR_ADD(R_LD_LIBRARY_PATH, [${lib}], [${PATH_SEPARATOR}]) + ;; + esac + done + ;; +esac + +## Record name of environment variable which tells the dynamic linker +## where to find shlibs (typically, 'LD_LIBRARY_PATH'). +## Used in etc/ldpaths: As from R 3.0.0 override what libtool thinks on macOS +## http://hublog.hubmed.org/archives/001192.html suggests this was in 10.4 +## However, as from 10.11 this variable is not passed down to shells. +case "${host_os}" in + darwin*) + Rshlibpath_var=DYLD_FALLBACK_LIBRARY_PATH + ;; + *) + Rshlibpath_var=${shlibpath_var} +esac +AC_SUBST(shlibpath_var) +## Export LD_LIBRARY_PATH or equivalent. +if eval "test -z \"\${${Rshlibpath_var}}\""; then + eval "${Rshlibpath_var}=\"${R_LD_LIBRARY_PATH}\"" +else + eval "${Rshlibpath_var}=\"${R_LD_LIBRARY_PATH}${PATH_SEPARATOR}\${${Rshlibpath_var}}\"" +fi +eval "export ${Rshlibpath_var}" +AC_SUBST(Rshlibpath_var) + +## record how to strip shared/dynamic libraries. +AC_SUBST(striplib) +## record how to strip static libraries. +stripstaticlib=${old_striplib} +AC_SUBST(stripstaticlib) + +## <NOTE> +## This actually comes from libtool.m4. +AC_CHECK_LIBM +AC_SUBST(LIBM) +## </NOTE> +## AC_CHECK_LIBM computes LIBM but does not add to LIBS, hence we do +## the following as well. +AC_CHECK_LIB(m, sin) +case "${host_os}" in + darwin*) + ## macOS >= 10.3 include dlcompat in libSystem + ## This is ancient history + ## SI says we want '-lcc_dynamic' on Darwin, although currently + ## https://developer.apple.com/documentation/MacOSX/ has nothing + ## official. Bill Northcott <w.northcott@unsw.edu.au> points out + ## that it is only needed for GCC 3.x (and earlier) ... + if test "${GCC}" = yes; then + case "${CC_VERSION}" in + 2.*|3.*) + AC_MSG_ERROR([Your gcc is too old.]) + esac + fi + ;; + *) + AC_CHECK_LIB(dl, dlopen) + ;; +esac + +## Readline. +if test "${use_readline}" = yes; then + AC_CHECK_HEADERS(readline/history.h readline/readline.h) + r_save_LIBS="${LIBS}" + LIBS= + ## don't use the cached value as we need to rebuild LIBS + unset ac_cv_lib_readline_rl_callback_read_char + AC_CHECK_LIB(readline, rl_callback_read_char) + use_readline="${ac_cv_lib_readline_rl_callback_read_char}" + if test "${use_readline}" = no; then + ## only need ncurses if libreadline is not statically linked against it + unset ac_cv_lib_readline_rl_callback_read_char + AC_CHECK_LIB(ncurses, main, [], + AC_CHECK_LIB(termcap, main, [], + AC_CHECK_LIB(termlib, main))) + AC_CHECK_LIB(readline, rl_callback_read_char) + use_readline="${ac_cv_lib_readline_rl_callback_read_char}" + if test "${use_readline}" = yes; then + use_readline="${ac_cv_header_readline_readline_h}" + fi + fi + if test "${use_readline}" = no; then + AC_MSG_ERROR([--with-readline=yes (default) and headers/libs are not available]) + else + ## the NetBSD emulation supplied by macOS does not have this + AC_CHECK_FUNCS(history_truncate_file) + ## rl_completion_matches is >= 4.2. + ## rl_resize_terminal is >= 4.0 ane we use it only for >= 6.3. + ## rl_callback_sigcleanup is in pre-releases for 7.0, not yet used. + R_CHECK_FUNCS([rl_callback_sigcleanup rl_completion_matches rl_resize_terminal rl_sort_completion_matches], +[#include <stdio.h> +#include <readline/readline.h>] + ) + fi + READLINE_LIBS="${LIBS}" + LIBS="${r_save_LIBS}" +fi +AC_SUBST(READLINE_LIBS) + +### * Checks for header files. + +AC_HEADER_STDC +AC_HEADER_DIRENT +## we also assume readdir and closedir +if test "${ac_cv_search_opendir}" = "no"; then + AC_MSG_ERROR([Building R requires the 'opendir' system call]) +fi +AC_HEADER_SYS_WAIT +## <NOTE> +## Some of these are also checked for when Autoconf computes the default +## includes. +## +## The following headers are POSIX, +## We use sched.h for Linux-specific features (affinity) +AC_CHECK_HEADERS(dlfcn.h fcntl.h glob.h grp.h pwd.h sched.h strings.h \ + sys/resource.h sys/select.h sys/socket.h sys/stat.h sys/time.h \ + sys/times.h sys/utsname.h unistd.h utime.h) +## dl.h is used in src/unix/hpdlfcn.c included from src/unix/dynload.c on HP-UX +## features.h is used by date-time code on Linux. +## floatingpoint.h is used for fpsetmask on FreeBSD. +## sys/param.h is one way to get PATH_MAX. +AC_CHECK_HEADERS(arpa/inet.h dl.h elf.h features.h floatingpoint.h \ + langinfo.h netdb.h netinet/in.h sys/param.h) +## stdalign.h is C11. +AC_CHECK_HEADERS(stdalign.h) +## These are C99 headers but some C code (written to work also +## without assuming C99) may need the corresponding conditionals. +AC_CHECK_HEADERS(errno.h inttypes.h limits.h locale.h stdarg.h stdbool.h \ + stdint.h string.h) +## only vsnprintf.c requires stdarg.h + +## We also use without checking sys/sysctl.h, but only on *BSD and macOS +## The default includes check for sys/types.h (POSIX), which we use unconditionally +## </NOTE> + +R_HEADER_SETJMP +R_HEADER_GLIBC2 + +### * Checks for types. + +AC_TYPE_SIGNAL +## liblzma uses uint64_t: used unconditionally in src/main/util.c +AC_TYPE_UINT64_T +AC_CHECK_TYPES([int64_t, int_fast64_t]) +AC_TYPE_PID_T +AC_TYPE_SIZE_T +R_SIZE_MAX +AC_CHECK_TYPE(blkcnt_t, long) +AH_TEMPLATE([blkcnt_t], + [Define to 'long' if <sys/types.h> does not define. + Apparently necessary to fix a GCC bug on AIX?]) +R_TYPE_SOCKLEN +AC_CHECK_TYPES([stack_t], , , [#include <signal.h>]) +## These are optional C99 types, which we used to typedef in Defn.h if absent. +## There seems some confusion as to where they should be defined: +## the standard says stdint.h but drafts and Solaris 8 have inttypes.h. +## It seems all systems having stdint.h include it in inttypes.h, and +## POSIX requires that. But we will make sure. +AC_CHECK_TYPES([intptr_t, uintptr_t], , , [#ifdef HAVE_INTTYPES_H +#include <inttypes.h> +#endif +#ifdef HAVE_STDINT_H +#include <stdint.h> +#endif]) + +### * Checks for compiler characteristics. + +### ** Generic tests for the C, Fortran 77 and C++ compilers. + +### *** C compiler. + +R_BIGENDIAN +AC_C_CONST +R_C_INLINE +AC_CHECK_SIZEOF(int) +## on some platforms this gives a trailing lf, so +case "${ac_cv_sizeof_int}" in + 4*) + AC_DEFINE(INT_32_BITS, 1, [Define if you have 32 bit ints.]) + ;; +esac +AC_CHECK_SIZEOF(long) +AC_CHECK_SIZEOF(long long) +AC_CHECK_SIZEOF(double) +AC_CHECK_SIZEOF(size_t) +AC_ARG_ENABLE([long-double], +[AS_HELP_STRING([--enable-long-double],[use long double type @<:@yes@:>@])], +[if test "${enableval}" = no; then + use_long_double=no +else + use_long_double=yes +fi], +[use_long_double=yes]) + +dnl also used in intl. +if test "x${use_long_double}" = xyes; then + AC_DEFINE(HAVE_LONG_DOUBLE, 1, [Define if you wish to use the 'long double' type.]) + AC_CHECK_SIZEOF(long double) +else + AC_MSG_WARN([Not using the 'long double' type]) +fi + +R_PROG_CC_MAKEFRAG +R_PROG_CC_LO_MAKEFRAG + +R_OPENMP + +### *** Fortran 77 compiler. + +R_PROG_F77_FLIBS +if test -z "$FLIBS_IN_SO"; then + FLIBS_IN_SO=${FLIBS} +fi +AC_SUBST(FLIBS_IN_SO) +R_PROG_F77_APPEND_UNDERSCORE +R_PROG_F77_CAN_RUN +R_PROG_F77_CC_COMPAT +R_PROG_F77_CC_COMPAT_COMPLEX + +AM_CONDITIONAL(COMPILE_FORTRAN_DOUBLE_COMPLEX, + [test "x${HAVE_FORTRAN_DOUBLE_COMPLEX}" != x]) + +AC_LANG_PUSH(Fortran 77) +R_OPENMP +AC_LANG_POP(Fortran 77) + + +### *** C++ compiler. + +R_PROG_CXX_MAKEFRAG + +AC_LANG_PUSH(C++) +R_OPENMP +AC_LANG_POP(C++) + +### *** ObjC compiler + +R_PROG_OBJC_MAKEFRAG +R_PROG_OBJC_RUNTIME +## FSF builds of gcc (and maybe others?) need -fobjc-exceptions otherwise +## @try and friends don't work +R_PROG_OBJC_FLAG([-fobjc-exceptions], + R_SH_VAR_ADD(OBJCFLAGS, [-fobjc-exceptions])) +## FIXME: checks for Foundation are not darwin-specifc at all. In fact the whole +## point of R_OBJC_FOUNDATION is to detect foundation classes on other +## platforms (on Darwin we already *know* that is it -framework Foundation +## but not so on Linux!), so the following was not intended to be conditonal. +case "${host_os}" in + darwin*) + R_OBJC_FOUNDATION + ;; +esac + +### ** Platform-specific overrides for the C, Fortran 77 and C++ compilers. + +case "${host_cpu}" in + i*86|x86_64) + R_PROG_CC_FLAG_D__NO_MATH_INLINES + ## We used to add -mieee-fp here, but it seems it is really a + ## linker flag for old Linuxen adding -lieee to a non-shared link. + ;; +esac + +AH_TEMPLATE([HAVE_NO_SYMBOL_UNDERSCORE], + [Define if module-loading does not need an underscore to + be prepended to external names.]) + +case "${host_os}" in + aix*) + AC_DEFINE(HAVE_NO_SYMBOL_UNDERSCORE) + if test "${GCC}" = yes; then + if test "x${OBJECT_MODE}" = "x64"; then + R_PROG_CC_FLAG([-mminimal-toc], + R_SH_VAR_ADD(R_XTRA_CFLAGS, [-mminimal-toc])) + else + R_PROG_CC_FLAG([-mno-fp-in-toc], + R_SH_VAR_ADD(R_XTRA_CFLAGS, [-mno-fp-in-toc])) + fi + fi + ;; + darwin*) + ## which these days mean macOS + AC_DEFINE(HAVE_NO_SYMBOL_UNDERSCORE) + ;; + hpux*) + AC_DEFINE(HAVE_NO_SYMBOL_UNDERSCORE) + case "${CC}" in + cc|c89) + ## Luke Tierney says we also need '-Wp,-H16000' which tells the + ## pre-processor to increase the size of an internal table. It + ## seems that src/main/vfonts/g_her_glyph.c contains a line + ## that is too long for the pre-processor without this flag. + R_SH_VAR_ADD(R_XTRA_CPPFLAGS, [-Wp,-H16000]) + ;; + esac + AC_CHECK_LIB(dld, shl_load, [R_XTRA_LIBS="-ldld ${R_XTRA_LIBS}"]) + ;; + linux*) + case "${CC}" in + ## Intel compiler + *icc*) + ## icc declares __GNUC__, so it picks up CFLAGS intended for gcc. + if test "$ac_test_CFLAGS" != set; then + if test $ac_cv_prog_cc_g = yes; then + case "${host_cpu}" in + x86_64) + CFLAGS="-g -O2 -std=c99" + ;; + *) + ## on ix86 optimization fails + CFLAGS="-g -std=c99" + ;; + esac + else + case "${host_cpu}" in + x86_64) + CFLAGS="-O2 -std=c99" + ;; + *) + CFLAGS="-std=c99" + ;; + esac + fi + fi + ## used to set IEEE flag, but this is version-dependent. + ;; + esac + case "${F77}" in + ## Intel compilers + *ifc|*ifort) + if test "x$userFFLAGS" = x; then + if test $ac_cv_prog_f77_g = yes; then + case "${host_cpu}" in + x86_64) + FFLAGS="-g -O2" + ;; + *) + FFLAGS="-g" + ;; + esac + else + case "${host_cpu}" in + x86_64) + FFLAGS="-O2" + ;; + *) + ## on ix86 optimization of dlamc.f fails + FFLAGS= + ;; + esac + fi + fi + ;; + esac + case "${CXX}" in + ## Intel compilers + *icpc|*icc) + if test "$ac_test_CXXFLAGS" != set; then + if test $ac_cv_prog_cxx_g = yes; then + case "${host_cpu}" in + x86_64) + CXXFLAGS="-g -O2" + ;; + *) + CXXFLAGS="-g" + ;; + esac + else + case "${host_cpu}" in + x86_64) + CXXFLAGS="-O2" + ;; + *) + CXXFLAGS= + ;; + esac + fi + fi + ;; + esac + ;; + mingw*|windows*|winnt) + AC_DEFINE(HAVE_NO_SYMBOL_UNDERSCORE) + ;; + openbsd*) + if test -z "`echo __ELF__ | $CC -E - | grep __ELF__`"; then + AC_DEFINE(HAVE_NO_SYMBOL_UNDERSCORE) + fi + ;; +esac + +if test "${SAFE_FFLAGS+set}" != set; then + if test "x${ac_cv_f77_compiler_gnu}" = xyes; then + SAFE_FFLAGS="${FFLAGS} -ffloat-store" + else + SAFE_FFLAGS=${FFLAGS} + fi +fi + + +AC_SUBST(CFLAGS) +AC_SUBST(MAIN_CFLAGS) +AC_SUBST(SHLIB_CFLAGS) +AC_SUBST(CXXFLAGS) +AC_SUBST(CXXSTD) +AC_SUBST(SHLIB_CXXFLAGS) +AC_SUBST(FFLAGS) +AC_SUBST(SAFE_FFLAGS) +AC_SUBST(MAIN_FFLAGS) +AC_SUBST(SHLIB_FFLAGS) +AC_SUBST(R_XTRA_CFLAGS) +AC_SUBST(R_XTRA_CPPFLAGS) +AC_SUBST(R_XTRA_CXXFLAGS) +AC_SUBST(R_XTRA_FFLAGS) +AC_SUBST(R_XTRA_LIBS) +AC_SUBST(OBJC_LIBS) +AC_SUBST(OBJCFLAGS) +AC_SUBST(OBJCXXFLAGS) + +R_ABI + +### ** DLL stuff. + +## We need to determine the following: +## +## MAIN_LD, MAIN_LDFLAGS +## command and flags for loading the main binary so that it will load +## shared objects (DLLs) at runtime, also for profiling. +## CPICFLAGS, CXXPICFLAGS, FPICFLAGS, FCPICFLAGS +## flags for compiling C, C++, and Fortran library code. +## SHLIB_LD, SHLIB_LDFLAGS +## command and flags for creating DLLs (which contain object files +## from a C or Fortran compiler). +## DYLIB_LD, DYLIB_LDFLAGS +## ditto for dynamic libraries (where different.) +## SHLIB_CXXLD, SHLIB_CXXLDFLAGS +## command and flags for creating DLLs which contain object files from +## a C++ compiler. According to Autoconf, the C++ compiler/linker +## must be used for linking in this case (since special C++-ish things +## need to happen at link time like calling global constructors, +## instantiating templates, enabling exception support, etc.). +## +## The procedure is as follows. +## +## * We use applicable values from imake in case its CC is ours. +## * Irrespective of that, we think we know what to do with GNU tools +## (GNU C, Fortran, and C++ compilers). +## * Then, use platform specific overrides. +## * As a final safeguard, values from the environment (as specified in +## one of the configuration files or at the configure command line) +## override anything we figure out in the case of compiler flags; for +## linker flags (*LDFLAGS), environment settings override our results +## if the corresponding *LD variable was set, and add otherwise. +## +## NOTE: We do not provide defaults for the *LDFLAGS, taking a defensive +## approach. In case we cannot figure out {MAIN,SHLIB}_LDFLAGS and the +## user did not provide defaults, an error results. A warning is given +## if nothing was obtained for SHLIB_CXXLDFLAGS. +## +## Note also that some systems (formerly AIX) do not allow for unresolved +## symbols at link time. For such systems, we link against -lm (in case +## it exists) when building a shlib module via SHLIB_LIBADD. + +main_ld="${CC}" +shlib_ld="${CC}" +shlib_cxxld="${CXX}" +SHLIB_EXT=".so" +SHLIB_LIBADD= +use_exportfiles=no + +## Step 1. Ask imake. +## <NOTE> +## Earlier versions had fpicflags=${cpicflags}. As this really amounts +## to hoping rather than knowing, we no longer do this. +## </NOTE> +r_xtra_path="${PATH}" +for dir in /usr/bin/X11 /usr/X11R6/bin /usr/openwin/bin; do + r_xtra_path="${r_xtra_path}${PATH_SEPARATOR}${dir}" +done +AC_PATH_PROG(XMKMF, xmkmf, [], [${r_xtra_path}]) +if test -n "${XMKMF}"; then + echo > Imakefile + ${XMKMF} > /dev/null 2>&1 || echo > Makefile + cc=`"${srcdir}/tools/GETMAKEVAL" CC` + cc=`echo ${cc} | sed "s/ .*//"` + ## Paul Gilbert reported on R-devel 2006-04-13 a system with cc="" + if test -n "${cc}" ; then + r_cc_cmd=`echo ${CC} | sed "s/ .*//"` + if test "`which ${cc}`" = "`which ${r_cc_cmd}`"; then + shlib_ldflags=`"${srcdir}/tools/GETMAKEVAL" SHLIBLDFLAGS` + cpicflags=`"${srcdir}/tools/GETMAKEVAL" PICFLAGS` + fi + fi + cxx=`"${srcdir}/tools/GETMAKEVAL" CXX` + cxx=`echo ${cxx} | sed "s/ .*//"` + if test -n "${cxx}" -a -n "${CXX}"; then + r_cxx_cmd=`echo ${CXX} | sed "s/ .*//"` + if test "`which ${cxx}`" = "`which ${r_cxx_cmd}`"; then + cxxpicflags=`"${srcdir}/tools/GETMAKEVAL" CXXPICFLAGS` + fi + fi + rm -f Imakefile Makefile +fi + +## Step 2. GNU compilers. +if test "${GCC}" = yes; then + case "${host_cpu}" in +## Sparc has only an 8k global object table, 1024 entries on 64-bit. +## PowerPC has 32k, not enough on ppc64 for the ca6200 entries in libR.so +## The only other platform where this is said to matter is m68k, which +## has 32k and so can use -fpic. +## However, although the gcc docs do not mention it, it seems s390/s390x +## also supports and needs -fPIC + sparc*|ppc64*|powerpc64*|s390*) + cpicflags="-fPIC" + ;; + *) + cpicflags="-fpic" + ;; + esac + shlib_ldflags="-shared" +fi +if test "${G77}" = yes; then + case "${host_cpu}" in + sparc*|ppc64*|powerpc64*|s390*) + fpicflags="-fPIC" + ;; + *) + fpicflags="-fpic" + ;; + esac +fi +if test "${GXX}" = yes; then + case "${host_cpu}" in + sparc*|ppc64*|powerpc64*|s390*) + cxxpicflags="-fPIC" + ;; + *) + cxxpicflags="-fpic" + ;; + esac + shlib_cxxldflags="-shared" +fi + +## Step 3. Individual platform overrides. +dylib_undefined_allowed=yes +case "${host_os}" in + aix*) + use_exportfiles=yes + ## All AIX code is PIC. + cpicflags= + cxxpicflags= + fpicflags= + ## not clear if this is correct for native compilers + wl="-Wl," + ## libtool suggests that ia64 needs -Bexport and not -brtl + ## but we have no confirmation. + dylib_undefined_allowed=no + ##ADD: A symbol of memcpy,memset is exported in libR by expall. + ##ADD: However, for example, symbol in libc of memcpy is __memmove,__memmove64. + ##ADD: This black magic puts lc before lR and pockets this. + if test "x${OBJECT_MODE}" = "x64"; then + main_ldflags="${wl}-brtl ${wl}-bexpall ${wl}-bpT:0x100000000 ${wl}-bpD:0x110000000 -lc" + else + main_ldflags="${wl}-brtl ${wl}-bexpall -lc" + fi + shlib_ldflags="${wl}-brtl ${wl}-G ${wl}-bexpall ${wl}-bnoentry -lc" + SHLIB_LIBADD="\$(LIBM)" + shlib_cxxldflags="${shlib_ldflags}" + if test "${GCC}" = yes; then + shlib_ldflags="-shared ${shlib_ldflags}" + fi + if test "${GXX}" = yes; then + shlib_cxxldflags="-shared ${shlib_cxxldflags}" + fi + ;; + darwin*) + darwin_pic="-fPIC" + dylib_undefined_allowed=no + darwin_dylib_ldflags="-dynamiclib" + shlib_ldflags="-dynamiclib -Wl,-headerpad_max_install_names -undefined dynamic_lookup -single_module -multiply_defined suppress" + ## * recent ld has -single_module so it doesn't need -fno-common + ## we have to use dylib instead of a bundle + ## * dylib+single_module+flat_namespace=pretty much what other platforms call .so + ## but there can be no multiple symbols (due to flat namespace) + ## * since 10.3 we can also use -undefined dynamic_lookup which allows us to + ## use two-level namespace and still have undefined symbols + + ## FIXME: strictly speaking it should be "yes" but libRblas still + ## needs -lgfortran because the sharing is a one-way street + ## dylib_undefined_allowed=yes + + ## we have to test this in case an outdated linker or non-Apple compiler is used + AC_MSG_CHECKING([whether linker supports dynamic lookup]) + AC_CACHE_VAL([r_cv_has_dynlookup],[ +[cat > conftest.c <<EOF + void dummy() { } +EOF] +echo "${CC} ${CFLAGS} conftest.c ${shlib_ldflags} -o libconftest${DYLIB_EXT} ${LIBS}" >&AS_MESSAGE_LOG_FD +if ${CC} ${CFLAGS} conftest.c ${shlib_ldflags} -o libconftest${DYLIB_EXT} ${LIBS} 1>&AS_MESSAGE_LOG_FD 2>&AS_MESSAGE_LOG_FD; then + r_cv_has_dynlookup=yes + AC_MSG_RESULT([yes]) +else + r_cv_has_dynlookup=no + AC_MSG_RESULT([no]) + AC_MSG_WARN([*** Please consider updating your Xcode tools. ***]) +fi +rm -f libconftest${DYLIB_EXT} conftest.c +]) + if test -n "${FORCE_FLAT_NAMESPACE}"; then + AC_MSG_WARN([Use of flat namespace is requested by user.]) + r_cv_has_dynlookup=forced-no + fi + if test "${r_cv_has_dynlookup}" != "yes"; then + shlib_ldflags="-dynamiclib -flat_namespace -undefined suppress -single_module -multiply_defined suppress" + dylib_undefined_allowed=yes + fi + + ## we use the same method for shlib and dylib now + darwin_dylib_ldflags="${shlib_ldflags}" + ## side note: we could use flat namespace instead, but there is an exception: + ## * libRblas must be 2-level, dyn lookup because of xerbla which is undefined + cpicflags="${darwin_pic}" + cxxpicflags="${darwin_pic}" + ## macOS does not have a Fortran compiler, so this is speculative + fpicflags="${darwin_pic}" + shlib_cxxldflags="${shlib_ldflags}" + ;; + freebsd*) + ## maybe this needs to depend on the compiler: + ## -export-dynamic used to work, but does not with clang. + ## Seems FreeBSD has used the GNU linker since at least 3.0 (Oct 1998) + ## We could also use -rdynamic, which seems to work with clang and gcc. + main_ldflags="-Wl,--export-dynamic" + shlib_ldflags="-shared" + ;; + gnu*) # GNU Hurd, see FreeBSD comment + main_ldflags="-Wl,--export-dynamic" + ;; + hpux*) + SHLIB_EXT=".sl" + case "${CC}" in + cc|c89) + cpicflags="+Z" + ;; + esac + case "${F77}" in + f77|fort77|f90) + fpicflags="+Z" + ;; + esac + main_ldflags="-Wl,-E" + if test "${GCC}" = yes; then + shlib_ldflags="-shared -fPIC -Wl,-Bsymbolic" + else + ## <NOTE> + ## Native cc insists on tacking on crt0.o when it calls ld, and + ## crt0.o is not built with PIC. As there seems to be no obvious + ## way to tell cc not to do this, we use ld for linking shlibs. + shlib_ld=ld + shlib_ldflags="-b -Bsymbolic" + ## </NOTE> + fi + if test "${GXX}" = yes; then + shlib_cxxldflags="-shared -fPIC" + fi + ;; + linux*aout) # GNU Linux/aout + sed '/HAVE_ELF_H/d' confdefs.h > tmp.h ; mv tmp.h confdefs.h + ;; + linux*) # GNU Linux/ELF + case "${CC}" in + ## Intel compiler: note that -c99 may have been appended + *icc*) + cpicflags="-fpic" + ;; + ## Portland Group + *pgcc*) + cpicflags="-fpic" + ;; + esac + case "${F77}" in + ## Intel compilers + *ifc|*ifort) + fpicflags="-fpic" + ;; + ## Portland Group + *pgf77|*pgf90|*pgf95) + fpicflags="-fpic" + ;; + esac + case "${CXX}" in + ## Intel compilers + *icpc|*icc) + cxxpicflags="-fpic" + ;; + ## Portland Group + *pgCC) + cxxpicflags="-fpic" + ;; + esac + ## Luke Tierney says that just '-export-dynamic' does not work for + ## Intel compilers (icc). It is accepted by clang but ignored. + ## Could also use -rdynamic, at least for gcc and clang. + main_ldflags="-Wl,--export-dynamic" + STATICR1="-Wl,--whole-archive" + STATICR2="-Wl,--no-whole-archive" + ;; + mingw*) + SHLIB_EXT=".dll" + cpicflags= + cxxpicflags= + fpicflags= + fcpicflags= + ;; + netbsd*) + ## See the comments about FreeBSD + if ${CPP} - -dM < /dev/null | grep __ELF__ >/dev/null ; then + main_ldflags="-Wl,--export-dynamic" + shlib_ldflags="-shared" + else + shlib_ldflags="-Bshareable" + fi + ;; + openbsd*) + ## ${wl} is defined by libtool configuration code. + ## Both -Wl,-export-dynamic and -Wl,--export-dynamic seem to + ## work with the GNU linker, but the second is what is documented. + ## libtool seems to use -Wl-E , a GNU ld alias of -Wl,--export-dynamic + if test -z "`echo __ELF__ | $CC -E - | grep __ELF__`"; then + main_ldflags="${wl}-export-dynamic" + shlib_ldflags="-shared -fPIC" + fi + case "${host_cpu}" in + powerpc*) + ## GCC -fpic limits to 2**16 on OpenBSD powerpc. + ## Error message without -fPIC: + ## relocation truncated to fit: R_PPC_GOT16... + if test "${GCC}" = yes; then + cpicflags="-fPIC" + fi + if test "${G77}" = yes; then + fpicflags="-fPIC" + fi + if test "${GXX}" = yes; then + cxxpicflags="-fPIC" + fi + ;; + esac + ;; + solaris*) +## SPARC has only an 8k global object table, 1024 entries on 64-bit, +## so need PIC not pic. They are the same on other Solaris platforms. + shlib_ldflags="-G" + shlib_cxxldflags="-G" + if test "${GCC}" = yes; then + cpicflags="-fPIC" + ld=`${CC} -print-prog-name=ld` + ldoutput=`${ld} -v 2>&1 | grep GNU` + if test -n "${ldoutput}"; then + main_ldflags="-Wl,-export-dynamic" + shlib_ldflags="-shared" + shlib_cxxldflags="-shared" + else + ## it seems gcc c 4.6.2 needs this with Solaris linker + shlib_ldflags="-shared" + shlib_cxxldflags="-shared" + fi + else + cpicflags="-KPIC" + if test "`basename ${CXX}`" = "CC" ; then + ## Forte version 7 needs -lCstd: Forte 6 does not. + ver=`${CXX} -V 2>&1 | sed 2d | grep 'Forte Developer 7 C++'` + if test -n "${ver}" ; then + shlib_cxxldflags="-G -lCstd" + fi + fi + fi + ## G77 include gfortran + if test "${G77}" != yes; then + fpicflags="-PIC" + else + fpicflags="-fPIC" + fi + if test "${GXX}" = yes; then + cxxpicflags="-fPIC" + ld=`${CXX} -print-prog-name=ld` + ldoutput=`${ld} -v 2>&1 | grep GNU` + if test -n "${ldoutput}"; then + shlib_cxxldflags="-shared" + fi + else + cxxpicflags="-KPIC" + fi + ;; +esac + +## <FIXME> +## Completely disable using libtool for building shlibs until libtool +## fully supports at least Fortran and C++. +## ## Step 4. In case we use libtool ... +## if test "${use_libtool}" = yes; then +## case "${host_os}" in +## *) +## ;; +## esac +## fi +## </FIXME> + +## Step 5. Overrides from the environment and error checking. +if test -z "${MAIN_LD}"; then + main_ld_was_given=no + if test "${main_ld}" = "${CC}"; then + MAIN_LD="\$(CC)" + else + MAIN_LD="${main_ld}" + fi +fi +R_SH_VAR_ADD(MAIN_LDFLAGS, [${main_ldflags}]) + +: ${CPICFLAGS="${cpicflags}"} +if test -z "${CPICFLAGS}"; then + case "${host_os}" in + aix*|mingw*) + ;; + *) + AC_MSG_WARN([I could not determine CPICFLAGS.]) + AC_MSG_ERROR([See the file doc/html/R-admin.html for more information.]) + ;; + esac +fi + +: ${FPICFLAGS="${fpicflags}"} +if test -z "${FPICFLAGS}"; then + case "${host_os}" in + aix*|mingw*) + ;; + *) + AC_MSG_WARN([I could not determine FPICFLAGS.]) + AC_MSG_ERROR([See the file doc/html/R-admin.html for more information.]) + ;; + esac +fi + +: ${CXXPICFLAGS="${cxxpicflags}"} +if test -n "${CXX}" -a -z "${CXXPICFLAGS}"; then + case "${host_os}" in + aix*|mingw*) + ;; + *) + warn_cxxpicflags="I could not determine CXXPICFLAGS." + ;; + esac +fi + +if test -z "${SHLIB_LD}"; then + shlib_ld_was_given=no + if test "${shlib_ld}" = "${CC}"; then + SHLIB_LD="\$(CC)" + else + SHLIB_LD="${shlib_ld}" + fi + R_SH_VAR_ADD(SHLIB_LDFLAGS, [${shlib_ldflags}]) +fi +if test -z "${SHLIB_LDFLAGS}"; then + AC_MSG_WARN([I could not determine SHLIB_LDFLAGS.]) + AC_MSG_ERROR([See the file doc/html/R-admin.html for more information.]) +fi + +if test -z "${SHLIB_CXXLD}"; then + shlib_cxxld_was_given=no + if test "${shlib_cxxld}" = "${CXX}"; then + SHLIB_CXXLD="\$(CXX)" + else + SHLIB_CXXLD="${shlib_cxxld}" + fi + R_SH_VAR_ADD(SHLIB_CXXLDFLAGS, [${shlib_cxxldflags}]) +fi +if test -n "${CXX}" -a -z "${SHLIB_CXXLDFLAGS}"; then + warn_shlib_cxxldflags="I could not determine SHLIB_CXXLDFLAGS" + AC_MSG_WARN([${warn_shlib_cxxldflags}]) +fi + +## Step 6. We may need flags different from SHLIB_LDFLAGS and SHLIB_EXT +## for building R as a shared library to link against (the SHLIB_* vars +## just determined are really for loadable modules). On ELF there is no +## difference, but e.g. on Mach-O for Darwin there is. +## +## Also need flags to build the Rlapack shared library on some platforms. +DYLIB_EXT="${SHLIB_EXT}" +dylib_ldflags="${SHLIB_LDFLAGS}" +LIBR_LDFLAGS="" +RLAPACK_LDFLAGS="" +RBLAS_LDFLAGS="" +R_DYLIB_VERSION_SUFFIX="" +case "${host_os}" in + aix*) + ## Not needed for -brtl linking + # RLAPACK_LDFLAGS="${wl}-bE:\$(top_builddir)/etc/Rlapack.exp" + # LAPACK_LDFLAGS="${wl}-bI:\$(R_HOME)/etc/Rlapack.exp" + ;; + darwin*) + DYLIB_EXT=".dylib" + dylib_ldflags="${darwin_dylib_ldflags}" + MAJR_VERSION=`echo "${PACKAGE_VERSION}" | sed -e "s/[[\.]][[1-9]]$/.0/"` + LIBR_LDFLAGS="-install_name libR.dylib -compatibility_version ${MAJR_VERSION} -current_version ${PACKAGE_VERSION} -headerpad_max_install_names" + RLAPACK_LDFLAGS="-install_name libRlapack.dylib -compatibility_version ${MAJR_VERSION} -current_version ${PACKAGE_VERSION} -headerpad_max_install_names" + ## don't use version in libRblas so we can replace it with any BLAS implementation + RBLAS_LDFLAGS="-install_name libRblas.dylib -headerpad_max_install_names" + ;; + hpux*) + ## Needs to avoid embedding a relative path ../../../bin. + ## See the above code for shlib_ldflags for reasons why we currently + ## cannot always use '-Wl,+s'. + if test "${GCC}" = yes; then + LAPACK_LDFLAGS="-Wl,+s" + else + LAPACK_LDFLAGS="+s" + fi + ;; + openbsd*) + if test -z "${R_DYLIB_VERSION}"; then + PACKAGE_VERSION_MAJOR=`echo "${PACKAGE_VERSION}" | \ + sed -e "s/\.//" -e "s/\..*$//"` + PACKAGE_VERSION_MINOR=`echo "${PACKAGE_VERSION}" | \ + sed -e "s/.*\.\([[^.]][[^.]]*$\)/\1/"` + R_DYLIB_VERSION="${PACKAGE_VERSION_MAJOR}.${PACKAGE_VERSION_MINOR}" + fi + R_DYLIB_VERSION_SUFFIX=".${R_DYLIB_VERSION}" + ;; +esac + +R_DYLIB_EXT="${DYLIB_EXT}${R_DYLIB_VERSION_SUFFIX}" + +if test -z "${DYLIB_LD}"; then + dylib_ld_was_given=no + DYLIB_LD="${SHLIB_LD}" + R_SH_VAR_ADD(DYLIB_LDFLAGS, [${dylib_ldflags}]) +else + if test -z "${DYLIB_LDFLAGS}"; then + DYLIB_LDFLAGS="${dylib_ldflags}" + fi +fi + +## some claim Solaris needs -lsocket -lnsl (PR#15815) +: ${INTERNET_LIBS="${internet_libs}"} +AC_SUBST(INTERNET_LIBS) + +AM_CONDITIONAL(DYLIB_UNDEFINED_ALLOWED, [test "x${dylib_undefined_allowed}" = xyes]) + +AC_SUBST(MAIN_LD) +AC_SUBST(MAIN_LDFLAGS) +AC_SUBST(CPICFLAGS) +AC_SUBST(CXXPICFLAGS) +AC_SUBST(DYLIB_LD) +AC_SUBST(DYLIB_LDFLAGS) +AC_SUBST(FCPICFLAGS) +AC_SUBST(FPICFLAGS) +AC_SUBST(SHLIB_CXXLD) +AC_SUBST(SHLIB_CXXLDFLAGS) +AC_SUBST(SHLIB_LD) +AC_SUBST(SHLIB_LDFLAGS) +AC_SUBST(SHLIB_LIBADD) +AC_SUBST(SHLIB_EXT) +AC_DEFINE_UNQUOTED(SHLIB_EXT, "${SHLIB_EXT}", +[Define this to be the extension used for shared objects on your system.]) +AM_CONDITIONAL(USE_EXPORTFILES, [test "x${use_exportfiles}" = xyes]) +AC_SUBST(DYLIB_EXT) +AC_SUBST(LIBR_LDFLAGS) +AC_SUBST(RBLAS_LDFLAGS) +AC_SUBST(RLAPACK_LDFLAGS) +AC_SUBST(LAPACK_LDFLAGS) +AC_SUBST(FW_VERSION) +AC_SUBST(STATICR1) +AC_SUBST(STATICR2) +AC_SUBST(R_DYLIB_EXT) + +## Test support for C++ standards +R_STDCXX([98], [CXX98], [CXX]) +R_STDCXX([11], [CXX11], [CXX]) +R_STDCXX([14], [CXX14], [CXX11]) +R_STDCXX([17], [CXX17], [CXX14]) + +### OpenMP. + +## The basic checking is performed via AC_OPENMP added in Autoconf 2.62, +## which we already called for determining the appropriate flags for the +## C, C++, Fortran 77, Fortran compiler/linker. Note that this gives +## variables OPENMP_CFLAGS etc., which are meant to be used for *both* +## compiling and linking. So we can really only used them provided that +## we use the respective compilers for linking as well (or we need a +## different mechanism for determining what is needed). +## +## For compiling R itself, we use MAIN_LD and DYLIB_LD for linking, both +## defaulting to CC. Hence: +## +## If both MAIN_LD and DYLIB_LD were not specified by the user and +## equal CC and this was determined to support OpenMP, then we (try +## to) provide OpenMP support by adding OPENMP_CFLAGS to the linker +## flags and OPENMP_CFLAGS and OPENMP_FFLAGS to the C and Fortran 77 +## compiler flags, and defining HAVE_OPENMP. +## +## (The Fortran 77 compiler is never used for linking by default.) + +if test -n "${R_OPENMP_CFLAGS+set}"; then + if test -n "${R_OPENMP_CFLAGS}"; then + R_SH_VAR_ADD(MAIN_LDFLAGS, [${R_OPENMP_CFLAGS}]) + R_SH_VAR_ADD(DYLIB_LDFLAGS, [${R_OPENMP_CFLAGS}]) + AC_DEFINE(HAVE_OPENMP, 1, [Define if you have C OpenMP support.]) + fi +elif test "x${main_ld_was_given}" = xno -a "${MAIN_LD}" = "\$(CC)" -a \ + "x${dylib_ld_was_given}" = xno -a "${DYLIB_LD}" = "\$(CC)" -a \ + "x${ac_cv_prog_c_openmp}" != "xunsupported"; then + R_OPENMP_CFLAGS="${OPENMP_CFLAGS}" + R_SH_VAR_ADD(MAIN_LDFLAGS, [${OPENMP_CFLAGS}]) + R_SH_VAR_ADD(DYLIB_LDFLAGS, [${OPENMP_CFLAGS}]) + AC_DEFINE(HAVE_OPENMP, 1, [Define if you have C OpenMP support.]) +else + R_OPENMP_CFLAGS= +fi +## Currently unused: see comment in Makeconf.in +if test -z "${R_OPENMP_FFLAGS+set}" -a \ + "x${ac_cv_prog_f77_openmp}" != "xunsupported"; then + R_OPENMP_FFLAGS="${OPENMP_FFLAGS}" +fi +AC_SUBST(R_OPENMP_CFLAGS) +AC_SUBST(R_OPENMP_FFLAGS) + +## For compiling package code, we use SHLIB_FCLD, SHLIB_CXXLD or +## SHLIB_LD for linking, depending on whether the package contains +## Fortran (90/95) code, C++ (or ObjC) code, or "just" C and Fortran 77. +## However, we (currently) do not conditionalize compilation flags. So +## the only "safe" thing we can do for now is: +## +## If none of SHLIB_LD, SHLIB_CXXLD and SHLIB_FCLD were specified by +## the user and equal CC, CXX and FC, respectively, and these were +## determined to support OpenMP, the we try to provide OpenMP support +## for packages by adding OPENMP_FCFLAGS, OPENMP_CXXFLAGS and +## OPENMP_CFLAGS to the respective linker flags, and add the OPENMP +## flags to all (C, C++, Fortran and Fortran 77) compiler flags. + +## <FIXME> +## Need to do this after configuring Fortran 90/95 support, which comes +## way below: should this be moved up to the compiler section? +## </FIXME> + +### Now we have found all the flags, we need to use them to test appropriately. +### We don't currently have any C++ tests, but future-proof. +### In principle we should do this before testing for C-Fortran compatibility. + +CPPFLAGS_KEEP=${CPPFLAGS} +CFLAGS_KEEP=${CFLAGS} +FFLAGS_KEEP=${FFLAGS} +CXXFLAGS_KEEP=${CXXFLAGS} +CPPFLAGS="${CPPFLAGS} ${R_XTRA_CPPFLAGS}" +if test "${want_R_shlib}" = yes; then + CFLAGS="${CFLAGS} ${CPICFLAGS} ${R_XTRA_CFLAGS}" + FFLAGS="${FFLAGS} ${FPICFLAGS} ${R_XTRA_FFLAGS}" + CXXFLAGS="${CXXFLAGS} ${CXXPICFLAGS} ${R_XTRA_CXXFLAGS}" +else + CFLAGS="${CFLAGS} ${R_XTRA_CFLAGS}" + FFLAGS="${FFLAGS} ${R_XTRA_FFLAGS}" + CXXFLAGS="${CXXFLAGS} ${R_XTRA_CXXFLAGS}" +fi + +### * Checks for library functions. + +AC_CHECK_TYPES([off_t]) +AC_FUNC_ALLOCA +AC_CHECK_DECLS([alloca], , , +[#ifdef HAVE_ALLOCA_H +# include <alloca.h> +#endif]) + +## C99 functions: +## not all C99 runtimes are complete, +## but we have substitutes for expm1 hypot log1p and (internally) nearbyint[l] +## FreeBSD used to lack log1pl, but 10 seems to have it. +## FreeBSD 8.2 lacks log2 +## FreeBSD 7.3 lacks nearbyintl/rintl (nearbyint appeared in 5.2) +## Apparently rint was once broken on HP-UX: undefine HAVE_RINT for such platforms +## Cygwin and FreeBSD lacked powl (FreeBSD 10 seems to have it). +## Cygwin had rintl but not nearbyintl +R_CHECK_FUNCS([expm1 hypot log1p log1pl log2 log10 nearbyint nearbyintl powl rint rintl], [#include <math.h>]) +## va_copy is C99: required as from R 2.13.0 +R_CHECK_FUNCS([va_copy], [#include <stdarg.h>]) +if test "${ac_cv_have_decl_va_copy}" = "no"; then + AC_MSG_ERROR([Building R requires the 'va_copy' system call]) +fi +## isblank should be a macro according to C99. It was missing on Solaris 8 +AC_CHECK_FUNCS(isblank) + +## Solaris libsunmath +AC_CHECK_HEADERS(sunmath.h) +AC_CHECK_LIB(sunmath, cospi) + +## Functions from ISO/IEC TS 18661-4:2015 C11 extensions. +## For now, do not define _GNU_SOURCE here. +## All but pown have long been in Solaris' libsunmath +## macOS has __cospi __sinpi __tanpi +AC_CHECK_FUNCS([atanpi atan2pi cospi exp10 pown sinpi tanpi __cospi __sinpi __tanpi], +[#define __STDC_WANT_IEC_60559_FUNCS_EXT__ 1 +#include <math.h> +#ifdef HAVE_SUNMATH_H +#include <sunmath.h> +#endif]) + +## fseeko/ftello are POSIX, may be macros +## matherr is SVID, redefined in arithmetic.c if present +AC_CHECK_FUNCS(fseeko ftello matherr) + +## POSIX functions +R_CHECK_FUNCS([fcntl], [#include <fcntl.h>]) +R_CHECK_FUNCS([getgrgid], [#include <grp.h>]) +R_CHECK_FUNCS([getpwuid], [#include <pwd.h>]) +R_CHECK_FUNCS([kill sigaction sigaltstack sigemptyset], [#include <signal.h>]) +R_CHECK_FUNCS([fdopen popen], [#include <stdio.h>]) +if test "${ac_cv_have_decl_popen}" = "no"; then + AC_MSG_ERROR([Building R requires the 'popen' system call]) +fi +R_CHECK_FUNCS([getline], [#include <stdio.h>]) +R_CHECK_FUNCS([select], +[#ifdef HAVE_SYS_SELECT_H +#include <sys/select.h> /* POSIX >= 2001 */ +#endif +#ifdef HAVE_SYS_TIME_H +#include <sys/time.h> /* Earlier POSIX, HP-UX? */ +#endif]) +case "${host_os}" in + mingw*|windows*|winnt) + ;; + *) + if test "${ac_cv_have_decl_select}" = "no"; then + AC_MSG_ERROR([Building R on Unix requires the 'select' system call]) + fi + if test "${ac_cv_header_sys_select_h}" = "no" -a "${ac_cv_header_sys_times_h} = "no""; then + AC_MSG_ERROR([Building R on Unix requires either <sys/select.h> or <sys/time.h>]) + fi + ;; +esac +## Windows has neither setenv nor unsetenv +R_CHECK_FUNCS([setenv unsetenv], [#include <stdlib.h>]) +R_CHECK_FUNCS([getrlimit getrusage getpriority], [#include <sys/resource.h>]) +R_CHECK_FUNCS([chmod mkfifo stat umask], [#include <sys/stat.h>]) +if test "${ac_cv_have_decl_stat}" = "no"; then + AC_MSG_ERROR([Building R requires the 'stat' system call]) +fi +R_CHECK_FUNCS([gettimeofday utimes], [#include <sys/time.h>]) +R_CHECK_FUNCS([times], [#include <sys/times.h>]) +R_CHECK_FUNCS([gmtime_r localtime_r], [#include <time.h>]) +R_CHECK_FUNCS([nl_langinfo], [#include <langinfo.h>]) +R_CHECK_FUNCS([access chdir execv ftruncate getcwd geteuid getuid link readlink symlink sysconf], +[#ifdef HAVE_UNISTD_H +# include <unistd.h> +#endif]) +## Linux-specific feature allowing us to fix CPU affinity for parallel +R_CHECK_FUNCS([sched_setaffinity sched_getaffinity], [#include <sched.h>]) +## utime was declared obsolescent in POSIX 2008 (use utimes instead) +R_CHECK_FUNCS([utime], [#include <utime.h>]) +## POSIX.1-2008 preferred form +R_CHECK_FUNCS([utimensat], [#include <sys/stat.h>]) +## clock_gettime is POSIX 1993, but not on macOS prior to 10.12 (Sierra) +## Some OSes need -lrt: Linux (for glibc versions before 2.17), Solaris, +## not FreeBSD. +## Unsurprising, as POSIX 2008 moved it from its timers section to base. +## timespec_get is C11. +AC_CHECK_LIB(rt, clock_gettime) +R_CHECK_FUNCS([clock_gettime timespec_get], [#include <time.h>]) +## We need setenv or putenv. It seems that everyone does have +## putenv, as earlier versions of R would have failed without it. +## It is not always declared, so we do not require a declaration. +AC_CHECK_FUNCS(putenv) +AC_CHECK_DECLS([putenv], , , [#include <stdlib.h>]) +## this is a GNU extension so usually hidden. Not in Solaris 10 +AC_CHECK_FUNCS(vasprintf) +AC_CHECK_DECLS([vasprintf], , , [#include <stdio.h>]) +## mempcpy is a GNU extension used by the included gettext. Not in Solaris 10 +AC_CHECK_FUNCS(mempcpy) +## realpath is POSIX 2001 (and BSD) +## Some early GNU libc systems had it in unistd.h. +AC_CHECK_FUNCS(realpath) +AC_CHECK_DECLS([realpath], , , [#include <stdlib.h> +#ifdef HAVE_UNISTD_H +#include <unistd.h> +#endif]) +## glob is POSIX: we have a substitute on Windows +## assume without checking that if we have glob we also have globfree +R_CHECK_FUNCS([glob], [#ifdef HAVE_GLOB_H +# include <glob.h> +#endif]) +AC_CHECK_FUNCS([dladdr dlsym]) +AC_CHECK_DECLS([dladdr,dlsym], , , [#include<dlfcn.h>]) +AC_CHECK_DECLS([RTLD_DEFAULT,RTLD_NEXT], , , [#include<dlfcn.h>]) + +## Lots of uses of getwd(), file.access(), Sys.glob(). +## We don't need times() except as a fallback for getrusage and +## clock_gettime/gettimeofday -- but it is older and always there. +case "${host_os}" in + mingw*) + ;; + *) + if test "${ac_cv_search_glob}" = "no"; then + AC_MSG_ERROR([Building R requires the 'glob' system call]) + fi + if test "${ac_cv_search_access}" = "no"; then + AC_MSG_ERROR([Building R requires the 'access' system call]) + fi + if test "${ac_cv_search_getcwd}" = "no"; then + AC_MSG_ERROR([Building R requires the 'getcwd' system call]) + fi + if test "${ac_cv_search_chdir}" = "no"; then + AC_MSG_ERROR([Building R requires the 'chdir' system call]) + fi + if test "${ac_cv_search_times}" = "no"; then + AC_MSG_ERROR([Building R requires the 'times' system call]) + fi + ;; +esac +## We also use getlogin isatty rename unlink without checking. + +## <NOTE> +## No need checking for bcopy bzero memcpy even though ifnames +## might report corresponding HAVE_FOO conditionals. +## </NOTE> + + +if test $ac_cv_type_off_t=yes -a $ac_cv_func_fseeko=yes -a $ac_cv_func_ftello=yes; then + AC_DEFINE(HAVE_OFF_T, 1, + [Define if you have off_t, fseeko and ftello.]) +fi + +## IEEE 754. We rely on this in e.g. the working log test. +R_IEEE_754 + +## check if putenv can substitute for unsetenv +R_PUTENV_AS_UNSETENV + + +## check whether nl_langinfo(CODESET) is in langinfo.h +## defines HAVE_LANGINFO_CODESET if it's there +AM_LANGINFO_CODESET + +## Used to build src/include/Rmath.h. +## <NOTE> +## we don't use AC_CONFIG_HEADERS on Rmath.h.in because +## a) that would comment out #undef statements in Rmath.h.in and +## b) Rmath.h should be a self-contained file for standalone Rmath use. +## </NOTE> +if test "${ac_cv_have_decl_expm1}" = yes; then + RMATH_HAVE_EXPM1="# define HAVE_EXPM1 1" +else + RMATH_HAVE_EXPM1="# undef HAVE_EXPM1" +fi +AC_SUBST(RMATH_HAVE_EXPM1) +if test "${ac_cv_have_decl_hypot}" = yes; then + RMATH_HAVE_HYPOT="# define HAVE_HYPOT 1" +else + RMATH_HAVE_HYPOT="# undef HAVE_HYPOT" +fi +AC_SUBST(RMATH_HAVE_HYPOT) +if test "${ac_cv_have_decl_log1p}" = yes; then + RMATH_HAVE_LOG1P="# define HAVE_LOG1P 1" +else + RMATH_HAVE_LOG1P="# undef HAVE_LOG1P" +fi +AC_SUBST(RMATH_HAVE_LOG1P) + +## Do we need substitutes? +## mkdtemp is not on Solaris 10, added in POSIX 2008 +## strdup strncasecmp were first required in POSIX 2001. +AC_REPLACE_FUNCS([mkdtemp strdup strncasecmp]) +## Enable declarations in Defn.h? +AC_CHECK_DECLS([mkdtemp, strdup, strncasecmp]) + +AC_SEARCH_LIBS(connect, [socket]) +# gethostbyname was removed in POSIX 2008 (in favour of getaddrinfo, POSIX 2001) +AC_SEARCH_LIBS(gethostbyname, [nsl socket]) +AC_SEARCH_LIBS(xdr_string, [nsl tirpc]) +R_FUNC_CALLOC +if test "${ac_cv_have_decl_isfinite}" = "yes"; then +R_FUNC_ISFINITE +fi +## check accuracy of log1p +R_FUNC_LOG1P +R_FUNC_FTELL +R_FUNC_SIGACTION + +if test x${use_internal_tzcode} = xdefault; then +case "${host_os}" in + darwin*) + use_internal_tzcode=yes; + ;; +esac +fi +if test "${use_internal_tzcode}" != yes; then + R_MKTIME_ERRNO + R_FUNC_MKTIME +fi + +R_C99_COMPLEX + +## BSD extensions +AC_CACHE_CHECK([whether 'struct tm' includes tm_zone], + [r_cv_have_tm_zone], +[AC_COMPILE_IFELSE([AC_LANG_SOURCE([[ +// glibc needs this defined. +#define _BSD_SOURCE +#include <time.h> + +int main() { + struct tm x; + x.tm_zone = ""; +} +]])], + [r_cv_have_tm_zone=yes], + [r_cv_have_tm_zone=no])]) +if test "x${r_cv_have_tm_zone}" = xyes; then + AC_DEFINE(HAVE_TM_ZONE, 1, [Define to 1 if your 'struct tm' has tm_zone.]) +fi + +AC_CACHE_CHECK([whether 'struct tm' includes tm_gmtoff], + [r_cv_have_tm_gmtoff], +[AC_COMPILE_IFELSE([AC_LANG_SOURCE([[ +// glibc needs this defined, second for >= 2.20 +#define _BSD_SOURCE +#define _DEFAULT_SOURCE +#include <time.h> + +int main() { + struct tm x; + x.tm_gmtoff = +3600; +} +]])], + [r_cv_have_tm_gmtoff=yes], + [r_cv_have_tm_gmtoff=no])]) +if test "x${r_cv_have_tm_gmtoff}" = xyes; then + AC_DEFINE(HAVE_TM_GMTOFF, 1, [Define to 1 if your 'struct tm' has tm_gmtoff.]) +fi + +## BLAS. +## <NOTE> +## This has to come *after* checking for Fortran 77 compiler/converter +## characteristics (notably name mangling and FLIBS). +## </NOTE> + +if test "${use_blas}" = yes; then + ## may acx_blas_ok to yes + R_BLAS_LIBS +fi + +if test "${acx_blas_ok}" != "yes"; then + case "${host_os}" in + aix*) + ;; + *) + if test "${use_blas_shlib}" = "unset"; then + use_blas_shlib="yes" + fi + ;; + esac +fi + +AM_CONDITIONAL(BLAS_SHLIB, [test "x${use_blas_shlib}" = xyes]) + +case "${host_os}" in + darwin*) + ## In order to allow the R build to be relocatable, we strip paths + ## from all shlibs and rely on DYLD_LIBRARY_PATH. Unfortunately + ## Darwin linker ignores it at build-time and doesn't use -L to + ## resolve dylib dependencies, so libRblas will not be found unless + ## we tell ld where it lives. I don't know of any more elegant solution :/ + if test "x${use_blas_shlib}" = xyes; then + LIBR="${LIBR} -dylib_file libRblas.dylib:\$(R_HOME)/lib\$(R_ARCH)/libRblas.dylib" + fi + ;; +esac +## LIBR0 is for the -L part, LIBR1 for -lR (if needed) +AC_SUBST(LIBR0) +AC_SUBST(LIBR1) + +## This version is used to build a shared BLAS lib +BLAS_LIBS0=${BLAS_LIBS} + +## external BLAS + shared BLAS lib = we need to pass symbols through +## this may require some magic +if test "${acx_blas_ok}" = yes -a "${use_blas_shlib}" = yes; then + case "${host_os}" in + darwin*) + ## test whether we can see symbols through the proxy BLAS library + ## this test could be modified to not be Darwin-specific, + ## however the fix is darwin-specific + if test "${r_cv_prog_f77_append_underscore}" = yes; then + dgemm=dgemm_ + xerbla=xerbla_ + else + dgemm=dgemm + xerbla=xerbla + fi + AC_MSG_CHECKING([whether external BLAS is visible through libRblas]) + AC_CACHE_VAL([r_cv_blas0_passthrough],[ +[cat > conftestl.c <<EOF + void ${dgemm}(); + void dummy() { ${dgemm}(); } +EOF] +echo "${CC} ${CFLAGS} conftestl.c ${SHLIB_LDFLAGS} -o libconftest${DYLIB_EXT} ${LIBS} ${BLAS_LIBS}" >&AS_MESSAGE_LOG_FD +${CC} ${CFLAGS} conftestl.c ${SHLIB_LDFLAGS} -o libconftest${DYLIB_EXT} ${LIBS} ${BLAS_LIBS} 1>&AS_MESSAGE_LOG_FD 2>&AS_MESSAGE_LOG_FD +[cat > conftest.c <<EOF +void ${dgemm}(); +void ${xerbla}(char *srname, int *info){}; +int main(int argc, char **argv) { if (argc<0) ${dgemm}(); return 0; } +EOF] +if ${CC} ${CFLAGS} -c conftest.c 1>&AS_MESSAGE_LOG_FD 2>&AS_MESSAGE_LOG_FD; then + if ${CC} ${LDFLAGS} -o conftest${ac_exeext} \ + conftest.${ac_objext} -L. -lconftest \ + 1>&AS_MESSAGE_LOG_FD 2>&AS_MESSAGE_LOG_FD; + then + ## redirect error messages to config.log + output=`./conftest${ac_exeext} 2>&AS_MESSAGE_LOG_FD` + if test ${?} = 0; then + r_cv_blas0_passthrough=yes + fi + fi +fi +]) +if test -n "${r_cv_blas0_passthrough}"; then +r_cv_blas0_passthrough=yes +AC_MSG_RESULT([yes]) +else +AC_MSG_RESULT([no]) +AC_MSG_CHECKING([can it be fixed by using -sub_umbrella]) +ac_test_BLAS_LIBS=`echo "${BLAS_LIBS}"|sed -e s/-framework/-sub_umbrella/` +rm -f libconftest.dylib +echo "${CC} ${CFLAGS} conftestl.c ${SHLIB_LDFLAGS} -o libconftest${DYLIB_EXT} ${LIBS} ${BLAS_LIBS} ${ac_test_BLAS_LIBS}" >&AS_MESSAGE_LOG_FD +${CC} ${CFLAGS} conftestl.c ${SHLIB_LDFLAGS} -o libconftest${DYLIB_EXT} ${LIBS} ${BLAS_LIBS} ${ac_test_BLAS_LIBS} 1>&AS_MESSAGE_LOG_FD 2>&AS_MESSAGE_LOG_FD +if ${CC} ${CFLAGS} -c conftest.c 1>&AS_MESSAGE_LOG_FD 2>&AS_MESSAGE_LOG_FD; then + if ${CC} ${LDFLAGS} -o conftest${ac_exeext} \ + conftest.${ac_objext} -L. -lconftest \ + 1>&AS_MESSAGE_LOG_FD 2>&AS_MESSAGE_LOG_FD; + then + ## redirect error messages to config.log + output=`./conftest${ac_exeext} 2>&AS_MESSAGE_LOG_FD` + if test ${?} = 0; then + r_cv_blas0_passthrough=yes + fi + fi +fi +if test -n "${r_cv_blas0_passthrough}"; then +r_cv_blas0_passthrough=yes +AC_MSG_RESULT([yes]) +BLAS_LIBS0="${BLAS_LIBS} ${ac_test_BLAS_LIBS}" +else +AC_MSG_RESULT([no]) +AC_MSG_ERROR([Cannot build Rblas shared library such that it makes external BLAS visible. +An alternative is to use internal BLAS instead and replace +libRblas.dylib with the external BLAS library after R is built.]) +fi +fi + rm -f conftest.c conftest.o conftestl.c libconftest.dylib + ;; + esac +fi +AC_SUBST(BLAS_LIBS0) + +if test "${use_blas_shlib}" = yes; then + ## set BLAS_LIBS to point at local version + BLAS_LIBS="-L\$(R_HOME)/lib\$(R_ARCH) -lRblas" +fi + +AM_CONDITIONAL(USE_VECLIB_G95FIX, [test "x${use_veclib_g95fix}" = xyes]) +AM_CONDITIONAL(USE_EXTERNAL_BLAS, [test "${acx_blas_ok}" = "yes"]) + +## LAPACK. +## The default has already been set on macOS: otherwise it is "no" +## and so this test fails. +if test "${use_lapack}" = "yes"; then + R_LAPACK_LIBS +fi +if test "${acx_lapack_ok}" != "yes"; then + LAPACK_LIBS="-L\$(R_HOME)/lib\$(R_ARCH) -lRlapack" +fi +AC_SUBST(LAPACK_LIBS) +AM_CONDITIONAL(USE_EXTERNAL_LAPACK, [test "${acx_lapack_ok}" = "yes"]) + +### * Checks for system services. + +## iconv headers and function. +R_ICONV + +## check sufficient support for MBCS +R_MBCS + +## support for ICU +if test "$use_ICU" = yes ; then + R_ICU + if test "$use_ICU" = no ; then + case "${host_os}" in + darwin*) + AC_CHECK_LIB(icucore, ucol_open, [], + [AC_MSG_ERROR([library 'icucore' is required for ICU])]) + AC_DEFINE(USE_ICU_APPLE, 1, [Define to use Apple's ICU.]) + AC_DEFINE(USE_ICU, 1, [Define to use ICU for collation.]) + use_ICU=yes + ;; + esac + fi +fi +AC_SUBST(USE_ICU) +AC_SUBST(USE_ICU_APPLE) + +## X11. +R_X11 +AM_CONDITIONAL(BUILD_X11, [test "x${use_X11}" = "xyes"]) +## check if X11 typedefs KeySym +R_TYPE_KEYSYM +## check if Xmu is supported +R_X11_Xmu + +if test "x${want_cairo}" = "xyes"; then +R_PANGO_CAIRO +fi +AM_CONDITIONAL(BUILD_DEVCAIRO, [test "x${r_cv_cairo_works}" = xyes]) + + +## Aqua +case "${host_os}" in + darwin*) + ## check for CoreFoundation framework (chances are much higher + ## that we can build AQUA if this one is present) + R_CHECK_FRAMEWORK(CFStringGetSystemEncoding, CoreFoundation) + ## FIXME: we should verify that we can use Obj-C exceptions + ## such as @try and friends. The OBJC compiler tests + ## above add -fobjc-exceptions where possible, but + ## they don't check that the exceptions are available. + R_AQUA + ## That sets HAVE_AQUA, which is used to enable support of R.app + ## and also in C headers and files related to quartz() + ;; + *) + use_aqua=no + ;; +esac +## Now used: +## - to compile src/unix/aqua.c +## - in etc/Renviron to set the personal library, +## - in grDevices to select building quartz() +AM_CONDITIONAL(BUILD_AQUA, [test "x${use_aqua}" = xyes]) + +## Tcl/Tk. +R_TCLTK + +## BSD networking. +R_BSD_NETWORKING + +## XDR headers and library routines. +R_XDR + +## zlib headers and libraries. +R_ZLIB + +## bzlib headers and libraries. +R_BZLIB + +## LZMA headers and libraries from xz-utils +R_LZMA + +## PCRE headers and libraries. +R_PCRE + +## tre headers and libraries. +R_TRE + +## libcurl +R_LIBCURL + + +## Bitmap headers and libraries. +if test -n "${PKGCONF}"; then +R_BITMAPS2 +else +R_BITMAPS +fi + +## POSIX times. +R_SYS_POSIX_LEAPSECONDS + +## stat times +gl_STAT_TIME + +## R profiling. +if test "${want_R_profiling}" = yes; then + AC_CHECK_FUNCS(setitimer, + [AC_DEFINE(R_PROFILING, 1, + [Define this to enable R-level profiling.])], + [want_R_profiling="no"]) +fi +AC_SUBST(R_PROFILING) + +## R profiling. +if test "${want_memory_profiling}" = yes; then + AC_DEFINE(R_MEMORY_PROFILING, 1, [Define this to enable memory profiling.]) +fi + +## Large-file-support +AC_SYS_LARGEFILE +AC_FUNC_FSEEKO + +## Valgrind instrumentation +if test ${valgrind_level} -eq 0; then + AC_DEFINE(NVALGRIND, 1, [Define to disable Valgrind instrumentation]) +elif test "${use_system_valgrind}" = yes; then + AC_CHECK_HEADERS([valgrind/memcheck.h]) +fi + +AC_DEFINE_UNQUOTED(VALGRIND_LEVEL, ${valgrind_level}, [Define as 1 or 2 to specify levels of Valgrind instrumentation]) + + +if test "x${use_internal_tzcode}" = xyes; then + AC_DEFINE(USE_INTERNAL_MKTIME, 1, [Define to use internal time-zone code]) +fi +AM_CONDITIONAL(BUILD_TZONE, [test "x${use_internal_tzcode}" = xyes]) + + +## KERN_USRSTACK support (BSD, Darwin, ...) +R_KERN_USRSTACK + +## check for visible __libc_stack_end on Linux +case "${host_os}" in + linux*) + AC_CACHE_CHECK([for visible __lib_stack_end], + [r_cv_libc_stack_end], + [AC_RUN_IFELSE([AC_LANG_SOURCE([[ +#include "confdefs.h" +#include <stdlib.h> +/* This might get optimized out if not used */ +extern void * __libc_stack_end; + +int main () { + if(!__libc_stack_end) exit(1); + exit(0); +} + ]])], [r_cv_libc_stack_end=yes], [r_cv_libc_stack_end=no], + [r_cv_libc_stack_end=no])]) + + if test "${r_cv_libc_stack_end}" = yes; then + AC_DEFINE(HAVE_LIBC_STACK_END, 1, [Define if __libc_stack_end is visible.]) + fi +esac + +### * Miscellaneous. + +## Printing. +## We look to see whether we have 'lpr' or 'lp'. Some platforms +## provide both (SunOS and HPUX), and in those cases we choose lpr. +if test -z "${R_PRINTCMD}"; then + AC_CHECK_PROGS(R_PRINTCMD, [lpr lp]) +fi +AC_DEFINE_UNQUOTED(R_PRINTCMD, "${R_PRINTCMD}", +[Define this to be printing command on your system.]) + +## Default paper size. +AC_PATH_PROG(PAPERCONF, paperconf, false) +: ${PAPERSIZE=a4} +papersize=`${PAPERCONF}` +test -z "${papersize}" && papersize="${PAPERSIZE}" +: ${R_PAPERSIZE="${papersize}"} +AC_SUBST(R_PAPERSIZE) + +## Saving. +AC_SUBST(R_BATCHSAVE) + +## Java support +## R_JAVA +custom_JAVA_HOME="${JAVA_HOME}" +: ${JAVA_LIBS=~autodetect~} +: ${JAVA_CPPFLAGS=~autodetect~} +: ${JAVA_LD_LIBRARY_PATH=~autodetect~} +custom_JAVA_LIBS="${JAVA_LIBS}" +custom_JAVA_CPPFLAGS="${JAVA_CPPFLAGS}" +custom_JAVA_LD_LIBRARY_PATH="${JAVA_LD_LIBRARY_PATH}" +AC_SUBST(custom_JAVA_HOME) +AC_SUBST(custom_JAVA_CPPFLAGS) +AC_SUBST(custom_JAVA_LIBS) +AC_SUBST(custom_JAVA_LD_LIBRARY_PATH) +JAVA_LD_LIBRARY_PATH= +AC_SUBST(JAVA) +AC_SUBST(JAVAC) +AC_SUBST(JAVAH) +AC_SUBST(JAR) +AC_SUBST(JAVA_LD_LIBRARY_PATH) +AC_SUBST(JAVA_LIBS0) +AC_SUBST(JAVA_CPPFLAGS0) +AC_SUBST(R_JAVA_LD_LIBRARY_PATH) + + +## F90/F95 support +AC_PROG_FC() +AC_LANG_PUSH(Fortran) +AC_FC_SRCEXT(f90, [dummy=1], [dummy=0]) +AC_FC_SRCEXT(f95, [dummy=1], [dummy=0]) +R_OPENMP +AC_LANG_POP() +if test -z "${SHLIB_FCLD}"; then + shlib_fcld_was_given=no + SHLIB_FCLD="\$(FC)" +fi +: ${SHLIB_FCLDFLAGS="${SHLIB_LDFLAGS}"} +AC_SUBST(SHLIB_FCLD) +AC_SUBST(SHLIB_FCLDFLAGS) +## x86 Solaris' f95 needs additional libs when building a DSO +FCLIBS=${FCLIBS} +AC_SUBST(FCLIBS) + +## OpenMP package stuff (needs to come *after* configuration of all +## compilers). +## We allow the users to override this for packages only (for now) +## FIXME: what if SHLIB_OPENMP_?FLAGS is set but empty? (could use -n "${VAR+set}") +if test "x${shlib_ld_was_given}" = xno -a \ + "${SHLIB_LD}" = "\$(CC)" -a \ + "x${ac_cv_prog_c_openmp}" != "xunsupported" -a \ + "x${ac_cv_prog_c_openmp}" != "x" -a \ + "x${shlib_cxxld_was_given}" = xno -a \ + "${SHLIB_CXXLD}" = "\$(CXX)" -a \ + "x${ac_cv_prog_cxx_openmp}" != "xunsupported" -a \ + "x${shlib_fcld_was_given}" = xno -a \ + "${SHLIB_FCLD}" = "\$(FC)" -a \ + "x${ac_cv_prog_fc_openmp}" != "xunsupported"; then + ## next macro is copied into Rconfig.h + AC_DEFINE(SUPPORT_OPENMP, 1, + [Define if you have C/C++/Fortran OpenMP support for package code.]) +fi +## This assumes that OpenMP support in the C compiler includes compilation by F77 +if test -z "${SHLIB_OPENMP_CFLAGS+set}" -a \ + "x${shlib_ld_was_given}" = xno -a \ + "${SHLIB_LD}" = "\$(CC)" -a \ + "x${ac_cv_prog_c_openmp}" != "xunsupported" -a \ + "x${ac_cv_prog_c_openmp}" != "x"; then + SHLIB_OPENMP_CFLAGS="${OPENMP_CFLAGS}" + if test -z "${SHLIB_OPENMP_FFLAGS+set}" -a \ + "x${ac_cv_prog_f77_openmp}" != "xunsupported"; then + SHLIB_OPENMP_FFLAGS="${OPENMP_FFLAGS}" + fi +fi +if test -z "${SHLIB_OPENMP_CXXFLAGS+set}" -a \ + "x${shlib_cxxld_was_given}" = xno -a \ + "${SHLIB_CXXLD}" = "\$(CXX)" -a \ + "x${ac_cv_prog_cxx_openmp}" != "xunsupported"; then + SHLIB_OPENMP_CXXFLAGS="${OPENMP_CXXFLAGS}" +fi +if test -z "${SHLIB_OPENMP_FCFLAGS+set}" -a \ + "x${shlib_fcld_was_given}" = xno -a \ + "${SHLIB_FCLD}" = "\$(FC)" -a \ + "x${ac_cv_prog_fc_openmp}" != "xunsupported"; then + SHLIB_OPENMP_FCFLAGS="${OPENMP_FCFLAGS}" +fi + +AC_SUBST(SHLIB_OPENMP_CFLAGS) +AC_SUBST(SHLIB_OPENMP_CXXFLAGS) +AC_SUBST(SHLIB_OPENMP_FCFLAGS) +AC_SUBST(SHLIB_OPENMP_FFLAGS) + + +## Look for FCPICFLAGS +## Debian in their wisdom have f95 as a link to gfortran, so +## use this to pick out gfortran (even though it is unreliable). +if test "${ac_cv_fc_compiler_gnu}" = yes; then + case "${host_cpu}" in + sparc*|ppc64*|powerpc64*|s390*) + fcpicflags="-fPIC" + ;; + *) + fcpicflags="-fpic" + ;; + esac +fi +case "${host_os}" in + darwin*) + ## macOS does not have a Fortran compiler, so this is speculative + fcpicflags="${darwin_pic}" + ;; + hpux*) + case "${FC}" in + f90) + fcpicflags="+Z" + ;; + esac + ;; + linux*) + case "${FC}" in + ## Intel compilers: probably get identified as GNU, but make sure. + *ifc|*ifort) + fcpicflags="-fpic" + ;; + ## Portland Group + *pgf95|*pgf90) + fcpicflags="-fpic" + ;; + esac + ;; + solaris*) + if test "${ac_cv_fc_compiler_gnu}" = yes; then + fcpicflags="-fPIC" + else + fcpicflags="-PIC" + fi + ;; +esac +: ${FCPICFLAGS="${fcpicflags}"} +if test -z "${FCPICFLAGS}"; then + case "${host_os}" in + aix*|mingw*) + ;; + *) + AC_MSG_WARN([I could not determine FCPICFLAGS.]) + ;; + esac +fi + + +## Make sure -L terms come first in LIBS. +LIBS1="" +LIBS2="" +for arg in ${LIBS}; do + case "${arg}" in + -L*) + R_SH_VAR_ADD(LIBS1, [${arg}]) + ;; + *) + R_SH_VAR_ADD(LIBS2, [${arg}]) + ;; + esac +done +LIBS="${LIBS1} ${LIBS2}" + +## R_LD_LIBRARY_PATH. + +## On Linux, do not add the ld.so system directories such as '/lib' and +## '/usr/lib', so that the entries from '/etc/ld.so.conf' are not +## shadowed (otherwise, e.g. optimized ATLAS libs would not be used). + +## On macOS (Darwin) this used to have /usr/X11R6/lib +## which shadows the OpenGL framework but we add nothing on macOS .... +case "${host_os}" in + linux*) + r_ld_library_defaults="/usr/lib64:/lib64:/usr/lib:/lib" + ;; + solaris*) + r_ld_library_defaults="/usr/lib:/lib" + ;; + *) + r_ld_library_defaults= + ;; +esac +if test -n "${R_LD_LIBRARY_PATH_save}"; then + R_LD_LIBRARY_PATH=${R_LD_LIBRARY_PATH_save} +else +## We already added -L's from LDFLAGS (except on Darwin): +## seem to be doing it again +for arg in ${LDFLAGS} ${FLIBS} ${BLAS_LIBS} ${LAPACK_LIBS} ${X_LIBS} \ + ${TCLTK_LIBS}; do + case "${arg}" in + -L*) + lib=`echo ${arg} | sed "s/^-L//"` + r_want_lib=true + ## don't add anything for Darwin + case "${host_os}" in darwin*) r_want_lib=false ;; esac + ## Do not add non-existent directories. + test -d "${lib}" || r_want_lib=false + if test x"${r_want_lib}" = xtrue; then + ## Canonicalize (/usr/lib/gcc-lib/i486-linux/3.3.4/../../..). + lib=`cd "${lib}" && ${GETWD}` + ## Do not add something twice, or default paths. + r_save_IFS="${IFS}"; IFS="${PATH_SEPARATOR}" + for dir in ${R_LD_LIBRARY_PATH}${IFS}${r_ld_library_defaults}; do + if test x"${dir}" = x"${lib}"; then + r_want_lib=false + break + fi + done + IFS="${r_save_IFS}" + if test x"${r_want_lib}" = xtrue; then + R_SH_VAR_ADD(R_LD_LIBRARY_PATH, [${lib}], [${PATH_SEPARATOR}]) + fi + fi + ;; + esac +done +fi + +AC_SUBST(R_LD_LIBRARY_PATH) + +## Recommended packages. +if test "${use_recommended_packages}" = yes; then + R_RECOMMENDED_PACKAGES +fi +AM_CONDITIONAL(USE_RECOMMENDED_PACKAGES, + [test "x${use_recommended_packages}" = xyes]) + +# i18n support. +AM_NLS +if test "${USE_NLS}" = "yes"; then + echo + echo "Configuring src/extra/intl directory" + AM_GNU_GETTEXT_VERSION(0.16.1) + AM_GNU_GETTEXT([no-libtool], [need-ngettext], [../extra/intl]) + if test -n "$INTL_MACOSX_LIBS"; then + XTRA_INTL_CPPFLAGS=-I/System/Library/Frameworks/CoreFoundation.framework/Headers + fi + echo "Finished configuring src/extra/intl directory" + echo +else + USE_INCLUDED_LIBINTL=no +fi +AC_SUBST(XTRA_INTL_CPPFLAGS) + +AM_CONDITIONAL(USE_NLS, [test "x${USE_NLS}" = xyes]) +AM_CONDITIONAL(BUILD_LIBINTL, [test "x${USE_INCLUDED_LIBINTL}" = xyes]) + +R_OPENMP_SIMDRED + +### shell for use in scripts: we allow R_SHELL to set the script, +### since some AIX systems have zsh as sh. +: ${R_SHELL=${SHELL}} +AC_SUBST(R_SHELL) +AC_MSG_RESULT([using as R_SHELL for scripts ... ${R_SHELL}]) + + +### * Win32 overrides +case "${host_os}" in + mingw*) + AC_DEFINE(HAVE_ICONV, 1, [Define if you have the iconv() function.]) + AC_DEFINE(HAVE_ICONVLIST, 1, [Define if you have the `iconvlist' function.]) + AC_DEFINE(HAVE_ICONV_H, 1, [Define to 1 if you have the <iconv.h> header file.]) + AC_DEFINE(HAVE_JPEG, 1,[Define if you have the JPEG headers and libraries.]) + AC_DEFINE(HAVE_PNG, 1, [Define if you have the PNG headers and libraries.]) + AC_DEFINE(HAVE_POSIX_SETJMP, 1, [Define if you have POSIX.1 compatible + sigsetjmp/siglongjmp.]) + AC_DEFINE(HAVE_TCLTK, 1, [Define if you have the Tcl/Tk headers and + libraries and want Tcl/Tk support to be built.] ) + AC_DEFINE(HAVE_TIFF, 1, [Define this if libtiff is available.]) + AC_DEFINE(HAVE_TIMES, 1, [Define to 1 if you have the `times' function.]) + want_R_profiling=yes + AC_DEFINE(R_PROFILING, 1, [Define this to enable R-level profiling.]) + ;; +esac + +### * Output. + +AC_CONFIG_HEADERS([src/include/config.h]) +AC_CONFIG_FILES( +[Makeconf + Makefile + doc/Makefile + doc/html/Makefile + doc/manual/Makefile + etc/Makefile + etc/Makeconf + etc/Renviron + etc/javaconf + etc/ldpaths + m4/Makefile + po/Makefile + share/Makefile + src/Makefile + src/appl/Makefile + src/extra/Makefile + src/extra/blas/Makefile + src/extra/intl/Makefile + src/extra/tre/Makefile + src/extra/tzone/Makefile + src/extra/xdr/Makefile + src/include/Makefile + src/include/Rmath.h0 + src/include/R_ext/Makefile + src/library/Recommended/Makefile + src/library/Makefile + src/library/base/DESCRIPTION + src/library/base/Makefile + src/library/compiler/DESCRIPTION + src/library/compiler/Makefile + src/library/datasets/DESCRIPTION + src/library/datasets/Makefile + src/library/graphics/DESCRIPTION + src/library/graphics/Makefile + src/library/graphics/src/Makefile + src/library/grDevices/DESCRIPTION + src/library/grDevices/Makefile + src/library/grDevices/src/Makefile + src/library/grDevices/src/cairo/Makefile + src/library/grid/DESCRIPTION + src/library/grid/Makefile + src/library/grid/src/Makefile + src/library/methods/DESCRIPTION + src/library/methods/Makefile + src/library/methods/src/Makefile + src/library/parallel/DESCRIPTION + src/library/parallel/Makefile + src/library/parallel/src/Makefile + src/library/profile/Makefile + src/library/stats/DESCRIPTION + src/library/stats/Makefile + src/library/stats/src/Makefile + src/library/stats4/DESCRIPTION + src/library/stats4/Makefile + src/library/splines/DESCRIPTION + src/library/splines/Makefile + src/library/splines/src/Makefile + src/library/tcltk/DESCRIPTION + src/library/tcltk/Makefile + src/library/tcltk/src/Makefile + src/library/tools/DESCRIPTION + src/library/tools/Makefile + src/library/tools/src/Makefile + src/library/translations/DESCRIPTION + src/library/translations/Makefile + src/library/utils/DESCRIPTION + src/library/utils/Makefile + src/library/utils/src/Makefile + src/main/Makefile + src/modules/Makefile + src/modules/X11/Makefile + src/modules/internet/Makefile + src/modules/lapack/Makefile + src/nmath/Makefile + src/nmath/standalone/Makefile + src/scripts/Makefile + src/scripts/R.sh + src/scripts/Rcmd + src/scripts/f77_f2c + src/scripts/javareconf + src/scripts/mkinstalldirs + src/scripts/pager + src/scripts/rtags + src/unix/Makefile + tests/Makefile + tests/Embedding/Makefile + tests/Examples/Makefile + tools/Makefile +]) + +AC_CONFIG_COMMANDS([stamp-h], +[test -f src/include/stamp-h || echo timestamp > src/include/stamp-h]) + +### now reset flags +CPPFLAGS=${CPPFLAGS_KEEP} +CFLAGS=${CFLAGS_KEEP} +FFLAGS=${FFLAGS_KEEP} +CXXFLAGS=${CXXFLAGS_KEEP} + +AC_OUTPUT + +## Summarize configure results. +## <NOTE> +## Doing this via AC_CONFIG_COMMANDS would require explicitly passing all +## configure variables to config.status. +## </NOTE> +r_c_compiler="${CC} ${R_XTRA_CFLAGS} ${CFLAGS}" +r_cxx_compiler="${CXX} ${CXXSTD} ${R_XTRA_CXXFLAGS} ${CXXFLAGS}" +r_cxx98_compiler="${CXX98} ${CXX98STD} ${CXX98FLAGS}" +r_cxx11_compiler="${CXX11} ${CXX11STD} ${CXX11FLAGS}" +r_cxx14_compiler="${CXX14} ${CXX14STD} ${CXX14FLAGS}" +r_cxx17_compiler="${CXX17} ${CXX17STD} ${CXX17FLAGS}" +r_f77_compiler="${F77} ${R_XTRA_FFLAGS} ${FFLAGS}" +r_f95_compiler="${FC} ${FCFLAGS}" +r_objc_compiler="${OBJC} ${OBJCFLAGS}" +r_interfaces= +## we will not have tested for X11 under some configure options, so +## need to test protect the test. +for item in X11 aqua tcltk; do + if eval "test x\${use_${item}} = xyes"; then + R_SH_VAR_ADD(r_interfaces, [${item}], [, ]) + fi +done +r_external_libs= +if test "${use_readline}" = yes; then + r_external_libs=readline +fi +if test "${acx_blas_ok}" = "yes"; then + ## Try to figure out which BLAS was used. + case "${BLAS_LIBS0}" in + *-latlas*) r_blas=ATLAS ;; + *-lgoto*) r_blas=Goto ;; + *-lopenblas*) r_blas=OpenBLAS ;; + *-lacml*) r_blas=ACML ;; + *-lmkl*) r_blas=MKL ;; + *-lsgemm*) r_blas=PhiPack ;; + *sunperf*) r_blas=SunPerf ;; + *-lessl*) r_blas=ESSL ;; + *Accelerate*) r_blas=Accelerate ;; + "") r_blas=none ;; + *) r_blas=generic ;; + esac + R_SH_VAR_ADD(r_external_libs, [BLAS(${r_blas})], [, ]) +fi +if test "${acx_lapack_ok}" = "yes"; then + ## Try to figure out which LAPACK was used. + case "${LAPACK_LIBS}" in + *sunperf*) r_lapack=SunPerf ;; + "") r_lapack="in blas" ;; + *) r_lapack=generic ;; + esac + R_SH_VAR_ADD(r_external_libs, [LAPACK(${r_lapack})], [, ]) +fi +if test "${have_tre}" = yes; then + R_SH_VAR_ADD(r_external_libs, [tre], [, ]) +fi +if test "x$ac_cv_header_curl_curl_h" = xyes; then + R_SH_VAR_ADD(r_external_libs, [curl], [, ]) +fi + +r_capabilities= +r_no_capabilities= +if test "${have_png}" = yes; then + R_SH_VAR_ADD(r_capabilities, [PNG], [, ]) +else + R_SH_VAR_ADD(r_no_capabilities, [PNG], [, ]) +fi +if test "${have_jpeg}" = yes; then + R_SH_VAR_ADD(r_capabilities, [JPEG], [, ]) +else + R_SH_VAR_ADD(r_no_capabilities, [JPEG], [, ]) +fi +if test "${have_tiff}" = yes; then + R_SH_VAR_ADD(r_capabilities, [TIFF], [, ]) +else + R_SH_VAR_ADD(r_no_capabilities, [TIFF], [, ]) +fi +if test "${USE_NLS}" = yes; then + R_SH_VAR_ADD(r_capabilities, [NLS], [, ]) +else + R_SH_VAR_ADD(r_no_capabilities, [NLS], [, ]) +fi +if test "${r_cv_cairo_works}" = yes; then + R_SH_VAR_ADD(r_capabilities, [cairo], [, ]) +else + R_SH_VAR_ADD(r_no_capabilities, [cairo], [, ]) +fi +if test "${use_ICU}" = yes; then + R_SH_VAR_ADD(r_capabilities, [ICU], [, ]) +else + R_SH_VAR_ADD(r_no_capabilities, [ICU], [, ]) +fi + +r_options= +r_no_options= +if test "${want_R_framework}" = yes; then + R_SH_VAR_ADD(r_options, [framework], [, ]) +elif test "${want_R_shlib}" = yes; then + R_SH_VAR_ADD(r_options, [shared R library], [, ]) +elif test "${want_R_static}" = yes; then + R_SH_VAR_ADD(r_options, [static R library], [, ]) +fi +if test "${use_blas_shlib}" = yes; then + R_SH_VAR_ADD(r_options, [shared BLAS], [, ]) +else + R_SH_VAR_ADD(r_no_options, [shared BLAS], [, ]) +fi +if test "${want_R_profiling}" = yes; then + R_SH_VAR_ADD(r_options, [R profiling], [, ]) +else + R_SH_VAR_ADD(r_no_options, [R profiling], [, ]) +fi +if test "${want_memory_profiling}" = yes; then + R_SH_VAR_ADD(r_options, [memory profiling], [, ]) +else + R_SH_VAR_ADD(r_no_options, [memory profiling], [, ]) +fi +if test "${use_maintainer_mode}" = yes; then + R_SH_VAR_ADD(r_options, [maintainer mode], [, ]) +fi +if test "${use_strict_barrier}" = yes; then + R_SH_VAR_ADD(r_options, [strict barrier], [, ]) +fi +if test "${want_prebuilt_html}" = yes; then + R_SH_VAR_ADD(r_options, [static HTML], [, ]) +fi + +AC_MSG_RESULT( +[ +R is now configured for ${host} + + Source directory: ${srcdir} + Installation directory: ${prefix} + + C compiler: ${r_c_compiler} + Fortran 77 compiler: ${r_f77_compiler} + + Default C++ compiler: ${r_cxx_compiler} + C++98 compiler: ${r_cxx98_compiler} + C++11 compiler: ${r_cxx11_compiler} + C++14 compiler: ${r_cxx14_compiler} + C++17 compiler: ${r_cxx17_compiler} + Fortran 90/95 compiler: ${r_f95_compiler} + Obj-C compiler: ${r_objc_compiler} + + Interfaces supported: ${r_interfaces} + External libraries: ${r_external_libs} + Additional capabilities: ${r_capabilities} + Options enabled: ${r_options} + + Capabilities skipped: ${r_no_capabilities} + Options not enabled: ${r_no_options} + + Recommended packages: ${use_recommended_packages} +]) +if test -n "${warn_f77_cc_double_complex}"; then + AC_MSG_WARN([${warn_f77_cc_double_complex}]) +fi +if test -n "${warn_xcompile_sizeof_long}"; then + AC_MSG_WARN([${warn_xcompile_sizeof_long}]) +fi +if test -n "${warn_type_socklen}"; then + AC_MSG_WARN([${warn_type_socklen}]) +fi +if test -n "${warn_cxxpicflags}"; then + AC_MSG_WARN([${warn_cxxpicflags}]) +fi +if test -n "${warn_shlib_cxxldflags}"; then + AC_MSG_WARN([${warn_shlib_cxxldflags}]) +fi +if test -n "${warn_cxxpicflags}"; then + AC_MSG_WARN([${warn_cxxpicflags}]) +fi +if test -n "${warn_fcpicflags}"; then + AC_MSG_WARN([${warn_fcpicflags}]) +fi +if test -n "${warn_tcltk_version}"; then + AC_MSG_WARN([${warn_tcltk_version}]) +fi +if test -n "${warn_pcre_version}"; then + AC_MSG_WARN([${warn_pcre_version}]) +fi +if test -n "${warn_info}"; then + AC_MSG_WARN([${warn_info}]) +fi +if test -n "${warn_pdf1}"; then + AC_MSG_WARN([${warn_pdf1}]) +fi +if test -n "${warn_pdf2}"; then + AC_MSG_WARN([${warn_pdf2}]) +fi +if test -n "${warn_pdf3}"; then + AC_MSG_WARN([${warn_pdf3}]) +fi +if test -n "${warn_pager}"; then + AC_MSG_WARN([${warn_pager}]) +fi +if test -n "${warn_browser}"; then + AC_MSG_WARN([${warn_browser}]) +fi +if test -n "${warn_pdfviewer}"; then + AC_MSG_WARN([${warn_pdfviewer}]) +fi + +### Local variables: *** +### mode: outline-minor *** +### outline-regexp: "### [*]+" *** +### End: *** diff --git a/com.oracle.truffle.r.native/gnur/patch/src/appl/dchdc.f b/com.oracle.truffle.r.native/gnur/patch/src/appl/dchdc.f new file mode 100644 index 0000000000000000000000000000000000000000..81b6786bde7f53ae804c641e6f7a66ce12734ef5 --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/appl/dchdc.f @@ -0,0 +1,234 @@ + subroutine dchdc(a,lda,p,work,jpvt,job,info) + integer lda,p,jpvt(p),job,info + double precision a(lda,p),work(*) +c +c dchdc computes the cholesky decomposition of a positive definite +c matrix. a pivoting option allows the user to estimate the +c condition of a positive definite matrix or determine the rank +c of a positive semidefinite matrix. +c +c on entry +c +c a double precision(lda,p). +c a contains the matrix whose decomposition is to +c be computed. onlt the upper half of a need be stored. +c the lower part of the array a is not referenced. +c +c lda integer. +c lda is the leading dimension of the array a. +c +c p integer. +c p is the order of the matrix. +c +c work double precision. +c work is a work array. +c +c jpvt integer(p). +c jpvt contains integers that control the selection +c of the pivot elements, if pivoting has been requested. +c each diagonal element a(k,k) +c is placed in one of three classes according to the +c value of jpvt(k). +c +c if jpvt(k) .gt. 0, then x(k) is an initial +c element. +c +c if jpvt(k) .eq. 0, then x(k) is a free element. +c +c if jpvt(k) .lt. 0, then x(k) is a final element. +c +c before the decomposition is computed, initial elements +c are moved by symmetric row and column interchanges to +c the beginning of the array a and final +c elements to the end. both initial and final elements +c are frozen in place during the computation and only +c free elements are moved. at the k-th stage of the +c reduction, if a(k,k) is occupied by a free element +c it is interchanged with the largest free element +c a(l,l) with l .ge. k. jpvt is not referenced if +c job .eq. 0. +c +c job integer. +c job is an integer that initiates column pivoting. +c if job .eq. 0, no pivoting is done. +c if job .ne. 0, pivoting is done. +c +c on return +c +c a a contains in its upper half the cholesky factor +c of the matrix a as it has been permuted by pivoting. +c +c jpvt jpvt(j) contains the index of the diagonal element +c of a that was moved into the j-th position, +c provided pivoting was requested. +c +c info contains the index of the last positive diagonal +c element of the cholesky factor. +c +c for positive definite matrices info = p is the normal return. +c for pivoting with positive semidefinite matrices info will +c in general be less than p. however, info may be greater than +c the rank of a, since rounding error can cause an otherwise zero +c element to be positive. indefinite systems will always cause +c info to be less than p. +c +c linpack. this version dated 08/14/78 . +c j.j. dongarra and g.w. stewart, argonne national laboratory and +c university of maryland. +c +c +c blas daxpy,dswap +c fortran dsqrt +c +c internal variables +c + integer pu,pl,plp1,j,jp,jt,k,kb,km1,kp1,l,maxl + double precision temp + double precision maxdia + logical swapk,negk +c + pl = 1 + pu = 0 + info = p + if (job .eq. 0) go to 160 +c +c pivoting has been requested. rearrange the +c the elements according to jpvt. +c + do 70 k = 1, p + swapk = jpvt(k) .gt. 0 + negk = jpvt(k) .lt. 0 + jpvt(k) = k + if (negk) jpvt(k) = -jpvt(k) + if (.not.swapk) go to 60 + if (k .eq. pl) go to 50 + call dswap(pl-1,a(1,k),1,a(1,pl),1) + temp = a(k,k) + a(k,k) = a(pl,pl) + a(pl,pl) = temp + plp1 = pl + 1 + if (p .lt. plp1) go to 40 + do 30 j = plp1, p + if (j .ge. k) go to 10 + temp = a(pl,j) + a(pl,j) = a(j,k) + a(j,k) = temp + go to 20 + 10 continue + if (j .eq. k) go to 20 + temp = a(k,j) + a(k,j) = a(pl,j) + a(pl,j) = temp + 20 continue + 30 continue + 40 continue + jpvt(k) = jpvt(pl) + jpvt(pl) = k + 50 continue + pl = pl + 1 + 60 continue + 70 continue + pu = p + if (p .lt. pl) go to 150 + do 140 kb = pl, p + k = p - kb + pl + if (jpvt(k) .ge. 0) go to 130 + jpvt(k) = -jpvt(k) + if (pu .eq. k) go to 120 + call dswap(k-1,a(1,k),1,a(1,pu),1) + temp = a(k,k) + a(k,k) = a(pu,pu) + a(pu,pu) = temp + kp1 = k + 1 + if (p .lt. kp1) go to 110 + do 100 j = kp1, p + if (j .ge. pu) go to 80 + temp = a(k,j) + a(k,j) = a(j,pu) + a(j,pu) = temp + go to 90 + 80 continue + if (j .eq. pu) go to 90 + temp = a(k,j) + a(k,j) = a(pu,j) + a(pu,j) = temp + 90 continue + 100 continue + 110 continue + jt = jpvt(k) + jpvt(k) = jpvt(pu) + jpvt(pu) = jt + 120 continue + pu = pu - 1 + 130 continue + 140 continue + 150 continue + 160 continue + do 270 k = 1, p +c +c reduction loop. +c + maxdia = a(k,k) + kp1 = k + 1 + maxl = k +c +c determine the pivot element. +c + if (k .lt. pl .or. k .ge. pu) go to 190 + do 180 l = kp1, pu + if (a(l,l) .le. maxdia) go to 170 + maxdia = a(l,l) + maxl = l + 170 continue + 180 continue + 190 continue +c +c quit if the pivot element is not positive. +c + if (maxdia .gt. 0.0d0) go to 200 + info = k - 1 +c ......exit + go to 280 + 200 continue + if (k .eq. maxl) go to 210 +c +c start the pivoting and update jpvt. +c + km1 = k - 1 + call dswap(km1,a(1,k),1,a(1,maxl),1) + a(maxl,maxl) = a(k,k) + a(k,k) = maxdia + jp = jpvt(maxl) + jpvt(maxl) = jpvt(k) + jpvt(k) = jp + 210 continue +c +c reduction step. pivoting is contained across the rows. +c + work(k) = dsqrt(a(k,k)) + a(k,k) = work(k) + if (p .lt. kp1) go to 260 + do 250 j = kp1, p + if (k .eq. maxl) go to 240 + if (j .ge. maxl) go to 220 + temp = a(k,j) + a(k,j) = a(j,maxl) + a(j,maxl) = temp + go to 230 + 220 continue + if (j .eq. maxl) go to 230 + temp = a(k,j) + a(k,j) = a(maxl,j) + a(maxl,j) = temp + 230 continue + 240 continue + a(k,j) = a(k,j)/work(k) + work(j) = a(k,j) + temp = -a(k,j) + call daxpy(j-k,temp,work(kp1),1,a(kp1,j),1) + 250 continue + 260 continue + 270 continue + 280 continue + return + end diff --git a/com.oracle.truffle.r.native/gnur/patch/src/appl/dpbfa.f b/com.oracle.truffle.r.native/gnur/patch/src/appl/dpbfa.f new file mode 100644 index 0000000000000000000000000000000000000000..3c22a86094bd3ddb31493f63f09115d0106124fd --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/appl/dpbfa.f @@ -0,0 +1,100 @@ + subroutine dpbfa(abd,lda,n,m,info) + + integer lda,n,m,info + double precision abd(lda,n) +c +c dpbfa factors a double precision symmetric positive definite +c matrix stored in band form. +c +c dpbfa is usually called by dpbco, but it can be called +c directly with a saving in time if rcond is not needed. +c +c on entry +c +c abd double precision(lda, n) +c the matrix to be factored. the columns of the upper +c triangle are stored in the columns of abd and the +c diagonals of the upper triangle are stored in the +c rows of abd . see the comments below for details. +c +c lda integer +c the leading dimension of the array abd . +c lda must be .ge. m + 1 . +c +c n integer +c the order of the matrix a . +c +c m integer +c the number of diagonals above the main diagonal. +c 0 .le. m .lt. n . +c +c on return +c +c abd an upper triangular matrix r , stored in band +c form, so that a = trans(r)*r . +c +c info integer +c = 0 for normal return. +c = k if the leading minor of order k is not +c positive definite. +c +c band storage +c +c if a is a symmetric positive definite band matrix, +c the following program segment will set up the input. +c +c m = (band width above diagonal) +c do 20 j = 1, n +c i1 = max0(1, j-m) +c do 10 i = i1, j +c k = i-j+m+1 +c abd(k,j) = a(i,j) +c 10 continue +c 20 continue +c +c linpack. this version dated 08/14/78 . +c cleve moler, university of new mexico, argonne national lab. +c +c subroutines and functions +c +c blas ddot +c fortran max0,sqrt +c +c internal variables +c + double precision ddot,t + double precision s + integer ik,j,jk,k,mu +c begin block with ...exits to 40 +c +c + do 30 j = 1, n + info = j + s = 0.0d0 + ik = m + 1 + jk = max0(j-m,1) + mu = max0(m+2-j,1) + if (m .lt. mu) go to 20 + do 10 k = mu, m + + t = abd(k,j) - ddot(k-mu,abd(ik,jk),1,abd(mu,j),1) + t = t/abd(m+1,jk) + abd(k,j) = t + s = s + t*t + ik = ik - 1 + jk = jk + 1 + 10 continue + 20 continue + + s = abd(m+1,j) - s +c ......exit + if (s .le. 0.0d0) go to 40 + + abd(m+1,j) = sqrt(s) + + 30 continue + info = 0 + 40 continue + return + end + diff --git a/com.oracle.truffle.r.native/gnur/patch/src/appl/dpbsl.f b/com.oracle.truffle.r.native/gnur/patch/src/appl/dpbsl.f new file mode 100644 index 0000000000000000000000000000000000000000..d910deef88ecd031b13d86af743201e31b49be0d --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/appl/dpbsl.f @@ -0,0 +1,83 @@ + subroutine dpbsl(abd,lda,n,m,b) + + integer lda,n,m + double precision abd(lda,n),b(n) +c +c dpbsl solves the double precision symmetric positive definite +c band system a*x = b +c using the factors computed by dpbco or dpbfa. +c +c on entry +c +c abd double precision(lda, n) +c the output from dpbco or dpbfa. +c +c lda integer +c the leading dimension of the array abd . +c +c n integer +c the order of the matrix a . +c +c m integer +c the number of diagonals above the main diagonal. +c +c b double precision(n) +c the right hand side vector. +c +c on return +c +c b the solution vector x . +c +c error condition +c +c a division by zero will occur if the input factor contains +c a zero on the diagonal. technically this indicates +c singularity but it is usually caused by improper subroutine +c arguments. it will not occur if the subroutines are called +c correctly and info .eq. 0 . +c +c to compute inverse(a) * c where c is a matrix +c with p columns +c call dpbco(abd,lda,n,rcond,z,info) +c if (rcond is too small .or. info .ne. 0) go to ... +c do 10 j = 1, p +c call dpbsl(abd,lda,n,c(1,j)) +c 10 continue +c +c linpack. this version dated 08/14/78 . +c cleve moler, university of new mexico, argonne national lab. +c +c subroutines and functions +c +c blas daxpy,ddot +c fortran min0 +c +c internal variables +c + double precision ddot,t + integer k,kb,la,lb,lm +c +c solve trans(r)*y = b +c + do 10 k = 1, n + lm = min0(k-1,m) + la = m + 1 - lm + lb = k - lm + t = ddot(lm,abd(la,k),1,b(lb),1) + b(k) = (b(k) - t)/abd(m+1,k) + 10 continue +c +c solve r*x = y +c + do 20 kb = 1, n + k = n + 1 - kb + lm = min0(k-1,m) + la = m + 1 - lm + lb = k - lm + b(k) = b(k)/abd(m+1,k) + t = -b(k) + call daxpy(lm,t,abd(la,k),1,b(lb),1) + 20 continue + return + end + diff --git a/com.oracle.truffle.r.native/gnur/patch/src/appl/dpoco.f b/com.oracle.truffle.r.native/gnur/patch/src/appl/dpoco.f new file mode 100644 index 0000000000000000000000000000000000000000..83a7f1bd9b5f259f6e04549adec7d692a8011200 --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/appl/dpoco.f @@ -0,0 +1,195 @@ +c +c dpoco factors a double precision symmetric positive definite +c matrix and estimates the condition of the matrix. +c +c if rcond is not needed, dpofa is slightly faster. +c to solve a*x = b , follow dpoco by dposl. +c to compute inverse(a)*c , follow dpoco by dposl. +c to compute determinant(a) , follow dpoco by dpodi. +c to compute inverse(a) , follow dpoco by dpodi. +c +c on entry +c +c a double precision(lda, n) +c the symmetric matrix to be factored. only the +c diagonal and upper triangle are used. +c +c lda integer +c the leading dimension of the array a . +c +c n integer +c the order of the matrix a . +c +c on return +c +c a an upper triangular matrix r so that a = trans(r)*r +c where trans(r) is the transpose. +c the strict lower triangle is unaltered. +c if info .ne. 0 , the factorization is not complete. +c +c rcond double precision +c an estimate of the reciprocal condition of a . +c for the system a*x = b , relative perturbations +c in a and b of size epsilon may cause +c relative perturbations in x of size epsilon/rcond . +c if rcond is so small that the logical expression +c 1.0 + rcond .eq. 1.0 +c is true, then a may be singular to working +c precision. in particular, rcond is zero if +c exact singularity is detected or the estimate +c underflows. if info .ne. 0 , rcond is unchanged. +c +c z double precision(n) +c a work vector whose contents are usually unimportant. +c if a is close to a singular matrix, then z is +c an approximate null vector in the sense that +c norm(a*z) = rcond*norm(a)*norm(z) . +c if info .ne. 0 , z is unchanged. +c +c info integer +c = 0 for normal return. +c = k signals an error condition. the leading minor +c of order k is not positive definite. +c +c linpack. this version dated 08/14/78 . +c cleve moler, university of new mexico, argonne national lab. +c +c subroutines and functions +c +c linpack dpofa +c blas daxpy,ddot,dscal,dasum +c fortran dabs,dmax1,dreal,dsign +c + subroutine dpoco(a,lda,n,rcond,z,info) + integer lda,n,info + double precision a(lda,*),z(*) + double precision rcond +c +c internal variables +c + double precision ddot,ek,t,wk,wkm + double precision anorm,s,dasum,sm,ynorm + integer i,j,jm1,k,kb,kp1 +c +c +c find norm of a using only upper half +c + do 30 j = 1, n + z(j) = dasum(j,a(1,j),1) + jm1 = j - 1 + if (jm1 .lt. 1) go to 20 + do 10 i = 1, jm1 + z(i) = z(i) + dabs(a(i,j)) + 10 continue + 20 continue + 30 continue + anorm = 0.0d0 + do 40 j = 1, n + anorm = dmax1(anorm,z(j)) + 40 continue +c +c factor +c + call dpofa(a,lda,n,info) + if (info .ne. 0) go to 180 +c +c rcond = 1/(norm(a)*(estimate of norm(inverse(a)))) . +c estimate = norm(z)/norm(y) where a*z = y and a*y = e . +c the components of e are chosen to cause maximum local +c growth in the elements of w where trans(r)*w = e . +c the vectors are frequently rescaled to avoid overflow. +c +c solve trans(r)*w = e +c + ek = 1.0d0 + do 50 j = 1, n + z(j) = 0.0d0 + 50 continue + do 110 k = 1, n + if (z(k) .ne. 0.0d0) ek = dsign(ek,-z(k)) + if (dabs(ek-z(k)) .le. a(k,k)) go to 60 + s = a(k,k)/dabs(ek-z(k)) + call dscal(n,s,z,1) + ek = s*ek + 60 continue + wk = ek - z(k) + wkm = -ek - z(k) + s = dabs(wk) + sm = dabs(wkm) + wk = wk/a(k,k) + wkm = wkm/a(k,k) + kp1 = k + 1 + if (kp1 .gt. n) go to 100 + do 70 j = kp1, n + sm = sm + dabs(z(j)+wkm*a(k,j)) + z(j) = z(j) + wk*a(k,j) + s = s + dabs(z(j)) + 70 continue + if (s .ge. sm) go to 90 + t = wkm - wk + wk = wkm + do 80 j = kp1, n + z(j) = z(j) + t*a(k,j) + 80 continue + 90 continue + 100 continue + z(k) = wk + 110 continue + s = 1.0d0/dasum(n,z,1) + call dscal(n,s,z,1) +c +c solve r*y = w +c + do 130 kb = 1, n + k = n + 1 - kb + if (dabs(z(k)) .le. a(k,k)) go to 120 + s = a(k,k)/dabs(z(k)) + call dscal(n,s,z,1) + 120 continue + z(k) = z(k)/a(k,k) + t = -z(k) + call daxpy(k-1,t,a(1,k),1,z(1),1) + 130 continue + s = 1.0d0/dasum(n,z,1) + call dscal(n,s,z,1) +c + ynorm = 1.0d0 +c +c solve trans(r)*v = y +c + do 150 k = 1, n + z(k) = z(k) - ddot(k-1,a(1,k),1,z(1),1) + if (dabs(z(k)) .le. a(k,k)) go to 140 + s = a(k,k)/dabs(z(k)) + call dscal(n,s,z,1) + ynorm = s*ynorm + 140 continue + z(k) = z(k)/a(k,k) + 150 continue + s = 1.0d0/dasum(n,z,1) + call dscal(n,s,z,1) + ynorm = s*ynorm +c +c solve r*z = v +c + do 170 kb = 1, n + k = n + 1 - kb + if (dabs(z(k)) .le. a(k,k)) go to 160 + s = a(k,k)/dabs(z(k)) + call dscal(n,s,z,1) + ynorm = s*ynorm + 160 continue + z(k) = z(k)/a(k,k) + t = -z(k) + call daxpy(k-1,t,a(1,k),1,z(1),1) + 170 continue +c make znorm = 1.0 + s = 1.0d0/dasum(n,z,1) + call dscal(n,s,z,1) + ynorm = s*ynorm +c + if (anorm .ne. 0.0d0) rcond = ynorm/anorm + if (anorm .eq. 0.0d0) rcond = 0.0d0 + 180 continue + return + end diff --git a/com.oracle.truffle.r.native/gnur/patch/src/appl/dpodi.f b/com.oracle.truffle.r.native/gnur/patch/src/appl/dpodi.f new file mode 100644 index 0000000000000000000000000000000000000000..4d52c5998fbefb4cf81542a8966d757e80d7650c --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/appl/dpodi.f @@ -0,0 +1,122 @@ +c +c dpodi computes the determinant and inverse of a certain +c double precision symmetric positive definite matrix (see below) +c using the factors computed by dpoco, dpofa or dqrdc. +c +c on entry +c +c a double precision(lda, n) +c the output a from dpoco or dpofa +c or the output x from dqrdc. +c +c lda integer +c the leading dimension of the array a . +c +c n integer +c the order of the matrix a . +c +c job integer +c = 11 both determinant and inverse. +c = 01 inverse only. +c = 10 determinant only. +c +c on return +c +c a if dpoco or dpofa was used to factor a then +c dpodi produces the upper half of inverse(a) . +c if dqrdc was used to decompose x then +c dpodi produces the upper half of inverse(trans(x)*x) +c where trans(x) is the transpose. +c elements of a below the diagonal are unchanged. +c if the units digit of job is zero, a is unchanged. +c +c det double precision(2) +c determinant of a or of trans(x)*x if requested. +c otherwise not referenced. +c determinant = det(1) * 10.0**det(2) +c with 1.0 .le. det(1) .lt. 10.0 +c or det(1) .eq. 0.0 . +c +c error condition +c +c a division by zero will occur if the input factor contains +c a zero on the diagonal and the inverse is requested. +c it will not occur if the subroutines are called correctly +c and if dpoco or dpofa has set info .eq. 0 . +c +c linpack. this version dated 08/14/78 . +c cleve moler, university of new mexico, argonne national lab. +c +c subroutines and functions +c +c blas daxpy,dscal +c fortran mod +c + subroutine dpodi(a,lda,n,det,job) + integer lda,n,job + double precision a(lda,*) + double precision det(2) +c +c internal variables +c + double precision t + double precision s + integer i,j,jm1,k,kp1 +c +c compute determinant +c + if (job/10 .eq. 0) go to 70 + det(1) = 1.0d0 + det(2) = 0.0d0 + s = 10.0d0 + do 50 i = 1, n + det(1) = a(i,i)**2*det(1) +c ...exit + if (det(1) .eq. 0.0d0) go to 60 + 10 if (det(1) .ge. 1.0d0) go to 20 + det(1) = s*det(1) + det(2) = det(2) - 1.0d0 + go to 10 + 20 continue + 30 if (det(1) .lt. s) go to 40 + det(1) = det(1)/s + det(2) = det(2) + 1.0d0 + go to 30 + 40 continue + 50 continue + 60 continue + 70 continue +c +c compute inverse(r) +c + if (mod(job,10) .eq. 0) go to 140 + do 100 k = 1, n + a(k,k) = 1.0d0/a(k,k) + t = -a(k,k) + call dscal(k-1,t,a(1,k),1) + kp1 = k + 1 + if (n .lt. kp1) go to 90 + do 80 j = kp1, n + t = a(k,j) + a(k,j) = 0.0d0 + call daxpy(k,t,a(1,k),1,a(1,j),1) + 80 continue + 90 continue + 100 continue +c +c form inverse(r) * trans(inverse(r)) +c + do 130 j = 1, n + jm1 = j - 1 + if (jm1 .lt. 1) go to 120 + do 110 k = 1, jm1 + t = a(k,j) + call daxpy(k,t,a(1,j),1,a(1,k),1) + 110 continue + 120 continue + t = a(j,j) + call dscal(j,t,a(1,j),1) + 130 continue + 140 continue + return + end diff --git a/com.oracle.truffle.r.native/gnur/patch/src/appl/dpofa.f b/com.oracle.truffle.r.native/gnur/patch/src/appl/dpofa.f new file mode 100644 index 0000000000000000000000000000000000000000..94d71d20ede3f1788dd2bd6bf8ab9c11a23f6fef --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/appl/dpofa.f @@ -0,0 +1,78 @@ +C Modified 2002-05-20 for R to add a tolerance of positive definiteness. +C +c +c dpofa factors a double precision symmetric positive definite +c matrix. +c +c dpofa is usually called by dpoco, but it can be called +c directly with a saving in time if rcond is not needed. +c (time for dpoco) = (1 + 18/n)*(time for dpofa) . +c +c on entry +c +c a double precision(lda, n) +c the symmetric matrix to be factored. only the +c diagonal and upper triangle are used. +c +c lda integer +c the leading dimension of the array a . +c +c n integer +c the order of the matrix a . +c +c on return +c +c a an upper triangular matrix r so that a = trans(r)*r +c where trans(r) is the transpose. +c the strict lower triangle is unaltered. +c if info .ne. 0 , the factorization is not complete. +c +c info integer +c = 0 for normal return. +c = k signals an error condition. the leading minor +c of order k is not positive definite. +c +c linpack. this version dated 08/14/78 . +c cleve moler, university of new mexico, argonne national lab. +c +c subroutines and functions +c +c blas ddot +c fortran dsqrt +c + subroutine dpofa(a,lda,n,info) + integer lda,n,info + double precision a(lda,*) +c +c internal variables +c + double precision ddot,t,eps + double precision s + integer j,jm1,k + data eps/1.d-14/ + +c begin block with ...exits to 40 +c +c + do 30 j = 1, n + info = j + s = 0.0d0 + jm1 = j - 1 + if (jm1 .lt. 1) go to 20 + do 10 k = 1, jm1 + t = a(k,j) - ddot(k-1,a(1,k),1,a(1,j),1) + t = t/a(k,k) + a(k,j) = t + s = s + t*t + 10 continue + 20 continue + s = a(j,j) - s +c ......exit +c if (s .le. 0.0d0) go to 40 + if (s .le. eps * abs(a(j,j))) go to 40 + a(j,j) = dsqrt(s) + 30 continue + info = 0 + 40 continue + return + end diff --git a/com.oracle.truffle.r.native/gnur/patch/src/appl/dposl.f b/com.oracle.truffle.r.native/gnur/patch/src/appl/dposl.f new file mode 100644 index 0000000000000000000000000000000000000000..41c0e69502fc3cd94e3301364059ce3c1bdae1ac --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/appl/dposl.f @@ -0,0 +1,72 @@ +c +c dposl solves the double precision symmetric positive definite +c system a * x = b +c using the factors computed by dpoco or dpofa. +c +c on entry +c +c a double precision(lda, n) +c the output from dpoco or dpofa. +c +c lda integer +c the leading dimension of the array a . +c +c n integer +c the order of the matrix a . +c +c b double precision(n) +c the right hand side vector. +c +c on return +c +c b the solution vector x . +c +c error condition +c +c a division by zero will occur if the input factor contains +c a zero on the diagonal. technically this indicates +c singularity but it is usually caused by improper subroutine +c arguments. it will not occur if the subroutines are called +c correctly and info .eq. 0 . +c +c to compute inverse(a) * c where c is a matrix +c with p columns +c call dpoco(a,lda,n,rcond,z,info) +c if (rcond is too small .or. info .ne. 0) go to ... +c do 10 j = 1, p +c call dposl(a,lda,n,c(1,j)) +c 10 continue +c +c linpack. this version dated 08/14/78 . +c cleve moler, university of new mexico, argonne national lab. +c +c subroutines and functions +c +c blas daxpy,ddot +c + subroutine dposl(a,lda,n,b) + integer lda,n + double precision a(lda,*),b(*) +c +c internal variables +c + double precision ddot,t + integer k,kb +c +c solve trans(r)*y = b +c + do 10 k = 1, n + t = ddot(k-1,a(1,k),1,b(1),1) + b(k) = (b(k) - t)/a(k,k) + 10 continue +c +c solve r*x = y +c + do 20 kb = 1, n + k = n + 1 - kb + b(k) = b(k)/a(k,k) + t = -b(k) + call daxpy(k-1,t,a(1,k),1,b(1),1) + 20 continue + return + end diff --git a/com.oracle.truffle.r.native/gnur/patch/src/appl/dqrdc.f b/com.oracle.truffle.r.native/gnur/patch/src/appl/dqrdc.f new file mode 100644 index 0000000000000000000000000000000000000000..54c9320cbea64ada95353a5231b39b158e168794 --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/appl/dqrdc.f @@ -0,0 +1,208 @@ +c +c dqrdc uses householder transformations to compute the qr +c factorization of an n by p matrix x. column pivoting +c based on the 2-norms of the reduced columns may be +c performed at the users option. +c +c on entry +c +c x double precision(ldx,p), where ldx .ge. n. +c x contains the matrix whose decomposition is to be +c computed. +c +c ldx integer. +c ldx is the leading dimension of the array x. +c +c n integer. +c n is the number of rows of the matrix x. +c +c p integer. +c p is the number of columns of the matrix x. +c +c jpvt integer(p). +c jpvt contains integers that control the selection +c of the pivot columns. the k-th column x(k) of x +c is placed in one of three classes according to the +c value of jpvt(k). +c +c if jpvt(k) .gt. 0, then x(k) is an initial +c column. +c +c if jpvt(k) .eq. 0, then x(k) is a free column. +c +c if jpvt(k) .lt. 0, then x(k) is a final column. +c +c before the decomposition is computed, initial columns +c are moved to the beginning of the array x and final +c columns to the end. both initial and final columns +c are frozen in place during the computation and only +c free columns are moved. at the k-th stage of the +c reduction, if x(k) is occupied by a free column +c it is interchanged with the free column of largest +c reduced norm. jpvt is not referenced if +c job .eq. 0. +c +c work double precision(p). +c work is a work array. work is not referenced if +c job .eq. 0. +c +c job integer. +c job is an integer that initiates column pivoting. +c if job .eq. 0, no pivoting is done. +c if job .ne. 0, pivoting is done. +c +c on return +c +c x x contains in its upper triangle the upper +c triangular matrix r of the qr factorization. +c below its diagonal x contains information from +c which the orthogonal part of the decomposition +c can be recovered. note that if pivoting has +c been requested, the decomposition is not that +c of the original matrix x but that of x +c with its columns permuted as described by jpvt. +c +c qraux double precision(p). +c qraux contains further information required to recover +c the orthogonal part of the decomposition. +c +c jpvt jpvt(k) contains the index of the column of the +c original matrix that has been interchanged into +c the k-th column, if pivoting was requested. +c +c linpack. this version dated 08/14/78 . +c g.w. stewart, university of maryland, argonne national lab. +c +c dqrdc uses the following functions and subprograms. +c +c blas daxpy,ddot,dscal,dswap,dnrm2 +c fortran dabs,dmax1,min0,dsqrt +c + subroutine dqrdc(x,ldx,n,p,qraux,jpvt,work,job) + integer ldx,n,p,job + integer jpvt(*) + double precision x(ldx,*),qraux(*),work(*) +c +c internal variables +c + integer j,jp,jj, l,lp1,lup,maxj,pl,pu + double precision maxnrm,dnrm2,tt + double precision ddot,nrmxl,t + logical negj,swapj +c +c + pl = 1 + pu = 0 + if (job .eq. 0) go to 60 +c +c pivoting has been requested. rearrange the columns +c according to jpvt. +c + do 20 j = 1, p + swapj = jpvt(j) .gt. 0 + negj = jpvt(j) .lt. 0 + jpvt(j) = j + if (negj) jpvt(j) = -j + if (.not.swapj) go to 10 + if (j .ne. pl) call dswap(n,x(1,pl),1,x(1,j),1) + jpvt(j) = jpvt(pl) + jpvt(pl) = j + pl = pl + 1 + 10 continue + 20 continue + pu = p + do 50 jj = 1, p + j = p - jj + 1 + if (jpvt(j) .ge. 0) go to 40 + jpvt(j) = -jpvt(j) + if (j .eq. pu) go to 30 + call dswap(n,x(1,pu),1,x(1,j),1) + jp = jpvt(pu) + jpvt(pu) = jpvt(j) + jpvt(j) = jp + 30 continue + pu = pu - 1 + 40 continue + 50 continue + 60 continue +c +c compute the norms of the free columns. +c + if (pu .lt. pl) go to 80 + do 70 j = pl, pu + qraux(j) = dnrm2(n,x(1,j),1) + work(j) = qraux(j) + 70 continue + 80 continue +c +c perform the householder reduction of x. +c + lup = min0(n,p) + do 200 l = 1, lup + if (l .lt. pl .or. l .ge. pu) go to 120 +c +c locate the column of largest norm and bring it +c into the pivot position. +c + maxnrm = 0.0d0 + maxj = l + do 100 j = l, pu + if (qraux(j) .le. maxnrm) go to 90 + maxnrm = qraux(j) + maxj = j + 90 continue + 100 continue + if (maxj .eq. l) go to 110 + call dswap(n,x(1,l),1,x(1,maxj),1) + qraux(maxj) = qraux(l) + work(maxj) = work(l) + jp = jpvt(maxj) + jpvt(maxj) = jpvt(l) + jpvt(l) = jp + 110 continue + 120 continue + qraux(l) = 0.0d0 + if (l .eq. n) go to 190 +c +c compute the householder transformation for column l. +c + nrmxl = dnrm2(n-l+1,x(l,l),1) + if (nrmxl .eq. 0.0d0) go to 180 + if (x(l,l) .ne. 0.0d0) nrmxl = dsign(nrmxl,x(l,l)) + call dscal(n-l+1,1.0d0/nrmxl,x(l,l),1) + x(l,l) = 1.0d0 + x(l,l) +c +c apply the transformation to the remaining columns, +c updating the norms. +c + lp1 = l + 1 + if (p .lt. lp1) go to 170 + do 160 j = lp1, p + t = -ddot(n-l+1,x(l,l),1,x(l,j),1)/x(l,l) + call daxpy(n-l+1,t,x(l,l),1,x(l,j),1) + if (j .lt. pl .or. j .gt. pu) go to 150 + if (qraux(j) .eq. 0.0d0) go to 150 + tt = 1.0d0 - (dabs(x(l,j))/qraux(j))**2 + tt = dmax1(tt,0.0d0) + t = tt + tt = 1.0d0 + 0.05d0*tt*(qraux(j)/work(j))**2 + if (tt .eq. 1.0d0) go to 130 + qraux(j) = qraux(j)*dsqrt(t) + go to 140 + 130 continue + qraux(j) = dnrm2(n-l,x(l+1,j),1) + work(j) = qraux(j) + 140 continue + 150 continue + 160 continue + 170 continue +c +c save the transformation. +c + qraux(l) = x(l,l) + x(l,l) = -nrmxl + 180 continue + 190 continue + 200 continue + return + end diff --git a/com.oracle.truffle.r.native/gnur/patch/src/appl/dqrdc2.f b/com.oracle.truffle.r.native/gnur/patch/src/appl/dqrdc2.f new file mode 100644 index 0000000000000000000000000000000000000000..e184dc95a0b222aa818fbbafd815f9f68cd92ecd --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/appl/dqrdc2.f @@ -0,0 +1,197 @@ +C Dqrdc2 is a *modification* of Linpack's dqrdc ('DQRDC') for R +c +c dqrdc2 uses householder transformations to compute the qr +c factorization of an n by p matrix x. a limited column +c pivoting strategy based on the 2-norms of the reduced columns +c moves columns with near-zero norm to the right-hand edge of +c the x matrix. this strategy means that sequential one +c degree-of-freedom effects can be computed in a natural way. +c +c i am very nervous about modifying linpack code in this way. +c if you are a computational linear algebra guru and you really +c understand how to solve this problem please feel free to +c suggest improvements to this code. +c +c Another change was to compute the rank. +c +c on entry +c +c x double precision(ldx,p), where ldx .ge. n. +c x contains the matrix whose decomposition is to be +c computed. +c +c ldx integer. +c ldx is the leading dimension of the array x. +c +c n integer. +c n is the number of rows of the matrix x. +c +c p integer. +c p is the number of columns of the matrix x. +c +c tol double precision +c tol is the nonnegative tolerance used to +c determine the subset of the columns of x +c included in the solution. +c +c jpvt integer(p). +c integers which are swapped in the same way as the +c the columns of x during pivoting. on entry these +c should be set equal to the column indices of the +c columns of the x matrix (typically 1 to p). +c +c work double precision(p,2). +c work is a work array. +c +c on return +c +c x x contains in its upper triangle the upper +c triangular matrix r of the qr factorization. +c below its diagonal x contains information from +c which the orthogonal part of the decomposition +c can be recovered. note that if pivoting has +c been requested, the decomposition is not that +c of the original matrix x but that of x +c with its columns permuted as described by jpvt. +c +c k integer. +c k contains the number of columns of x judged +c to be linearly independent, i.e., "the rank" +c +c qraux double precision(p). +c qraux contains further information required to recover +c the orthogonal part of the decomposition. +c +c jpvt jpvt(j) contains the index of the column of the +c original matrix that has been interchanged into +c the j-th column. Consequently, jpvt[] codes a +c permutation of 1:p; it is called 'pivot' in R + +c +c original (dqrdc.f) linpack version dated 08/14/78 . +c g.w. stewart, university of maryland, argonne national lab. +c +C This version dated 22 August 1995 +C Ross Ihaka +c +c bug fixes 29 September 1999 BDR (p > n case, inaccurate ranks) +c +c +c dqrdc2 uses the following functions and subprograms. +c +c blas daxpy,ddot,dscal,dnrm2 +c fortran dabs,dmax1,min0,dsqrt +c + subroutine dqrdc2(x,ldx,n,p,tol,k,qraux,jpvt,work) + integer ldx,n,p + integer jpvt(*) + double precision x(ldx,*),qraux(*),work(p,2),tol +c +c internal variables +c + integer i,j,l,lp1,lup,k + double precision dnrm2,tt,ttt + double precision ddot,nrmxl,t +c +c +c compute the norms of the columns of x. +c + do 70 j = 1, p + qraux(j) = dnrm2(n,x(1,j),1) + work(j,1) = qraux(j) + work(j,2) = qraux(j) + if(work(j,2) .eq. 0.0d0) work(j,2) = 1.0d0 + 70 continue +c +c perform the householder reduction of x. +c + lup = min0(n,p) + k = p + 1 + do 200 l = 1, lup +c +c previous version only cycled l to lup +c +c cycle the columns from l to p left-to-right until one +c with non-negligible norm is located. a column is considered +c to have become negligible if its norm has fallen below +c tol times its original norm. the check for l .le. k +c avoids infinite cycling. +c + 80 continue + if (l .ge. k .or. qraux(l) .ge. work(l,2)*tol) go to 120 + lp1 = l+1 + do 100 i=1,n + t = x(i,l) + do 90 j=lp1,p + x(i,j-1) = x(i,j) + 90 continue + x(i,p) = t + 100 continue + i = jpvt(l) + t = qraux(l) + tt = work(l,1) + ttt = work(l,2) + do 110 j=lp1,p + jpvt(j-1) = jpvt(j) + qraux(j-1) = qraux(j) + work(j-1,1) = work(j,1) + work(j-1,2) = work(j,2) + 110 continue + jpvt(p) = i + qraux(p) = t + work(p,1) = tt + work(p,2) = ttt + k = k - 1 + go to 80 + 120 continue + if (l .eq. n) go to 190 +c +c compute the householder transformation for column l. +c + nrmxl = dnrm2(n-l+1,x(l,l),1) + if (nrmxl .eq. 0.0d0) go to 180 + if (x(l,l) .ne. 0.0d0) nrmxl = dsign(nrmxl,x(l,l)) + call dscal(n-l+1,1.0d0/nrmxl,x(l,l),1) + x(l,l) = 1.0d0 + x(l,l) +c +c apply the transformation to the remaining columns, +c updating the norms. +c + lp1 = l + 1 + if (p .lt. lp1) go to 170 + do 160 j = lp1, p + t = -ddot(n-l+1,x(l,l),1,x(l,j),1)/x(l,l) + call daxpy(n-l+1,t,x(l,l),1,x(l,j),1) + if (qraux(j) .eq. 0.0d0) go to 150 + tt = 1.0d0 - (dabs(x(l,j))/qraux(j))**2 + tt = dmax1(tt,0.0d0) + t = tt +c +c modified 9/99 by BDR. Re-compute norms if there is large reduction +c The tolerance here is on the squared norm +c In this version we need accurate norms, so re-compute often. +c work(j,1) is only updated in one case: looks like a bug -- no longer used +c +c tt = 1.0d0 + 0.05d0*tt*(qraux(j)/work(j,1))**2 +c if (tt .eq. 1.0d0) go to 130 + if (dabs(t) .lt. 1d-6) go to 130 + qraux(j) = qraux(j)*dsqrt(t) + go to 140 + 130 continue + qraux(j) = dnrm2(n-l,x(l+1,j),1) + work(j,1) = qraux(j) + 140 continue + 150 continue + 160 continue + 170 continue +c +c save the transformation. +c + qraux(l) = x(l,l) + x(l,l) = -nrmxl + 180 continue + 190 continue + 200 continue + k = min0(k - 1, n) + return + end diff --git a/com.oracle.truffle.r.native/gnur/patch/src/appl/dqrls.f b/com.oracle.truffle.r.native/gnur/patch/src/appl/dqrls.f new file mode 100644 index 0000000000000000000000000000000000000000..8e94f584d5a56432d83653b7e62c721bd1d3b9ae --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/appl/dqrls.f @@ -0,0 +1,119 @@ +c +c dqrfit is a subroutine to compute least squares solutions +c to the system +c +c (1) x * b = y +c +c which may be either under-determined or over-determined. +c the user must supply a tolerance to limit the columns of +c x used in computing the solution. in effect, a set of +c columns with a condition number approximately bounded by +c 1/tol is used, the other components of b being set to zero. +c +c on entry +c +c x double precision(n,p). +c x contains n-by-p coefficient matrix of +c the system (1), x is destroyed by dqrfit. +c +c n the number of rows of the matrix x. +c +c p the number of columns of the matrix x. +c +c y double precision(n,ny) +c y contains the right hand side(s) of the system (1). +c +c ny the number of right hand sides of the system (1). +c +c tol double precision +c tol is the nonnegative tolerance used to +c determine the subset of columns of x included +c in the solution. columns are pivoted out of +c decomposition if +c +c jpvt integer(p) +c the values in jpvt are permuted in the same +c way as the columns of x. this can be useful +c in unscrambling coefficients etc. +c +c work double precision(2*p) +c work is an array used by dqrdc2 and dqrsl. +c +c on return +c +c x contains the output array from dqrdc2. +c namely the qr decomposition of x stored in +c compact form. +c +c b double precision(p,ny) +c b contains the solution vectors with rows permuted +c in the same way as the columns of x. components +c corresponding to columns not used are set to zero. +c +c rsd double precision(n,ny) +c rsd contains the residual vectors y-x*b. +c +c qty double precision(n,ny) t +c qty contains the vectors q y. note that +c the initial p elements of this vector are +c permuted in the same way as the columns of x. +c +c k integer +c k contains the number of columns used in the +c solution. +c +c jpvt has its contents permuted as described above. +c +c qraux double precision(p) +c qraux contains auxiliary information on the +c qr decomposition of x. +c +c +c on return the arrays x, jpvt and qraux contain the +c usual output from dqrdc, so that the qr decomposition +c of x with pivoting is fully available to the user. +c in particular, columns jpvt(1), jpvt(2),...,jpvt(k) +c were used in the solution, and the condition number +c associated with those columns is estimated by +c abs(x(1,1)/x(k,k)). +c +c dqrfit uses the linpack routines dqrdc and dqrsl. +c + subroutine dqrls(x,n,p,y,ny,tol,b,rsd,qty,k,jpvt,qraux,work) + integer n,p,ny,k,jpvt(p) + double precision x(n,p),y(n,ny),tol,b(p,ny),rsd(n,ny), + . qty(n,ny),qraux(p),work(p) +c +c internal variables. +c + integer info,j,jj,kk +c +c reduce x. +c + call dqrdc2(x,n,n,p,tol,k,qraux,jpvt,work) +c +c solve the truncated least squares problem for each rhs. +c + if(k .gt. 0) then + do 20 jj=1,ny + call dqrsl(x,n,n,k,qraux,y(1,jj),rsd(1,jj),qty(1,jj), + 1 b(1,jj),rsd(1,jj),rsd(1,jj),1110,info) + 20 continue + else + do 35 i=1,n + do 30 jj=1,ny + rsd(i,jj) = y(i,jj) + 30 continue + 35 continue + endif +c +c set the unused components of b to zero. +c + kk = k + 1 + do 50 j=kk,p + do 40 jj=1,ny + b(j,jj) = 0.d0 + 40 continue + 50 continue + return + end diff --git a/com.oracle.truffle.r.native/gnur/patch/src/appl/dqrsl.f b/com.oracle.truffle.r.native/gnur/patch/src/appl/dqrsl.f new file mode 100644 index 0000000000000000000000000000000000000000..aab138a5feb558905e7f4c597afdb2c1b14002a8 --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/appl/dqrsl.f @@ -0,0 +1,275 @@ +c +c dqrsl applies the output of dqrdc to compute coordinate +c transformations, projections, and least squares solutions. +c for k .le. min(n,p), let xk be the matrix +c +c xk = (x(jpvt(1)),x(jpvt(2)), ... ,x(jpvt(k))) +c +c formed from columnns jpvt(1), ... ,jpvt(k) of the original +c n x p matrix x that was input to dqrdc (if no pivoting was +c done, xk consists of the first k columns of x in their +c original order). dqrdc produces a factored orthogonal matrix q +c and an upper triangular matrix r such that +c +c xk = q * (r) +c (0) +c +c this information is contained in coded form in the arrays +c x and qraux. +c +c on entry +c +c x double precision(ldx,p). +c x contains the output of dqrdc. +c +c ldx integer. +c ldx is the leading dimension of the array x. +c +c n integer. +c n is the number of rows of the matrix xk. it must +c have the same value as n in dqrdc. +c +c k integer. +c k is the number of columns of the matrix xk. k +c must nnot be greater than min(n,p), where p is the +c same as in the calling sequence to dqrdc. +c +c qraux double precision(p). +c qraux contains the auxiliary output from dqrdc. +c +c y double precision(n) +c y contains an n-vector that is to be manipulated +c by dqrsl. +c +c job integer. +c job specifies what is to be computed. job has +c the decimal expansion abcde, with the following +c meaning. +c +c if a.ne.0, compute qy. +c if b,c,d, or e .ne. 0, compute qty. +c if c.ne.0, compute b. +c if d.ne.0, compute rsd. +c if e.ne.0, compute xb. +c +c note that a request to compute b, rsd, or xb +c automatically triggers the computation of qty, for +c which an array must be provided in the calling +c sequence. +c +c on return +c +c qy double precision(n). +c qy conntains q*y, if its computation has been +c requested. +c +c qty double precision(n). +c qty contains trans(q)*y, if its computation has +c been requested. here trans(q) is the +c transpose of the matrix q. +c +c b double precision(k) +c b contains the solution of the least squares problem +c +c minimize norm2(y - xk*b), +c +c if its computation has been requested. (note that +c if pivoting was requested in dqrdc, the j-th +c component of b will be associated with column jpvt(j) +c of the original matrix x that was input into dqrdc.) +c +c rsd double precision(n). +c rsd contains the least squares residual y - xk*b, +c if its computation has been requested. rsd is +c also the orthogonal projection of y onto the +c orthogonal complement of the column space of xk. +c +c xb double precision(n). +c xb contains the least squares approximation xk*b, +c if its computation has been requested. xb is also +c the orthogonal projection of y onto the column space +c of x. +c +c info integer. +c info is zero unless the computation of b has +c been requested and r is exactly singular. in +c this case, info is the index of the first zero +c diagonal element of r and b is left unaltered. +c +c the parameters qy, qty, b, rsd, and xb are not referenced +c if their computation is not requested and in this case +c can be replaced by dummy variables in the calling program. +c to save storage, the user may in some cases use the same +c array for different parameters in the calling sequence. a +c frequently occuring example is when one wishes to compute +c any of b, rsd, or xb and does not need y or qty. in this +c case one may identify y, qty, and one of b, rsd, or xb, while +c providing separate arrays for anything else that is to be +c computed. thus the calling sequence +c +c call dqrsl(x,ldx,n,k,qraux,y,dum,y,b,y,dum,110,info) +c +c will result in the computation of b and rsd, with rsd +c overwriting y. more generally, each item in the following +c list contains groups of permissible identifications for +c a single callinng sequence. +c +c 1. (y,qty,b) (rsd) (xb) (qy) +c +c 2. (y,qty,rsd) (b) (xb) (qy) +c +c 3. (y,qty,xb) (b) (rsd) (qy) +c +c 4. (y,qy) (qty,b) (rsd) (xb) +c +c 5. (y,qy) (qty,rsd) (b) (xb) +c +c 6. (y,qy) (qty,xb) (b) (rsd) +c +c in any group the value returned in the array allocated to +c the group corresponds to the last member of the group. +c +c linpack. this version dated 08/14/78 . +c g.w. stewart, university of maryland, argonne national lab. +c +c dqrsl uses the following functions and subprograms. +c +c BLAS daxpy,dcopy,ddot +c Fortran dabs,min0,mod +c + subroutine dqrsl(x,ldx,n,k,qraux,y,qy,qty,b,rsd,xb,job,info) + integer ldx,n,k,job,info + double precision x(ldx,*),qraux(*),y(*),qy(*),qty(*),b(*),rsd(*), + * xb(*) +c +c internal variables +c + integer i,j,jj,ju,kp1 + double precision ddot,t,temp + logical cb,cqy,cqty,cr,cxb +c +c +c set info flag. +c + info = 0 +c +c determine what is to be computed. +c + cqy = job/10000 .ne. 0 + cqty = mod(job,10000) .ne. 0 + cb = mod(job,1000)/100 .ne. 0 + cr = mod(job,100)/10 .ne. 0 + cxb = mod(job,10) .ne. 0 + ju = min0(k,n-1) +c +c special action when n=1. +c + if (ju .ne. 0) go to 40 + if (cqy) qy(1) = y(1) + if (cqty) qty(1) = y(1) + if (cxb) xb(1) = y(1) + if (.not.cb) go to 30 + if (x(1,1) .ne. 0.0d0) go to 10 + info = 1 + go to 20 + 10 continue + b(1) = y(1)/x(1,1) + 20 continue + 30 continue + if (cr) rsd(1) = 0.0d0 + go to 250 + 40 continue +c +c set up to compute qy or qty. +c + if (cqy) call dcopy(n,y,1,qy,1) + if (cqty) call dcopy(n,y,1,qty,1) + if (.not.cqy) go to 70 +c +c compute qy. +c + do 60 jj = 1, ju + j = ju - jj + 1 + if (qraux(j) .eq. 0.0d0) go to 50 + temp = x(j,j) + x(j,j) = qraux(j) + t = -ddot(n-j+1,x(j,j),1,qy(j),1)/x(j,j) + call daxpy(n-j+1,t,x(j,j),1,qy(j),1) + x(j,j) = temp + 50 continue + 60 continue + 70 continue + if (.not.cqty) go to 100 +c +c compute trans(q)*y. +c + do 90 j = 1, ju + if (qraux(j) .eq. 0.0d0) go to 80 + temp = x(j,j) + x(j,j) = qraux(j) + t = -ddot(n-j+1,x(j,j),1,qty(j),1)/x(j,j) + call daxpy(n-j+1,t,x(j,j),1,qty(j),1) + x(j,j) = temp + 80 continue + 90 continue + 100 continue +c +c set up to compute b, rsd, or xb. +c + if (cb) call dcopy(k,qty,1,b,1) + kp1 = k + 1 + if (cxb) call dcopy(k,qty,1,xb,1) + if (cr .and. k .lt. n) call dcopy(n-k,qty(kp1),1,rsd(kp1),1) + if (.not.cxb .or. kp1 .gt. n) go to 120 + do 110 i = kp1, n + xb(i) = 0.0d0 + 110 continue + 120 continue + if (.not.cr) go to 140 + do 130 i = 1, k + rsd(i) = 0.0d0 + 130 continue + 140 continue + if (.not.cb) go to 190 +c +c compute b. +c + do 170 jj = 1, k + j = k - jj + 1 + if (x(j,j) .ne. 0.0d0) go to 150 + info = j +c ......exit + go to 180 + 150 continue + b(j) = b(j)/x(j,j) + if (j .eq. 1) go to 160 + t = -b(j) + call daxpy(j-1,t,x(1,j),1,b,1) + 160 continue + 170 continue + 180 continue + 190 continue + if (.not.cr .and. .not.cxb) go to 240 +c +c compute rsd or xb as required. +c + do 230 jj = 1, ju + j = ju - jj + 1 + if (qraux(j) .eq. 0.0d0) go to 220 + temp = x(j,j) + x(j,j) = qraux(j) + if (.not.cr) go to 200 + t = -ddot(n-j+1,x(j,j),1,rsd(j),1)/x(j,j) + call daxpy(n-j+1,t,x(j,j),1,rsd(j),1) + 200 continue + if (.not.cxb) go to 210 + t = -ddot(n-j+1,x(j,j),1,xb(j),1)/x(j,j) + call daxpy(n-j+1,t,x(j,j),1,xb(j),1) + 210 continue + x(j,j) = temp + 220 continue + 230 continue + 240 continue + 250 continue + return + end diff --git a/com.oracle.truffle.r.native/gnur/patch/src/appl/dqrutl.f b/com.oracle.truffle.r.native/gnur/patch/src/appl/dqrutl.f new file mode 100644 index 0000000000000000000000000000000000000000..2d208ca0d8cb33e6215801c7637bc9465f167181 --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/appl/dqrutl.f @@ -0,0 +1,66 @@ +c dqr Utilities: Interface to the different "switches" of dqrsl(). +c + subroutine dqrqty(x, n, k, qraux, y, ny, qty) + + integer n, k, ny + double precision x(n,k), qraux(k), y(n,ny), qty(n,ny) + integer info, j + double precision dummy(1) + do 10 j = 1,ny + call dqrsl(x, n, n, k, qraux, y(1,j), dummy, qty(1,j), + & dummy, dummy, dummy, 1000, info) + 10 continue + return + end +c + subroutine dqrqy(x, n, k, qraux, y, ny, qy) + + integer n, k, ny + double precision x(n,k), qraux(k), y(n,ny), qy(n,ny) + integer info, j + double precision dummy(1) + do 10 j = 1,ny + call dqrsl(x, n, n, k, qraux, y(1,j), qy(1,j), + & dummy, dummy, dummy, dummy, 10000, info) + 10 continue + return + end +c + subroutine dqrcf(x, n, k, qraux, y, ny, b, info) + + integer n, k, ny, info + double precision x(n,k), qraux(k), y(n,ny), b(k,ny) + integer j + double precision dummy(1) + do 10 j = 1,ny + call dqrsl(x, n, n, k, qraux, y(1,j), dummy, + & y(1,j), b(1,j), dummy, dummy, 100, info) + 10 continue + return + end +c + subroutine dqrrsd(x, n, k, qraux, y, ny, rsd) + + integer n, k, ny + double precision x(n,k), qraux(k), y(n,ny), rsd(n,ny) + integer info, j + double precision dummy(1) + do 10 j = 1,ny + call dqrsl(x, n, n, k, qraux, y(1,j), dummy, + & y(1,j), dummy, rsd(1,j), dummy, 10, info) + 10 continue + return + end +c + subroutine dqrxb(x, n, k, qraux, y, ny, xb) + + integer n, k, ny + double precision x(n,k), qraux(k), y(n,ny), xb(n,ny) + integer info, j + double precision dummy(1) + do 10 j = 1,ny + call dqrsl(x, n, n, k, qraux, y(1,j), dummy, + & y(1,j), dummy, dummy, xb(1,j), 1, info) + 10 continue + return + end diff --git a/com.oracle.truffle.r.native/gnur/patch/src/appl/dsvdc.f b/com.oracle.truffle.r.native/gnur/patch/src/appl/dsvdc.f new file mode 100644 index 0000000000000000000000000000000000000000..bdfd97d77a42a9a378a9e2b06ab802e325ee9505 --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/appl/dsvdc.f @@ -0,0 +1,495 @@ +c -- called from R's svd(x, ..., LINPACK = TRUE) , i.e, *NOT* by default -- +c +c dsvdc is a subroutine to reduce a double precision nxp matrix x +c by orthogonal transformations u and v to diagonal form. the +c diagonal elements s(i) are the singular values of x. the +c columns of u are the corresponding left singular vectors, +c and the columns of v the right singular vectors. +c +c on entry +c +c x double precision(ldx,p), where ldx.ge.n. +c x contains the matrix whose singular value +c decomposition is to be computed. x is +c destroyed by dsvdc. +c +c ldx integer. +c ldx is the leading dimension of the array x. +c +c n integer. +c n is the number of rows of the matrix x. +c +c p integer. +c p is the number of columns of the matrix x. +c +c ldu integer. +c ldu is the leading dimension of the array u. +c (see below). +c +c ldv integer. +c ldv is the leading dimension of the array v. +c (see below). +c +c work double precision(n). +c work is a scratch array. +c +c job integer. +c job controls the computation of the singular +c vectors. it has the decimal expansion ab +c with the following meaning +c +c a.eq.0 do not compute the left singular +c vectors. +c a.eq.1 return the n left singular vectors +c in u. +c a.ge.2 return the first min(n,p) singular +c vectors in u. +c b.eq.0 do not compute the right singular +c vectors. +c b.eq.1 return the right singular vectors +c in v. +c +c on return +c +c s double precision(mm), where mm=min(n+1,p). +c the first min(n,p) entries of s contain the +c singular values of x arranged in descending +c order of magnitude. +c +c e double precision(p), +c e ordinarily contains zeros. however see the +c discussion of info for exceptions. +c +c u double precision(ldu,k), where ldu.ge.n. if +c joba.eq.1 then k.eq.n, if joba.ge.2 +c then k.eq.min(n,p). +c u contains the matrix of left singular vectors. +c u is not referenced if joba.eq.0. if n.le.p +c or if joba.eq.2, then u may be identified with x +c in the subroutine call. +c +c v double precision(ldv,p), where ldv.ge.p. +c v contains the matrix of right singular vectors. +c v is not referenced if job.eq.0. if p.le.n, +c then v may be identified with x in the +c subroutine call. +c +c info integer. +c the singular values (and their corresponding +c singular vectors) s(info+1),s(info+2),...,s(m) +c are correct (here m=min(n,p)). thus if +c info.eq.0, all the singular values and their +c vectors are correct. in any event, the matrix +c b = trans(u)*x*v is the bidiagonal matrix +c with the elements of s on its diagonal and the +c elements of e on its super-diagonal (trans(u) +c is the transpose of u). thus the singular +c values of x and b are the same. +c +c linpack. this version dated 08/14/78 . +c correction made to shift 2/84. +c g.w. stewart, university of maryland, argonne national lab. +c +c Modified 2000-12-28 to use a relative convergence test, +c as this was infinite-looping on ix86. +c +c dsvdc uses the following functions and subprograms. +c +c external drot +c blas daxpy,ddot,dscal,dswap,dnrm2,drotg +c fortran dabs,dmax1,max0,min0,mod,dsqrt +c + subroutine dsvdc(x,ldx,n,p,s,e,u,ldu,v,ldv,work,job,info) + integer ldx,n,p,ldu,ldv,job,info + double precision x(ldx,*),s(*),e(*),u(ldu,*),v(ldv,*),work(*) +c +c internal variables +c + integer i,iter,j,jobu,k,kase,kk,l,ll,lls,lm1,lp1,ls,lu,m,maxit, + * mm,mm1,mp1,nct,nctp1,ncu,nrt,nrtp1 + double precision ddot,t + double precision b,c,cs,el,emm1,f,g,dnrm2,scale,shift,sl,sm,sn, + * smm1,t1,test,ztest,acc + logical wantu,wantv +c +c unnecessary initializations of l and ls to keep g77 -Wall happy +c + l = 0 + ls = 0 +c +c +c set the maximum number of iterations. +c + maxit = 30 +c +c determine what is to be computed. +c + wantu = .false. + wantv = .false. + jobu = mod(job,100)/10 + ncu = n + if (jobu .gt. 1) ncu = min0(n,p) + if (jobu .ne. 0) wantu = .true. + if (mod(job,10) .ne. 0) wantv = .true. +c +c reduce x to bidiagonal form, storing the diagonal elements +c in s and the super-diagonal elements in e. +c + info = 0 + nct = min0(n-1,p) + nrt = max0(0,min0(p-2,n)) + lu = max0(nct,nrt) + if (lu .lt. 1) go to 170 + do 160 l = 1, lu + lp1 = l + 1 + if (l .gt. nct) go to 20 +c +c compute the transformation for the l-th column and +c place the l-th diagonal in s(l). +c + s(l) = dnrm2(n-l+1,x(l,l),1) + if (s(l) .eq. 0.0d0) go to 10 + if (x(l,l) .ne. 0.0d0) s(l) = dsign(s(l),x(l,l)) + call dscal(n-l+1,1.0d0/s(l),x(l,l),1) + x(l,l) = 1.0d0 + x(l,l) + 10 continue + s(l) = -s(l) + 20 continue + if (p .lt. lp1) go to 50 + do 40 j = lp1, p + if (l .gt. nct) go to 30 + if (s(l) .eq. 0.0d0) go to 30 +c +c apply the transformation. +c + t = -ddot(n-l+1,x(l,l),1,x(l,j),1)/x(l,l) + call daxpy(n-l+1,t,x(l,l),1,x(l,j),1) + 30 continue +c +c place the l-th row of x into e for the +c subsequent calculation of the row transformation. +c + e(j) = x(l,j) + 40 continue + 50 continue + if (.not.wantu .or. l .gt. nct) go to 70 +c +c place the transformation in u for subsequent back +c multiplication. +c + do 60 i = l, n + u(i,l) = x(i,l) + 60 continue + 70 continue + if (l .gt. nrt) go to 150 +c +c compute the l-th row transformation and place the +c l-th super-diagonal in e(l). +c + e(l) = dnrm2(p-l,e(lp1),1) + if (e(l) .eq. 0.0d0) go to 80 + if (e(lp1) .ne. 0.0d0) e(l) = dsign(e(l),e(lp1)) + call dscal(p-l,1.0d0/e(l),e(lp1),1) + e(lp1) = 1.0d0 + e(lp1) + 80 continue + e(l) = -e(l) + if (lp1 .gt. n .or. e(l) .eq. 0.0d0) go to 120 +c +c apply the transformation. +c + do 90 i = lp1, n + work(i) = 0.0d0 + 90 continue + do 100 j = lp1, p + call daxpy(n-l,e(j),x(lp1,j),1,work(lp1),1) + 100 continue + do 110 j = lp1, p + call daxpy(n-l,-e(j)/e(lp1),work(lp1),1,x(lp1,j),1) + 110 continue + 120 continue + if (.not.wantv) go to 140 +c +c place the transformation in v for subsequent +c back multiplication. +c + do 130 i = lp1, p + v(i,l) = e(i) + 130 continue + 140 continue + 150 continue + 160 continue + 170 continue +c +c set up the final bidiagonal matrix or order m. +c + m = min0(p,n+1) + nctp1 = nct + 1 + nrtp1 = nrt + 1 + if (nct .lt. p) s(nctp1) = x(nctp1,nctp1) + if (n .lt. m) s(m) = 0.0d0 + if (nrtp1 .lt. m) e(nrtp1) = x(nrtp1,m) + e(m) = 0.0d0 +c +c if required, generate u. +c + if (.not.wantu) go to 300 + if (ncu .lt. nctp1) go to 200 + do 190 j = nctp1, ncu + do 180 i = 1, n + u(i,j) = 0.0d0 + 180 continue + u(j,j) = 1.0d0 + 190 continue + 200 continue + if (nct .lt. 1) go to 290 + do 280 ll = 1, nct + l = nct - ll + 1 + if (s(l) .eq. 0.0d0) go to 250 + lp1 = l + 1 + if (ncu .lt. lp1) go to 220 + do 210 j = lp1, ncu + t = -ddot(n-l+1,u(l,l),1,u(l,j),1)/u(l,l) + call daxpy(n-l+1,t,u(l,l),1,u(l,j),1) + 210 continue + 220 continue + call dscal(n-l+1,-1.0d0,u(l,l),1) + u(l,l) = 1.0d0 + u(l,l) + lm1 = l - 1 + if (lm1 .lt. 1) go to 240 + do 230 i = 1, lm1 + u(i,l) = 0.0d0 + 230 continue + 240 continue + go to 270 + 250 continue + do 260 i = 1, n + u(i,l) = 0.0d0 + 260 continue + u(l,l) = 1.0d0 + 270 continue + 280 continue + 290 continue + 300 continue +c +c if it is required, generate v. +c + if (.not.wantv) go to 350 + do 340 ll = 1, p + l = p - ll + 1 + lp1 = l + 1 + if (l .gt. nrt) go to 320 + if (e(l) .eq. 0.0d0) go to 320 + do 310 j = lp1, p + t = -ddot(p-l,v(lp1,l),1,v(lp1,j),1)/v(lp1,l) + call daxpy(p-l,t,v(lp1,l),1,v(lp1,j),1) + 310 continue + 320 continue + do 330 i = 1, p + v(i,l) = 0.0d0 + 330 continue + v(l,l) = 1.0d0 + 340 continue + 350 continue +c +c main iteration loop for the singular values. +c + mm = m + iter = 0 + 360 continue +c +c quit if all the singular values have been found. +c +c ...exit + if (m .eq. 0) go to 620 +c +c if too many iterations have been performed, set +c flag and return. +c + if (iter .lt. maxit) go to 370 + info = m +c ......exit + go to 620 + 370 continue +c +c this section of the program inspects for +c negligible elements in the s and e arrays. on +c completion the variables kase and l are set as follows. +c +c kase = 1 if s(m) and e(l-1) are negligible and l.lt.m +c kase = 2 if s(l) is negligible and l.lt.m +c kase = 3 if e(l-1) is negligible, l.lt.m, and +c s(l), ..., s(m) are not negligible (qr step). +c kase = 4 if e(m-1) is negligible (convergence). +c + do 390 ll = 1, m + l = m - ll +c ...exit + if (l .eq. 0) go to 400 + test = dabs(s(l)) + dabs(s(l+1)) + ztest = test + dabs(e(l)) + acc = dabs(test - ztest)/(1.0d-100 + test) + if (acc .gt. 1.d-15) goto 380 +c if (ztest .ne. test) go to 380 + e(l) = 0.0d0 +c ......exit + go to 400 + 380 continue + 390 continue + 400 continue + if (l .ne. m - 1) go to 410 + kase = 4 + go to 480 + 410 continue + lp1 = l + 1 + mp1 = m + 1 + do 430 lls = lp1, mp1 + ls = m - lls + lp1 +c ...exit + if (ls .eq. l) go to 440 + test = 0.0d0 + if (ls .ne. m) test = test + dabs(e(ls)) + if (ls .ne. l + 1) test = test + dabs(e(ls-1)) + ztest = test + dabs(s(ls)) +c 1.0d-100 is to guard against a zero matrix, hence zero test + acc = dabs(test - ztest)/(1.0d-100 + test) + if (acc .gt. 1.d-15) goto 420 +c if (ztest .ne. test) go to 420 + s(ls) = 0.0d0 +c ......exit + go to 440 + 420 continue + 430 continue + 440 continue + if (ls .ne. l) go to 450 + kase = 3 + go to 470 + 450 continue + if (ls .ne. m) go to 460 + kase = 1 + go to 470 + 460 continue + kase = 2 + l = ls + 470 continue + 480 continue + l = l + 1 +c +c perform the task indicated by kase. +c + go to (490,520,540,570), kase +c +c deflate negligible s(m). +c + 490 continue + mm1 = m - 1 + f = e(m-1) + e(m-1) = 0.0d0 + do 510 kk = l, mm1 + k = mm1 - kk + l + t1 = s(k) + call drotg(t1,f,cs,sn) + s(k) = t1 + if (k .eq. l) go to 500 + f = -sn*e(k-1) + e(k-1) = cs*e(k-1) + 500 continue + if (wantv) call drot(p,v(1,k),1,v(1,m),1,cs,sn) + 510 continue + go to 610 +c +c split at negligible s(l). +c + 520 continue + f = e(l-1) + e(l-1) = 0.0d0 + do 530 k = l, m + t1 = s(k) + call drotg(t1,f,cs,sn) + s(k) = t1 + f = -sn*e(k) + e(k) = cs*e(k) + if (wantu) call drot(n,u(1,k),1,u(1,l-1),1,cs,sn) + 530 continue + go to 610 +c +c perform one qr step. +c + 540 continue +c +c calculate the shift. +c + scale = dmax1(dabs(s(m)),dabs(s(m-1)),dabs(e(m-1)), + * dabs(s(l)),dabs(e(l))) + sm = s(m)/scale + smm1 = s(m-1)/scale + emm1 = e(m-1)/scale + sl = s(l)/scale + el = e(l)/scale + b = ((smm1 + sm)*(smm1 - sm) + emm1**2)/2.0d0 + c = (sm*emm1)**2 + shift = 0.0d0 + if (b .eq. 0.0d0 .and. c .eq. 0.0d0) go to 550 + shift = dsqrt(b**2+c) + if (b .lt. 0.0d0) shift = -shift + shift = c/(b + shift) + 550 continue + f = (sl + sm)*(sl - sm) + shift + g = sl*el +c +c chase zeros. +c + mm1 = m - 1 + do 560 k = l, mm1 + call drotg(f,g,cs,sn) + if (k .ne. l) e(k-1) = f + f = cs*s(k) + sn*e(k) + e(k) = cs*e(k) - sn*s(k) + g = sn*s(k+1) + s(k+1) = cs*s(k+1) + if (wantv) call drot(p,v(1,k),1,v(1,k+1),1,cs,sn) + call drotg(f,g,cs,sn) + s(k) = f + f = cs*e(k) + sn*s(k+1) + s(k+1) = -sn*e(k) + cs*s(k+1) + g = sn*e(k+1) + e(k+1) = cs*e(k+1) + if (wantu .and. k .lt. n) + * call drot(n,u(1,k),1,u(1,k+1),1,cs,sn) + 560 continue + e(m-1) = f + iter = iter + 1 + go to 610 +c +c convergence. +c + 570 continue +c +c make the singular value positive. +c + if (s(l) .ge. 0.0d0) go to 580 + s(l) = -s(l) + if (wantv) call dscal(p,-1.0d0,v(1,l),1) + 580 continue +c +c order the singular value. +c + 590 if (l .eq. mm) go to 600 +c ...exit + if (s(l) .ge. s(l+1)) go to 600 + t = s(l) + s(l) = s(l+1) + s(l+1) = t + if (wantv .and. l .lt. p) + * call dswap(p,v(1,l),1,v(1,l+1),1) + if (wantu .and. l .lt. n) + * call dswap(n,u(1,l),1,u(1,l+1),1) + l = l + 1 + go to 590 + 600 continue + iter = 0 + m = m - 1 + 610 continue + go to 360 + 620 continue + return + end diff --git a/com.oracle.truffle.r.native/gnur/patch/src/appl/dtrco.f b/com.oracle.truffle.r.native/gnur/patch/src/appl/dtrco.f new file mode 100644 index 0000000000000000000000000000000000000000..8f693e6a818fc23902117385b68d651a726fb556 --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/appl/dtrco.f @@ -0,0 +1,161 @@ + subroutine dtrco(t,ldt,n,rcond,z,job) + integer ldt,n,job + double precision t(ldt,*),z(*) + double precision rcond +c +c dtrco estimates the condition of a double precision triangular +c matrix. +c +c on entry +c +c t double precision(ldt,n) +c t contains the triangular matrix. the zero +c elements of the matrix are not referenced, and +c the corresponding elements of the array can be +c used to store other information. +c +c ldt integer +c ldt is the leading dimension of the array t. +c +c n integer +c n is the order of the system. +c +c job integer +c = 0 t is lower triangular. +c = nonzero t is upper triangular. +c +c on return +c +c rcond double precision +c an estimate of the reciprocal condition of t . +c for the system t*x = b , relative perturbations +c in t and b of size epsilon may cause +c relative perturbations in x of size epsilon/rcond . +c if rcond is so small that the logical expression +c 1.0 + rcond .eq. 1.0 +c is true, then t may be singular to working +c precision. in particular, rcond is zero if +c exact singularity is detected or the estimate +c underflows. +c +c z double precision(n) +c a work vector whose contents are usually unimportant. +c if t is close to a singular matrix, then z is +c an approximate null vector in the sense that +c norm(a*z) = rcond*norm(a)*norm(z) . +c +c linpack. this version dated 08/14/78 . +c cleve moler, university of new mexico, argonne national lab. +c +c subroutines and functions +c +c blas daxpy,dscal,dasum +c fortran dabs,dmax1,dsign +c +c internal variables +c + double precision w,wk,wkm,ek + double precision tnorm,ynorm,s,sm,dasum + integer i1,j,j1,j2,k,kk,l + logical lower +c + lower = job .eq. 0 +c +c compute 1-norm of t +c + tnorm = 0.0d0 + do 10 j = 1, n + l = j + if (lower) l = n + 1 - j + i1 = 1 + if (lower) i1 = j + tnorm = dmax1(tnorm,dasum(l,t(i1,j),1)) + 10 continue +c +c rcond = 1/(norm(t)*(estimate of norm(inverse(t)))) . +c estimate = norm(z)/norm(y) where t*z = y and trans(t)*y = e . +c trans(t) is the transpose of t . +c the components of e are chosen to cause maximum local +c growth in the elements of y . +c the vectors are frequently rescaled to avoid overflow. +c +c solve trans(t)*y = e +c + ek = 1.0d0 + do 20 j = 1, n + z(j) = 0.0d0 + 20 continue + do 100 kk = 1, n + k = kk + if (lower) k = n + 1 - kk + if (z(k) .ne. 0.0d0) ek = dsign(ek,-z(k)) + if (dabs(ek-z(k)) .le. dabs(t(k,k))) go to 30 + s = dabs(t(k,k))/dabs(ek-z(k)) + call dscal(n,s,z,1) + ek = s*ek + 30 continue + wk = ek - z(k) + wkm = -ek - z(k) + s = dabs(wk) + sm = dabs(wkm) + if (t(k,k) .eq. 0.0d0) go to 40 + wk = wk/t(k,k) + wkm = wkm/t(k,k) + go to 50 + 40 continue + wk = 1.0d0 + wkm = 1.0d0 + 50 continue + if (kk .eq. n) go to 90 + j1 = k + 1 + if (lower) j1 = 1 + j2 = n + if (lower) j2 = k - 1 + do 60 j = j1, j2 + sm = sm + dabs(z(j)+wkm*t(k,j)) + z(j) = z(j) + wk*t(k,j) + s = s + dabs(z(j)) + 60 continue + if (s .ge. sm) go to 80 + w = wkm - wk + wk = wkm + do 70 j = j1, j2 + z(j) = z(j) + w*t(k,j) + 70 continue + 80 continue + 90 continue + z(k) = wk + 100 continue + s = 1.0d0/dasum(n,z,1) + call dscal(n,s,z,1) +c + ynorm = 1.0d0 +c +c solve t*z = y +c + do 130 kk = 1, n + k = n + 1 - kk + if (lower) k = kk + if (dabs(z(k)) .le. dabs(t(k,k))) go to 110 + s = dabs(t(k,k))/dabs(z(k)) + call dscal(n,s,z,1) + ynorm = s*ynorm + 110 continue + if (t(k,k) .ne. 0.0d0) z(k) = z(k)/t(k,k) + if (t(k,k) .eq. 0.0d0) z(k) = 1.0d0 + i1 = 1 + if (lower) i1 = k + 1 + if (kk .ge. n) go to 120 + w = -z(k) + call daxpy(n-kk,w,t(i1,k),1,z(i1),1) + 120 continue + 130 continue +c make znorm = 1.0 + s = 1.0d0/dasum(n,z,1) + call dscal(n,s,z,1) + ynorm = s*ynorm +c + if (tnorm .ne. 0.0d0) rcond = ynorm/tnorm + if (tnorm .eq. 0.0d0) rcond = 0.0d0 + return + end diff --git a/com.oracle.truffle.r.native/gnur/patch/src/appl/dtrsl.f b/com.oracle.truffle.r.native/gnur/patch/src/appl/dtrsl.f new file mode 100644 index 0000000000000000000000000000000000000000..b656627dfd5640eceb310ac6d8bffc1a209cdfac --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/appl/dtrsl.f @@ -0,0 +1,141 @@ +c Triangular Solve dtrsl() +c ---------------- +c solves systems of the form +c +c t * x = b +c or +c trans(t) * x = b +c +c where t is a triangular matrix of order n. here trans(t) +c denotes the transpose of the matrix t. +c +c on entry +c +c t double precision(ldt,n) +c t contains the matrix of the system. the zero +c elements of the matrix are not referenced, and +c the corresponding elements of the array can be +c used to store other information. +c +c ldt integer +c ldt is the leading dimension of the array t. +c +c n integer +c n is the order of the system. +c +c b double precision(n). +c b contains the right hand side of the system. +c +c job integer +c job specifies what kind of system is to be solved. +c if job is +c +c 00 solve t*x=b, t lower triangular, +c 01 solve t*x=b, t upper triangular, +c 10 solve trans(t)*x=b, t lower triangular, +c 11 solve trans(t)*x=b, t upper triangular. +c +c on return +c +c b b contains the solution, if info .eq. 0. +c otherwise b is unaltered. +c +c info integer +c info contains zero if the system is nonsingular. +c otherwise info contains the index of +c the first zero diagonal element of t. +c +c linpack. this version dated 08/14/78 . +c g. w. stewart, university of maryland, argonne national lab. +c +c subroutines and functions +c +c blas: daxpy,ddot +c fortran mod +c + subroutine dtrsl(t,ldt,n,b,job,info) + integer ldt,n,job,info + double precision t(ldt,*),b(*) +c +c internal variables +c + double precision ddot,temp + integer case,j,jj +c +c begin block permitting ...exits to 150 +c +c check for zero diagonal elements. +c + do 10 info = 1, n + if (t(info,info) .eq. 0.0d0) go to 150 +c ......exit + 10 continue + info = 0 +c +c determine the task and go to it. +c + case = 1 + if (mod(job,10) .ne. 0) case = 2 + if (mod(job,100)/10 .ne. 0) case = case + 2 + go to (20,50,80,110), case +c +C Case 1 (job = 00): +c solve t*x=b for t lower triangular +c + 20 continue + b(1) = b(1)/t(1,1) + if (n .ge. 2) then + do 30 j = 2, n + temp = -b(j-1) + call daxpy(n-j+1,temp,t(j,j-1),1,b(j),1) + b(j) = b(j)/t(j,j) + 30 continue + endif + go to 140 +c +C Case 2 (job = 01): +c solve t*x=b for t upper triangular. +c + 50 continue + b(n) = b(n)/t(n,n) + if (n .ge. 2) then + do 60 jj = 2, n + j = n - jj + 1 + temp = -b(j+1) + call daxpy(j,temp,t(1,j+1),1,b(1),1) + b(j) = b(j)/t(j,j) + 60 continue + endif + go to 140 +c +C Case 3 (job = 10): +c solve trans(t)*x=b for t lower triangular. +c + 80 continue + b(n) = b(n)/t(n,n) + if (n .ge. 2) then + do 90 jj = 2, n + j = n - jj + 1 + b(j) = b(j) - ddot(jj-1,t(j+1,j),1,b(j+1),1) + b(j) = b(j)/t(j,j) + 90 continue + endif + go to 140 +c +C Case 4 (job = 11): +c solve trans(t)*x=b for t upper triangular. +c + 110 continue + b(1) = b(1)/t(1,1) + if (n .ge. 2) then + do 120 j = 2, n + b(j) = b(j) - ddot(j-1,t(1,j),1,b(1),1) + b(j) = b(j)/t(j,j) + 120 continue + endif +C + 140 continue +c EXIT: + 150 continue + return + end diff --git a/com.oracle.truffle.r.native/gnur/patch/src/appl/interv.c b/com.oracle.truffle.r.native/gnur/patch/src/appl/interv.c new file mode 100644 index 0000000000000000000000000000000000000000..7ed6c9870c32dc7e5608731a13dcbcd46d8aa141 --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/appl/interv.c @@ -0,0 +1,207 @@ +/* + * R : A Computer Language for Statistical Data Analysis + * Copyright (C) 2002--2016 The R Core Team + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version. + * + * This program 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 this program; if not, a copy is available at + * https://www.R-project.org/Licenses/ + * + * The interv() used to be Fortran in ../library/modreg/src/bvalue.f + * and part of Hastie and Tibshirani's public domain GAMFIT package. + * + * Translated by f2c (version 20010821), cleaned up and extended by + * Martin Maechler. + */ + +#include <R_ext/Applic.h> +#include <R_ext/Boolean.h> +#include <R_ext/Utils.h> + +/* This is called from stats/src/bvalue.f, 3 x stats/src/s*.f for smooth.spline() + and packages gam and mda */ +int F77_SUB(interv)(double *xt, int *n, double *x, + Rboolean *rightmost_closed, Rboolean *all_inside, + int *ilo, int *mflag) +{ + return findInterval(xt, *n, *x, *rightmost_closed, *all_inside, *ilo, mflag); +} + +int findInterval2(double *xt, int n, double x, + Rboolean rightmost_closed, Rboolean all_inside, + Rboolean left_open, // <- new in findInterval2() + int ilo, int *mflag) +{ + int istep, middle, ihi; + +/* computes `left' := max( i ; 1 <= i <= n && xt[i] <= x ) . + + ****** i n p u t ****** + + xt numeric vector of length n , assumed to be nondecreasing + n length(xt) + x the point whose location with respect to the sequence xt is + to be determined. + rightmost_closed {logical} indicating if the rightmost xt[] interval + should be closed, i.e. result := n-1 if x == x[n] + (when left_open, the *leftmost* interval should be closed.) + all_inside {logical} indicating if result should be coerced + to lie inside {1, n-1} + left_open {logical} use intervals (s, t] instead of [s, t) + ilo typically the result of the last call to findInterval(.) + `ilo' used to be a static variable (in Fortran) which is not + desirable in R anymore (threads!). + Instead, you *should* use a reasonable value, in the first call. + + ****** o u t p u t ****** + + left, mflag both integers, whose value is + + 0 -1 if x < xt[1] + i 0 if xt[i] <= x < xt[i+1] + n 1 if xt[n] <= x + + in particular, mflag = 0 is the 'usual' case. mflag != 0 + indicates that x lies outside the halfopen interval + xt[1] <= y < xt[n] . the asymmetric treatment of the + interval is due to the decision to make all pp functions cont- + inuous from the right. + + Note that if all_inside, left is 1 instead of 0 and n-1 instead of n; + and if rightmost_closed and x == xt[n], left is n-1 instead of n. + + + ****** m e t h o d ****** + + the program is designed to be efficient in the common situation that + it is called repeatedly, with x taken from an increasing or decreasing + sequence. this will happen, e.g., when a pp function is to be graphed. + The first guess for left is therefore taken to be the value returned at + the previous call and stored in the l o c a l variable ilo . + a first check ascertains that ilo < n (this is necessary since the + present call may have nothing to do with the previous call). + + then, if xt[ilo] <= x < xt[ilo+1], we set left = ilo + and are done after just three comparisons. + otherwise, we repeatedly double the difference istep = ihi - ilo + while also moving ilo and ihi in the direction of x , until + xt[ilo] <= x < xt[ihi] , + after which we use bisection to get, in addition, ilo+1 = ihi . + left = ilo is then returned. +*/ + +#define left_boundary { *mflag = -1; \ + return((all_inside || (rightmost_closed && x == xt[1])) ? 1 : 0); } + +#define right_boundary { *mflag = +1; \ + return((all_inside || (rightmost_closed && x == xt[n])) \ + ? (n - 1) : n); } + +#define X_grtr(XT_v) x > XT_v || (!left_open && x >= XT_v) +#define X_smlr(XT_v) x < XT_v || (left_open && x <= XT_v) + + if(n == 0) { *mflag = 0 ; return 0; } + /* 1-indexing : */ + --xt; + + if(ilo <= 0) { + if (X_smlr(xt[1])) left_boundary; + ilo = 1; + } + ihi = ilo + 1; + if (ihi >= n) { + if (X_grtr(xt[n])) right_boundary; + if (n <= 1) /* x < xt[1] */ left_boundary; + ilo = n - 1; + ihi = n; + } + + if (X_smlr(xt[ihi])) { + if (X_grtr(xt[ilo])) { + /* `lucky': same interval as last time */ + *mflag = 0; return ilo; + } + /* **** now x < xt[ilo] . decrease ilo to capture x */ + if(!left_open) for(istep = 1; ; istep *= 2) { + ihi = ilo; + ilo = ihi - istep; + if (ilo <= 1) + break; + if (x >= xt[ilo]) goto L50; + } else for(istep = 1; ; istep *= 2) { + ihi = ilo; + ilo = ihi - istep; + if (ilo <= 1) + break; + if (x > xt[ilo]) goto L51; + } + ilo = 1; + if (X_smlr(xt[1])) left_boundary; + } + else { + /* **** now x >= xt[ihi] . increase ihi to capture x */ + if(!left_open) for(istep = 1; ; istep *= 2) { + ilo = ihi; + ihi = ilo + istep; + if (ihi >= n) + break; + if (x < xt[ihi]) goto L50; + } + else for(istep = 1; ; istep *= 2) { + ilo = ihi; + ihi = ilo + istep; + if (ihi >= n) + break; + if (x <= xt[ihi]) goto L51; + } + if (X_grtr(xt[n])) right_boundary; + ihi = n; + } + + if (left_open) goto L51; /* There _is_ a path to here, avoiding return and goto */ + +L50: // ! left_open + /* **** now xt[ilo] <= x < xt[ihi] . narrow the interval. */ + for(;;) { + middle = (ilo + ihi) / 2; + if (middle == ilo) { + *mflag = 0; return ilo; + } + /* note. it is assumed that middle = ilo in case ihi = ilo+1 . */ + if (x >= xt[middle]) + ilo = middle; + else + ihi = middle; + } + +L51: // left_open + /* **** now xt[ilo] < x <= xt[ihi] . narrow the interval. */ + for(;;) { + middle = (ilo + ihi) / 2; + if (middle == ilo) { + *mflag = 0; return ilo; + } + /* note. it is assumed that middle = ilo in case ihi = ilo+1 . */ + if (x > xt[middle]) + ilo = middle; + else + ihi = middle; + } +} /* findInterval2 */ + +// has been in API -- keep for compatibility: +int findInterval(double *xt, int n, double x, + Rboolean rightmost_closed, Rboolean all_inside, int ilo, + int *mflag) +{ + return findInterval2(xt, n, x, rightmost_closed, all_inside, FALSE, ilo, mflag); +} diff --git a/com.oracle.truffle.r.native/gnur/patch/src/appl/pretty.c b/com.oracle.truffle.r.native/gnur/patch/src/appl/pretty.c new file mode 100644 index 0000000000000000000000000000000000000000..8f5f6064195af79abc222f41dc52c3415b4ad34e --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/appl/pretty.c @@ -0,0 +1,196 @@ +/* + * R : A Computer Language for Statistical Data Analysis + * Copyright (C) 1995-2014 The R Core Team + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version. + * + * This program 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 this program; if not, a copy is available at + * https://www.R-project.org/Licenses/ + */ + +/* Pretty Intervals + * ---------------- + * Constructs m "pretty" values which cover the given interval *lo <= *up + * m ~= *ndiv + 1 (i.e., ndiv := approximate number of INTERVALS) + * + * It is not quite clear what should happen for *lo = *up; + * S itself behaves quite funilly, then. + * + * In my opinion, a proper 'pretty' should always ensure + * *lo < *up, and hence *ndiv >=1 in the result. + * However, in S and here, we allow *lo == *up, and *ndiv = 0. + * Note however, that we are NOT COMPATIBLE to S. [Martin M.] + * + * NEW (0.63.2): ns, nu are double (==> no danger of integer overflow) + * + * We determine + * if the interval (up - lo) is ``small'' [<==> i_small == TRUE, below]. + * For the ``i_small'' situation, there is a parameter shrink_sml, + * the factor by which the "scale" is shrunk. ~~~~~~~~~~ + * It is advisable to set it to some (smaller) integer power of 2, + * since this enables exact floating point division. + */ + +#ifdef HAVE_CONFIG_H +#include <config.h> +#endif + +#ifdef ENABLE_NLS +#include <libintl.h> +#define _(String) gettext (String) +#else +#define _(String) (String) +#endif + +#include <math.h> +#include <float.h> +#include <R_ext/Applic.h> +#include <Rmath.h> +#include <R_ext/Error.h> +#ifdef DEBUGpr +# include <R_ext/Print.h> +#endif + +#ifdef HAVE_VISIBILITY_ATTRIBUTE +# define attribute_hidden __attribute__ ((visibility ("hidden"))) +#else +# define attribute_hidden +#endif + +attribute_hidden +double R_pretty(double *lo, double *up, int *ndiv, int min_n, + double shrink_sml, double high_u_fact[], + int eps_correction, int return_bounds) +{ +/* From version 0.65 on, we had rounding_eps := 1e-5, before, r..eps = 0 + * 1e-7 is consistent with seq.default() */ +#define rounding_eps 1e-7 + +#define h high_u_fact[0] +#define h5 high_u_fact[1] + + double dx, cell, unit, base, U; + double ns, nu; + int k; + Rboolean i_small; + + dx = *up - *lo; + /* cell := "scale" here */ + if(dx == 0 && *up == 0) { /* up == lo == 0 */ + cell = 1; + i_small = TRUE; + } else { + cell = fmax2(fabs(*lo),fabs(*up)); + /* U = upper bound on cell/unit */ + U = (1 + (h5 >= 1.5*h+.5)) ? 1/(1+h) : 1.5/(1+h5); + /* added times 3, as several calculations here */ + i_small = dx < cell * U * imax2(1,*ndiv) * DBL_EPSILON *3; + } + + /*OLD: cell = FLT_EPSILON+ dx / *ndiv; FLT_EPSILON = 1.192e-07 */ + if(i_small) { + if(cell > 10) + cell = 9 + cell/10; + cell *= shrink_sml; + if(min_n > 1) cell /= min_n; + } else { + cell = dx; + if(*ndiv > 1) cell /= *ndiv; + } + + if(cell < 20*DBL_MIN) { + warning(_("Internal(pretty()): very small range.. corrected")); + cell = 20*DBL_MIN; + } else if(cell * 10 > DBL_MAX) { + warning(_("Internal(pretty()): very large range.. corrected")); + cell = .1*DBL_MAX; + } + /* NB: the power can be negative and this relies on exact + calculation, which glibc's exp10 does not achieve */ + base = pow(10.0, floor(log10(cell))); /* base <= cell < 10*base */ + + /* unit : from { 1,2,5,10 } * base + * such that |u - cell| is small, + * favoring larger (if h > 1, else smaller) u values; + * favor '5' more than '2' if h5 > h (default h5 = .5 + 1.5 h) */ + unit = base; + if((U = 2*base)-cell < h*(cell-unit)) { unit = U; + if((U = 5*base)-cell < h5*(cell-unit)) { unit = U; + if((U =10*base)-cell < h*(cell-unit)) unit = U; }} + /* Result: c := cell, u := unit, b := base + * c in [ 1, (2+ h) /(1+h) ] b ==> u= b + * c in ( (2+ h)/(1+h), (5+2h5)/(1+h5)] b ==> u= 2b + * c in ( (5+2h)/(1+h), (10+5h) /(1+h) ] b ==> u= 5b + * c in ((10+5h)/(1+h), 10 ) b ==> u=10b + * + * ===> 2/5 *(2+h)/(1+h) <= c/u <= (2+h)/(1+h) */ + + ns = floor(*lo/unit+rounding_eps); + nu = ceil (*up/unit-rounding_eps); +#ifdef DEBUGpr + REprintf("pretty(lo=%g,up=%g,ndiv=%d,min_n=%d,shrink=%g,high_u=(%g,%g)," + "eps=%d)\n\t dx=%g; is.small:%d. ==> cell=%g; unit=%g\n", + *lo, *up, *ndiv, min_n, shrink_sml, h, h5, + eps_correction, dx, (int)i_small, cell, unit); +#endif + if(eps_correction && (eps_correction > 1 || !i_small)) { + if(*lo != 0.) *lo *= (1- DBL_EPSILON); else *lo = -DBL_MIN; + if(*up != 0.) *up *= (1+ DBL_EPSILON); else *up = +DBL_MIN; + } + +#ifdef DEBUGpr + if(ns*unit > *lo) + REprintf("\t ns= %.0f -- while(ns*unit > *lo) ns--;\n", ns); +#endif + while(ns*unit > *lo + rounding_eps*unit) ns--; + +#ifdef DEBUGpr + if(nu*unit < *up) + REprintf("\t nu= %.0f -- while(nu*unit < *up) nu++;\n", nu); +#endif + while(nu*unit < *up - rounding_eps*unit) nu++; + + k = (int)(0.5 + nu - ns); + if(k < min_n) { + /* ensure that nu - ns == min_n */ +#ifdef DEBUGpr + REprintf("\tnu-ns=%.0f-%.0f=%d SMALL -> ensure nu-ns= min_n=%d\n", + nu,ns, k, min_n); +#endif + k = min_n - k; + if(ns >= 0.) { + nu += k/2; + ns -= k/2 + k%2;/* ==> nu-ns = old(nu-ns) + min_n -k = min_n */ + } else { + ns -= k/2; + nu += k/2 + k%2; + } + *ndiv = min_n; + } + else { + *ndiv = k; + } + if(return_bounds) { /* if()'s to ensure that result covers original range */ + if(ns * unit < *lo) *lo = ns * unit; + if(nu * unit > *up) *up = nu * unit; + } else { + *lo = ns; + *up = nu; + } +#ifdef DEBUGpr + REprintf("\t ns=%.0f ==> lo=%g\n", ns, *lo); + REprintf("\t nu=%.0f ==> up=%g ==> ndiv = %d\n", nu, *up, *ndiv); +#endif + return unit; +#undef h +#undef h5 +} diff --git a/com.oracle.truffle.r.native/gnur/patch/src/include/Defn.h b/com.oracle.truffle.r.native/gnur/patch/src/include/Defn.h new file mode 100644 index 0000000000000000000000000000000000000000..39a3a90e7f464ea284ef3cc3c6fa6b4ca9f82718 --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/include/Defn.h @@ -0,0 +1,1460 @@ +/* + * R : A Computer Language for Statistical Data Analysis + * Copyright (C) 1995, 1996 Robert Gentleman and Ross Ihaka + * Copyright (C) 1998--2017 The R Core Team. + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version. + * + * This program 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 this program; if not, a copy is available at + * https://www.R-project.org/Licenses/ + */ + +/* Internal header, not installed */ + +#ifndef DEFN_H_ +#define DEFN_H_ + +/* seems unused */ +#define COUNTING + +#define BYTECODE + +/* probably no longer needed */ +#define NEW_CONDITION_HANDLING + +/* To test the write barrier used by the generational collector, + define TESTING_WRITE_BARRIER. This makes the internal structure of + SEXPRECs visible only inside of files that explicitly define + USE_RINTERNALS, and all uses of SEXPREC fields that do not go + through the appropriate functions or macros will become compilation + errors. Since this does impose a small but noticable performance + penalty, code that includes Defn.h (or code that explicitly defines + USE_RINTERNALS) can access a SEXPREC's fields directly. */ + +#ifndef TESTING_WRITE_BARRIER +# define USE_RINTERNALS +#endif + +#ifdef HAVE_VISIBILITY_ATTRIBUTE +# define attribute_visible __attribute__ ((visibility ("default"))) +# define attribute_hidden __attribute__ ((visibility ("hidden"))) +#else +# define attribute_visible +# define attribute_hidden +#endif + +#ifdef __MAIN__ +# define extern0 attribute_hidden +#else +# define extern0 extern +#endif + +#define MAXELTSIZE 8192 /* Used as a default for string buffer sizes, + and occasionally as a limit. */ + +#include <R_ext/Complex.h> +void Rf_CoercionWarning(int);/* warning code */ +int Rf_LogicalFromInteger(int, int*); +int Rf_LogicalFromReal(double, int*); +int Rf_LogicalFromComplex(Rcomplex, int*); +int Rf_IntegerFromLogical(int, int*); +int Rf_IntegerFromReal(double, int*); +int Rf_IntegerFromComplex(Rcomplex, int*); +double Rf_RealFromLogical(int, int*); +double Rf_RealFromInteger(int, int*); +double Rf_RealFromComplex(Rcomplex, int*); +Rcomplex Rf_ComplexFromLogical(int, int*); +Rcomplex Rf_ComplexFromInteger(int, int*); +Rcomplex Rf_ComplexFromReal(double, int*); + +#define CALLED_FROM_DEFN_H 1 +#include <Rinternals.h> /*-> Arith.h, Boolean.h, Complex.h, Error.h, + Memory.h, PrtUtil.h, Utils.h */ +#undef CALLED_FROM_DEFN_H +extern0 SEXP R_CommentSymbol; /* "comment" */ +extern0 SEXP R_DotEnvSymbol; /* ".Environment" */ +extern0 SEXP R_ExactSymbol; /* "exact" */ +extern0 SEXP R_RecursiveSymbol; /* "recursive" */ +extern0 SEXP R_WholeSrcrefSymbol; /* "wholeSrcref" */ +extern0 SEXP R_TmpvalSymbol; /* "*tmp*" */ +extern0 SEXP R_UseNamesSymbol; /* "use.names" */ +extern0 SEXP R_ColonSymbol; /* ":" */ +//extern0 SEXP R_DoubleColonSymbol; /* "::" */ +//extern0 SEXP R_TripleColonSymbol; /* ":::" */ +extern0 SEXP R_ConnIdSymbol; /* "conn_id" */ +extern0 SEXP R_DevicesSymbol; /* ".Devices" */ + +extern0 SEXP R_dot_Methods; /* ".Methods" */ +extern0 SEXP R_dot_Group; /* ".Group" */ +extern0 SEXP R_dot_Class; /* ".Class" */ +extern0 SEXP R_dot_GenericCallEnv; /* ".GenericCallEnv" */ +extern0 SEXP R_dot_GenericDefEnv; /* ".GenericDefEnv" */ + +extern0 SEXP R_StringHash; /* Global hash of CHARSXPs */ + + + /* writable char access for R internal use only */ +#define CHAR_RW(x) ((char *) CHAR(x)) + +/* CHARSXP charset bits */ +#define BYTES_MASK (1<<1) +#define LATIN1_MASK (1<<2) +#define UTF8_MASK (1<<3) +/* (1<<4) is taken by S4_OBJECT_MASK */ +#define CACHED_MASK (1<<5) +#define ASCII_MASK (1<<6) +#define HASHASH_MASK 1 +/**** HASHASH uses the first bit -- see HASHASH_MASK defined below */ + +#ifdef USE_RINTERNALS +# define IS_BYTES(x) ((x)->sxpinfo.gp & BYTES_MASK) +# define SET_BYTES(x) (((x)->sxpinfo.gp) |= BYTES_MASK) +# define IS_LATIN1(x) ((x)->sxpinfo.gp & LATIN1_MASK) +# define SET_LATIN1(x) (((x)->sxpinfo.gp) |= LATIN1_MASK) +# define IS_ASCII(x) ((x)->sxpinfo.gp & ASCII_MASK) +# define SET_ASCII(x) (((x)->sxpinfo.gp) |= ASCII_MASK) +# define IS_UTF8(x) ((x)->sxpinfo.gp & UTF8_MASK) +# define SET_UTF8(x) (((x)->sxpinfo.gp) |= UTF8_MASK) +# define ENC_KNOWN(x) ((x)->sxpinfo.gp & (LATIN1_MASK | UTF8_MASK)) +# define SET_CACHED(x) (((x)->sxpinfo.gp) |= CACHED_MASK) +# define IS_CACHED(x) (((x)->sxpinfo.gp) & CACHED_MASK) +#else +/* Needed only for write-barrier testing */ +int IS_BYTES(SEXP x); +void SET_BYTES(SEXP x); +int IS_LATIN1(SEXP x); +void SET_LATIN1(SEXP x); +int IS_ASCII(SEXP x); +void SET_ASCII(SEXP x); +int IS_UTF8(SEXP x); +void SET_UTF8(SEXP x); +int ENC_KNOWN(SEXP x); +int SET_CACHED(SEXP x); +int IS_CACHED(SEXP x); +#endif +/* macros and declarations for managing CHARSXP cache */ +# define CXHEAD(x) (x) +# define CXTAIL(x) ATTRIB(x) +SEXP (SET_CXTAIL)(SEXP x, SEXP y); + +#include "Errormsg.h" + +extern void R_ProcessEvents(void); +#ifdef Win32 +extern void R_WaitEvent(void); +#endif + +#ifdef R_USE_SIGNALS +#ifdef Win32 +# include <psignal.h> +#else +# include <signal.h> +# include <setjmp.h> +#endif +#endif + +#ifdef Unix +# define OSTYPE "unix" +# define FILESEP "/" +#endif /* Unix */ + +#ifdef Win32 +# define OSTYPE "windows" +# define FILESEP "/" +#endif /* Win32 */ + +#ifdef HAVE_F77_UNDERSCORE +# define F77_SYMBOL(x) x ## _ +# define F77_QSYMBOL(x) #x "_" +#else +# define F77_SYMBOL(x) x +# define F77_QSYMBOL(x) #x +#endif + +/* Heap and Pointer Protection Stack Sizes. */ + +/* These headers are all required by C99. + However, we use types below such as uintptr_t which are optional in C11. + And on some older systems they were in inttypes.h but not stdint.h. + + Up to 2.11.1 (r52035, May 2010) we had + +#if !defined(HAVE_INTPTR_T) && !defined(intptr_t) + typedef long intptr_t; +#endif +#if !defined(HAVE_UINTPTR_T) && !defined(uintptr_t) + typedef unsigned long uintptr_t; +#endif + but size_t might be better. + + */ +#ifdef HAVE_INTTYPES_H +# include <inttypes.h> +#endif +/* According to POSIX inttypes.h should include stdint.h, + but let's be sure. */ +#ifdef HAVE_STDINT_H +# include <stdint.h> +#endif +#ifdef HAVE_LIMITS_H +# include <limits.h> +#endif + +#if defined HAVE_DECL_SIZE_MAX && HAVE_DECL_SIZE_MAX + typedef size_t R_size_t; +# define R_SIZE_T_MAX SIZE_MAX +#else +# error SIZE_MAX is required for C99 +#endif + + +#define Mega 1048576. /* 1 Mega Byte := 2^20 (= 1048576) Bytes */ +#define Giga 1073741824. /* 1 Giga Byte := 2^30 Bytes */ + +/* R_PPSSIZE The pointer protection stack size */ +/* R_NSIZE The number of cons cells */ +/* R_VSIZE The vector heap size in bytes */ +/* These values are defaults and can be overridden in config.h + The maxima and minima are in startup.c */ + +#ifndef R_PPSSIZE +#define R_PPSSIZE 50000L +#endif +#ifndef R_NSIZE +#define R_NSIZE 350000L +#endif +#ifndef R_VSIZE +#define R_VSIZE 6291456L +#endif + +/* some commonly needed headers */ +#include <math.h> +#include <stdlib.h> +#include <string.h> + +/* declare substitutions */ +#if !defined(strdup) && defined(HAVE_DECL_STRDUP) && !HAVE_DECL_STRDUP +extern char *strdup(const char *s1); +#endif +#if !defined(strncascmp) && defined(HAVE_DECL_STRNCASECMP) && !HAVE_DECL_STRNCASECMP +extern int strncasecmp(const char *s1, const char *s2, size_t n); +#endif + +/* Glibc manages to not define this in -pedantic -ansi */ +#if defined(HAVE_PUTENV) && !defined(putenv) && defined(HAVE_DECL_PUTENV) && !HAVE_DECL_PUTENV +extern int putenv(char *string); +#endif + + +/* Maximal length in bytes of an entire path name. + POSIX has required this to be at least 255/256, and X/Open at least 1024. + Solaris has 1024, Linux glibc has 4192. + File names are limited to FILENAME_MAX bytes (usually the same as PATH_MAX) + or NAME_MAX (often 255/256). + */ +#if !defined(PATH_MAX) +# if defined(HAVE_SYS_PARAM_H) +# include <sys/param.h> +# endif +# if !defined(PATH_MAX) +# if defined(MAXPATHLEN) +/* Try BSD name */ +# define PATH_MAX MAXPATHLEN +# elif defined(Win32) +/* seems this is now defined by MinGW to be 259, whereas FILENAME_MAX + and MAX_PATH are 260. It is not clear that this really is in bytes, + but might be chars for the Unicode interfaces. + + 260 is d:\ plus 256 chars plus nul. Some but not all API calls + allow filepaths of the form \\?\D:\very_long_path . +*/ +# define PATH_MAX 260 +# else +/* quite possibly unlimited, so we make this large, and test when used */ +# define PATH_MAX 5000 +# endif +# endif +#endif + +#ifdef R_USE_SIGNALS +#ifdef HAVE_POSIX_SETJMP +# define SIGJMP_BUF sigjmp_buf +# define SIGSETJMP(x,s) sigsetjmp(x,s) +# define SIGLONGJMP(x,i) siglongjmp(x,i) +# define JMP_BUF sigjmp_buf +# define SETJMP(x) sigsetjmp(x,0) +# define LONGJMP(x,i) siglongjmp(x,i) +#else +# define SIGJMP_BUF jmp_buf +# define SIGSETJMP(x,s) setjmp(x) +# define SIGLONGJMP(x,i) longjmp(x,i) +# define JMP_BUF jmp_buf +# define SETJMP(x) setjmp(x) +# define LONGJMP(x,i) longjmp(x,i) +#endif +#endif + +#define HSIZE 4119 /* The size of the hash table for symbols */ +#define MAXIDSIZE 10000 /* Largest symbol size, + in bytes excluding terminator. + Was 256 prior to 2.13.0, now just a sanity check. + */ + +/* The type of the do_xxxx functions. */ +/* These are the built-in R functions. */ +typedef SEXP (*CCODE)(SEXP, SEXP, SEXP, SEXP); + +/* Information for Deparsing Expressions */ +typedef enum { + PP_INVALID = 0, + PP_ASSIGN = 1, + PP_ASSIGN2 = 2, + PP_BINARY = 3, + PP_BINARY2 = 4, + PP_BREAK = 5, + PP_CURLY = 6, + PP_FOR = 7, + PP_FUNCALL = 8, + PP_FUNCTION = 9, + PP_IF = 10, + PP_NEXT = 11, + PP_PAREN = 12, + PP_RETURN = 13, + PP_SUBASS = 14, + PP_SUBSET = 15, + PP_WHILE = 16, + PP_UNARY = 17, + PP_DOLLAR = 18, + PP_FOREIGN = 19, + PP_REPEAT = 20 +} PPkind; + +typedef enum { + PREC_FN = 0, + PREC_EQ = 1, + PREC_LEFT = 2, + PREC_RIGHT = 3, + PREC_TILDE = 4, + PREC_OR = 5, + PREC_AND = 6, + PREC_NOT = 7, + PREC_COMPARE = 8, + PREC_SUM = 9, + PREC_PROD = 10, + PREC_PERCENT = 11, + PREC_COLON = 12, + PREC_SIGN = 13, + PREC_POWER = 14, + PREC_SUBSET = 15, + PREC_DOLLAR = 16, + PREC_NS = 17 +} PPprec; + +typedef struct { + PPkind kind; /* deparse kind */ + PPprec precedence; /* operator precedence */ + unsigned int rightassoc; /* right associative? */ +} PPinfo; + +/* The type definitions for the table of built-in functions. */ +/* This table can be found in ../main/names.c */ +typedef struct { + char *name; /* print name */ + CCODE cfun; /* c-code address */ + int code; /* offset within c-code */ + int eval; /* evaluate args? */ + int arity; /* function arity */ + PPinfo gram; /* pretty-print info */ +} FUNTAB; + +#ifdef USE_RINTERNALS +/* There is much more in Rinternals.h, including function versions + * of the Promise and Hashing groups. + */ + +/* Primitive Access Macros */ +#define PRIMOFFSET(x) ((x)->u.primsxp.offset) +#define SET_PRIMOFFSET(x,v) (((x)->u.primsxp.offset)=(v)) +#define PRIMFUN(x) (R_FunTab[(x)->u.primsxp.offset].cfun) +#define PRIMNAME(x) (R_FunTab[(x)->u.primsxp.offset].name) +#define PRIMVAL(x) (R_FunTab[(x)->u.primsxp.offset].code) +#define PRIMARITY(x) (R_FunTab[(x)->u.primsxp.offset].arity) +#define PPINFO(x) (R_FunTab[(x)->u.primsxp.offset].gram) +#define PRIMPRINT(x) (((R_FunTab[(x)->u.primsxp.offset].eval)/100)%10) +#define PRIMINTERNAL(x) (((R_FunTab[(x)->u.primsxp.offset].eval)%100)/10) + +/* Promise Access Macros */ +#define PRCODE(x) ((x)->u.promsxp.expr) +#define PRENV(x) ((x)->u.promsxp.env) +#define PRVALUE(x) ((x)->u.promsxp.value) +#define PRSEEN(x) ((x)->sxpinfo.gp) +#define SET_PRSEEN(x,v) (((x)->sxpinfo.gp)=(v)) + +/* Hashing Macros */ +#define HASHASH(x) ((x)->sxpinfo.gp & HASHASH_MASK) +#define HASHVALUE(x) TRUELENGTH(x) +#define SET_HASHASH(x,v) ((v) ? (((x)->sxpinfo.gp) |= HASHASH_MASK) : \ + (((x)->sxpinfo.gp) &= (~HASHASH_MASK))) +#define SET_HASHVALUE(x,v) SET_TRUELENGTH(x, v) + +/* Vector Heap Structure */ +typedef struct { + union { + SEXP backpointer; + double align; + } u; +} VECREC, *VECP; + +/* Vector Heap Macros */ +#define BACKPOINTER(v) ((v).u.backpointer) +#define BYTE2VEC(n) (((n)>0)?(((n)-1)/sizeof(VECREC)+1):0) +#define INT2VEC(n) (((n)>0)?(((n)*sizeof(int)-1)/sizeof(VECREC)+1):0) +#define FLOAT2VEC(n) (((n)>0)?(((n)*sizeof(double)-1)/sizeof(VECREC)+1):0) +#define COMPLEX2VEC(n) (((n)>0)?(((n)*sizeof(Rcomplex)-1)/sizeof(VECREC)+1):0) +#define PTR2VEC(n) (((n)>0)?(((n)*sizeof(SEXP)-1)/sizeof(VECREC)+1):0) + +/* Bindings */ +/* use the same bits (15 and 14) in symbols and bindings */ +#define ACTIVE_BINDING_MASK (1<<15) +#define BINDING_LOCK_MASK (1<<14) +#define SPECIAL_BINDING_MASK (ACTIVE_BINDING_MASK | BINDING_LOCK_MASK) +#define IS_ACTIVE_BINDING(b) ((b)->sxpinfo.gp & ACTIVE_BINDING_MASK) +#define BINDING_IS_LOCKED(b) ((b)->sxpinfo.gp & BINDING_LOCK_MASK) +#define SET_ACTIVE_BINDING_BIT(b) ((b)->sxpinfo.gp |= ACTIVE_BINDING_MASK) +#define LOCK_BINDING(b) ((b)->sxpinfo.gp |= BINDING_LOCK_MASK) +#define UNLOCK_BINDING(b) ((b)->sxpinfo.gp &= (~BINDING_LOCK_MASK)) + +#define BASE_SYM_CACHED_MASK (1<<13) +#define SET_BASE_SYM_CACHED(b) ((b)->sxpinfo.gp |= BASE_SYM_CACHED_MASK) +#define UNSET_BASE_SYM_CACHED(b) ((b)->sxpinfo.gp &= (~BASE_SYM_CACHED_MASK)) +#define BASE_SYM_CACHED(b) ((b)->sxpinfo.gp & BASE_SYM_CACHED_MASK) + +#define SPECIAL_SYMBOL_MASK (1<<12) +#define SET_SPECIAL_SYMBOL(b) ((b)->sxpinfo.gp |= SPECIAL_SYMBOL_MASK) +#define UNSET_SPECIAL_SYMBOL(b) ((b)->sxpinfo.gp &= (~SPECIAL_SYMBOL_MASK)) +#define IS_SPECIAL_SYMBOL(b) ((b)->sxpinfo.gp & SPECIAL_SYMBOL_MASK) +#define SET_NO_SPECIAL_SYMBOLS(b) ((b)->sxpinfo.gp |= SPECIAL_SYMBOL_MASK) +#define UNSET_NO_SPECIAL_SYMBOLS(b) ((b)->sxpinfo.gp &= (~SPECIAL_SYMBOL_MASK)) +#define NO_SPECIAL_SYMBOLS(b) ((b)->sxpinfo.gp & SPECIAL_SYMBOL_MASK) + +#else /* USE_RINTERNALS */ + +typedef struct VECREC *VECP; +int (PRIMOFFSET)(SEXP x); +void (SET_PRIMOFFSET)(SEXP x, int v); + +#define PRIMFUN(x) (R_FunTab[PRIMOFFSET(x)].cfun) +#define PRIMNAME(x) (R_FunTab[PRIMOFFSET(x)].name) +#define PRIMVAL(x) (R_FunTab[PRIMOFFSET(x)].code) +#define PRIMARITY(x) (R_FunTab[PRIMOFFSET(x)].arity) +#define PPINFO(x) (R_FunTab[PRIMOFFSET(x)].gram) +#define PRIMPRINT(x) (((R_FunTab[PRIMOFFSET(x)].eval)/100)%10) +#define PRIMINTERNAL(x) (((R_FunTab[PRIMOFFSET(x)].eval)%100)/10) + + +Rboolean (IS_ACTIVE_BINDING)(SEXP b); +Rboolean (BINDING_IS_LOCKED)(SEXP b); +void (SET_ACTIVE_BINDING_BIT)(SEXP b); +void (LOCK_BINDING)(SEXP b); +void (UNLOCK_BINDING)(SEXP b); + +void (SET_BASE_SYM_CACHED)(SEXP b); +void (UNSET_BASE_SYM_CACHED)(SEXP b); +Rboolean (BASE_SYM_CACHED)(SEXP b); + +void (SET_SPECIAL_SYMBOL)(SEXP b); +void (UNSET_SPECIAL_SYMBOL)(SEXP b); +Rboolean (IS_SPECIAL_SYMBOL)(SEXP b); +void (SET_NO_SPECIAL_SYMBOLS)(SEXP b); +void (UNSET_NO_SPECIAL_SYMBOLS)(SEXP b); +Rboolean (NO_SPECIAL_SYMBOLS)(SEXP b); + +#endif /* USE_RINTERNALS */ + +#define TYPED_STACK +#ifdef TYPED_STACK +/* The typed stack's entries consist of a tag and a union. An entry + can represent a standard SEXP value (tag = 0) or an unboxed scalar + value. For now real, integer, and logical values are supported. It + would in principle be possible to support complex scalars and short + scalar strings, but it isn't clear if this is worth while. + + In addition to unboxed values the typed stack can hold partially + evaluated or incomplete allocated values. For now this is only used + for holding a short representation of an integer sequence as produce + by the colon operator, seq_len, or seq_along, and as consumed by + compiled 'for' loops. This could be used more extensively in the + future. +*/ +typedef struct { + int tag; + union { + int ival; + double dval; + SEXP sxpval; + } u; +} R_bcstack_t; +# define PARTIALSXP_MASK (~255) +# define IS_PARTIAL_SXP_TAG(x) ((x) & PARTIALSXP_MASK) +# define RAWMEM_TAG 254 +#else +typedef SEXP R_bcstack_t; +#endif +#ifdef BC_INT_STACK +typedef union { void *p; int i; } IStackval; +#endif + +#ifdef R_USE_SIGNALS +/* Stack entry for pending promises */ +typedef struct RPRSTACK { + SEXP promise; + struct RPRSTACK *next; +} RPRSTACK; + +/* Evaluation Context Structure */ +typedef struct RCNTXT { + struct RCNTXT *nextcontext; /* The next context up the chain */ + int callflag; /* The context "type" */ + JMP_BUF cjmpbuf; /* C stack and register information */ + int cstacktop; /* Top of the pointer protection stack */ + int evaldepth; /* evaluation depth at inception */ + SEXP promargs; /* Promises supplied to closure */ + SEXP callfun; /* The closure called */ + SEXP sysparent; /* environment the closure was called from */ + SEXP call; /* The call that effected this context*/ + SEXP cloenv; /* The environment */ + SEXP conexit; /* Interpreted "on.exit" code */ + void (*cend)(void *); /* C "on.exit" thunk */ + void *cenddata; /* data for C "on.exit" thunk */ + void *vmax; /* top of R_alloc stack */ + int intsusp; /* interrupts are suspended */ + int gcenabled; /* R_GCEnabled value */ + int bcintactive; /* R_BCIntActive value */ + SEXP bcbody; /* R_BCbody value */ + void* bcpc; /* R_BCpc value */ + SEXP handlerstack; /* condition handler stack */ + SEXP restartstack; /* stack of available restarts */ + struct RPRSTACK *prstack; /* stack of pending promises */ + R_bcstack_t *nodestack; +#ifdef BC_INT_STACK + IStackval *intstack; +#endif + SEXP srcref; /* The source line in effect */ + int browserfinish; /* should browser finish this context without + stopping */ + SEXP returnValue; /* only set during on.exit calls */ + struct RCNTXT *jumptarget; /* target for a continuing jump */ + int jumpmask; /* associated LONGJMP argument */ +} RCNTXT, *context; + +/* The Various Context Types. + + * In general the type is a bitwise OR of the values below. + * Note that CTXT_LOOP is already the or of CTXT_NEXT and CTXT_BREAK. + * Only functions should have the third bit turned on; + * this allows us to move up the context stack easily + * with either RETURN's or GENERIC's or RESTART's. + * If you add a new context type for functions make sure + * CTXT_NEWTYPE & CTXT_FUNCTION > 0 + */ +enum { + CTXT_TOPLEVEL = 0, + CTXT_NEXT = 1, + CTXT_BREAK = 2, + CTXT_LOOP = 3, /* break OR next target */ + CTXT_FUNCTION = 4, + CTXT_CCODE = 8, + CTXT_RETURN = 12, + CTXT_BROWSER = 16, + CTXT_GENERIC = 20, + CTXT_RESTART = 32, + CTXT_BUILTIN = 64 /* used in profiling */ +}; + +/* +TOP 0 0 0 0 0 0 = 0 +NEX 1 0 0 0 0 0 = 1 +BRE 0 1 0 0 0 0 = 2 +LOO 1 1 0 0 0 0 = 3 +FUN 0 0 1 0 0 0 = 4 +CCO 0 0 0 1 0 0 = 8 +BRO 0 0 0 0 1 0 = 16 +RET 0 0 1 1 0 0 = 12 +GEN 0 0 1 0 1 0 = 20 +RES 0 0 0 0 0 0 1 = 32 +BUI 0 0 0 0 0 0 0 1 = 64 +*/ + +#define IS_RESTART_BIT_SET(flags) ((flags) & CTXT_RESTART) +#define SET_RESTART_BIT_ON(flags) (flags |= CTXT_RESTART) +#define SET_RESTART_BIT_OFF(flags) (flags &= ~CTXT_RESTART) +#endif + +/* Miscellaneous Definitions */ +#define streql(s, t) (!strcmp((s), (t))) + +/* Arithmetic and Relation Operators */ +typedef enum { + PLUSOP = 1, + MINUSOP, + TIMESOP, + DIVOP, + POWOP, + MODOP, + IDIVOP +} ARITHOP_TYPE; + +typedef enum { + EQOP = 1, + NEOP, + LTOP, + LEOP, + GEOP, + GTOP +} RELOP_TYPE; + +typedef enum { + MATPROD_DEFAULT = 1, + MATPROD_INTERNAL, + MATPROD_BLAS, + MATPROD_DEFAULT_SIMD /* experimental */ +} MATPROD_TYPE; + +/* File Handling */ +/* +#define R_EOF 65535 +*/ +#define R_EOF -1 + + +/*--- Global Variables ---------------------------------------------------- */ + +/* Defined and initialized in names.c (not main.c) :*/ +#ifndef __R_Names__ +extern +#endif +FUNTAB R_FunTab[]; /* Built in functions */ + + +#include <R_ext/libextern.h> + +#ifdef __MAIN__ +# define INI_as(v) = v +#define extern0 attribute_hidden +#else +# define INI_as(v) +#define extern0 extern +#endif + +LibExtern SEXP R_SrcfileSymbol; /* "srcfile" */ +LibExtern SEXP R_SrcrefSymbol; /* "srcref" */ + + +LibExtern Rboolean R_interrupts_suspended INI_as(FALSE); +LibExtern int R_interrupts_pending INI_as(0); + +/* R Home Directory */ +LibExtern char *R_Home; /* Root of the R tree */ + +/* Memory Management */ +extern0 R_size_t R_NSize INI_as(R_NSIZE);/* Size of cons cell heap */ +extern0 R_size_t R_VSize INI_as(R_VSIZE);/* Size of the vector heap */ +extern0 int R_GCEnabled INI_as(1); +extern0 int R_in_gc INI_as(0); +extern0 int R_BCIntActive INI_as(0); /* bcEval called more recently than + eval */ +extern0 void* R_BCpc INI_as(NULL);/* current byte code instruction */ +extern0 SEXP R_BCbody INI_as(NULL); /* current byte code object */ +extern0 SEXP R_NHeap; /* Start of the cons cell heap */ +extern0 SEXP R_FreeSEXP; /* Cons cell free list */ +extern0 R_size_t R_Collected; /* Number of free cons cells (after gc) */ +extern0 int R_Is_Running; /* for Windows memory manager */ + +/* The Pointer Protection Stack */ +LibExtern int R_PPStackSize INI_as(R_PPSSIZE); /* The stack size (elements) */ +LibExtern int R_PPStackTop; /* The top of the stack */ +LibExtern SEXP* R_PPStack; /* The pointer protection stack */ + +/* Evaluation Environment */ +extern0 SEXP R_CurrentExpr; /* Currently evaluating expression */ +extern0 SEXP R_ReturnedValue; /* Slot for return-ing values */ +extern0 SEXP* R_SymbolTable; /* The symbol table */ +#ifdef R_USE_SIGNALS +extern0 RCNTXT R_Toplevel; /* Storage for the toplevel context */ +extern0 RCNTXT* R_ToplevelContext; /* The toplevel context */ +LibExtern RCNTXT* R_GlobalContext; /* The global context */ +extern0 RCNTXT* R_SessionContext; /* The session toplevel context */ +extern0 RCNTXT* R_ExitContext; /* The active context for on.exit processing */ +#endif +extern Rboolean R_Visible; /* Value visibility flag */ +extern0 int R_EvalDepth INI_as(0); /* Evaluation recursion depth */ +extern0 int R_BrowseLines INI_as(0); /* lines/per call in browser */ + +extern0 int R_Expressions INI_as(5000); /* options(expressions) */ +extern0 int R_Expressions_keep INI_as(5000); /* options(expressions) */ +extern0 Rboolean R_KeepSource INI_as(FALSE); /* options(keep.source) */ +extern0 Rboolean R_CBoundsCheck INI_as(FALSE); /* options(CBoundsCheck) */ +extern0 MATPROD_TYPE R_Matprod INI_as(MATPROD_DEFAULT); /* options(matprod) */ +extern0 int R_WarnLength INI_as(1000); /* Error/warning max length */ +extern0 int R_nwarnings INI_as(50); +extern uintptr_t R_CStackLimit INI_as((uintptr_t)-1); /* C stack limit */ +extern uintptr_t R_OldCStackLimit INI_as((uintptr_t)0); /* Old value while + handling overflow */ +extern uintptr_t R_CStackStart INI_as((uintptr_t)-1); /* Initial stack address */ +extern int R_CStackDir INI_as(1); /* C stack direction */ + +#ifdef R_USE_SIGNALS +extern0 struct RPRSTACK *R_PendingPromises INI_as(NULL); /* Pending promise stack */ +#endif + +/* File Input/Output */ +LibExtern Rboolean R_Interactive INI_as(TRUE); /* TRUE during interactive use*/ +extern0 Rboolean R_Quiet INI_as(FALSE); /* Be as quiet as possible */ +extern Rboolean R_Slave INI_as(FALSE); /* Run as a slave process */ +extern0 Rboolean R_Verbose INI_as(FALSE); /* Be verbose */ +/* extern int R_Console; */ /* Console active flag */ +/* IoBuffer R_ConsoleIob; : --> ./IOStuff.h */ +/* R_Consolefile is used in the internet module */ +extern FILE* R_Consolefile INI_as(NULL); /* Console output file */ +extern FILE* R_Outputfile INI_as(NULL); /* Output file */ +extern0 int R_ErrorCon INI_as(2); /* Error connection */ +LibExtern char *R_TempDir INI_as(NULL); /* Name of per-session dir */ +extern0 char *Sys_TempDir INI_as(NULL); /* Name of per-session dir + if set by R itself */ +extern0 char R_StdinEnc[31] INI_as(""); /* Encoding assumed for stdin */ + +/* Objects Used In Parsing */ +LibExtern int R_ParseError INI_as(0); /* Line where parse error occurred */ +extern0 int R_ParseErrorCol; /* Column of start of token where parse error occurred */ +extern0 SEXP R_ParseErrorFile; /* Source file where parse error was seen. Either a + STRSXP or (when keeping srcrefs) a SrcFile ENVSXP */ +#define PARSE_ERROR_SIZE 256 /* Parse error messages saved here */ +LibExtern char R_ParseErrorMsg[PARSE_ERROR_SIZE] INI_as(""); +#define PARSE_CONTEXT_SIZE 256 /* Recent parse context kept in a circular buffer */ +LibExtern char R_ParseContext[PARSE_CONTEXT_SIZE] INI_as(""); +LibExtern int R_ParseContextLast INI_as(0); /* last character in context buffer */ +LibExtern int R_ParseContextLine; /* Line in file of the above */ + +/* Image Dump/Restore */ +extern int R_DirtyImage INI_as(0); /* Current image dirty */ + +/* History */ +LibExtern char *R_HistoryFile; /* Name of the history file */ +LibExtern int R_HistorySize; /* Size of the history file */ +LibExtern int R_RestoreHistory; /* restore the history file? */ +extern void R_setupHistory(void); + +/* Warnings/Errors */ +extern0 int R_CollectWarnings INI_as(0); /* the number of warnings */ +extern0 SEXP R_Warnings; /* the warnings and their calls */ +extern0 int R_ShowErrorMessages INI_as(1); /* show error messages? */ +extern0 SEXP R_HandlerStack; /* Condition handler stack */ +extern0 SEXP R_RestartStack; /* Stack of available restarts */ +extern0 Rboolean R_warn_partial_match_args INI_as(FALSE); +extern0 Rboolean R_warn_partial_match_dollar INI_as(FALSE); +extern0 Rboolean R_warn_partial_match_attr INI_as(FALSE); +extern0 Rboolean R_ShowWarnCalls INI_as(FALSE); +extern0 Rboolean R_ShowErrorCalls INI_as(FALSE); +extern0 int R_NShowCalls INI_as(50); + +LibExtern Rboolean utf8locale INI_as(FALSE); /* is this a UTF-8 locale? */ +LibExtern Rboolean mbcslocale INI_as(FALSE); /* is this a MBCS locale? */ +extern0 Rboolean latin1locale INI_as(FALSE); /* is this a Latin-1 locale? */ +#ifdef Win32 +LibExtern unsigned int localeCP INI_as(1252); /* the locale's codepage */ +extern0 Rboolean WinUTF8out INI_as(FALSE); /* Use UTF-8 for output */ +extern0 void WinCheckUTF8(void); +#endif + +extern char* OutDec INI_as("."); /* decimal point used for output */ +extern0 Rboolean R_DisableNLinBrowser INI_as(FALSE); +extern0 char R_BrowserLastCommand INI_as('n'); + +/* Initialization of the R environment when it is embedded */ +extern int Rf_initEmbeddedR(int argc, char **argv); + +/* GUI type */ + +extern char *R_GUIType INI_as("unknown"); +extern Rboolean R_isForkedChild INI_as(FALSE); /* was this forked? */ + +extern0 double cpuLimit INI_as(-1.0); +extern0 double cpuLimit2 INI_as(-1.0); +extern0 double cpuLimitValue INI_as(-1.0); +extern0 double elapsedLimit INI_as(-1.0); +extern0 double elapsedLimit2 INI_as(-1.0); +extern0 double elapsedLimitValue INI_as(-1.0); + +void resetTimeLimits(void); + +#define R_BCNODESTACKSIZE 200000 +extern0 R_bcstack_t *R_BCNodeStackBase, *R_BCNodeStackTop, *R_BCNodeStackEnd; +#ifdef BC_INT_STACK +# define R_BCINTSTACKSIZE 10000 +extern0 IStackval *R_BCIntStackBase, *R_BCIntStackTop, *R_BCIntStackEnd; +#endif +extern0 int R_jit_enabled INI_as(0); /* has to be 0 during R startup */ +extern0 int R_compile_pkgs INI_as(0); +extern0 int R_check_constants INI_as(0); +extern0 int R_disable_bytecode INI_as(0); +extern SEXP R_cmpfun(SEXP); +extern SEXP R_cmpfun1(SEXP); /* unconditional fresh compilation */ +extern void R_init_jit_enabled(void); +extern void R_initAssignSymbols(void); +#ifdef R_USE_SIGNALS +extern SEXP R_findBCInterpreterSrcref(RCNTXT*); +#endif +extern SEXP R_getCurrentSrcref(); +extern SEXP R_getBCInterpreterExpression(); + +LibExtern SEXP R_CachedScalarReal INI_as(NULL); +LibExtern SEXP R_CachedScalarInteger INI_as(NULL); + +LibExtern int R_num_math_threads INI_as(1); +LibExtern int R_max_num_math_threads INI_as(1); + +/* Pointer type and utilities for dispatch in the methods package */ +typedef SEXP (*R_stdGen_ptr_t)(SEXP, SEXP, SEXP); /* typedef */ +//R_stdGen_ptr_t R_get_standardGeneric_ptr(void); /* get method */ +R_stdGen_ptr_t R_set_standardGeneric_ptr(R_stdGen_ptr_t, SEXP); /* set method */ +LibExtern SEXP R_MethodsNamespace; +SEXP R_deferred_default_method(void); +SEXP R_set_prim_method(SEXP fname, SEXP op, SEXP code_vec, SEXP fundef, + SEXP mlist); +SEXP do_set_prim_method(SEXP op, const char *code_string, SEXP fundef, + SEXP mlist); +void R_set_quick_method_check(R_stdGen_ptr_t); +SEXP R_primitive_methods(SEXP op); +SEXP R_primitive_generic(SEXP op); + +/* smallest decimal exponent, needed in format.c, set in Init_R_Machine */ +extern0 int R_dec_min_exponent INI_as(-308); + +/* structure for caching machine accuracy values */ +typedef struct { + int ibeta, it, irnd, ngrd, machep, negep, iexp, minexp, maxexp; + double eps, epsneg, xmin, xmax; +} AccuracyInfo; + +LibExtern AccuracyInfo R_AccuracyInfo; + +extern unsigned int max_contour_segments INI_as(25000); + +/* used in package utils */ +extern Rboolean known_to_be_latin1 INI_as(FALSE); +extern0 Rboolean known_to_be_utf8 INI_as(FALSE); + +/* pre-allocated boolean values */ +LibExtern SEXP R_TrueValue INI_as(NULL); +LibExtern SEXP R_FalseValue INI_as(NULL); +LibExtern SEXP R_LogicalNAValue INI_as(NULL); + +/* for PCRE as from R 3.4.0 */ +extern0 Rboolean R_PCRE_use_JIT INI_as(TRUE); +extern0 int R_PCRE_study INI_as(10); +extern0 int R_PCRE_limit_recursion; + + +#ifdef __MAIN__ +# undef extern +# undef extern0 +# undef LibExtern +#endif +#undef INI_as + +#define checkArity(a,b) Rf_checkArityCall(a,b,call) + +/*--- FUNCTIONS ------------------------------------------------------ */ + +# define allocCharsxp Rf_allocCharsxp +# define asVecSize Rf_asVecSize +# define begincontext Rf_begincontext +# define BindDomain Rf_BindDomain +# define check_stack_balance Rf_check_stack_balance +# define check1arg Rf_check1arg +# define CheckFormals Rf_CheckFormals +# define CleanEd Rf_CleanEd +# define CoercionWarning Rf_CoercionWarning +# define ComplexFromInteger Rf_ComplexFromInteger +# define ComplexFromLogical Rf_ComplexFromLogical +# define ComplexFromReal Rf_ComplexFromReal +# define ComplexFromString Rf_ComplexFromString +# define copyMostAttribNoTs Rf_copyMostAttribNoTs +# define createS3Vars Rf_createS3Vars +# define currentTime Rf_currentTime +# define CustomPrintValue Rf_CustomPrintValue +# define DataFrameClass Rf_DataFrameClass +# define ddfindVar Rf_ddfindVar +# define deparse1 Rf_deparse1 +# define deparse1w Rf_deparse1w +# define deparse1line Rf_deparse1line +# define deparse1s Rf_deparse1s +# define DispatchGroup Rf_DispatchGroup +# define DispatchOrEval Rf_DispatchOrEval +# define DispatchAnyOrEval Rf_DispatchAnyOrEval +# define dynamicfindVar Rf_dynamicfindVar +# define EncodeChar Rf_EncodeChar +# define EncodeRaw Rf_EncodeRaw +# define EncodeReal2 Rf_EncodeReal2 +# define EncodeString Rf_EncodeString +# define EnsureString Rf_EnsureString +# define endcontext Rf_endcontext +# define errorcall_cpy Rf_errorcall_cpy +# define ErrorMessage Rf_ErrorMessage +# define evalList Rf_evalList +# define evalListKeepMissing Rf_evalListKeepMissing +# define factorsConform Rf_factorsConform +# define findcontext Rf_findcontext +# define findVar1 Rf_findVar1 +# define FrameClassFix Rf_FrameClassFix +# define framedepth Rf_framedepth +# define frameSubscript Rf_frameSubscript +# define get1index Rf_get1index +# define GetOptionCutoff Rf_GetOptionCutoff +# define getVar Rf_getVar +# define getVarInFrame Rf_getVarInFrame +# define InitArithmetic Rf_InitArithmetic +# define InitConnections Rf_InitConnections +# define InitEd Rf_InitEd +# define InitFunctionHashing Rf_InitFunctionHashing +# define InitBaseEnv Rf_InitBaseEnv +# define InitGlobalEnv Rf_InitGlobalEnv +# define InitGraphics Rf_InitGraphics +# define InitMemory Rf_InitMemory +# define InitNames Rf_InitNames +# define InitOptions Rf_InitOptions +# define InitStringHash Rf_InitStringHash +# define InitS3DefaultTypes Rf_InitS3DefaultTypes +# define InitTempDir Rf_InitTempDir +# define InitTypeTables Rf_InitTypeTables +# define initStack Rf_initStack +# define IntegerFromComplex Rf_IntegerFromComplex +# define IntegerFromLogical Rf_IntegerFromLogical +# define IntegerFromReal Rf_IntegerFromReal +# define IntegerFromString Rf_IntegerFromString +# define internalTypeCheck Rf_internalTypeCheck +# define isValidName Rf_isValidName +# define installTrChar Rf_installTrChar +# define ItemName Rf_ItemName +# define jump_to_toplevel Rf_jump_to_toplevel +# define KillAllDevices Rf_KillAllDevices +# define levelsgets Rf_levelsgets +# define LogicalFromComplex Rf_LogicalFromComplex +# define LogicalFromInteger Rf_LogicalFromInteger +# define LogicalFromReal Rf_LogicalFromReal +# define LogicalFromString Rf_LogicalFromString +# define mainloop Rf_mainloop +# define makeSubscript Rf_makeSubscript +# define markKnown Rf_markKnown +# define mat2indsub Rf_mat2indsub +# define matchArg Rf_matchArg +# define matchArgExact Rf_matchArgExact +# define matchArgs Rf_matchArgs +# define matchPar Rf_matchPar +# define Mbrtowc Rf_mbrtowc +# define mbtoucs Rf_mbtoucs +# define mbcsToUcs2 Rf_mbcsToUcs2 +# define memtrace_report Rf_memtrace_report +# define mkCLOSXP Rf_mkCLOSXP +# define mkFalse Rf_mkFalse +# define mkPROMISE Rf_mkPROMISE +# define mkQUOTE Rf_mkQUOTE +# define mkSYMSXP Rf_mkSYMSXP +# define mkTrue Rf_mkTrue +# define NewEnvironment Rf_NewEnvironment +# define OneIndex Rf_OneIndex +# define onintr Rf_onintr +# define onintrNoResume Rf_onintrNoResume +# define onsigusr1 Rf_onsigusr1 +# define onsigusr2 Rf_onsigusr2 +# define parse Rf_parse +# define patchArgsByActuals Rf_patchArgsByActuals +# define PrintDefaults Rf_PrintDefaults +# define PrintGreeting Rf_PrintGreeting +# define PrintValueEnv Rf_PrintValueEnv +# define PrintValueRec Rf_PrintValueRec +# define PrintVersion Rf_PrintVersion +# define PrintVersion_part_1 Rf_PrintVersion_part_1 +# define PrintVersionString Rf_PrintVersionString +# define PrintWarnings Rf_PrintWarnings +# define promiseArgs Rf_promiseArgs +# define RealFromComplex Rf_RealFromComplex +# define RealFromInteger Rf_RealFromInteger +# define RealFromLogical Rf_RealFromLogical +# define RealFromString Rf_RealFromString +# define Seql Rf_Seql +# define sexptype2char Rf_sexptype2char +# define Scollate Rf_Scollate +# define sortVector Rf_sortVector +# define SrcrefPrompt Rf_SrcrefPrompt +# define ssort Rf_ssort +# define StringFromComplex Rf_StringFromComplex +# define StringFromInteger Rf_StringFromInteger +# define StringFromLogical Rf_StringFromLogical +# define StringFromReal Rf_StringFromReal +# define strIsASCII Rf_strIsASCII +# define StrToInternal Rf_StrToInternal +# define strmat2intmat Rf_strmat2intmat +# define substituteList Rf_substituteList +# define TimeToSeed Rf_TimeToSeed +# define tsConform Rf_tsConform +# define tspgets Rf_tspgets +# define type2symbol Rf_type2symbol +# define unbindVar Rf_unbindVar +# define usemethod Rf_usemethod +# define ucstomb Rf_ucstomb +# define ucstoutf8 Rf_ucstoutf8 +# define utf8toucs Rf_utf8toucs +# define utf8towcs Rf_utf8towcs +# define vectorIndex Rf_vectorIndex +# define warningcall Rf_warningcall +# define WarningMessage Rf_WarningMessage +# define wcstoutf8 Rf_wcstoutf8 +# define wtransChar Rf_wtransChar +# define yychar Rf_yychar +# define yylval Rf_yylval +# define yynerrs Rf_yynerrs +# define yyparse Rf_yyparse + +/* Platform Dependent Gui Hooks */ + +#define R_CONSOLE 1 +#define R_FILE 2 +#define R_TEXT 3 + +/* The maximum length of input line which will be asked for, + in bytes, including the terminator */ +#define CONSOLE_BUFFER_SIZE 4096 +int R_ReadConsole(const char *, unsigned char *, int, int); +void R_WriteConsole(const char *, int); /* equivalent to R_WriteConsoleEx(a, b, 0) */ +void R_WriteConsoleEx(const char *, int, int); +void R_ResetConsole(void); +void R_FlushConsole(void); +void R_ClearerrConsole(void); +void R_Busy(int); +int R_ShowFiles(int, const char **, const char **, const char *, + Rboolean, const char *); +int R_EditFiles(int, const char **, const char **, const char *); +int R_ChooseFile(int, char *, int); +char *R_HomeDir(void); +Rboolean R_FileExists(const char *); +Rboolean R_HiddenFile(const char *); +double R_FileMtime(const char *); +int R_GetFDLimit(); + +/* environment cell access */ +typedef struct { SEXP cell; } R_varloc_t; /* use struct to prevent casting */ +#define R_VARLOC_IS_NULL(loc) ((loc).cell == NULL) +R_varloc_t R_findVarLocInFrame(SEXP, SEXP); +SEXP R_GetVarLocValue(R_varloc_t); +SEXP R_GetVarLocSymbol(R_varloc_t); +Rboolean R_GetVarLocMISSING(R_varloc_t); +void R_SetVarLocValue(R_varloc_t, SEXP); + +/* deparse option bits: change do_dump if more are added */ + +#define KEEPINTEGER 1 +#define QUOTEEXPRESSIONS 2 +#define SHOWATTRIBUTES 4 +#define USESOURCE 8 +#define WARNINCOMPLETE 16 +#define DELAYPROMISES 32 +#define KEEPNA 64 +#define S_COMPAT 128 +#define HEXNUMERIC 256 +#define DIGITS16 512 +/* common combinations of the above */ +#define SIMPLEDEPARSE 0 +#define DEFAULTDEPARSE 65 /* KEEPINTEGER | KEEPNA, used for calls */ +#define FORSOURCING 95 /* not DELAYPROMISES, used in edit.c */ + +/* Coercion functions */ +int Rf_LogicalFromString(SEXP, int*); +int Rf_IntegerFromString(SEXP, int*); +double Rf_RealFromString(SEXP, int*); +Rcomplex Rf_ComplexFromString(SEXP, int*); +SEXP Rf_StringFromLogical(int, int*); +SEXP Rf_StringFromInteger(int, int*); +SEXP Rf_StringFromReal(double, int*); +SEXP Rf_StringFromComplex(Rcomplex, int*); +SEXP Rf_EnsureString(SEXP); + +/* Other Internally Used Functions */ + +SEXP Rf_allocCharsxp(R_len_t); +SEXP Rf_append(SEXP, SEXP); /* apparently unused now */ +R_xlen_t asVecSize(SEXP x); +void check1arg(SEXP, SEXP, const char *); +void Rf_checkArityCall(SEXP, SEXP, SEXP); +void CheckFormals(SEXP); +void R_check_locale(void); +void check_stack_balance(SEXP op, int save); +void CleanEd(void); +void copyMostAttribNoTs(SEXP, SEXP); +SEXP createS3Vars(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP); +void CustomPrintValue(SEXP, SEXP); +double currentTime(void); +void DataFrameClass(SEXP); +SEXP ddfindVar(SEXP, SEXP); +SEXP deparse1(SEXP,Rboolean,int); +SEXP deparse1w(SEXP,Rboolean,int); +SEXP deparse1line(SEXP,Rboolean); +SEXP deparse1s(SEXP call); +int DispatchAnyOrEval(SEXP, SEXP, const char *, SEXP, SEXP, SEXP*, int, int); +int DispatchOrEval(SEXP, SEXP, const char *, SEXP, SEXP, SEXP*, int, int); +int DispatchGroup(const char *, SEXP,SEXP,SEXP,SEXP,SEXP*); +R_xlen_t dispatch_xlength(SEXP, SEXP, SEXP); +R_len_t dispatch_length(SEXP, SEXP, SEXP); +SEXP dispatch_subset2(SEXP, R_xlen_t, SEXP, SEXP); +SEXP duplicated(SEXP, Rboolean); +R_xlen_t any_duplicated(SEXP, Rboolean); +R_xlen_t any_duplicated3(SEXP, SEXP, Rboolean); +SEXP evalList(SEXP, SEXP, SEXP, int); +SEXP evalListKeepMissing(SEXP, SEXP); +int factorsConform(SEXP, SEXP); +void NORET findcontext(int, SEXP, SEXP); +SEXP findVar1(SEXP, SEXP, SEXPTYPE, int); +void FrameClassFix(SEXP); +SEXP frameSubscript(int, SEXP, SEXP); +R_xlen_t get1index(SEXP, SEXP, R_xlen_t, int, int, SEXP); +int GetOptionCutoff(void); +SEXP getVar(SEXP, SEXP); +SEXP getVarInFrame(SEXP, SEXP); +void InitArithmetic(void); +void InitConnections(void); +void InitEd(void); +void InitFunctionHashing(void); +void InitBaseEnv(void); +void InitGlobalEnv(void); +Rboolean R_current_trace_state(void); +Rboolean R_current_debug_state(void); +Rboolean R_has_methods(SEXP); +void R_InitialData(void); +SEXP R_possible_dispatch(SEXP, SEXP, SEXP, SEXP, Rboolean); +Rboolean inherits2(SEXP, const char *); +void InitGraphics(void); +void InitMemory(void); +void InitNames(void); +void InitOptions(void); +void InitStringHash(void); +void Init_R_Variables(SEXP); +void InitTempDir(void); +void InitTypeTables(void); +void initStack(void); +void InitS3DefaultTypes(void); +void internalTypeCheck(SEXP, SEXP, SEXPTYPE); +Rboolean isMethodsDispatchOn(void); +int isValidName(const char *); +void NORET jump_to_toplevel(void); +void KillAllDevices(void); +SEXP levelsgets(SEXP, SEXP); +void mainloop(void); +SEXP makeSubscript(SEXP, SEXP, R_xlen_t *, SEXP); +SEXP markKnown(const char *, SEXP); +SEXP mat2indsub(SEXP, SEXP, SEXP); +SEXP matchArg(SEXP, SEXP*); +SEXP matchArgExact(SEXP, SEXP*); +SEXP matchArgs(SEXP, SEXP, SEXP); +SEXP matchPar(const char *, SEXP*); +void memtrace_report(void *, void *); +SEXP mkCLOSXP(SEXP, SEXP, SEXP); +SEXP mkFalse(void); +SEXP mkPRIMSXP (int, int); +SEXP mkPROMISE(SEXP, SEXP); +SEXP R_mkEVPROMISE(SEXP, SEXP); +SEXP R_mkEVPROMISE_NR(SEXP, SEXP); +SEXP mkQUOTE(SEXP); +SEXP mkSYMSXP(SEXP, SEXP); +SEXP mkTrue(void); +SEXP NewEnvironment(SEXP, SEXP, SEXP); +void onintr(void); +void onintrNoResume(void); +RETSIGTYPE onsigusr1(int); +RETSIGTYPE onsigusr2(int); +R_xlen_t OneIndex(SEXP, SEXP, R_xlen_t, int, SEXP*, int, SEXP); +SEXP parse(FILE*, int); +SEXP patchArgsByActuals(SEXP, SEXP, SEXP); +void PrintDefaults(void); +void PrintGreeting(void); +void PrintValueEnv(SEXP, SEXP); +void PrintValueRec(SEXP, SEXP); +void PrintVersion(char *, size_t len); +void PrintVersion_part_1(char *, size_t len); +void PrintVersionString(char *, size_t len); +void PrintWarnings(void); +void process_site_Renviron(void); +void process_system_Renviron(void); +void process_user_Renviron(void); +SEXP promiseArgs(SEXP, SEXP); +void Rcons_vprintf(const char *, va_list); +SEXP R_data_class(SEXP , Rboolean); +SEXP R_data_class2(SEXP); +char *R_LibraryFileName(const char *, char *, size_t); +SEXP R_LoadFromFile(FILE*, int); +SEXP R_NewHashedEnv(SEXP, SEXP); +extern int R_Newhashpjw(const char *); +FILE* R_OpenLibraryFile(const char *); +SEXP R_Primitive(const char *); +void R_RestoreGlobalEnv(void); +void R_RestoreGlobalEnvFromFile(const char *, Rboolean); +void R_SaveGlobalEnv(void); +void R_SaveGlobalEnvToFile(const char *); +void R_SaveToFile(SEXP, FILE*, int); +void R_SaveToFileV(SEXP, FILE*, int, int); +Rboolean R_seemsOldStyleS4Object(SEXP object); +int R_SetOptionWarn(int); +int R_SetOptionWidth(int); +void R_Suicide(const char *); +void R_getProcTime(double *data); +int R_isMissing(SEXP symbol, SEXP rho); +const char *sexptype2char(SEXPTYPE type); +void sortVector(SEXP, Rboolean); +void SrcrefPrompt(const char *, SEXP); +void ssort(SEXP*,int); +int StrToInternal(const char *); +SEXP strmat2intmat(SEXP, SEXP, SEXP); +SEXP substituteList(SEXP, SEXP); +unsigned int TimeToSeed(void); +Rboolean tsConform(SEXP,SEXP); +SEXP tspgets(SEXP, SEXP); +SEXP type2symbol(SEXPTYPE); +void unbindVar(SEXP, SEXP); +#ifdef ALLOW_OLD_SAVE +void unmarkPhase(void); +#endif +SEXP R_LookupMethod(SEXP, SEXP, SEXP, SEXP); +int usemethod(const char *, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP*); +SEXP vectorIndex(SEXP, SEXP, int, int, int, SEXP, Rboolean); + +#ifdef R_USE_SIGNALS +void begincontext(RCNTXT*, int, SEXP, SEXP, SEXP, SEXP, SEXP); +SEXP dynamicfindVar(SEXP, RCNTXT*); +void endcontext(RCNTXT*); +int framedepth(RCNTXT*); +void R_InsertRestartHandlers(RCNTXT *, const char *); +void NORET R_JumpToContext(RCNTXT *, int, SEXP); +SEXP R_syscall(int,RCNTXT*); +int R_sysparent(int,RCNTXT*); +SEXP R_sysframe(int,RCNTXT*); +SEXP R_sysfunction(int,RCNTXT*); + +void R_run_onexits(RCNTXT *); +void NORET R_jumpctxt(RCNTXT *, int, SEXP); +#endif + +/* ../main/bind.c */ +SEXP ItemName(SEXP, R_xlen_t); + +/* ../main/errors.c : */ +void NORET errorcall_cpy(SEXP, const char *, ...); +void NORET ErrorMessage(SEXP, int, ...); +void WarningMessage(SEXP, R_WARNING, ...); +SEXP R_GetTraceback(int); + +R_size_t R_GetMaxVSize(void); +void R_SetMaxVSize(R_size_t); +R_size_t R_GetMaxNSize(void); +void R_SetMaxNSize(R_size_t); +R_size_t R_Decode2Long(char *p, int *ierr); +void R_SetPPSize(R_size_t); + +/* ../main/devices.c, used in memory.c, gnuwin32/extra.c */ +#define R_MaxDevices 64 + +/* ../../main/printutils.c : */ +typedef enum { + Rprt_adj_left = 0, + Rprt_adj_right = 1, + Rprt_adj_centre = 2, + Rprt_adj_none = 3 +} Rprt_adj; + +int Rstrlen(SEXP, int); +const char *EncodeRaw(Rbyte, const char *); +const char *EncodeString(SEXP, int, int, Rprt_adj); +const char *EncodeReal2(double, int, int, int); +const char *EncodeChar(SEXP); + + +/* main/sort.c */ +void orderVector1(int *indx, int n, SEXP key, Rboolean nalast, + Rboolean decreasing, SEXP rho); + +/* main/subset.c */ +SEXP R_subset3_dflt(SEXP, SEXP, SEXP); + +/* main/subassign.c */ +SEXP R_subassign3_dflt(SEXP, SEXP, SEXP, SEXP); + +#include <wchar.h> + +/* main/util.c */ +void NORET UNIMPLEMENTED_TYPE(const char *s, SEXP x); +void NORET UNIMPLEMENTED_TYPEt(const char *s, SEXPTYPE t); +Rboolean Rf_strIsASCII(const char *str); +int utf8clen(char c); +int Rf_AdobeSymbol2ucs2(int n); +double R_strtod5(const char *str, char **endptr, char dec, + Rboolean NA, int exact); + +typedef unsigned short ucs2_t; +size_t mbcsToUcs2(const char *in, ucs2_t *out, int nout, int enc); +/* size_t mbcsMblen(char *in); +size_t ucs2ToMbcs(ucs2_t *in, char *out); +size_t ucs2Mblen(ucs2_t *in); */ +size_t utf8toucs(wchar_t *wc, const char *s); +size_t utf8towcs(wchar_t *wc, const char *s, size_t n); +size_t ucstomb(char *s, const unsigned int wc); +size_t ucstoutf8(char *s, const unsigned int wc); +size_t mbtoucs(unsigned int *wc, const char *s, size_t n); +size_t wcstoutf8(char *s, const wchar_t *wc, size_t n); + +SEXP Rf_installTrChar(SEXP); + +const wchar_t *wtransChar(SEXP x); /* from sysutils.c */ + +#define mbs_init(x) memset(x, 0, sizeof(mbstate_t)) +size_t Mbrtowc(wchar_t *wc, const char *s, size_t n, mbstate_t *ps); +Rboolean mbcsValid(const char *str); +Rboolean utf8Valid(const char *str); +char *Rf_strchr(const char *s, int c); +char *Rf_strrchr(const char *s, int c); + +SEXP fixup_NaRm(SEXP args); /* summary.c */ +void invalidate_cached_recodings(void); /* from sysutils.c */ +void resetICUcollator(void); /* from util.c */ +void dt_invalidate_locale(); /* from Rstrptime.h */ +int R_OutputCon; /* from connections.c */ +extern int R_InitReadItemDepth, R_ReadItemDepth; /* from serialize.c */ +void get_current_mem(size_t *,size_t *,size_t *); /* from memory.c */ +unsigned long get_duplicate_counter(void); /* from duplicate.c */ +void reset_duplicate_counter(void); /* from duplicate.c */ +void BindDomain(char *); /* from main.c */ +extern Rboolean LoadInitFile; /* from startup.c */ + +// Unix and Windows versions +double R_getClockIncrement(void); +void R_getProcTime(double *data); +void InitDynload(void); +void R_CleanTempDir(void); + +#ifdef Win32 +void R_fixslash(char *s); +void R_fixbackslash(char *s); +wchar_t *filenameToWchar(const SEXP fn, const Rboolean expand); + +#if defined(SUPPORT_UTF8_WIN32) +#define mbrtowc(a,b,c,d) Rmbrtowc(a,b) +#define wcrtomb(a,b,c) Rwcrtomb(a,b) +#define mbstowcs(a,b,c) Rmbstowcs(a,b,c) +#define wcstombs(a,b,c) Rwcstombs(a,b,c) +size_t Rmbrtowc(wchar_t *wc, const char *s); +size_t Rwcrtomb(char *s, const wchar_t wc); +size_t Rmbstowcs(wchar_t *wc, const char *s, size_t n); +size_t Rwcstombs(char *s, const wchar_t *wc, size_t n); +#endif +#endif + +FILE *RC_fopen(const SEXP fn, const char *mode, const Rboolean expand); +int Seql(SEXP a, SEXP b); +int Scollate(SEXP a, SEXP b); + +double R_strtod4(const char *str, char **endptr, char dec, Rboolean NA); +double R_strtod(const char *str, char **endptr); +double R_atof(const char *str); + +/* unix/sys-std.c, main/options.c */ +void set_rl_word_breaks(const char *str); + +/* From localecharset.c */ +extern const char *locale2charset(const char *); + +/* Localization */ + +#ifndef NO_NLS +# ifdef ENABLE_NLS +# include <libintl.h> +# ifdef Win32 +# define _(String) libintl_gettext (String) +# undef gettext /* needed for graphapp */ +# else +# define _(String) gettext (String) +# endif +# define gettext_noop(String) String +# define N_(String) gettext_noop (String) +# else /* not NLS */ +# define _(String) (String) +# define N_(String) String +# define ngettext(String, StringP, N) (N > 1 ? StringP: String) +# endif +#endif + +/* Macros for suspending interrupts: also in GraphicsDevice.h */ +#define BEGIN_SUSPEND_INTERRUPTS do { \ + Rboolean __oldsusp__ = R_interrupts_suspended; \ + R_interrupts_suspended = TRUE; +#define END_SUSPEND_INTERRUPTS R_interrupts_suspended = __oldsusp__; \ + if (R_interrupts_pending && ! R_interrupts_suspended) \ + onintr(); \ +} while(0) + + +/* + alloca is neither C99 nor POSIX. + + It might be better to try alloca.h first, see + https://www.gnu.org/software/autoconf/manual/autoconf-2.60/html_node/Particular-Functions.html +*/ +#ifdef __GNUC__ +// This covers GNU, Clang and Intel compilers +// The undef is needed in case some other header, e.g. malloc.h, already did this +# undef alloca +# define alloca(x) __builtin_alloca((x)) +#else +# ifdef HAVE_ALLOCA_H +// Needed for native compilers on Solaris and AIX +# include <alloca.h> +# endif +// it might have been defined via some other standard header, e.g. stdlib.h +# if !HAVE_DECL_ALLOCA +# include <stddef.h> // for size_t +extern void *alloca(size_t); +# endif +#endif + +/* Required by C99, but might be slow */ +#ifdef HAVE_LONG_DOUBLE +# define LDOUBLE long double +#else +# define LDOUBLE double +#endif + +/* int_fast64_t is required by C99/C11 + Alternative would be to use intmax_t. + */ +#ifdef HAVE_INT64_T +# define LONG_INT int64_t +# define LONG_INT_MAX INT64_MAX +#elif defined(HAVE_INT_FAST64_T) +# define LONG_INT int_fast64_t +# define LONG_INT_MAX INT_FAST64_MAX +#endif + +// for reproducibility for now: use exp10 or pown later if accurate enough. +#define Rexp10(x) pow(10.0, x) + +#endif /* DEFN_H_ */ +/* + *- Local Variables: + *- page-delimiter: "^/\\*---" + *- End: + */ diff --git a/com.oracle.truffle.r.native/gnur/patch/src/include/Errormsg.h b/com.oracle.truffle.r.native/gnur/patch/src/include/Errormsg.h new file mode 100644 index 0000000000000000000000000000000000000000..7d27018f138faa8f6e17a1d1a8f4357e798ffa88 --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/include/Errormsg.h @@ -0,0 +1,63 @@ +/* + * R : A Computer Language for Statistical Data Analysis + * Copyright (C) 1995, 1996 Robert Gentleman and Ross Ihaka + * 2000-8 the R Core Team + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version. + * + * This program 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 this program; if not, a copy is available at + * https://www.R-project.org/Licenses/ + */ + +/* Internal header, not installed */ + +#ifndef ERRORMSG_H +#define ERRORMSG_H + +/* Used in ../main/sub*.c */ +#define R_MSG_subs_o_b _("subscript out of bounds") +#define R_MSG_ob_nonsub _("object of type '%s' is not subsettable") + +/*---- Packaged Error & Warning Messages ---- + *---- ================================= ----*/ + +/* ---> Handling & I18n + * via ErrorMessage() and WarningMessage() in ../../main/errors.c */ + +typedef enum { + /* Argument list length and type errors */ + + ERROR_NUMARGS = 1, + ERROR_ARGTYPE = 2, + ERROR_INCOMPAT_ARGS = 3, + + /* General type and length incompatibilities */ + + ERROR_TSVEC_MISMATCH = 100, + + ERROR_UNIMPLEMENTED = 9998, + ERROR_UNKNOWN = 9999 +} R_ERROR; + + +typedef enum { + + WARNING_coerce_NA = 101, + WARNING_coerce_INACC= 102, + WARNING_coerce_IMAG = 103, + + WARNING_UNKNOWN = 9999 +} R_WARNING; + + +#endif + diff --git a/com.oracle.truffle.r.native/gnur/patch/src/include/Fileio.h b/com.oracle.truffle.r.native/gnur/patch/src/include/Fileio.h new file mode 100644 index 0000000000000000000000000000000000000000..c3de1591dfc61db8c4814c6741885fb76f4f5475 --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/include/Fileio.h @@ -0,0 +1,30 @@ +/* + * R : A Computer Language for Statistical Data Analysis + * Copyright (C) 1995, 1996 Robert Gentleman and Ross Ihaka + * 2007 R Core Team + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version. + * + * This program 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 this program; if not, a copy is available at + * https://www.R-project.org/Licenses/ + */ + +/* Internal header, not installed */ + +#ifndef RFILEIO_H_ + +#define RFILEIO_H_ + +int R_fgetc(FILE*); +FILE * R_fopen(const char *filename, const char *mode); + +#endif diff --git a/com.oracle.truffle.r.native/gnur/patch/src/include/Graphics.h b/com.oracle.truffle.r.native/gnur/patch/src/include/Graphics.h new file mode 100644 index 0000000000000000000000000000000000000000..f7ade5f7a55f5b31459493e5c6ed6440eb932c20 --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/include/Graphics.h @@ -0,0 +1,307 @@ +/* + * R : A Computer Language for Statistical Data Analysis + * Copyright (C) 1995, 1996 Robert Gentleman and Ross Ihaka + * Copyright (C) 1998--2012 R Core Team + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version. + * + * This program 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 this program; if not, a copy is available at + * https://www.R-project.org/Licenses/ + */ + +/* Internal header, not installed */ + +#ifndef GRAPHICS_H_ +#define GRAPHICS_H_ + +#include <R_ext/Boolean.h> + +#include <R_ext/GraphicsEngine.h> +/* needed for R_GE_lineend/join, R_GE_gcontext */ + +#define R_GRAPHICS 1 +#include <Rgraphics.h> /* RUnit */ + +/* base.c, graphics.c, par.c */ +#define MAX_LAYOUT_ROWS 200 +#define MAX_LAYOUT_COLS 200 +#define MAX_LAYOUT_CELLS 10007 /* must be less than 65535, + 3 copies, 3bytes each */ + +typedef struct { + double ax; + double bx; + double ay; + double by; +} GTrans; + +typedef struct { + /* Plot State */ + /* + When the device driver is started this is 0 + After the first call to plot.new/perps it is 1 + Every graphics operation except plot.new/persp + should fail if state = 0 + This is checked at the highest internal function + level (e.g., do_lines, do_axis, do_plot_xy, ...) + */ + + int state; /* plot state: 1 if GNewPlot has been called + (by plot.new or persp) */ + Rboolean valid; /* valid layout ? Used in GCheckState & do_playDL */ + + /* GRZ-like Graphics Parameters */ + /* ``The horror, the horror ... '' */ + /* Marlon Brando - Appocalypse Now */ + + /* General Parameters -- set and interrogated directly */ + + double adj; /* String adjustment */ + Rboolean ann; /* Should annotation take place */ + rcolor bg; /* **R ONLY** Background color */ + char bty; /* Box type */ + double cex; /* Character expansion */ + double lheight; /* Line height + The height of a line of text is: + ps * cex * lheight */ + rcolor col; /* Plotting Color */ + double crt; /* Character/string rotation */ + double din[2]; /* device size in inches */ + int err; /* Error repporting level */ + rcolor fg; /* **R ONLY** Foreground Color */ + char family[201]; /* **R ONLY** Font family + Simple name which is mapped by device-specific + font database to device-specific name. + Only used if not "". + Default is "". + Ignored by some devices. */ + int font; /* Text font */ + double gamma; /* Device Gamma Correction */ + int lab[3]; /* Axis labelling */ + /* [0] = # ticks on x-axis */ + /* [1] = # ticks on y-axis */ + /* [2] = length of axis labels */ + int las; /* Label style (rotation) */ + int lty; /* Line texture */ + double lwd; /* Line width */ + R_GE_lineend lend; /* **R ONLY** Line end style */ + R_GE_linejoin ljoin;/* **R ONLY** Line join style */ + double lmitre; /* **R ONLY** Line mitre limit */ + double mgp[3]; /* Annotation location */ + /* [0] = location of axis title */ + /* [1] = location of axis label */ + /* [2] = location of axis line */ + double mkh; /* Mark size in inches */ + int pch; /* Plotting character */ + /* Note that ps is never changed, so always the same as dev->startps. + However, the ps in the graphics context is changed */ + double ps; /* Text & symbol pointsize */ + int smo; /* Curve smoothness */ + double srt; /* String Rotation */ + double tck; /* Tick size as in S */ + double tcl; /* Tick size in "lines" */ + double xaxp[3]; /* X Axis annotation */ + /* [0] = coordinate of lower tick */ + /* [1] = coordinate of upper tick */ + /* [2] = num tick intervals */ + /* almost always used internally */ + char xaxs; /* X Axis style */ + char xaxt; /* X Axis type */ + Rboolean xlog; /* Log Axis for X */ + int xpd; /* Clip to plot region indicator */ + int oldxpd; + double yaxp[3]; /* Y Axis annotation */ + char yaxs; /* Y Axis style */ + char yaxt; /* Y Axis type */ + Rboolean ylog; /* Log Axis for Y */ + + /* Annotation Parameters */ + + double cexbase; /* Base character size */ + double cexmain; /* Main title size */ + double cexlab; /* xlab and ylab size */ + double cexsub; /* Sub title size */ + double cexaxis; /* Axis label size */ + + int fontmain; /* Main title font */ + int fontlab; /* Xlab and ylab font */ + int fontsub; /* Subtitle font */ + int fontaxis; /* Axis label fonts */ + + rcolor colmain; /* Main title color */ + rcolor collab; /* Xlab and ylab color */ + rcolor colsub; /* Subtitle color */ + rcolor colaxis; /* Axis label color */ + + /* Layout Parameters */ + + Rboolean layout; /* has a layout been specified */ + + int numrows; + int numcols; + int currentFigure; + int lastFigure; + double heights[MAX_LAYOUT_ROWS]; + double widths[MAX_LAYOUT_COLS]; + int cmHeights[MAX_LAYOUT_ROWS]; + int cmWidths[MAX_LAYOUT_COLS]; + unsigned short order[MAX_LAYOUT_CELLS]; + int rspct; /* 0 = none, 1 = full, 2 = see respect */ + unsigned char respect[MAX_LAYOUT_CELLS]; + + int mfind; /* By row/col indicator */ + + /* Layout parameters which can be set directly by the */ + /* user (e.g., par(fig=c(.5,1,0,1))) or otherwise are */ + /* calculated automatically */ + /* NOTE that *Units parameters are for internal use only */ + + double fig[4]; /* (current) Figure size (proportion) */ + /* [0] = left, [1] = right */ + /* [2] = bottom, [3] = top */ + double fin[2]; /* (current) Figure size (inches) */ + /* [0] = width, [1] = height */ + GUnit fUnits; /* (current) figure size units */ + double plt[4]; /* (current) Plot size (proportions) */ + /* [0] = left, [1] = right */ + /* [2] = bottom, [3] = top */ + double pin[2]; /* (current) plot size (inches) */ + /* [0] = width, [1] = height */ + GUnit pUnits; /* (current) plot size units */ + Rboolean defaultFigure; /* calculate figure from layout ? */ + Rboolean defaultPlot; /* calculate plot from figure - margins ? */ + + /* Layout parameters which are set directly by the user */ + + double mar[4]; /* Plot margins in lines */ + double mai[4]; /* Plot margins in inches */ + /* [0] = bottom, [1] = left */ + /* [2] = top, [3] = right */ + GUnit mUnits; /* plot margin units */ + double mex; /* Margin expansion factor */ + double oma[4]; /* Outer margins in lines */ + double omi[4]; /* outer margins in inches */ + double omd[4]; /* outer margins in NDC */ + /* [0] = bottom, [1] = left */ + /* [2] = top, [3] = right */ + GUnit oUnits; /* outer margin units */ + char pty; /* Plot type */ + + /* Layout parameters which can be set by the user, but */ + /* almost always get automatically calculated anyway */ + + double usr[4]; /* Graphics window */ + /* [0] = xmin, [1] = xmax */ + /* [2] = ymin, [3] = ymax */ + + /* The logged usr parameter; if xlog, use logusr[0:1] */ + /* if ylog, use logusr[2:3] */ + + double logusr[4]; + + /* Layout parameter: Internal flags */ + + Rboolean new; /* Clean plot ? */ + int devmode; /* creating new image or adding to existing one */ + + /* Coordinate System Mappings */ + /* These are only used internally (i.e., cannot be */ + /* set directly by the user) */ + + /* The reliability of these parameters relies on */ + /* the fact that plot.new is the */ + /* first graphics operation called in the creation */ + /* of a graph (unless it is a call to persp) */ + + /* udpated per plot.new */ + + double xNDCPerChar; /* Nominal character width (NDC) */ + double yNDCPerChar; /* Nominal character height (NDC) */ + double xNDCPerLine; /* Nominal line width (NDC) */ + double yNDCPerLine; /* Nominal line height (NDC) */ + double xNDCPerInch; /* xNDC -> Inches */ + double yNDCPerInch; /* yNDC -> Inches */ + + /* updated per plot.new and if inner2dev changes */ + + GTrans fig2dev; /* Figure to device */ + + /* udpated per DevNewPlot and if ndc2dev changes */ + + GTrans inner2dev; /* Inner region to device */ + + /* udpated per device resize */ + + GTrans ndc2dev; /* NDC to raw device */ + + /* updated per plot.new and per plot.window */ + + GTrans win2fig; /* Window to figure mapping */ + + /* NOTE: if user has not set fig and/or plt then */ + /* they need to be updated per plot.new too */ + + double scale; /* An internal "zoom" factor to apply to ps and lwd */ + /* (for fit-to-window resizing in Windows) */ +} GPar; + +/* always remap private functions */ +#define copyGPar Rf_copyGPar +#define FixupCol Rf_FixupCol +#define FixupLty Rf_FixupLty +#define FixupLwd Rf_FixupLwd +#define FixupVFont Rf_FixupVFont +#define GInit Rf_GInit +#define labelformat Rf_labelformat +#define ProcessInlinePars Rf_ProcessInlinePars +#define recordGraphicOperation Rf_recordGraphicOperation + +/* NOTE: during replays, call == R_NilValue; + ---- the following adds readability: */ +Rboolean GRecording(SEXP, pGEDevDesc); + +/* Default the settings for general graphical parameters + * (i.e., defaults that do not depend on the device type: */ +void GInit(GPar*); + +void copyGPar(GPar *, GPar *); + + /* from graphics.c, used in par.c */ +double R_Log10(double); + +/* from par.c, called in plot.c, plot3d.c */ +void ProcessInlinePars(SEXP, pGEDevDesc); + +/* from device.c */ +void recordGraphicOperation(SEXP, SEXP, pGEDevDesc); + +/* some functions that plot.c needs to share with plot3d.c */ +SEXP FixupCol(SEXP, unsigned int); +SEXP FixupLty(SEXP, int); +SEXP FixupLwd(SEXP, double); +SEXP FixupVFont(SEXP); +SEXP labelformat(SEXP); + +/* + * Function to generate an R_GE_gcontext from Rf_gpptr info + * + * from graphics.c, used in plot.c, plotmath.c + */ +void gcontextFromGP(pGEcontext gc, pGEDevDesc dd); + +/* From base.c */ +#define gpptr Rf_gpptr +#define dpptr Rf_dpptr +GPar* Rf_gpptr(pGEDevDesc dd); +GPar* Rf_dpptr(pGEDevDesc dd); + +#endif /* GRAPHICS_H_ */ diff --git a/com.oracle.truffle.r.native/gnur/patch/src/include/GraphicsBase.h b/com.oracle.truffle.r.native/gnur/patch/src/include/GraphicsBase.h new file mode 100644 index 0000000000000000000000000000000000000000..954eaff567ba27cd6538d95613908f058e75a9a3 --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/include/GraphicsBase.h @@ -0,0 +1,46 @@ +/* + * R : A Computer Language for Statistical Data Analysis + * Copyright (C) 2001-8 The R Core Team. + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU Lesser General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; if not, a copy is available at + * https://www.R-project.org/Licenses/ + */ + +/* Definitions for the base graphics system. + So should be private. + */ + +#ifndef R_GRAPHICSBASE_H_ +#define R_GRAPHICSBASE_H_ + +typedef struct { + GPar dp; /* current device default parameters: + those which will be used at the next GNewPage */ + GPar gp; /* current device current parameters */ + GPar dpSaved; /* saved device default parameters: + graphics state at the time that the currently + displayed plot was started, so we can replay + the display list. + */ + Rboolean baseDevice; /* Has the device received base output? */ +} baseSystemState; + +void registerBase(void); /* used in devices.c */ +void unregisterBase(void); /* used in devices.c */ + +void Rf_setBaseDevice(Rboolean val, pGEDevDesc dd); /* used in graphics.c */ + +int baseRegisterIndex; + +#endif /* R_GRAPHICSBASE_ */ diff --git a/com.oracle.truffle.r.native/gnur/patch/src/include/IOStuff.h b/com.oracle.truffle.r.native/gnur/patch/src/include/IOStuff.h new file mode 100644 index 0000000000000000000000000000000000000000..1bc02c8146267aa63039b64339477e7aba95ff71 --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/include/IOStuff.h @@ -0,0 +1,86 @@ +/* + * R : A Computer Language for Statistical Data Analysis + * Copyright (C) 1997 Robert Gentleman and Ross Ihaka + * Copyright (C) 2005 R Core Team + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version. + * + * This program 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 this program; if not, a copy is available at + * https://www.R-project.org/Licenses/ + */ + +/* Internal header, not installed */ + +#ifndef R_IOSTUFF_H +#define R_IOSTUFF_H + +/* + * I/O Support for Consoles and Character Vectors + * + * This code provides analogues for the stdio routines "fgetc" and + * (formerly) "ungetc" for "consoles" and character vectors. These routines + * are used for parsing input from the console window and character + * vectors. + */ + +#include <Defn.h> +#include <stdio.h> + +#define IOBSIZE 4096 + +typedef struct BufferListItem { + unsigned char buf[IOBSIZE]; + struct BufferListItem *next; +} BufferListItem; + +typedef struct IoBuffer { + BufferListItem *start_buf; /* First buffer item */ + BufferListItem *write_buf; /* Write pointer location */ + unsigned char *write_ptr; /* Write pointer location */ + int write_offset; /* Write pointer location */ + BufferListItem *read_buf; /* Read pointer location */ + unsigned char *read_ptr; /* Read pointer location */ + int read_offset; /* Read pointer location */ +} IoBuffer; + + +typedef struct TextBuffer { + void *vmax; /* Memory stack top */ + unsigned char *buf; /* Line buffer */ + unsigned char *bufp; /* Line buffer location */ + SEXP text; /* String Vector */ + int ntext; /* Vector length */ + int offset; /* Offset within vector */ +} TextBuffer; + +#ifndef __MAIN__ +extern +#else +attribute_hidden +#endif +IoBuffer R_ConsoleIob; /* Console IO Buffer */ + +/*- some of these really could be void */ +int R_IoBufferInit(IoBuffer*); +int R_IoBufferFree(IoBuffer*); +int R_IoBufferReadReset(IoBuffer*); +int R_IoBufferWriteReset(IoBuffer*); +int R_IoBufferGetc(IoBuffer*); +int R_IoBufferPutc(int, IoBuffer*); +int R_IoBufferPuts(char*, IoBuffer*); +int R_IoBufferReadOffset(IoBuffer*); + +int R_TextBufferInit(TextBuffer*, SEXP); +int R_TextBufferFree(TextBuffer*); +int R_TextBufferGetc(TextBuffer*); + +#endif /* not R_IOSTUFF_H */ diff --git a/com.oracle.truffle.r.native/gnur/patch/src/include/Internal.h b/com.oracle.truffle.r.native/gnur/patch/src/include/Internal.h new file mode 100644 index 0000000000000000000000000000000000000000..6b5c5182c2c64bb5e1595aa16590fa48814fb1b5 --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/include/Internal.h @@ -0,0 +1,514 @@ +/* + * R : A Computer Language for Statistical Data Analysis + * Copyright (C) 1995, 1996 Robert Gentleman and Ross Ihaka + * Copyright (C) 1997--2016 The R Core Team + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version. + * + * This program 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 this program; if not, a copy is available at + * https://www.R-project.org/Licenses/ + */ + +/* Names of .Internal(.) and .Primitive(.) R functions + * + * Must all return SEXP because of CCODE in Defn.h. + * do_math*() and do_cmathfuns are in ../main/arithmetic.h + */ + +#ifndef R_INTERNAL_H +#define R_INTERNAL_H + + +/* Function Names */ + +#if Win32 +SEXP do_mkjunction(SEXP, SEXP, SEXP, SEXP); +SEXP do_shellexec(SEXP, SEXP, SEXP, SEXP); +SEXP do_syswhich(SEXP, SEXP, SEXP, SEXP); +SEXP do_tzone_name(SEXP, SEXP, SEXP, SEXP); +#else +SEXP do_X11(SEXP, SEXP, SEXP, SEXP); +#endif + +SEXP do_abbrev(SEXP, SEXP, SEXP, SEXP); +SEXP do_abs(SEXP, SEXP, SEXP, SEXP); +SEXP do_addCondHands(SEXP, SEXP, SEXP, SEXP); +SEXP do_address(SEXP, SEXP, SEXP, SEXP); +SEXP do_addRestart(SEXP, SEXP, SEXP, SEXP); +SEXP do_addTryHandlers(SEXP, SEXP, SEXP, SEXP); +SEXP do_adist(SEXP, SEXP, SEXP, SEXP); +SEXP do_agrep(SEXP, SEXP, SEXP, SEXP); +SEXP do_allnames(SEXP, SEXP, SEXP, SEXP); +SEXP do_anyNA(SEXP, SEXP, SEXP, SEXP); +SEXP do_aperm(SEXP, SEXP, SEXP, SEXP); +SEXP do_aregexec(SEXP, SEXP, SEXP, SEXP); +SEXP do_args(SEXP, SEXP, SEXP, SEXP); +SEXP do_arith(SEXP, SEXP, SEXP, SEXP); +SEXP do_array(SEXP, SEXP, SEXP, SEXP); +SEXP do_asPOSIXct(SEXP, SEXP, SEXP, SEXP); +SEXP do_asPOSIXlt(SEXP, SEXP, SEXP, SEXP); +SEXP do_ascall(SEXP, SEXP, SEXP, SEXP); +SEXP do_as_environment(SEXP, SEXP, SEXP, SEXP); +SEXP do_asatomic(SEXP, SEXP, SEXP, SEXP); +SEXP do_asfunction(SEXP, SEXP, SEXP, SEXP); +SEXP do_asmatrixdf(SEXP, SEXP, SEXP, SEXP); +SEXP do_assign(SEXP, SEXP, SEXP, SEXP); +SEXP do_asvector(SEXP, SEXP, SEXP, SEXP); +SEXP do_asCharacterFactor(SEXP, SEXP, SEXP, SEXP); +SEXP do_AT(SEXP call, SEXP op, SEXP args, SEXP env); +SEXP do_attach(SEXP,SEXP,SEXP,SEXP); +SEXP do_attr(SEXP, SEXP, SEXP, SEXP); +SEXP do_attrgets(SEXP, SEXP, SEXP, SEXP); +SEXP do_attributes(SEXP, SEXP, SEXP, SEXP); +SEXP do_attributesgets(SEXP, SEXP, SEXP, SEXP); +SEXP do_backsolve(SEXP, SEXP, SEXP, SEXP); +SEXP do_baseenv(SEXP, SEXP, SEXP, SEXP); +SEXP do_basename(SEXP, SEXP, SEXP, SEXP); +SEXP do_bcprofcounts(SEXP, SEXP, SEXP, SEXP); +SEXP do_bcprofstart(SEXP, SEXP, SEXP, SEXP); +SEXP do_bcprofstop(SEXP, SEXP, SEXP, SEXP); +SEXP do_begin(SEXP, SEXP, SEXP, SEXP); +SEXP do_bincode(SEXP, SEXP, SEXP, SEXP); +SEXP do_bind(SEXP, SEXP, SEXP, SEXP); +SEXP do_bindtextdomain(SEXP, SEXP, SEXP, SEXP); +SEXP do_bitwise(SEXP, SEXP, SEXP, SEXP); +SEXP do_body(SEXP, SEXP, SEXP, SEXP); +SEXP do_bodyCode(SEXP, SEXP, SEXP, SEXP); +SEXP NORET do_break(SEXP, SEXP, SEXP, SEXP); +SEXP do_browser(SEXP, SEXP, SEXP, SEXP); +SEXP do_builtins(SEXP, SEXP, SEXP, SEXP); +SEXP do_c(SEXP, SEXP, SEXP, SEXP); +SEXP do_c_dflt(SEXP, SEXP, SEXP, SEXP); +SEXP do_call(SEXP, SEXP, SEXP, SEXP); +SEXP do_capabilities(SEXP, SEXP, SEXP, SEXP); +SEXP do_capabilitiesX11(SEXP, SEXP, SEXP, SEXP); +SEXP do_cat(SEXP, SEXP, SEXP, SEXP); +SEXP do_charmatch(SEXP, SEXP, SEXP, SEXP); +SEXP do_charToRaw(SEXP, SEXP, SEXP, SEXP); +SEXP do_chartr(SEXP, SEXP, SEXP, SEXP); +SEXP do_class(SEXP, SEXP, SEXP, SEXP); +SEXP do_classgets(SEXP, SEXP, SEXP, SEXP); +SEXP do_colon(SEXP, SEXP, SEXP, SEXP); +SEXP do_colsum(SEXP, SEXP, SEXP, SEXP); +SEXP do_commandArgs(SEXP, SEXP, SEXP, SEXP); +SEXP do_comment(SEXP, SEXP, SEXP, SEXP); +SEXP do_commentgets(SEXP, SEXP, SEXP, SEXP); +SEXP do_complex(SEXP, SEXP, SEXP, SEXP); +SEXP do_contourLines(SEXP, SEXP, SEXP, SEXP); +SEXP do_copyDFattr(SEXP, SEXP, SEXP, SEXP); +SEXP do_crc64(SEXP, SEXP, SEXP, SEXP); +SEXP do_Cstack_info(SEXP, SEXP, SEXP, SEXP); +SEXP do_cum(SEXP, SEXP, SEXP, SEXP); +SEXP do_curlDownload(SEXP, SEXP, SEXP, SEXP); +SEXP do_curlGetHeaders(SEXP, SEXP, SEXP, SEXP); +SEXP do_curlVersion(SEXP, SEXP, SEXP, SEXP); +SEXP do_D2POSIXlt(SEXP, SEXP, SEXP, SEXP); +SEXP do_date(SEXP, SEXP, SEXP, SEXP); +SEXP do_debug(SEXP, SEXP, SEXP, SEXP); +SEXP do_delayed(SEXP, SEXP, SEXP, SEXP); +SEXP do_deparse(SEXP, SEXP, SEXP, SEXP); +SEXP do_detach(SEXP,SEXP,SEXP,SEXP); +SEXP NORET do_dfltStop(SEXP, SEXP, SEXP, SEXP); +SEXP do_dfltWarn(SEXP, SEXP, SEXP, SEXP); +SEXP do_diag(SEXP, SEXP, SEXP, SEXP); +SEXP do_dim(SEXP, SEXP, SEXP, SEXP); +SEXP do_dimgets(SEXP, SEXP, SEXP, SEXP); +SEXP do_dimnames(SEXP, SEXP, SEXP, SEXP); +SEXP do_dimnamesgets(SEXP, SEXP, SEXP, SEXP); +SEXP do_dircreate(SEXP, SEXP, SEXP, SEXP); +SEXP do_direxists(SEXP, SEXP, SEXP, SEXP); +SEXP do_dirname(SEXP, SEXP, SEXP, SEXP); +SEXP do_docall(SEXP, SEXP, SEXP, SEXP); +SEXP do_dotcall(SEXP, SEXP, SEXP, SEXP); +SEXP do_dotcallgr(SEXP, SEXP, SEXP, SEXP); +SEXP do_dotCode(SEXP, SEXP, SEXP, SEXP); +SEXP do_dput(SEXP, SEXP, SEXP, SEXP); +SEXP do_drop(SEXP, SEXP, SEXP, SEXP); +SEXP do_dump(SEXP, SEXP, SEXP, SEXP); +SEXP do_duplicated(SEXP, SEXP, SEXP, SEXP); +SEXP do_dynload(SEXP, SEXP, SEXP, SEXP); +SEXP do_dynunload(SEXP, SEXP, SEXP, SEXP); +SEXP do_eapply(SEXP, SEXP, SEXP, SEXP); +SEXP do_edit(SEXP, SEXP, SEXP, SEXP); +SEXP do_emptyenv(SEXP, SEXP, SEXP, SEXP); +SEXP do_encoding(SEXP, SEXP, SEXP, SEXP); +SEXP do_encodeString(SEXP, SEXP, SEXP, SEXP); +SEXP do_enc2(SEXP, SEXP, SEXP, SEXP); +SEXP do_envir(SEXP, SEXP, SEXP, SEXP); +SEXP do_envirgets(SEXP, SEXP, SEXP, SEXP); +SEXP do_envirName(SEXP, SEXP, SEXP, SEXP); +SEXP do_env2list(SEXP, SEXP, SEXP, SEXP); +SEXP do_eSoftVersion(SEXP, SEXP, SEXP, SEXP); +SEXP do_External(SEXP, SEXP, SEXP, SEXP); +SEXP do_Externalgr(SEXP, SEXP, SEXP, SEXP); +SEXP do_eval(SEXP, SEXP, SEXP, SEXP); +SEXP do_expression(SEXP, SEXP, SEXP, SEXP); +SEXP do_fileaccess(SEXP, SEXP, SEXP, SEXP); +SEXP do_fileappend(SEXP, SEXP, SEXP, SEXP); +SEXP do_filechoose(SEXP, SEXP, SEXP, SEXP); +SEXP do_filecopy(SEXP, SEXP, SEXP, SEXP); +SEXP do_filecreate(SEXP, SEXP, SEXP, SEXP); +SEXP do_fileexists(SEXP, SEXP, SEXP, SEXP); +SEXP do_fileinfo(SEXP, SEXP, SEXP, SEXP); +SEXP do_filelink(SEXP, SEXP, SEXP, SEXP); +SEXP do_filepath(SEXP, SEXP, SEXP, SEXP); +SEXP do_fileremove(SEXP, SEXP, SEXP, SEXP); +SEXP do_filerename(SEXP, SEXP, SEXP, SEXP); +SEXP do_fileshow(SEXP, SEXP, SEXP, SEXP); +SEXP do_filesymlink(SEXP, SEXP, SEXP, SEXP); +SEXP do_findinterval(SEXP, SEXP, SEXP, SEXP); +SEXP do_first_min(SEXP, SEXP, SEXP, SEXP); +SEXP do_flush(SEXP, SEXP, SEXP, SEXP); +SEXP do_for(SEXP, SEXP, SEXP, SEXP); +SEXP do_forceAndCall(SEXP, SEXP, SEXP, SEXP); +SEXP do_format(SEXP, SEXP, SEXP, SEXP); +SEXP do_formatC(SEXP, SEXP, SEXP, SEXP); +SEXP do_formatinfo(SEXP, SEXP, SEXP, SEXP); +SEXP do_formatPOSIXlt(SEXP, SEXP, SEXP, SEXP); +SEXP do_formals(SEXP, SEXP, SEXP, SEXP); +SEXP do_function(SEXP, SEXP, SEXP, SEXP); +SEXP do_gc(SEXP, SEXP, SEXP, SEXP); +SEXP do_gcinfo(SEXP, SEXP, SEXP, SEXP); +SEXP do_gctime(SEXP, SEXP, SEXP, SEXP); +SEXP do_gctorture(SEXP, SEXP, SEXP, SEXP); +SEXP do_gctorture2(SEXP, SEXP, SEXP, SEXP); +SEXP do_get(SEXP, SEXP, SEXP, SEXP); +SEXP do_getDllTable(SEXP, SEXP, SEXP, SEXP); +SEXP do_getVarsFromFrame(SEXP call, SEXP op, SEXP args, SEXP env); +SEXP do_getenv(SEXP, SEXP, SEXP, SEXP); +SEXP do_geterrmessage(SEXP, SEXP, SEXP, SEXP); +SEXP do_getGraphicsEvent(SEXP, SEXP, SEXP, SEXP); +SEXP do_getGraphicsEventEnv(SEXP, SEXP, SEXP, SEXP); +SEXP do_getlocale(SEXP, SEXP, SEXP, SEXP); +SEXP do_getOption(SEXP, SEXP, SEXP, SEXP); +SEXP do_getRegisteredRoutines(SEXP, SEXP, SEXP, SEXP); +SEXP do_getSymbolInfo(SEXP, SEXP, SEXP, SEXP); +SEXP do_getRestart(SEXP, SEXP, SEXP, SEXP); +SEXP do_gettext(SEXP, SEXP, SEXP, SEXP); +SEXP do_getwd(SEXP, SEXP, SEXP, SEXP); +SEXP do_glob(SEXP, SEXP, SEXP, SEXP); +SEXP do_globalenv(SEXP, SEXP, SEXP, SEXP); +SEXP do_grep(SEXP, SEXP, SEXP, SEXP); +SEXP do_grepraw(SEXP, SEXP, SEXP, SEXP); +SEXP do_gsub(SEXP, SEXP, SEXP, SEXP); +SEXP do_iconv(SEXP, SEXP, SEXP, SEXP); +SEXP do_ICUget(SEXP, SEXP, SEXP, SEXP); +SEXP do_ICUset(SEXP, SEXP, SEXP, SEXP); +SEXP do_identical(SEXP, SEXP, SEXP, SEXP); +SEXP do_if(SEXP, SEXP, SEXP, SEXP); +SEXP do_inherits(SEXP, SEXP, SEXP, SEXP); +SEXP do_inspect(SEXP, SEXP, SEXP, SEXP); +SEXP do_intToUtf8(SEXP, SEXP, SEXP, SEXP); +SEXP do_interactive(SEXP, SEXP, SEXP, SEXP); +SEXP do_internal(SEXP, SEXP, SEXP, SEXP); +SEXP do_internalsID(SEXP, SEXP, SEXP, SEXP); +SEXP do_interruptsSuspended(SEXP, SEXP, SEXP, SEXP); +SEXP do_intToBits(SEXP, SEXP, SEXP, SEXP); +SEXP do_invisible(SEXP, SEXP, SEXP, SEXP); +SEXP NORET do_invokeRestart(SEXP, SEXP, SEXP, SEXP); +SEXP do_is(SEXP, SEXP, SEXP, SEXP); +SEXP do_isatty(SEXP, SEXP, SEXP, SEXP); +SEXP do_isfinite(SEXP, SEXP, SEXP, SEXP); +SEXP do_isinfinite(SEXP, SEXP, SEXP, SEXP); +SEXP do_islistfactor(SEXP, SEXP, SEXP, SEXP); +SEXP do_isloaded(SEXP, SEXP, SEXP, SEXP); +SEXP do_isna(SEXP, SEXP, SEXP, SEXP); +SEXP do_isnan(SEXP, SEXP, SEXP, SEXP); +SEXP do_isunsorted(SEXP, SEXP, SEXP, SEXP); +SEXP do_isvector(SEXP, SEXP, SEXP, SEXP); +SEXP do_lapack(SEXP, SEXP, SEXP, SEXP); +SEXP do_lapply(SEXP, SEXP, SEXP, SEXP); +SEXP do_lazyLoadDBfetch(SEXP, SEXP, SEXP, SEXP); +SEXP do_lazyLoadDBflush(SEXP, SEXP, SEXP, SEXP); +SEXP do_lazyLoadDBinsertValue(SEXP call, SEXP op, SEXP args, SEXP env); +SEXP do_length(SEXP, SEXP, SEXP, SEXP); +SEXP do_lengthgets(SEXP, SEXP, SEXP, SEXP); +SEXP do_lengths(SEXP, SEXP, SEXP, SEXP); +SEXP do_levelsgets(SEXP, SEXP, SEXP, SEXP); +SEXP do_listdirs(SEXP, SEXP, SEXP, SEXP); +SEXP do_listfiles(SEXP, SEXP, SEXP, SEXP); +SEXP do_list2env(SEXP, SEXP, SEXP, SEXP); +SEXP do_load(SEXP, SEXP, SEXP, SEXP); +SEXP do_loadFromConn2(SEXP, SEXP, SEXP, SEXP); +SEXP do_localeconv(SEXP, SEXP, SEXP, SEXP); +SEXP do_log(SEXP, SEXP, SEXP, SEXP); +SEXP do_log1arg(SEXP, SEXP, SEXP, SEXP); +SEXP do_logic(SEXP, SEXP, SEXP, SEXP); +SEXP do_logic2(SEXP, SEXP, SEXP, SEXP); +SEXP do_logic3(SEXP, SEXP, SEXP, SEXP); +SEXP do_ls(SEXP, SEXP, SEXP, SEXP); +SEXP do_l10n_info(SEXP, SEXP, SEXP, SEXP); +SEXP do_machine(SEXP, SEXP, SEXP, SEXP); +SEXP do_makelazy(SEXP, SEXP, SEXP, SEXP); +SEXP do_makelist(SEXP, SEXP, SEXP, SEXP); +SEXP do_makenames(SEXP, SEXP, SEXP, SEXP); +SEXP do_makeunique(SEXP, SEXP, SEXP, SEXP); +SEXP do_makevector(SEXP, SEXP, SEXP, SEXP); +SEXP do_mapply(SEXP, SEXP, SEXP, SEXP); +SEXP do_match(SEXP, SEXP, SEXP, SEXP); +SEXP do_matchcall(SEXP, SEXP, SEXP, SEXP); +SEXP do_matprod(SEXP, SEXP, SEXP, SEXP); +SEXP do_Math2(SEXP, SEXP, SEXP, SEXP); +SEXP do_matrix(SEXP, SEXP, SEXP, SEXP); +SEXP do_maxcol(SEXP, SEXP, SEXP, SEXP); +SEXP do_memlimits(SEXP, SEXP, SEXP, SEXP); +SEXP do_memoryprofile(SEXP, SEXP, SEXP, SEXP); +SEXP do_merge(SEXP, SEXP, SEXP, SEXP); +SEXP do_mget(SEXP, SEXP, SEXP, SEXP); +SEXP do_missing(SEXP, SEXP, SEXP, SEXP); +SEXP do_names(SEXP, SEXP, SEXP, SEXP); +SEXP do_namesgets(SEXP, SEXP, SEXP, SEXP); +SEXP do_nargs(SEXP, SEXP, SEXP, SEXP); +SEXP do_nchar(SEXP,SEXP,SEXP,SEXP); +SEXP do_newenv(SEXP,SEXP,SEXP,SEXP); +SEXP do_nextmethod(SEXP,SEXP,SEXP,SEXP); +SEXP do_ngettext(SEXP, SEXP, SEXP, SEXP); +SEXP do_normalizepath(SEXP, SEXP, SEXP, SEXP); +SEXP do_nzchar(SEXP,SEXP,SEXP,SEXP); +SEXP do_onexit(SEXP, SEXP, SEXP, SEXP); +SEXP do_options(SEXP, SEXP, SEXP, SEXP); +SEXP do_order(SEXP, SEXP, SEXP, SEXP); +SEXP do_packBits(SEXP, SEXP, SEXP, SEXP); +SEXP do_paren(SEXP, SEXP, SEXP, SEXP); +SEXP do_parentenv(SEXP, SEXP, SEXP, SEXP); +SEXP do_parentenvgets(SEXP, SEXP, SEXP, SEXP); +SEXP do_parentframe(SEXP, SEXP, SEXP, SEXP); +SEXP do_parse(SEXP, SEXP, SEXP, SEXP); +SEXP do_paste(SEXP, SEXP, SEXP, SEXP); +SEXP do_pathexpand(SEXP, SEXP, SEXP, SEXP); +SEXP do_pcre_config(SEXP, SEXP, SEXP, SEXP); +SEXP do_pmatch(SEXP, SEXP, SEXP, SEXP); +SEXP do_pmin(SEXP, SEXP, SEXP, SEXP); +SEXP do_polyroot(SEXP, SEXP, SEXP, SEXP); +SEXP do_pos2env(SEXP, SEXP, SEXP, SEXP); +SEXP do_POSIXlt2D(SEXP, SEXP, SEXP, SEXP); +SEXP do_pretty(SEXP, SEXP, SEXP, SEXP); +SEXP do_primitive(SEXP, SEXP, SEXP, SEXP); +SEXP do_printdefault(SEXP, SEXP, SEXP, SEXP); +SEXP do_printDeferredWarnings(SEXP, SEXP, SEXP, SEXP); +SEXP do_printfunction(SEXP, SEXP, SEXP, SEXP); +SEXP do_prmatrix(SEXP, SEXP, SEXP, SEXP); +SEXP do_proctime(SEXP, SEXP, SEXP, SEXP); +SEXP do_psort(SEXP, SEXP, SEXP, SEXP); +SEXP do_qsort(SEXP, SEXP, SEXP, SEXP); +SEXP do_quit(SEXP, SEXP, SEXP, SEXP); +SEXP do_quote(SEXP, SEXP, SEXP, SEXP); +SEXP do_radixsort(SEXP, SEXP, SEXP, SEXP); +SEXP do_random1(SEXP, SEXP, SEXP, SEXP); +SEXP do_random2(SEXP, SEXP, SEXP, SEXP); +SEXP do_random3(SEXP, SEXP, SEXP, SEXP); +SEXP do_range(SEXP, SEXP, SEXP, SEXP); +SEXP do_rank(SEXP, SEXP, SEXP, SEXP); +SEXP do_rapply(SEXP, SEXP, SEXP, SEXP); +SEXP do_rawShift(SEXP, SEXP, SEXP, SEXP); +SEXP do_rawToBits(SEXP, SEXP, SEXP, SEXP); +SEXP do_rawToChar(SEXP, SEXP, SEXP, SEXP); +SEXP do_readDCF(SEXP, SEXP, SEXP, SEXP); +SEXP do_readEnviron(SEXP, SEXP, SEXP, SEXP); +SEXP do_readlink(SEXP, SEXP, SEXP, SEXP); +SEXP do_readLines(SEXP, SEXP, SEXP, SEXP); +SEXP do_readln(SEXP, SEXP, SEXP, SEXP); +SEXP do_recall(SEXP, SEXP, SEXP, SEXP); +SEXP do_refcnt(SEXP, SEXP, SEXP, SEXP); +SEXP do_recordGraphics(SEXP, SEXP, SEXP, SEXP); +SEXP do_regexec(SEXP, SEXP, SEXP, SEXP); +SEXP do_regexpr(SEXP, SEXP, SEXP, SEXP); +SEXP do_regFinaliz(SEXP, SEXP, SEXP, SEXP); +SEXP do_relop(SEXP, SEXP, SEXP, SEXP); +SEXP do_relop_dflt(SEXP, SEXP, SEXP, SEXP); +SEXP do_remove(SEXP, SEXP, SEXP, SEXP); +SEXP do_rep(SEXP, SEXP, SEXP, SEXP); +SEXP do_rep_int(SEXP, SEXP, SEXP, SEXP); +SEXP do_rep_len(SEXP, SEXP, SEXP, SEXP); +SEXP do_repeat(SEXP, SEXP, SEXP, SEXP); +SEXP do_resetCondHands(SEXP, SEXP, SEXP, SEXP); +SEXP NORET do_return(SEXP, SEXP, SEXP, SEXP); +SEXP do_returnValue(SEXP, SEXP, SEXP, SEXP); +SEXP do_rgb(SEXP, SEXP, SEXP, SEXP); +SEXP do_Rhome(SEXP, SEXP, SEXP, SEXP); +SEXP do_RNGkind(SEXP, SEXP, SEXP, SEXP); +SEXP do_rowsum(SEXP, SEXP, SEXP, SEXP); +SEXP do_rowscols(SEXP, SEXP, SEXP, SEXP); +SEXP do_S4on(SEXP, SEXP, SEXP, SEXP); +SEXP do_sample(SEXP, SEXP, SEXP, SEXP); +SEXP do_sample2(SEXP, SEXP, SEXP, SEXP); +SEXP do_save(SEXP, SEXP, SEXP, SEXP); +SEXP do_saveToConn(SEXP, SEXP, SEXP, SEXP); +SEXP do_saveplot(SEXP, SEXP, SEXP, SEXP); +SEXP do_scan(SEXP, SEXP, SEXP, SEXP); +SEXP do_search(SEXP, SEXP, SEXP, SEXP); +SEXP do_seq(SEXP, SEXP, SEXP, SEXP); +SEXP do_seq_along(SEXP, SEXP, SEXP, SEXP); +SEXP do_seq_len(SEXP, SEXP, SEXP, SEXP); +SEXP do_serialize(SEXP, SEXP, SEXP, SEXP); +SEXP do_serializeToConn(SEXP, SEXP, SEXP, SEXP); +SEXP do_set(SEXP, SEXP, SEXP, SEXP); +SEXP do_setS4Object(SEXP, SEXP, SEXP, SEXP); +SEXP do_setFileTime(SEXP, SEXP, SEXP, SEXP); +SEXP do_setencoding(SEXP, SEXP, SEXP, SEXP); +SEXP do_setenv(SEXP, SEXP, SEXP, SEXP); +SEXP do_seterrmessage(SEXP, SEXP, SEXP, SEXP); +SEXP do_setmaxnumthreads(SEXP, SEXP, SEXP, SEXP); +SEXP do_setnumthreads(SEXP, SEXP, SEXP, SEXP); +SEXP do_setGraphicsEventEnv(SEXP, SEXP, SEXP, SEXP); +SEXP do_setlocale(SEXP, SEXP, SEXP, SEXP); +SEXP do_setseed(SEXP, SEXP, SEXP, SEXP); +SEXP do_setSessionTimeLimit(SEXP, SEXP, SEXP, SEXP); +SEXP do_setTimeLimit(SEXP, SEXP, SEXP, SEXP); +SEXP do_setwd(SEXP, SEXP, SEXP, SEXP); +SEXP do_shortRowNames(SEXP, SEXP, SEXP, SEXP); +SEXP do_signalCondition(SEXP, SEXP, SEXP, SEXP); +SEXP do_sink(SEXP, SEXP, SEXP, SEXP); +SEXP do_sinknumber(SEXP, SEXP, SEXP, SEXP); +SEXP do_sort(SEXP, SEXP, SEXP, SEXP); +SEXP do_split(SEXP, SEXP, SEXP, SEXP); +SEXP do_sprintf(SEXP, SEXP, SEXP, SEXP); +SEXP do_standardGeneric(SEXP, SEXP, SEXP, SEXP); +SEXP do_startsWith(SEXP, SEXP, SEXP, SEXP); +SEXP NORET do_stop(SEXP, SEXP, SEXP, SEXP); +SEXP do_storage_mode(SEXP, SEXP, SEXP, SEXP); +SEXP do_strrep(SEXP, SEXP, SEXP, SEXP); +SEXP do_strsplit(SEXP,SEXP,SEXP,SEXP); +SEXP do_strptime(SEXP,SEXP,SEXP,SEXP); +SEXP do_strtrim(SEXP,SEXP,SEXP,SEXP); +SEXP do_strtoi(SEXP,SEXP,SEXP,SEXP); +SEXP do_syschmod(SEXP,SEXP,SEXP,SEXP); +SEXP do_sysinfo(SEXP,SEXP,SEXP,SEXP); +SEXP do_syssleep(SEXP,SEXP,SEXP,SEXP); +SEXP do_sysumask(SEXP,SEXP,SEXP,SEXP); +SEXP do_subassign(SEXP, SEXP, SEXP, SEXP); +SEXP do_subassign_dflt(SEXP, SEXP, SEXP, SEXP); +SEXP do_subassign2(SEXP, SEXP, SEXP, SEXP); +SEXP do_subassign2_dflt(SEXP, SEXP, SEXP, SEXP); +SEXP do_subassign3(SEXP, SEXP, SEXP, SEXP); +SEXP do_subset(SEXP, SEXP, SEXP, SEXP); +SEXP do_subset_dflt(SEXP, SEXP, SEXP, SEXP); +SEXP do_subset2(SEXP, SEXP, SEXP, SEXP); +SEXP do_subset2_dflt(SEXP, SEXP, SEXP, SEXP); +SEXP do_subset3(SEXP, SEXP, SEXP, SEXP); +SEXP do_substitute(SEXP, SEXP, SEXP, SEXP); +SEXP do_substr(SEXP,SEXP,SEXP,SEXP); +SEXP do_substrgets(SEXP,SEXP,SEXP,SEXP); +SEXP do_summary(SEXP, SEXP, SEXP, SEXP); +SEXP do_switch(SEXP, SEXP, SEXP, SEXP); +SEXP do_sys(SEXP, SEXP, SEXP, SEXP); +SEXP do_sysbrowser(SEXP, SEXP, SEXP, SEXP); +SEXP do_sysgetpid(SEXP, SEXP, SEXP, SEXP); +SEXP do_system(SEXP, SEXP, SEXP, SEXP); +SEXP do_systime(SEXP, SEXP, SEXP, SEXP); +SEXP do_tabulate(SEXP, SEXP, SEXP, SEXP); +SEXP do_tempdir(SEXP, SEXP, SEXP, SEXP); +SEXP do_tempfile(SEXP, SEXP, SEXP, SEXP); +SEXP do_tilde(SEXP, SEXP, SEXP, SEXP); +SEXP do_tolower(SEXP, SEXP, SEXP, SEXP); +SEXP do_topenv(SEXP, SEXP, SEXP, SEXP); +SEXP do_trace(SEXP, SEXP, SEXP, SEXP); +SEXP do_traceOnOff(SEXP, SEXP, SEXP, SEXP); +SEXP do_traceback(SEXP, SEXP, SEXP, SEXP); +SEXP do_transpose(SEXP, SEXP, SEXP, SEXP); +SEXP do_trunc(SEXP, SEXP, SEXP, SEXP); +SEXP do_tryCatchHelper(SEXP, SEXP, SEXP, SEXP); +SEXP do_typeof(SEXP, SEXP, SEXP, SEXP); +SEXP do_unclass(SEXP, SEXP, SEXP, SEXP); +SEXP do_unlink(SEXP, SEXP, SEXP, SEXP); +SEXP do_unlist(SEXP, SEXP, SEXP, SEXP); +SEXP do_unserializeFromConn(SEXP, SEXP, SEXP, SEXP); +SEXP do_unsetenv(SEXP, SEXP, SEXP, SEXP); +SEXP NORET do_usemethod(SEXP, SEXP, SEXP, SEXP); +SEXP do_utf8ToInt(SEXP, SEXP, SEXP, SEXP); +SEXP do_validEnc(SEXP, SEXP, SEXP, SEXP); +SEXP do_validUTF8(SEXP, SEXP, SEXP, SEXP); +SEXP do_vapply(SEXP, SEXP, SEXP, SEXP); +SEXP do_version(SEXP, SEXP, SEXP, SEXP); +SEXP do_warning(SEXP, SEXP, SEXP, SEXP); +SEXP do_while(SEXP, SEXP, SEXP, SEXP); +SEXP do_which(SEXP, SEXP, SEXP, SEXP); +SEXP do_withVisible(SEXP, SEXP, SEXP, SEXP); +SEXP do_xtfrm(SEXP, SEXP, SEXP, SEXP); + +SEXP do_getSnapshot(SEXP, SEXP, SEXP, SEXP); +SEXP do_playSnapshot(SEXP, SEXP, SEXP, SEXP); + +SEXP R_do_data_class(SEXP call, SEXP op, SEXP args, SEXP env); +SEXP R_do_set_class(SEXP call, SEXP op, SEXP args, SEXP env); +SEXP R_getS4DataSlot(SEXP obj, SEXPTYPE type); + +/* bytecode */ +SEXP do_mkcode(SEXP, SEXP, SEXP, SEXP); +SEXP do_bcclose(SEXP, SEXP, SEXP, SEXP); +SEXP do_is_builtin_internal(SEXP, SEXP, SEXP, SEXP); +SEXP do_disassemble(SEXP, SEXP, SEXP, SEXP); +SEXP do_bcversion(SEXP, SEXP, SEXP, SEXP); +SEXP do_loadfile(SEXP, SEXP, SEXP, SEXP); +SEXP do_savefile(SEXP, SEXP, SEXP, SEXP); +SEXP do_growconst(SEXP, SEXP, SEXP, SEXP); +SEXP do_putconst(SEXP, SEXP, SEXP, SEXP); +SEXP do_getconst(SEXP, SEXP, SEXP, SEXP); +SEXP do_enablejit(SEXP, SEXP, SEXP, SEXP); +SEXP do_compilepkgs(SEXP, SEXP, SEXP, SEXP); + +/* Connections */ +SEXP do_stdin(SEXP, SEXP, SEXP, SEXP); +SEXP do_stdout(SEXP, SEXP, SEXP, SEXP); +SEXP do_stderr(SEXP, SEXP, SEXP, SEXP); +SEXP do_writelines(SEXP, SEXP, SEXP, SEXP); +SEXP do_readbin(SEXP, SEXP, SEXP, SEXP); +SEXP do_writebin(SEXP, SEXP, SEXP, SEXP); +SEXP do_readchar(SEXP, SEXP, SEXP, SEXP); +SEXP do_writechar(SEXP, SEXP, SEXP, SEXP); +SEXP do_open(SEXP, SEXP, SEXP, SEXP); +SEXP do_isopen(SEXP, SEXP, SEXP, SEXP); +SEXP do_isincomplete(SEXP, SEXP, SEXP, SEXP); +SEXP do_isseekable(SEXP, SEXP, SEXP, SEXP); +SEXP do_close(SEXP, SEXP, SEXP, SEXP); +SEXP do_fifo(SEXP, SEXP, SEXP, SEXP); +SEXP do_pipe(SEXP, SEXP, SEXP, SEXP); +SEXP do_url(SEXP, SEXP, SEXP, SEXP); +SEXP do_gzfile(SEXP, SEXP, SEXP, SEXP); +SEXP do_unz(SEXP, SEXP, SEXP, SEXP); +SEXP do_seek(SEXP, SEXP, SEXP, SEXP); +SEXP do_truncate(SEXP, SEXP, SEXP, SEXP); +SEXP do_pushback(SEXP, SEXP, SEXP, SEXP); +SEXP do_pushbacklength(SEXP, SEXP, SEXP, SEXP); +SEXP do_clearpushback(SEXP, SEXP, SEXP, SEXP); +SEXP do_rawconnection(SEXP, SEXP, SEXP, SEXP); +SEXP do_rawconvalue(SEXP, SEXP, SEXP, SEXP); +SEXP do_textconnection(SEXP, SEXP, SEXP, SEXP); +SEXP do_textconvalue(SEXP, SEXP, SEXP, SEXP); +SEXP do_getconnection(SEXP, SEXP, SEXP, SEXP); +SEXP do_getallconnections(SEXP, SEXP, SEXP, SEXP); +SEXP do_sumconnection(SEXP, SEXP, SEXP, SEXP); +SEXP do_sockconn(SEXP, SEXP, SEXP, SEXP); +SEXP do_sockselect(SEXP, SEXP, SEXP, SEXP); +SEXP do_gzcon(SEXP, SEXP, SEXP, SEXP); +SEXP do_memCompress(SEXP, SEXP, SEXP, SEXP); +SEXP do_memDecompress(SEXP, SEXP, SEXP, SEXP); + +SEXP do_lockEnv(SEXP, SEXP, SEXP, SEXP); +SEXP do_envIsLocked(SEXP, SEXP, SEXP, SEXP); +SEXP do_lockBnd(SEXP, SEXP, SEXP, SEXP); +SEXP do_bndIsLocked(SEXP, SEXP, SEXP, SEXP); +SEXP do_mkActiveBnd(SEXP, SEXP, SEXP, SEXP); +SEXP do_bndIsActive(SEXP, SEXP, SEXP, SEXP); +SEXP do_mkUnbound(SEXP, SEXP, SEXP, SEXP); +SEXP do_isNSEnv(SEXP call, SEXP op, SEXP args, SEXP rho); +SEXP do_regNS(SEXP call, SEXP op, SEXP args, SEXP rho); +SEXP do_unregNS(SEXP call, SEXP op, SEXP args, SEXP rho); +SEXP do_getRegNS(SEXP call, SEXP op, SEXP args, SEXP rho); +SEXP do_getNSRegistry(SEXP call, SEXP op, SEXP args, SEXP rho); +SEXP do_importIntoEnv(SEXP call, SEXP op, SEXP args, SEXP rho); +SEXP do_envprofile(SEXP call, SEXP op, SEXP args, SEXP rho); + +SEXP do_tracemem(SEXP, SEXP, SEXP, SEXP); +SEXP do_retracemem(SEXP, SEXP, SEXP, SEXP); +SEXP do_untracemem(SEXP, SEXP, SEXP, SEXP); +#endif /* not R_INTERNAL_H */ diff --git a/com.oracle.truffle.r.native/gnur/patch/src/include/Makefile.in b/com.oracle.truffle.r.native/gnur/patch/src/include/Makefile.in new file mode 100644 index 0000000000000000000000000000000000000000..734ac9a359d844fba8ce08853a89ae46b517cccb --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/include/Makefile.in @@ -0,0 +1,137 @@ +# +# ${R_HOME}/src/include/Makefile + +VPATH = @srcdir@ +srcdir = @srcdir@ +top_srcdir = @top_srcdir@ + +top_builddir = ../.. +subdir = src/include + +include $(top_builddir)/Makeconf + +distdir = $(top_builddir)/$(PACKAGE)-$(VERSION)/$(subdir) + +## API(1): for .C() and .Call() writers _or_ for alternative front ends. +SRC_HEADERS = R.h S.h Rdefines.h Rembedded.h Rinternals.h Rinterface.h +## API(2) {these are built, system-dependently}: +OBJ_HEADERS = Rconfig.h Rmath.h Rversion.h +## Non-API internal ones: +INT_HEADERS = Defn.h Errormsg.h Fileio.h Graphics.h GraphicsBase.h \ + IOStuff.h Internal.h Parse.h Print.h Rconnections.h \ + Rdynpriv.h Rgraphics.h Rinlinedfuns.h Startup.h rlocale.h + +DISTFILES = Makefile.in Makefile.win $(INT_HEADERS) $(SRC_HEADERS) \ + config.h.in stamp-h.in Rmath.h0.in + +SUBDIRS = R_ext +SUBDIRS_WITH_NO_BUILD = Rmodules vg + +TIMESTAMPS = $(SRC_HEADERS:.h=.ts) $(OBJ_HEADERS:.h=.tsa) + +CLEANFILES = $(OBJ_HEADERS) stamp-R $(TIMESTAMPS) libintl.h +DISTCLEANFILES = Makefile Rmath.h0 config.h stamp-h + +.SUFFIXES: +.SUFFIXES: .h .ts .tsa + +.h.ts: + @$(INSTALL_DATA) $< $(top_builddir)/include/`basename $<` + @touch $@ +.h.tsa: + @$(INSTALL_DATA) $< $(top_builddir)/include@R_ARCH@/`basename $<` + @touch $@ + + +all: Makefile R + +Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status + @cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ + +R: Makefile stamp-R $(TIMESTAMPS) + @for d in $(SUBDIRS); do \ + (cd $${d} && $(MAKE) $@) || exit 1; \ + done +stamp-R: + @$(MKINSTALLDIRS) $(top_builddir)/include@R_ARCH@ + @touch $@ +$(TIMESTAMPS): stamp-R + +config.h: stamp-h +stamp-h: $(srcdir)/config.h.in $(top_builddir)/config.status + @cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/config.h + @$(ECHO) timestamp > $@ 2> /dev/null +$(srcdir)/config.h.in: @MAINTAINER_MODE_TRUE@ $(srcdir)/stamp-h.in +$(srcdir)/stamp-h.in: @MAINTAINER_MODE_TRUE@ $(top_srcdir)/configure.ac $(top_builddir)/aclocal.m4 + @TBD=`cd $(top_builddir); pwd`; \ + cd $(top_srcdir) && $(AUTOHEADER) -I $${TBD} + @$(ECHO) timestamp > $@ 2> /dev/null +Rconfig.h: config.h $(top_srcdir)/tools/GETCONFIG + @$(SHELL) $(top_srcdir)/tools/GETCONFIG > $@ +Rversion.h: $(top_srcdir)/VERSION $(top_srcdir)/tools/GETVERSION $(top_builddir)/SVN-REVISION + @$(SHELL) $(top_srcdir)/tools/GETVERSION > $@ + +## <NOTE> +## we don't use AC_CONFIG_HEADERS on Rmath.h.in because +## a) that would comment out #undef statements in Rmath.h.in and +## b) Rmath.h should be a self-contained file for standalone Rmath use. +## </NOTE> +Rmath.h: Rmath.h0 + @$(SHELL) $(top_srcdir)/tools/copy-if-change Rmath.h0 $@ +Rmath.h0: $(srcdir)/Rmath.h0.in $(top_builddir)/config.status + @cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ + +install: installdirs install-intl-@USE_INCLUDED_LIBINTL@ + @for d in $(SUBDIRS); do \ + (cd $${d} && $(MAKE) $@) || exit 1; \ + done + @for f in $(SRC_HEADERS); do \ + $(INSTALL_DATA) $(srcdir)/$${f} "$(DESTDIR)$(rincludedir)"; \ + done + @for f in $(OBJ_HEADERS); do \ + $(INSTALL_DATA) $${f} "$(DESTDIR)$(rincludedir)@R_ARCH@"; \ + done +installdirs: + @$(MKINSTALLDIRS) "$(DESTDIR)$(rincludedir)@R_ARCH@" +install-intl-yes: installdirs + @$(INSTALL_DATA) libintl.h "$(DESTDIR)$(rincludedir)@R_ARCH@" +install-intl-no: + +install-strip: + $(MAKE) INSTALL_PROGRAM="${INSTALL_PROGRAM} -s" install +uninstall: + @for d in $(SUBDIRS); do \ + (cd $${d} && $(MAKE) $@) || exit 1; \ + done + @rm -rf "$(DESTDIR)$(rincludedir)" + +mostlyclean: clean +clean: + @for d in $(SUBDIRS); do (cd $${d} && $(MAKE) $@); done + -@test -z "$(CLEANFILES)" || rm -f $(CLEANFILES) +distclean: clean + @for d in $(SUBDIRS); do (cd $${d} && $(MAKE) $@); done + -@test -z "$(DISTCLEANFILES)" || rm -f $(DISTCLEANFILES) +maintainer-clean: distclean + +TAGS info dvi check: + +distdir: $(DISTFILES) + @for f in $(DISTFILES); do \ + test -f $(distdir)/$${f} \ + || ln $(srcdir)/$${f} $(distdir)/$${f} 2>/dev/null \ + || cp -p $(srcdir)/$${f} $(distdir)/$${f}; \ + done + @for d in $(SUBDIRS); do \ + test -d $(distdir)/$${d} \ + || mkdir $(distdir)/$${d} \ + || exit 1; \ + chmod 755 $(distdir)/$${d}; \ + (cd $${d} && $(MAKE) distdir) \ + || exit 1; \ + done + @for d in $(SUBDIRS_WITH_NO_BUILD); do \ + ((cd $(srcdir); $(TAR) -c -f - $(DISTDIR_TAR_EXCLUDE) $${d}) \ + | (cd $(distdir); $(TAR) -x -f -)) \ + || exit 1; \ + done diff --git a/com.oracle.truffle.r.native/gnur/patch/src/include/Makefile.win b/com.oracle.truffle.r.native/gnur/patch/src/include/Makefile.win new file mode 100644 index 0000000000000000000000000000000000000000..96dad0a26e8c8dee86008e45344ff878a9c9ef0b --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/include/Makefile.win @@ -0,0 +1,110 @@ +#-*- Makefile -*- +include ../gnuwin32/MkRules +R_HOME = ../.. + +GIT = `if [ -d "$(top_builddir)/.git" ]; then echo "git"; fi` + +VER = $(shell sed -e 's/\([^ ]*\).*/\1/' ../../VERSION) + +## keep these in step with ./Makefile.in +SRC_HEADERS = R.h S.h Rdefines.h Rembedded.h Rinternals.h +## this deliberately does not include Rinterfaces.h, which is Unix-only +OBJ_HEADERS = Rconfig.h Rmath.h Rversion.h +GW32_HEADERS = iconv.h psignal.h + +## This omits GetX11Image.h QuartzDevice.h eventloop.h +R_EXT_HEADERS = \ + Applic.h Arith.h BLAS.h Boolean.h Callbacks.h Complex.h Connections.h \ + Constants.h Error.h \ + GraphicsDevice.h GraphicsEngine.h Itermacros.h \ + Lapack.h Linpack.h MathThreads.h Memory.h \ + Parse.h Print.h PrtUtil.h R-ftp-http.h RS.h Rallocators.h Random.h \ + Rdynload.h Riconv.h RStartup.h Utils.h libextern.h \ + stats_package.h stats_stubs.h Visibility.h + +all: fixh config.h trioremap.h + @echo 'installing C headers' + @mkdir -p $(R_HOME)/include/R_ext + @cp -p $(SRC_HEADERS) $(OBJ_HEADERS) iconv.h $(R_HOME)/include + @(cd R_ext; cp -p $(R_EXT_HEADERS) ../../../include/R_ext) + @cp -p ../extra/graphapp/graphapp.h ../extra/graphapp/ga.h \ + $(R_HOME)/include + +version: Rversion.h + +fixh: $(GW32_HEADERS) $(OBJ_HEADERS) + @$(ECHO) done > fixh + +ifeq "$(WIN)" "64" +config.h: ../gnuwin32/fixed/h/config.h ../../VERSION + @$(SED) -e 's/@VERSION@/$(VER)/' -e 's/@ST@/8/' $< > $@ +else +config.h: ../gnuwin32/fixed/h/config.h ../../VERSION + @$(SED) -e 's/@VERSION@/$(VER)/' -e 's/@ST@/4/' $< > $@ +endif + +Rconfig.h: ../gnuwin32/fixed/h/Rconfig.h + @cp $< $@ + +iconv.h: ../gnuwin32/fixed/h/iconv.h + @cp $< $@ + +psignal.h: ../gnuwin32/fixed/h/psignal.h + @cp $< $@ + +Rversion.h: $(R_HOME)/VERSION $(R_HOME)/SVN-REVISION $(R_HOME)/tools/GETVERSION + @sh $(R_HOME)/tools/GETVERSION > $@ + +Rmath.h0: Rmath.h0.in $(R_HOME)/VERSION Makefile.win + @$(SED) -e 's/@RMATH_HAVE_LOG1P@/# define HAVE_LOG1P 1/' \ + -e 's/@RMATH_HAVE_EXPM1@/# define HAVE_EXPM1 1/' \ + -e 's/@RMATH_HAVE_HYPOT@/# define HAVE_HYPOT 1/' \ + -e 's/@RMATH_HAVE_WORKING_LOG1P@/# define HAVE_WORKING_LOG1P 1/' \ + -e "s/@PACKAGE_VERSION@/`sed 's/\([^ ]*\).*/\1/' < $(R_HOME)/VERSION`/" $< > Rmath.h0 + +Rmath.h: Rmath.h0 + @sh $(R_HOME)/tools/copy-if-change $< $@ + +trioremap.h: ../gnuwin32/fixed/h/trioremap.h + @cp $< $@ + +## If we do not have svn, get the old file from SVN-REVISION.bak (if poss). +## This needs to be copy-on-change. +## The date from svn info is not in GMT, but we have decided to live +## with that as they changed the format in svn 1.4.x +## <FIXME> USE_SVNVERSION does not work if there is no 'svnversion' +FORCE: +$(R_HOME)/SVN-REVISION: FORCE + @if test -f $(R_HOME)/SVN-REVISION ; then \ + cp -p $(R_HOME)/SVN-REVISION $(R_HOME)/SVN-REVISION.bak ; \ + fi +ifdef USE_SVNVERSION + @LC_ALL=C svnversion ../.. | sed -n 's/^/Revision: /p' > svn-tmp || rm -f svn-tmp + @grep -v exported svn-tmp > /dev/null || rm -f svn-tmp +else + @(cd ../..; LC_ALL=C $(GIT) svn info || echo "Revision: unknown") 2> /dev/null \ + | sed -n '/^Revision/p' > svn-tmp + @if grep unknown svn-tmp > /dev/null ; then \ + rm svn-tmp; \ + fi +endif + @if test -f svn-tmp ; then \ + (cd ../..; LC_ALL=C TZ=GMT $(GIT) svn info || echo "Last Changed Date: unknown") 2> /dev/null \ + | sed -n '/^Last Changed Date:/p' | sed 's/[0-9][0-9]:.*//' \ + >> svn-tmp ; \ + else \ + rm -f svn-tmp ; \ + fi + @if test -f svn-tmp; then \ + if test ! -f $@ || ! cmp svn-tmp $@ > /dev/null ; then\ + cp svn-tmp $@; \ + fi ; \ + else \ + cp -p $(R_HOME)/SVN-REVISION.bak $@ 2> /dev/null || \ + (echo "Revision: 00000" > $@; \ + echo "Last Changed Date: 2006-00-00" >> $@) ; \ + fi + @rm -f svn-tmp $(R_HOME)/SVN-REVISION.bak + +distclean: + $(RM) -f Rmath.h0 fixh diff --git a/com.oracle.truffle.r.native/gnur/patch/src/include/Parse.h b/com.oracle.truffle.r.native/gnur/patch/src/include/Parse.h new file mode 100644 index 0000000000000000000000000000000000000000..a4cf02806cae8c99467edbfeaf05c8a871493da6 --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/include/Parse.h @@ -0,0 +1,77 @@ +/* + * R : A Computer Language for Statistical Data Analysis + * Copyright (C) 1998-2005 R Core Team + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version. + * + * This program 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 this program; if not, a copy is available at + * https://www.R-project.org/Licenses/ + */ + +/* Internal header, not installed */ + +#ifndef R_PARSE_H +#define R_PARSE_H + +#include <R_ext/Parse.h> +#include <IOStuff.h> + +/* Public interface */ +/* SEXP R_ParseVector(SEXP, int, ParseStatus *, SEXP); in R_ext/Parse.h */ + +/* Private interface */ + +typedef struct SrcRefState SrcRefState; + +struct SrcRefState { + + Rboolean keepSrcRefs; /* Whether to attach srcrefs to objects as they are parsed */ + Rboolean didAttach; /* Record of whether a srcref was attached */ + SEXP SrcFile; /* The srcfile object currently being parsed */ + SEXP Original; /* The underlying srcfile object */ + PROTECT_INDEX SrcFileProt; /* The SrcFile may change */ + PROTECT_INDEX OriginalProt; /* ditto */ + SEXP data; /* Detailed info on parse */ + SEXP text; + SEXP ids; + int data_count; + /* Position information about the current parse */ + int xxlineno; /* Line number according to #line directives */ + int xxcolno; /* Character number on line */ + int xxbyteno; /* Byte number on line */ + int xxparseno; /* Line number ignoring #line directives */ + + SrcRefState* prevState; +}; + +void InitParser(void); + +void R_InitSrcRefState(void); +void R_FinalizeSrcRefState(void); + +SEXP R_Parse1Buffer(IoBuffer*, int, ParseStatus *); /* in ReplIteration, + R_ReplDLLdo1 */ +SEXP R_ParseBuffer(IoBuffer*, int, ParseStatus *, SEXP, SEXP); /* in source.c */ +SEXP R_Parse1File(FILE*, int, ParseStatus *); /* in R_ReplFile */ +SEXP R_ParseFile(FILE*, int, ParseStatus *, SEXP); /* in edit.c */ + +#ifndef HAVE_RCONNECTION_TYPEDEF +typedef struct Rconn *Rconnection; +#define HAVE_RCONNECTION_TYPEDEF +#endif +SEXP R_ParseConn(Rconnection con, int n, ParseStatus *status, SEXP srcfile); + + /* Report a parse error */ + +void NORET parseError(SEXP call, int linenum); + +#endif /* not R_PARSE_H */ diff --git a/com.oracle.truffle.r.native/gnur/patch/src/include/Print.h b/com.oracle.truffle.r.native/gnur/patch/src/include/Print.h new file mode 100644 index 0000000000000000000000000000000000000000..0d4a10e9af9ce140df1619e4327cbbf4638a1063 --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/include/Print.h @@ -0,0 +1,91 @@ +/* + * R : A Computer Language for Statistical Data Analysis + * Copyright (C) 1995, 1996 Robert Gentleman and Ross Ihaka + * Copyright (C) 1997-2014 The R Core Team. + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version. + * + * This program 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 this program; if not, a copy is available at + * https://www.R-project.org/Licenses/ + */ + +/* Internal header, not installed */ + +#ifndef PRINT_H_ +#define PRINT_H_ + +#include "Defn.h" +#include <R_ext/PrtUtil.h> +#include <R_ext/Print.h> + +#define formatRaw Rf_formatRaw +#define formatString Rf_formatString +#define EncodeElement Rf_EncodeElement +#define EncodeElement0 Rf_EncodeElement0 +#define EncodeEnvironment Rf_EncodeEnvironment +#define printArray Rf_printArray +#define printMatrix Rf_printMatrix +#define printNamedVector Rf_printNamedVector +#define printVector Rf_printVector + +typedef struct { + int width; + int na_width; + int na_width_noquote; + int digits; + int scipen; + int gap; + int quote; + int right; + int max; + SEXP na_string; + SEXP na_string_noquote; + int useSource; + int cutoff; // for deparsed language objects +} R_print_par_t; +extern R_print_par_t R_print; + +/* Computation of printing formats */ +void formatRaw(Rbyte *, R_xlen_t, int *); +void formatString(SEXP*, R_xlen_t, int*, int); + +/* Formating of values */ +const char *EncodeElement0(SEXP, int, int, const char *); +const char *EncodeEnvironment(SEXP); +/* Legacy, for R.app */ +const char *EncodeElement(SEXP, int, int, char); + +/* In Rinternals.h (and MUST be there): + CustomPrintValue, PrintValue, PrintValueRec */ +void printArray(SEXP, SEXP, int, int, SEXP); +void printMatrix(SEXP, int, SEXP, int, int, SEXP, SEXP, + const char*, const char*); +void printNamedVector(SEXP, SEXP, int, const char*); +void printVector(SEXP, int, int); +// void PrintClosure(SEXP, Rboolean); +// void PrintLanguage(SEXP, Rboolean); + +/* Utilities for S compatibility and debuggging */ +int F77_SYMBOL(dblepr0)(const char *, int *, double *, int *); +int F77_SYMBOL(intpr0) (const char *, int *, int *, int *); +int F77_SYMBOL(realpr0)(const char *, int *, float *, int *); +void R_PV(SEXP s); + +/* Offset for rowlabels if there are named dimnames */ +#define R_MIN_LBLOFF 2 + +#define R_MIN_WIDTH_OPT 10 +#define R_MAX_WIDTH_OPT 10000 +#define R_MIN_DIGITS_OPT 0 +#define R_MAX_DIGITS_OPT 22 + +#endif diff --git a/com.oracle.truffle.r.native/gnur/patch/src/include/R.h b/com.oracle.truffle.r.native/gnur/patch/src/include/R.h new file mode 100644 index 0000000000000000000000000000000000000000..4199374f23eac1bb3225301c642911b18c8546ca --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/include/R.h @@ -0,0 +1,115 @@ +/* + * R : A Computer Language for Statistical Data Analysis + * Copyright (C) 2000-2016 The R Core Team. + * + * This header file is free software; you can redistribute it and/or modify + * it under the terms of the GNU Lesser General Public License as published by + * the Free Software Foundation; either version 2.1 of the License, or + * (at your option) any later version. + * + * This file is part of R. R is distributed under the terms of the + * GNU General Public License, either Version 2, June 1991 or Version 3, + * June 2007. See doc/COPYRIGHTS for details of the copyright status of R. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public License + * along with this program; if not, a copy is available at + * https://www.R-project.org/Licenses/ + */ + +#ifndef R_R_H +#define R_R_H + +#ifndef USING_R +# define USING_R +#endif + +/* same as Rmath.h: needed for cospi etc */ +#ifndef __STDC_WANT_IEC_60559_FUNCS_EXT__ +# define __STDC_WANT_IEC_60559_FUNCS_EXT__ 1 +#endif +/* The C++ headers in Solaris Studio are strict C++98, and 100+ + packages would fail because of not using e.g. std::floor + or using C99 functions such as + + erf exmp1 floorf fmin fminf fmax lgamma lround loglp round + snprintf strcasecmp trunc + + We workaround the first, here and in Rmath.h. + + DO_NOT_USE_CXX_HEADERS is legacy, left as a last resort. +*/ +#if defined(__cplusplus) && !defined(DO_NOT_USE_CXX_HEADERS) +# include <cstdlib> +# include <cstdio> +# include <climits> +# include <cmath> +# ifdef __SUNPRO_CC +using namespace std; +# endif +#else +# include <stdlib.h> /* Not used by R itself, but widely assumed in packages */ +# include <stdio.h> /* Used by ca 200 packages, but not in R itself */ +# include <limits.h> /* for INT_MAX */ +# include <math.h> +#endif +/* + math.h is also included by R_ext/Arith.h, except in C++ code + stddef.h (or cstddef) is included by R_ext/Memory.h + string.h (or cstring) is included by R_ext/RS.h +*/ +#if defined(__sun) +/* Solaris' stdlib.h includes a header which defines these (and more) */ +# undef CS +# undef DO +# undef DS +# undef ES +# undef FS +# undef GS +# undef SO +# undef SS +#endif + +#ifdef NO_C_HEADERS +# warning "use of NO_C_HEADERS is defunct and will be ignored" +#endif + +#include <Rconfig.h> +#include <R_ext/Arith.h> /* R_FINITE, ISNAN, ... */ +#include <R_ext/Boolean.h> /* Rboolean type */ +#include <R_ext/Complex.h> /* Rcomplex type */ +#include <R_ext/Constants.h> /* PI, DOUBLE_EPS, etc */ +#include <R_ext/Error.h> /* error and warning */ +#include <R_ext/Memory.h> /* R_alloc and S_alloc */ +#include <R_ext/Print.h> /* Rprintf etc */ +#include <R_ext/Random.h> /* RNG interface */ +#include <R_ext/Utils.h> /* sort routines et al */ +#include <R_ext/RS.h> +/* for PROBLEM ... Calloc, Realloc, Free, Memcpy, F77_xxxx */ + + +typedef double Sfloat; +typedef int Sint; +#define SINT_MAX INT_MAX +#define SINT_MIN INT_MIN + +#ifdef __cplusplus +extern "C" { +#endif + +void R_FlushConsole(void); +/* always declared, but only usable under Win32 and Aqua */ +void R_ProcessEvents(void); +#ifdef Win32 +void R_WaitEvent(void); +#endif + +#ifdef __cplusplus +} +#endif + +#endif /* !R_R_H */ diff --git a/com.oracle.truffle.r.native/gnur/patch/src/include/R_ext/Applic.h b/com.oracle.truffle.r.native/gnur/patch/src/include/R_ext/Applic.h new file mode 100644 index 0000000000000000000000000000000000000000..a8fa9752be395d97e5b0b6b590dc44ef61f17940 --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/include/R_ext/Applic.h @@ -0,0 +1,157 @@ +/* + * R : A Computer Language for Statistical Data Analysis + * Copyright (C) 1998-2015 The R Core Team + * + * This header file is free software; you can redistribute it and/or modify + * it under the terms of the GNU Lesser General Public License as published by + * the Free Software Foundation; either version 2.1 of the License, or + * (at your option) any later version. + * + * This file is part of R. R is distributed under the terms of the + * GNU General Public License, either Version 2, June 1991 or Version 3, + * June 2007. See doc/COPYRIGHTS for details of the copyright status of R. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public License + * along with this program; if not, a copy is available at + * https://www.R-project.org/Licenses/ + * + * + * Application Routines, typically implemented in ../appl/ + * ---------------------------------------------- ======== + */ + +/* This header file contains routines which are in the R API and ones which + are not. + + Those which are not can be used only at the user's risk and may change + or disappear in a future release of R. +*/ + + +#ifndef R_APPLIC_H_ +#define R_APPLIC_H_ + +#include <R_ext/Boolean.h> +#include <R_ext/RS.h> /* F77_... */ +#include <R_ext/BLAS.h> + +#ifdef __cplusplus +extern "C" { +#endif + +/* Entry points in the R API */ + +/* ../../appl/integrate.c */ +typedef void integr_fn(double *x, int n, void *ex); +/* vectorizing function f(x[1:n], ...) -> x[] {overwriting x[]}. */ + +void Rdqags(integr_fn f, void *ex, double *a, double *b, + double *epsabs, double *epsrel, + double *result, double *abserr, int *neval, int *ier, + int *limit, int *lenw, int *last, int *iwork, double *work); + +void Rdqagi(integr_fn f, void *ex, double *bound, int *inf, + double *epsabs, double *epsrel, + double *result, double *abserr, int *neval, int *ier, + int *limit, int *lenw, int *last, + int *iwork, double *work); + +/* main/optim.c */ +typedef double optimfn(int, double *, void *); +typedef void optimgr(int, double *, double *, void *); + +void vmmin(int n, double *b, double *Fmin, + optimfn fn, optimgr gr, int maxit, int trace, + int *mask, double abstol, double reltol, int nREPORT, + void *ex, int *fncount, int *grcount, int *fail); +void nmmin(int n, double *Bvec, double *X, double *Fmin, optimfn fn, + int *fail, double abstol, double intol, void *ex, + double alpha, double bet, double gamm, int trace, + int *fncount, int maxit); +void cgmin(int n, double *Bvec, double *X, double *Fmin, + optimfn fn, optimgr gr, + int *fail, double abstol, double intol, void *ex, + int type, int trace, int *fncount, int *grcount, int maxit); +void lbfgsb(int n, int m, double *x, double *l, double *u, int *nbd, + double *Fmin, optimfn fn, optimgr gr, int *fail, void *ex, + double factr, double pgtol, int *fncount, int *grcount, + int maxit, char *msg, int trace, int nREPORT); +void samin(int n, double *pb, double *yb, optimfn fn, int maxit, + int tmax, double ti, int trace, void *ex); + +/* appl/interv.c: Also in Utils.h, used in package eco */ +int findInterval(double *xt, int n, double x, + Rboolean rightmost_closed, Rboolean all_inside, int ilo, + int *mflag); +// findInterval2() is only in Utils.h (and hence Rinternals.h) + + +/* ------------------ Entry points NOT in the R API --------------- */ + +/* The following are registered for use in .C/.Fortran */ + +/* appl/dqrutl.f: interfaces to dqrsl */ +void F77_NAME(dqrqty)(double *x, int *n, int *k, double *qraux, + double *y, int *ny, double *qty); +void F77_NAME(dqrqy)(double *x, int *n, int *k, double *qraux, + double *y, int *ny, double *qy); +void F77_NAME(dqrcf)(double *x, int *n, int *k, double *qraux, + double *y, int *ny, double *b, int *info); +void F77_NAME(dqrrsd)(double *x, int *n, int *k, double *qraux, + double *y, int *ny, double *rsd); +void F77_NAME(dqrxb)(double *x, int *n, int *k, double *qraux, + double *y, int *ny, double *xb); + +/* end of registered */ + +/* hidden, for use in R.bin/R.dll/libR.so */ + +/* appl/pretty.c: for use in engine.c and util.c */ +double R_pretty(double *lo, double *up, int *ndiv, int min_n, + double shrink_sml, double high_u_fact[], + int eps_correction, int return_bounds); + + +/* For use in package stats */ + +/* appl/uncmin.c : */ + +/* type of pointer to the target and gradient functions */ +typedef void (*fcn_p)(int, double *, double *, void *); + +/* type of pointer to the hessian functions */ +typedef void (*d2fcn_p)(int, int, double *, double *, void *); + +void fdhess(int n, double *x, double fval, fcn_p fun, void *state, + double *h, int nfd, double *step, double *f, int ndigit, + double *typx); + +/* Also used in packages nlme, pcaPP */ +void optif9(int nr, int n, double *x, + fcn_p fcn, fcn_p d1fcn, d2fcn_p d2fcn, + void *state, double *typsiz, double fscale, int method, + int iexp, int *msg, int ndigit, int itnlim, int iagflg, + int iahflg, double dlt, double gradtl, double stepmx, + double steptl, double *xpls, double *fpls, double *gpls, + int *itrmcd, double *a, double *wrk, int *itncnt); + +/* find qr decomposition, dqrdc2() is basis of R's qr(), + also used by nlme and many other packages. */ +void F77_NAME(dqrdc2)(double *x, int *ldx, int *n, int *p, + double *tol, int *rank, + double *qraux, int *pivot, double *work); +void F77_NAME(dqrls)(double *x, int *n, int *p, double *y, int *ny, + double *tol, double *b, double *rsd, + double *qty, int *k, + int *jpvt, double *qraux, double *work); + +#ifdef __cplusplus +} +#endif + +#endif /* R_APPLIC_H_ */ diff --git a/com.oracle.truffle.r.native/gnur/patch/src/include/R_ext/Arith.h b/com.oracle.truffle.r.native/gnur/patch/src/include/R_ext/Arith.h new file mode 100644 index 0000000000000000000000000000000000000000..0a5a852be563317133197266ad546c4af9ef679a --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/include/R_ext/Arith.h @@ -0,0 +1,91 @@ +/* + * R : A Computer Language for Statistical Data Analysis + * Copyright (C) 1995, 1996 Robert Gentleman and Ross Ihaka + * Copyright (C) 1998--2016 The R Core Team. + * + * This header file is free software; you can redistribute it and/or modify + * it under the terms of the GNU Lesser General Public License as published by + * the Free Software Foundation; either version 2.1 of the License, or + * (at your option) any later version. + * + * This file is part of R. R is distributed under the terms of the + * GNU General Public License, either Version 2, June 1991 or Version 3, + * June 2007. See doc/COPYRIGHTS for details of the copyright status of R. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public License + * along with this program; if not, a copy is available at + * https://www.R-project.org/Licenses/ + */ + +/* Included by R.h: API */ + +#ifndef R_ARITH_H_ +#define R_ARITH_H_ + +/* + This used to define _BSD_SOURCE to make declarations of isfinite + and isnan visible in glibc. But that was deprecated in glibc 2.20, + and --std=c99 suffices nowadays. +*/ + +#include <R_ext/libextern.h> +#ifdef __cplusplus +extern "C" { +#else +/* needed for isnan and isfinite, neither of which are used under C++ */ +# include <math.h> +#endif + +/* implementation of these : ../../main/arithmetic.c */ +LibExtern double R_NaN; /* IEEE NaN */ +LibExtern double R_PosInf; /* IEEE Inf */ +LibExtern double R_NegInf; /* IEEE -Inf */ +LibExtern double R_NaReal; /* NA_REAL: IEEE */ +LibExtern int R_NaInt; /* NA_INTEGER:= INT_MIN currently */ +#ifdef __MAIN__ +#undef extern +#undef LibExtern +#endif + +#define NA_LOGICAL R_NaInt +#define NA_INTEGER R_NaInt +/* #define NA_FACTOR R_NaInt unused */ +#define NA_REAL R_NaReal +/* NA_STRING is a SEXP, so defined in Rinternals.h */ + +int R_IsNA(double); /* True for R's NA only */ +int R_IsNaN(double); /* True for special NaN, *not* for NA */ +int R_finite(double); /* True if none of NA, NaN, +/-Inf */ +#define ISNA(x) R_IsNA(x) + +/* ISNAN(): True for *both* NA and NaN. + NOTE: some systems do not return 1 for TRUE. + Also note that C++ math headers specifically undefine + isnan if it is a macro (it is on macOS and in C99), + hence the workaround. This code also appears in Rmath.h +*/ +#ifdef __cplusplus + int R_isnancpp(double); /* in arithmetic.c */ +# define ISNAN(x) R_isnancpp(x) +#else +# define ISNAN(x) (isnan(x)!=0) +#endif + +/* The following is only defined inside R */ +#ifdef HAVE_WORKING_ISFINITE +/* isfinite is defined in <math.h> according to C99 */ +# define R_FINITE(x) isfinite(x) +#else +# define R_FINITE(x) R_finite(x) +#endif + +#ifdef __cplusplus +} +#endif + +#endif /* R_ARITH_H_ */ diff --git a/com.oracle.truffle.r.native/gnur/patch/src/include/R_ext/BLAS.h b/com.oracle.truffle.r.native/gnur/patch/src/include/R_ext/BLAS.h new file mode 100644 index 0000000000000000000000000000000000000000..d03af0d653a66340f4952cd6ea1ee8874715c440 --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/include/R_ext/BLAS.h @@ -0,0 +1,414 @@ +/* + * R : A Computer Language for Statistical Data Analysis + * Copyright (C) 2003-2016 The R Core Team. + * + * This header file is free software; you can redistribute it and/or modify + * it under the terms of the GNU Lesser General Public License as published by + * the Free Software Foundation; either version 2.1 of the License, or + * (at your option) any later version. + * + * This file is part of R. R is distributed under the terms of the + * GNU General Public License, either Version 2, June 1991 or Version 3, + * June 2007. See doc/COPYRIGHTS for details of the copyright status of R. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public License + * along with this program; if not, a copy is available at + * https://www.R-project.org/Licenses/ + */ + +/* + C declarations of BLAS Fortran subroutines always available in R. + + Part of the API. + + R packages that use these should have PKG_LIBS in src/Makevars include + $(BLAS_LIBS) $(FLIBS) + */ + +/* Part of the API */ + +#ifndef R_BLAS_H +#define R_BLAS_H + +#include <R_ext/RS.h> /* for F77_... */ +#include <R_ext/Complex.h> /* for Rcomplex */ + +#ifdef __cplusplus +extern "C" { +#endif + +// never defined in R itself. +#ifndef BLAS_extern +#define BLAS_extern extern +#endif + +/* Double Precision Level 1 BLAS */ + +BLAS_extern double /* DASUM - sum of absolute values of a one-dimensional array */ +F77_NAME(dasum)(const int *n, const double *dx, const int *incx); +BLAS_extern void /* DAXPY - replace y by alpha*x + y */ +F77_NAME(daxpy)(const int *n, const double *alpha, + const double *dx, const int *incx, + double *dy, const int *incy); +BLAS_extern void /* DCOPY - copy x to y */ +F77_NAME(dcopy)(const int *n, const double *dx, const int *incx, + double *dy, const int *incy); +BLAS_extern double /* DDOT - inner product of x and y */ +F77_NAME(ddot)(const int *n, const double *dx, const int *incx, + const double *dy, const int *incy); +BLAS_extern double /* DNRM2 - 2-norm of a vector */ +F77_NAME(dnrm2)(const int *n, const double *dx, const int *incx); +BLAS_extern void /* DROT - apply a Given's rotation */ +F77_NAME(drot)(const int *n, double *dx, const int *incx, + double *dy, const int *incy, const double *c, const double *s); +BLAS_extern void /* DROTG - generate a Given's rotation */ +F77_NAME(drotg)(const double *a, const double *b, double *c, double *s); +BLAS_extern void /* DROTM - apply a modified Given's rotation */ +F77_NAME(drotm)(const int *n, double *dx, const int *incx, + double *dy, const int *incy, const double *dparam); +BLAS_extern void /* DROTMG - generate a modified Given's rotation */ +F77_NAME(drotmg)(const double *dd1, const double *dd2, const double *dx1, + const double *dy1, double *param); +BLAS_extern void /* DSCAL - scale a one-dimensional array */ +F77_NAME(dscal)(const int *n, const double *alpha, double *dx, const int *incx); +BLAS_extern void /* DSWAP - interchange one-dimensional arrays */ +F77_NAME(dswap)(const int *n, double *dx, const int *incx, + double *dy, const int *incy); +BLAS_extern int /* IDAMAX - return the index of the element with max abs value */ +F77_NAME(idamax)(const int *n, const double *dx, const int *incx); + +/* Double Precision Level 2 BLAS */ + +/* DGBMV - perform one of the matrix-vector operations */ +/* y := alpha*A*x + beta*y, or y := alpha*A'*x + beta*y, */ +BLAS_extern void +F77_NAME(dgbmv)(const char *trans, const int *m, const int *n, + const int *kl,const int *ku, + const double *alpha, const double *a, const int *lda, + const double *x, const int *incx, + const double *beta, double *y, const int *incy); +/* DGEMV - perform one of the matrix-vector operations */ +/* y := alpha*A*x + beta*y, or y := alpha*A'*x + beta*y, */ +BLAS_extern void +F77_NAME(dgemv)(const char *trans, const int *m, const int *n, + const double *alpha, const double *a, const int *lda, + const double *x, const int *incx, const double *beta, + double *y, const int *incy); +/* DSBMV - perform the matrix-vector operation */ +/* y := alpha*A*x + beta*y, */ +BLAS_extern void +F77_NAME(dsbmv)(const char *uplo, const int *n, const int *k, + const double *alpha, const double *a, const int *lda, + const double *x, const int *incx, + const double *beta, double *y, const int *incy); +/* DSPMV - perform the matrix-vector operation */ +/* y := alpha*A*x + beta*y, */ +BLAS_extern void +F77_NAME(dspmv)(const char *uplo, const int *n, + const double *alpha, const double *ap, + const double *x, const int *incx, + const double *beta, double *y, const int *incy); + +/* DSYMV - perform the matrix-vector operation */ +/* y := alpha*A*x + beta*y, */ +BLAS_extern void +F77_NAME(dsymv)(const char *uplo, const int *n, const double *alpha, + const double *a, const int *lda, + const double *x, const int *incx, + const double *beta, double *y, const int *incy); +/* DTBMV - perform one of the matrix-vector operations */ +/* x := A*x, or x := A'*x, */ +BLAS_extern void +F77_NAME(dtbmv)(const char *uplo, const char *trans, + const char *diag, const int *n, const int *k, + const double *a, const int *lda, + double *x, const int *incx); +/* DTPMV - perform one of the matrix-vector operations */ +/* x := A*x, or x := A'*x, */ +BLAS_extern void +F77_NAME(dtpmv)(const char *uplo, const char *trans, const char *diag, + const int *n, const double *ap, + double *x, const int *incx); +/* DTRMV - perform one of the matrix-vector operations */ +/* x := A*x, or x := A'*x, */ +BLAS_extern void +F77_NAME(dtrmv)(const char *uplo, const char *trans, const char *diag, + const int *n, const double *a, const int *lda, + double *x, const int *incx); +/* DTBSV - solve one of the systems of equations */ +/* A*x = b, or A'*x = b, */ +BLAS_extern void +F77_NAME(dtbsv)(const char *uplo, const char *trans, + const char *diag, const int *n, const int *k, + const double *a, const int *lda, + double *x, const int *incx); +/* DTPSV - solve one of the systems of equations */ +/* A*x = b, or A'*x = b, */ +BLAS_extern void +F77_NAME(dtpsv)(const char *uplo, const char *trans, + const char *diag, const int *n, + const double *ap, double *x, const int *incx); +/* DTRSV - solve one of the systems of equations */ +/* A*x = b, or A'*x = b, */ +BLAS_extern void +F77_NAME(dtrsv)(const char *uplo, const char *trans, + const char *diag, const int *n, + const double *a, const int *lda, + double *x, const int *incx); +/* DGER - perform the rank 1 operation A := alpha*x*y' + A */ +BLAS_extern void +F77_NAME(dger)(const int *m, const int *n, const double *alpha, + const double *x, const int *incx, + const double *y, const int *incy, + double *a, const int *lda); +/* DSYR - perform the symmetric rank 1 operation A := alpha*x*x' + A */ +BLAS_extern void +F77_NAME(dsyr)(const char *uplo, const int *n, const double *alpha, + const double *x, const int *incx, + double *a, const int *lda); +/* DSPR - perform the symmetric rank 1 operation A := alpha*x*x' + A */ +BLAS_extern void +F77_NAME(dspr)(const char *uplo, const int *n, const double *alpha, + const double *x, const int *incx, double *ap); +/* DSYR2 - perform the symmetric rank 2 operation */ +/* A := alpha*x*y' + alpha*y*x' + A, */ +BLAS_extern void +F77_NAME(dsyr2)(const char *uplo, const int *n, const double *alpha, + const double *x, const int *incx, + const double *y, const int *incy, + double *a, const int *lda); +/* DSPR2 - perform the symmetric rank 2 operation */ +/* A := alpha*x*y' + alpha*y*x' + A, */ +BLAS_extern void +F77_NAME(dspr2)(const char *uplo, const int *n, const double *alpha, + const double *x, const int *incx, + const double *y, const int *incy, double *ap); + +/* Double Precision Level 3 BLAS */ + +/* DGEMM - perform one of the matrix-matrix operations */ +/* C := alpha*op( A )*op( B ) + beta*C */ +BLAS_extern void +F77_NAME(dgemm)(const char *transa, const char *transb, const int *m, + const int *n, const int *k, const double *alpha, + const double *a, const int *lda, + const double *b, const int *ldb, + const double *beta, double *c, const int *ldc); +/* DTRSM - solve one of the matrix equations */ +/* op(A)*X = alpha*B, or X*op(A) = alpha*B */ +BLAS_extern void +F77_NAME(dtrsm)(const char *side, const char *uplo, + const char *transa, const char *diag, + const int *m, const int *n, const double *alpha, + const double *a, const int *lda, + double *b, const int *ldb); +/* DTRMM - perform one of the matrix-matrix operations */ +/* B := alpha*op( A )*B, or B := alpha*B*op( A ) */ +BLAS_extern void +F77_NAME(dtrmm)(const char *side, const char *uplo, const char *transa, + const char *diag, const int *m, const int *n, + const double *alpha, const double *a, const int *lda, + double *b, const int *ldb); +/* DSYMM - perform one of the matrix-matrix operations */ +/* C := alpha*A*B + beta*C, */ +BLAS_extern void +F77_NAME(dsymm)(const char *side, const char *uplo, const int *m, + const int *n, const double *alpha, + const double *a, const int *lda, + const double *b, const int *ldb, + const double *beta, double *c, const int *ldc); +/* DSYRK - perform one of the symmetric rank k operations */ +/* C := alpha*A*A' + beta*C or C := alpha*A'*A + beta*C */ +BLAS_extern void +F77_NAME(dsyrk)(const char *uplo, const char *trans, + const int *n, const int *k, + const double *alpha, const double *a, const int *lda, + const double *beta, double *c, const int *ldc); +/* DSYR2K - perform one of the symmetric rank 2k operations */ +/* C := alpha*A*B' + alpha*B*A' + beta*C or */ +/* C := alpha*A'*B + alpha*B'*A + beta*C */ +BLAS_extern void +F77_NAME(dsyr2k)(const char *uplo, const char *trans, + const int *n, const int *k, + const double *alpha, const double *a, const int *lda, + const double *b, const int *ldb, + const double *beta, double *c, const int *ldc); +/* + LSAME is a LAPACK support routine, not part of BLAS +*/ + +/* Double complex BLAS routines added for 2.3.0 */ +/* #ifdef HAVE_FORTRAN_DOUBLE_COMPLEX */ + BLAS_extern double + F77_NAME(dcabs1)(const double *z); + BLAS_extern double + F77_NAME(dzasum)(const int *n, const Rcomplex *zx, const int *incx); + BLAS_extern double + F77_NAME(dznrm2)(const int *n, const Rcomplex *x, const int *incx); + BLAS_extern int + F77_NAME(izamax)(const int *n, const Rcomplex *zx, const int *incx); + BLAS_extern void + F77_NAME(zaxpy)(const int *n, const Rcomplex *za, const Rcomplex *zx, + const int *incx, const Rcomplex *zy, const int *incy); + BLAS_extern void + F77_NAME(zcopy)(const int *n, const Rcomplex *zx, const int *incx, + const Rcomplex *zy, const int *incy); + + /* WARNING! The next two return a value that may not be + compatible between C and Fortran, and even if it is, this might + not be the right translation to C. Only use after + configure-testing with your compilers. + */ + BLAS_extern Rcomplex + F77_NAME(zdotc)(const int *n, + const Rcomplex *zx, const int *incx, + const Rcomplex *zy, const int *incy); + BLAS_extern Rcomplex + F77_NAME(zdotu)(const int *n, + const Rcomplex *zx, const int *incx, + const Rcomplex *zy, const int *incy); + + BLAS_extern void + F77_NAME(zdrot)(const int *n, + const Rcomplex *zx, const int *incx, + Rcomplex *zy, const int *incy, + const double *c, const double *s); + BLAS_extern void + F77_NAME(zdscal)(const int *n, const double *da, + Rcomplex *zx, const int *incx); + BLAS_extern void + F77_NAME(zgbmv)(const char *trans, int *m, int *n, int *kl, + int *ku, Rcomplex *alpha, Rcomplex *a, int *lda, + Rcomplex *x, int *incx, Rcomplex *beta, Rcomplex *y, + int *incy); + BLAS_extern void + F77_NAME(zgemm)(const char *transa, const char *transb, const int *m, + const int *n, const int *k, const Rcomplex *alpha, + const Rcomplex *a, const int *lda, + const Rcomplex *b, const int *ldb, + const Rcomplex *beta, Rcomplex *c, const int *ldc); + BLAS_extern void + F77_NAME(zgemv)(const char *trans, const int *m, const int *n, + const Rcomplex *alpha, const Rcomplex *a, const int *lda, + const Rcomplex *x, const int *incx, const Rcomplex *beta, + Rcomplex *y, const int *incy); + BLAS_extern void + F77_NAME(zgerc)(const int *m, const int *n, const Rcomplex *alpha, + const Rcomplex *x, const int *incx, const Rcomplex *y, + const int *incy, Rcomplex *a, const int *lda); + BLAS_extern void + F77_NAME(zgeru)(const int *m, const int *n, const Rcomplex *alpha, + const Rcomplex *x, const int *incx, const Rcomplex *y, + const int *incy, Rcomplex *a, const int *lda); + BLAS_extern void + F77_NAME(zhbmv)(const char *uplo, const int *n, const int *k, + const Rcomplex *alpha, const Rcomplex *a, const int *lda, + const Rcomplex *x, const int *incx, const Rcomplex *beta, + Rcomplex *y, const int *incy); + BLAS_extern void + F77_NAME(zhemm)(const char *side, const char *uplo, const int *m, + const int *n, const Rcomplex *alpha, const Rcomplex *a, + const int *lda, const Rcomplex *b, const int *ldb, + const Rcomplex *beta, Rcomplex *c, const int *ldc); + BLAS_extern void + F77_NAME(zhemv)(const char *uplo, const int *n, const Rcomplex *alpha, + const Rcomplex *a, const int *lda, const Rcomplex *x, + const int *incx, const Rcomplex *beta, + Rcomplex *y, const int *incy); + BLAS_extern void + F77_NAME(zher)(const char *uplo, const int *n, const double *alpha, + const Rcomplex *x, const int *incx, Rcomplex *a, + const int *lda); + BLAS_extern void + F77_NAME(zher2)(const char *uplo, const int *n, const Rcomplex *alpha, + const Rcomplex *x, const int *incx, const Rcomplex *y, + const int *incy, Rcomplex *a, const int *lda); + BLAS_extern void + F77_NAME(zher2k)(const char *uplo, const char *trans, const int *n, + const int *k, const Rcomplex *alpha, const Rcomplex *a, + const int *lda, const Rcomplex *b, const int *ldb, + const double *beta, Rcomplex *c, const int *ldc); + BLAS_extern void + F77_NAME(zherk)(const char *uplo, const char *trans, const int *n, + const int *k, const double *alpha, const Rcomplex *a, + const int *lda, const double *beta, Rcomplex *c, + const int *ldc); + BLAS_extern void + F77_NAME(zhpmv)(const char *uplo, const int *n, const Rcomplex *alpha, + const Rcomplex *ap, const Rcomplex *x, const int *incx, + const Rcomplex * beta, Rcomplex *y, const int *incy); + BLAS_extern void + F77_NAME(zhpr)(const char *uplo, const int *n, const double *alpha, + const Rcomplex *x, const int *incx, Rcomplex *ap); + BLAS_extern void + F77_NAME(zhpr2)(const char *uplo, const int *n, const Rcomplex *alpha, + const Rcomplex *x, const int *incx, const Rcomplex *y, + const int *incy, Rcomplex *ap); + BLAS_extern void + F77_NAME(zrotg)(const Rcomplex *ca, const Rcomplex *cb, + double *c, Rcomplex *s); + BLAS_extern void + F77_NAME(zscal)(const int *n, const Rcomplex *za, Rcomplex *zx, + const int *incx); + BLAS_extern void + F77_NAME(zswap)(const int *n, Rcomplex *zx, const int *incx, + Rcomplex *zy, const int *incy); + BLAS_extern void + F77_NAME(zsymm)(const char *side, const char *uplo, const int *m, + const int *n, const Rcomplex *alpha, const Rcomplex *a, + const int *lda, const Rcomplex *b, const int *ldb, + const Rcomplex *beta, Rcomplex *c, const int *ldc); + BLAS_extern void + F77_NAME(zsyr2k)(const char *uplo, const char *trans, int *n, int *k, + Rcomplex *alpha, Rcomplex *a, int *lda, Rcomplex *b, + int *ldb, Rcomplex *beta, Rcomplex *c, int *ldc); + BLAS_extern void + F77_NAME(zsyrk)(const char *uplo, const char *trans, const int *n, + const int *k, const Rcomplex *alpha, const Rcomplex *a, + const int *lda, const Rcomplex *beta, Rcomplex *c, + const int *ldc); + BLAS_extern void + F77_NAME(ztbmv)(const char *uplo, const char *trans, const char *diag, + const int *n, const int *k, const Rcomplex *a, + const int *lda, Rcomplex *x, const int *incx); + BLAS_extern void + F77_NAME(ztbsv)(const char *uplo, const char *trans, const char *diag, + const int *n, const int *k, const Rcomplex *a, + const int *lda, Rcomplex *x, const int *incx); + BLAS_extern void + F77_NAME(ztpmv)(const char *uplo, const char *trans, const char *diag, + const int *n, const Rcomplex *ap, Rcomplex *x, + const int *incx); + BLAS_extern void + F77_NAME(ztpsv)(const char *uplo, const char *trans, const char *diag, + const int *n, const Rcomplex *ap, Rcomplex *x, + const int *incx); + BLAS_extern void + F77_NAME(ztrmm)(const char *side, const char *uplo, const char *transa, + const char *diag, const int *m, const int *n, + const Rcomplex *alpha, const Rcomplex *a, + const int *lda, Rcomplex *b, const int *ldb); + BLAS_extern void + F77_NAME(ztrmv)(const char *uplo, const char *trans, const char *diag, + const int *n, const Rcomplex *a, const int *lda, + Rcomplex *x, const int *incx); + BLAS_extern void + F77_NAME(ztrsm)(const char *side, const char *uplo, const char *transa, + const char *diag, int *m, int *n, Rcomplex *alpha, + Rcomplex *a, int *lda, Rcomplex *b, int *ldb); + BLAS_extern void + F77_NAME(ztrsv)(const char *uplo, const char *trans, const char *diag, + const int *n, const Rcomplex *a, const int *lda, + Rcomplex *x, const int *incx); +/* #endif */ + +#ifdef __cplusplus +} +#endif + +#endif /* R_BLAS_H */ diff --git a/com.oracle.truffle.r.native/gnur/patch/src/include/R_ext/Boolean.h b/com.oracle.truffle.r.native/gnur/patch/src/include/R_ext/Boolean.h new file mode 100644 index 0000000000000000000000000000000000000000..56bce4e4a0b3781e9108931ba3aabb53a0536050 --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/include/R_ext/Boolean.h @@ -0,0 +1,41 @@ +/* + * R : A Computer Language for Statistical Data Analysis + * Copyright (C) 2000, 2001 The R Core Team. + * + * This header file is free software; you can redistribute it and/or modify + * it under the terms of the GNU Lesser General Public License as published by + * the Free Software Foundation; either version 2.1 of the License, or + * (at your option) any later version. + * + * This file is part of R. R is distributed under the terms of the + * GNU General Public License, either Version 2, June 1991 or Version 3, + * June 2007. See doc/COPYRIGHTS for details of the copyright status of R. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public License + * along with this program; if not, a copy is available at + * https://www.R-project.org/Licenses/ + */ + +/* Included by R.h: API */ + +#ifndef R_EXT_BOOLEAN_H_ +#define R_EXT_BOOLEAN_H_ + +#undef FALSE +#undef TRUE + +#ifdef __cplusplus +extern "C" { +#endif +typedef enum { FALSE = 0, TRUE /*, MAYBE */ } Rboolean; + +#ifdef __cplusplus +} +#endif + +#endif /* R_EXT_BOOLEAN_H_ */ diff --git a/com.oracle.truffle.r.native/gnur/patch/src/include/R_ext/Callbacks.h b/com.oracle.truffle.r.native/gnur/patch/src/include/R_ext/Callbacks.h new file mode 100644 index 0000000000000000000000000000000000000000..c442391d34a8ae62d5e3d998247027f1d58a19a5 --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/include/R_ext/Callbacks.h @@ -0,0 +1,120 @@ +/* + * R : A Computer Language for Statistical Data Analysis + * Copyright (C) 2001-2016 The R Core Team. + * + * This header file is free software; you can redistribute it and/or modify + * it under the terms of the GNU Lesser General Public License as published by + * the Free Software Foundation; either version 2.1 of the License, or + * (at your option) any later version. + * + * This file is part of R. R is distributed under the terms of the + * GNU General Public License, either Version 2, June 1991 or Version 3, + * June 2007. See doc/COPYRIGHTS for details of the copyright status of R. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public License + * along with this program; if not, a copy is available at + * https://www.R-project.org/Licenses/ + */ + +/* + Not part of the API, subject to change at any time. +*/ + +#ifndef R_CALLBACKS_H +#define R_CALLBACKS_H + +/** + These structures are for C (and R function) top-level task handlers. + Such routines are called at the end of every (successful) top-level task + in the regular REPL. + */ + +#include <Rinternals.h> +/** + The signature of the C routine that a callback must implement. + expr - the expression for the top-level task that was evaluated. + value - the result of the top-level task, i.e. evaluating expr. + succeeded - a logical value indicating whether the task completed propertly. + visible - a logical value indicating whether the result was printed to the R ``console''/stdout. + data - user-level data passed to the registration routine. + */ +typedef Rboolean (*R_ToplevelCallback)(SEXP expr, SEXP value, Rboolean succeeded, Rboolean visible, void *); + +typedef struct _ToplevelCallback R_ToplevelCallbackEl; +/** + Linked list element for storing the top-level task callbacks. + */ +struct _ToplevelCallback { + R_ToplevelCallback cb; /* the C routine to call. */ + void *data; /* the user-level data to pass to the call to cb() */ + void (*finalizer)(void *data); /* Called when the callback is removed. */ + + char *name; /* a name by which to identify this element. */ + + R_ToplevelCallbackEl *next; /* the next element in the linked list. */ +}; + +#ifdef __cplusplus +extern "C" { +#endif + +Rboolean Rf_removeTaskCallbackByIndex(int id); +Rboolean Rf_removeTaskCallbackByName(const char *name); +SEXP R_removeTaskCallback(SEXP which); +R_ToplevelCallbackEl* Rf_addTaskCallback(R_ToplevelCallback cb, void *data, void (*finalizer)(void *), const char *name, int *pos); + + + +/* + The following definitions are for callbacks to R functions and + methods related to user-level tables. This was implemented in a + separate package on Omegahat and these declarations allow the package + to interface to the internal R code. + + See https://developer.r-project.org/RObjectTables.pdf, + http://www.omegahat.net/RObjectTables/ +*/ + +typedef struct _R_ObjectTable R_ObjectTable; + +/* Do we actually need the exists() since it is never called but R + uses get to see if the symbol is bound to anything? */ +typedef Rboolean (*Rdb_exists)(const char * const name, Rboolean *canCache, R_ObjectTable *); +typedef SEXP (*Rdb_get)(const char * const name, Rboolean *canCache, R_ObjectTable *); +typedef int (*Rdb_remove)(const char * const name, R_ObjectTable *); +typedef SEXP (*Rdb_assign)(const char * const name, SEXP value, R_ObjectTable *); +typedef SEXP (*Rdb_objects)(R_ObjectTable *); +typedef Rboolean (*Rdb_canCache)(const char * const name, R_ObjectTable *); + +typedef void (*Rdb_onDetach)(R_ObjectTable *); +typedef void (*Rdb_onAttach)(R_ObjectTable *); + +struct _R_ObjectTable{ + int type; + char **cachedNames; + Rboolean active; + + Rdb_exists exists; + Rdb_get get; + Rdb_remove remove; + Rdb_assign assign; + Rdb_objects objects; + Rdb_canCache canCache; + + Rdb_onDetach onDetach; + Rdb_onAttach onAttach; + + void *privateData; +}; + + +#ifdef __cplusplus +} +#endif + +#endif /* R_CALLBACKS_H */ diff --git a/com.oracle.truffle.r.native/gnur/patch/src/include/R_ext/Complex.h b/com.oracle.truffle.r.native/gnur/patch/src/include/R_ext/Complex.h new file mode 100644 index 0000000000000000000000000000000000000000..ecd8cb74165bf1c0b6e4b6f73b61ada0e324af71 --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/include/R_ext/Complex.h @@ -0,0 +1,42 @@ +/* + * R : A Computer Language for Statistical Data Analysis + * Copyright (C) 1998-2001 The R Core Team + * + * This header file is free software; you can redistribute it and/or modify + * it under the terms of the GNU Lesser General Public License as published by + * the Free Software Foundation; either version 2.1 of the License, or + * (at your option) any later version. + * + * This file is part of R. R is distributed under the terms of the + * GNU General Public License, either Version 2, June 1991 or Version 3, + * June 2007. See doc/COPYRIGHTS for details of the copyright status of R. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public License + * along with this program; if not, a copy is available at + * https://www.R-project.org/Licenses/ + */ + +/* Included by R.h: API */ + +#ifndef R_COMPLEX_H +#define R_COMPLEX_H + +#ifdef __cplusplus +extern "C" { +#endif + +typedef struct { + double r; + double i; +} Rcomplex; + +#ifdef __cplusplus +} +#endif + +#endif /* R_COMPLEX_H */ diff --git a/com.oracle.truffle.r.native/gnur/patch/src/include/R_ext/Connections.h b/com.oracle.truffle.r.native/gnur/patch/src/include/R_ext/Connections.h new file mode 100644 index 0000000000000000000000000000000000000000..3383d0e9464482a0bdf280b3727b51a9b1cb5077 --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/include/R_ext/Connections.h @@ -0,0 +1,95 @@ +/* + * R : A Computer Language for Statistical Data Analysis + * Copyright (C) 2000-2016 The R Core Team. + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version. + * + * This program 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 this program; if not, a copy is available at + * https://www.R-project.org/Licenses/ + */ + +#ifndef R_EXT_CONNECTIONS_H_ +#define R_EXT_CONNECTIONS_H_ + +#include <R_ext/Boolean.h> + +#if defined(__cplusplus) && !defined(DO_NOT_USE_CXX_HEADERS) +# include <cstddef> +# include <cstdarg> +#else +# include <stddef.h> /* for size_t */ +# include <stdarg.h> /* for va_list */ +#endif + +/* IMPORTANT: we do not expect future connection APIs to be + backward-compatible so if you use this, you *must* check the version + and proceed only if it matches what you expect + + We explicitly reserve the right to change the connection + implementation without a compatibility layer. + */ +#define R_CONNECTIONS_VERSION 1 + +/* this allows the opaque pointer definition to be made available + in Rinternals.h */ +#ifndef HAVE_RCONNECTION_TYPEDEF +typedef struct Rconn *Rconnection; +#endif +struct Rconn { + char* class; + char* description; + int enc; /* the encoding of 'description' */ + char mode[5]; + Rboolean text, isopen, incomplete, canread, canwrite, canseek, blocking, + isGzcon; + Rboolean (*open)(struct Rconn *); + void (*close)(struct Rconn *); /* routine closing after auto open */ + void (*destroy)(struct Rconn *); /* when closing connection */ + int (*vfprintf)(struct Rconn *, const char *, va_list); + int (*fgetc)(struct Rconn *); + int (*fgetc_internal)(struct Rconn *); + double (*seek)(struct Rconn *, double, int, int); + void (*truncate)(struct Rconn *); + int (*fflush)(struct Rconn *); + size_t (*read)(void *, size_t, size_t, struct Rconn *); + size_t (*write)(const void *, size_t, size_t, struct Rconn *); + int nPushBack, posPushBack; /* number of lines, position on top line */ + char **PushBack; + int save, save2; + char encname[101]; + /* will be iconv_t, which is a pointer. NULL if not in use */ + void *inconv, *outconv; + /* The idea here is that no MBCS char will ever not fit */ + char iconvbuff[25], oconvbuff[50], *next, init_out[25]; + short navail, inavail; + Rboolean EOF_signalled; + Rboolean UTF8out; + void *id; + void *ex_ptr; + void *private; + int status; /* for pipes etc */ +}; + +#ifdef __cplusplus +extern "C" { +#endif + +SEXP R_new_custom_connection(const char *description, const char *mode, const char *class_name, Rconnection *ptr); +size_t R_ReadConnection(Rconnection con, void *buf, size_t n); +size_t R_WriteConnection(Rconnection con, void *buf, size_t n); +Rconnection R_GetConnection(SEXP sConn); + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/com.oracle.truffle.r.native/gnur/patch/src/include/R_ext/Constants.h b/com.oracle.truffle.r.native/gnur/patch/src/include/R_ext/Constants.h new file mode 100644 index 0000000000000000000000000000000000000000..ba61397ebeedc08ae02d3376a1aaba0ec819cb19 --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/include/R_ext/Constants.h @@ -0,0 +1,48 @@ +/* + * R : A Computer Language for Statistical Data Analysis + * Copyright (C) 1995, 1996 Robert Gentleman and Ross Ihaka + * Copyright (C) 1998-2012 The R Core Team. + * + * This header file is free software; you can redistribute it and/or modify + * it under the terms of the GNU Lesser General Public License as published by + * the Free Software Foundation; either version 2.1 of the License, or + * (at your option) any later version. + * + * This file is part of R. R is distributed under the terms of the + * GNU General Public License, either Version 2, June 1991 or Version 3, + * June 2007. See doc/COPYRIGHTS for details of the copyright status of R. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public License + * along with this program; if not, a copy is available at + * https://www.R-project.org/Licenses/ + */ + +/* Included by R.h: API */ + +#ifndef R_EXT_CONSTANTS_H_ +#define R_EXT_CONSTANTS_H_ + +/* usually in math.h, but not with strict C99 compliance */ +#ifndef M_PI +#define M_PI 3.141592653589793238462643383279502884197169399375 +#endif + +#ifndef STRICT_R_HEADERS +#define PI M_PI +#include <float.h> /* Defines the rest, at least in C99 */ +#define SINGLE_EPS FLT_EPSILON +#define SINGLE_BASE FLT_RADIX +#define SINGLE_XMIN FLT_MIN +#define SINGLE_XMAX FLT_MAX +#define DOUBLE_DIGITS DBL_MANT_DIG +#define DOUBLE_EPS DBL_EPSILON +#define DOUBLE_XMAX DBL_MAX +#define DOUBLE_XMIN DBL_MIN +#endif + +#endif /* R_EXT_CONSTANTS_H_ */ diff --git a/com.oracle.truffle.r.native/gnur/patch/src/include/R_ext/Error.h b/com.oracle.truffle.r.native/gnur/patch/src/include/R_ext/Error.h new file mode 100644 index 0000000000000000000000000000000000000000..8d17d37f29b2b89b8dd652a6f9a6a47f5a9b8aaf --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/include/R_ext/Error.h @@ -0,0 +1,57 @@ +/* + * R : A Computer Language for Statistical Data Analysis + * Copyright (C) 1998-2005 The R Core Team + * + * This header file is free software; you can redistribute it and/or modify + * it under the terms of the GNU Lesser General Public License as published by + * the Free Software Foundation; either version 2.1 of the License, or + * (at your option) any later version. + * + * This file is part of R. R is distributed under the terms of the + * GNU General Public License, either Version 2, June 1991 or Version 3, + * June 2007. See doc/COPYRIGHTS for details of the copyright status of R. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public License + * along with this program; if not, a copy is available at + * https://www.R-project.org/Licenses/ + */ + +/* Included by R.h: API */ + +#ifndef R_ERROR_H_ +#define R_ERROR_H_ + +#ifdef __cplusplus +extern "C" { +#endif + +#if defined(__GNUC__) && __GNUC__ >= 3 +#define NORET __attribute__((noreturn)) +#else +#define NORET +#endif + +void NORET Rf_error(const char *, ...); +void NORET UNIMPLEMENTED(const char *); +void NORET WrongArgCount(const char *); + +void Rf_warning(const char *, ...); +void R_ShowMessage(const char *s); + + +#ifdef __cplusplus +} +#endif + +#ifndef R_NO_REMAP +#define error Rf_error +#define warning Rf_warning +#endif + + +#endif /* R_ERROR_H_ */ diff --git a/com.oracle.truffle.r.native/gnur/patch/src/include/R_ext/GetX11Image.h b/com.oracle.truffle.r.native/gnur/patch/src/include/R_ext/GetX11Image.h new file mode 100644 index 0000000000000000000000000000000000000000..07b4fd1b0069042a1c87908c98c1cacfe306ea1a --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/include/R_ext/GetX11Image.h @@ -0,0 +1,38 @@ +/* + * R : A Computer Language for Statistical Data Analysis + * Copyright (C) 2003-2016 R Core Team + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version. + * + * This program 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 this program; if not, a copy is available at + * https://www.R-project.org/Licenses/ + */ + +/* Unix-only header */ + +#ifndef GETX11IMAGE_H_ +#define GETX11IMAGE_H_ + +#ifdef __cplusplus +extern "C" { +#endif + +/* used by package tkrplot */ + +Rboolean R_GetX11Image(int d, void *pximage, int *pwidth, int *pheight); +/* pximage is really (XImage **) */ + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/com.oracle.truffle.r.native/gnur/patch/src/include/R_ext/GraphicsDevice.h b/com.oracle.truffle.r.native/gnur/patch/src/include/R_ext/GraphicsDevice.h new file mode 100644 index 0000000000000000000000000000000000000000..d2604daf98e7a45b528ba926349f45cc130d1e4d --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/include/R_ext/GraphicsDevice.h @@ -0,0 +1,869 @@ +/* + * R : A Computer Language for Statistical Data Analysis + * Copyright (C) 2001-11 The R Core Team. + * + * This header file is free software; you can redistribute it and/or modify + * it under the terms of the GNU Lesser General Public License as published by + * the Free Software Foundation; either version 2.1 of the License, or + * (at your option) any later version. + * + * This file is part of R. R is distributed under the terms of the + * GNU General Public License, either Version 2, June 1991 or Version 3, + * June 2007. See doc/COPYRIGHTS for details of the copyright status of R. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public License + * along with this program; if not, a copy is available at + * https://www.R-project.org/Licenses/ + */ + +/* Used by third-party graphics devices. + * + * This defines DevDesc, whereas GraphicsEngine.h defines GEDevDesc. + * Also contains entry points from gevents.c + */ + +#ifndef R_GRAPHICSDEVICE_H_ +#define R_GRAPHICSDEVICE_H_ + + +/* ideally we would use prototypes in DevDesc. + Some devices have taken to passing pointers to their own structure + instead of DevDesc* , defining R_USE_PROTOTYPES 0 allows them to + opt out. +*/ + +#ifndef R_USE_PROTOTYPES +# define R_USE_PROTOTYPES 1 +# ifndef R_GRAPHICSENGINE_H_ +# error R_ext/GraphicsEngine.h must be included first, and includes this header +# endif +#endif + +#include <R_ext/Boolean.h> + +#ifdef __cplusplus +extern "C" { +#endif + +/* --------- New (in 1.4.0) device driver structure --------- + * NOTES: + * 1. All locations and dimensions are in device coordinates. + * 2. I found this comment in the doc for dev_Open -- looks nasty + * Any known instances of such a thing happening? Should be + * replaced by a function to query the device for preferred gpars + * settings? (to be called when the device is initialised) + * + * NOTE that it is perfectly acceptable for this + * function to set generic graphics parameters too + * (i.e., override the generic parameter settings + * which GInit sets up) all at the author's own risk + * of course :) + * + * 3. Do we really need dev_StrWidth as well as dev_MetricInfo? + * I can see the difference between the two -- its just a + * question of whether dev_MetricInfo should just return + * what dev_StrWidth would give if font metric information is + * not available. I guess having both allows the developer + * to decide when to ask for which sort of value, and to decide + * what to do when font metric information is not available. + * And why not a dev_StrHeight? + * 4. Should "ipr", "asp", and "cra" be in the device description? + * If not, then where? + * I guess they don't need to be if no device makes use of them. + * On the other hand, they would need to be replaced by a device + * call that R base graphics could use to get enough information + * to figure them out. (e.g., some sort of dpi() function to + * complement the size() function.) + */ + +typedef struct _DevDesc DevDesc; +typedef DevDesc* pDevDesc; + +struct _DevDesc { + /******************************************************** + * Device physical characteristics + ********************************************************/ + double left; /* left raster coordinate */ + double right; /* right raster coordinate */ + double bottom; /* bottom raster coordinate */ + double top; /* top raster coordinate */ + /* R only has the notion of a rectangular clipping region + */ + double clipLeft; + double clipRight; + double clipBottom; + double clipTop; + /* I hate these next three -- they seem like a real fudge + * BUT I'm not sure what to replace them with so they stay for now. + */ + double xCharOffset; /* x character addressing offset - unused */ + double yCharOffset; /* y character addressing offset */ + double yLineBias; /* 1/2 interline space as frac of line height */ + double ipr[2]; /* Inches per raster; [0]=x, [1]=y */ + /* I hate this guy too -- seems to assume that a device can only + * have one font size during its lifetime + * BUT removing/replacing it would take quite a lot of work + * to design and insert a good replacement so it stays for now. + */ + double cra[2]; /* Character size in rasters; [0]=x, [1]=y */ + double gamma; /* (initial) Device Gamma Correction */ + /******************************************************** + * Device capabilities + ********************************************************/ + Rboolean canClip; /* Device-level clipping */ + Rboolean canChangeGamma; /* can the gamma factor be modified? */ + int canHAdj; /* Can do at least some horiz adjust of text + 0 = none, 1 = {0,0.5,1}, 2 = [0,1] */ + /******************************************************** + * Device initial settings + ********************************************************/ + /* These are things that the device must set up when it is created. + * The graphics system can modify them and track current values, + */ + double startps; + int startcol; /* sets par("fg"), par("col") and gpar("col") */ + int startfill; /* sets par("bg") and gpar("fill") */ + int startlty; + int startfont; + double startgamma; + /******************************************************** + * Device specific information + ********************************************************/ + void *deviceSpecific; /* pointer to device specific parameters */ + /******************************************************** + * Device display list + ********************************************************/ + Rboolean displayListOn; /* toggle for initial display list status */ + + + /******************************************************** + * Event handling entries + ********************************************************/ + + /* Used in do_setGraphicsEventEnv */ + + Rboolean canGenMouseDown; /* can the device generate mousedown events */ + Rboolean canGenMouseMove; /* can the device generate mousemove events */ + Rboolean canGenMouseUp; /* can the device generate mouseup events */ + Rboolean canGenKeybd; /* can the device generate keyboard events */ + Rboolean canGenIdle; /* can the device generate idle events */ + + Rboolean gettingEvent; /* This is set while getGraphicsEvent + is actively looking for events */ + + /******************************************************** + * Device procedures. + ********************************************************/ + + /* + * --------------------------------------- + * GENERAL COMMENT ON GRAPHICS PARAMETERS: + * --------------------------------------- + * Graphical parameters are now passed in a pointer to a + * graphics context structure (pGEcontext) rather than individually. + * Each device action should extract the parameters it needs + * and ignore the others. Thought should be given to which + * parameters are relevant in each case -- the graphics engine + * does not REQUIRE that each parameter is honoured, but if + * a parameter is NOT honoured, it might be a good idea to + * issue a warning when a parameter is not honoured (or at + * the very least document which parameters are not honoured + * in the user-level documentation for the device). [An example + * of a parameter that may not be honoured by many devices is + * transparency.] + */ + + /* + * device_Activate is called when a device becomes the + * active device. For example, it can be used to change the + * title of a window to indicate the active status of + * the device to the user. Not all device types will + * do anything. + * The only parameter is a device driver structure. + * An example is ... + * + * static void X11_Activate(pDevDesc dd); + * + * As from R 2.14.0 this can be omitted or set to NULL. + */ +#if R_USE_PROTOTYPES + void (*activate)(const pDevDesc ); +#else + void (*activate)(); +#endif + /* + * device_Circle should have the side-effect that a + * circle is drawn, centred at the given location, with + * the given radius. + * (If the device has non-square pixels, 'radius' should + * be interpreted in the units of the x direction.) + * The border of the circle should be + * drawn in the given "col", and the circle should be + * filled with the given "fill" colour. + * If "col" is NA_INTEGER then no border should be drawn + * If "fill" is NA_INTEGER then the circle should not + * be filled. + * An example is ... + * + * static void X11_Circle(double x, double y, double r, + * pGEcontext gc, + * pDevDesc dd); + * + * R_GE_gcontext parameters that should be honoured (if possible): + * col, fill, gamma, lty, lwd + */ +#if R_USE_PROTOTYPES + void (*circle)(double x, double y, double r, const pGEcontext gc, pDevDesc dd); +#else + void (*circle)(); +#endif + /* + * device_Clip is given the left, right, bottom, and + * top of a rectangle (in DEVICE coordinates). + * It should have the side-effect that subsequent output + * is clipped to the given rectangle. + * NOTE that R's graphics engine already clips to the + * extent of the device. + * NOTE also that this will probably only be called if + * the flag canClip is true. + * An example is ... + * + * static void X11_Clip(double x0, double x1, double y0, double y1, + * pDevDesc dd) + */ +#if R_USE_PROTOTYPES + void (*clip)(double x0, double x1, double y0, double y1, pDevDesc dd); +#else + void (*clip)(); +#endif + /* + * device_Close is called when the device is killed. + * This function is responsible for destroying any + * device-specific resources that were created in + * device_Open and for FREEing the device-specific + * parameters structure. + * An example is ... + * + * static void X11_Close(pDevDesc dd) + * + */ +#if R_USE_PROTOTYPES + void (*close)(pDevDesc dd); +#else + void (*close)(); +#endif + /* + * device_Deactivate is called when a device becomes + * inactive. + * This allows the device to undo anything it did in + * dev_Activate. + * Not all device types will do anything. + * An example is ... + * + * static void X11_Deactivate(pDevDesc dd) + * + * As from R 2.14.0 this can be omitted or set to NULL. + */ +#if R_USE_PROTOTYPES + void (*deactivate)(pDevDesc ); +#else + void (*deactivate)(); +#endif + + + /* + * device_Locator should return the location of the next + * mouse click (in DEVICE coordinates) + * Not all devices will do anything (e.g., postscript) + * An example is ... + * + * static Rboolean X11_Locator(double *x, double *y, pDevDesc dd) + * + * As from R 2.14.0 this can be omitted or set to NULL. + */ +#if R_USE_PROTOTYPES + Rboolean (*locator)(double *x, double *y, pDevDesc dd); +#else + Rboolean (*locator)(); +#endif + /* + * device_Line should have the side-effect that a single + * line is drawn (from x1,y1 to x2,y2) + * An example is ... + * + * static void X11_Line(double x1, double y1, double x2, double y2, + * const pGEcontext gc, + * pDevDesc dd); + * + * R_GE_gcontext parameters that should be honoured (if possible): + * col, gamma, lty, lwd + */ +#if R_USE_PROTOTYPES + void (*line)(double x1, double y1, double x2, double y2, + const pGEcontext gc, pDevDesc dd); +#else + void (*line)(); +#endif + /* + * device_MetricInfo should return height, depth, and + * width information for the given character in DEVICE + * units. + * Note: in an 8-bit locale, c is 'char'. + * In an mbcslocale, it is wchar_t, and at least some + * of code assumes that is UCS-2 (Windows, true) or UCS-4. + * This is used for formatting mathematical expressions + * and for exact centering of text (see GText) + * If the device cannot provide metric information then + * it MUST return 0.0 for ascent, descent, and width. + * An example is ... + * + * static void X11_MetricInfo(int c, + * const pGEcontext gc, + * double* ascent, double* descent, + * double* width, pDevDesc dd); + * + * R_GE_gcontext parameters that should be honoured (if possible): + * font, cex, ps + */ +#if R_USE_PROTOTYPES + void (*metricInfo)(int c, const pGEcontext gc, + double* ascent, double* descent, double* width, + pDevDesc dd); +#else + void (*metricInfo)(); +#endif + /* + * device_Mode is called whenever the graphics engine + * starts drawing (mode=1) or stops drawing (mode=0) + * GMode (in graphics.c) also says that + * mode = 2 (graphical input on) exists. + * The device is not required to do anything + * An example is ... + * + * static void X11_Mode(int mode, pDevDesc dd); + * + * As from R 2.14.0 this can be omitted or set to NULL. + */ +#if R_USE_PROTOTYPES + void (*mode)(int mode, pDevDesc dd); +#else + void (*mode)(); +#endif + /* + * device_NewPage is called whenever a new plot requires + * a new page. + * A new page might mean just clearing the + * device (e.g., X11) or moving to a new page + * (e.g., postscript) + * An example is ... + * + * + * static void X11_NewPage(const pGEcontext gc, + * pDevDesc dd); + * + */ +#if R_USE_PROTOTYPES + void (*newPage)(const pGEcontext gc, pDevDesc dd); +#else + void (*newPage)(); +#endif + /* + * device_Polygon should have the side-effect that a + * polygon is drawn using the given x and y values + * the polygon border should be drawn in the "col" + * colour and filled with the "fill" colour. + * If "col" is NA_INTEGER don't draw the border + * If "fill" is NA_INTEGER don't fill the polygon + * An example is ... + * + * static void X11_Polygon(int n, double *x, double *y, + * const pGEcontext gc, + * pDevDesc dd); + * + * R_GE_gcontext parameters that should be honoured (if possible): + * col, fill, gamma, lty, lwd + */ +#if R_USE_PROTOTYPES + void (*polygon)(int n, double *x, double *y, const pGEcontext gc, pDevDesc dd); +#else + void (*polygon)(); +#endif + /* + * device_Polyline should have the side-effect that a + * series of line segments are drawn using the given x + * and y values. + * An example is ... + * + * static void X11_Polyline(int n, double *x, double *y, + * const pGEcontext gc, + * pDevDesc dd); + * + * R_GE_gcontext parameters that should be honoured (if possible): + * col, gamma, lty, lwd + */ +#if R_USE_PROTOTYPES + void (*polyline)(int n, double *x, double *y, const pGEcontext gc, pDevDesc dd); +#else + void (*polyline)(); +#endif + /* + * device_Rect should have the side-effect that a + * rectangle is drawn with the given locations for its + * opposite corners. The border of the rectangle + * should be in the given "col" colour and the rectangle + * should be filled with the given "fill" colour. + * If "col" is NA_INTEGER then no border should be drawn + * If "fill" is NA_INTEGER then the rectangle should not + * be filled. + * An example is ... + * + * static void X11_Rect(double x0, double y0, double x1, double y1, + * const pGEcontext gc, + * pDevDesc dd); + * + */ +#if R_USE_PROTOTYPES + void (*rect)(double x0, double y0, double x1, double y1, + const pGEcontext gc, pDevDesc dd); +#else + void (*rect)(); +#endif + /* + * device_Path should draw one or more sets of points + * as a single path + * + * 'x' and 'y' give the points + * + * 'npoly' gives the number of polygons in the path + * MUST be at least 1 + * + * 'nper' gives the number of points in each polygon + * each value MUST be at least 2 + * + * 'winding' says whether to fill using the nonzero + * winding rule or the even-odd rule + * + * Added 2010-06-27 + * + * As from R 2.13.2 this can be left unimplemented as NULL. + */ +#if R_USE_PROTOTYPES + void (*path)(double *x, double *y, + int npoly, int *nper, + Rboolean winding, + const pGEcontext gc, pDevDesc dd); +#else + void (*path)(); +#endif + /* + * device_Raster should draw a raster image justified + * at the given location, + * size, and rotation (not all devices may be able to rotate?) + * + * 'raster' gives the image data BY ROW, with every four bytes + * giving one R colour (ABGR). + * + * 'x and 'y' give the bottom-left corner. + * + * 'rot' is in degrees (as per device_Text), with positive + * rotation anticlockwise from the positive x-axis. + * + * As from R 2.13.2 this can be left unimplemented as NULL. + */ +#if R_USE_PROTOTYPES + void (*raster)(unsigned int *raster, int w, int h, + double x, double y, + double width, double height, + double rot, + Rboolean interpolate, + const pGEcontext gc, pDevDesc dd); +#else + void (*raster)(); +#endif + /* + * device_Cap should return an integer matrix (R colors) + * representing the current contents of the device display. + * + * The result is expected to be ROW FIRST. + * + * This will only make sense for raster devices and can + * probably only be implemented for screen devices. + * + * added 2010-06-27 + * + * As from R 2.13.2 this can be left unimplemented as NULL. + * For earlier versions of R it should return R_NilValue. + */ +#if R_USE_PROTOTYPES + SEXP (*cap)(pDevDesc dd); +#else + SEXP (*cap)(); +#endif + /* + * device_Size is called whenever the device is + * resized. + * The function returns (left, right, bottom, and top) for the + * new device size. + * This is not usually called directly by the graphics + * engine because the detection of device resizes + * (e.g., a window resize) are usually detected by + * device-specific code. + * An example is ... + * + * static void X11_Size(double *left, double *right, + * double *bottom, double *top, + * pDevDesc dd); + * + * R_GE_gcontext parameters that should be honoured (if possible): + * col, fill, gamma, lty, lwd + * + * As from R 2.13.2 this can be left unimplemented as NULL. + */ +#if R_USE_PROTOTYPES + void (*size)(double *left, double *right, double *bottom, double *top, + pDevDesc dd); +#else + void (*size)(); +#endif + /* + * device_StrWidth should return the width of the given + * string in DEVICE units. + * An example is ... + * + * static double X11_StrWidth(const char *str, + * const pGEcontext gc, + * pDevDesc dd) + * + * R_GE_gcontext parameters that should be honoured (if possible): + * font, cex, ps + */ +#if R_USE_PROTOTYPES + double (*strWidth)(const char *str, const pGEcontext gc, pDevDesc dd); +#else + double (*strWidth)(); +#endif + /* + * device_Text should have the side-effect that the + * given text is drawn at the given location. + * The text should be rotated according to rot (degrees) + * An example is ... + * + * static void X11_Text(double x, double y, const char *str, + * double rot, double hadj, + * const pGEcontext gc, + * pDevDesc dd); + * + * R_GE_gcontext parameters that should be honoured (if possible): + * font, cex, ps, col, gamma + */ +#if R_USE_PROTOTYPES + void (*text)(double x, double y, const char *str, double rot, + double hadj, const pGEcontext gc, pDevDesc dd); +#else + void (*text)(); +#endif + /* + * device_onExit is called by GEonExit when the user has aborted + * some operation, and so an R_ProcessEvents call may not return normally. + * It need not be set to any value; if null, it will not be called. + * + * An example is ... + * + * static void GA_onExit(pDevDesc dd); + */ +#if R_USE_PROTOTYPES + void (*onExit)(pDevDesc dd); +#else + void (*onExit)(); +#endif + /* + * device_getEvent is no longer used, but the slot is kept for back + * compatibility of the structure. + */ + SEXP (*getEvent)(SEXP, const char *); + + /* --------- Optional features introduced in 2.7.0 --------- */ + + /* Does the device have a device-specific way to confirm a + new frame (for e.g. par(ask=TRUE))? + This should be NULL if it does not. + If it does, it returns TRUE if the device handled this, and + FALSE if it wants the engine to do so. + + There is an example in the windows() device. + + Can be left unimplemented as NULL. + */ +#if R_USE_PROTOTYPES + Rboolean (*newFrameConfirm)(pDevDesc dd); +#else + Rboolean (*newFrameConfirm)(); +#endif + + /* Some devices can plot UTF-8 text directly without converting + to the native encoding, e.g. windows(), quartz() .... + + If this flag is true, all text *not in the symbol font* is sent + in UTF8 to the textUTF8/strWidthUTF8 entry points. + + If the flag is TRUE, the metricInfo entry point should + accept negative values for 'c' and treat them as indicating + Unicode points (as well as positive values in a MBCS locale). + */ + Rboolean hasTextUTF8; /* and strWidthUTF8 */ +#if R_USE_PROTOTYPES + void (*textUTF8)(double x, double y, const char *str, double rot, + double hadj, const pGEcontext gc, pDevDesc dd); + double (*strWidthUTF8)(const char *str, const pGEcontext gc, pDevDesc dd); +#else + void (*textUTF8)(); + double (*strWidthUTF8)(); +#endif + Rboolean wantSymbolUTF8; + + /* Is rotated text good enough to be preferable to Hershey in + contour labels? Old default was FALSE. + */ + Rboolean useRotatedTextInContour; + + /* --------- Post-2.7.0 features --------- */ + + /* Added in 2.12.0: Changed graphics event handling. */ + + SEXP eventEnv; /* This is an environment holding event handlers. */ + /* + * eventHelper(dd, 1) is called by do_getGraphicsEvent before looking for a + * graphics event. It will then call R_ProcessEvents() and eventHelper(dd, 2) + * until this or another device returns sets a non-null result value in eventEnv, + * at which time eventHelper(dd, 0) will be called. + * + * An example is ... + * + * static SEXP GA_eventHelper(pDevDesc dd, int code); + + * Can be left unimplemented as NULL + */ +#if R_USE_PROTOTYPES + void (*eventHelper)(pDevDesc dd, int code); +#else + void (*eventHelper)(); +#endif + + /* added in 2.14.0, only used by screen devices. + + Allows graphics devices to have multiple levels of suspension: + when this reaches zero output is flushed. + + Can be left unimplemented as NULL. + */ +#if R_USE_PROTOTYPES + int (*holdflush)(pDevDesc dd, int level); +#else + int (*holdflush)(); +#endif + + /* added in 2.14.0, for dev.capabilities. + In all cases 0 means NA (unset). + */ + int haveTransparency; /* 1 = no, 2 = yes */ + int haveTransparentBg; /* 1 = no, 2 = fully, 3 = semi */ + int haveRaster; /* 1 = no, 2 = yes, 3 = except for missing values */ + int haveCapture, haveLocator; /* 1 = no, 2 = yes */ + + + /* Area for future expansion. + By zeroing this, devices are more likely to work if loaded + into a later version of R than that they were compiled under. + */ + char reserved[64]; +}; + + + /********************************************************/ + /* the device-driver entry point is given a device */ + /* description structure that it must set up. this */ + /* involves several important jobs ... */ + /* (1) it must ALLOCATE a new device-specific parameters*/ + /* structure and FREE that structure if anything goes */ + /* wrong (i.e., it won't report a successful setup to */ + /* the graphics engine (the graphics engine is NOT */ + /* responsible for allocating or freeing device-specific*/ + /* resources or parameters) */ + /* (2) it must initialise the device-specific resources */ + /* and parameters (mostly done by calling device_Open) */ + /* (3) it must initialise the generic graphical */ + /* parameters that are not initialised by GInit (because*/ + /* only the device knows what values they should have) */ + /* see Graphics.h for the official list of these */ + /* (4) it may reset generic graphics parameters that */ + /* have already been initialised by GInit (although you */ + /* should know what you are doing if you do this) */ + /* (5) it must attach the device-specific parameters */ + /* structure to the device description structure */ + /* e.g., dd->deviceSpecfic = (void *) xd; */ + /* (6) it must FREE the overall device description if */ + /* it wants to bail out to the top-level */ + /* the graphics engine is responsible for allocating */ + /* the device description and freeing it in most cases */ + /* but if the device driver freaks out it needs to do */ + /* the clean-up itself */ + /********************************************************/ + +/* moved from Rgraphics.h */ + +/* + * Some Notes on Color + * + * R uses a 24-bit color model. Colors are specified in 32-bit + * integers which are partitioned into 4 bytes as follows. + * + * <-- most sig least sig --> + * +-------------------------------+ + * | 0 | blue | green | red | + * +-------------------------------+ + * + * The red, green and blue bytes can be extracted as follows. + * + * red = ((color ) & 255) + * green = ((color >> 8) & 255) + * blue = ((color >> 16) & 255) + */ +/* + * Changes as from 1.4.0: use top 8 bits as an alpha channel. + * 0 = opaque, 255 = transparent. + */ +/* + * Changes as from 2.0.0: use top 8 bits as full alpha channel + * 255 = opaque, 0 = transparent + * [to conform with SVG, PDF and others] + * and everything in between is used + * [which means that NA is not stored as an internal colour; + * it is converted to R_RGBA(255, 255, 255, 0)] + */ + +#define R_RGB(r,g,b) ((r)|((g)<<8)|((b)<<16)|0xFF000000) +#define R_RGBA(r,g,b,a) ((r)|((g)<<8)|((b)<<16)|((a)<<24)) +#define R_RED(col) (((col) )&255) +#define R_GREEN(col) (((col)>> 8)&255) +#define R_BLUE(col) (((col)>>16)&255) +#define R_ALPHA(col) (((col)>>24)&255) +#define R_OPAQUE(col) (R_ALPHA(col) == 255) +#define R_TRANSPARENT(col) (R_ALPHA(col) == 0) + /* + * A transparent white + */ +#define R_TRANWHITE (R_RGBA(255, 255, 255, 0)) + + +/* used in various devices */ + +#define curDevice Rf_curDevice +#define killDevice Rf_killDevice +#define ndevNumber Rf_ndevNumber +#define NewFrameConfirm Rf_NewFrameConfirm +#define nextDevice Rf_nextDevice +#define NoDevices Rf_NoDevices +#define NumDevices Rf_NumDevices +#define prevDevice Rf_prevDevice +#define selectDevice Rf_selectDevice +#define AdobeSymbol2utf8 Rf_AdobeSymbol2utf8 + +/* Properly declared version of devNumber */ +int ndevNumber(pDevDesc ); + +/* How many devices exist ? (>= 1) */ +int NumDevices(void); + +/* Check for an available device slot */ +void R_CheckDeviceAvailable(void); +Rboolean R_CheckDeviceAvailableBool(void); + +/* Return the number of the current device. */ +int curDevice(void); + +/* Return the number of the next device. */ +int nextDevice(int); + +/* Return the number of the previous device. */ +int prevDevice(int); + +/* Make the specified device (specified by number) the current device */ +int selectDevice(int); + +/* Kill device which is identified by number. */ +void killDevice(int); + +int NoDevices(void); /* used in engine, graphics, plot, grid */ + +void NewFrameConfirm(pDevDesc); /* used in graphics.c, grid */ + + +/* Graphics events: defined in gevents.c */ + +/* These give the indices of some known keys */ + +typedef enum {knUNKNOWN = -1, + knLEFT = 0, knUP, knRIGHT, knDOWN, + knF1, knF2, knF3, knF4, knF5, knF6, knF7, knF8, knF9, knF10, + knF11, knF12, + knPGUP, knPGDN, knEND, knHOME, knINS, knDEL} R_KeyName; + +/* These are the three possible mouse events */ + +typedef enum {meMouseDown = 0, + meMouseUp, + meMouseMove} R_MouseEvent; + +#define leftButton 1 +#define middleButton 2 +#define rightButton 4 + +#define doKeybd Rf_doKeybd +#define doMouseEvent Rf_doMouseEvent +#define doIdle Rf_doIdle +#define doesIdle Rf_doesIdle + +void doMouseEvent(pDevDesc dd, R_MouseEvent event, + int buttons, double x, double y); +void doKeybd(pDevDesc dd, R_KeyName rkey, + const char *keyname); +void doIdle(pDevDesc dd); +Rboolean doesIdle(pDevDesc dd); + +/* For use in third-party devices when setting up a device: + * duplicates Defn.h which is used internally. + * (Tested in devNull.c) + */ + +#ifndef BEGIN_SUSPEND_INTERRUPTS +/* Macros for suspending interrupts */ +#define BEGIN_SUSPEND_INTERRUPTS do { \ + Rboolean __oldsusp__ = R_interrupts_suspended; \ + R_interrupts_suspended = TRUE; +#define END_SUSPEND_INTERRUPTS R_interrupts_suspended = __oldsusp__; \ + if (R_interrupts_pending && ! R_interrupts_suspended) \ + Rf_onintr(); \ +} while(0) + +#include <R_ext/libextern.h> +LibExtern Rboolean R_interrupts_suspended; +LibExtern int R_interrupts_pending; +extern void Rf_onintr(void); +LibExtern Rboolean mbcslocale; +#endif + +/* Useful for devices: translates Adobe symbol encoding to UTF-8 */ +extern void *AdobeSymbol2utf8(char*out, const char *in, size_t nwork); +/* Translates Unicode point to UTF-8 */ +extern size_t Rf_ucstoutf8(char *s, const unsigned int c); + +#ifdef __cplusplus +} +#endif + +#endif /* R_GRAPHICSDEVICE_ */ diff --git a/com.oracle.truffle.r.native/gnur/patch/src/include/R_ext/GraphicsEngine.h b/com.oracle.truffle.r.native/gnur/patch/src/include/R_ext/GraphicsEngine.h new file mode 100644 index 0000000000000000000000000000000000000000..e4b13e3ddf91315007d19bf10be0f98eee6fc2c4 --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/include/R_ext/GraphicsEngine.h @@ -0,0 +1,530 @@ +/* + * R : A Computer Language for Statistical Data Analysis + * Copyright (C) 2001-11 The R Core Team. + * + * This header file is free software; you can redistribute it and/or modify + * it under the terms of the GNU Lesser General Public License as published by + * the Free Software Foundation; either version 2.1 of the License, or + * (at your option) any later version. + * + * This file is part of R. R is distributed under the terms of the + * GNU General Public License, either Version 2, June 1991 or Version 3, + * June 2007. See doc/COPYRIGHTS for details of the copyright status of R. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public License + * along with this program; if not, a copy is available at + * https://www.R-project.org/Licenses/ + */ + +/* Used by graphics.c, grid and by third-party graphics devices */ + +#ifndef R_GRAPHICSENGINE_H_ +#define R_GRAPHICSENGINE_H_ + +#ifdef __cplusplus +extern "C" { +#endif + +/* + * The current graphics engine (including graphics device) API version + * MUST be integer + * + * This number should be bumped whenever there are changes to + * GraphicsEngine.h or GraphicsDevice.h so that add-on packages + * that compile against these headers (graphics systems such as + * graphics and grid; graphics devices such as gtkDevice, RSvgDevice) + * can detect any version mismatch. + * + * Version 1: Introduction of the version number. + * Version 2: GEDevDesc *dd dropped from GEcontourLines(). + * Version 3: R_GE_str2col() added to API. (r41887) + * Version 4: UTF-8 text hooks, useRotatedTextInContour, + * add newFrameConfirm() to NewDevDesc. + * New API: GEaddDevice[2] GEgetDevice, GEkillDevice, + * ndevNumber. (R 2.7.0) + * Version 5: Clean up 1.4.0/2.0.0 changes! + * Remove newDevStruct from GEDevDesc and NewDevDesc. + * Remove asp, dot(), hold(), open() from NewDevDesc. + * Move displayList, DLlastElt, savedSnapshot from + * NewDevDesc to GEDevDesc. + * Add 'ask' to GEDevDesc. (R 2.8.0) + * Version 6: Add dev_Raster() and dev_Cap() (R 2.11.0) + * Version 7: Change graphics event handling, adding eventEnv and eventHelper() + * to DevDesc. (R 2.12.0) + * Version 8: Add dev_Path() (R 2.12.0) + * Version 9: Add dev_HoldFlush(), haveTrans*, haveRaster, + * haveCapture, haveLocator. (R 2.14.0) + * Version 10: For R 3.0.0. Typedef and use 'rcolor', + * Remove name2col (R_GE_str2col does the job). + * Version 11: For R 3.3.0. + * Official support for saving/restoring display lists + * across R sessions (via recordPlot() and replayPlot()) + * - added grid DL to snapshots (used to be NULL) + * - added this version number to snapshots (as attribute) + * - added R version number to snapshots (as attribute) + * - added pkgName to graphics system state info (as attribute) + * Version 12: For R 3.4.0 + * Added canGenIndle, doIdle() and doesIdle() to devices. + */ + +#define R_GE_version 12 + +int R_GE_getVersion(void); + +void R_GE_checkVersionOrDie(int version); + +/* The graphics engine will only accept locations and dimensions + * in native device coordinates, but it provides the following functions + * for converting between a couple of simple alternative coordinate + * systems and device coordinates: + * DEVICE = native units of the device + * NDC = Normalised device coordinates + * INCHES = inches (!) + * CM = centimetres (!!) + */ + +typedef enum { + GE_DEVICE = 0, /* native device coordinates (rasters) */ + GE_NDC = 1, /* normalised device coordinates x=(0,1), y=(0,1) */ + GE_INCHES = 2, + GE_CM = 3 +} GEUnit; + +#define MAX_GRAPHICS_SYSTEMS 24 + +typedef enum { + /* In response to this event, the registered graphics system + * should allocate and initialise the systemSpecific structure + * + * Should return R_NilValue on failure so that engine + * can tidy up memory allocation + */ + GE_InitState = 0, + /* This event gives the registered system a chance to undo + * anything done in the initialisation. + */ + GE_FinaliseState = 1, + /* This is sent by the graphics engine prior to initialising + * the display list. It give the graphics system the chance + * to squirrel away information it will need for redrawing the + * the display list + */ + GE_SaveState = 2, + /* This is sent by the graphics engine prior to replaying the + * display list. It gives the graphics system the chance to + * restore any information it saved on the GE_SaveState event + */ + GE_RestoreState = 6, + /* Copy system state information to the current device. + * This is used when copying graphics from one device to another + * so all the graphics system needs to do is to copy across + * the bits required for the display list to draw faithfully + * on the new device. + */ + GE_CopyState = 3, + /* Create a snapshot of the system state that is sufficient + * for the current "image" to be reproduced + */ + GE_SaveSnapshotState = 4, + /* Restore the system state that is saved by GE_SaveSnapshotState + */ + GE_RestoreSnapshotState = 5, + /* When replaying the display list, the graphics engine + * checks, after each replayed action, that the action + * produced valid output. This is the graphics system's + * chance to say that the output is crap (in which case the + * graphics engine will abort the display list replay). + */ + GE_CheckPlot = 7, + /* The device wants to scale the current pointsize + * (for scaling an image) + * This is not a nice general solution, but a quick fix for + * the Windows device. + */ + GE_ScalePS = 8 +} GEevent; + +/* + * Some line end/join constants + */ +typedef enum { + GE_ROUND_CAP = 1, + GE_BUTT_CAP = 2, + GE_SQUARE_CAP = 3 +} R_GE_lineend; + +typedef enum { + GE_ROUND_JOIN = 1, + GE_MITRE_JOIN = 2, + GE_BEVEL_JOIN = 3 +} R_GE_linejoin; + +/* + * A structure containing graphical parameters + * + * This is how graphical parameters are passed from graphics systems + * to the graphics engine AND from the graphics engine to graphics + * devices. + * + * Devices are not *required* to honour graphical parameters + * (e.g., alpha transparency is going to be tough for some) + */ +typedef struct { + /* + * Colours + * + * NOTE: Alpha transparency included in col & fill + */ + int col; /* pen colour (lines, text, borders, ...) */ + int fill; /* fill colour (for polygons, circles, rects, ...) */ + double gamma; /* Gamma correction */ + /* + * Line characteristics + */ + double lwd; /* Line width (roughly number of pixels) */ + int lty; /* Line type (solid, dashed, dotted, ...) */ + R_GE_lineend lend; /* Line end */ + R_GE_linejoin ljoin; /* line join */ + double lmitre; /* line mitre */ + /* + * Text characteristics + */ + double cex; /* Character expansion (font size = fontsize*cex) */ + double ps; /* Font size in points */ + double lineheight; /* Line height (multiply by font size) */ + int fontface; /* Font face (plain, italic, bold, ...) */ + char fontfamily[201]; /* Font family */ +} R_GE_gcontext; + +typedef R_GE_gcontext* pGEcontext; + + +#include <R_ext/GraphicsDevice.h> /* needed for DevDesc */ + +typedef struct _GEDevDesc GEDevDesc; + +typedef SEXP (* GEcallback)(GEevent, GEDevDesc *, SEXP); + +typedef struct { + /* An array of information about each graphics system that + * has registered with the graphics engine. + * This is used to store graphics state for each graphics + * system on each device. + */ + void *systemSpecific; + /* + * An array of function pointers, one per graphics system that + * has registered with the graphics engine. + * + * system_Callback is called when the graphics engine wants + * to give a graphics system the chance to play with its + * device-specific information (stored in systemSpecific) + * There are two parameters: an "event" to tell the graphics + * system why the graphics engine has called this function, + * and the systemSpecific pointer. The graphics engine + * has to pass the systemSpecific pointer because only + * the graphics engine will know what array index to use. + */ + GEcallback callback; +} GESystemDesc; + +struct _GEDevDesc { + /* + * Stuff that the devices can see (and modify). + * All detailed in GraphicsDevice.h + */ + pDevDesc dev; + /* + * Stuff about the device that only the graphics engine sees + * (the devices don't see it). + */ + Rboolean displayListOn; /* toggle for display list status */ + SEXP displayList; /* display list */ + SEXP DLlastElt; /* A pointer to the end of the display list + to avoid tranversing pairlists */ + SEXP savedSnapshot; /* The last element of the display list + * just prior to when the display list + * was last initialised + */ + Rboolean dirty; /* Has the device received any output? */ + Rboolean recordGraphics; /* Should a graphics call be stored + * on the display list? + * Set to FALSE by do_recordGraphics, + * do_dotcallgr, and do_Externalgr + * so that nested calls are not + * recorded on the display list + */ + /* + * Stuff about the device that only graphics systems see. + * The graphics engine has no idea what is in here. + * Used by graphics systems to store system state per device. + */ + GESystemDesc *gesd[MAX_GRAPHICS_SYSTEMS]; + + /* per-device setting for 'ask' (use NewFrameConfirm) */ + Rboolean ask; +}; + +typedef GEDevDesc* pGEDevDesc; + +/* functions from devices.c for use by graphics devices */ + +#define desc2GEDesc Rf_desc2GEDesc +/* map DevDesc to enclosing GEDevDesc */ +pGEDevDesc desc2GEDesc(pDevDesc dd); +int GEdeviceNumber(pGEDevDesc); +pGEDevDesc GEgetDevice(int); +void GEaddDevice(pGEDevDesc); +void GEaddDevice2(pGEDevDesc, const char *); +void GEaddDevice2f(pGEDevDesc, const char *, const char *); +void GEkillDevice(pGEDevDesc); +pGEDevDesc GEcreateDevDesc(pDevDesc dev); + +void GEdestroyDevDesc(pGEDevDesc dd); +void *GEsystemState(pGEDevDesc dd, int index); +void GEregisterWithDevice(pGEDevDesc dd); +void GEregisterSystem(GEcallback callback, int *systemRegisterIndex); +void GEunregisterSystem(int registerIndex); +SEXP GEhandleEvent(GEevent event, pDevDesc dev, SEXP data); + +#define fromDeviceX GEfromDeviceX +#define toDeviceX GEtoDeviceX +#define fromDeviceY GEfromDeviceY +#define toDeviceY GEtoDeviceY +#define fromDeviceWidth GEfromDeviceWidth +#define toDeviceWidth GEtoDeviceWidth +#define fromDeviceHeight GEfromDeviceHeight +#define toDeviceHeight GEtoDeviceHeight + +double fromDeviceX(double value, GEUnit to, pGEDevDesc dd); +double toDeviceX(double value, GEUnit from, pGEDevDesc dd); +double fromDeviceY(double value, GEUnit to, pGEDevDesc dd); +double toDeviceY(double value, GEUnit from, pGEDevDesc dd); +double fromDeviceWidth(double value, GEUnit to, pGEDevDesc dd); +double toDeviceWidth(double value, GEUnit from, pGEDevDesc dd); +double fromDeviceHeight(double value, GEUnit to, pGEDevDesc dd); +double toDeviceHeight(double value, GEUnit from, pGEDevDesc dd); + +/*------------------------------------------------------------------- + * + * COLOUR CODE is concerned with the internals of R colour representation + * + * From colors.c, used in par.c, grid/src/gpar.c + */ + +typedef unsigned int rcolor; + +#define RGBpar Rf_RGBpar +#define RGBpar3 Rf_RGBpar3 +#define col2name Rf_col2name + +/* Convert an element of a R colour specification (which might be a + number or a string) into an internal colour specification. */ +rcolor RGBpar(SEXP, int); +rcolor RGBpar3(SEXP, int, rcolor); + +/* Convert an internal colour specification to/from a colour name */ +const char *col2name(rcolor col); /* used in par.c, grid */ + +/* Convert either a name or a #RRGGBB[AA] string to internal. + Because people were using it, it also converts "1", "2" ... + to a colour in the palette, and "0" to transparent white. +*/ +rcolor R_GE_str2col(const char *s); + + + +/* + * Some Notes on Line Textures + * + * Line textures are stored as an array of 4-bit integers within + * a single 32-bit word. These integers contain the lengths of + * lines to be drawn with the pen alternately down and then up. + * The device should try to arrange that these values are measured + * in points if possible, although pixels is ok on most displays. + * + * If newlty contains a line texture description it is decoded + * as follows: + * + * ndash = 0; + * for(i=0 ; i<8 && newlty & 15 ; i++) { + * dashlist[ndash++] = newlty & 15; + * newlty = newlty>>4; + * } + * dashlist[0] = length of pen-down segment + * dashlist[1] = length of pen-up segment + * etc + * + * An integer containing a zero terminates the pattern. Hence + * ndash in this code fragment gives the length of the texture + * description. If a description contains an odd number of + * elements it is replicated to create a pattern with an + * even number of elements. (If this is a pain, do something + * different its not crucial). + * + */ + +/*--- The basic numbered & names line types; Here device-independent: + e.g. "dashed" == "44", "dotdash" == "1343" +*/ + +/* NB: was also in Rgraphics.h in R < 2.7.0 */ +#define LTY_BLANK -1 +#define LTY_SOLID 0 +#define LTY_DASHED 4 + (4<<4) +#define LTY_DOTTED 1 + (3<<4) +#define LTY_DOTDASH 1 + (3<<4) + (4<<8) + (3<<12) +#define LTY_LONGDASH 7 + (3<<4) +#define LTY_TWODASH 2 + (2<<4) + (6<<8) + (2<<12) + +R_GE_lineend GE_LENDpar(SEXP value, int ind); +SEXP GE_LENDget(R_GE_lineend lend); +R_GE_linejoin GE_LJOINpar(SEXP value, int ind); +SEXP GE_LJOINget(R_GE_linejoin ljoin); + +void GESetClip(double x1, double y1, double x2, double y2, pGEDevDesc dd); +void GENewPage(const pGEcontext gc, pGEDevDesc dd); +void GELine(double x1, double y1, double x2, double y2, + const pGEcontext gc, pGEDevDesc dd); +void GEPolyline(int n, double *x, double *y, + const pGEcontext gc, pGEDevDesc dd); +void GEPolygon(int n, double *x, double *y, + const pGEcontext gc, pGEDevDesc dd); +SEXP GEXspline(int n, double *x, double *y, double *s, Rboolean open, + Rboolean repEnds, Rboolean draw, + const pGEcontext gc, pGEDevDesc dd); +void GECircle(double x, double y, double radius, + const pGEcontext gc, pGEDevDesc dd); +void GERect(double x0, double y0, double x1, double y1, + const pGEcontext gc, pGEDevDesc dd); +void GEPath(double *x, double *y, + int npoly, int *nper, + Rboolean winding, + const pGEcontext gc, pGEDevDesc dd); +void GERaster(unsigned int *raster, int w, int h, + double x, double y, double width, double height, + double angle, Rboolean interpolate, + const pGEcontext gc, pGEDevDesc dd); +SEXP GECap(pGEDevDesc dd); +void GEText(double x, double y, const char * const str, cetype_t enc, + double xc, double yc, double rot, + const pGEcontext gc, pGEDevDesc dd); +void GEMode(int mode, pGEDevDesc dd); +void GESymbol(double x, double y, int pch, double size, + const pGEcontext gc, pGEDevDesc dd); +void GEPretty(double *lo, double *up, int *ndiv); +void GEMetricInfo(int c, const pGEcontext gc, + double *ascent, double *descent, double *width, + pGEDevDesc dd); +double GEStrWidth(const char *str, cetype_t enc, + const pGEcontext gc, pGEDevDesc dd); +double GEStrHeight(const char *str, cetype_t enc, + const pGEcontext gc, pGEDevDesc dd); +void GEStrMetric(const char *str, cetype_t enc, const pGEcontext gc, + double *ascent, double *descent, double *width, + pGEDevDesc dd); +int GEstring_to_pch(SEXP pch); + +/*------------------------------------------------------------------- + * + * LINE TEXTURE CODE is concerned with the internals of R + * line texture representation. + */ +unsigned int GE_LTYpar(SEXP, int); +SEXP GE_LTYget(unsigned int); + +/* + * Raster operations + */ +void R_GE_rasterScale(unsigned int *sraster, int sw, int sh, + unsigned int *draster, int dw, int dh); +void R_GE_rasterInterpolate(unsigned int *sraster, int sw, int sh, + unsigned int *draster, int dw, int dh); +void R_GE_rasterRotatedSize(int w, int h, double angle, + int *wnew, int *hnew); +void R_GE_rasterRotatedOffset(int w, int h, double angle, int botleft, + double *xoff, double *yoff); +void R_GE_rasterResizeForRotation(unsigned int *sraster, + int w, int h, + unsigned int *newRaster, + int wnew, int hnew, + const pGEcontext gc); +void R_GE_rasterRotate(unsigned int *sraster, int w, int h, double angle, + unsigned int *draster, const pGEcontext gc, + Rboolean perPixelAlpha); + + +/* + * From plotmath.c + */ +double GEExpressionWidth(SEXP expr, + const pGEcontext gc, pGEDevDesc dd); +double GEExpressionHeight(SEXP expr, + const pGEcontext gc, pGEDevDesc dd); +void GEExpressionMetric(SEXP expr, const pGEcontext gc, + double *ascent, double *descent, double *width, + pGEDevDesc dd); +void GEMathText(double x, double y, SEXP expr, + double xc, double yc, double rot, + const pGEcontext gc, pGEDevDesc dd); +/* + * (End from plotmath.c) + */ + +/* + * From plot3d.c : used in package clines + */ +SEXP GEcontourLines(double *x, int nx, double *y, int ny, + double *z, double *levels, int nl); +/* + * (End from plot3d.c) + */ + +/* + * From vfonts.c + */ +double R_GE_VStrWidth(const char *s, cetype_t enc, const pGEcontext gc, pGEDevDesc dd); + +double R_GE_VStrHeight(const char *s, cetype_t enc, const pGEcontext gc, pGEDevDesc dd); +void R_GE_VText(double x, double y, const char * const s, cetype_t enc, + double x_justify, double y_justify, double rotation, + const pGEcontext gc, pGEDevDesc dd); +/* + * (End from vfonts.c) + */ + +/* Also in Graphics.h */ +#define DEG2RAD 0.01745329251994329576 + +pGEDevDesc GEcurrentDevice(void); +Rboolean GEdeviceDirty(pGEDevDesc dd); +void GEdirtyDevice(pGEDevDesc dd); +Rboolean GEcheckState(pGEDevDesc dd); +Rboolean GErecording(SEXP call, pGEDevDesc dd); +void GErecordGraphicOperation(SEXP op, SEXP args, pGEDevDesc dd); +void GEinitDisplayList(pGEDevDesc dd); +void GEplayDisplayList(pGEDevDesc dd); +void GEcopyDisplayList(int fromDevice); +SEXP GEcreateSnapshot(pGEDevDesc dd); +void GEplaySnapshot(SEXP snapshot, pGEDevDesc dd); +void GEonExit(void); +void GEnullDevice(void); + + +/* From ../../main/plot.c, used by ../../library/grid/src/grid.c : */ +#define CreateAtVector Rf_CreateAtVector +SEXP CreateAtVector(double*, double*, int, Rboolean); +/* From ../../main/graphics.c, used by ../../library/grDevices/src/axis_scales.c : */ +#define GAxisPars Rf_GAxisPars +void GAxisPars(double *min, double *max, int *n, Rboolean log, int axis); + +#ifdef __cplusplus +} +#endif + +#endif /* R_GRAPHICSENGINE_ */ diff --git a/com.oracle.truffle.r.native/gnur/patch/src/include/R_ext/Itermacros.h b/com.oracle.truffle.r.native/gnur/patch/src/include/R_ext/Itermacros.h new file mode 100644 index 0000000000000000000000000000000000000000..1456d66a20845f4bd34ec45138d4b20832410582 --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/include/R_ext/Itermacros.h @@ -0,0 +1,181 @@ +/* + * R : A Computer Language for Statistical Data Analysis + * Copyright (C) 2001-12 The R Core Team. + * + * This header file is free software; you can redistribute it and/or modify + * it under the terms of the GNU Lesser General Public License as published by + * the Free Software Foundation; either version 2.1 of the License, or + * (at your option) any later version. + * + * This file is part of R. R is distributed under the terms of the + * GNU General Public License, either Version 2, June 1991 or Version 3, + * June 2007. See doc/COPYRIGHTS for details of the copyright status of R. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public License + * along with this program; if not, a copy is available at + * https://www.R-project.org/Licenses/ + */ + +/* + Macros to help defining vectorized functions with proper recycling + and periodic interrupt checks. + */ + +#ifndef R_EXT_ITERMACROS_H_ +#define R_EXT_ITERMACROS_H_ + +#define LOOP_WITH_INTERRUPT_CHECK(LOOP, ncheck, n, ...) do { \ + for (size_t __intr_threshold__ = ncheck; \ + TRUE; \ + __intr_threshold__ += ncheck) { \ + size_t __intr_end__ = n < __intr_threshold__ ? \ + n : __intr_threshold__; \ + LOOP(__intr_end__, __VA_ARGS__); \ + if (__intr_end__ == n) break; \ + else R_CheckUserInterrupt(); \ + } \ + } while (0) + +#define R_ITERATE_CORE(n, i, loop_body) do { \ + for (; i < n; ++i) { loop_body } \ + } while (0) + +#define R_ITERATE(n, i, loop_body) do { \ + i = 0; \ + R_ITERATE_CORE(n, i, loop_body); \ + } while (0) + +#define R_ITERATE_CHECK(ncheck, n, i, loop_body) do { \ + i = 0; \ + LOOP_WITH_INTERRUPT_CHECK(R_ITERATE_CORE, ncheck, n, i, loop_body); \ + } while (0) + + +#define MOD_ITERATE1_CORE(n, n1, i, i1, loop_body) do { \ + for (; i < n; \ + i1 = (++i1 == n1) ? 0 : i1, \ + ++i) { \ + loop_body \ + } \ + } while (0) + +#define MOD_ITERATE1(n, n1, i, i1, loop_body) do { \ + i = i1 = 0; \ + MOD_ITERATE1_CORE(n, n1, i, i1, loop_body); \ + } while (0) + +#define MOD_ITERATE1_CHECK(ncheck, n, n1, i, i1, loop_body) do { \ + i = i1 = 0; \ + LOOP_WITH_INTERRUPT_CHECK(MOD_ITERATE1_CORE, ncheck, n, \ + n1, i, i1, loop_body); \ + } while (0) + +#define MOD_ITERATE2_CORE(n, n1, n2, i, i1, i2, loop_body) do { \ + for (; i < n; \ + i1 = (++i1 == n1) ? 0 : i1, \ + i2 = (++i2 == n2) ? 0 : i2, \ + ++i) { \ + loop_body \ + } \ + } while (0) + +#define MOD_ITERATE2(n, n1, n2, i, i1, i2, loop_body) do { \ + i = i1 = i2 = 0; \ + MOD_ITERATE2_CORE(n, n1, n2, i, i1, i2, loop_body); \ + } while (0) + +#define MOD_ITERATE2_CHECK(ncheck, n, n1, n2, i, i1, i2, loop_body) do { \ + i = i1 = i2 = 0; \ + LOOP_WITH_INTERRUPT_CHECK(MOD_ITERATE2_CORE, ncheck, n, \ + n1, n2, i, i1, i2, loop_body); \ + } while (0) + +#define MOD_ITERATE MOD_ITERATE2 +#define MOD_ITERATE_CORE MOD_ITERATE2_CORE +#define MOD_ITERATE_CHECK MOD_ITERATE2_CHECK + +#define MOD_ITERATE3_CORE(n, n1, n2, n3, i, i1, i2, i3, loop_body) do { \ + for (; i < n; \ + i1 = (++i1 == n1) ? 0 : i1, \ + i2 = (++i2 == n2) ? 0 : i2, \ + i3 = (++i3 == n3) ? 0 : i3, \ + ++i) { \ + loop_body \ + } \ + } while (0) + +#define MOD_ITERATE3(n, n1, n2, n3, i, i1, i2, i3, loop_body) do { \ + i = i1 = i2 = i3 = 0; \ + MOD_ITERATE3_CORE(n, n1, n2, n3, i, i1, i2, i3, loop_body); \ + } while (0) + +#define MOD_ITERATE3_CHECK(ncheck, n, n1, n2, n3, i, i1, i2, i3, loop_body) \ + do { \ + i = i1 = i2 = i3 = 0; \ + LOOP_WITH_INTERRUPT_CHECK(MOD_ITERATE3_CORE, ncheck, n, \ + n1, n2, n3, i, i1, i2, i3, loop_body); \ + } while (0) + +#define MOD_ITERATE4_CORE(n, n1, n2, n3, n4, i, i1, i2, i3, i4, loop_body) \ + do { \ + for (; i < n; \ + i1 = (++i1 == n1) ? 0 : i1, \ + i2 = (++i2 == n2) ? 0 : i2, \ + i3 = (++i3 == n3) ? 0 : i3, \ + i4 = (++i4 == n4) ? 0 : i4, \ + ++i) { \ + loop_body \ + } \ + } while (0) + +#define MOD_ITERATE4(n, n1, n2, n3, n4, i, i1, i2, i3, i4, loop_body) do { \ + i = i1 = i2 = i3 = i4 = 0; \ + MOD_ITERATE4_CORE(n, n1, n2, n3, n4, i, i1, i2, i3, i4, loop_body); \ + } while (0) + +#define MOD_ITERATE4_CHECK(ncheck, n, n1, n2, n3, n4, i, i1, i2, i3, i4, \ + loop_body) \ + do { \ + i = i1 = i2 = i3 = i4 = 0; \ + LOOP_WITH_INTERRUPT_CHECK(MOD_ITERATE4_CORE, ncheck, n, \ + n1, n2, n3, n4, \ + i, i1, i2, i3, i4, loop_body); \ + } while (0) + +#define MOD_ITERATE5_CORE(n, n1, n2, n3, n4, n5, i, i1, i2, i3, i4, i5, \ + loop_body) \ + do { \ + for (; i < n; \ + i1 = (++i1 == n1) ? 0 : i1, \ + i2 = (++i2 == n2) ? 0 : i2, \ + i3 = (++i3 == n3) ? 0 : i3, \ + i4 = (++i4 == n4) ? 0 : i4, \ + i5 = (++i5 == n5) ? 0 : i5, \ + ++i) { \ + loop_body \ + } \ + } while (0) + +#define MOD_ITERATE5(n, n1, n2, n3, n4, n5, i, i1, i2, i3, i4, i5, loop_body) \ + do { \ + i = i1 = i2 = i3 = i4 = i5 = 0; \ + MOD_ITERATE5_CORE(n, n1, n2, n3, n4, n5, i, i1, i2, i3, i4, i5, \ + loop_body); \ + } while (0) + +#define MOD_ITERATE5_CHECK(ncheck, n, n1, n2, n3, n4, n5, \ + i, i1, i2, i3, i4, i5, \ + loop_body) \ + do { \ + i = i1 = i2 = i3 = i4 = i5 = 0; \ + LOOP_WITH_INTERRUPT_CHECK(MOD_ITERATE5_CORE, ncheck, n, \ + n1, n2, n3, n4, n5, \ + i, i1, i2, i3, i4, i5, loop_body); \ + } while (0) + +#endif /* R_EXT_ITERMACROS_H_ */ diff --git a/com.oracle.truffle.r.native/gnur/patch/src/include/R_ext/Lapack.h b/com.oracle.truffle.r.native/gnur/patch/src/include/R_ext/Lapack.h new file mode 100644 index 0000000000000000000000000000000000000000..06501e9bac685b7d6ae954603e1ea5a4755fac31 --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/include/R_ext/Lapack.h @@ -0,0 +1,3127 @@ +/* + * R : A Computer Language for Statistical Data Analysis + * Copyright (C) 2003-2016 The R Core Team. + * Copyright (C) 2008 The R Foundation + * + * This header file is free software; you can redistribute it and/or modify + * it under the terms of the GNU Lesser General Public License as published by + * the Free Software Foundation; either version 2.1 of the License, or + * (at your option) any later version. + * + * This file is part of R. R is distributed under the terms of the + * GNU General Public License, either Version 2, June 1991 or Version 3, + * June 2007. See doc/COPYRIGHTS for details of the copyright status of R. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public License + * along with this program; if not, a copy is available at + * https://www.R-project.org/Licenses/ + */ + +/* + C declarations of LAPACK Fortran subroutines included in R. + Just those used (currently or previously) by C routines in R itself. + + Part of the API. + + R packages that use these should have PKG_LIBS in src/Makevars include + $(LAPACK_LIBS) $(BLAS_LIBS) $(FLIBS) + */ + + +#ifndef R_LAPACK_H +#define R_LAPACK_H + +#include <R_ext/RS.h> /* for F77_... */ +#include <R_ext/Complex.h> /* for Rcomplex */ +#include <R_ext/BLAS.h> + + +/* + LAPACK function names are [dz]<name>(), where d denotes the real + version of the function, z the complex version. (Only + double-precision versions are used in R.) +*/ + +#ifdef __cplusplus +extern "C" { +#endif + +/* The LAPACK version: might change after installation with + external LAPACK +*/ +extern void F77_NAME(ilaver)(int *major, int *minor, int *patch); + +// Never defined by R itself. +#ifndef La_extern +#define La_extern extern +#endif + +// Utilities for Lapack-using packages : +// ------------------------------------ + +/* matrix norms: converting typstr[] to one of {'M', 'O', 'I', 'F'} + * or signal error(): */ +// La_extern char La_norm_type(const char *typstr); + +/* matrix (reciprocal) condition numbers: convert typstr[] to 'O'(ne) or 'I'(nf) + * or signal error(): */ +// La_extern char La_rcond_type(const char *typstr); + + +/* Selected Double Precision Lapack Routines + ======== + */ + +//* Double precision BiDiagonal and DIagonal matrices -> DBD & DDI + +/* DBDSQR - compute the singular value decomposition (SVD) of a real */ +/* N-by-N (upper or lower) bidiagonal matrix B */ +La_extern void +F77_NAME(dbdsqr)(const char* uplo, const int* n, const int* ncvt, + const int* nru, const int* ncc, double* d, double* e, + double* vt, const int* ldvt, double* u, const int* ldu, + double* c, const int* ldc, double* work, int* info); +/* DDISNA - compute the reciprocal condition numbers for the */ +/* eigenvectors of a real symmetric or complex Hermitian matrix or */ +/* for the left or right singular vectors of a general m-by-n */ +/* matrix */ +La_extern void +F77_NAME(ddisna)(const char* job, const int* m, const int* n, + double* d, double* sep, int* info); + + +//* Double precision General Banded matrices -> DGB + +/* DGBBRD - reduce a real general m-by-n band matrix A to upper */ +/* bidiagonal form B by an orthogonal transformation */ +La_extern void +F77_NAME(dgbbrd)(const char* vect, const int* m, const int* n, + const int* ncc, const int* kl, const int* ku, + double* ab, const int* ldab, + double* d, double* e, double* q, + const int* ldq, double* pt, const int* ldpt, + double* c, const int* ldc, + double* work, int* info); +/* DGBCON - estimate the reciprocal of the condition number of a */ +/* real general band matrix A, in either the 1-norm or the */ +/* infinity-norm */ +La_extern void +F77_NAME(dgbcon)(const char* norm, const int* n, const int* kl, + const int* ku, double* ab, const int* ldab, + int* ipiv, const double* anorm, double* rcond, + double* work, int* iwork, int* info); +/* DGBEQU - compute row and column scalings intended to equilibrate */ +/* an M-by-N band matrix A and reduce its condition number */ +La_extern void +F77_NAME(dgbequ)(const int* m, const int* n, const int* kl, const int* ku, + double* ab, const int* ldab, double* r, double* c, + double* rowcnd, double* colcnd, double* amax, int* info); +/* DGBRFS - improve the computed solution to a system of linear */ +/* equations when the coefficient matrix is banded, and provides */ +/* error bounds and backward error estimates for the solution */ +La_extern void +F77_NAME(dgbrfs)(const char* trans, const int* n, const int* kl, + const int* ku, const int* nrhs, double* ab, + const int* ldab, double* afb, const int* ldafb, + int* ipiv, double* b, const int* ldb, + double* x, const int* ldx, double* ferr, double* berr, + double* work, int* iwork, int* info); +/* DGBSV - compute the solution to a real system of linear */ +/* equations A * X = B, where A is a band matrix of order N with */ +/* KL subdiagonals and KU superdiagonals, and X and B are */ +/* N-by-NRHS matrices */ +La_extern void +F77_NAME(dgbsv)(const int* n, const int* kl,const int* ku, + const int* nrhs, double* ab, const int* ldab, + int* ipiv, double* b, const int* ldb, int* info); +/* DGBSVX - use the LU factorization to compute the solution to a */ +/* real system of linear equations A * X = B or A**T * X = B */ +La_extern void +F77_NAME(dgbsvx)(const int* fact, const char* trans, + const int* n, const int* kl,const int* ku, + const int* nrhs, double* ab, const int* ldab, + double* afb, const int* ldafb, int* ipiv, + const char* equed, double* r, double* c, + double* b, const int* ldb, + double* x, const int* ldx, + double* rcond, double* ferr, double* berr, + double* work, int* iwork, int* info); +/* DGBTF2 - compute an LU factorization of a real m-by-n band */ +/* matrix A using partial pivoting with row interchanges */ +La_extern void +F77_NAME(dgbtf2)(const int* m, const int* n, const int* kl,const int* ku, + double* ab, const int* ldab, int* ipiv, int* info); +/* DGBTRF - compute an LU factorization of a real m-by-n band */ +/* matrix A using partial pivoting with row interchanges */ +La_extern void +F77_NAME(dgbtrf)(const int* m, const int* n, const int* kl,const int* ku, + double* ab, const int* ldab, int* ipiv, int* info); +/* DGBTRS - solve a system of linear equations A * X = B or */ +/* A' * X = B with a general band matrix A using the LU */ +/* factorization computed by DGBTRF */ +La_extern void +F77_NAME(dgbtrs)(const char* trans, const int* n, + const int* kl, const int* ku, const int* nrhs, + const double* ab, const int* ldab, const int* ipiv, + double* b, const int* ldb, int* info); + + +//* Double precision GEneral matrices -> DGE + +/* DGEBAK - form the right or left eigenvectors of a real general */ +/* matrix by backward transformation on the computed eigenvectors */ +/* of the balanced matrix output by DGEBAL */ +La_extern void +F77_NAME(dgebak)(const char* job, const char* side, const int* n, + const int* ilo, const int* ihi, double* scale, + const int* m, double* v, const int* ldv, int* info); +/* DGEBAL - balance a general real matrix A */ +La_extern void +F77_NAME(dgebal)(const char* job, const int* n, double* a, const int* lda, + int* ilo, int* ihi, double* scale, int* info); +/* DGEBD2 - reduce a real general m by n matrix A to upper or */ +/* lower bidiagonal form B by an orthogonal transformation */ +La_extern void +F77_NAME(dgebd2)(const int* m, const int* n, double* a, const int* lda, + double* d, double* e, double* tauq, double* taup, + double* work, int* info); +/* DGEBRD - reduce a general real M-by-N matrix A to upper or */ +/* lower bidiagonal form B by an orthogonal transformation */ +La_extern void +F77_NAME(dgebrd)(const int* m, const int* n, double* a, const int* lda, + double* d, double* e, double* tauq, double* taup, + double* work, const int* lwork, int* info); +/* DGECON - estimate the reciprocal of the condition number of a */ +/* general real matrix A, in either the 1-norm or the */ +/* infinity-norm, using the LU factorization computed by DGETRF */ +La_extern void +F77_NAME(dgecon)(const char* norm, const int* n, + const double* a, const int* lda, + const double* anorm, double* rcond, + double* work, int* iwork, int* info); +/* DGEEQU - compute row and column scalings intended to equilibrate */ +/* an M-by-N matrix A and reduce its condition number */ +La_extern void +F77_NAME(dgeequ)(const int* m, const int* n, double* a, const int* lda, + double* r, double* c, double* rowcnd, double* colcnd, + double* amax, int* info); +/* DGEES - compute for an N-by-N real nonsymmetric matrix A, the */ +/* eigenvalues, the real Schur form T, and, optionally, the matrix */ +/* of Schur vectors Z */ +La_extern void +F77_NAME(dgees)(const char* jobvs, const char* sort, + int (*select)(const double*, const double*), + const int* n, double* a, const int* lda, + int* sdim, double* wr, double* wi, + double* vs, const int* ldvs, + double* work, const int* lwork, int* bwork, int* info); +/* DGEESX - compute for an N-by-N real nonsymmetric matrix A, the */ +/* eigenvalues, the real Schur form T, and, optionally, the matrix */ +/* of Schur vectors Z */ +La_extern void +F77_NAME(dgeesx)(const char* jobvs, const char* sort, + int (*select)(const double*, const double*), + const char* sense, const int* n, double* a, + const int* lda, int* sdim, double* wr, double* wi, + double* vs, const int* ldvs, double* rconde, + double* rcondv, double* work, const int* lwork, + int* iwork, const int* liwork, int* bwork, int* info); +/* DGEEV - compute for an N-by-N real nonsymmetric matrix A, the */ +/* eigenvalues and, optionally, the left and/or right eigenvectors */ +La_extern void +F77_NAME(dgeev)(const char* jobvl, const char* jobvr, + const int* n, double* a, const int* lda, + double* wr, double* wi, double* vl, const int* ldvl, + double* vr, const int* ldvr, + double* work, const int* lwork, int* info); +/* DGEEVX - compute for an N-by-N real nonsymmetric matrix A, the */ +/* eigenvalues and, optionally, the left and/or right eigenvectors */ +La_extern void +F77_NAME(dgeevx)(const char* balanc, const char* jobvl, const char* jobvr, + const char* sense, const int* n, double* a, const int* lda, + double* wr, double* wi, double* vl, const int* ldvl, + double* vr, const int* ldvr, int* ilo, int* ihi, + double* scale, double* abnrm, double* rconde, double* rcondv, + double* work, const int* lwork, int* iwork, int* info); +/* DGEHD2 - reduce a real general matrix A to upper Hessenberg */ +/* form H by an orthogonal similarity transformation */ +La_extern void +F77_NAME(dgehd2)(const int* n, const int* ilo, const int* ihi, + double* a, const int* lda, double* tau, + double* work, int* info); +/* DGEHRD - reduce a real general matrix A to upper Hessenberg */ +/* form H by an orthogonal similarity transformation */ +La_extern void +F77_NAME(dgehrd)(const int* n, const int* ilo, const int* ihi, + double* a, const int* lda, double* tau, + double* work, const int* lwork, int* info); +/* DGELQ2 - compute an LQ factorization of a real m by n matrix A */ +La_extern void +F77_NAME(dgelq2)(const int* m, const int* n, + double* a, const int* lda, double* tau, + double* work, int* info); +/* DGELQF - compute an LQ factorization of a real M-by-N matrix A */ +La_extern void +F77_NAME(dgelqf)(const int* m, const int* n, + double* a, const int* lda, double* tau, + double* work, const int* lwork, int* info); +/* DGELS - solve overdetermined or underdetermined real linear */ +/* systems involving an M-by-N matrix A, or its transpose, using a */ +/* QR or LQ factorization of A */ +La_extern void +F77_NAME(dgels)(const char* trans, const int* m, const int* n, + const int* nrhs, double* a, const int* lda, + double* b, const int* ldb, + double* work, const int* lwork, int* info); +/* DGELSS - compute the minimum norm solution to a real linear */ +/* least squares problem */ +La_extern void +F77_NAME(dgelss)(const int* m, const int* n, const int* nrhs, + double* a, const int* lda, double* b, const int* ldb, + double* s, double* rcond, int* rank, + double* work, const int* lwork, int* info); +/* DGELSY - compute the minimum-norm solution to a real linear */ +/* least squares problem */ +La_extern void +F77_NAME(dgelsy)(const int* m, const int* n, const int* nrhs, + double* a, const int* lda, double* b, const int* ldb, + int* jpvt, const double* rcond, int* rank, + double* work, const int* lwork, int* info); +/* DGEQL2 - compute a QL factorization of a real m by n matrix A */ +La_extern void +F77_NAME(dgeql2)(const int* m, const int* n, double* a, const int* lda, + double* tau, double* work, int* info); +/* DGEQLF - compute a QL factorization of a real M-by-N matrix A */ +La_extern void +F77_NAME(dgeqlf)(const int* m, const int* n, + double* a, const int* lda, double* tau, + double* work, const int* lwork, int* info); +/* DGEQP3 - compute a QR factorization with column pivoting of a */ +/* real M-by-N matrix A using level 3 BLAS */ +La_extern void +F77_NAME(dgeqp3)(const int* m, const int* n, double* a, const int* lda, + int* jpvt, double* tau, double* work, const int* lwork, + int* info); +/* DGEQR2 - compute a QR factorization of a real m by n matrix A */ +La_extern void +F77_NAME(dgeqr2)(const int* m, const int* n, double* a, const int* lda, + double* tau, double* work, int* info); +/* DGEQRF - compute a QR factorization of a real M-by-N matrix A */ +La_extern void +F77_NAME(dgeqrf)(const int* m, const int* n, double* a, const int* lda, + double* tau, double* work, const int* lwork, int* info); +/* DGERFS - improve the computed solution to a system of linear */ +/* equations and provides error bounds and backward error */ +/* estimates for the solution */ +La_extern void +F77_NAME(dgerfs)(const char* trans, const int* n, const int* nrhs, + double* a, const int* lda, double* af, const int* ldaf, + int* ipiv, double* b, const int* ldb, + double* x, const int* ldx, double* ferr, double* berr, + double* work, int* iwork, int* info); +/* DGERQ2 - compute an RQ factorization of a real m by n matrix A */ +La_extern void +F77_NAME(dgerq2)(const int* m, const int* n, double* a, const int* lda, + double* tau, double* work, int* info); +/* DGERQF - compute an RQ factorization of a real M-by-N matrix A */ +La_extern void +F77_NAME(dgerqf)(const int* m, const int* n, double* a, const int* lda, + double* tau, double* work, const int* lwork, int* info); +/* DGESV - compute the solution to a real system of linear */ +/* equations A * X = B, */ +La_extern void +F77_NAME(dgesv)(const int* n, const int* nrhs, double* a, const int* lda, + int* ipiv, double* b, const int* ldb, int* info); +/* DGESVD - compute the singular value decomposition (SVD); of a */ +/* real M-by-N matrix A, optionally computing the left and/or */ +/* right singular vectors */ +La_extern void +F77_NAME(dgesvd)(const char* jobu, const char* jobvt, const int* m, + const int* n, double* a, const int* lda, double* s, + double* u, const int* ldu, double* vt, const int* ldvt, + double* work, const int* lwork, int* info); +/* DGESVX - use the LU factorization to compute the solution to a */ +/* real system of linear equations A * X = B, */ +La_extern void +F77_NAME(dgesvx)(const char* fact, const char* trans, const int* n, + const int* nrhs, double* a, const int* lda, + double* af, const int* ldaf, int* ipiv, + char *equed, double* r, double* c, + double* b, const int* ldb, + double* x, const int* ldx, + double* rcond, double* ferr, double* berr, + double* work, int* iwork, int* info); +/* DGETF2 - compute an LU factorization of a general m-by-n */ +/* matrix A using partial pivoting with row interchanges */ +La_extern void +F77_NAME(dgetf2)(const int* m, const int* n, double* a, const int* lda, + int* ipiv, int* info); +/* DGETRF - compute an LU factorization of a general M-by-N */ +/* matrix A using partial pivoting with row interchanges */ +La_extern void +F77_NAME(dgetrf)(const int* m, const int* n, double* a, const int* lda, + int* ipiv, int* info); +/* DGETRI - compute the inverse of a matrix using the LU */ +/* factorization computed by DGETRF */ +La_extern void +F77_NAME(dgetri)(const int* n, double* a, const int* lda, + int* ipiv, double* work, const int* lwork, int* info); +/* DGETRS - solve a system of linear equations A * X = B or A' * */ +/* X = B with a general N-by-N matrix A using the LU factorization */ +/* computed by DGETRF */ +La_extern void +F77_NAME(dgetrs)(const char* trans, const int* n, const int* nrhs, + const double* a, const int* lda, const int* ipiv, + double* b, const int* ldb, int* info); + + +//* Double precision General matrices Generalized problems -> DGG + +/* DGGBAK - form the right or left eigenvectors of a real */ +/* generalized eigenvalue problem A*x = lambda*B*x, by backward */ +/* transformation on the computed eigenvectors of the balanced */ +/* pair of matrices output by DGGBAL */ +La_extern void +F77_NAME(dggbak)(const char* job, const char* side, + const int* n, const int* ilo, const int* ihi, + double* lscale, double* rscale, const int* m, + double* v, const int* ldv, int* info); +/* DGGBAL - balance a pair of general real matrices (A,B); */ +La_extern void +F77_NAME(dggbal)(const char* job, const int* n, double* a, const int* lda, + double* b, const int* ldb, int* ilo, int* ihi, + double* lscale, double* rscale, double* work, int* info); +/* DGGES - compute for a pair of N-by-N real nonsymmetric */ +/* matrices A, B the generalized eigenvalues, the generalized */ +/* real Schur form (S,T), optionally, the left and/or right matrices */ +/* of Schur vectors (VSL and VSR)*/ +La_extern void +F77_NAME(dgges)(const char* jobvsl, const char* jobvsr, const char* sort, + int (*delztg)(double*, double*, double*), + const int* n, double* a, const int* lda, + double* b, const int* ldb, double* alphar, + double* alphai, const double* beta, + double* vsl, const int* ldvsl, + double* vsr, const int* ldvsr, + double* work, const int* lwork, int* bwork, int* info); + +/* DGGGLM - solve a general Gauss-Markov linear model (GLM) problem */ +La_extern void +F77_NAME(dggglm)(const int* n, const int* m, const int* p, + double* a, const int* lda, double* b, const int* ldb, + double* d, double* x, double* y, + double* work, const int* lwork, int* info); +/* DGGHRD - reduce a pair of real matrices (A,B); to generalized */ +/* upper Hessenberg form using orthogonal transformations, where A */ +/* is a general matrix and B is upper triangular */ +La_extern void +F77_NAME(dgghrd)(const char* compq, const char* compz, const int* n, + const int* ilo, const int* ihi, double* a, const int* lda, + double* b, const int* ldb, double* q, const int* ldq, + double* z, const int* ldz, int* info); +/* DGGLSE - solve the linear equality-constrained least squares */ +/* (LSE) problem */ +La_extern void +F77_NAME(dgglse)(const int* m, const int* n, const int* p, + double* a, const int* lda, + double* b, const int* ldb, + double* c, double* d, double* x, + double* work, const int* lwork, int* info); +/* DGGQRF - compute a generalized QR factorization of an N-by-M */ +/* matrix A and an N-by-P matrix B */ +La_extern void +F77_NAME(dggqrf)(const int* n, const int* m, const int* p, + double* a, const int* lda, double* taua, + double* b, const int* ldb, double* taub, + double* work, const int* lwork, int* info); +/* DGGRQF - compute a generalized RQ factorization of an M-by-N */ +/* matrix A and a P-by-N matrix B */ +La_extern void +F77_NAME(dggrqf)(const int* m, const int* p, const int* n, + double* a, const int* lda, double* taua, + double* b, const int* ldb, double* taub, + double* work, const int* lwork, int* info); + +//* Double precision General Tridiagonal matrices -> DGT + +/* DGTCON - estimate the reciprocal of the condition number of a real */ +/* tridiagonal matrix A using the LU factorization as computed by DGTTRF */ +La_extern void +F77_NAME(dgtcon)(const char* norm, const int* n, double* dl, double* d, + double* du, double* du2, int* ipiv, const double* anorm, + double* rcond, double* work, int* iwork, int* info); +/* DGTRFS - improve the computed solution to a system of linear equations */ +/* when the coefficient matrix is tridiagonal, and provides error bounds */ +/* and backward error estimates for the solution */ +La_extern void +F77_NAME(dgtrfs)(const char* trans, const int* n, const int* nrhs, + double* dl, double* d, double* du, double* dlf, + double* df, double* duf, double* du2, + int* ipiv, double* b, const int* ldb, + double* x, const int* ldx, + double* ferr, double* berr, + double* work, int* iwork, int* info); +/* DGTSV - solve the equation A*X = B, */ +La_extern void +F77_NAME(dgtsv)(const int* n, const int* nrhs, + double* dl, double* d, double* du, + double* b, const int* ldb, int* info); +/* DGTSVX - use the LU factorization to compute the solution to a */ +/* real system of linear equations A * X = B or A**T * X = B, */ +La_extern void +F77_NAME(dgtsvx)(const int* fact, const char* trans, + const int* n, const int* nrhs, + double* dl, double* d, double* du, + double* dlf, double* df, double* duf, + double* du2, int* ipiv, + double* b, const int* ldb, + double* x, const int* ldx, + double* rcond, double* ferr, double* berr, + double* work, int* iwork, int* info); +/* DGTTRF - compute an LU factorization of a real tridiagonal matrix */ +/* A using elimination with partial pivoting and row interchanges */ +La_extern void +F77_NAME(dgttrf)(const int* n, double* dl, double* d, + double* du, double* du2, int* ipiv, int* info); +/* DGTTRS - solve one of the systems of equations A*X = B or */ +/* A'*X = B, */ +La_extern void +F77_NAME(dgttrs)(const char* trans, const int* n, const int* nrhs, + double* dl, double* d, double* du, double* du2, + int* ipiv, double* b, const int* ldb, int* info); + + +//* Double precision Orthogonal matrices -> DOP & DOR + +/* DOPGTR - generate a real orthogonal matrix Q which is defined */ +/* as the product of n-1 elementary reflectors H(i); of order n, */ +/* as returned by DSPTRD using packed storage */ +La_extern void +F77_NAME(dopgtr)(const char* uplo, const int* n, + const double* ap, const double* tau, + double* q, const int* ldq, + double* work, int* info); +/* DOPMTR - overwrite the general real M-by-N matrix C with */ +/* SIDE = 'L' SIDE = 'R' TRANS = 'N' */ +La_extern void +F77_NAME(dopmtr)(const char* side, const char* uplo, + const char* trans, const int* m, const int* n, + const double* ap, const double* tau, + double* c, const int* ldc, + double* work, int* info); +/* DORG2L - generate an m by n real matrix Q with orthonormal */ +/* columns, */ +La_extern void +F77_NAME(dorg2l)(const int* m, const int* n, const int* k, + double* a, const int* lda, + const double* tau, double* work, int* info); +/* DORG2R - generate an m by n real matrix Q with orthonormal */ +/* columns, */ +La_extern void +F77_NAME(dorg2r)(const int* m, const int* n, const int* k, + double* a, const int* lda, + const double* tau, double* work, int* info); +/* DORGBR - generate one of the real orthogonal matrices Q or */ +/* P**T determined by DGEBRD when reducing a real matrix A to */ +/* bidiagonal form */ +La_extern void +F77_NAME(dorgbr)(const char* vect, const int* m, + const int* n, const int* k, + double* a, const int* lda, + const double* tau, double* work, + const int* lwork, int* info); +/* DORGHR - generate a real orthogonal matrix Q which is defined */ +/* as the product of IHI-ILO elementary reflectors of order N, as */ +/* returned by DGEHRD */ +La_extern void +F77_NAME(dorghr)(const int* n, const int* ilo, const int* ihi, + double* a, const int* lda, const double* tau, + double* work, const int* lwork, int* info); +/* DORGL2 - generate an m by n real matrix Q with orthonormal */ +/* rows, */ +La_extern void +F77_NAME(dorgl2)(const int* m, const int* n, const int* k, + double* a, const int* lda, const double* tau, + double* work, int* info); +/* DORGLQ - generate an M-by-N real matrix Q with orthonormal */ +/* rows, */ +La_extern void +F77_NAME(dorglq)(const int* m, const int* n, const int* k, + double* a, const int* lda, + const double* tau, double* work, + const int* lwork, int* info); +/* DORGQL - generate an M-by-N real matrix Q with orthonormal */ +/* columns, */ +La_extern void +F77_NAME(dorgql)(const int* m, const int* n, const int* k, + double* a, const int* lda, + const double* tau, double* work, + const int* lwork, int* info); +/* DORGQR - generate an M-by-N real matrix Q with orthonormal */ +/* columns, */ +La_extern void +F77_NAME(dorgqr)(const int* m, const int* n, const int* k, + double* a, const int* lda, const double* tau, + double* work, const int* lwork, int* info); +/* DORGR2 - generate an m by n real matrix Q with orthonormal */ +/* rows, */ +La_extern void +F77_NAME(dorgr2)(const int* m, const int* n, const int* k, + double* a, const int* lda, const double* tau, + double* work, int* info); +/* DORGRQ - generate an M-by-N real matrix Q with orthonormal rows */ +La_extern void +F77_NAME(dorgrq)(const int* m, const int* n, const int* k, + double* a, const int* lda, const double* tau, + double* work, const int* lwork, int* info); +/* DORGTR - generate a real orthogonal matrix Q which is defined */ +/* as the product of n-1 elementary reflectors of order const int* n, as */ +/* returned by DSYTRD */ +La_extern void +F77_NAME(dorgtr)(const char* uplo, const int* n, + double* a, const int* lda, const double* tau, + double* work, const int* lwork, int* info); +/* DORM2L - overwrite the general real m by n matrix C with Q * */ +/* C if SIDE = 'L' and TRANS = 'N', or Q'* C if SIDE = 'L' and */ +/* TRANS = 'T', or C * Q if SIDE = 'R' and TRANS = 'N', or C * */ +/* Q' if SIDE = 'R' and TRANS = 'T', */ +La_extern void +F77_NAME(dorm2l)(const char* side, const char* trans, + const int* m, const int* n, const int* k, + const double* a, const int* lda, + const double* tau, double* c, const int* ldc, + double* work, int* info); +/* DORM2R - overwrite the general real m by n matrix C with Q * C */ +/* if SIDE = 'L' and TRANS = 'N', or Q'* C if SIDE = 'L' and */ +/* TRANS = 'T', or C * Q if SIDE = 'R' and TRANS = 'N', or C * */ +/* Q' if SIDE = 'R' and TRANS = 'T', */ +La_extern void +F77_NAME(dorm2r)(const char* side, const char* trans, + const int* m, const int* n, const int* k, + const double* a, const int* lda, const double* tau, + double* c, const int* ldc, double* work, int* info); +/* DORMBR - VECT = 'Q', DORMBR overwrites the general real M-by-N */ +/* matrix C with SIDE = 'L' SIDE = 'R' TRANS = 'N' */ +La_extern void +F77_NAME(dormbr)(const char* vect, const char* side, const char* trans, + const int* m, const int* n, const int* k, + const double* a, const int* lda, const double* tau, + double* c, const int* ldc, + double* work, const int* lwork, int* info); +/* DORMHR - overwrite the general real M-by-N matrix C with */ +/* SIDE = 'L' SIDE = 'R' TRANS = 'N' */ +La_extern void +F77_NAME(dormhr)(const char* side, const char* trans, const int* m, + const int* n, const int* ilo, const int* ihi, + const double* a, const int* lda, const double* tau, + double* c, const int* ldc, + double* work, const int* lwork, int* info); +/* DORML2 - overwrite the general real m by n matrix C with Q * */ +/* C if SIDE = 'L' and TRANS = 'N', or Q'* C if SIDE = 'L' and */ +/* TRANS = 'T', or C * Q if SIDE = 'R' and TRANS = 'N', or C * */ +/* Q' if SIDE = 'R' and TRANS = 'T', */ +La_extern void +F77_NAME(dorml2)(const char* side, const char* trans, + const int* m, const int* n, const int* k, + const double* a, const int* lda, const double* tau, + double* c, const int* ldc, double* work, int* info); +/* DORMLQ - overwrite the general real M-by-N matrix C with */ +/* SIDE = 'L' SIDE = 'R' TRANS = 'N' */ +La_extern void +F77_NAME(dormlq)(const char* side, const char* trans, + const int* m, const int* n, const int* k, + const double* a, const int* lda, + const double* tau, double* c, const int* ldc, + double* work, const int* lwork, int* info); +/* DORMQL - overwrite the general real M-by-N matrix C with */ +/* SIDE = 'L' SIDE = 'R' TRANS = 'N' */ +La_extern void +F77_NAME(dormql)(const char* side, const char* trans, + const int* m, const int* n, const int* k, + const double* a, const int* lda, + const double* tau, double* c, const int* ldc, + double* work, const int* lwork, int* info); +/* DORMQR - overwrite the general real M-by-N matrix C with SIDE = */ +/* 'L' SIDE = 'R' TRANS = 'N' */ +La_extern void +F77_NAME(dormqr)(const char* side, const char* trans, + const int* m, const int* n, const int* k, + const double* a, const int* lda, + const double* tau, double* c, const int* ldc, + double* work, const int* lwork, int* info); +/* DORMR2 - overwrite the general real m by n matrix C with Q * */ +/* C if SIDE = 'L' and TRANS = 'N', or Q'* C if SIDE = 'L' and */ +/* TRANS = 'T', or C * Q if SIDE = 'R' and TRANS = 'N', or C * */ +/* Q' if SIDE = 'R' and TRANS = 'T', */ +La_extern void +F77_NAME(dormr2)(const char* side, const char* trans, + const int* m, const int* n, const int* k, + const double* a, const int* lda, + const double* tau, double* c, const int* ldc, + double* work, int* info); +/* DORMRQ - overwrite the general real M-by-N matrix C with */ +/* SIDE = 'L' SIDE = 'R' TRANS = 'N' */ +La_extern void +F77_NAME(dormrq)(const char* side, const char* trans, + const int* m, const int* n, const int* k, + const double* a, const int* lda, + const double* tau, double* c, const int* ldc, + double* work, const int* lwork, int* info); +/* DORMTR - overwrite the general real M-by-N matrix C with */ +/* SIDE = 'L' SIDE = 'R' TRANS = 'N' */ +La_extern void +F77_NAME(dormtr)(const char* side, const char* uplo, + const char* trans, const int* m, const int* n, + const double* a, const int* lda, + const double* tau, double* c, const int* ldc, + double* work, const int* lwork, int* info); + + +//* Double precision Positive definite Band matrices -> DPB + +/* DPBCON - estimate the reciprocal of the condition number (in */ +/* the 1-norm); of a real symmetric positive definite band matrix */ +/* using the Cholesky factorization A = U**T*U or A = L*L**T */ +/* computed by DPBTRF */ +La_extern void +F77_NAME(dpbcon)(const char* uplo, const int* n, const int* kd, + const double* ab, const int* ldab, + const double* anorm, double* rcond, + double* work, int* iwork, int* info); +/* DPBEQU - compute row and column scalings intended to */ +/* equilibrate a symmetric positive definite band matrix A and */ +/* reduce its condition number (with respect to the two-norm); */ +La_extern void +F77_NAME(dpbequ)(const char* uplo, const int* n, const int* kd, + const double* ab, const int* ldab, + double* s, double* scond, double* amax, int* info); +/* DPBRFS - improve the computed solution to a system of linear */ +/* equations when the coefficient matrix is symmetric positive */ +/* definite and banded, and provides error bounds and backward */ +/* error estimates for the solution */ +La_extern void +F77_NAME(dpbrfs)(const char* uplo, const int* n, + const int* kd, const int* nrhs, + const double* ab, const int* ldab, + const double* afb, const int* ldafb, + const double* b, const int* ldb, + double* x, const int* ldx, + double* ferr, double* berr, + double* work, int* iwork, int* info); +/* DPBSTF - compute a split Cholesky factorization of a real */ +/* symmetric positive definite band matrix A */ +La_extern void +F77_NAME(dpbstf)(const char* uplo, const int* n, const int* kd, + double* ab, const int* ldab, int* info); +/* DPBSV - compute the solution to a real system of linear */ +/* equations A * X = B, */ +La_extern void +F77_NAME(dpbsv)(const char* uplo, const int* n, + const int* kd, const int* nrhs, + double* ab, const int* ldab, + double* b, const int* ldb, int* info); +/* DPBSVX - use the Cholesky factorization A = U**T*U or A = */ +/* L*L**T to compute the solution to a real system of linear */ +/* equations A * X = B, */ +La_extern void +F77_NAME(dpbsvx)(const int* fact, const char* uplo, const int* n, + const int* kd, const int* nrhs, + double* ab, const int* ldab, + double* afb, const int* ldafb, + char* equed, double* s, + double* b, const int* ldb, + double* x, const int* ldx, double* rcond, + double* ferr, double* berr, + double* work, int* iwork, int* info); +/* DPBTF2 - compute the Cholesky factorization of a real */ +/* symmetric positive definite band matrix A */ +La_extern void +F77_NAME(dpbtf2)(const char* uplo, const int* n, const int* kd, + double* ab, const int* ldab, int* info); +/* DPBTRF - compute the Cholesky factorization of a real */ +/* symmetric positive definite band matrix A */ +La_extern void +F77_NAME(dpbtrf)(const char* uplo, const int* n, const int* kd, + double* ab, const int* ldab, int* info); +/* DPBTRS - solve a system of linear equations A*X = B with a */ +/* symmetric positive definite band matrix A using the Cholesky */ +/* factorization A = U**T*U or A = L*L**T computed by DPBTRF */ +La_extern void +F77_NAME(dpbtrs)(const char* uplo, const int* n, + const int* kd, const int* nrhs, + const double* ab, const int* ldab, + double* b, const int* ldb, int* info); + + +//* Double precision Positive definite matrices -> DPO + +/* DPOCON - estimate the reciprocal of the condition number (in */ +/* the 1-norm); of a real symmetric positive definite matrix using */ +/* the Cholesky factorization A = U**T*U or A = L*L**T computed by */ +/* DPOTRF */ +La_extern void +F77_NAME(dpocon)(const char* uplo, const int* n, + const double* a, const int* lda, + const double* anorm, double* rcond, + double* work, int* iwork, int* info); +/* DPOEQU - compute row and column scalings intended to */ +/* equilibrate a symmetric positive definite matrix A and reduce */ +/* its condition number (with respect to the two-norm); */ +La_extern void +F77_NAME(dpoequ)(const int* n, const double* a, const int* lda, + double* s, double* scond, double* amax, int* info); +/* DPORFS - improve the computed solution to a system of linear */ +/* equations when the coefficient matrix is symmetric positive */ +/* definite, */ +La_extern void +F77_NAME(dporfs)(const char* uplo, const int* n, const int* nrhs, + const double* a, const int* lda, + const double* af, const int* ldaf, + const double* b, const int* ldb, + double* x, const int* ldx, + double* ferr, double* berr, + double* work, int* iwork, int* info); +/* DPOSV - compute the solution to a real system of linear */ +/* equations A * X = B, */ +La_extern void +F77_NAME(dposv)(const char* uplo, const int* n, const int* nrhs, + double* a, const int* lda, + double* b, const int* ldb, int* info); +/* DPOSVX - use the Cholesky factorization A = U**T*U or A = */ +/* L*L**T to compute the solution to a real system of linear */ +/* equations A * X = B, */ +La_extern void +F77_NAME(dposvx)(const int* fact, const char* uplo, + const int* n, const int* nrhs, + double* a, const int* lda, + double* af, const int* ldaf, char* equed, + double* s, double* b, const int* ldb, + double* x, const int* ldx, double* rcond, + double* ferr, double* berr, double* work, + int* iwork, int* info); +/* DPOTF2 - compute the Cholesky factorization of a real */ +/* symmetric positive definite matrix A */ +La_extern void +F77_NAME(dpotf2)(const char* uplo, const int* n, + double* a, const int* lda, int* info); +/* DPOTRF - compute the Cholesky factorization of a real */ +/* symmetric positive definite matrix A */ +La_extern void +F77_NAME(dpotrf)(const char* uplo, const int* n, + double* a, const int* lda, int* info); +/* DPOTRI - compute the inverse of a real symmetric positive */ +/* definite matrix A using the Cholesky factorization A = U**T*U */ +/* or A = L*L**T computed by DPOTRF */ +La_extern void +F77_NAME(dpotri)(const char* uplo, const int* n, + double* a, const int* lda, int* info); +/* DPOTRS - solve a system of linear equations A*X = B with a */ +/* symmetric positive definite matrix A using the Cholesky */ +/* factorization A = U**T*U or A = L*L**T computed by DPOTRF */ +La_extern void +F77_NAME(dpotrs)(const char* uplo, const int* n, + const int* nrhs, const double* a, const int* lda, + double* b, const int* ldb, int* info); +/* DPPCON - estimate the reciprocal of the condition number (in */ +/* the 1-norm); of a real symmetric positive definite packed */ +/* matrix using the Cholesky factorization A = U**T*U or A = */ +/* L*L**T computed by DPPTRF */ +La_extern void +F77_NAME(dppcon)(const char* uplo, const int* n, + const double* ap, const double* anorm, double* rcond, + double* work, int* iwork, int* info); +/* DPPEQU - compute row and column scalings intended to */ +/* equilibrate a symmetric positive definite matrix A in packed */ +/* storage and reduce its condition number (with respect to the */ +/* two-norm); */ +La_extern void +F77_NAME(dppequ)(const char* uplo, const int* n, + const double* ap, double* s, double* scond, + double* amax, int* info); + + +//* Double precision Positive definite matrices in Packed storage -> DPP + +/* DPPRFS - improve the computed solution to a system of linear */ +/* equations when the coefficient matrix is symmetric positive */ +/* definite and packed, and provides error bounds and backward */ +/* error estimates for the solution */ +La_extern void +F77_NAME(dpprfs)(const char* uplo, const int* n, const int* nrhs, + const double* ap, const double* afp, + const double* b, const int* ldb, + double* x, const int* ldx, + double* ferr, double* berr, + double* work, int* iwork, int* info); +/* DPPSV - compute the solution to a real system of linear */ +/* equations A * X = B, */ +La_extern void +F77_NAME(dppsv)(const char* uplo, const int* n, + const int* nrhs, const double* ap, + double* b, const int* ldb, int* info); +/* DPPSVX - use the Cholesky factorization A = U**T*U or A = */ +/* L*L**T to compute the solution to a real system of linear */ +/* equations A * X = B, */ +La_extern void +F77_NAME(dppsvx)(const int* fact, const char* uplo, + const int* n, const int* nrhs, double* ap, + double* afp, char* equed, double* s, + double* b, const int* ldb, + double* x, const int* ldx, + double* rcond, double* ferr, double* berr, + double* work, int* iwork, int* info); +/* DPPTRF - compute the Cholesky factorization of a real */ +/* symmetric positive definite matrix A stored in packed format */ +La_extern void +F77_NAME(dpptrf)(const char* uplo, const int* n, double* ap, int* info); +/* DPPTRI - compute the inverse of a real symmetric positive */ +/* definite matrix A using the Cholesky factorization A = U**T*U */ +/* or A = L*L**T computed by DPPTRF */ +La_extern void +F77_NAME(dpptri)(const char* uplo, const int* n, double* ap, int* info); +/* DPPTRS - solve a system of linear equations A*X = B with a */ +/* symmetric positive definite matrix A in packed storage using */ +/* the Cholesky factorization A = U**T*U or A = L*L**T computed by */ +/* DPPTRF */ +La_extern void +F77_NAME(dpptrs)(const char* uplo, const int* n, + const int* nrhs, const double* ap, + double* b, const int* ldb, int* info); + +//* Double precision symmetric Positive definite Tridiagonal matrices -> DPT + +/* DPTCON - compute the reciprocal of the condition number (in */ +/* the 1-norm); of a real symmetric positive definite tridiagonal */ +/* matrix using the factorization A = L*D*L**T or A = U**T*D*U */ +/* computed by DPTTRF */ +La_extern void +F77_NAME(dptcon)(const int* n, + const double* d, const double* e, + const double* anorm, double* rcond, + double* work, int* info); +/* DPTEQR - compute all eigenvalues and, optionally, eigenvectors */ +/* of a symmetric positive definite tridiagonal matrix by first */ +/* factoring the matrix using DPTTRF, and then calling DBDSQR to */ +/* compute the singular values of the bidiagonal factor */ +La_extern void +F77_NAME(dpteqr)(const char* compz, const int* n, double* d, + double* e, double* z, const int* ldz, + double* work, int* info); +/* DPTRFS - improve the computed solution to a system of linear */ +/* equations when the coefficient matrix is symmetric positive */ +/* definite and tridiagonal, and provides error bounds and */ +/* backward error estimates for the solution */ +La_extern void +F77_NAME(dptrfs)(const int* n, const int* nrhs, + const double* d, const double* e, + const double* df, const double* ef, + const double* b, const int* ldb, + double* x, const int* ldx, + double* ferr, double* berr, + double* work, int* info); +/* DPTSV - compute the solution to a real system of linear */ +/* equations A*X = B, where A is an N-by-N symmetric positive */ +/* definite tridiagonal matrix, and X and B are N-by-NRHS matrices */ +La_extern void +F77_NAME(dptsv)(const int* n, const int* nrhs, double* d, + double* e, double* b, const int* ldb, int* info); +/* DPTSVX - use the factorization A = L*D*L**T to compute the */ +/* solution to a real system of linear equations A*X = B, where A */ +/* is an N-by-N symmetric positive definite tridiagonal matrix and */ +/* X and B are N-by-NRHS matrices */ +La_extern void +F77_NAME(dptsvx)(const int* fact, const int* n, + const int* nrhs, + const double* d, const double* e, + double* df, double* ef, + const double* b, const int* ldb, + double* x, const int* ldx, double* rcond, + double* ferr, double* berr, + double* work, int* info); +/* DPTTRF - compute the factorization of a real symmetric */ +/* positive definite tridiagonal matrix A */ +La_extern void +F77_NAME(dpttrf)(const int* n, double* d, double* e, int* info); +/* DPTTRS - solve a system of linear equations A * X = B with a */ +/* symmetric positive definite tridiagonal matrix A using the */ +/* factorization A = L*D*L**T or A = U**T*D*U computed by DPTTRF */ +La_extern void +F77_NAME(dpttrs)(const int* n, const int* nrhs, + const double* d, const double* e, + double* b, const int* ldb, int* info); +/* DRSCL - multiply an n-element real vector x by the real scalar */ +/* 1/a */ +La_extern void +F77_NAME(drscl)(const int* n, const double* da, + double* x, const int* incx); + +//* Double precision Symmetric Band matrices -> DSB + +/* DSBEV - compute all the eigenvalues and, optionally, */ +/* eigenvectors of a real symmetric band matrix A */ +La_extern void +F77_NAME(dsbev)(const char* jobz, const char* uplo, + const int* n, const int* kd, + double* ab, const int* ldab, + double* w, double* z, const int* ldz, + double* work, int* info); +/* DSBEVD - compute all the eigenvalues and, optionally, */ +/* eigenvectors of a real symmetric band matrix A */ +La_extern void +F77_NAME(dsbevd)(const char* jobz, const char* uplo, + const int* n, const int* kd, + double* ab, const int* ldab, + double* w, double* z, const int* ldz, + double* work, const int* lwork, + int* iwork, const int* liwork, int* info); +/* DSBEVX - compute selected eigenvalues and, optionally, */ +/* eigenvectors of a real symmetric band matrix A */ +La_extern void +F77_NAME(dsbevx)(const char* jobz, const char* range, + const char* uplo, const int* n, const int* kd, + double* ab, const int* ldab, + double* q, const int* ldq, + const double* vl, const double* vu, + const int* il, const int* iu, + const double* abstol, + int* m, double* w, + double* z, const int* ldz, + double* work, int* iwork, + int* ifail, int* info); +/* DSBGST - reduce a real symmetric-definite banded generalized */ +/* eigenproblem A*x = lambda*B*x to standard form C*y = lambda*y, */ +La_extern void +F77_NAME(dsbgst)(const char* vect, const char* uplo, + const int* n, const int* ka, const int* kb, + double* ab, const int* ldab, + double* bb, const int* ldbb, + double* x, const int* ldx, + double* work, int* info); +/* DSBGV - compute all the eigenvalues, and optionally, the */ +/* eigenvectors of a real generalized symmetric-definite banded */ +/* eigenproblem, of the form A*x=(lambda);*B*x */ +La_extern void +F77_NAME(dsbgv)(const char* jobz, const char* uplo, + const int* n, const int* ka, const int* kb, + double* ab, const int* ldab, + double* bb, const int* ldbb, + double* w, double* z, const int* ldz, + double* work, int* info); +/* DSBTRD - reduce a real symmetric band matrix A to symmetric */ +/* tridiagonal form T by an orthogonal similarity transformation */ +La_extern void +F77_NAME(dsbtrd)(const char* vect, const char* uplo, + const int* n, const int* kd, + double* ab, const int* ldab, + double* d, double* e, + double* q, const int* ldq, + double* work, int* info); + +//* Double precision Symmetric Packed matrices -> DSP + +/* DSPCON - estimate the reciprocal of the condition number (in */ +/* the 1-norm); of a real symmetric packed matrix A using the */ +/* factorization A = U*D*U**T or A = L*D*L**T computed by DSPTRF */ +La_extern void +F77_NAME(dspcon)(const char* uplo, const int* n, + const double* ap, const int* ipiv, + const double* anorm, double* rcond, + double* work, int* iwork, int* info); +/* DSPEV - compute all the eigenvalues and, optionally, */ +/* eigenvectors of a real symmetric matrix A in packed storage */ +La_extern void +F77_NAME(dspev)(const char* jobz, const char* uplo, const int* n, + double* ap, double* w, double* z, const int* ldz, + double* work, int* info); +/* DSPEVD - compute all the eigenvalues and, optionally, */ +/* eigenvectors of a real symmetric matrix A in packed storage */ +La_extern void +F77_NAME(dspevd)(const char* jobz, const char* uplo, + const int* n, double* ap, double* w, + double* z, const int* ldz, + double* work, const int* lwork, + int* iwork, const int* liwork, int* info); +/* DSPEVX - compute selected eigenvalues and, optionally, */ +/* eigenvectors of a real symmetric matrix A in packed storage */ +La_extern void +F77_NAME(dspevx)(const char* jobz, const char* range, + const char* uplo, const int* n, double* ap, + const double* vl, const double* vu, + const int* il, const int* iu, + const double* abstol, + int* m, double* w, + double* z, const int* ldz, + double* work, int* iwork, + int* ifail, int* info); +/* DSPGST - reduce a real symmetric-definite generalized */ +/* eigenproblem to standard form, using packed storage */ +La_extern void +F77_NAME(dspgst)(const int* itype, const char* uplo, + const int* n, double* ap, double* bp, int* info); +/* DSPGV - compute all the eigenvalues and, optionally, the */ +/* eigenvectors of a real generalized symmetric-definite */ +/* eigenproblem, of the form A*x=(lambda)*B*x, A*Bx=(lambda)*x, */ +/* or B*A*x=(lambda)*x */ +La_extern void +F77_NAME(dspgv)(const int* itype, const char* jobz, + const char* uplo, const int* n, + double* ap, double* bp, double* w, + double* z, const int* ldz, + double* work, int* info); + +/* DSPRFS - improve the computed solution to a system of linear */ +/* equations when the coefficient matrix is symmetric indefinite */ +/* and packed, and provides error bounds and backward error */ +/* estimates for the solution */ +La_extern void +F77_NAME(dsprfs)(const char* uplo, const int* n, + const int* nrhs, const double* ap, + const double* afp, const int* ipiv, + const double* b, const int* ldb, + double* x, const int* ldx, + double* ferr, double* berr, + double* work, int* iwork, int* info); + +/* DSPSV - compute the solution to a real system of linear */ +/* equations A * X = B, */ +La_extern void +F77_NAME(dspsv)(const char* uplo, const int* n, + const int* nrhs, double* ap, int* ipiv, + double* b, const int* ldb, int* info); + +/* DSPSVX - use the diagonal pivoting factorization A = U*D*U**T */ +/* or A = L*D*L**T to compute the solution to a real system of */ +/* linear equations A * X = B, where A is an N-by-N symmetric */ +/* matrix stored in packed format and X and B are N-by-NRHS */ +/* matrices */ +La_extern void +F77_NAME(dspsvx)(const int* fact, const char* uplo, + const int* n, const int* nrhs, + const double* ap, double* afp, int* ipiv, + const double* b, const int* ldb, + double* x, const int* ldx, + double* rcond, double* ferr, double* berr, + double* work, int* iwork, int* info); + +/* DSPTRD - reduce a real symmetric matrix A stored in packed */ +/* form to symmetric tridiagonal form T by an orthogonal */ +/* similarity transformation */ +La_extern void +F77_NAME(dsptrd)(const char* uplo, const int* n, + double* ap, double* d, double* e, + double* tau, int* info); + +/* DSPTRF - compute the factorization of a real symmetric matrix */ +/* A stored in packed format using the Bunch-Kaufman diagonal */ +/* pivoting method */ +La_extern void +F77_NAME(dsptrf)(const char* uplo, const int* n, + double* ap, int* ipiv, int* info); + +/* DSPTRI - compute the inverse of a real symmetric indefinite */ +/* matrix A in packed storage using the factorization A = U*D*U**T */ +/* or A = L*D*L**T computed by DSPTRF */ +La_extern void +F77_NAME(dsptri)(const char* uplo, const int* n, + double* ap, const int* ipiv, + double* work, int* info); + +/* DSPTRS - solve a system of linear equations A*X = B with a */ +/* real symmetric matrix A stored in packed format using the */ +/* factorization A = U*D*U**T or A = L*D*L**T computed by DSPTRF */ +La_extern void +F77_NAME(dsptrs)(const char* uplo, const int* n, + const int* nrhs, const double* ap, + const int* ipiv, double* b, const int* ldb, int* info); + + +//* Double precision Symmetric Tridiagonal matrices -> DST + +/* DSTEBZ - compute the eigenvalues of a symmetric tridiagonal */ +/* matrix T */ +La_extern void +F77_NAME(dstebz)(const char* range, const char* order, const int* n, + const double* vl, const double* vu, + const int* il, const int* iu, + const double *abstol, + const double* d, const double* e, + int* m, int* nsplit, double* w, + int* iblock, int* isplit, + double* work, int* iwork, + int* info); +/* DSTEDC - compute all eigenvalues and, optionally, eigenvectors */ +/* of a symmetric tridiagonal matrix using the divide and conquer */ +/* method */ +La_extern void +F77_NAME(dstedc)(const char* compz, const int* n, + double* d, double* e, + double* z, const int* ldz, + double* work, const int* lwork, + int* iwork, const int* liwork, int* info); +/* DSTEIN - compute the eigenvectors of a real symmetric */ +/* tridiagonal matrix T corresponding to specified eigenvalues, */ +/* using inverse iteration */ +La_extern void +F77_NAME(dstein)(const int* n, const double* d, const double* e, + const int* m, const double* w, + const int* iblock, const int* isplit, + double* z, const int* ldz, + double* work, int* iwork, + int* ifail, int* info); +/* DSTEQR - compute all eigenvalues and, optionally, eigenvectors */ +/* of a symmetric tridiagonal matrix using the implicit QL or QR */ +/* method */ +La_extern void +F77_NAME(dsteqr)(const char* compz, const int* n, double* d, double* e, + double* z, const int* ldz, double* work, int* info); +/* DSTERF - compute all eigenvalues of a symmetric tridiagonal */ +/* matrix using the Pal-Walker-Kahan variant of the QL or QR */ +/* algorithm */ +La_extern void +F77_NAME(dsterf)(const int* n, double* d, double* e, int* info); +/* DSTEV - compute all eigenvalues and, optionally, eigenvectors */ +/* of a real symmetric tridiagonal matrix A */ +La_extern void +F77_NAME(dstev)(const char* jobz, const int* n, + double* d, double* e, + double* z, const int* ldz, + double* work, int* info); +/* DSTEVD - compute all eigenvalues and, optionally, eigenvectors */ +/* of a real symmetric tridiagonal matrix */ +La_extern void +F77_NAME(dstevd)(const char* jobz, const int* n, + double* d, double* e, + double* z, const int* ldz, + double* work, const int* lwork, + int* iwork, const int* liwork, int* info); +/* DSTEVX - compute selected eigenvalues and, optionally, */ +/* eigenvectors of a real symmetric tridiagonal matrix A */ +La_extern void +F77_NAME(dstevx)(const char* jobz, const char* range, + const int* n, double* d, double* e, + const double* vl, const double* vu, + const int* il, const int* iu, + const double* abstol, + int* m, double* w, + double* z, const int* ldz, + double* work, int* iwork, + int* ifail, int* info); + +//* Double precision SYmmetric matrices -> DSY + +/* DSYCON - estimate the reciprocal of the condition number (in */ +/* the 1-norm); of a real symmetric matrix A using the */ +/* factorization A = U*D*U**T or A = L*D*L**T computed by DSYTRF */ +La_extern void +F77_NAME(dsycon)(const char* uplo, const int* n, + const double* a, const int* lda, + const int* ipiv, + const double* anorm, double* rcond, + double* work, int* iwork, int* info); +/* DSYEV - compute all eigenvalues and, optionally, eigenvectors */ +/* of a real symmetric matrix A */ +La_extern void +F77_NAME(dsyev)(const char* jobz, const char* uplo, + const int* n, double* a, const int* lda, + double* w, double* work, const int* lwork, int* info); +/* DSYEVD - compute all eigenvalues and, optionally, eigenvectors */ +/* of a real symmetric matrix A */ +La_extern void +F77_NAME(dsyevd)(const char* jobz, const char* uplo, + const int* n, double* a, const int* lda, + double* w, double* work, const int* lwork, + int* iwork, const int* liwork, int* info); +/* DSYEVX - compute selected eigenvalues and, optionally, */ +/* eigenvectors of a real symmetric matrix A */ +La_extern void +F77_NAME(dsyevx)(const char* jobz, const char* range, + const char* uplo, const int* n, + double* a, const int* lda, + const double* vl, const double* vu, + const int* il, const int* iu, + const double* abstol, + int* m, double* w, + double* z, const int* ldz, + double* work, const int* lwork, int* iwork, + int* ifail, int* info); +/* DSYEVR - compute all eigenvalues and, optionally, eigenvectors */ +/* of a real symmetric matrix A */ +La_extern void +F77_NAME(dsyevr)(const char *jobz, const char *range, const char *uplo, + const int *n, double *a, const int *lda, + const double *vl, const double *vu, + const int *il, const int *iu, + const double *abstol, int *m, double *w, + double *z, const int *ldz, int *isuppz, + double *work, const int *lwork, + int *iwork, const int *liwork, + int *info); +/* DSYGS2 - reduce a real symmetric-definite generalized */ +/* eigenproblem to standard form */ +La_extern void +F77_NAME(dsygs2)(const int* itype, const char* uplo, + const int* n, double* a, const int* lda, + const double* b, const int* ldb, int* info); +/* DSYGST - reduce a real symmetric-definite generalized */ +/* eigenproblem to standard form */ +La_extern void +F77_NAME(dsygst)(const int* itype, const char* uplo, + const int* n, double* a, const int* lda, + const double* b, const int* ldb, int* info); +/* DSYGV - compute all the eigenvalues, and optionally, the */ +/* eigenvectors of a real generalized symmetric-definite */ +/* eigenproblem, of the form A*x=(lambda);*B*x, A*Bx=(lambda);*x, */ +/* or B*A*x=(lambda);*x */ +La_extern void +F77_NAME(dsygv)(const int* itype, const char* jobz, + const char* uplo, const int* n, + double* a, const int* lda, + double* b, const int* ldb, + double* w, double* work, const int* lwork, + int* info); +/* DSYRFS - improve the computed solution to a system of linear */ +/* equations when the coefficient matrix is symmetric indefinite, */ +/* and provides error bounds and backward error estimates for the */ +/* solution */ +La_extern void +F77_NAME(dsyrfs)(const char* uplo, const int* n, + const int* nrhs, + const double* a, const int* lda, + const double* af, const int* ldaf, + const int* ipiv, + const double* b, const int* ldb, + double* x, const int* ldx, + double* ferr, double* berr, + double* work, int* iwork, int* info); + +/* DSYSV - compute the solution to a real system of linear */ +/* equations A * X = B, */ +La_extern void +F77_NAME(dsysv)(const char* uplo, const int* n, + const int* nrhs, + double* a, const int* lda, int* ipiv, + double* b, const int* ldb, + double* work, const int* lwork, int* info); + +/* DSYSVX - use the diagonal pivoting factorization to compute */ +/* the solution to a real system of linear equations A * X = B, */ +La_extern void +F77_NAME(dsysvx)(const int* fact, const char* uplo, + const int* n, const int* nrhs, + const double* a, const int* lda, + double* af, const int* ldaf, int* ipiv, + const double* b, const int* ldb, + double* x, const int* ldx, double* rcond, + double* ferr, double* berr, + double* work, const int* lwork, + int* iwork, int* info); + +/* DSYTD2 - reduce a real symmetric matrix A to symmetric */ +/* tridiagonal form T by an orthogonal similarity transformation */ +La_extern void +F77_NAME(dsytd2)(const char* uplo, const int* n, + double* a, const int* lda, + double* d, double* e, double* tau, + int* info); + +/* DSYTF2 - compute the factorization of a real symmetric matrix */ +/* A using the Bunch-Kaufman diagonal pivoting method */ +La_extern void +F77_NAME(dsytf2)(const char* uplo, const int* n, + double* a, const int* lda, + int* ipiv, int* info); + +/* DSYTRD - reduce a real symmetric matrix A to real symmetric */ +/* tridiagonal form T by an orthogonal similarity transformation */ +La_extern void +F77_NAME(dsytrd)(const char* uplo, const int* n, + double* a, const int* lda, + double* d, double* e, double* tau, + double* work, const int* lwork, int* info); + +/* DSYTRF - compute the factorization of a real symmetric matrix */ +/* A using the Bunch-Kaufman diagonal pivoting method */ +La_extern void +F77_NAME(dsytrf)(const char* uplo, const int* n, + double* a, const int* lda, int* ipiv, + double* work, const int* lwork, int* info); + +/* DSYTRI - compute the inverse of a real symmetric indefinite */ +/* matrix A using the factorization A = U*D*U**T or A = L*D*L**T */ +/* computed by DSYTRF */ +La_extern void +F77_NAME(dsytri)(const char* uplo, const int* n, + double* a, const int* lda, const int* ipiv, + double* work, int* info); + +/* DSYTRS - solve a system of linear equations A*X = B with a */ +/* real symmetric matrix A using the factorization A = U*D*U**T or */ +/* A = L*D*L**T computed by DSYTRF */ +La_extern void +F77_NAME(dsytrs)(const char* uplo, const int* n, + const int* nrhs, + const double* a, const int* lda, + const int* ipiv, + double* b, const int* ldb, int* info); + +//* Double precision Triangular Band matrices -> DTB + +/* DTBCON - estimate the reciprocal of the condition number of a */ +/* triangular band matrix A, in either the 1-norm or the */ +/* infinity-norm */ +La_extern void +F77_NAME(dtbcon)(const char* norm, const char* uplo, + const char* diag, const int* n, const int* kd, + const double* ab, const int* ldab, + double* rcond, double* work, + int* iwork, int* info); +/* DTBRFS - provide error bounds and backward error estimates for */ +/* the solution to a system of linear equations with a triangular */ +/* band coefficient matrix */ +La_extern void +F77_NAME(dtbrfs)(const char* uplo, const char* trans, + const char* diag, const int* n, const int* kd, + const int* nrhs, + const double* ab, const int* ldab, + const double* b, const int* ldb, + double* x, const int* ldx, + double* ferr, double* berr, + double* work, int* iwork, int* info); +/* DTBTRS - solve a triangular system of the form A * X = B or */ +/* A**T * X = B, */ +La_extern void +F77_NAME(dtbtrs)(const char* uplo, const char* trans, + const char* diag, const int* n, + const int* kd, const int* nrhs, + const double* ab, const int* ldab, + double* b, const int* ldb, int* info); + +//* Double precision Triangular matrices Generalized problems -> DTG + +/* DTGEVC - compute some or all of the right and/or left */ +/* generalized eigenvectors of a pair of real upper triangular */ +/* matrices (A,B); */ +La_extern void +F77_NAME(dtgevc)(const char* side, const char* howmny, + const int* select, const int* n, + const double* a, const int* lda, + const double* b, const int* ldb, + double* vl, const int* ldvl, + double* vr, const int* ldvr, + const int* mm, int* m, double* work, int* info); + +/* DTGSJA - compute the generalized singular value decomposition */ +/* (GSVD); of two real upper triangular (or trapezoidal); matrices */ +/* A and B */ +La_extern void +F77_NAME(dtgsja)(const char* jobu, const char* jobv, const char* jobq, + const int* m, const int* p, const int* n, + const int* k, const int* l, + double* a, const int* lda, + double* b, const int* ldb, + const double* tola, const double* tolb, + double* alpha, double* beta, + double* u, const int* ldu, + double* v, const int* ldv, + double* q, const int* ldq, + double* work, int* ncycle, int* info); + +//* Double precision Triangular matrices Packed storage -> DTP + +/* DTPCON - estimate the reciprocal of the condition number of a */ +/* packed triangular matrix A, in either the 1-norm or the */ +/* infinity-norm */ +La_extern void +F77_NAME(dtpcon)(const char* norm, const char* uplo, + const char* diag, const int* n, + const double* ap, double* rcond, + double* work, int* iwork, int* info); + +/* DTPRFS - provide error bounds and backward error estimates for */ +/* the solution to a system of linear equations with a triangular */ +/* packed coefficient matrix */ +La_extern void +F77_NAME(dtprfs)(const char* uplo, const char* trans, + const char* diag, const int* n, + const int* nrhs, const double* ap, + const double* b, const int* ldb, + double* x, const int* ldx, + double* ferr, double* berr, + double* work, int* iwork, int* info); +/* DTPTRI - compute the inverse of a real upper or lower */ +/* triangular matrix A stored in packed format */ +La_extern void +F77_NAME(dtptri)(const char* uplo, const char* diag, + const int* n, double* ap, int* info); + +/* DTPTRS - solve a triangular system of the form A * X = B or */ +/* A**T * X = B, */ +La_extern void +F77_NAME(dtptrs)(const char* uplo, const char* trans, + const char* diag, const int* n, + const int* nrhs, const double* ap, + double* b, const int* ldb, int* info); + + +//* Double precision TRiangular matrices -> DTR + +/* DTRCON - estimate the reciprocal of the condition number of a */ +/* triangular matrix A, in either the 1-norm or the infinity-norm */ +La_extern void +F77_NAME(dtrcon)(const char* norm, const char* uplo, + const char* diag, const int* n, + const double* a, const int* lda, + double* rcond, double* work, + int* iwork, int* info); + +/* DTREVC - compute some or all of the right and/or left */ +/* eigenvectors of a real upper quasi-triangular matrix T */ +La_extern void +F77_NAME(dtrevc)(const char* side, const char* howmny, + const int* select, const int* n, + const double* t, const int* ldt, + double* vl, const int* ldvl, + double* vr, const int* ldvr, + const int* mm, int* m, double* work, int* info); + +/* DTREXC - reorder the real Schur factorization of a real matrix */ +/* A = Q*T*Q**T, so that the diagonal block of T with row index */ +/* IFST is moved to row ILST */ +La_extern void +F77_NAME(dtrexc)(const char* compq, const int* n, + double* t, const int* ldt, + double* q, const int* ldq, + int* ifst, int* ILST, + double* work, int* info); + +/* DTRRFS - provide error bounds and backward error estimates for */ +/* the solution to a system of linear equations with a triangular */ +/* coefficient matrix */ +La_extern void +F77_NAME(dtrrfs)(const char* uplo, const char* trans, + const char* diag, const int* n, const int* nrhs, + const double* a, const int* lda, + const double* b, const int* ldb, + double* x, const int* ldx, + double* ferr, double* berr, + double* work, int* iwork, int* info); + +/* DTRSEN - reorder the real Schur factorization of a real matrix */ +/* A = Q*T*Q**T, so that a selected cluster of eigenvalues appears */ +/* in the leading diagonal blocks of the upper quasi-triangular */ +/* matrix T, */ +La_extern void +F77_NAME(dtrsen)(const char* job, const char* compq, + const int* select, const int* n, + double* t, const int* ldt, + double* q, const int* ldq, + double* wr, double* wi, + int* m, double* s, double* sep, + double* work, const int* lwork, + int* iwork, const int* liwork, int* info); + +/* DTRSNA - estimate reciprocal condition numbers for specified */ +/* eigenvalues and/or right eigenvectors of a real upper */ +/* quasi-triangular matrix T (or of any matrix Q*T*Q**T with Q */ +/* orthogonal); */ +La_extern void +F77_NAME(dtrsna)(const char* job, const char* howmny, + const int* select, const int* n, + const double* t, const int* ldt, + const double* vl, const int* ldvl, + const double* vr, const int* ldvr, + double* s, double* sep, const int* mm, + int* m, double* work, const int* lwork, + int* iwork, int* info); + +/* DTRSYL - solve the real Sylvester matrix equation */ +La_extern void +F77_NAME(dtrsyl)(const char* trana, const char* tranb, + const int* isgn, const int* m, const int* n, + const double* a, const int* lda, + const double* b, const int* ldb, + double* c, const int* ldc, + double* scale, int* info); + +/* DTRTI2 - compute the inverse of a real upper or lower */ +/* triangular matrix */ +La_extern void +F77_NAME(dtrti2)(const char* uplo, const char* diag, + const int* n, double* a, const int* lda, + int* info); + +/* DTRTRI - compute the inverse of a real upper or lower */ +/* triangular matrix A */ +La_extern void +F77_NAME(dtrtri)(const char* uplo, const char* diag, + const int* n, double* a, const int* lda, + int* info); + +/* DTRTRS - solve a triangular system of the form A * X = B or */ +/* A**T * X = B */ +La_extern void +F77_NAME(dtrtrs)(const char* uplo, const char* trans, + const char* diag, const int* n, const int* nrhs, + const double* a, const int* lda, + double* b, const int* ldb, int* info); + + + +//* Double precision utilities in Lapack + +/* DHGEQZ - implement a single-/double-shift version of the QZ */ +/* method for finding the generalized eigenvalues */ +/* w(j);=(ALPHAR(j); + i*ALPHAI(j););/BETAR(j); of the equation */ +/* det( A - w(i); B ); = 0 In addition, the pair A,B may be */ +/* reduced to generalized Schur form */ +La_extern void +F77_NAME(dhgeqz)(const char* job, const char* compq, const char* compz, + const int* n, const int *ILO, const int* IHI, + double* a, const int* lda, + double* b, const int* ldb, + double* alphar, double* alphai, const double* beta, + double* q, const int* ldq, + double* z, const int* ldz, + double* work, const int* lwork, int* info); +/* DHSEIN - use inverse iteration to find specified right and/or */ +/* left eigenvectors of a real upper Hessenberg matrix H */ +La_extern void +F77_NAME(dhsein)(const char* side, const char* eigsrc, + const char* initv, int* select, + const int* n, double* h, const int* ldh, + double* wr, double* wi, + double* vl, const int* ldvl, + double* vr, const int* ldvr, + const int* mm, int* m, double* work, + int* ifaill, int* ifailr, int* info); +/* DHSEQR - compute the eigenvalues of a real upper Hessenberg */ +/* matrix H and, optionally, the matrices T and Z from the Schur */ +/* decomposition H = Z T Z**T, where T is an upper */ +/* quasi-triangular matrix (the Schur form);, and Z is the */ +/* orthogonal matrix of Schur vectors */ +La_extern void +F77_NAME(dhseqr)(const char* job, const char* compz, const int* n, + const int* ilo, const int* ihi, + double* h, const int* ldh, + double* wr, double* wi, + double* z, const int* ldz, + double* work, const int* lwork, int* info); +/* DLABAD - take as input the values computed by SLAMCH for */ +/* underflow and overflow, and returns the square root of each of */ +/* these values if the log of LARGE is sufficiently large */ +La_extern void +F77_NAME(dlabad)(double* small, double* large); +/* DLABRD - reduce the first NB rows and columns of a real */ +/* general m by n matrix A to upper or lower bidiagonal form by an */ +/* orthogonal transformation Q' * A * P, and returns the matrices */ +/* X and Y which are needed to apply the transformation to the */ +/* unreduced part of A */ +La_extern void +F77_NAME(dlabrd)(const int* m, const int* n, const int* nb, + double* a, const int* lda, double* d, double* e, + double* tauq, double* taup, + double* x, const int* ldx, double* y, const int* ldy); +/* DLACON - estimate the 1-norm of a square, real matrix A */ +La_extern void +F77_NAME(dlacon)(const int* n, double* v, double* x, + int* isgn, double* est, int* kase); +/* DLACPY - copy all or part of a two-dimensional matrix A to */ +/* another matrix B */ +La_extern void +F77_NAME(dlacpy)(const char* uplo, const int* m, const int* n, + const double* a, const int* lda, + double* b, const int* ldb); +/* DLADIV - perform complex division in real arithmetic */ +La_extern void +F77_NAME(dladiv)(const double* a, const double* b, + const double* c, const double* d, + double* p, double* q); +/* DLAE2 - compute the eigenvalues of a 2-by-2 symmetric matrix [ A B ] */ +/* [ B C ] */ +La_extern void +F77_NAME(dlae2)(const double* a, const double* b, const double* c, + double* rt1, double* rt2); +/* DLAEBZ - contain the iteration loops which compute and use the */ +/* function N(w);, which is the count of eigenvalues of a */ +/* symmetric tridiagonal matrix T less than or equal to its */ +/* argument w */ +La_extern void +F77_NAME(dlaebz)(const int* ijob, const int* nitmax, const int* n, + const int* mmax, const int* minp, const int* nbmin, + const double* abstol, const double* reltol, + const double* pivmin, double* d, double* e, + double* e2, int* nval, double* ab, double* c, + int* mout, int* nab, double* work, int* iwork, + int* info); +/* DLAED0 - compute all eigenvalues and corresponding */ +/* eigenvectors of a symmetric tridiagonal matrix using the divide */ +/* and conquer method */ +La_extern void +F77_NAME(dlaed0)(const int* icompq, const int* qsiz, const int* n, + double* d, double* e, double* q, const int* ldq, + double* qstore, const int* ldqs, + double* work, int* iwork, int* info); +/* DLAED1 - compute the updated eigensystem of a diagonal matrix */ +/* after modification by a rank-one symmetric matrix */ +La_extern void +F77_NAME(dlaed1)(const int* n, double* d, double* q, const int* ldq, + int* indxq, const double* rho, const int* cutpnt, + double* work, int* iwork, int* info); +/* DLAED2 - merge the two sets of eigenvalues together into a */ +/* single sorted set */ +La_extern void +F77_NAME(dlaed2)(const int* k, const int* n, double* d, + double* q, const int* ldq, int* indxq, + double* rho, double* z, + double* dlamda, double* w, double* q2, + int* indx, int* indxc, int* indxp, + int* coltyp, int* info); +/* DLAED3 - find the roots of the secular equation, as defined by */ +/* the values in double* d, W, and RHO, between KSTART and KSTOP */ +La_extern void +F77_NAME(dlaed3)(const int* k, const int* n, const int* n1, + double* d, double* q, const int* ldq, + const double* rho, double* dlamda, double* q2, + int* indx, int* ctot, double* w, + double* s, int* info); +/* DLAED4 - subroutine computes the I-th updated eigenvalue of a */ +/* symmetric rank-one modification to a diagonal matrix whose */ +/* elements are given in the array d, and that D(i); < D(j); for */ +/* i < j and that RHO > 0 */ +La_extern void +F77_NAME(dlaed4)(const int* n, const int* i, const double* d, + const double* z, const double* delta, + const double* rho, double* dlam, int* info); +/* DLAED5 - subroutine computes the I-th eigenvalue of a */ +/* symmetric rank-one modification of a 2-by-2 diagonal matrix */ +/* diag( D ); + RHO The diagonal elements in the array D are */ +/* assumed to satisfy D(i); < D(j); for i < j */ +La_extern void +F77_NAME(dlaed5)(const int* i, const double* d, const double* z, + double* delta, const double* rho, double* dlam); +/* DLAED6 - compute the positive or negative root (closest to the */ +/* origin); of z(1); z(2); z(3); f(x); = rho + --------- + */ +/* ---------- + --------- d(1);-x d(2);-x d(3);-x It is assumed */ +/* that if ORGATI = .true */ +La_extern void +F77_NAME(dlaed6)(const int* kniter, const int* orgati, + const double* rho, const double* d, + const double* z, const double* finit, + double* tau, int* info); +/* DLAED7 - compute the updated eigensystem of a diagonal matrix */ +/* after modification by a rank-one symmetric matrix */ +La_extern void +F77_NAME(dlaed7)(const int* icompq, const int* n, + const int* qsiz, const int* tlvls, + const int* curlvl, const int* curpbm, + double* d, double* q, const int* ldq, + int* indxq, const double* rho, const int* cutpnt, + double* qstore, double* qptr, const int* prmptr, + const int* perm, const int* givptr, + const int* givcol, const double* givnum, + double* work, int* iwork, int* info); +/* DLAED8 - merge the two sets of eigenvalues together into a */ +/* single sorted set */ +La_extern void +F77_NAME(dlaed8)(const int* icompq, const int* k, + const int* n, const int* qsiz, + double* d, double* q, const int* ldq, + const int* indxq, double* rho, + const int* cutpnt, const double* z, + double* dlamda, double* q2, const int* ldq2, + double* w, int* perm, int* givptr, + int* givcol, double* givnum, int* indxp, + int* indx, int* info); +/* DLAED9 - find the roots of the secular equation, as defined by */ +/* the values in double* d, Z, and RHO, between KSTART and KSTOP */ +La_extern void +F77_NAME(dlaed9)(const int* k, const int* kstart, const int* kstop, + const int* n, double* d, double* q, const int* ldq, + const double* rho, const double* dlamda, + const double* w, double* s, const int* lds, int* info); +/* DLAEDA - compute the Z vector corresponding to the merge step */ +/* in the CURLVLth step of the merge process with TLVLS steps for */ +/* the CURPBMth problem */ +La_extern void +F77_NAME(dlaeda)(const int* n, const int* tlvls, const int* curlvl, + const int* curpbm, const int* prmptr, const int* perm, + const int* givptr, const int* givcol, + const double* givnum, const double* q, + const int* qptr, double* z, double* ztemp, int* info); +/* DLAEIN - use inverse iteration to find a right or left */ +/* eigenvector corresponding to the eigenvalue (WR,WI); of a real */ +/* upper Hessenberg matrix H */ +La_extern void +F77_NAME(dlaein)(const int* rightv, const int* noinit, const int* n, + const double* h, const int* ldh, + const double* wr, const double* wi, + double* vr, double* vi, + double* b, const int* ldb, double* work, + const double* eps3, const double* smlnum, + const double* bignum, int* info); +/* DLAEV2 - compute the eigendecomposition of a 2-by-2 symmetric */ +/* matrix [ A B ] [ B C ] */ +La_extern void +F77_NAME(dlaev2)(const double* a, const double* b, const double* c, + double* rt1, double* rt2, double* cs1, double *sn1); +/* DLAEXC - swap adjacent diagonal blocks T11 and T22 of order 1 */ +/* or 2 in an upper quasi-triangular matrix T by an orthogonal */ +/* similarity transformation */ +La_extern void +F77_NAME(dlaexc)(const int* wantq, const int* n, double* t, const int* ldt, + double* q, const int* ldq, const int* j1, + const int* n1, const int* n2, double* work, int* info); +/* DLAG2 - compute the eigenvalues of a 2 x 2 generalized */ +/* eigenvalue problem A - w B, with scaling as necessary to aextern void */ +/* over-/underflow */ +La_extern void +F77_NAME(dlag2)(const double* a, const int* lda, const double* b, + const int* ldb, const double* safmin, + double* scale1, double* scale2, + double* wr1, double* wr2, double* wi); +/* DLAGS2 - compute 2-by-2 orthogonal matrices U, V and Q, such */ +/* that if ( UPPER ); then U'*A*Q = U'*( A1 A2 );*Q = ( x 0 ); */ +/* ( 0 A3 ); ( x x ); and V'*B*Q = V'*( B1 B2 );*Q = ( x 0 ); ( */ +/* 0 B3 ); ( x x ); or if ( .NOT.UPPER ); then U'*A*Q = U'*( A1 */ +/* 0 );*Q = ( x x ); ( A2 A3 ); ( 0 x ); and V'*B*Q = V'*( B1 0 */ +/* );*Q = ( x x ); ( B2 B3 ); ( 0 x ); The rows of the */ +/* transformed A and B are parallel, where U = ( CSU SNU );, V = */ +/* ( CSV SNV );, Q = ( CSQ SNQ ); ( -SNU CSU ); ( -SNV CSV ); ( */ +/* -SNQ CSQ ); Z' denotes the transpose of Z */ +La_extern void +F77_NAME(dlags2)(const int* upper, + const double* a1, const double* a2, const double* a3, + const double* b1, const double* b2, const double* b3, + double* csu, double* snu, + double* csv, double* snv, double *csq, double *snq); +/* DLAGTF - factorize the matrix (T - lambda*I);, where T is an n */ +/* by n tridiagonal matrix and lambda is a scalar, as T - */ +/* lambda*I = PLU, */ +La_extern void +F77_NAME(dlagtf)(const int* n, double* a, const double* lambda, + double* b, double* c, const double *tol, + double* d, int* in, int* info); +/* DLAGTM - perform a matrix-vector product of the form B := */ +/* alpha * A * X + beta * B where A is a tridiagonal matrix of */ +/* order N, B and X are N by NRHS matrices, and alpha and beta are */ +/* real scalars, each of which may be 0., 1., or -1 */ +La_extern void +F77_NAME(dlagtm)(const char* trans, const int* n, const int* nrhs, + const double* alpha, const double* dl, + const double* d, const double* du, + const double* x, const int* ldx, const double* beta, + double* b, const int* ldb); +/* DLAGTS - may be used to solve one of the systems of equations */ +/* (T - lambda*I);*x = y or (T - lambda*I);'*x = y, */ +La_extern void +F77_NAME(dlagts)(const int* job, const int* n, + const double* a, const double* b, + const double* c, const double* d, + const int* in, double* y, double* tol, int* info); +/* DLAHQR - an auxiliary routine called by DHSEQR to update the */ +/* eigenvalues and Schur decomposition already computed by DHSEQR, */ +/* by dealing with the Hessenberg submatrix in rows and columns */ +/* ILO to IHI */ +La_extern void +F77_NAME(dlahqr)(const int* wantt, const int* wantz, const int* n, + const int* ilo, const int* ihi, + double* H, const int* ldh, double* wr, double* wi, + const int* iloz, const int* ihiz, + double* z, const int* ldz, int* info); +/* DLAIC1 - apply one step of incremental condition estimation in */ +/* its simplest version */ +La_extern void +F77_NAME(dlaic1)(const int* job, const int* j, const double* x, + const double* sest, const double* w, + const double* gamma, double* sestpr, + double* s, double* c); +/* DLALN2 - solve a system of the form (ca A - w D ); X = s B or */ +/* (ca A' - w D); X = s B with possible scaling ("s"); and */ +/* perturbation of A */ +La_extern void +F77_NAME(dlaln2)(const int* ltrans, const int* na, const int* nw, + const double* smin, const double* ca, + const double* a, const int* lda, + const double* d1, const double* d2, + const double* b, const int* ldb, + const double* wr, const double* wi, + double* x, const int* ldx, double* scale, + double* xnorm, int* info); +/* DLAMCH - determine double precision machine parameters */ +La_extern double +F77_NAME(dlamch)(const char* cmach); +/* DLAMRG - will create a permutation list which will merge the */ +/* elements of A (which is composed of two independently sorted */ +/* sets); into a single set which is sorted in ascending order */ +La_extern void +F77_NAME(dlamrg)(const int* n1, const int* n2, const double* a, + const int* dtrd1, const int* dtrd2, int* index); +/* DLANGB - return the value of the one norm, or the Frobenius */ +/* norm, or the infinity norm, or the element of largest absolute */ +/* value of an n by n band matrix A, with kl sub-diagonals and ku */ +/* super-diagonals */ +La_extern double +F77_NAME(dlangb)(const char* norm, const int* n, + const int* kl, const int* ku, const double* ab, + const int* ldab, double* work); +/* DLANGE - return the value of the one norm, or the Frobenius */ +/* norm, or the infinity norm, or the element of largest absolute */ +/* value of a real matrix A */ +La_extern double +F77_NAME(dlange)(const char* norm, const int* m, const int* n, + const double* a, const int* lda, double* work); +/* DLANGT - return the value of the one norm, or the Frobenius */ +/* norm, or the infinity norm, or the element of largest absolute */ +/* value of a real tridiagonal matrix A */ +La_extern double +F77_NAME(dlangt)(const char* norm, const int* n, + const double* dl, const double* d, + const double* du); +/* DLANHS - return the value of the one norm, or the Frobenius */ +/* norm, or the infinity norm, or the element of largest absolute */ +/* value of a Hessenberg matrix A */ +La_extern double +F77_NAME(dlanhs)(const char* norm, const int* n, + const double* a, const int* lda, double* work); +/* DLANSB - return the value of the one norm, or the Frobenius */ +/* norm, or the infinity norm, or the element of largest absolute */ +/* value of an n by n symmetric band matrix A, with k */ +/* super-diagonals */ +La_extern double +F77_NAME(dlansb)(const char* norm, const char* uplo, + const int* n, const int* k, + const double* ab, const int* ldab, double* work); +/* DLANSP - return the value of the one norm, or the Frobenius */ +/* norm, or the infinity norm, or the element of largest absolute */ +/* value of a real symmetric matrix A, supplied in packed form */ +La_extern double +F77_NAME(dlansp)(const char* norm, const char* uplo, + const int* n, const double* ap, double* work); +/* DLANST - return the value of the one norm, or the Frobenius */ +/* norm, or the infinity norm, or the element of largest absolute */ +/* value of a real symmetric tridiagonal matrix A */ +La_extern double +F77_NAME(dlanst)(const char* norm, const int* n, + const double* d, const double* e); +/* DLANSY - return the value of the one norm, or the Frobenius */ +/* norm, or the infinity norm, or the element of largest absolute */ +/* value of a real symmetric matrix A */ +La_extern double +F77_NAME(dlansy)(const char* norm, const char* uplo, const int* n, + const double* a, const int* lda, double* work); +/* DLANTB - return the value of the one norm, or the Frobenius */ +/* norm, or the infinity norm, or the element of largest absolute */ +/* value of an n by n triangular band matrix A, with ( k + 1 ) diagonals */ +La_extern double +F77_NAME(dlantb)(const char* norm, const char* uplo, + const char* diag, const int* n, const int* k, + const double* ab, const int* ldab, double* work); +/* DLANTP - return the value of the one norm, or the Frobenius */ +/* norm, or the infinity norm, or the element of largest absolute */ +/* value of a triangular matrix A, supplied in packed form */ +La_extern double +F77_NAME(dlantp)(const char* norm, const char* uplo, const char* diag, + const int* n, const double* ap, double* work); +/* DLANTR - return the value of the one norm, or the Frobenius */ +/* norm, or the infinity norm, or the element of largest absolute */ +/* value of a trapezoidal or triangular matrix A */ +La_extern double +F77_NAME(dlantr)(const char* norm, const char* uplo, + const char* diag, const int* m, const int* n, + const double* a, const int* lda, double* work); +/* DLANV2 - compute the Schur factorization of a real 2-by-2 */ +/* nonsymmetric matrix in standard form */ +La_extern void +F77_NAME(dlanv2)(double* a, double* b, double* c, double* d, + double* rt1r, double* rt1i, double* rt2r, double* rt2i, + double* cs, double *sn); +/* DLAPLL - two column vectors X and Y, let A = ( X Y ); */ +La_extern void +F77_NAME(dlapll)(const int* n, double* x, const int* incx, + double* y, const int* incy, double* ssmin); +/* DLAPMT - rearrange the columns of the M by N matrix X as */ +/* specified by the permutation K(1);,K(2);,...,K(N); of the */ +/* integers 1,...,N */ +La_extern void +F77_NAME(dlapmt)(const int* forwrd, const int* m, const int* n, + double* x, const int* ldx, const int* k); +/* DLAPY2 - return sqrt(x**2+y**2);, taking care not to cause */ +/* unnecessary overflow */ +La_extern double +F77_NAME(dlapy2)(const double* x, const double* y); +/* DLAPY3 - return sqrt(x**2+y**2+z**2);, taking care not to */ +/* cause unnecessary overflow */ +La_extern double +F77_NAME(dlapy3)(const double* x, const double* y, const double* z); +/* DLAQGB - equilibrate a general M by N band matrix A with KL */ +/* subdiagonals and KU superdiagonals using the row and scaling */ +/* factors in the vectors R and C */ +La_extern void +F77_NAME(dlaqgb)(const int* m, const int* n, + const int* kl, const int* ku, + double* ab, const int* ldab, + double* r, double* c, + double* rowcnd, double* colcnd, + const double* amax, char* equed); +/* DLAQGE - equilibrate a general M by N matrix A using the row */ +/* and scaling factors in the vectors R and C */ +La_extern void +F77_NAME(dlaqge)(const int* m, const int* n, + double* a, const int* lda, + double* r, double* c, + double* rowcnd, double* colcnd, + const double* amax, char* equed); +/* DLAQSB - equilibrate a symmetric band matrix A using the */ +/* scaling factors in the vector S */ +La_extern void +F77_NAME(dlaqsb)(const char* uplo, const int* n, const int* kd, + double* ab, const int* ldab, const double* s, + const double* scond, const double* amax, char* equed); +/* DLAQSP - equilibrate a symmetric matrix A using the scaling */ +/* factors in the vector S */ +La_extern void +F77_NAME(dlaqsp)(const char* uplo, const int* n, + double* ap, const double* s, const double* scond, + const double* amax, int* equed); +/* DLAQSY - equilibrate a symmetric matrix A using the scaling */ +/* factors in the vector S */ +La_extern void +F77_NAME(dlaqsy)(const char* uplo, const int* n, + double* a, const int* lda, + const double* s, const double* scond, + const double* amax, int* equed); +/* DLAQTR - solve the real quasi-triangular system */ +/* op(T) * p = scale*c */ +La_extern void +F77_NAME(dlaqtr)(const int* ltran, const int* lreal, const int* n, + const double* t, const int* ldt, + const double* b, const double* w, + double* scale, double* x, double* work, int* info); +/* DLAR2V - apply a vector of real plane rotations from both */ +/* sides to a sequence of 2-by-2 real symmetric matrices, defined */ +/* by the elements of the vectors x, y and z */ +La_extern void +F77_NAME(dlar2v)(const int* n, double* x, double* y, + double* z, const int* incx, + const double* c, const double* s, + const int* incc); +/* DLARF - apply a real elementary reflector H to a real m by n */ +/* matrix C, from either the left or the right */ +La_extern void +F77_NAME(dlarf)(const char* side, const int* m, const int* n, + const double* v, const int* incv, const double* tau, + double* c, const int* ldc, double* work); +/* DLARFB - apply a real block reflector H or its transpose H' */ +/* to a real m by n matrix C, from either the left or the right */ +La_extern void +F77_NAME(dlarfb)(const char* side, const char* trans, + const char* direct, const char* storev, + const int* m, const int* n, const int* k, + const double* v, const int* ldv, + const double* t, const int* ldt, + double* c, const int* ldc, + double* work, const int* lwork); +/* DLARFG - generate a real elementary reflector H of order n, */ +/* such that H * ( alpha ) = ( beta ), H' * H = I */ +La_extern void +F77_NAME(dlarfg)(const int* n, const double* alpha, + double* x, const int* incx, double* tau); +/* DLARFT - form the triangular factor T of a real block */ +/* reflector H of order n, which is defined as a product of k */ +/* elementary reflectors */ +La_extern void +F77_NAME(dlarft)(const char* direct, const char* storev, + const int* n, const int* k, double* v, const int* ldv, + const double* tau, double* t, const int* ldt); +/* DLARFX - apply a real elementary reflector H to a real m by n */ +/* matrix C, from either the left or the right */ +La_extern void +F77_NAME(dlarfx)(const char* side, const int* m, const int* n, + const double* v, const double* tau, + double* c, const int* ldc, double* work); +/* DLARGV - generate a vector of real plane rotations, determined */ +/* by elements of the real vectors x and y */ +La_extern void +F77_NAME(dlargv)(const int* n, double* x, const int* incx, + double* y, const int* incy, double* c, const int* incc); +/* DLARNV - return a vector of n random real numbers from a */ +/* uniform or normal distribution */ +La_extern void +F77_NAME(dlarnv)(const int* idist, int* iseed, const int* n, double* x); +/* DLARTG - generate a plane rotation so that [ CS SN ] */ +La_extern void +F77_NAME(dlartg)(const double* f, const double* g, double* cs, + double* sn, double *r); +/* DLARTV - apply a vector of real plane rotations to elements of */ +/* the real vectors x and y */ +La_extern void +F77_NAME(dlartv)(const int* n, double* x, const int* incx, + double* y, const int* incy, + const double* c, const double* s, + const int* incc); +/* DLARUV - return a vector of n random real numbers from a */ +/* uniform (0,1); */ +La_extern void +F77_NAME(dlaruv)(int* iseed, const int* n, double* x); + +/* DLAS2 - compute the singular values of the 2-by-2 matrix */ +/* [ F G ] [ 0 H ] */ +La_extern void +F77_NAME(dlas2)(const double* f, const double* g, const double* h, + double* ssmin, double* ssmax); + +/* DLASCL - multiply the M by N real matrix A by the real scalar */ +/* CTO/CFROM */ +La_extern void +F77_NAME(dlascl)(const char* type, + const int* kl,const int* ku, + double* cfrom, double* cto, + const int* m, const int* n, + double* a, const int* lda, int* info); + +/* DLASET - initialize an m-by-n matrix A to BETA on the diagonal */ +/* and ALPHA on the offdiagonals */ +La_extern void +F77_NAME(dlaset)(const char* uplo, const int* m, const int* n, + const double* alpha, const double* beta, + double* a, const int* lda); +/* DLASQ1 - DLASQ1 computes the singular values of a real N-by-N */ +/* bidiagonal matrix with diagonal D and off-diagonal E */ +La_extern void +F77_NAME(dlasq1)(const int* n, double* d, double* e, + double* work, int* info); +/* DLASQ2 - DLASQ2 computes the singular values of a real N-by-N */ +/* unreduced bidiagonal matrix with squared diagonal elements in */ +/* Q and squared off-diagonal elements in E */ +La_extern void +F77_NAME(dlasq2)(const int* m, double* q, double* e, + double* qq, double* ee, const double* eps, + const double* tol2, const double* small2, + double* sup, int* kend, int* info); +/* DLASQ3 - DLASQ3 is the workhorse of the whole bidiagonal SVD */ +/* algorithm */ +La_extern void +F77_NAME(dlasq3)(int* n, double* q, double* e, double* qq, + double* ee, double* sup, double *sigma, + int* kend, int* off, int* iphase, + const int* iconv, const double* eps, + const double* tol2, const double* small2); +/* DLASQ4 - DLASQ4 estimates TAU, the smallest eigenvalue of a */ +/* matrix */ +La_extern void +F77_NAME(dlasq4)(const int* n, const double* q, const double* e, + double* tau, double* sup); +/* DLASR - perform the transformation A := P*A, when SIDE = 'L' */ +/* or 'l' ( Left-hand side ); A := A*P', when SIDE = 'R' or 'r' */ +/* ( Right-hand side ); where A is an m by n real matrix and P is */ +/* an orthogonal matrix, */ +La_extern void +F77_NAME(dlasr)(const char* side, const char* pivot, + const char* direct, const int* m, const int* n, + const double* c, const double* s, + double* a, const int* lda); +/* DLASRT - the numbers in D in increasing order (if ID = 'I'); */ +/* or in decreasing order (if ID = 'D' ); */ +La_extern void +F77_NAME(dlasrt)(const char* id, const int* n, double* d, int* info); +/* DLASSQ - return the values scl and smsq such that ( scl**2 */ +/* );*smsq = x( 1 );**2 +...+ x( n );**2 + ( scale**2 );*sumsq, */ +La_extern void +F77_NAME(dlassq)(const int* n, const double* x, const int* incx, + double* scale, double* sumsq); +/* DLASV2 - compute the singular value decomposition of a 2-by-2 */ +/* triangular matrix [ F G ] [ 0 H ] */ +La_extern void +F77_NAME(dlasv2)(const double* f, const double* g, const double* h, + double* ssmin, double* ssmax, double* snr, double* csr, + double* snl, double* csl); +/* DLASWP - perform a series of row interchanges on the matrix A */ +La_extern void +F77_NAME(dlaswp)(const int* n, double* a, const int* lda, + const int* k1, const int* k2, + const int* ipiv, const int* incx); +/* DLASY2 - solve for the N1 by N2 matrix double* x, 1 <= N1,N2 <= 2, in */ +/* op(TL);*X + ISGN*X*op(TR); = SCALE*B, */ +La_extern void +F77_NAME(dlasy2)(const int* ltranl, const int* ltranr, + const int* isgn, const int* n1, const int* n2, + const double* tl, const int* ldtl, + const double* tr, const int* ldtr, + const double* b, const int* ldb, + double* scale, double* x, const int* ldx, + double* xnorm, int* info); +/* DLASYF - compute a partial factorization of a real symmetric */ +/* matrix A using the Bunch-Kaufman diagonal pivoting method */ +La_extern void +F77_NAME(dlasyf)(const char* uplo, const int* n, + const int* nb, const int* kb, + double* a, const int* lda, int* ipiv, + double* w, const int* ldw, int* info); +/* DLATBS - solve one of the triangular systems A *x = s*b or */ +/* A'*x = s*b with scaling to prevent overflow, where A is an */ +/* upper or lower triangular band matrix */ +La_extern void +F77_NAME(dlatbs)(const char* uplo, const char* trans, + const char* diag, const char* normin, + const int* n, const int* kd, + const double* ab, const int* ldab, + double* x, double* scale, double* cnorm, int* info); +/* DLATPS - solve one of the triangular systems A *x = s*b or */ +/* A'*x = s*b with scaling to prevent overflow, where A is an */ +/* upper or lower triangular matrix stored in packed form */ +La_extern void +F77_NAME(dlatps)(const char* uplo, const char* trans, + const char* diag, const char* normin, + const int* n, const double* ap, + double* x, double* scale, double* cnorm, int* info); +/* DLATRD - reduce NB rows and columns of a real symmetric matrix */ +/* A to symmetric tridiagonal form by an orthogonal similarity */ +/* transformation Q' * A * Q, and returns the matrices V and W */ +/* which are needed to apply the transformation to the unreduced */ +/* part of A */ +La_extern void +F77_NAME(dlatrd)(const char* uplo, const int* n, const int* nb, + double* a, const int* lda, double* e, double* tau, + double* w, const int* ldw); +/* DLATRS - solve one of the triangular systems A *x = s*b or */ +/* A'*x = s*b with scaling to prevent overflow */ +La_extern void +F77_NAME(dlatrs)(const char* uplo, const char* trans, + const char* diag, const char* normin, + const int* n, const double* a, const int* lda, + double* x, double* scale, double* cnorm, int* info); +/* DLAUU2 - compute the product U * U' or L' * const int* l, where the */ +/* triangular factor U or L is stored in the upper or lower */ +/* triangular part of the array A */ +La_extern void +F77_NAME(dlauu2)(const char* uplo, const int* n, + double* a, const int* lda, int* info); +/* DLAUUM - compute the product U * U' or L' * L, where the */ +/* triangular factor U or L is stored in the upper or lower */ +/* triangular part of the array A */ +La_extern void +F77_NAME(dlauum)(const char* uplo, const int* n, + double* a, const int* lda, int* info); + +/* ======================================================================== */ + + +//* Selected Double Complex Lapack Routines +/* ======== + */ + +/* IZMAX1 finds the index of the element whose real part has maximum + * absolute value. */ +La_extern int +F77_NAME(izmax1)(const int *n, Rcomplex *cx, const int *incx); + + +/* ZGECON estimates the reciprocal of the condition number of a general + * complex matrix A, in either the 1-norm or the infinity-norm, using + * the LU factorization computed by ZGETRF. + */ +La_extern void +F77_NAME(zgecon)(const char *norm, const int *n, + const Rcomplex *a, const int *lda, + const double *anorm, double *rcond, + Rcomplex *work, double *rwork, int *info); + +/* ZGESV computes the solution to a complex system of linear equations */ +La_extern void +F77_NAME(zgesv)(const int *n, const int *nrhs, Rcomplex *a, + const int *lda, int *ipiv, Rcomplex *b, + const int *ldb, int *info); + +/* ZGEQP3 computes a QR factorization with column pivoting */ +La_extern void +F77_NAME(zgeqp3)(const int *m, const int *n, + Rcomplex *a, const int *lda, + int *jpvt, Rcomplex *tau, + Rcomplex *work, const int *lwork, + double *rwork, int *info); + +/* ZUNMQR applies Q or Q**H from the Left or Right */ +La_extern void +F77_NAME(zunmqr)(const char *side, const char *trans, + const int *m, const int *n, const int *k, + Rcomplex *a, const int *lda, + Rcomplex *tau, + Rcomplex *c, const int *ldc, + Rcomplex *work, const int *lwork, int *info); + +/* ZTRTRS solves triangular systems */ +La_extern void +F77_NAME(ztrtrs)(const char *uplo, const char *trans, const char *diag, + const int *n, const int *nrhs, + Rcomplex *a, const int *lda, + Rcomplex *b, const int *ldb, int *info); +/* ZGESVD - compute the singular value decomposition (SVD); of a */ +/* real M-by-N matrix A, optionally computing the left and/or */ +/* right singular vectors */ +La_extern void +F77_NAME(zgesvd)(const char *jobu, const char *jobvt, + const int *m, const int *n, + Rcomplex *a, const int *lda, double *s, + Rcomplex *u, const int *ldu, + Rcomplex *vt, const int *ldvt, + Rcomplex *work, const int *lwork, double *rwork, + int *info); + +/* ZGHEEV - compute all eigenvalues and, optionally, eigenvectors */ +/* of a Hermitian matrix A */ +La_extern void +F77_NAME(zheev)(const char *jobz, const char *uplo, + const int *n, Rcomplex *a, const int *lda, + double *w, Rcomplex *work, const int *lwork, + double *rwork, int *info); + +/* ZGGEEV - compute all eigenvalues and, optionally, eigenvectors */ +/* of a complex non-symmetric matrix A */ +La_extern void +F77_NAME(zgeev)(const char *jobvl, const char *jobvr, + const int *n, Rcomplex *a, const int *lda, + Rcomplex *wr, Rcomplex *vl, const int *ldvl, + Rcomplex *vr, const int *ldvr, + Rcomplex *work, const int *lwork, + double *rwork, int *info); + + +/* NOTE: The following entry points were traditionally in this file, + but are not provided by R's libRlapack */ + +/* DZSUM1 - take the sum of the absolute values of a complex */ +/* vector and returns a double precision result */ +La_extern double +F77_NAME(dzsum1)(const int *n, Rcomplex *CX, const int *incx); + +/* ZLACN2 estimates the 1-norm of a square, complex matrix A. + * Reverse communication is used for evaluating matrix-vector products. +*/ +La_extern void +F77_NAME(zlacn2)(const int *n, Rcomplex *v, Rcomplex *x, + double *est, int *kase, int *isave); + +/* ZLANTR - return the value of the one norm, or the Frobenius norm, */ +/* or the infinity norm, or the element of largest absolute value of */ +/* a trapezoidal or triangular matrix A */ +La_extern double +F77_NAME(zlantr)(const char *norm, const char *uplo, const char *diag, + const int *m, const int *n, Rcomplex *a, + const int *lda, double *work); + +/* ======================================================================== */ + +//* Other double precision and double complex Lapack routines provided by libRlapack. +/* + These are extracted from the CLAPACK headers. +*/ + +La_extern void +F77_NAME(dbdsdc)(const char *uplo, const char *compq, int *n, + double * d, double *e, double *u, int *ldu, double *vt, + int *ldvt, double *q, int *iq, double *work, int * iwork, int *info); + +La_extern void +F77_NAME(dgelsd)(int *m, int *n, int *nrhs, + double *a, int *lda, double *b, int *ldb, double * + s, double *rcond, int *rank, double *work, int *lwork, + int *iwork, int *info); + +La_extern void +F77_NAME(dgesc2)(int *n, double *a, int *lda, + double *rhs, int *ipiv, int *jpiv, double *scale); + +/* DGESDD - compute the singular value decomposition (SVD); of a */ +/* real M-by-N matrix A, optionally computing the left and/or */ +/* right singular vectors. If singular vectors are desired, it uses a */ +/* divide-and-conquer algorithm. */ +La_extern void +F77_NAME(dgesdd)(const char *jobz, + const int *m, const int *n, + double *a, const int *lda, double *s, + double *u, const int *ldu, + double *vt, const int *ldvt, + double *work, const int *lwork, int *iwork, int *info); + +La_extern void +F77_NAME(dgetc2)(int *n, double *a, int *lda, int + *ipiv, int *jpiv, int *info); + +typedef int (*L_fp)(); +La_extern void +F77_NAME(dggesx)(char *jobvsl, char *jobvsr, char *sort, L_fp + delctg, char *sense, int *n, double *a, int *lda, + double *b, int *ldb, int *sdim, double *alphar, + double *alphai, double *beta, double *vsl, int *ldvsl, + double *vsr, int *ldvsr, double *rconde, double * + rcondv, double *work, int *lwork, int *iwork, int * + liwork, int *bwork, int *info); + +La_extern void +F77_NAME(dggev)(char *jobvl, char *jobvr, int *n, double * + a, int *lda, double *b, int *ldb, double *alphar, + double *alphai, double *beta, double *vl, int *ldvl, + double *vr, int *ldvr, double *work, int *lwork, + int *info); + +La_extern void +F77_NAME(dggevx)(char *balanc, char *jobvl, char *jobvr, char * + sense, int *n, double *a, int *lda, double *b, + int *ldb, double *alphar, double *alphai, double * + beta, double *vl, int *ldvl, double *vr, int *ldvr, + int *ilo, int *ihi, double *lscale, double *rscale, + double *abnrm, double *bbnrm, double *rconde, double * + rcondv, double *work, int *lwork, int *iwork, int * + bwork, int *info); + +La_extern void +F77_NAME(dgtts2)(int *itrans, int *n, int *nrhs, + double *dl, double *d, double *du, double *du2, + int *ipiv, double *b, int *ldb); +La_extern void +F77_NAME(dlagv2)(double *a, int *lda, double *b, int *ldb, double *alphar, + double *alphai, double * beta, double *csl, double *snl, + double *csr, double * snr); + +La_extern void +F77_NAME(dlals0)(int *icompq, int *nl, int *nr, + int *sqre, int *nrhs, double *b, int *ldb, double + *bx, int *ldbx, int *perm, int *givptr, int *givcol, + int *ldgcol, double *givnum, int *ldgnum, double * + poles, double *difl, double *difr, double *z, int * + k, double *c, double *s, double *work, int *info); + +La_extern void +F77_NAME(dlalsa)(int *icompq, int *smlsiz, int *n, + int *nrhs, double *b, int *ldb, double *bx, int * + ldbx, double *u, int *ldu, double *vt, int *k, + double *difl, double *difr, double *z, double * + poles, int *givptr, int *givcol, int *ldgcol, int * + perm, double *givnum, double *c, double *s, double * + work, int *iwork, int *info); + +La_extern void +F77_NAME(dlalsd)(char *uplo, int *smlsiz, int *n, int + *nrhs, double *d, double *e, double *b, int *ldb, + double *rcond, int *rank, double *work, int *iwork, + int *info); + +La_extern void +F77_NAME(dlamc1)(int *beta, int *t, int *rnd, int + *ieee1); + +La_extern void +F77_NAME(dlamc2)(int *beta, int *t, int *rnd, + double *eps, int *emin, double *rmin, int *emax, + double *rmax); + +La_extern double +F77_NAME(dlamc3)(double *a, double *b); + +La_extern void +F77_NAME(dlamc4)(int *emin, double *start, int *base); + +La_extern void +F77_NAME(dlamc5)(int *beta, int *p, int *emin, + int *ieee, int *emax, double *rmax); + +La_extern void +F77_NAME(dlaqp2)(int *m, int *n, int *offset, + double *a, int *lda, int *jpvt, double *tau, + double *vn1, double *vn2, double *work); + +La_extern void +F77_NAME(dlaqps)(int *m, int *n, int *offset, int + *nb, int *kb, double *a, int *lda, int *jpvt, + double *tau, double *vn1, double *vn2, double *auxv, + double *f, int *ldf); + +La_extern void +F77_NAME(dlar1v)(int *n, int *b1, int *bn, double + *sigma, double *d, double *l, double *ld, double * + lld, double *gersch, double *z, double *ztz, double + *mingma, int *r, int *isuppz, double *work); + +La_extern void +F77_NAME(dlarrb)(int *n, double *d, double *l, + double *ld, double *lld, int *ifirst, int *ilast, + double *sigma, double *reltol, double *w, double * + wgap, double *werr, double *work, int *iwork, int * + info); + +La_extern void +F77_NAME(dlarre)(int *n, double *d, double *e, + double *tol, int *nsplit, int *isplit, int *m, + double *w, double *woff, double *gersch, double *work, + int *info); + +La_extern void +F77_NAME(dlarrf)(int *n, double *d, double *l, + double *ld, double *lld, int *ifirst, int *ilast, + double *w, double *dplus, double *lplus, double *work, + int *iwork, int *info); + +La_extern void +F77_NAME(dlarrv)(int *n, double *d, double *l, + int *isplit, int *m, double *w, int *iblock, + double *gersch, double *tol, double *z, int *ldz, + int *isuppz, double *work, int *iwork, int *info); + +La_extern void +F77_NAME(dlarz)(char *side, int *m, int *n, int *l, + double *v, int *incv, double *tau, double *c, + int *ldc, double *work); + +La_extern void +F77_NAME(dlarzb)(char *side, char *trans, char *direct, char * + storev, int *m, int *n, int *k, int *l, double *v, + int *ldv, double *t, int *ldt, double *c, int * + ldc, double *work, int *ldwork); + +La_extern void +F77_NAME(dlarzt)(char *direct, char *storev, int *n, int * + k, double *v, int *ldv, double *tau, double *t, + int *ldt); + +La_extern void +F77_NAME(dlasd0)(int *n, int *sqre, double *d, + double *e, double *u, int *ldu, double *vt, int * + ldvt, int *smlsiz, int *iwork, double *work, int * + info); + +La_extern void +F77_NAME(dlasd1)(int *nl, int *nr, int *sqre, + double *d, double *alpha, double *beta, double *u, + int *ldu, double *vt, int *ldvt, int *idxq, int * + iwork, double *work, int *info); + +La_extern void +F77_NAME(dlasd2)(int *nl, int *nr, int *sqre, int + *k, double *d, double *z, double *alpha, double * + beta, double *u, int *ldu, double *vt, int *ldvt, + double *dsigma, double *u2, int *ldu2, double *vt2, + int *ldvt2, int *idxp, int *idx, int *idxc, int * + idxq, int *coltyp, int *info); + +La_extern void +F77_NAME(dlasd3)(int *nl, int *nr, int *sqre, int + *k, double *d, double *q, int *ldq, double *dsigma, + double *u, int *ldu, double *u2, int *ldu2, + double *vt, int *ldvt, double *vt2, int *ldvt2, + int *idxc, int *ctot, double *z, int *info); + +La_extern void +F77_NAME(dlasd4)(int *n, int *i, double *d, + double *z, double *delta, double *rho, double * + sigma, double *work, int *info); + +La_extern void +F77_NAME(dlasd5)(int *i, double *d, double *z, + double *delta, double *rho, double *dsigma, double * + work); + +La_extern void +F77_NAME(dlasd6)(int *icompq, int *nl, int *nr, + int *sqre, double *d, double *vf, double *vl, + double *alpha, double *beta, int *idxq, int *perm, + int *givptr, int *givcol, int *ldgcol, double *givnum, + int *ldgnum, double *poles, double *difl, double * + difr, double *z, int *k, double *c, double *s, + double *work, int *iwork, int *info); + +La_extern void +F77_NAME(dlasd7)(int *icompq, int *nl, int *nr, + int *sqre, int *k, double *d, double *z, + double *zw, double *vf, double *vfw, double *vl, + double *vlw, double *alpha, double *beta, double * + dsigma, int *idx, int *idxp, int *idxq, int *perm, + int *givptr, int *givcol, int *ldgcol, double *givnum, + int *ldgnum, double *c, double *s, int *info); + +La_extern void +F77_NAME(dlasd8)(int *icompq, int *k, double *d, + double *z, double *vf, double *vl, double *difl, + double *difr, int *lddifr, double *dsigma, double * + work, int *info); + +La_extern void +F77_NAME(dlasd9)(int *icompq, int *ldu, int *k, + double *d, double *z, double *vf, double *vl, + double *difl, double *difr, double *dsigma, double * + work, int *info); + +La_extern void +F77_NAME(dlasda)(int *icompq, int *smlsiz, int *n, + int *sqre, double *d, double *e, double *u, int + *ldu, double *vt, int *k, double *difl, double *difr, + double *z, double *poles, int *givptr, int *givcol, + int *ldgcol, int *perm, double *givnum, double *c, + double *s, double *work, int *iwork, int *info); + +La_extern void +F77_NAME(dlasdq)(char *uplo, int *sqre, int *n, int * + ncvt, int *nru, int *ncc, double *d, double *e, + double *vt, int *ldvt, double *u, int *ldu, + double *c, int *ldc, double *work, int *info); + +La_extern void +F77_NAME(dlasdt)(int *n, int *lvl, int *nd, int * + inode, int *ndiml, int *ndimr, int *msub); + +La_extern void +F77_NAME(dlasq5)(int *i0, int *n0, double *z, + int *pp, double *tau, double *dmin, double *dmin1, + double *dmin2, double *dn, double *dnm1, double *dnm2, + int *ieee); + +La_extern void +F77_NAME(dlasq6)(int *i0, int *n0, double *z, + int *pp, double *dmin, double *dmin1, double *dmin2, + double *dn, double *dnm1, double *dnm2); + +La_extern void +F77_NAME(dlatdf)(int *ijob, int *n, double *z, + int *ldz, double *rhs, double *rdsum, double *rdscal, + int *ipiv, int *jpiv); + +La_extern void +F77_NAME(dlatrz)(int *m, int *n, int *l, double * + a, int *lda, double *tau, double *work); + +La_extern void +F77_NAME(dormr3)(char *side, char *trans, int *m, int *n, + int *k, int *l, double *a, int *lda, double *tau, + double *c, int *ldc, double *work, int *info); + +La_extern void +F77_NAME(dormrz)(char *side, char *trans, int *m, int *n, + int *k, int *l, double *a, int *lda, double *tau, + double *c, int *ldc, double *work, int *lwork, + int *info); + +La_extern void +F77_NAME(dptts2)(int *n, int *nrhs, double *d, + double *e, double *b, int *ldb); + +La_extern void +F77_NAME(dsbgvd)(char *jobz, char *uplo, int *n, int *ka, + int *kb, double *ab, int *ldab, double *bb, int * + ldbb, double *w, double *z, int *ldz, double *work, + int *lwork, int *iwork, int *liwork, int *info); + +La_extern void +F77_NAME(dsbgvx)(char *jobz, char *range, char *uplo, int *n, + int *ka, int *kb, double *ab, int *ldab, double * + bb, int *ldbb, double *q, int *ldq, double *vl, + double *vu, int *il, int *iu, double *abstol, int + *m, double *w, double *z, int *ldz, double *work, + int *iwork, int *ifail, int *info); + +La_extern void +F77_NAME(dspgvd)(int *itype, char *jobz, char *uplo, int * + n, double *ap, double *bp, double *w, double *z, + int *ldz, double *work, int *lwork, int *iwork, + int *liwork, int *info); + +La_extern void +F77_NAME(dspgvx)(int *itype, char *jobz, char *range, char * + uplo, int *n, double *ap, double *bp, double *vl, + double *vu, int *il, int *iu, double *abstol, int + *m, double *w, double *z, int *ldz, double *work, + int *iwork, int *ifail, int *info); + +La_extern void +F77_NAME(dstegr)(char *jobz, char *range, int *n, double * + d, double *e, double *vl, double *vu, int *il, + int *iu, double *abstol, int *m, double *w, + double *z, int *ldz, int *isuppz, double *work, + int *lwork, int *iwork, int *liwork, int *info); + +La_extern void +F77_NAME(dstevr)(char *jobz, char *range, int *n, double * + d, double *e, double *vl, double *vu, int *il, + int *iu, double *abstol, int *m, double *w, + double *z, int *ldz, int *isuppz, double *work, + int *lwork, int *iwork, int *liwork, int *info); + +La_extern void +F77_NAME(dsygvd)(int *itype, char *jobz, char *uplo, int * + n, double *a, int *lda, double *b, int *ldb, + double *w, double *work, int *lwork, int *iwork, + int *liwork, int *info); + +La_extern void +F77_NAME(dsygvx)(int *itype, char *jobz, char *range, char * + uplo, int *n, double *a, int *lda, double *b, int + *ldb, double *vl, double *vu, int *il, int *iu, + double *abstol, int *m, double *w, double *z, + int *ldz, double *work, int *lwork, int *iwork, + int *ifail, int *info); + +La_extern void +F77_NAME(dtgex2)(int *wantq, int *wantz, int *n, + double *a, int *lda, double *b, int *ldb, double * + q, int *ldq, double *z, int *ldz, int *j1, int * + n1, int *n2, double *work, int *lwork, int *info); + +La_extern void +F77_NAME(dtgexc)(int *wantq, int *wantz, int *n, + double *a, int *lda, double *b, int *ldb, double * + q, int *ldq, double *z, int *ldz, int *ifst, + int *ilst, double *work, int *lwork, int *info); + +La_extern void +F77_NAME(dtgsen)(int *ijob, int *wantq, int *wantz, + int *select, int *n, double *a, int *lda, double * + b, int *ldb, double *alphar, double *alphai, double * + beta, double *q, int *ldq, double *z, int *ldz, + int *m, double *pl, double *pr, double *dif, + double *work, int *lwork, int *iwork, int *liwork, + int *info); + +La_extern void +F77_NAME(dtgsna)(char *job, char *howmny, int *select, + int *n, double *a, int *lda, double *b, int *ldb, + double *vl, int *ldvl, double *vr, int *ldvr, + double *s, double *dif, int *mm, int *m, double * + work, int *lwork, int *iwork, int *info); + +La_extern void +F77_NAME(dtgsy2)(char *trans, int *ijob, int *m, int * + n, double *a, int *lda, double *b, int *ldb, + double *c, int *ldc, double *d, int *ldd, + double *e, int *lde, double *f, int *ldf, double * + scale, double *rdsum, double *rdscal, int *iwork, int + *pq, int *info); + +La_extern void +F77_NAME(dtgsyl)(char *trans, int *ijob, int *m, int * + n, double *a, int *lda, double *b, int *ldb, + double *c, int *ldc, double *d, int *ldd, + double *e, int *lde, double *f, int *ldf, double * + scale, double *dif, double *work, int *lwork, int * + iwork, int *info); + +La_extern void +F77_NAME(dtzrzf)(int *m, int *n, double *a, int * + lda, double *tau, double *work, int *lwork, int *info); + +La_extern void +F77_NAME(dpstrf)(const char* uplo, const int* n, + double* a, const int* lda, int* piv, int* rank, + double* tol, double *work, int* info); + + +La_extern int +F77_NAME(lsame)(const char *ca, const char *cb); + +La_extern void +F77_NAME(zbdsqr)(const char *uplo, int *n, int *ncvt, int * + nru, int *ncc, double *d, double *e, Rcomplex *vt, + int *ldvt, Rcomplex *u, int *ldu, Rcomplex *c, + int *ldc, double *rwork, int *info); + +La_extern void +F77_NAME(zdrot)(const int *n, const Rcomplex *cx, const int *incx, + Rcomplex *cy, const int *incy, const double *c, const double *s); + +La_extern void +F77_NAME(zgebak)(const char *job, const char *side, int *n, int *ilo, + int *ihi, double *scale, int *m, Rcomplex *v, + int *ldv, int *info); + +La_extern void +F77_NAME(zgebal)(const char *job, int *n, Rcomplex *a, int + *lda, int *ilo, int *ihi, double *scale, int *info); + +La_extern void +F77_NAME(zgebd2)(int *m, int *n, Rcomplex *a, + int *lda, double *d, double *e, Rcomplex *tauq, + Rcomplex *taup, Rcomplex *work, int *info); + +La_extern void +F77_NAME(zgebrd)(int *m, int *n, Rcomplex *a, + int *lda, double *d, double *e, Rcomplex *tauq, + Rcomplex *taup, Rcomplex *work, int *lwork, int * + info); +La_extern void +F77_NAME(zgehd2)(int *n, int *ilo, int *ihi, + Rcomplex *a, int *lda, Rcomplex *tau, Rcomplex * + work, int *info); + +La_extern void +F77_NAME(zgehrd)(int *n, int *ilo, int *ihi, + Rcomplex *a, int *lda, Rcomplex *tau, Rcomplex * + work, int *lwork, int *info); + +La_extern void +F77_NAME(zgelq2)(int *m, int *n, Rcomplex *a, + int *lda, Rcomplex *tau, Rcomplex *work, int *info); + +La_extern void +F77_NAME(zgelqf)(int *m, int *n, Rcomplex *a, + int *lda, Rcomplex *tau, Rcomplex *work, int *lwork, + int *info); + +La_extern void +F77_NAME(zgeqr2)(int *m, int *n, Rcomplex *a, + int *lda, Rcomplex *tau, Rcomplex *work, int *info); + +La_extern void +F77_NAME(zgeqrf)(int *m, int *n, Rcomplex *a, + int *lda, Rcomplex *tau, Rcomplex *work, int *lwork, + int *info); + +La_extern void +F77_NAME(zgetf2)(int *m, int *n, Rcomplex *a, + int *lda, int *ipiv, int *info); + +La_extern void +F77_NAME(zgetrf)(int *m, int *n, Rcomplex *a, + int *lda, int *ipiv, int *info); + +La_extern void +F77_NAME(zgetrs)(const char *trans, int *n, int *nrhs, + Rcomplex *a, int *lda, int *ipiv, Rcomplex *b, + int *ldb, int *info); + + +La_extern void +F77_NAME(zhetd2)(const char *uplo, int *n, Rcomplex *a, int *lda, double *d, + double *e, Rcomplex *tau, int *info); + +La_extern void +F77_NAME(zhetrd)(const char *uplo, int *n, Rcomplex *a, + int *lda, double *d, double *e, Rcomplex *tau, + Rcomplex *work, int *lwork, int *info); + +La_extern void +F77_NAME(zhseqr)(const char *job, const char *compz, int *n, int *ilo, + int *ihi, Rcomplex *h, int *ldh, Rcomplex *w, + Rcomplex *z, int *ldz, Rcomplex *work, int *lwork, + int *info); + +La_extern void +F77_NAME(zlabrd)(int *m, int *n, int *nb, + Rcomplex *a, int *lda, double *d, double *e, + Rcomplex *tauq, Rcomplex *taup, Rcomplex *x, int * + ldx, Rcomplex *y, int *ldy); + +La_extern void +F77_NAME(zlacgv)(int *n, Rcomplex *x, int *incx); + +La_extern void +F77_NAME(zlacpy)(const char *uplo, int *m, int *n, + Rcomplex *a, int *lda, Rcomplex *b, int *ldb); + +La_extern void +F77_NAME(zlahqr)(int *wantt, int *wantz, int *n, + int *ilo, int *ihi, Rcomplex *h, int *ldh, + Rcomplex *w, int *iloz, int *ihiz, Rcomplex *z, + int *ldz, int *info); + +La_extern double +F77_NAME(zlange)(const char *norm, int *m, int *n, Rcomplex *a, int *lda, + double *work); + +La_extern double +F77_NAME(zlanhe)(const char *norm, const char *uplo, int *n, Rcomplex *a, + int *lda, double *work); + +La_extern double +F77_NAME(zlanhs)(const char *norm, int *n, Rcomplex *a, int *lda, double *work); + + +La_extern void +F77_NAME(zlaqp2)(int *m, int *n, int *offset, + Rcomplex *a, int *lda, int *jpvt, Rcomplex *tau, + double *vn1, double *vn2, Rcomplex *work); + +La_extern void +F77_NAME(zlaqps)(int *m, int *n, int *offset, int + *nb, int *kb, Rcomplex *a, int *lda, int *jpvt, + Rcomplex *tau, double *vn1, double *vn2, Rcomplex * + auxv, Rcomplex *f, int *ldf); + +La_extern void +F77_NAME(zlarf)(const char *side, int *m, int *n, Rcomplex + *v, int *incv, Rcomplex *tau, Rcomplex *c, int * + ldc, Rcomplex *work); + +La_extern void +F77_NAME(zlarfb)(const char *side, const char *trans, + const char *direct, const char * storev, + int *m, int *n, int *k, Rcomplex *v, int *ldv, + Rcomplex *t, int *ldt, Rcomplex *c, int * + ldc, Rcomplex *work, int *ldwork); + +La_extern void +F77_NAME(zlarfg)(int *n, Rcomplex *alpha, Rcomplex * + x, int *incx, Rcomplex *tau); + +La_extern void +F77_NAME(zlarft)(const char *direct, const char *storev, int *n, int * + k, Rcomplex *v, int *ldv, Rcomplex *tau, Rcomplex * + t, int *ldt); + +La_extern void +F77_NAME(zlarfx)(const char *side, int *m, int *n, + Rcomplex *v, Rcomplex *tau, Rcomplex *c, int * + ldc, Rcomplex *work); + +La_extern void +F77_NAME(zlascl)(const char *type, int *kl, int *ku, + double *cfrom, double *cto, int *m, int *n, + Rcomplex *a, int *lda, int *info); + +La_extern void +F77_NAME(zlaset)(const char *uplo, int *m, int *n, + Rcomplex *alpha, Rcomplex *beta, Rcomplex *a, int * + lda); + +La_extern void +F77_NAME(zlasr)(const char *side, const char *pivot, const char *direct, + int *m, int *n, double *c, double *s, Rcomplex *a, int *lda); + +La_extern void +F77_NAME(zlassq)(int *n, Rcomplex *x, int *incx, + double *scale, double *sumsq); + +La_extern void +F77_NAME(zlaswp)(int *n, Rcomplex *a, int *lda, + int *k1, int *k2, int *ipiv, int *incx); + +La_extern void +F77_NAME(zlatrd)(const char *uplo, int *n, int *nb, + Rcomplex *a, int *lda, double *e, Rcomplex *tau, + Rcomplex *w, int *ldw); + +La_extern void +F77_NAME(zlatrs)(const char *uplo, const char *trans, + const char *diag, const char * normin, + int *n, Rcomplex *a, int *lda, Rcomplex *x, + double *scale, double *cnorm, int *info); + +La_extern void +F77_NAME(zsteqr)(const char *compz, int *n, double *d, + double *e, Rcomplex *z, int *ldz, double *work, + int *info); + +/* ZTRCON estimates the reciprocal of the condition number of a + * triangular matrix A, in either the 1-norm or the infinity-norm. + */ +La_extern void +F77_NAME(ztrcon)(const char *norm, const char *uplo, const char *diag, + const int *n, const Rcomplex *a, const int *lda, + double *rcond, Rcomplex *work, double *rwork, int *info); + +La_extern void +F77_NAME(ztrevc)(const char *side, const char *howmny, int *select, + int *n, Rcomplex *t, int *ldt, Rcomplex *vl, + int *ldvl, Rcomplex *vr, int *ldvr, int *mm, int + *m, Rcomplex *work, double *rwork, int *info); + +La_extern void +F77_NAME(zung2l)(int *m, int *n, int *k, + Rcomplex *a, int *lda, Rcomplex *tau, Rcomplex * + work, int *info); + +La_extern void +F77_NAME(zung2r)(int *m, int *n, int *k, + Rcomplex *a, int *lda, Rcomplex *tau, Rcomplex * + work, int *info); + +La_extern void +F77_NAME(zungbr)(const char *vect, int *m, int *n, int *k, + Rcomplex *a, int *lda, Rcomplex *tau, Rcomplex * + work, int *lwork, int *info); + +La_extern void +F77_NAME(zunghr)(int *n, int *ilo, int *ihi, + Rcomplex *a, int *lda, Rcomplex *tau, Rcomplex * + work, int *lwork, int *info); + +La_extern void +F77_NAME(zungl2)(int *m, int *n, int *k, + Rcomplex *a, int *lda, Rcomplex *tau, Rcomplex * + work, int *info); + +La_extern void +F77_NAME(zunglq)(int *m, int *n, int *k, + Rcomplex *a, int *lda, Rcomplex *tau, Rcomplex * + work, int *lwork, int *info); + +La_extern void +F77_NAME(zungql)(int *m, int *n, int *k, + Rcomplex *a, int *lda, Rcomplex *tau, Rcomplex * + work, int *lwork, int *info); + +La_extern void +F77_NAME(zungqr)(int *m, int *n, int *k, + Rcomplex *a, int *lda, Rcomplex *tau, Rcomplex * + work, int *lwork, int *info); + +La_extern void +F77_NAME(zungr2)(int *m, int *n, int *k, + Rcomplex *a, int *lda, Rcomplex *tau, Rcomplex * + work, int *info); + +La_extern void +F77_NAME(zungrq)(int *m, int *n, int *k, + Rcomplex *a, int *lda, Rcomplex *tau, Rcomplex * + work, int *lwork, int *info); + +La_extern void +F77_NAME(zungtr)(const char *uplo, int *n, Rcomplex *a, + int *lda, Rcomplex *tau, Rcomplex *work, int *lwork, + int *info); + +La_extern void +F77_NAME(zunm2r)(const char *side, const char *trans, int *m, int *n, + int *k, Rcomplex *a, int *lda, Rcomplex *tau, + Rcomplex *c, int *ldc, Rcomplex *work, int *info); + +La_extern void +F77_NAME(zunmbr)(const char *vect, const char *side, const char *trans, int *m, + int *n, int *k, Rcomplex *a, int *lda, Rcomplex + *tau, Rcomplex *c, int *ldc, Rcomplex *work, int * + lwork, int *info); + +La_extern void +F77_NAME(zunml2)(const char *side, const char *trans, int *m, int *n, + int *k, Rcomplex *a, int *lda, Rcomplex *tau, + Rcomplex *c, int *ldc, Rcomplex *work, int *info); + +La_extern void +F77_NAME(zunmlq)(const char *side, const char *trans, int *m, int *n, + int *k, Rcomplex *a, int *lda, Rcomplex *tau, + Rcomplex *c, int *ldc, Rcomplex *work, int *lwork, + int *info); + +/* Added in R 3.1.0 */ +/* ZGESVD - compute the singular value decomposition (SVD); of a */ +/* real M-by-N matrix A, optionally computing the left and/or */ +/* right singular vectors */ +La_extern void +F77_NAME(zgesdd)(const char *jobz, + const int *m, const int *n, + Rcomplex *a, const int *lda, double *s, + Rcomplex *u, const int *ldu, + Rcomplex *vt, const int *ldvt, + Rcomplex *work, const int *lwork, double *rwork, + int *iwork, int *info); +La_extern void +F77_NAME(zgelsd)(int *m, int *n, int *nrhs, + Rcomplex *a, int *lda, Rcomplex *b, int *ldb, double *s, + double *rcond, int *rank, + Rcomplex *work, int *lwork, double *rwork, int *iwork, int *info); + +/* =========================== DEPRECATED ============================== + + Routines below were deprecated in LAPACK 3.6.0, and are not + included in a default build of LAPACK. + + Currently dgegv, dgeqpf, dggsvd and dggsvp are included in R, but + that may change in future. + */ + +/* DGEGV - compute for a pair of n-by-n real nonsymmetric */ +/* matrices A and B, the generalized eigenvalues (alphar +/- */ +/* alphai*i, beta);, and optionally, the left and/or right */ +/* generalized eigenvectors (VL and VR); */ +La_extern void +F77_NAME(dgegv)(const char* jobvl, const char* jobvr, + const int* n, double* a, const int* lda, + double* b, const int* ldb, + double* alphar, double* alphai, + const double* beta, double* vl, const int* ldvl, + double* vr, const int* ldvr, + double* work, const int* lwork, int* info); + +/* DGEQPF - compute a QR factorization with column pivoting of a */ +/* real M-by-N matrix A */ +La_extern void +F77_NAME(dgeqpf)(const int* m, const int* n, double* a, const int* lda, + int* jpvt, double* tau, double* work, int* info); + +/* DGGSVD - compute the generalized singular value decomposition */ +/* (GSVD) of an M-by-N real matrix A and P-by-N real matrix B */ +La_extern void +F77_NAME(dggsvd)(const char* jobu, const char* jobv, const char* jobq, + const int* m, const int* n, const int* p, + const int* k, const int* l, + double* a, const int* lda, + double* b, const int* ldb, + const double* alpha, const double* beta, + double* u, const int* ldu, + double* v, const int* ldv, + double* q, const int* ldq, + double* work, int* iwork, int* info); + +/* DTZRQF - reduce the M-by-N ( M<=N ); real upper trapezoidal */ +/* matrix A to upper triangular form by means of orthogonal */ +/* transformations */ +La_extern void +F77_NAME(dtzrqf)(const int* m, const int* n, + double* a, const int* lda, + double* tau, int* info); + +/* DLAHRD - reduce the first NB columns of a real general */ +/* n-by-(n-k+1); matrix A so that elements below the k-th */ +/* subdiagonal are zero */ +La_extern void +F77_NAME(dlahrd)(const int* n, const int* k, const int* nb, + double* a, const int* lda, + double* tau, double* t, const int* ldt, + double* y, const int* ldy); + +/* DLATZM - apply a Householder matrix generated by DTZRQF to a */ +/* matrix */ +La_extern void +F77_NAME(dlatzm)(const char* side, const int* m, const int* n, + const double* v, const int* incv, + const double* tau, double* c1, double* c2, + const int* ldc, double* work); + +La_extern void +F77_NAME(dgegs)(char *jobvsl, char *jobvsr, int *n, + double *a, int *lda, double *b, int *ldb, double * + alphar, double *alphai, double *beta, double *vsl, + int *ldvsl, double *vsr, int *ldvsr, double *work, + int *lwork, int *info); + +La_extern void +F77_NAME(dgelsx)(int *m, int *n, int *nrhs, + double *a, int *lda, double *b, int *ldb, int * + jpvt, double *rcond, int *rank, double *work, int * + info); + +La_extern void +F77_NAME(dggsvp)(char *jobu, char *jobv, char *jobq, int *m, + int *p, int *n, double *a, int *lda, double *b, + int *ldb, double *tola, double *tolb, int *k, int + *l, double *u, int *ldu, double *v, int *ldv, + double *q, int *ldq, int *iwork, double *tau, + double *work, int *info); + +La_extern void +F77_NAME(zlahrd)(int *n, int *k, int *nb, + Rcomplex *a, int *lda, Rcomplex *tau, Rcomplex *t, + int *ldt, Rcomplex *y, int *ldy); + + +#ifdef __cplusplus +} +#endif + +#endif /* R_LAPACK_H */ + +// Local variables: *** +// mode: outline-minor *** +// outline-regexp: "^\^L\\|^//[*]+" *** +// End: *** diff --git a/com.oracle.truffle.r.native/gnur/patch/src/include/R_ext/Linpack.h b/com.oracle.truffle.r.native/gnur/patch/src/include/R_ext/Linpack.h new file mode 100644 index 0000000000000000000000000000000000000000..1a0ef5515b269fc0a08add5ad49cc3b11c53332a --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/include/R_ext/Linpack.h @@ -0,0 +1,92 @@ +/* + * R : A Computer Language for Statistical Data Analysis + * Copyright (C) 1997 Robert Gentleman and Ross Ihaka + * Copyright (C) 1999-2015 The R Core Team. + * + * This header file is free software; you can redistribute it and/or modify + * it under the terms of the GNU Lesser General Public License as published by + * the Free Software Foundation; either version 2.1 of the License, or + * (at your option) any later version. + * + * This file is part of R. R is distributed under the terms of the + * GNU General Public License, either Version 2, June 1991 or Version 3, + * June 2007. See doc/COPYRIGHTS for details of the copyright status of R. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public License + * along with this program; if not, a copy is available at + * https://www.R-project.org/Licenses/ + */ + +/* + C declarations of double-precision LINPACK Fortran subroutines + included in R, and some others. + + Those which are listed as part of R are in the API + */ + +#ifndef R_LINPACK_H_ +#define R_LINPACK_H_ + +#include <R_ext/RS.h> /* for F77_... */ +#include <R_ext/BLAS.h> + +#ifdef __cplusplus +extern "C" { +#endif + + /* Double Precision LINPACK */ + +extern void F77_NAME(dpbfa)(double*, int*, int*, int*, int*); +extern void F77_NAME(dpbsl)(double*, int*, int*, int*, double*); +extern void F77_NAME(dpoco)(double*, int*, int*, double*, double*, int*); +extern void F77_NAME(dpodi)(double*, int*, int*, double*, int*); +extern void F77_NAME(dpofa)(double*, int*, int*, int*); +extern void F77_NAME(dposl)(double*, int*, int*, double*); +extern void F77_NAME(dqrdc)(double*, int*, int*, int*, double*, int*, double*, int*); +extern void F77_NAME(dqrsl)(double*, int*, int*, int*, double*, double*, double*, double*, double*, double*, double*, int*, int*); +extern void F77_NAME(dsvdc)(double*, int*, int*, int*, double*, double*, double*, int*, double*, int*, double*, int*, int*); +extern void F77_NAME(dtrco)(double*, int*, int*, double*, double*, int*); +extern void F77_NAME(dtrsl)(double*, int*, int*, double*, int*, int*); + + +/* The following routines are listed as they have always been declared + here, but they are not currently included in R */ +extern void F77_NAME(dchdc)(double*, int*, int*, double*, int*, int*, int*); +extern void F77_NAME(dchdd)(double*, int*, int*, double*, double*, int*, int*, double*, double*, double*, double*, int*); +extern void F77_NAME(dchex)(double*, int*, int*, int*, int*, double*, int*, int*, double*, double*, int*); +extern void F77_NAME(dchud)(double*, int*, int*, double*, double*, int*, int*, double*, double*, double*, double*); +extern void F77_NAME(dgbco)(double*, int*, int*, int*, int*, int*, double*, double*); +extern void F77_NAME(dgbdi)(double*, int*, int*, int*, int*, int*, double*); +extern void F77_NAME(dgbfa)(double*, int*, int*, int*, int*, int*, int*); +extern void F77_NAME(dgbsl)(double*, int*, int*, int*, int*, int*, double*, int*); +extern void F77_NAME(dgeco)(double*, int*, int*, int*, double*, double*); +extern void F77_NAME(dgedi)(double*, int*, int*, int*, double*, double*, int*); +extern void F77_NAME(dgefa)(double*, int*, int*, int*, int*); +extern void F77_NAME(dgesl)(double*, int*, int*, int*, double*, int*); +extern void F77_NAME(dgtsl)(int*, double*, double*, double*, double*, int*); +extern void F77_NAME(dpbco)(double*, int*, int*, int*, double*, double*, int*); +extern void F77_NAME(dpbdi)(double*, int*, int*, int*, double*); +extern void F77_NAME(dppco)(double*, int*, double*, double*, int*); +extern void F77_NAME(dppdi)(double*, int*, double*, int*); +extern void F77_NAME(dppfa)(double*, int*, int*); +extern void F77_NAME(dppsl)(double*, int*, double*); +extern void F77_NAME(dptsl)(int*, double*, double*, double*); +extern void F77_NAME(dsico)(double*, int*, int*, int*, double*, double*); +extern void F77_NAME(dsidi)(double*, int*, int*, int*, double*, int*, double*, int*); +extern void F77_NAME(dsifa)(double*, int*, int*, int*, int*); +extern void F77_NAME(dsisl)(double*, int*, int*, int*, double*); +extern void F77_NAME(dspco)(double*, int*, int*, double*, double*); +extern void F77_NAME(dspdi)(double*, int*, int*, double*, int*, double*, int*); +extern void F77_NAME(dspfa)(double*, int*, int*, int*); +extern void F77_NAME(dspsl)(double*, int*, int*, double*); + +#ifdef __cplusplus +} +#endif + +#endif /* R_LINPACK_H_ */ diff --git a/com.oracle.truffle.r.native/gnur/patch/src/include/R_ext/Makefile.in b/com.oracle.truffle.r.native/gnur/patch/src/include/R_ext/Makefile.in new file mode 100644 index 0000000000000000000000000000000000000000..a1a9ef2a03963ba91a50f925aa4291931cc5cfb8 --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/include/R_ext/Makefile.in @@ -0,0 +1,75 @@ +# +# ${R_HOME}/src/include/R_ext/Makefile + +VPATH = @srcdir@ +srcdir = @srcdir@ +top_srcdir = @top_srcdir@ + +top_builddir = ../../.. +subdir = src/include/R_ext + +include $(top_builddir)/Makeconf + +distdir = $(top_builddir)/$(PACKAGE)-$(VERSION)/$(subdir) + +## Partially included by the API (1) headers in .., but not part of the +## API per se. +R_EXT_HEADERS = \ + Applic.h Arith.h BLAS.h Boolean.h Callbacks.h Complex.h Connections.h \ + Constants.h Error.h GetX11Image.h \ + GraphicsDevice.h GraphicsEngine.h Itermacros.h \ + Lapack.h Linpack.h MathThreads.h Memory.h QuartzDevice.h \ + Parse.h Print.h PrtUtil.h R-ftp-http.h RS.h Rallocators.h Random.h \ + Rdynload.h Riconv.h RStartup.h Utils.h eventloop.h libextern.h \ + stats_package.h stats_stubs.h Visibility.h + +DISTFILES = Makefile.in $(R_EXT_HEADERS) +TIMESTAMPS = $(R_EXT_HEADERS:.h=.ts) + +CLEANFILES = stamp-R $(TIMESTAMPS) +DISTCLEANFILES = Makefile + +.SUFFIXES: +.SUFFIXES: .h .ts + +.h.ts: + @$(INSTALL_DATA) $< $(top_builddir)/include/R_ext/`basename $<` + @touch $@ + +all: Makefile R + +Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status + @cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ + +R: Makefile stamp-R $(TIMESTAMPS) +stamp-R: + @$(MKINSTALLDIRS) $(top_builddir)/include/R_ext + @touch $@ +$(TIMESTAMPS): stamp-R + +install: installdirs + @for f in $(R_EXT_HEADERS); do \ + $(INSTALL_DATA) $(srcdir)/$${f} "$(DESTDIR)$(rincludedir)/R_ext"; \ + done +installdirs: + @$(MKINSTALLDIRS) "$(DESTDIR)$(rincludedir)/R_ext" +install-strip: + $(MAKE) INSTALL_PROGRAM="${INSTALL_PROGRAM} -s" install +uninstall: + @rm -rf "$(DESTDIR)$(rincludedir)/R_ext" + +mostlyclean: clean +clean: + -@test -z "$(CLEANFILES)" || rm -f $(CLEANFILES) +distclean: clean + -@test -z "$(DISTCLEANFILES)" || rm -f $(DISTCLEANFILES) +maintainer-clean: distclean + +TAGS info dvi check: + +distdir: $(DISTFILES) + @for f in $(DISTFILES); do \ + test -f $(distdir)/$${f} \ + || ln $(srcdir)/$${f} $(distdir)/$${f} 2>/dev/null \ + || cp -p $(srcdir)/$${f} $(distdir)/$${f}; \ + done diff --git a/com.oracle.truffle.r.native/gnur/patch/src/include/R_ext/MathThreads.h b/com.oracle.truffle.r.native/gnur/patch/src/include/R_ext/MathThreads.h new file mode 100644 index 0000000000000000000000000000000000000000..9aecef89371f633541ce4aae0223705e36b87e37 --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/include/R_ext/MathThreads.h @@ -0,0 +1,49 @@ +/* + * R : A Computer Language for Statistical Data Analysis + * Copyright (C) 2000-2014 The R Core Team. + * + * This header file is free software; you can redistribute it and/or modify + * it under the terms of the GNU Lesser General Public License as published by + * the Free Software Foundation; either version 2.1 of the License, or + * (at your option) any later version. + * + * This file is part of R. R is distributed under the terms of the + * GNU General Public License, either Version 2, June 1991 or Version 3, + * June 2007. See doc/COPYRIGHTS for details of the copyright status of R. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public License + * along with this program; if not, a copy is available at + * https://www.R-project.org/Licenses/ + */ + +/* + Experimental: included by src/library/stats/src/distance.c + + Note that only uses R_num_math_threads: it is not clear + R_num_math_threads should be exposed at all. + + This is not used currently on Windows, where R_num_math_threads + used not to be exposed. +*/ + +#ifndef R_EXT_MATHTHREADS_H_ +#define R_EXT_MATHTHREADS_H_ + +#ifdef __cplusplus +extern "C" { +#endif + +#include <R_ext/libextern.h> +LibExtern int R_num_math_threads; +LibExtern int R_max_num_math_threads; + +#ifdef __cplusplus +} +#endif + +#endif /* R_EXT_MATHTHREADS_H_ */ diff --git a/com.oracle.truffle.r.native/gnur/patch/src/include/R_ext/Memory.h b/com.oracle.truffle.r.native/gnur/patch/src/include/R_ext/Memory.h new file mode 100644 index 0000000000000000000000000000000000000000..82dccf65140b58c33ed84646fd54631216d90d83 --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/include/R_ext/Memory.h @@ -0,0 +1,59 @@ +/* + * R : A Computer Language for Statistical Data Analysis + * Copyright (C) 1998-2016 The R Core Team + * + * This header file is free software; you can redistribute it and/or modify + * it under the terms of the GNU Lesser General Public License as published by + * the Free Software Foundation; either version 2.1 of the License, or + * (at your option) any later version. + * + * This file is part of R. R is distributed under the terms of the + * GNU General Public License, either Version 2, June 1991 or Version 3, + * June 2007. See doc/COPYRIGHTS for details of the copyright status of R. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public License + * along with this program; if not, a copy is available at + * https://www.R-project.org/Licenses/ + * + * + * Memory Allocation (garbage collected) --- INCLUDING S compatibility --- + */ + +/* Included by R.h: API */ + +#ifndef R_EXT_MEMORY_H_ +#define R_EXT_MEMORY_H_ + +#if defined(__cplusplus) && !defined(DO_NOT_USE_CXX_HEADERS) +# include <cstddef> +# define R_SIZE_T std::size_t +#else +# include <stddef.h> /* for size_t */ +# define R_SIZE_T size_t +#endif + +#ifdef __cplusplus +extern "C" { +#endif + +void* vmaxget(void); +void vmaxset(const void *); + +void R_gc(void); +int R_gc_running(); + +char* R_alloc(R_SIZE_T, int); +long double *R_allocLD(R_SIZE_T nelem); +char* S_alloc(long, int); +char* S_realloc(char *, long, long, int); + +#ifdef __cplusplus +} +#endif + +#endif /* R_EXT_MEMORY_H_ */ diff --git a/com.oracle.truffle.r.native/gnur/patch/src/include/R_ext/Parse.h b/com.oracle.truffle.r.native/gnur/patch/src/include/R_ext/Parse.h new file mode 100644 index 0000000000000000000000000000000000000000..25e6fbefcbe0c2666640c04abda17d49c41aa345 --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/include/R_ext/Parse.h @@ -0,0 +1,47 @@ +/* + * R : A Computer Language for Statistical Data Analysis + * Copyright (C) 1998-2006 R Core Team + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version. + * + * This program 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 this program; if not, a copy is available at + * https://www.R-project.org/Licenses/ + */ + +/* NOTE: + This file exports a part of the current internal parse interface. + It is subject to change at any minor (x.y.0) version of R. + */ + +#ifndef R_EXT_PARSE_H_ +#define R_EXT_PARSE_H_ + +#ifdef __cplusplus +extern "C" { +#endif + +/* PARSE_NULL will not be returned by R_ParseVector */ +typedef enum { + PARSE_NULL, + PARSE_OK, + PARSE_INCOMPLETE, + PARSE_ERROR, + PARSE_EOF +} ParseStatus; + +SEXP R_ParseVector(SEXP, int, ParseStatus *, SEXP); + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/com.oracle.truffle.r.native/gnur/patch/src/include/R_ext/Print.h b/com.oracle.truffle.r.native/gnur/patch/src/include/R_ext/Print.h new file mode 100644 index 0000000000000000000000000000000000000000..4e70c92dc21c5c892fa3793fcc79a0315bfe39ec --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/include/R_ext/Print.h @@ -0,0 +1,53 @@ +/* + * R : A Computer Language for Statistical Data Analysis + * Copyright (C) 1998-2016 The R Core Team + * + * This header file is free software; you can redistribute it and/or modify + * it under the terms of the GNU Lesser General Public License as published by + * the Free Software Foundation; either version 2.1 of the License, or + * (at your option) any later version. + * + * This file is part of R. R is distributed under the terms of the + * GNU General Public License, either Version 2, June 1991 or Version 3, + * June 2007. See doc/COPYRIGHTS for details of the copyright status of R. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public License + * along with this program; if not, a copy is available at + * https://www.R-project.org/Licenses/ + */ + +/* Included by R.h: API */ + +#ifndef R_EXT_PRINT_H_ +#define R_EXT_PRINT_H_ + +#ifdef __cplusplus +/* If the vprintf interface is defined at all in C++ it may only be + defined in namespace std. It is part of the C++11 standard. */ +# ifdef R_USE_C99_IN_CXX +# include <cstdarg> +# define R_VA_LIST std::va_list +# endif +extern "C" { +#else +# include <stdarg.h> +# define R_VA_LIST va_list +#endif + +void Rprintf(const char *, ...); +void REprintf(const char *, ...); +#if !defined(__cplusplus) || defined R_USE_C99_IN_CXX +void Rvprintf(const char *, R_VA_LIST); +void REvprintf(const char *, R_VA_LIST); +#endif + +#ifdef __cplusplus +} +#endif + +#endif /* R_EXT_PRINT_H_ */ diff --git a/com.oracle.truffle.r.native/gnur/patch/src/include/R_ext/PrtUtil.h b/com.oracle.truffle.r.native/gnur/patch/src/include/R_ext/PrtUtil.h new file mode 100644 index 0000000000000000000000000000000000000000..5aba50b50b4dde6e8bdeb2b2883ff769e02fa4b2 --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/include/R_ext/PrtUtil.h @@ -0,0 +1,80 @@ +/* + * R : A Computer Language for Statistical Data Analysis + * Copyright (C) 1998-2014 The R Core Team + * + * This header file is free software; you can redistribute it and/or modify + * it under the terms of the GNU Lesser General Public License as published by + * the Free Software Foundation; either version 2.1 of the License, or + * (at your option) any later version. + * + * This file is part of R. R is distributed under the terms of the + * GNU General Public License, either Version 2, June 1991 or Version 3, + * June 2007. See doc/COPYRIGHTS for details of the copyright status of R. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public License + * along with this program; if not, a copy is available at + * https://www.R-project.org/Licenses/ + */ + +/* + * These functions are not part of the API. + */ +#ifndef PRTUTIL_H_ +#define PRTUTIL_H_ + +#include <Rinternals.h> // for R_xlen_t +#include <R_ext/Complex.h> + +#define formatLogical Rf_formatLogical +#define formatInteger Rf_formatInteger +#define formatReal Rf_formatReal +#define formatComplex Rf_formatComplex +#define EncodeLogical Rf_EncodeLogical +#define EncodeInteger Rf_EncodeInteger +#define EncodeReal Rf_EncodeReal +#define EncodeReal0 Rf_EncodeReal0 +#define EncodeComplex Rf_EncodeComplex +#define VectorIndex Rf_VectorIndex +#define printIntegerVector Rf_printIntegerVector +#define printRealVector Rf_printRealVector +#define printComplexVector Rf_printComplexVector + +#ifdef __cplusplus +extern "C" { +#endif + +/* Computation of printing formats */ +void formatLogical(int *, R_xlen_t, int *); +void formatInteger(int *, R_xlen_t, int *); +void formatReal(double *, R_xlen_t, int *, int *, int *, int); +void formatComplex(Rcomplex *, R_xlen_t, int *, int *, int *, int *, int *, int *, int); + +/* Formating of values */ +const char *EncodeLogical(int, int); +const char *EncodeInteger(int, int); +const char *EncodeReal0(double, int, int, int, const char *); +const char *EncodeComplex(Rcomplex, int, int, int, int, int, int, const char *); + +/* Legacy, misused by packages RGtk2 and qtbase */ +const char *EncodeReal(double, int, int, int, char); + + +/* Printing */ +int IndexWidth(R_xlen_t); +void VectorIndex(R_xlen_t, int); + +//void printLogicalVector(int *, R_xlen_t, int); +void printIntegerVector(int *, R_xlen_t, int); +void printRealVector (double *, R_xlen_t, int); +void printComplexVector(Rcomplex *, R_xlen_t, int); + +#ifdef __cplusplus +} +#endif + +#endif /* PRTUTIL_H_ */ diff --git a/com.oracle.truffle.r.native/gnur/patch/src/include/R_ext/QuartzDevice.h b/com.oracle.truffle.r.native/gnur/patch/src/include/R_ext/QuartzDevice.h new file mode 100644 index 0000000000000000000000000000000000000000..c15382daf9e23e2fd4008214afaeb02f0fa131b9 --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/include/R_ext/QuartzDevice.h @@ -0,0 +1,238 @@ +/* + * R : A Computer Language for Statistical Data Analysis + * Copyright (C) 2007-2016 The R Core Team + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version. + * + * This program 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 this program; if not, a copy is available at + * https://www.R-project.org/Licenses/ + * + *--------------------------------------------------------------------- + * This header file constitutes the (unofficial) API to the Quartz + * device. Being unofficial, the API may change at any point without + * warning. + * + * Quartz is a general device-independent way of drawing in macOS, + * therefore the Quartz device modularizes the actual drawing target + * implementation into separate modules (e.g. Carbon and Cocoa for + * on-screen display and PDF, Bitmap for off-screen drawing). The API + * below is used by the modules to talk to the Quartz device without + * having to know anything about R graphics device API. + * + * Key functions are listed here: + * QuartzDevice_Create - creates a Quartz device + * QuartzDevice_ResetContext - should be called after the target + * context has been created to initialize it. + * QuartzDevice_Kill - closes the Quartz device (e.g. on window close) + * QuartzDevice_SetScaledSize - resize device (does not include + * re-painting, it should be followed by a call to + * QuartzDevice_ReplayDisplayList) + * QuartzDevice_ReplayDisplayList - replays all plot commands + * + * Key concepts + * - all Quartz modules are expected to provide a device context + * (CGContextRef) for drawing. A device can temporarily return NULL + * (e.g. if the context is not available immediately) and replay + * the display list later to catch up. + * + * - interactive devices can use QuartzDevice_SetScaledSize to resize + * the device (no context is necessary), then prepare the context + * (call QuartzDevice_ResetContext if a new context was created) + * and finally re-draw using QuartzDevice_ReplayDisplayList. + * + * - snapshots can be created either off the current display list + * (last=0) or off the last known one (last=1). NewPage callback + * can only use last=1 as there is no display list during that + * call. Restored snapshots become the current display list and + * thus can be extended by further painting (yet the original saved + * copy is not influenced). Also note that all snapshots are SEXPs + * (the declaration doesn't use SEXP as to not depend on + * Rinternals.h) therefore must be protected or preserved immediately + * (i.e. the Quartz device does NOT protect them - except in the + * call to RestoreSnapshot). + * + * - dirty flag: the dirty flag is not used internally by the Quartz + * device, but can be useful for the modules to determine whether + * the current graphics is a restored copy or in-progress + * drawing. The Quartz device manages the flag as follows: a) + * display list replay does NOT change the flag, b) snapshot + * restoration resets the flag, c) all other paint operations + * (i.e. outside of restore/replay) set the flag. Most common use + * is to determine whether restored snapshots have been + * subsequently modified. + * + * - history: currently the history management is not used by any + * modules and as such is untested and strictly experimental. It + * may be removed in the future as it is not clear whether it makes + * sense to be part of the device. See Cocoa module for a + * module-internal implementation of the display history. + * + * Quartz device creation path: + * quartz() function -> SEXP Quartz(args) -> + * setup QuartzParameters_t, call backend constructor + * [e.g. QuartzCocoa_DeviceCreate(dd, fn, QuartzParameters_t *pars)] -> + * create backend definition (QuartzBackend_t backend) -> + * fn->Create(dd, &backend), return the result + */ + +/* Unix-only header */ + +#ifndef R_EXT_QUARTZDEVICE_H_ +#define R_EXT_QUARTZDEVICE_H_ + +/* FIXME: this is installed, but can it really work without config.h? */ + +#ifdef HAVE_CONFIG_H +#include <config.h> +#endif + +#ifdef __cplusplus +extern "C" { +#endif + +#if HAVE_AQUA +#include <ApplicationServices/ApplicationServices.h> +#else + typedef void* CGContextRef; +#endif + +/* flags passed to the newPage callback */ +#define QNPF_REDRAW 0x0001 /* is set when NewPage really means re-draw of an existing page */ + +/* flags passed to QuartzDevice_Create (as fs parameter) */ +#define QDFLAG_DISPLAY_LIST 0x0001 +#define QDFLAG_INTERACTIVE 0x0002 +#define QDFLAG_RASTERIZED 0x0004 /* rasterized media - may imply disabling AA paritally for rects etc. */ + +/* parameter flags (they should not conflict with QDFLAGS to allow chaining) */ +#define QPFLAG_ANTIALIAS 0x0100 + +typedef void* QuartzDesc_t; + +typedef struct QuartzBackend_s { + int size; /* structure size */ + double width, height; + double scalex, scaley, pointsize; + int bg, canvas; + int flags; + void* userInfo; + CGContextRef (*getCGContext)(QuartzDesc_t dev, void*userInfo); /* Get the context for this device */ + int (*locatePoint)(QuartzDesc_t dev, void*userInfo, double*x, double*y); + void (*close)(QuartzDesc_t dev, void*userInfo); + void (*newPage)(QuartzDesc_t dev, void*userInfo, int flags); + void (*state)(QuartzDesc_t dev, void*userInfo, int state); + void* (*par)(QuartzDesc_t dev, void*userInfo, int set, const char *key, void *value); + void (*sync)(QuartzDesc_t dev, void*userInfo); + void* (*cap)(QuartzDesc_t dev, void*userInfo); +} QuartzBackend_t; + +/* parameters that are passed to functions that create backends */ +typedef struct QuartzParameters_s { + int size; /* structure size */ + const char *type, *file, *title; + double x, y, width, height, pointsize; + const char *family; + int flags; + int connection; + int bg, canvas; + double *dpi; + /* the following parameters can be used to pass custom parameters when desired */ + double pard1, pard2; + int pari1, pari2; + const char *pars1, *pars2; + void *parv; +} QuartzParameters_t; + +/* all device implementations have to call this general Quartz device constructor at some point */ +QuartzDesc_t QuartzDevice_Create(void *dd, QuartzBackend_t* def); + +typedef struct QuartzFunctons_s { + void* (*Create)(void *, QuartzBackend_t *); /* create a new device */ + int (*DevNumber)(QuartzDesc_t desc); /* returns device number */ + void (*Kill)(QuartzDesc_t desc); /* call to close the device */ + void (*ResetContext)(QuartzDesc_t desc); /* notifies Q back-end that the implementation has created a new context */ + double (*GetWidth)(QuartzDesc_t desc); /* get device width (in inches) */ + double (*GetHeight)(QuartzDesc_t desc); /* get device height (in inches) */ + void (*SetSize)(QuartzDesc_t desc, double width, double height); /* set device size (in inches) */ + + double (*GetScaledWidth)(QuartzDesc_t desc); /* get device width (in pixels) */ + double (*GetScaledHeight)(QuartzDesc_t desc); /* get device height (in pixels) */ + void (*SetScaledSize)(QuartzDesc_t desc, double width, double height); /* set device size (in pixels) */ + + double (*GetXScale)(QuartzDesc_t desc); /* get x scale factor (px/pt ratio) */ + double (*GetYScale)(QuartzDesc_t desc); /* get y scale factor (px/pt ratio) */ + void (*SetScale)(QuartzDesc_t desc,double scalex, double scaley); /* sets both scale factors (px/pt ratio) */ + + void (*SetTextScale)(QuartzDesc_t desc,double scale); /* sets text scale factor */ + double (*GetTextScale)(QuartzDesc_t desc); /* sets text scale factor */ + + void (*SetPointSize)(QuartzDesc_t desc,double ps); /* sets point size */ + double (*GetPointSize)(QuartzDesc_t desc); /* gets point size */ + + int (*GetDirty)(QuartzDesc_t desc); /* sets dirty flag */ + void (*SetDirty)(QuartzDesc_t desc,int dirty); /* gets dirty flag */ + + void (*ReplayDisplayList)(QuartzDesc_t desc); /* replay display list + Note: it inhibits sync calls during repaint, + the caller is responsible for calling sync if needed. + Dirty flag is kept unmodified */ + void* (*GetSnapshot)(QuartzDesc_t desc, int last); + /* create a (replayable) snapshot of the device contents. + when 'last' is set then the last stored display list is used, + otherwise a new snapshot is created */ + void (*RestoreSnapshot)(QuartzDesc_t desc,void* snapshot); + /* restore a snapshot. also clears the dirty flag */ + + int (*GetAntialias)(QuartzDesc_t desc); /* get anti-alias flag */ + void (*SetAntialias)(QuartzDesc_t desc, int aa); /* set anti-alias flag */ + + int (*GetBackground)(QuartzDesc_t desc); /* get background color */ + void (*Activate)(QuartzDesc_t desc); /* activate/select the device */ + /* get/set Quartz-specific parameters. desc can be NULL for global parameters */ + void* (*SetParameter)(QuartzDesc_t desc, const char *key, void *value); + void* (*GetParameter)(QuartzDesc_t desc, const char *key); +} QuartzFunctions_t; + +#define QuartzParam_EmbeddingFlags "embeddeding flags" /* value: int[1] */ +#define QP_Flags_CFLoop 0x0001 /* drives application event loop */ +#define QP_Flags_Cocoa 0x0002 /* Cocoa is fully initialized */ +#define QP_Flags_Front 0x0004 /* is front application */ + +/* FIXME: no longer used, remove in due course */ +/* from unix/aqua.c - loads grDevices if necessary and returns NULL on failure */ +QuartzFunctions_t *getQuartzFunctions(); + +/* type of a Quartz contructor */ +typedef QuartzDesc_t (*quartz_create_fn_t)(void *dd, QuartzFunctions_t *fn, QuartzParameters_t *par); + +/* grDevices currently supply following constructors: + QuartzCocoa_DeviceCreate, QuartzCarbon_DeviceCreate, + QuartzBitmap_DeviceCreate, QuartzPDF_DeviceCreate */ + +/* embedded Quartz support hook (defined in unix/aqua.c): + dd = should be passed-through to QuartzDevice_Create + fn = Quartz API functions + par = parameters (see above) */ +#ifndef IN_AQUA_C + extern +#endif + QuartzDesc_t (*ptr_QuartzBackend)(void *dd, QuartzFunctions_t *fn, QuartzParameters_t *par); + +/* C version of the Quartz call (experimental) + returns 0 on success, error code on failure */ +QuartzDesc_t Quartz_C(QuartzParameters_t *par, quartz_create_fn_t q_create, int *errorCode); + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/com.oracle.truffle.r.native/gnur/patch/src/include/R_ext/R-ftp-http.h b/com.oracle.truffle.r.native/gnur/patch/src/include/R_ext/R-ftp-http.h new file mode 100644 index 0000000000000000000000000000000000000000..06720eb46781b850a60354eda82e6e3dfd4bceea --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/include/R_ext/R-ftp-http.h @@ -0,0 +1,81 @@ +/* + * R : A Computer Language for Statistical Data Analysis + * Copyright (C) 2001-2016 The R Core Team. + * + * This header file is free software; you can redistribute it and/or modify + * it under the terms of the GNU Lesser General Public License as published by + * the Free Software Foundation; either version 2.1 of the License, or + * (at your option) any later version. + * + * This file is part of R. R is distributed under the terms of the + * GNU General Public License, either Version 2, June 1991 or Version 3, + * June 2007. See doc/COPYRIGHTS for details of the copyright status of R. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public License + * along with this program; if not, a copy is available at + * https://www.R-project.org/Licenses/ + */ + +/* Advertized entry points, for that part of libxml included in + * the internet module. + */ + +#ifndef R_FTP_HTTP_H_ +#define R_FTP_HTTP_H_ + +/* + allow for 'large' files (>= 2GB) on 32-bit systems, where supported. +*/ +/* required by C99/C11 */ +#ifdef __cplusplus +# include <cstdint> +#else +# include <stdint.h> +#endif + +typedef int_fast64_t DLsize_t; // used for download lengths and sizes + +#ifdef __cplusplus +extern "C" { +#endif + +void *R_HTTPOpen(const char *url); +int R_HTTPRead(void *ctx, char *dest, int len); +void R_HTTPClose(void *ctx); + +void *R_FTPOpen(const char *url); +int R_FTPRead(void *ctx, char *dest, int len); +void R_FTPClose(void *ctx); + +void * RxmlNanoHTTPOpen(const char *URL, char **contentType, const char *headers, int cacheOK); +int RxmlNanoHTTPRead(void *ctx, void *dest, int len); +void RxmlNanoHTTPClose(void *ctx); +int RxmlNanoHTTPReturnCode(void *ctx); +char * RxmlNanoHTTPStatusMsg(void *ctx); +DLsize_t RxmlNanoHTTPContentLength(void *ctx); +char * RxmlNanoHTTPContentType(void *ctx); +void RxmlNanoHTTPTimeout(int delay); + +void * RxmlNanoFTPOpen(const char *URL); +int RxmlNanoFTPRead(void *ctx, void *dest, int len); +int RxmlNanoFTPClose(void *ctx); +void RxmlNanoFTPTimeout(int delay); +DLsize_t RxmlNanoFTPContentLength(void *ctx); + +void RxmlMessage(int level, const char *format, ...); + +/* not currently used */ + +void RxmlNanoFTPCleanup(void); +void RxmlNanoHTTPCleanup(void); + +#ifdef __cplusplus +} +#endif + +#endif /* R_FTP_HTTP_H_ */ diff --git a/com.oracle.truffle.r.native/gnur/patch/src/include/R_ext/RS.h b/com.oracle.truffle.r.native/gnur/patch/src/include/R_ext/RS.h new file mode 100644 index 0000000000000000000000000000000000000000..4fc82ff9ca63b942e2762b4cde59f3bda4a1fc17 --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/include/R_ext/RS.h @@ -0,0 +1,109 @@ +/* + * R : A Computer Language for Statistical Data Analysis + * Copyright (C) 1999-2016 The R Core Team. + * + * This header file is free software; you can redistribute it and/or modify + * it under the terms of the GNU Lesser General Public License as published by + * the Free Software Foundation; either version 2.1 of the License, or + * (at your option) any later version. + * + * This file is part of R. R is distributed under the terms of the + * GNU General Public License, either Version 2, June 1991 or Version 3, + * June 2007. See doc/COPYRIGHTS for details of the copyright status of R. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public License + * along with this program; if not, a copy is available at + * https://www.R-project.org/Licenses/ + */ + +/* Included by R.h: API */ + +#ifndef R_RS_H +#define R_RS_H + +#if defined(__cplusplus) && !defined(DO_NOT_USE_CXX_HEADERS) +# include <cstring> +# include <cstddef> +# define R_SIZE_T std::size_t +#else +# include <string.h> /* for memcpy, memset */ +# include <stddef.h> /* for size_t */ +# define R_SIZE_T size_t +#endif + +#include <Rconfig.h> /* for F77_APPEND_UNDERSCORE */ + +#ifdef __cplusplus +extern "C" { +#endif + +/* S Like Error Handling */ + +#include <R_ext/Error.h> /* for error and warning */ + +#ifndef STRICT_R_HEADERS + +#define R_PROBLEM_BUFSIZE 4096 +/* Parentheses added for FC4 with gcc4 and -D_FORTIFY_SOURCE=2 */ +#define PROBLEM {char R_problem_buf[R_PROBLEM_BUFSIZE];(sprintf)(R_problem_buf, +#define MESSAGE {char R_problem_buf[R_PROBLEM_BUFSIZE];(sprintf)(R_problem_buf, +#define ERROR ),error(R_problem_buf);} +#define RECOVER(x) ),error(R_problem_buf);} +#define WARNING(x) ),warning(R_problem_buf);} +#define LOCAL_EVALUATOR /**/ +#define NULL_ENTRY /**/ +#define WARN WARNING(NULL) + +#endif + +/* S Like Memory Management */ + +extern void *R_chk_calloc(R_SIZE_T, R_SIZE_T); +extern void *R_chk_realloc(void *, R_SIZE_T); +extern void R_chk_free(void *); + +#ifndef STRICT_R_HEADERS +/* S-PLUS 3.x but not 5.x NULLs the pointer in the following */ +#define Calloc(n, t) (t *) R_chk_calloc( (R_SIZE_T) (n), sizeof(t) ) +#define Realloc(p,n,t) (t *) R_chk_realloc( (void *)(p), (R_SIZE_T)((n) * sizeof(t)) ) +#define Free(p) (R_chk_free( (void *)(p) ), (p) = NULL) +#endif +#define R_Calloc(n, t) (t *) R_chk_calloc( (R_SIZE_T) (n), sizeof(t) ) +#define R_Realloc(p,n,t) (t *) R_chk_realloc( (void *)(p), (R_SIZE_T)((n) * sizeof(t)) ) +#define R_Free(p) (R_chk_free( (void *)(p) ), (p) = NULL) + +#define Memcpy(p,q,n) memcpy( p, q, (R_SIZE_T)(n) * sizeof(*p) ) + +/* added for 3.0.0 */ +#define Memzero(p,n) memset(p, 0, (R_SIZE_T)(n) * sizeof(*p)) + +#define CallocCharBuf(n) (char *) R_chk_calloc((R_SIZE_T) ((n)+1), sizeof(char)) + +/* S Like Fortran Interface */ +/* These may not be adequate everywhere. Convex had _ prepending common + blocks, and some compilers may need to specify Fortran linkage */ + +#ifdef HAVE_F77_UNDERSCORE +# define F77_CALL(x) x ## _ +#else +# define F77_CALL(x) x +#endif +#define F77_NAME(x) F77_CALL(x) +#define F77_SUB(x) F77_CALL(x) +#define F77_COM(x) F77_CALL(x) +#define F77_COMDECL(x) F77_CALL(x) + +#ifndef NO_CALL_R +void call_R(char*, long, void**, char**, long*, char**, long, char**); +#endif + +#ifdef __cplusplus +} +#endif + +#endif /* R_RS_H */ diff --git a/com.oracle.truffle.r.native/gnur/patch/src/include/R_ext/RStartup.h b/com.oracle.truffle.r.native/gnur/patch/src/include/R_ext/RStartup.h new file mode 100644 index 0000000000000000000000000000000000000000..d0ac7c02bde29ae7084fb6ce654f5d7f17cfe37c --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/include/R_ext/RStartup.h @@ -0,0 +1,115 @@ +/* + * R : A Computer Language for Statistical Data Analysis + * Copyright (C) 1999-2016 The R Core Team + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version. + * + * This program 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 this program; if not, a copy is available at + * https://www.R-project.org/Licenses/ + */ + +/* + C functions to be called from alternative front-ends. + + Part of the API for such front-ends but not for packages. +*/ + +#ifndef R_EXT_RSTARTUP_H_ +#define R_EXT_RSTARTUP_H_ + +#if defined(__cplusplus) && !defined(DO_NOT_USE_CXX_HEADERS) +# include <cstddef> +# define R_SIZE_T std::size_t +#else +# include <stddef.h> /* for size_t */ +# define R_SIZE_T size_t +#endif + +#include <R_ext/Boolean.h> /* TRUE/FALSE */ + +#ifdef __cplusplus +extern "C" { +#endif + +#ifdef Win32 +typedef int (*blah1) (const char *, char *, int, int); +typedef void (*blah2) (const char *, int); +typedef void (*blah3) (void); +typedef void (*blah4) (const char *); +/* Return value here is expected to be 1 for Yes, -1 for No and 0 for Cancel: + symbolic constants in graphapp.h */ +typedef int (*blah5) (const char *); +typedef void (*blah6) (int); +typedef void (*blah7) (const char *, int, int); +typedef enum {RGui, RTerm, LinkDLL} UImode; +#endif + +/* Startup Actions */ +typedef enum { + SA_NORESTORE,/* = 0 */ + SA_RESTORE, + SA_DEFAULT,/* was === SA_RESTORE */ + SA_NOSAVE, + SA_SAVE, + SA_SAVEASK, + SA_SUICIDE +} SA_TYPE; + +typedef struct +{ + Rboolean R_Quiet; + Rboolean R_Slave; + Rboolean R_Interactive; + Rboolean R_Verbose; + Rboolean LoadSiteFile; + Rboolean LoadInitFile; + Rboolean DebugInitFile; + SA_TYPE RestoreAction; + SA_TYPE SaveAction; + R_SIZE_T vsize; + R_SIZE_T nsize; + R_SIZE_T max_vsize; + R_SIZE_T max_nsize; + R_SIZE_T ppsize; + int NoRenviron; + +#ifdef Win32 + char *rhome; /* R_HOME */ + char *home; /* HOME */ + blah1 ReadConsole; + blah2 WriteConsole; + blah3 CallBack; + blah4 ShowMessage; + blah5 YesNoCancel; + blah6 Busy; + UImode CharacterMode; + blah7 WriteConsoleEx; /* used only if WriteConsole is NULL */ +#endif +} structRstart; + +typedef structRstart *Rstart; + +void R_DefParams(Rstart); +void R_SetParams(Rstart); +void R_SetWin32(Rstart); +void R_SizeFromEnv(Rstart); +void R_common_command_line(int *, char **, Rstart); + +void R_set_command_line_arguments(int argc, char **argv); + +void setup_Rmainloop(void); // also in Rembedded.h + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/com.oracle.truffle.r.native/gnur/patch/src/include/R_ext/Rallocators.h b/com.oracle.truffle.r.native/gnur/patch/src/include/R_ext/Rallocators.h new file mode 100644 index 0000000000000000000000000000000000000000..f1742cbda6508fc3679653163af997d468fb9040 --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/include/R_ext/Rallocators.h @@ -0,0 +1,54 @@ +/* + * R : A Computer Language for Statistical Data Analysis + * Copyright (C) 2014-2016 The R Core Team + * + * This header file is free software; you can redistribute it and/or modify + * it under the terms of the GNU Lesser General Public License as published by + * the Free Software Foundation; either version 2.1 of the License, or + * (at your option) any later version. + * + * This file is part of R. R is distributed under the terms of the + * GNU General Public License, either Version 2, June 1991 or Version 3, + * June 2007. See doc/COPYRIGHTS for details of the copyright status of R. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public License + * along with this program; if not, a copy is available at + * https://www.R-project.org/Licenses/ + * + * + * Definition of the R_allocator_t structure for custom allocators + * to be used with allocVector3() + */ + +#ifndef R_EXT_RALLOCATORS_H_ +#define R_EXT_RALLOCATORS_H_ + +#if defined(__cplusplus) && !defined(DO_NOT_USE_CXX_HEADERS) +# include <cstddef> +#else +# include <stddef.h> /* for size_t */ +#endif + +/* R_allocator_t typedef is also declared in Rinternals.h + so we guard against random inclusion order */ +#ifndef R_ALLOCATOR_TYPE +#define R_ALLOCATOR_TYPE +typedef struct R_allocator R_allocator_t; +#endif + +typedef void *(*custom_alloc_t)(R_allocator_t *allocator, size_t); +typedef void (*custom_free_t)(R_allocator_t *allocator, void *); + +struct R_allocator { + custom_alloc_t mem_alloc; /* malloc equivalent */ + custom_free_t mem_free; /* free equivalent */ + void *res; /* reserved (maybe for copy) - must be NULL */ + void *data; /* custom data for the allocator implementation */ +}; + +#endif /* R_EXT_RALLOCATORS_H_ */ diff --git a/com.oracle.truffle.r.native/gnur/patch/src/include/R_ext/Random.h b/com.oracle.truffle.r.native/gnur/patch/src/include/R_ext/Random.h new file mode 100644 index 0000000000000000000000000000000000000000..3b9ad461b1a7750deaef17d002d88bb5eb461334 --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/include/R_ext/Random.h @@ -0,0 +1,78 @@ +/* + * R : A Computer Language for Statistical Data Analysis + * Copyright (C) 1998-2016 The R Core Team + * + * This header file is free software; you can redistribute it and/or modify + * it under the terms of the GNU Lesser General Public License as published by + * the Free Software Foundation; either version 2.1 of the License, or + * (at your option) any later version. + * + * This file is part of R. R is distributed under the terms of the + * GNU General Public License, either Version 2, June 1991 or Version 3, + * June 2007. See doc/COPYRIGHTS for details of the copyright status of R. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public License + * along with this program; if not, a copy is available at + * https://www.R-project.org/Licenses/ + */ + +/* Included by R.h: API */ + +#ifndef R_RANDOM_H +#define R_RANDOM_H + +#include <R_ext/Boolean.h> + +#ifdef __cplusplus +extern "C" { +#endif + +typedef enum { + WICHMANN_HILL, + MARSAGLIA_MULTICARRY, + SUPER_DUPER, + MERSENNE_TWISTER, + KNUTH_TAOCP, + USER_UNIF, + KNUTH_TAOCP2, + LECUYER_CMRG +} RNGtype; + +/* Different kinds of "N(0,1)" generators :*/ +typedef enum { + BUGGY_KINDERMAN_RAMAGE, + AHRENS_DIETER, + BOX_MULLER, + USER_NORM, + INVERSION, + KINDERMAN_RAMAGE +} N01type; + + +void GetRNGstate(void); +void PutRNGstate(void); + +double unif_rand(void); +double R_unif_index(double); +/* These are also defined in Rmath.h */ +double norm_rand(void); +double exp_rand(void); + +typedef unsigned int Int32; +double * user_unif_rand(void); +void user_unif_init(Int32); +int * user_unif_nseed(void); +int * user_unif_seedloc(void); + +double * user_norm_rand(void); + +#ifdef __cplusplus +} +#endif + +#endif /* R_RANDOM_H */ diff --git a/com.oracle.truffle.r.native/gnur/patch/src/include/R_ext/Rdynload.h b/com.oracle.truffle.r.native/gnur/patch/src/include/R_ext/Rdynload.h new file mode 100644 index 0000000000000000000000000000000000000000..d60e0e5506390a606cc6d5a3931111f33a4a5154 --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/include/R_ext/Rdynload.h @@ -0,0 +1,114 @@ +/* + * R : A Computer Language for Statistical Data Analysis + * Copyright (C) 2001-2017 The R Core Team. + * + * This header file is free software; you can redistribute it and/or modify + * it under the terms of the GNU Lesser General Public License as published by + * the Free Software Foundation; either version 2.1 of the License, or + * (at your option) any later version. + * + * This file is part of R. R is distributed under the terms of the + * GNU General Public License, either Version 2, June 1991 or Version 3, + * June 2007. See doc/COPYRIGHTS for details of the copyright status of R. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public License + * along with this program; if not, a copy is available at + * https://www.R-project.org/Licenses/ + */ + +/* + C functions used to register compiled code in packages. + + Those needed for that purpose are part of the API. + + Cleaned up for R 3.4.0, some changes require recompilation of packages. + */ + +#ifndef R_EXT_DYNLOAD_H_ +#define R_EXT_DYNLOAD_H_ + +#include <R_ext/Boolean.h> + +/* called with a variable argument set */ +typedef void * (*DL_FUNC)(); + +typedef unsigned int R_NativePrimitiveArgType; + +/* For interfaces to objects created with as.single */ +#define SINGLESXP 302 + +/* + These are very similar to those in Rdynpriv.h, + but we maintain them separately to give us more freedom to do + some computations on the internal versions that are derived from + these definitions. +*/ +typedef struct { + const char *name; + DL_FUNC fun; + int numArgs; + R_NativePrimitiveArgType *types; +} R_CMethodDef; + +typedef R_CMethodDef R_FortranMethodDef; + + +typedef struct { + const char *name; + DL_FUNC fun; + int numArgs; +} R_CallMethodDef; + +typedef R_CallMethodDef R_ExternalMethodDef; + + +typedef struct _DllInfo DllInfo; + +/* + Currently ignore the graphics routines, accessible via .External.graphics() + and .Call.graphics(). + */ +#ifdef __cplusplus +extern "C" { +#endif +int R_registerRoutines(DllInfo *info, const R_CMethodDef * const croutines, + const R_CallMethodDef * const callRoutines, + const R_FortranMethodDef * const fortranRoutines, + const R_ExternalMethodDef * const externalRoutines); + +Rboolean R_useDynamicSymbols(DllInfo *info, Rboolean value); +Rboolean R_forceSymbols(DllInfo *info, Rboolean value); + +DllInfo *R_getDllInfo(const char *name); + +/* To be used by applications embedding R to register their symbols + that are not related to any dynamic module */ +DllInfo *R_getEmbeddingDllInfo(void); + +typedef struct Rf_RegisteredNativeSymbol R_RegisteredNativeSymbol; +typedef enum {R_ANY_SYM=0, R_C_SYM, R_CALL_SYM, R_FORTRAN_SYM, R_EXTERNAL_SYM} NativeSymbolType; + + +DL_FUNC R_FindSymbol(char const *, char const *, + R_RegisteredNativeSymbol *symbol); + + +/* Interface for exporting and importing functions from one package + for use from C code in a package. The registration part probably + ought to be integrated with the other registrations. The naming of + these routines may be less than ideal. +*/ + +void R_RegisterCCallable(const char *package, const char *name, DL_FUNC fptr); +DL_FUNC R_GetCCallable(const char *package, const char *name); + +#ifdef __cplusplus +} +#endif + +#endif /* R_EXT_DYNLOAD_H_ */ diff --git a/com.oracle.truffle.r.native/gnur/patch/src/include/R_ext/Riconv.h b/com.oracle.truffle.r.native/gnur/patch/src/include/R_ext/Riconv.h new file mode 100644 index 0000000000000000000000000000000000000000..74825367a68ca88729edf40a498776c0c7ebb900 --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/include/R_ext/Riconv.h @@ -0,0 +1,50 @@ +/* + * R : A Computer Language for Statistical Data Analysis + * Copyright (C) 2005 the R Core Team + * + * This header file is free software; you can redistribute it and/or modify + * it under the terms of the GNU Lesser General Public License as published by + * the Free Software Foundation; either version 2.1 of the License, or + * (at your option) any later version. + * + * This file is part of R. R is distributed under the terms of the + * GNU General Public License, either Version 2, June 1991 or Version 3, + * June 2007. See doc/COPYRIGHTS for details of the copyright status of R. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public License + * along with this program; if not, a copy is available at + * https://www.R-project.org/Licenses/ + */ + +/* + Interface to R's platform-independent implementation of iconv. + + Part of the API. +*/ + +#ifndef R_ICONV_H +#define R_ICONV_H + +#ifdef __cplusplus +extern "C" { +#endif + +/* from sysutils.c */ +#undef Riconv_open +#undef Riconv +#undef Riconv_close +void * Riconv_open (const char* tocode, const char* fromcode); +size_t Riconv (void * cd, const char **inbuf, size_t *inbytesleft, + char **outbuf, size_t *outbytesleft); +int Riconv_close (void * cd); + +#ifdef __cplusplus +} +#endif + +#endif /* R_ICONV_H */ diff --git a/com.oracle.truffle.r.native/gnur/patch/src/include/R_ext/Utils.h b/com.oracle.truffle.r.native/gnur/patch/src/include/R_ext/Utils.h new file mode 100644 index 0000000000000000000000000000000000000000..792bac350b4321e5de37b13a11b1e7a007db53ca --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/include/R_ext/Utils.h @@ -0,0 +1,123 @@ +/* + * R : A Computer Language for Statistical Data Analysis + * Copyright (C) 1998-2016 The R Core Team + * + * This header file is free software; you can redistribute it and/or modify + * it under the terms of the GNU Lesser General Public License as published by + * the Free Software Foundation; either version 2.1 of the License, or + * (at your option) any later version. + + * This file is part of R. R is distributed under the terms of the + * GNU General Public License, either Version 2, June 1991 or Version 3, + * June 2007. See doc/COPYRIGHTS for details of the copyright status of R. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public License + * along with this program; if not, a copy is available at + * https://www.R-project.org/Licenses/ + * + * + * Generally useful UTILITIES *NOT* relying on R internals (from Defn.h) + */ + +/* Included by R.h: API */ + +#ifndef R_EXT_UTILS_H_ +#define R_EXT_UTILS_H_ + +#include <R_ext/Boolean.h> +#include <R_ext/Complex.h> + +#if defined(__cplusplus) && !defined(DO_NOT_USE_CXX_HEADERS) +# include <cstddef> +# define R_SIZE_T std::size_t +#else +# include <stddef.h> +# define R_SIZE_T size_t +#endif + +#define revsort Rf_revsort +#define iPsort Rf_iPsort +#define rPsort Rf_rPsort +#define cPsort Rf_cPsort +#define IndexWidth Rf_IndexWidth +#define setIVector Rf_setIVector +#define setRVector Rf_setRVector +#define StringFalse Rf_StringFalse +#define StringTrue Rf_StringTrue +#define isBlankString Rf_isBlankString + +#ifdef __cplusplus +extern "C" { +#endif + +/* ../../main/sort.c : */ +void R_isort(int*, int); +void R_rsort(double*, int); +void R_csort(Rcomplex*, int); +void rsort_with_index(double *, int *, int); +void revsort(double*, int*, int);/* reverse; sort i[] alongside */ +void iPsort(int*, int, int); +void rPsort(double*, int, int); +void cPsort(Rcomplex*, int, int); + +/* ../../main/qsort.c : */ +/* dummy renamed to II to avoid problems with g++ on Solaris */ +void R_qsort (double *v, R_SIZE_T i, R_SIZE_T j); +void R_qsort_I (double *v, int *II, int i, int j); +void R_qsort_int (int *iv, R_SIZE_T i, R_SIZE_T j); +void R_qsort_int_I(int *iv, int *II, int i, int j); +#ifdef R_RS_H +void F77_NAME(qsort4)(double *v, int *indx, int *ii, int *jj); +void F77_NAME(qsort3)(double *v, int *ii, int *jj); +#endif + +/* ../../main/util.c and others : */ +const char *R_ExpandFileName(const char *); +void setIVector(int*, int, int); +void setRVector(double*, int, double); +Rboolean StringFalse(const char *); +Rboolean StringTrue(const char *); +Rboolean isBlankString(const char *); + +/* These two are guaranteed to use '.' as the decimal point, + and to accept "NA". + */ +double R_atof(const char *str); +double R_strtod(const char *c, char **end); + +char *R_tmpnam(const char *prefix, const char *tempdir); +char *R_tmpnam2(const char *prefix, const char *tempdir, const char *fileext); + +void R_CheckUserInterrupt(void); +void R_CheckStack(void); +void R_CheckStack2(R_SIZE_T); + + +/* ../../appl/interv.c: also in Applic.h */ +int findInterval(double *xt, int n, double x, + Rboolean rightmost_closed, Rboolean all_inside, int ilo, + int *mflag); +int findInterval2(double *xt, int n, double x, + Rboolean rightmost_closed, Rboolean all_inside, Rboolean left_open, + int ilo, int *mflag); +#ifdef R_RS_H +int F77_SUB(interv)(double *xt, int *n, double *x, + Rboolean *rightmost_closed, Rboolean *all_inside, + int *ilo, int *mflag); +#endif +void find_interv_vec(double *xt, int *n, double *x, int *nx, + int *rightmost_closed, int *all_inside, int *indx); + +/* ../../appl/maxcol.c: also in Applic.h */ +void R_max_col(double *matrix, int *nr, int *nc, int *maxes, int *ties_meth); + +#ifdef __cplusplus +} +#endif + +#endif /* R_EXT_UTILS_H_ */ diff --git a/com.oracle.truffle.r.native/gnur/patch/src/include/R_ext/Visibility.h b/com.oracle.truffle.r.native/gnur/patch/src/include/R_ext/Visibility.h new file mode 100644 index 0000000000000000000000000000000000000000..9bfaef4d767b9e2e3267a33acabe6d6939d3079a --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/include/R_ext/Visibility.h @@ -0,0 +1,43 @@ +/* + * R : A Computer Language for Statistical Data Analysis + * Copyright (C) 2008 the R Core Team + * + * This header file is free software; you can redistribute it and/or modify + * it under the terms of the GNU Lesser General Public License as published by + * the Free Software Foundation; either version 2.1 of the License, or + * (at your option) any later version. + * + * This file is part of R. R is distributed under the terms of the + * GNU General Public License, either Version 2, June 1991 or Version 3, + * June 2007. See doc/COPYRIGHTS for details of the copyright status of R. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public License + * along with this program; if not, a copy is available at + * https://www.R-project.org/Licenses/ + */ + +/* + Definitions controlling visibility on some platforms. + + Part of the API. +*/ + +#ifndef R_EXT_VISIBILITY_H_ +#define R_EXT_VISIBILITY_H_ + +#include <Rconfig.h> + +#ifdef HAVE_VISIBILITY_ATTRIBUTE +# define attribute_visible __attribute__ ((visibility ("default"))) +# define attribute_hidden __attribute__ ((visibility ("hidden"))) +#else +# define attribute_visible +# define attribute_hidden +#endif + +#endif /* R_EXT_VISIBILITY_H_ */ diff --git a/com.oracle.truffle.r.native/gnur/patch/src/include/R_ext/eventloop.h b/com.oracle.truffle.r.native/gnur/patch/src/include/R_ext/eventloop.h new file mode 100644 index 0000000000000000000000000000000000000000..951b422c5acac672ba53d9e702668a690245f000 --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/include/R_ext/eventloop.h @@ -0,0 +1,105 @@ +/* + * R : A Computer Language for Statistical Data Analysis + * Copyright (C) 2000-2016 The R Core Team. + * + * This header file is free software; you can redistribute it and/or modify + * it under the terms of the GNU Lesser General Public License as published by + * the Free Software Foundation; either version 2.1 of the License, or + * (at your option) any later version. + * + * This file is part of R. R is distributed under the terms of the + * GNU General Public License, either Version 2, June 1991 or Version 3, + * June 2007. See doc/COPYRIGHTS for details of the copyright status of R. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public License + * along with this program; if not, a copy is available at + * https://www.R-project.org/Licenses/ + */ + +/* + For use by alternative front-ends and packages which need to share + the R event loop (on Unix-alikes). + + Not part of the API and subject to change without notice. + + NB: HAVE_SYS_SELECT_H should be checked and defined before this is + included. + */ + +#ifndef R_EXT_EVENTLOOP_H +#define R_EXT_EVENTLOOP_H + +#ifdef HAVE_SYS_SELECT_H +# include <sys/select.h> /* for fd_set, select according to POSIX 2004 */ +#endif +#ifdef HAVE_SYS_TIME_H +# include <sys/time.h> /* ... according to earlier POSIX and perhaps HP-UX */ +#endif +/* NOTE: At one time needed on FreeBSD so that fd_set is defined. */ +#include <sys/types.h> + +#ifdef __cplusplus +extern "C" { +#endif + +#define XActivity 1 +#define StdinActivity 2 + +typedef void (*InputHandlerProc)(void *userData); + +typedef struct _InputHandler { + + int activity; + int fileDescriptor; + InputHandlerProc handler; + + struct _InputHandler *next; + + /* Whether we should be listening to this file descriptor or not. */ + int active; + + /* Data that can be passed to the routine as its only argument. + This might be a user-level function or closure when we implement + a callback to R mechanism. + */ + void *userData; + +} InputHandler; + + +extern InputHandler *initStdinHandler(void); +extern void consoleInputHandler(unsigned char *buf, int len); + +extern InputHandler *addInputHandler(InputHandler *handlers, int fd, InputHandlerProc handler, int activity); +extern InputHandler *getInputHandler(InputHandler *handlers, int fd); +extern int removeInputHandler(InputHandler **handlers, InputHandler *it); +extern InputHandler *getSelectedHandler(InputHandler *handlers, fd_set *mask); +extern fd_set *R_checkActivity(int usec, int ignore_stdin); +extern fd_set *R_checkActivityEx(int usec, int ignore_stdin, void (*intr)(void)); +extern void R_runHandlers(InputHandler *handlers, fd_set *mask); + +extern int R_SelectEx(int n, fd_set *readfds, fd_set *writefds, + fd_set *exceptfds, struct timeval *timeout, + void (*intr)(void)); + +#ifdef __SYSTEM__ +#ifndef __cplusplus /* Would get duplicate conflicting symbols*/ +InputHandler *R_InputHandlers; +#endif +#else +extern InputHandler *R_InputHandlers; +#endif + +extern void (* R_PolledEvents)(void); +extern int R_wait_usec; + +#ifdef __cplusplus +} +#endif + +#endif /* R_EXT_EVENTLOOP_H */ diff --git a/com.oracle.truffle.r.native/gnur/patch/src/include/R_ext/libextern.h b/com.oracle.truffle.r.native/gnur/patch/src/include/R_ext/libextern.h new file mode 100644 index 0000000000000000000000000000000000000000..fc3716e398e999694d4791263228657b486fe00f --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/include/R_ext/libextern.h @@ -0,0 +1,52 @@ +/* + * R : A Computer Language for Statistical Data Analysis + * Copyright (C) 2001, 2004 The R Core Team. + * + * This header file is free software; you can redistribute it and/or modify + * it under the terms of the GNU Lesser General Public License as published by + * the Free Software Foundation; either version 2.1 of the License, or + * (at your option) any later version. + * + * This file is part of R. R is distributed under the terms of the + * GNU General Public License, either Version 2, June 1991 or Version 3, + * June 2007. See doc/COPYRIGHTS for details of the copyright status of R. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public License + * along with this program; if not, a copy is available at + * https://www.R-project.org/Licenses/ + */ + +/* Included by R.h: API on Windows */ + +/* don't disallow including this one more than once */ + +/* This is intended to be called from other header files, so not callable + from C++ */ + +#undef LibExtern +#undef LibImport +#undef LibExport + +/* Don't try to include CYGWIN here: decorating some symbols breaks + the auto-export that it relies on, even if R_DLL_BUILD were set. */ +#ifdef _WIN32 /* _WIN32 as does not depend on config.h */ +#define LibImport __declspec(dllimport) +#define LibExport __declspec(dllexport) +#else +#define LibImport +#define LibExport +#endif + +#ifdef __MAIN__ +#define LibExtern LibExport +#define extern +#elif defined(R_DLL_BUILD) +#define LibExtern extern +#else +#define LibExtern extern LibImport +#endif diff --git a/com.oracle.truffle.r.native/gnur/patch/src/include/R_ext/stats_package.h b/com.oracle.truffle.r.native/gnur/patch/src/include/R_ext/stats_package.h new file mode 100644 index 0000000000000000000000000000000000000000..72f422715af1e19eaf901de9ee364815b107db17 --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/include/R_ext/stats_package.h @@ -0,0 +1,78 @@ +/* + * R : A Computer Language for Statistical Data Analysis + * Copyright (C) 2007 The R Core Team. + * + * This header file is free software; you can redistribute it and/or modify + * it under the terms of the GNU Lesser General Public License as published by + * the Free Software Foundation; either version 2.1 of the License, or + * (at your option) any later version. + * + * This file is part of R. R is distributed under the terms of the + * GNU General Public License, either Version 2, June 1991 or Version 3, + * June 2007. See doc/COPYRIGHTS for details of the copyright status of R. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public License + * along with this program; if not, a copy is available at + * https://www.R-project.org/Licenses/ + */ + +#ifndef R_STATS_PACKAGE_H +#define R_STATS_PACKAGE_H +#include <Rconfig.h> + +#ifdef HAVE_VISIBILITY_ATTRIBUTE +# define attribute_hidden __attribute__ ((visibility ("hidden"))) +#else +# define attribute_hidden +#endif + +enum AlgType {NREG = 1, OPT = 2}; + /* 0-based indices into v */ +enum VPos {F = 9, F0 = 12, FDIF = 10, G = 27, HC = 70}; + /* 0-based indices into iv */ +enum IVPos {AI = 90, AM = 94, ALGSAV = 50, COVMAT = 25, + COVPRT = 13, COVREQ = 14, DRADPR = 100, + DTYPE = 15, IERR = 74, INITH = 24, INITS = 24, + IPIVOT = 75, IVNEED = 2, LASTIV = 42, LASTV = 44, + LMAT = 41, MXFCAL = 16, MXITER = 17, NEXTV = 46, + NFCALL = 5, NFCOV = 51, NFGCAL = 6, NGCOV = 52, + NITER = 30, NVDFLT = 49, NVSAVE = 8, OUTLEV = 18, + PARPRT = 19, PARSAV = 48, PERM = 57, PRUNIT = 20, + QRTYP = 79, RDREQ = 56, RMAT = 77, SOLPRT = 21, + STATPR = 22, TOOBIG = 1, VNEED = 3, VSAVE = 59, + X0PRT = 23}; + +void attribute_hidden +S_Rf_divset(int alg, int iv[], int liv, int lv, double v[]); + +void attribute_hidden +S_nlsb_iterate(double b[], double d[], double dr[], int iv[], + int liv, int lv, int n, int nd, int p, + double r[], double rd[], double v[], double x[]); + +void attribute_hidden +S_nlminb_iterate(double b[], double d[], double fx, double g[], + double h[], int iv[], int liv, int lv, int n, + double v[], double x[]); + +void attribute_hidden +S_rcont2(int nrow[], int ncol[], int nrowt[], int ncolt[], + int ntotal[], double fact[], int jwork[], int matrix[]); + +static R_INLINE int S_v_length(int alg, int n) +{ + return (alg - 1) ? (105 + (n * (2 * n + 20))) : + (130 + (n * (n + 27))/2); +} + +static R_INLINE int S_iv_length(int alg, int n) +{ + return (alg - 1) ? (82 + 4 * n) : (78 + 3 * n); +} + +#endif /* R_STATS_PACKAGE_H */ diff --git a/com.oracle.truffle.r.native/gnur/patch/src/include/R_ext/stats_stubs.h b/com.oracle.truffle.r.native/gnur/patch/src/include/R_ext/stats_stubs.h new file mode 100644 index 0000000000000000000000000000000000000000..87efa36f09e7d6fe8cce3e19e94d9b3cfe5044dc --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/include/R_ext/stats_stubs.h @@ -0,0 +1,84 @@ +/* + * R : A Computer Language for Statistical Data Analysis + * Copyright (C) 2007 The R Core Team. + * + * This header file is free software; you can redistribute it and/or modify + * it under the terms of the GNU Lesser General Public License as published by + * the Free Software Foundation; either version 2.1 of the License, or + * (at your option) any later version. + * + * This file is part of R. R is distributed under the terms of the + * GNU General Public License, either Version 2, June 1991 or Version 3, + * June 2007. See doc/COPYRIGHTS for details of the copyright status of R. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public License + * along with this program; if not, a copy is available at + * https://www.R-project.org/Licenses/ + */ + +#include <Rconfig.h> +#include <Rinternals.h> +#include <R_ext/Rdynload.h> + +#ifdef HAVE_VISIBILITY_ATTRIBUTE +# define attribute_hidden __attribute__ ((visibility ("hidden"))) +#else +# define attribute_hidden +#endif + +void attribute_hidden +S_Rf_divset(int alg, int iv[], int liv, int lv, double v[]) +{ + static void(*fun)(int,int[],int,int,double[]) = NULL; + if (fun == NULL) + fun = (void(*)(int,int[],int,int,double[])) + R_GetCCallable("stats", "Rf_divset"); + fun(alg, iv, liv, lv, v); +} + +void attribute_hidden +S_nlminb_iterate(double b[], double d[], double fx, double g[], double h[], + int iv[], int liv, int lv, int n, double v[], double x[]) +{ + static void(*fun)(double[],double[],double,double[],double[], + int[],int,int,int,double[],double[]) = NULL; + if (fun == NULL) + fun = (void(*)(double[],double[],double,double[],double[], + int[],int,int,int,double[],double[])) + R_GetCCallable("stats", "nlminb_iterate"); + fun(b, d, fx, g, h, iv, liv, lv, n, v, x); +} + +void attribute_hidden +S_nlsb_iterate(double b[], double d[], double dr[], int iv[], int liv, + int lv, int n, int nd, int p, double r[], double rd[], + double v[], double x[]) +{ + static void(*fun)(double[],double[],double[],int[],int,int, + int,int,int,double[],double[],double[], + double[]) = NULL; + if (fun == NULL) + fun = (void(*)(double[],double[],double[],int[],int, + int, int,int,int,double[], + double[],double[],double[])) + R_GetCCallable("stats", "nlsb_iterate"); + fun(b, d, dr, iv, liv, lv, n, nd, p, r, rd, v, x); +} + +void attribute_hidden +S_rcont2(int nrow[], int ncol[], int nrowt[], int ncolt[], + int ntotal[], double fact[], int jwork[], int matrix[]) +{ + static void(*fun)(int[], int[], int[], int[], int[], double[], + int[], int[]) = NULL; + if (fun == NULL) + fun = (void(*)(int[], int[], int[], int[], int[], double[], + int[], int[])) + R_GetCCallable("stats", "rcont2"); + fun(nrow, ncol, nrowt, ncolt, ntotal, fact, jwork, matrix); +} diff --git a/com.oracle.truffle.r.native/gnur/patch/src/include/Rconnections.h b/com.oracle.truffle.r.native/gnur/patch/src/include/Rconnections.h new file mode 100644 index 0000000000000000000000000000000000000000..cac02a98c51baf2dc606a5263e501b5175cdf605 --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/include/Rconnections.h @@ -0,0 +1,84 @@ +/* + * R : A Computer Language for Statistical Data Analysis + * Copyright (C) 2000-2015 The R Core Team. + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version. + * + * This program 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 this program; if not, a copy is available at + * https://www.R-project.org/Licenses/ + */ + +/* Internal header, not installed */ + +#ifndef R_CONNECTIONS_H_ +#define R_CONNECTIONS_H_ + +/* the visible part of the connections */ +#include <R_ext/Connections.h> + +/* NB: this is a private header, and not installed. The internals of + connections are private and subject to change without notice. + A subset can be accessed using R_ext/Connections.h but read + the warning in that file for details. */ + +typedef enum {HTTPsh, FTPsh, HTTPSsh, FTPSsh} UrlScheme; + +/* used in internet module */ +typedef struct urlconn { + void *ctxt; + UrlScheme type; +} *Rurlconn; + +/* used in internet module */ +typedef struct sockconn { + int port; + int server; + int fd; + int timeout; + char *host; + char inbuf[4096], *pstart, *pend; +} *Rsockconn; + +/* used in X11 module */ +typedef struct clpconn { + char *buff; + int pos, len, last, sizeKB; + Rboolean warned; +} *Rclpconn; + +#define init_con Rf_init_con +#define con_pushback Rf_con_pushback + +int Rconn_fgetc(Rconnection con); +int Rconn_ungetc(int c, Rconnection con); +int Rconn_getline(Rconnection con, char *buf, int bufsize); +int Rconn_printf(Rconnection con, const char *format, ...); +Rconnection getConnection(int n); +Rconnection getConnection_no_err(int n); +Rboolean switch_stdout(int icon, int closeOnExit); +void init_con(Rconnection new, const char *description, int enc, + const char * const mode); +Rconnection R_newurl(const char *description, const char * const mode, int type); +Rconnection R_newsock(const char *host, int port, int server, const char * const mode, int timeout); +Rconnection in_R_newsock(const char *host, int port, int server, const char *const mode, int timeout); +Rconnection R_newunz(const char *description, const char * const mode); +int dummy_fgetc(Rconnection con); +int dummy_vfprintf(Rconnection con, const char *format, va_list ap); +int getActiveSink(int n); +void con_pushback(Rconnection con, Rboolean newLine, char *line); + +int Rsockselect(int nsock, int *insockfd, int *ready, int *write, double timeout); + +#define set_iconv Rf_set_iconv +void set_iconv(Rconnection con); +#endif + diff --git a/com.oracle.truffle.r.native/gnur/patch/src/include/Rdefines.h b/com.oracle.truffle.r.native/gnur/patch/src/include/Rdefines.h new file mode 100644 index 0000000000000000000000000000000000000000..712bcead4b5f9082ebbd8fdaef4274223303feaa --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/include/Rdefines.h @@ -0,0 +1,199 @@ +/* + * R : A Computer Language for Statistical Data Analysis + * Copyright (C) 1999-2016 The R Core Team. + * + * This header file is free software; you can redistribute it and/or modify + * it under the terms of the GNU Lesser General Public License as published by + * the Free Software Foundation; either version 2.1 of the License, or + * (at your option) any later version. + * + * This file is part of R. R is distributed under the terms of the + * GNU General Public License, either Version 2, June 1991 or Version 3, + * June 2007. See doc/COPYRIGHTS for details of the copyright status of R. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public License + * along with this program; if not, a copy is available at + * https://www.R-project.org/Licenses/ + */ + +/* From 'Writing R Extensions: + + 'these are not kept up to date and are not recommended for new projects.' + + As from R 3.3.0 they have been adjusted to work when R_NO_REMAP is defined. +*/ + +#ifndef R_DEFINES_H +#define R_DEFINES_H + +#if !defined(R_R_H) && !defined(R_S_H) +/* user forgot to include R.h or S.h */ +# include <R_ext/Memory.h> +# include <R_ext/RS.h> +#endif + +#include <Rinternals.h> + +/* + * Much is from John Chambers' "Programming With Data". + * Some of this is from Doug Bates. + * + * It is presented here to support a joint programming style which + * will work in both R and S. In particular it helps with: + * + * 1. S/R <-> CORBA code. + * 2. S/R <-> Java Code. + * + * And to hide some internal nastiness. + */ + + +/* + * Added some macros defined in S.h from Splus 5.1 + */ + +#define NULL_USER_OBJECT R_NilValue + +#define AS_LOGICAL(x) Rf_coerceVector(x,LGLSXP) +#define AS_INTEGER(x) Rf_coerceVector(x,INTSXP) +#define AS_NUMERIC(x) Rf_coerceVector(x,REALSXP) +#define AS_CHARACTER(x) Rf_coerceVector(x,STRSXP) +#define AS_COMPLEX(x) Rf_coerceVector(x,CPLXSXP) +#define AS_VECTOR(x) Rf_coerceVector(x,VECSXP) +#define AS_LIST(x) Rf_coerceVector(x,VECSXP) +#define AS_RAW(x) Rf_coerceVector(x,RAWSXP) + +#ifdef USE_RINTERNALS +// This is not documented to be supported, and may not be in future +# define IS_LOGICAL(x) isLogical(x) +# define IS_INTEGER(x) isInteger(x) +# define IS_NUMERIC(x) isReal(x) +# define IS_CHARACTER(x) isString(x) +# define IS_COMPLEX(x) isComplex(x) +#else +# define IS_LOGICAL(x) Rf_isLogical(x) +# define IS_INTEGER(x) Rf_isInteger(x) +# define IS_NUMERIC(x) Rf_isReal(x) +# define IS_CHARACTER(x) Rf_isString(x) +# define IS_COMPLEX(x) Rf_isComplex(x) +#endif +/* NB: is this right? It means atomic or VECSXP or EXPRSXP */ +#define IS_VECTOR(x) Rf_isVector(x) +/* And this cannot be right: isVectorList(x)? */ +#define IS_LIST(x) IS_VECTOR(x) +#define IS_RAW(x) (TYPEOF(x) == RAWSXP) + +#define NEW_LOGICAL(n) Rf_allocVector(LGLSXP,n) +#define NEW_INTEGER(n) Rf_allocVector(INTSXP,n) +#define NEW_NUMERIC(n) Rf_allocVector(REALSXP,n) +#define NEW_CHARACTER(n) Rf_allocVector(STRSXP,n) +#define NEW_COMPLEX(n) Rf_allocVector(CPLXSXP,n) +#define NEW_LIST(n) Rf_allocVector(VECSXP,n) +#define NEW_STRING(n) NEW_CHARACTER(n) +#define NEW_RAW(n) Rf_allocVector(RAWSXP,n) + +#define LOGICAL_POINTER(x) LOGICAL(x) +#define INTEGER_POINTER(x) INTEGER(x) +#define NUMERIC_POINTER(x) REAL(x) +#define CHARACTER_POINTER(x) STRING_PTR(x) +#define COMPLEX_POINTER(x) COMPLEX(x) +/* Use of VECTOR_PTR will fail unless USE_RINTERNALS is in use + This is probably unused. +*/ +#define LIST_POINTER(x) VECTOR_PTR(x) +#define RAW_POINTER(x) RAW(x) + +/* The following are not defined in `Programming with Data' but are + defined in S.h in Svr4 */ + +/* + * Note that LIST_DATA and RAW_DATA are missing. + * This is consistent with Svr4. + */ + +#define LOGICAL_DATA(x) (LOGICAL(x)) +#define INTEGER_DATA(x) (INTEGER(x)) +#define DOUBLE_DATA(x) (REAL(x)) +#define NUMERIC_DATA(x) (REAL(x)) +#define CHARACTER_DATA(x) (STRING_PTR(x)) +#define COMPLEX_DATA(x) (COMPLEX(x)) +/* Use of VECTOR_PTR will fail unless USE_RINTERNALS is in use + VECTOR_DATA seems unused, and RECURSIVE_DATA is used only in + the Expat part of XML. +*/ +#define RECURSIVE_DATA(x) (VECTOR_PTR(x)) +#define VECTOR_DATA(x) (VECTOR_PTR(x)) + +#define LOGICAL_VALUE(x) Rf_asLogical(x) +#define INTEGER_VALUE(x) Rf_asInteger(x) +#define NUMERIC_VALUE(x) Rf_asReal(x) +#define CHARACTER_VALUE(x) CHAR(Rf_asChar(x)) +#define STRING_VALUE(x) CHAR(Rf_asChar(x)) +#define LIST_VALUE(x) Rf_error("the 'value' of a list object is not defined") +#define RAW_VALUE(x) Rf_error("the 'value' of a raw object is not defined") + +#define SET_ELEMENT(x, i, val) SET_VECTOR_ELT(x, i, val) +#define GET_ATTR(x,what) Rf_getAttrib(x, what) +#define GET_CLASS(x) Rf_getAttrib(x, R_ClassSymbol) +#define GET_DIM(x) Rf_getAttrib(x, R_DimSymbol) +#define GET_DIMNAMES(x) Rf_getAttrib(x, R_DimNamesSymbol) +#define GET_COLNAMES(x) Rf_GetColNames(x) +#define GET_ROWNAMES(x) Rf_GetRowNames(x) +#define GET_LEVELS(x) Rf_getAttrib(x, R_LevelsSymbol) +#define GET_TSP(x) Rf_getAttrib(x, R_TspSymbol) +#define GET_NAMES(x) Rf_getAttrib(x, R_NamesSymbol) +#define SET_ATTR(x, what, n) Rf_setAttrib(x, what, n) +#define SET_CLASS(x, n) Rf_setAttrib(x, R_ClassSymbol, n) +#define SET_DIM(x, n) Rf_setAttrib(x, R_DimSymbol, n) +#define SET_DIMNAMES(x, n) Rf_setAttrib(x, R_DimNamesSymbol, n) +#define SET_LEVELS(x, l) Rf_setAttrib(x, R_LevelsSymbol, l) +#define SET_NAMES(x, n) Rf_setAttrib(x, R_NamesSymbol, n) +/* These do not support long vectors */ +#define GET_LENGTH(x) Rf_length(x) +#define SET_LENGTH(x, n) (x = Rf_lengthgets(x, n)) + +#define GET_SLOT(x, what) R_do_slot(x, what) +#define SET_SLOT(x, what, value) R_do_slot_assign(x, what, value) + +#define MAKE_CLASS(what) R_do_MAKE_CLASS(what) +/* NEW_OBJECT is recommended; NEW is for green book compatibility */ +#define NEW_OBJECT(class_def) R_do_new_object(class_def) +#define NEW(class_def) R_do_new_object(class_def) + +#define s_object SEXPREC +#define S_EVALUATOR /**/ + +/* These conflict with definitions in R_ext/Boolean.h, + but spatstat relies on them in a C file */ +#ifdef __cplusplus +# ifndef R_EXT_BOOLEAN_H_ +# ifndef TRUE +# define TRUE 1 +# endif +# ifndef FALSE +# define FALSE 0 +# endif +# endif +#else +# ifndef TRUE +# define TRUE 1 +# endif +# ifndef FALSE +# define FALSE 0 +# endif +#endif + +#define COPY_TO_USER_STRING(x) mkChar(x) +#define CREATE_STRING_VECTOR(x) mkChar(x) + +#define CREATE_FUNCTION_CALL(name, argList) createFunctionCall(name, argList) + +#define EVAL(x) eval(x,R_GlobalEnv) + + +#endif diff --git a/com.oracle.truffle.r.native/gnur/patch/src/include/Rdynpriv.h b/com.oracle.truffle.r.native/gnur/patch/src/include/Rdynpriv.h new file mode 100644 index 0000000000000000000000000000000000000000..2850296f13a3a2d7ace97c257a40124b1f6c7fc4 --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/include/Rdynpriv.h @@ -0,0 +1,196 @@ +/* + * R : A Computer Language for Statistical Data Analysis + * Copyright (C) 2001-2017 The R Core Team. + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version. + * + * This program 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 this program; if not, a copy is available at + * https://www.R-project.org/Licenses/ + */ + +#ifndef R_DYNPRIV_H +#define R_DYNPRIV_H + +/***************************************************** + These are internal routines and definitions subject + to unannounced changes. Do not use for packages, etc. + (The header is not installed.) + + There is a great deal of repetition in the definitions + of the user-level method definitions and in the internal + definition structures. This is done to ensure that we + don't get into troubles needing different types, etc. + We could do it with typedef's and reduce the code, but it + is done now and isn't too complicated yet. +*****************************************************/ + + +#ifdef Win32 +#include <windows.h> +#define CACHE_DLL_SYM 1 +#else +typedef void *HINSTANCE; +#endif + + +#include <Defn.h> +#include <R_ext/Rdynload.h> +int R_moduleCdynload(const char *module, int local, int now); + + /* + A name-routine pair. + */ +typedef struct { + char *name; + DL_FUNC func; +} CFunTabEntry; + + /* + These three structures are the processed, internal information about + native routines that can be called by R. They are intended to be + instantiated by packages that explicitly register the routines in the + library. + */ + +typedef struct { + char *name; + DL_FUNC fun; + int numArgs; + + R_NativePrimitiveArgType *types; +} Rf_DotCSymbol; + +typedef Rf_DotCSymbol Rf_DotFortranSymbol; + + +typedef struct { + char *name; + DL_FUNC fun; + int numArgs; +} Rf_DotCallSymbol; + +typedef Rf_DotCallSymbol Rf_DotExternalSymbol; + + + + /* + This structure holds the information about a library that is + loaded into R and whose symbols are directly accessible to + .C, .Call, .Fortran, .External, ... + This stores the short name of the library (with the path and extension + removed), and its fully qualified name including the path and extension. + Additionally, it can potentially be populated with information about + the native routines in that library that are callable by R. + */ +struct _DllInfo { + char *path; + char *name; + HINSTANCE handle; + Rboolean useDynamicLookup; /* Flag indicating whether we use both + registered and dynamic lookup (TRUE) + or just registered values if there + are any. */ + int numCSymbols; + Rf_DotCSymbol *CSymbols; + + int numCallSymbols; + Rf_DotCallSymbol *CallSymbols; + + int numFortranSymbols; + Rf_DotFortranSymbol *FortranSymbols; + + int numExternalSymbols; + Rf_DotExternalSymbol *ExternalSymbols; + + Rboolean forceSymbols; +}; + + +struct Rf_RegisteredNativeSymbol { + NativeSymbolType type; + union { + Rf_DotCSymbol *c; + Rf_DotCallSymbol *call; + Rf_DotFortranSymbol *fortran; + Rf_DotExternalSymbol *external; + } symbol; + DllInfo *dll; +}; + + + /* + An abstraction of the system-specific hooks that can be implemented + to customize the dynamic loading for a particular operating system + or application. + The function pointers implement + the opening and closing of the libraries, + the resolution of symbol, + returning error messages from system-level failures, + finding symbols in R itself, + handling the cached symbols, + processing the library path. + */ +typedef struct { + HINSTANCE (*loadLibrary)(const char *path, int asLocal, int now, + char const *search); + /* Load the dynamic library. */ + DL_FUNC (*dlsym)(DllInfo *info, char const *name); + /* Low-level symbol lookup in library */ + void (*closeLibrary)(HINSTANCE handle); + /* Unload the dynamic library from process. */ + void (*getError)(char *buf, int len); + /* Put the current system error in DLLerror. */ + + + void (*deleteCachedSymbols)(DllInfo *dll); /* Discard cached symbols */ + DL_FUNC (*lookupCachedSymbol)(const char *name, const char *pkg, int all); + + void (*fixPath)(char *path); + void (*getFullDLLPath)(SEXP call, char *buf, const char * const path); + +} OSDynSymbol; + +extern OSDynSymbol Rf_osDynSymbol, *R_osDynSymbol; + + +#ifdef CACHE_DLL_SYM + /* + The collection of cached symbol holders which are used to make the lookup + more efficient. The most recently resolved symbols are stored in this + pool if CACHE_DLL_SYM is defined and repeated lookups check here first, + before using the dynamic loader's lookup mechanism. + */ +typedef struct { + char pkg[21]; + char name[41]; + DL_FUNC func; +} R_CPFun; + +extern R_CPFun CPFun[]; +extern int nCPFun; + +#endif /* CACHE_DLL_SYM */ + + +DL_FUNC Rf_lookupCachedSymbol(const char *name, const char *pkg, int all); + +DL_FUNC R_dlsym(DllInfo *info, char const *name, + R_RegisteredNativeSymbol *symbol); + +/* Moved to API in R 3.4.0 + SEXP R_MakeExternalPtrFn(DL_FUNC p, SEXP tag, SEXP prot); + DL_FUNC R_ExternalPtrAddrFn(SEXP s); +*/ +DL_FUNC R_dotCallFn(SEXP, SEXP, int); +SEXP R_doDotCall(DL_FUNC, int, SEXP *, SEXP); + +#endif /* ifdef R_DYNPRIV_H */ diff --git a/com.oracle.truffle.r.native/gnur/patch/src/include/Rembedded.h b/com.oracle.truffle.r.native/gnur/patch/src/include/Rembedded.h new file mode 100644 index 0000000000000000000000000000000000000000..93fb8956b72580eec6f1beed4ce311ecd54aa39f --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/include/Rembedded.h @@ -0,0 +1,73 @@ +/* + * R : A Computer Language for Statistical Data Analysis + * Copyright (C) 2006-2016 The R Core Team. + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version. + * + * This program 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 this program; if not, a copy is available at + * https://www.R-project.org/Licenses/ + */ + +/* A header for use with alternative front-ends. Not formally part of + * the API so subject to change without notice. */ + +#ifndef REMBEDDED_H_ +#define REMBEDDED_H_ + +#include <R_ext/Boolean.h> + +#ifdef __cplusplus +extern "C" { +#endif + +extern int Rf_initEmbeddedR(int argc, char *argv[]); +extern void Rf_endEmbeddedR(int fatal); + +/* From here on down can be helpful in writing tailored startup and + termination code */ + +#ifndef LibExtern +# define LibExtern extern +#endif + +int Rf_initialize_R(int ac, char **av); +void setup_Rmainloop(void); +extern void R_ReplDLLinit(void); +extern int R_ReplDLLdo1(void); + +void R_setStartTime(void); +extern void R_RunExitFinalizers(void); +extern void CleanEd(void); +extern void Rf_KillAllDevices(void); +LibExtern int R_DirtyImage; +extern void R_CleanTempDir(void); +LibExtern char *R_TempDir; +extern void R_SaveGlobalEnv(void); + +#ifdef _WIN32 +extern char *getDLLVersion(void), *getRUser(void), *get_R_HOME(void); +extern void setup_term_ui(void); +LibExtern int UserBreak; +extern Rboolean AllDevicesKilled; +extern void editorcleanall(void); +extern int GA_initapp(int, char **); +extern void GA_appcleanup(void); +extern void readconsolecfg(void); +#else +void fpu_setup(Rboolean start); +#endif + +#ifdef __cplusplus +} +#endif + +#endif /* REMBEDDED_H_ */ diff --git a/com.oracle.truffle.r.native/gnur/patch/src/include/Rgraphics.h b/com.oracle.truffle.r.native/gnur/patch/src/include/Rgraphics.h new file mode 100644 index 0000000000000000000000000000000000000000..096ab27b92c4c1183f3102cba7604b0782acae3a --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/include/Rgraphics.h @@ -0,0 +1,281 @@ +/* + * R : A Computer Language for Statistical Data Analysis + * Copyright (C) 1995, 1996 Robert Gentleman and Ross Ihaka + * Copyright (C) 1998--2016 R Core Team + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU Lesser General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; if not, a copy is available at + * https://www.R-project.org/Licenses/ + */ + +#ifndef RGRAPHICS_H_ +#define RGRAPHICS_H_ + +/* Internal header, not installed */ + + /* possible coordinate systems (for specifying locations) */ +typedef enum { + DEVICE = 0, /* native device coordinates (rasters) */ + NDC = 1, /* normalised device coordinates x=(0,1), y=(0,1) */ + INCHES = 13, /* inches x=(0,width), y=(0,height) */ + NIC = 6, /* normalised inner region coordinates (0,1) */ + OMA1 = 2, /* outer margin 1 (bottom) x=NIC, y=LINES */ + OMA2 = 3, /* outer margin 2 (left) */ + OMA3 = 4, /* outer margin 3 (top) */ + OMA4 = 5, /* outer margin 4 (right) */ + NFC = 7, /* normalised figure region coordinates (0,1) */ + NPC = 16, /* normalised plot region coordinates (0,1) */ + USER = 12, /* user/data/world coordinates; + * x,=(xmin,xmax), y=(ymin,ymax) */ + MAR1 = 8, /* figure margin 1 (bottom) x=USER(x), y=LINES */ + MAR2 = 9, /* figure margin 2 (left) x=USER(y), y=LINES */ + MAR3 = 10, /* figure margin 3 (top) x=USER(x), y=LINES */ + MAR4 = 11, /* figure margin 4 (right) x=USER(y), y=LINES */ + + /* possible, units (for specifying dimensions) */ + /* all of the above, plus ... */ + + LINES = 14, /* multiples of a line in the margin (mex) */ + CHARS = 15 /* multiples of text height (cex) */ +} GUnit; + + +#define currentFigureLocation Rf_currentFigureLocation +#define GArrow Rf_GArrow +#define GBox Rf_GBox +#define GCheckState Rf_GCheckState +#define GCircle Rf_GCircle +#define GClip Rf_GClip +#define GClipPolygon Rf_GClipPolygon +#define GConvert Rf_GConvert +#define GConvertX Rf_GConvertX +#define GConvertXUnits Rf_GConvertXUnits +#define GConvertY Rf_GConvertY +#define GConvertYUnits Rf_GConvertYUnits +#define GExpressionHeight Rf_GExpressionHeight +#define GExpressionWidth Rf_GExpressionWidth +#define GForceClip Rf_GForceClip +#define GLine Rf_GLine +#define GLocator Rf_GLocator +#define GMapUnits Rf_GMapUnits +#define GMapWin2Fig Rf_GMapWin2Fig +#define GMathText Rf_GMathText +#define GMetricInfo Rf_GMetricInfo +#define GMMathText Rf_GMMathText +#define GMode Rf_GMode +#define GMtext Rf_GMtext +#define GNewPlot Rf_GNewPlot +#define GPath Rf_GPath +#define GPolygon Rf_GPolygon +#define GPolyline Rf_GPolyline +#define GPretty Rf_GPretty +#define GRect Rf_GRect +#define GRaster Rf_GRaster +#define GReset Rf_GReset +#define GRestore Rf_GRestore +#define GRestorePars Rf_GRestorePars +#define GSavePars Rf_GSavePars +#define GScale Rf_GScale +#define GSetState Rf_GSetState +#define GSetupAxis Rf_GSetupAxis +#define GStrHeight Rf_GStrHeight +#define GStrWidth Rf_GStrWidth +#define GSymbol Rf_GSymbol +#define GText Rf_GText +#define GVStrHeight Rf_GVStrHeight +#define GVStrWidth Rf_GVStrWidth +#define GVText Rf_GVText + +#define xDevtoNDC Rf_xDevtoNDC +#define xDevtoNFC Rf_xDevtoNFC +#define xDevtoNPC Rf_xDevtoNPC +#define xDevtoUsr Rf_xDevtoUsr +#define xNPCtoUsr Rf_xNPCtoUsr +#define yDevtoNDC Rf_yDevtoNDC +#define yDevtoNFC Rf_yDevtoNFC +#define yDevtoNPC Rf_yDevtoNPC +#define yDevtoUsr Rf_yDevtoUsr +#define yNPCtoUsr Rf_yNPCtoUsr + + +/*------------------------------------------------------------------- + * + * GPAR FUNCTIONS are concerned with operations on the + * entire set of graphics parameters for a device + * (e.g., initialisation, saving, and restoring) + * + * From graphics.c, used in plot.c. + */ + +/* Reset the current graphical parameters from the default ones: */ +void GRestore(pGEDevDesc); +/* Make a temporary copy of the current parameters */ +void GSavePars(pGEDevDesc); +/* Restore the temporary copy saved by GSavePars */ +void GRestorePars(pGEDevDesc); + + +/*------------------------------------------------------------------- + * + * DEVICE STATE FUNCTIONS are concerned with getting and setting + * the current state of the device; is it ready to be drawn into? + * + * From graphics.c, used in plot.c. + */ + +/* has plot.new been called yet? */ +void GCheckState(pGEDevDesc); +/* Set to 1 when plot.new succeeds + * Set to 0 when don't want drawing to go ahead */ +void GSetState(int, pGEDevDesc); + +/*------------------------------------------------------------------- + * + * GRAPHICAL PRIMITIVES are the generic front-end for the functions + * that every device driver must provide. + * + * NOTE that locations supplied to these functions may be in any + * of the valid coordinate systems (each function takes a "coords" + * parameter to indicate the coordinate system); the device-specific + * version of the function is responsible for calling GConvert to get + * the location into device coordinates. + * + * From graphics.c, used in plot.c. + */ + + +/* Draw a circle, centred on (x,y) with radius r (in inches). */ +void GCircle(double, double, int, double, int, int, pGEDevDesc); +/* Set clipping region (based on current setting of dd->gp.xpd). + * Only clip if new clipping region is different from the current one */ +void GClip(pGEDevDesc); +/* Polygon clipping: */ +int GClipPolygon(double *, double *, int, int, int, + double *, double *, pGEDevDesc); +/* Always clips */ +void GForceClip(pGEDevDesc); +/* Draw a line from (x1,y1) to (x2,y2): */ +void GLine(double, double, double, double, int, pGEDevDesc); +/* Return the location of the next mouse click: */ +Rboolean GLocator(double*, double*, int, pGEDevDesc); +/* Return the height, depth, and width of the specified + * character in the specified units: */ +void GMetricInfo(int, double*, double*, double*, GUnit, pGEDevDesc); +/* Set device "mode" (drawing or not drawing) here for windows and mac drivers. + */ +void GMode(int, pGEDevDesc); +/* Draw a path using the specified lists of x and y values: */ +void GPath(double*, double*, int, int*, Rboolean, int, int, pGEDevDesc); +/* Draw a polygon using the specified lists of x and y values: */ +void GPolygon(int, double*, double*, int, int, int, pGEDevDesc); +/* Draw series of straight lines using the specified lists of x and y values: */ +void GPolyline(int, double*, double*, int, pGEDevDesc); +/* Draw a rectangle given two opposite corners: */ +void GRect(double, double, double, double, int, int, int, pGEDevDesc); +/* Draw a raster image given two opposite corners: */ +void GRaster(unsigned int*, int, int, + double, double, double, double, + double, Rboolean, pGEDevDesc); +/* Return the height of the specified string in the specified units: */ +double GStrHeight(const char *, cetype_t, GUnit, pGEDevDesc); +/* Return the width of the specified string in the specified units */ +double GStrWidth(const char *, cetype_t, GUnit, pGEDevDesc); +/* Draw the specified text at location (x,y) with the specified + * rotation and justification: */ +void GText(double, double, int, const char *, cetype_t, double, double, double, + pGEDevDesc); + +/* From plotmath.c, used in plot.c */ +void GMathText(double, double, int, SEXP, double, double, double, pGEDevDesc); +void GMMathText(SEXP, int, double, int, double, int, double, pGEDevDesc); + + +/*------------------------------------------------------------------- + * + * GRAPHICAL UTILITIES are functions that produce graphical output + * using the graphical primitives (i.e., they are generic - NOT + * device-specific). + * + * From graphics.c, used in plot.c. + */ + +/* Draw a line from (x1,y1) to (x2,y2) with an arrow head + * at either or both ends. */ +void GArrow(double, double, double, double, int, double, double, int, pGEDevDesc); +/* Draw a box around specified region: + * 1=plot region, 2=figure region, 3=inner region, 4=device. */ +void GBox(int, pGEDevDesc); +/* Return a "nice" min, max and number of intervals for a given + * range on a linear or _log_ scale, respectively: */ +void GPretty(double*, double*, int*); /* used in plot3d.c */ +/* Draw text in margins. */ +void GMtext(const char *, cetype_t, int, double, int, double, int, double, pGEDevDesc); +/* Draw one of the predefined symbols (circle, square, diamond, ...) */ +void GSymbol(double, double, int, int, pGEDevDesc); + +/* From plotmath.c, used in plot.c */ +double GExpressionHeight(SEXP, GUnit, pGEDevDesc); +double GExpressionWidth(SEXP, GUnit, pGEDevDesc); + + + +/*---------------------------------------------------------------------- + * + * TRANSFORMATIONS are concerned with converting locations between + * coordinate systems and dimensions between different units. + * + * From graphics.c, used in par.c, plot.c, plot3d.c + */ + +/* Convert an R unit (e.g., "user") into an internal unit (e.g., USER)> */ +GUnit GMapUnits(int); +/* Convert a LOCATION from one coordinate system to another: */ +void GConvert(double*, double*, GUnit, GUnit, pGEDevDesc); +double GConvertX(double, GUnit, GUnit, pGEDevDesc); +double GConvertY(double, GUnit, GUnit, pGEDevDesc); +/* Convert an x/y-dimension from one set of units to another: */ +double GConvertXUnits(double, GUnit, GUnit, pGEDevDesc); +double GConvertYUnits(double, GUnit, GUnit, pGEDevDesc); + +/* Set up the different regions on a device (i.e., inner region, + * figure region, plot region) and transformations for associated + * coordinate systems (called whenever anything that affects the + * coordinate transformations changes): + */ +void GReset(pGEDevDesc); + +/* Set up the user coordinate transformations: */ +void GMapWin2Fig(pGEDevDesc); +/* Set up the device for a new plot by Resetting graphics parameters + * and Resetting the regions and coordinate Systems */ +pGEDevDesc GNewPlot(Rboolean); +/* Set up the user coordinates based on the axis limits */ +void GScale(double, double, int, pGEDevDesc); +/* Set up the axis limits based on the user coordinates */ +void GSetupAxis(int, pGEDevDesc); +/* Return row and column of current figure in the layout matrix */ +void currentFigureLocation(int*, int*, pGEDevDesc); + +/* which of these conversions should be public? maybe all? [NO_REMAP] */ +double xDevtoNDC(double, pGEDevDesc); +double yDevtoNDC(double, pGEDevDesc); +double xDevtoNFC(double, pGEDevDesc); +double yDevtoNFC(double, pGEDevDesc); +double xDevtoNPC(double, pGEDevDesc); +double yDevtoNPC(double, pGEDevDesc); +double xDevtoUsr(double, pGEDevDesc); +double yDevtoUsr(double, pGEDevDesc); +double xNPCtoUsr(double, pGEDevDesc); +double yNPCtoUsr(double, pGEDevDesc); + +#endif /* RGRAPHICS_H_ */ diff --git a/com.oracle.truffle.r.native/gnur/patch/src/include/Rinlinedfuns.h b/com.oracle.truffle.r.native/gnur/patch/src/include/Rinlinedfuns.h new file mode 100644 index 0000000000000000000000000000000000000000..c81aa998645bb448b89cce5a959fa6a49ae7ab97 --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/include/Rinlinedfuns.h @@ -0,0 +1,735 @@ +/* + * R : A Computer Language for Statistical Data Analysis + * Copyright (C) 1995, 1996 Robert Gentleman and Ross Ihaka + * Copyright (C) 1999-2015 The R Core Team. + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version. + * + * This program 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 this program; if not, a copy is available at + * https://www.R-project.org/Licenses/ + */ + +/* Internal header, not installed */ + +/* this header is always to be included from others. + It is only called if COMPILING_R is defined (in util.c) or + from GNU C systems. + + There are different conventions for inlining across compilation units. + See http://www.greenend.org.uk/rjk/2003/03/inline.html + */ +#ifndef R_INLINES_H_ +#define R_INLINES_H_ + +/* Probably not able to use C99 semantics in gcc < 4.3.0 */ +#if __GNUC__ == 4 && __GNUC_MINOR__ >= 3 && defined(__GNUC_STDC_INLINE__) && !defined(C99_INLINE_SEMANTICS) +#define C99_INLINE_SEMANTICS 1 +#endif + +/* Apple's gcc build >5400 (since Xcode 3.0) doesn't support GNU inline in C99 mode */ +#if __APPLE_CC__ > 5400 && !defined(C99_INLINE_SEMANTICS) && __STDC_VERSION__ >= 199901L +#define C99_INLINE_SEMANTICS 1 +#endif + +#ifdef COMPILING_R +/* defined only in inlined.c: this emits standalone code there */ +# define INLINE_FUN +#else +/* This section is normally only used for versions of gcc which do not + support C99 semantics. __GNUC_STDC_INLINE__ is defined if + GCC is following C99 inline semantics by default: we + switch R's usage to the older GNU semantics via attributes. + Do this even for __GNUC_GNUC_INLINE__ to shut up warnings in 4.2.x. + __GNUC_STDC_INLINE__ and __GNUC_GNU_INLINE__ were added in gcc 4.2.0. +*/ +# if defined(__GNUC_STDC_INLINE__) || defined(__GNUC_GNU_INLINE__) +# define INLINE_FUN extern __attribute__((gnu_inline)) inline +# else +# define INLINE_FUN extern R_INLINE +# endif +#endif /* ifdef COMPILING_R */ + +#if C99_INLINE_SEMANTICS +# undef INLINE_FUN +# ifdef COMPILING_R +/* force exported copy */ +# define INLINE_FUN extern inline +# else +/* either inline or link to extern version at compiler's choice */ +# define INLINE_FUN inline +# endif /* ifdef COMPILING_R */ +#endif /* C99_INLINE_SEMANTICS */ + + +#include <string.h> /* for strlen, strcmp */ + +/* define inline-able functions */ + +#ifdef INLINE_PROTECT +extern int R_PPStackSize; +extern int R_PPStackTop; +extern SEXP* R_PPStack; + +INLINE_FUN SEXP protect(SEXP s) +{ + if (R_PPStackTop < R_PPStackSize) + R_PPStack[R_PPStackTop++] = s; + else R_signal_protect_error(); + return s; +} + +INLINE_FUN void unprotect(int l) +{ +#ifdef PROTECT_PARANOID + if (R_PPStackTop >= l) + R_PPStackTop -= l; + else R_signal_unprotect_error(); +#else + R_PPStackTop -= l; +#endif +} + +INLINE_FUN void R_ProtectWithIndex(SEXP s, PROTECT_INDEX *pi) +{ + protect(s); + *pi = R_PPStackTop - 1; +} + +INLINE_FUN void R_Reprotect(SEXP s, PROTECT_INDEX i) +{ + if (i >= R_PPStackTop || i < 0) + R_signal_reprotect_error(i); + R_PPStack[i] = s; +} +#endif /* INLINE_PROTECT */ + +/* from dstruct.c */ + +/* length - length of objects */ + +int Rf_envlength(SEXP rho); + +/* TODO: a Length(.) {say} which is length() + dispatch (S3 + S4) if needed + for one approach, see do_seq_along() in ../main/seq.c +*/ +INLINE_FUN R_len_t length(SEXP s) +{ + switch (TYPEOF(s)) { + case NILSXP: + return 0; + case LGLSXP: + case INTSXP: + case REALSXP: + case CPLXSXP: + case STRSXP: + case CHARSXP: + case VECSXP: + case EXPRSXP: + case RAWSXP: + return LENGTH(s); + case LISTSXP: + case LANGSXP: + case DOTSXP: + { + int i = 0; + while (s != NULL && s != R_NilValue) { + i++; + s = CDR(s); + } + return i; + } + case ENVSXP: + return Rf_envlength(s); + default: + return 1; + } +} + +R_xlen_t Rf_envxlength(SEXP rho); + +INLINE_FUN R_xlen_t xlength(SEXP s) +{ + switch (TYPEOF(s)) { + case NILSXP: + return 0; + case LGLSXP: + case INTSXP: + case REALSXP: + case CPLXSXP: + case STRSXP: + case CHARSXP: + case VECSXP: + case EXPRSXP: + case RAWSXP: + return XLENGTH(s); + case LISTSXP: + case LANGSXP: + case DOTSXP: + { + // it is implausible this would be >= 2^31 elements, but allow it + R_xlen_t i = 0; + while (s != NULL && s != R_NilValue) { + i++; + s = CDR(s); + } + return i; + } + case ENVSXP: + return Rf_envxlength(s); + default: + return 1; + } +} + +/* regular allocVector() as a special case of allocVector3() with no custom allocator */ +INLINE_FUN SEXP allocVector(SEXPTYPE type, R_xlen_t length) +{ + return allocVector3(type, length, NULL); +} + +/* from list.c */ +/* Return a dotted pair with the given CAR and CDR. */ +/* The (R) TAG slot on the cell is set to NULL. */ + + +/* Get the i-th element of a list */ +INLINE_FUN SEXP elt(SEXP list, int i) +{ + int j; + SEXP result = list; + + if ((i < 0) || (i > length(list))) + return R_NilValue; + else + for (j = 0; j < i; j++) + result = CDR(result); + + return CAR(result); +} + + +/* Return the last element of a list */ +INLINE_FUN SEXP lastElt(SEXP list) +{ + SEXP result = R_NilValue; + while (list != R_NilValue) { + result = list; + list = CDR(list); + } + return result; +} + + +/* Shorthands for creating small lists */ + +INLINE_FUN SEXP list1(SEXP s) +{ + return CONS(s, R_NilValue); +} + + +INLINE_FUN SEXP list2(SEXP s, SEXP t) +{ + PROTECT(s); + s = CONS(s, list1(t)); + UNPROTECT(1); + return s; +} + + +INLINE_FUN SEXP list3(SEXP s, SEXP t, SEXP u) +{ + PROTECT(s); + s = CONS(s, list2(t, u)); + UNPROTECT(1); + return s; +} + + +INLINE_FUN SEXP list4(SEXP s, SEXP t, SEXP u, SEXP v) +{ + PROTECT(s); + s = CONS(s, list3(t, u, v)); + UNPROTECT(1); + return s; +} + +INLINE_FUN SEXP list5(SEXP s, SEXP t, SEXP u, SEXP v, SEXP w) +{ + PROTECT(s); + s = CONS(s, list4(t, u, v, w)); + UNPROTECT(1); + return s; +} + +INLINE_FUN SEXP list6(SEXP s, SEXP t, SEXP u, SEXP v, SEXP w, SEXP x) +{ + PROTECT(s); + s = CONS(s, list5(t, u, v, w, x)); + UNPROTECT(1); + return s; +} + +/* Destructive list append : See also ``append'' */ + +INLINE_FUN SEXP listAppend(SEXP s, SEXP t) +{ + SEXP r; + if (s == R_NilValue) + return t; + r = s; + while (CDR(r) != R_NilValue) + r = CDR(r); + SETCDR(r, t); + return s; +} + + +/* Language based list constructs. These are identical to the list */ +/* constructs, but the results can be evaluated. */ + +/* Return a (language) dotted pair with the given car and cdr */ + +INLINE_FUN SEXP lcons(SEXP car, SEXP cdr) +{ + SEXP e = cons(car, cdr); + SET_TYPEOF(e, LANGSXP); + return e; +} + +INLINE_FUN SEXP lang1(SEXP s) +{ + return LCONS(s, R_NilValue); +} + +INLINE_FUN SEXP lang2(SEXP s, SEXP t) +{ + PROTECT(s); + s = LCONS(s, list1(t)); + UNPROTECT(1); + return s; +} + +INLINE_FUN SEXP lang3(SEXP s, SEXP t, SEXP u) +{ + PROTECT(s); + s = LCONS(s, list2(t, u)); + UNPROTECT(1); + return s; +} + +INLINE_FUN SEXP lang4(SEXP s, SEXP t, SEXP u, SEXP v) +{ + PROTECT(s); + s = LCONS(s, list3(t, u, v)); + UNPROTECT(1); + return s; +} + +INLINE_FUN SEXP lang5(SEXP s, SEXP t, SEXP u, SEXP v, SEXP w) +{ + PROTECT(s); + s = LCONS(s, list4(t, u, v, w)); + UNPROTECT(1); + return s; +} + +INLINE_FUN SEXP lang6(SEXP s, SEXP t, SEXP u, SEXP v, SEXP w, SEXP x) +{ + PROTECT(s); + s = LCONS(s, list5(t, u, v, w, x)); + UNPROTECT(1); + return s; +} + +/* from util.c */ + +/* Check to see if the arrays "x" and "y" have the identical extents */ + +INLINE_FUN Rboolean conformable(SEXP x, SEXP y) +{ + int i, n; + PROTECT(x = getAttrib(x, R_DimSymbol)); + y = getAttrib(y, R_DimSymbol); + UNPROTECT(1); + if ((n = length(x)) != length(y)) + return FALSE; + for (i = 0; i < n; i++) + if (INTEGER(x)[i] != INTEGER(y)[i]) + return FALSE; + return TRUE; +} + +/* NOTE: R's inherits() is based on inherits3() in ../main/objects.c + * Here, use char / CHAR() instead of the slower more general translateChar() + */ +INLINE_FUN Rboolean inherits(SEXP s, const char *name) +{ + SEXP klass; + int i, nclass; + if (OBJECT(s)) { + klass = getAttrib(s, R_ClassSymbol); + nclass = length(klass); + for (i = 0; i < nclass; i++) { + if (!strcmp(CHAR(STRING_ELT(klass, i)), name)) + return TRUE; + } + } + return FALSE; +} + +INLINE_FUN Rboolean isValidString(SEXP x) +{ + return TYPEOF(x) == STRSXP && LENGTH(x) > 0 && TYPEOF(STRING_ELT(x, 0)) != NILSXP; +} + +/* non-empty ("") valid string :*/ +INLINE_FUN Rboolean isValidStringF(SEXP x) +{ + return isValidString(x) && CHAR(STRING_ELT(x, 0))[0]; +} + +INLINE_FUN Rboolean isUserBinop(SEXP s) +{ + if (TYPEOF(s) == SYMSXP) { + const char *str = CHAR(PRINTNAME(s)); + if (strlen(str) >= 2 && str[0] == '%' && str[strlen(str)-1] == '%') + return TRUE; + } + return FALSE; +} + +INLINE_FUN Rboolean isFunction(SEXP s) +{ + return (TYPEOF(s) == CLOSXP || + TYPEOF(s) == BUILTINSXP || + TYPEOF(s) == SPECIALSXP); +} + +INLINE_FUN Rboolean isPrimitive(SEXP s) +{ + return (TYPEOF(s) == BUILTINSXP || + TYPEOF(s) == SPECIALSXP); +} + +INLINE_FUN Rboolean isList(SEXP s) +{ + return (s == R_NilValue || TYPEOF(s) == LISTSXP); +} + + +INLINE_FUN Rboolean isNewList(SEXP s) +{ + return (s == R_NilValue || TYPEOF(s) == VECSXP); +} + +INLINE_FUN Rboolean isPairList(SEXP s) +{ + switch (TYPEOF(s)) { + case NILSXP: + case LISTSXP: + case LANGSXP: + case DOTSXP: + return TRUE; + default: + return FALSE; + } +} + +INLINE_FUN Rboolean isVectorList(SEXP s) +{ + switch (TYPEOF(s)) { + case VECSXP: + case EXPRSXP: + return TRUE; + default: + return FALSE; + } +} + +INLINE_FUN Rboolean isVectorAtomic(SEXP s) +{ + switch (TYPEOF(s)) { + case LGLSXP: + case INTSXP: + case REALSXP: + case CPLXSXP: + case STRSXP: + case RAWSXP: + return TRUE; + default: /* including NULL */ + return FALSE; + } +} + +INLINE_FUN Rboolean isVector(SEXP s)/* === isVectorList() or isVectorAtomic() */ +{ + switch(TYPEOF(s)) { + case LGLSXP: + case INTSXP: + case REALSXP: + case CPLXSXP: + case STRSXP: + case RAWSXP: + + case VECSXP: + case EXPRSXP: + return TRUE; + default: + return FALSE; + } +} + +INLINE_FUN Rboolean isFrame(SEXP s) +{ + SEXP klass; + int i; + if (OBJECT(s)) { + klass = getAttrib(s, R_ClassSymbol); + for (i = 0; i < length(klass); i++) + if (!strcmp(CHAR(STRING_ELT(klass, i)), "data.frame")) return TRUE; + } + return FALSE; +} + +INLINE_FUN Rboolean isLanguage(SEXP s) +{ + return (s == R_NilValue || TYPEOF(s) == LANGSXP); +} + +INLINE_FUN Rboolean isMatrix(SEXP s) +{ + SEXP t; + if (isVector(s)) { + t = getAttrib(s, R_DimSymbol); + /* You are not supposed to be able to assign a non-integer dim, + although this might be possible by misuse of ATTRIB. */ + if (TYPEOF(t) == INTSXP && LENGTH(t) == 2) + return TRUE; + } + return FALSE; +} + +INLINE_FUN Rboolean isArray(SEXP s) +{ + SEXP t; + if (isVector(s)) { + t = getAttrib(s, R_DimSymbol); + /* You are not supposed to be able to assign a 0-length dim, + nor a non-integer dim */ + if (TYPEOF(t) == INTSXP && LENGTH(t) > 0) + return TRUE; + } + return FALSE; +} + +INLINE_FUN Rboolean isTs(SEXP s) +{ + return (isVector(s) && getAttrib(s, R_TspSymbol) != R_NilValue); +} + + +INLINE_FUN Rboolean isInteger(SEXP s) +{ + return (TYPEOF(s) == INTSXP && !inherits(s, "factor")); +} + +INLINE_FUN Rboolean isFactor(SEXP s) +{ + return (TYPEOF(s) == INTSXP && inherits(s, "factor")); +} + +INLINE_FUN int nlevels(SEXP f) +{ + if (!isFactor(f)) + return 0; + return LENGTH(getAttrib(f, R_LevelsSymbol)); +} + +/* Is an object of numeric type. */ +/* FIXME: the LGLSXP case should be excluded here + * (really? in many places we affirm they are treated like INTs)*/ + +INLINE_FUN Rboolean isNumeric(SEXP s) +{ + switch(TYPEOF(s)) { + case INTSXP: + if (inherits(s,"factor")) return FALSE; + case LGLSXP: + case REALSXP: + return TRUE; + default: + return FALSE; + } +} + +/** Is an object "Numeric" or complex */ +INLINE_FUN Rboolean isNumber(SEXP s) +{ + switch(TYPEOF(s)) { + case INTSXP: + if (inherits(s,"factor")) return FALSE; + case LGLSXP: + case REALSXP: + case CPLXSXP: + return TRUE; + default: + return FALSE; + } +} + +/* As from R 2.4.0 we check that the value is allowed. */ +INLINE_FUN SEXP ScalarLogical(int x) +{ + extern SEXP R_LogicalNAValue, R_TrueValue, R_FalseValue; + if (x == NA_LOGICAL) return R_LogicalNAValue; + else if (x != 0) return R_TrueValue; + else return R_FalseValue; +} + +INLINE_FUN SEXP ScalarInteger(int x) +{ + SEXP ans = allocVector(INTSXP, (R_xlen_t)1); + INTEGER(ans)[0] = x; + return ans; +} + +INLINE_FUN SEXP ScalarReal(double x) +{ + SEXP ans = allocVector(REALSXP, (R_xlen_t)1); + REAL(ans)[0] = x; + return ans; +} + + +INLINE_FUN SEXP ScalarComplex(Rcomplex x) +{ + SEXP ans = allocVector(CPLXSXP, (R_xlen_t)1); + COMPLEX(ans)[0] = x; + return ans; +} + +INLINE_FUN SEXP ScalarString(SEXP x) +{ + SEXP ans; + PROTECT(x); + ans = allocVector(STRSXP, (R_xlen_t)1); + SET_STRING_ELT(ans, (R_xlen_t)0, x); + UNPROTECT(1); + return ans; +} + +INLINE_FUN SEXP ScalarRaw(Rbyte x) +{ + SEXP ans = allocVector(RAWSXP, (R_xlen_t)1); + RAW(ans)[0] = x; + return ans; +} + +/* Check to see if a list can be made into a vector. */ +/* it must have every element being a vector of length 1. */ +/* BUT it does not exclude 0! */ + +INLINE_FUN Rboolean isVectorizable(SEXP s) +{ + if (s == R_NilValue) return TRUE; + else if (isNewList(s)) { + R_xlen_t i, n; + + n = XLENGTH(s); + for (i = 0 ; i < n; i++) + if (!isVector(VECTOR_ELT(s, i)) || XLENGTH(VECTOR_ELT(s, i)) > 1) + return FALSE; + return TRUE; + } + else if (isList(s)) { + for ( ; s != R_NilValue; s = CDR(s)) + if (!isVector(CAR(s)) || LENGTH(CAR(s)) > 1) return FALSE; + return TRUE; + } + else return FALSE; +} + + +/** + * Create a named vector of type TYP + * + * @example const char *nms[] = {"xi", "yi", "zi", ""}; + * mkNamed(VECSXP, nms); =~= R list(xi=, yi=, zi=) + * + * @param TYP a vector SEXP type (e.g. REALSXP) + * @param names names of list elements with null string appended + * + * @return (pointer to a) named vector of type TYP + */ +INLINE_FUN SEXP mkNamed(SEXPTYPE TYP, const char **names) +{ + SEXP ans, nms; + R_xlen_t i, n; + + for (n = 0; strlen(names[n]) > 0; n++) {} + ans = PROTECT(allocVector(TYP, n)); + nms = PROTECT(allocVector(STRSXP, n)); + for (i = 0; i < n; i++) + SET_STRING_ELT(nms, i, mkChar(names[i])); + setAttrib(ans, R_NamesSymbol, nms); + UNPROTECT(2); + return ans; +} + +/* from gram.y */ + +/* short cut for ScalarString(mkChar(s)) : */ +INLINE_FUN SEXP mkString(const char *s) +{ + SEXP t; + + PROTECT(t = allocVector(STRSXP, (R_xlen_t)1)); + SET_STRING_ELT(t, (R_xlen_t)0, mkChar(s)); + UNPROTECT(1); + return t; +} + +/* index of a given C string in (translated) R string vector */ +INLINE_FUN int +stringPositionTr(SEXP string, const char *translatedElement) { + + int slen = LENGTH(string); + int i; + + const void *vmax = vmaxget(); + for (i = 0 ; i < slen; i++) { + Rboolean found = ! strcmp(translateChar(STRING_ELT(string, i)), + translatedElement); + vmaxset(vmax); + if (found) + return i; + } + return -1; /* not found */ +} + +/* duplicate RHS value of complex assignment if necessary to prevent cycles */ +INLINE_FUN SEXP R_FixupRHS(SEXP x, SEXP y) +{ + if( y != R_NilValue && MAYBE_REFERENCED(y) ) { + if (R_cycle_detected(x, y)) { +#ifdef WARNING_ON_CYCLE_DETECT + warning("cycle detected"); + R_cycle_detected(x, y); +#endif + y = duplicate(y); + } + else if (NAMED(y) < 2) SET_NAMED(y, 2); + } + return y; +} +#endif /* R_INLINES_H_ */ diff --git a/com.oracle.truffle.r.native/gnur/patch/src/include/Rinterface.h b/com.oracle.truffle.r.native/gnur/patch/src/include/Rinterface.h new file mode 100644 index 0000000000000000000000000000000000000000..1f0df078b3e949a7936b89ccc1099568ade7d9bd --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/include/Rinterface.h @@ -0,0 +1,176 @@ +/* + * R : A Computer Language for Statistical Data Analysis + * Copyright (C) 1995, 1996 Robert Gentleman and Ross Ihaka + * Copyright (C) 1998--2017 The R Core Team. + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version. + * + * This program 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 this program; if not, a copy is available at + * https://www.R-project.org/Licenses/ + */ + +/* This header file is to provide hooks for alternative front-ends, + e.g. GUIs such as GNOME and Cocoa. It is only used on Unix-alikes. + All entries here should be documented in doc/manual/R-exts.texi. + + It should not be included by package sources unless they are + providing such a front-end. + + If CSTACK_DEFNS is defined, also define HAVE_UINTPTR_T (if true) + before including this, perhaps by including Rconfig.h from C code + (for C++ you need to test the C++ compiler in use). +*/ + +#ifndef RINTERFACE_H_ +#define RINTERFACE_H_ + +#include <R_ext/Boolean.h> + +#ifdef __cplusplus +/* we do not support DO_NOT_USE_CXX_HEADERS in this file */ +# include <cstdio> +extern "C" { +#else +# include <stdio.h> +#endif + +#if defined(__GNUC__) && __GNUC__ >= 3 +# define NORET __attribute__((noreturn)) +#else +# define NORET +#endif + +/* from Defn.h */ +/* this duplication will be removed in due course */ + +extern Rboolean R_Interactive; /* TRUE during interactive use*/ +extern Rboolean R_Slave; /* Run as a slave process */ + +extern void R_RestoreGlobalEnv(void); +extern void R_RestoreGlobalEnvFromFile(const char *, Rboolean); +extern void R_SaveGlobalEnv(void); +extern void R_SaveGlobalEnvToFile(const char *); +extern void R_FlushConsole(void); +extern void R_ClearerrConsole(void); +extern void R_Suicide(const char *); +extern char *R_HomeDir(void); +extern int R_DirtyImage; /* Current image dirty */ +extern char *R_GUIType; +extern void R_setupHistory(void); +extern char *R_HistoryFile; /* Name of the history file */ +extern int R_HistorySize; /* Size of the history file */ +extern int R_RestoreHistory; /* restore the history file? */ +extern char *R_Home; /* Root of the R tree */ + +# define jump_to_toplevel Rf_jump_to_toplevel +# define mainloop Rf_mainloop +# define onintr Rf_onintr +# define onintrNoResume Rf_onintrNoResume +void NORET jump_to_toplevel(void); +void mainloop(void); +void onintr(void); +void onintrNoResume(void); +#ifndef DEFN_H_ +extern void* R_GlobalContext; /* Need opaque pointer type for export */ +#endif + +void process_site_Renviron(void); +void process_system_Renviron(void); +void process_user_Renviron(void); + +#ifdef __cplusplus +extern std::FILE * R_Consolefile; +extern std::FILE * R_Outputfile; +#else +extern FILE * R_Consolefile; +extern FILE * R_Outputfile; +#endif + +/* in ../unix/sys-unix.c */ +void R_setStartTime(void); +void fpu_setup(Rboolean); + +/* in ../unix/system.c */ +extern int R_running_as_main_program; + +#ifdef CSTACK_DEFNS +/* duplicating older Defn.h. + Note: this is never used when including Rinterface.h from R itself +*/ +#if !defined(HAVE_UINTPTR_T) && !defined(uintptr_t) + typedef unsigned long uintptr_t; +#else +# ifndef __cplusplus +# include <stdint.h> +# elif __cplusplus >= 201103L +# include <cstdint> +# endif +#endif + +extern uintptr_t R_CStackLimit; /* C stack limit */ +extern uintptr_t R_CStackStart; /* Initial stack address */ +#endif + +/* formerly in src/unix/devUI.h */ + +#ifdef R_INTERFACE_PTRS +#include <Rinternals.h> // for SEXP +#include <R_ext/RStartup.h> // for SA_TYPE + +#ifdef __SYSTEM__ +# define extern +#endif + +extern void (*ptr_R_Suicide)(const char *); +extern void (*ptr_R_ShowMessage)(const char *); +extern int (*ptr_R_ReadConsole)(const char *, unsigned char *, int, int); +extern void (*ptr_R_WriteConsole)(const char *, int); +extern void (*ptr_R_WriteConsoleEx)(const char *, int, int); +extern void (*ptr_R_ResetConsole)(void); +extern void (*ptr_R_FlushConsole)(void); +extern void (*ptr_R_ClearerrConsole)(void); +extern void (*ptr_R_Busy)(int); +extern void (*ptr_R_CleanUp)(SA_TYPE, int, int); +extern int (*ptr_R_ShowFiles)(int, const char **, const char **, + const char *, Rboolean, const char *); +extern int (*ptr_R_ChooseFile)(int, char *, int); +extern int (*ptr_R_EditFile)(const char *); +extern void (*ptr_R_loadhistory)(SEXP, SEXP, SEXP, SEXP); +extern void (*ptr_R_savehistory)(SEXP, SEXP, SEXP, SEXP); +extern void (*ptr_R_addhistory)(SEXP, SEXP, SEXP, SEXP); + +// added in 3.0.0 +extern int (*ptr_R_EditFiles)(int, const char **, const char **, const char *); +// naming follows earlier versions in R.app +extern SEXP (*ptr_do_selectlist)(SEXP, SEXP, SEXP, SEXP); +extern SEXP (*ptr_do_dataentry)(SEXP, SEXP, SEXP, SEXP); +extern SEXP (*ptr_do_dataviewer)(SEXP, SEXP, SEXP, SEXP); +extern void (*ptr_R_ProcessEvents)(); + + +/* These two are not used by R itself, but are used by the tcltk package */ +extern int (*R_timeout_handler)(void); +extern long R_timeout_val; + +#endif /* R_INTERFACE_PTRS */ + +#ifdef __SYSTEM__ +# undef extern +#endif + +extern int R_SignalHandlers; + +#ifdef __cplusplus +} +#endif + +#endif /* RINTERFACE_H_ */ diff --git a/com.oracle.truffle.r.native/gnur/patch/src/include/Rinternals.h b/com.oracle.truffle.r.native/gnur/patch/src/include/Rinternals.h new file mode 100644 index 0000000000000000000000000000000000000000..27da70db0a2417ec38a104e78bba50ed66f7e691 --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/include/Rinternals.h @@ -0,0 +1,1464 @@ +/* + * R : A Computer Language for Statistical Data Analysis + * Copyright (C) 1995, 1996 Robert Gentleman and Ross Ihaka + * Copyright (C) 1999-2017 The R Core Team. + * + * This header file is free software; you can redistribute it and/or modify + * it under the terms of the GNU Lesser General Public License as published by + * the Free Software Foundation; either version 2.1 of the License, or + * (at your option) any later version. + * + * This file is part of R. R is distributed under the terms of the + * GNU General Public License, either Version 2, June 1991 or Version 3, + * June 2007. See doc/COPYRIGHTS for details of the copyright status of R. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public License + * along with this program; if not, a copy is available at + * https://www.R-project.org/Licenses/ + */ + +/* This file is installed and available to packages, but only a small + part of the contents is within the API. See chapter 6 of 'Writing + R Extensions'. + */ + +#ifndef R_INTERNALS_H_ +#define R_INTERNALS_H_ + +#ifdef __cplusplus +# include <cstdio> +# include <climits> +# include <cstddef> +extern "C" { +#else +# include <stdio.h> +# include <limits.h> /* for INT_MAX */ +# include <stddef.h> /* for ptrdiff_t, which is required by C99 */ +#endif + +#include <R_ext/Arith.h> +#include <R_ext/Boolean.h> +#include <R_ext/Complex.h> +#include <R_ext/Error.h> // includes NORET macro +#include <R_ext/Memory.h> +#include <R_ext/Utils.h> +#include <R_ext/Print.h> +#include <R_ext/Rdynload.h> // for DL_FUNC + +#include <R_ext/libextern.h> + +typedef unsigned char Rbyte; + +/* type for length of (standard, not long) vectors etc */ +typedef int R_len_t; +#define R_LEN_T_MAX INT_MAX + +/* both config.h and Rconfig.h set SIZEOF_SIZE_T, but Rconfig.h is + skipped if config.h has already been included. */ +#ifndef R_CONFIG_H +# include <Rconfig.h> +#endif + +#if ( SIZEOF_SIZE_T > 4 ) +# define LONG_VECTOR_SUPPORT +#endif + +#ifdef LONG_VECTOR_SUPPORT + typedef ptrdiff_t R_xlen_t; + typedef struct { R_xlen_t lv_length, lv_truelength; } R_long_vec_hdr_t; +# define R_XLEN_T_MAX 4503599627370496 +# define R_SHORT_LEN_MAX 2147483647 +# define R_LONG_VEC_TOKEN -1 +#else + typedef int R_xlen_t; +# define R_XLEN_T_MAX R_LEN_T_MAX +#endif + +#ifndef TESTING_WRITE_BARRIER +# define INLINE_PROTECT +#endif + +/* Fundamental Data Types: These are largely Lisp + * influenced structures, with the exception of LGLSXP, + * INTSXP, REALSXP, CPLXSXP and STRSXP which are the + * element types for S-like data objects. + * + * --> TypeTable[] in ../main/util.c for typeof() + */ + +/* UUID identifying the internals version -- packages using compiled + code should be re-installed when this changes */ +#define R_INTERNALS_UUID "0310d4b8-ccb1-4bb8-ba94-d36a55f60262" + +/* These exact numeric values are seldom used, but they are, e.g., in + * ../main/subassign.c, and they are serialized. +*/ +#ifndef enum_SEXPTYPE +/* NOT YET using enum: + * 1) The SEXPREC struct below has 'SEXPTYPE type : 5' + * (making FUNSXP and CLOSXP equivalent in there), + * giving (-Wall only ?) warnings all over the place + * 2) Many switch(type) { case ... } statements need a final `default:' + * added in order to avoid warnings like [e.g. l.170 of ../main/util.c] + * "enumeration value `FUNSXP' not handled in switch" + */ +typedef unsigned int SEXPTYPE; + +#define NILSXP 0 /* nil = NULL */ +#define SYMSXP 1 /* symbols */ +#define LISTSXP 2 /* lists of dotted pairs */ +#define CLOSXP 3 /* closures */ +#define ENVSXP 4 /* environments */ +#define PROMSXP 5 /* promises: [un]evaluated closure arguments */ +#define LANGSXP 6 /* language constructs (special lists) */ +#define SPECIALSXP 7 /* special forms */ +#define BUILTINSXP 8 /* builtin non-special forms */ +#define CHARSXP 9 /* "scalar" string type (internal only)*/ +#define LGLSXP 10 /* logical vectors */ +/* 11 and 12 were factors and ordered factors in the 1990s */ +#define INTSXP 13 /* integer vectors */ +#define REALSXP 14 /* real variables */ +#define CPLXSXP 15 /* complex variables */ +#define STRSXP 16 /* string vectors */ +#define DOTSXP 17 /* dot-dot-dot object */ +#define ANYSXP 18 /* make "any" args work. + Used in specifying types for symbol + registration to mean anything is okay */ +#define VECSXP 19 /* generic vectors */ +#define EXPRSXP 20 /* expressions vectors */ +#define BCODESXP 21 /* byte code */ +#define EXTPTRSXP 22 /* external pointer */ +#define WEAKREFSXP 23 /* weak reference */ +#define RAWSXP 24 /* raw bytes */ +#define S4SXP 25 /* S4, non-vector */ + +/* used for detecting PROTECT issues in memory.c */ +#define NEWSXP 30 /* fresh node created in new page */ +#define FREESXP 31 /* node released by GC */ + +#define FUNSXP 99 /* Closure or Builtin or Special */ + + +#else /* NOT YET */ +/*------ enum_SEXPTYPE ----- */ +typedef enum { + NILSXP = 0, /* nil = NULL */ + SYMSXP = 1, /* symbols */ + LISTSXP = 2, /* lists of dotted pairs */ + CLOSXP = 3, /* closures */ + ENVSXP = 4, /* environments */ + PROMSXP = 5, /* promises: [un]evaluated closure arguments */ + LANGSXP = 6, /* language constructs (special lists) */ + SPECIALSXP = 7, /* special forms */ + BUILTINSXP = 8, /* builtin non-special forms */ + CHARSXP = 9, /* "scalar" string type (internal only)*/ + LGLSXP = 10, /* logical vectors */ + INTSXP = 13, /* integer vectors */ + REALSXP = 14, /* real variables */ + CPLXSXP = 15, /* complex variables */ + STRSXP = 16, /* string vectors */ + DOTSXP = 17, /* dot-dot-dot object */ + ANYSXP = 18, /* make "any" args work */ + VECSXP = 19, /* generic vectors */ + EXPRSXP = 20, /* expressions vectors */ + BCODESXP = 21, /* byte code */ + EXTPTRSXP = 22, /* external pointer */ + WEAKREFSXP = 23, /* weak reference */ + RAWSXP = 24, /* raw bytes */ + S4SXP = 25, /* S4 non-vector */ + + NEWSXP = 30, /* fresh node creaed in new page */ + FREESXP = 31, /* node released by GC */ + + FUNSXP = 99 /* Closure or Builtin */ +} SEXPTYPE; +#endif + +/* These are also used with the write barrier on, in attrib.c and util.c */ +#define TYPE_BITS 5 +#define MAX_NUM_SEXPTYPE (1<<TYPE_BITS) + +// ======================= USE_RINTERNALS section +#ifdef USE_RINTERNALS +/* This is intended for use only within R itself. + * It defines internal structures that are otherwise only accessible + * via SEXP, and macros to replace many (but not all) of accessor functions + * (which are always defined). + */ + +/* Flags */ + + +struct sxpinfo_struct { + SEXPTYPE type : TYPE_BITS;/* ==> (FUNSXP == 99) %% 2^5 == 3 == CLOSXP + * -> warning: `type' is narrower than values + * of its type + * when SEXPTYPE was an enum */ + unsigned int obj : 1; + unsigned int named : 2; + unsigned int gp : 16; + unsigned int mark : 1; + unsigned int debug : 1; + unsigned int trace : 1; /* functions and memory tracing */ + unsigned int spare : 1; /* currently unused */ + unsigned int gcgen : 1; /* old generation number */ + unsigned int gccls : 3; /* node class */ +}; /* Tot: 32 */ + +struct vecsxp_struct { + R_len_t length; + R_len_t truelength; +}; + +struct primsxp_struct { + int offset; +}; + +struct symsxp_struct { + struct SEXPREC *pname; + struct SEXPREC *value; + struct SEXPREC *internal; +}; + +struct listsxp_struct { + struct SEXPREC *carval; + struct SEXPREC *cdrval; + struct SEXPREC *tagval; +}; + +struct envsxp_struct { + struct SEXPREC *frame; + struct SEXPREC *enclos; + struct SEXPREC *hashtab; +}; + +struct closxp_struct { + struct SEXPREC *formals; + struct SEXPREC *body; + struct SEXPREC *env; +}; + +struct promsxp_struct { + struct SEXPREC *value; + struct SEXPREC *expr; + struct SEXPREC *env; +}; + +/* Every node must start with a set of sxpinfo flags and an attribute + field. Under the generational collector these are followed by the + fields used to maintain the collector's linked list structures. */ + +/* Define SWITH_TO_REFCNT to use reference counting instead of the + 'NAMED' mechanism. This uses the R-devel binary layout. The two + 'named' field bits are used for the REFCNT, so REFCNTMAX is 3. */ +//#define SWITCH_TO_REFCNT + +#if defined(SWITCH_TO_REFCNT) && ! defined(COMPUTE_REFCNT_VALUES) +# define COMPUTE_REFCNT_VALUES +#endif +#define REFCNTMAX (4 - 1) + +#define SEXPREC_HEADER \ + struct sxpinfo_struct sxpinfo; \ + struct SEXPREC *attrib; \ + struct SEXPREC *gengc_next_node, *gengc_prev_node + +/* The standard node structure consists of a header followed by the + node data. */ +typedef struct SEXPREC { + SEXPREC_HEADER; + union { + struct primsxp_struct primsxp; + struct symsxp_struct symsxp; + struct listsxp_struct listsxp; + struct envsxp_struct envsxp; + struct closxp_struct closxp; + struct promsxp_struct promsxp; + } u; +} SEXPREC, *SEXP; + +/* The generational collector uses a reduced version of SEXPREC as a + header in vector nodes. The layout MUST be kept consistent with + the SEXPREC definition. The standard SEXPREC takes up 7 words on + most hardware; this reduced version should take up only 6 words. + In addition to slightly reducing memory use, this can lead to more + favorable data alignment on 32-bit architectures like the Intel + Pentium III where odd word alignment of doubles is allowed but much + less efficient than even word alignment. */ +typedef struct VECTOR_SEXPREC { + SEXPREC_HEADER; + struct vecsxp_struct vecsxp; +} VECTOR_SEXPREC, *VECSEXP; + +typedef union { VECTOR_SEXPREC s; double align; } SEXPREC_ALIGN; + +/* General Cons Cell Attributes */ +#define ATTRIB(x) ((x)->attrib) +#define OBJECT(x) ((x)->sxpinfo.obj) +#define MARK(x) ((x)->sxpinfo.mark) +#define TYPEOF(x) ((x)->sxpinfo.type) +#define NAMED(x) ((x)->sxpinfo.named) +#define RTRACE(x) ((x)->sxpinfo.trace) +#define LEVELS(x) ((x)->sxpinfo.gp) +#define SET_OBJECT(x,v) (((x)->sxpinfo.obj)=(v)) +#define SET_TYPEOF(x,v) (((x)->sxpinfo.type)=(v)) +#define SET_NAMED(x,v) (((x)->sxpinfo.named)=(v)) +#define SET_RTRACE(x,v) (((x)->sxpinfo.trace)=(v)) +#define SETLEVELS(x,v) (((x)->sxpinfo.gp)=((unsigned short)v)) + +#if defined(COMPUTE_REFCNT_VALUES) +# define REFCNT(x) ((x)->sxpinfo.named) +# define TRACKREFS(x) (TYPEOF(x) == CLOSXP ? TRUE : ! (x)->sxpinfo.spare) +#else +# define REFCNT(x) 0 +# define TRACKREFS(x) FALSE +#endif + +#ifdef SWITCH_TO_REFCNT +# undef NAMED +# undef SET_NAMED +# define NAMED(x) REFCNT(x) +# define SET_NAMED(x, v) do {} while (0) +#endif + +/* S4 object bit, set by R_do_new_object for all new() calls */ +#define S4_OBJECT_MASK ((unsigned short)(1<<4)) +#define IS_S4_OBJECT(x) ((x)->sxpinfo.gp & S4_OBJECT_MASK) +#define SET_S4_OBJECT(x) (((x)->sxpinfo.gp) |= S4_OBJECT_MASK) +#define UNSET_S4_OBJECT(x) (((x)->sxpinfo.gp) &= ~S4_OBJECT_MASK) + +/* JIT optimization support */ +#define NOJIT_MASK ((unsigned short)(1<<5)) +#define NOJIT(x) ((x)->sxpinfo.gp & NOJIT_MASK) +#define SET_NOJIT(x) (((x)->sxpinfo.gp) |= NOJIT_MASK) +#define MAYBEJIT_MASK ((unsigned short)(1<<6)) +#define MAYBEJIT(x) ((x)->sxpinfo.gp & MAYBEJIT_MASK) +#define SET_MAYBEJIT(x) (((x)->sxpinfo.gp) |= MAYBEJIT_MASK) +#define UNSET_MAYBEJIT(x) (((x)->sxpinfo.gp) &= ~MAYBEJIT_MASK) + +/* Growable vector support */ +#define GROWABLE_MASK ((unsigned short)(1<<5)) +#define GROWABLE_BIT_SET(x) ((x)->sxpinfo.gp & GROWABLE_MASK) +#define SET_GROWABLE_BIT(x) (((x)->sxpinfo.gp) |= GROWABLE_MASK) +#define IS_GROWABLE(x) (GROWABLE_BIT_SET(x) && XLENGTH(x) < XTRUELENGTH(x)) + +/* Vector Access Macros */ +#ifdef LONG_VECTOR_SUPPORT +# define IS_LONG_VEC(x) (SHORT_VEC_LENGTH(x) == R_LONG_VEC_TOKEN) +# define SHORT_VEC_LENGTH(x) (((VECSEXP) (x))->vecsxp.length) +# define SHORT_VEC_TRUELENGTH(x) (((VECSEXP) (x))->vecsxp.truelength) +# define LONG_VEC_LENGTH(x) ((R_long_vec_hdr_t *) (x))[-1].lv_length +# define LONG_VEC_TRUELENGTH(x) ((R_long_vec_hdr_t *) (x))[-1].lv_truelength +# define XLENGTH(x) (IS_LONG_VEC(x) ? LONG_VEC_LENGTH(x) : SHORT_VEC_LENGTH(x)) +# define XTRUELENGTH(x) (IS_LONG_VEC(x) ? LONG_VEC_TRUELENGTH(x) : SHORT_VEC_TRUELENGTH(x)) +# define LENGTH(x) (IS_LONG_VEC(x) ? R_BadLongVector(x, __FILE__, __LINE__) : SHORT_VEC_LENGTH(x)) +# define TRUELENGTH(x) (IS_LONG_VEC(x) ? R_BadLongVector(x, __FILE__, __LINE__) : SHORT_VEC_TRUELENGTH(x)) +# define SET_SHORT_VEC_LENGTH(x,v) (SHORT_VEC_LENGTH(x) = (v)) +# define SET_SHORT_VEC_TRUELENGTH(x,v) (SHORT_VEC_TRUELENGTH(x) = (v)) +# define SET_LONG_VEC_LENGTH(x,v) (LONG_VEC_LENGTH(x) = (v)) +# define SET_LONG_VEC_TRUELENGTH(x,v) (LONG_VEC_TRUELENGTH(x) = (v)) +# define SETLENGTH(x,v) do { \ + SEXP sl__x__ = (x); \ + R_xlen_t sl__v__ = (v); \ + if (IS_LONG_VEC(sl__x__)) \ + SET_LONG_VEC_LENGTH(sl__x__, sl__v__); \ + else SET_SHORT_VEC_LENGTH(sl__x__, (R_len_t) sl__v__); \ + } while (0) +# define SET_TRUELENGTH(x,v) do { \ + SEXP sl__x__ = (x); \ + R_xlen_t sl__v__ = (v); \ + if (IS_LONG_VEC(sl__x__)) \ + SET_LONG_VEC_TRUELENGTH(sl__x__, sl__v__); \ + else SET_SHORT_VEC_TRUELENGTH(sl__x__, (R_len_t) sl__v__); \ + } while (0) +# define IS_SCALAR(x, type) (TYPEOF(x) == (type) && SHORT_VEC_LENGTH(x) == 1) +#else +# define SHORT_VEC_LENGTH(x) (((VECSEXP) (x))->vecsxp.length) +# define LENGTH(x) (((VECSEXP) (x))->vecsxp.length) +# define TRUELENGTH(x) (((VECSEXP) (x))->vecsxp.truelength) +# define XLENGTH(x) LENGTH(x) +# define XTRUELENGTH(x) TRUELENGTH(x) +# define SETLENGTH(x,v) ((((VECSEXP) (x))->vecsxp.length)=(v)) +# define SET_TRUELENGTH(x,v) ((((VECSEXP) (x))->vecsxp.truelength)=(v)) +# define SET_SHORT_VEC_LENGTH SETLENGTH +# define SET_SHORT_VEC_TRUELENGTH SET_TRUELENGTH +# define IS_LONG_VEC(x) 0 +# define IS_SCALAR(x, type) (TYPEOF(x) == (type) && LENGTH(x) == 1) +#endif + +/* Under the generational allocator the data for vector nodes comes + immediately after the node structure, so the data address is a + known offset from the node SEXP. */ +#define DATAPTR(x) (((SEXPREC_ALIGN *) (x)) + 1) +#define CHAR(x) ((const char *) DATAPTR(x)) +#define LOGICAL(x) ((int *) DATAPTR(x)) +#define INTEGER(x) ((int *) DATAPTR(x)) +#define RAW(x) ((Rbyte *) DATAPTR(x)) +#define COMPLEX(x) ((Rcomplex *) DATAPTR(x)) +#define REAL(x) ((double *) DATAPTR(x)) +#define STRING_ELT(x,i) ((SEXP *) DATAPTR(x))[i] +#define VECTOR_ELT(x,i) ((SEXP *) DATAPTR(x))[i] +#define STRING_PTR(x) ((SEXP *) DATAPTR(x)) +#define VECTOR_PTR(x) ((SEXP *) DATAPTR(x)) + +/* List Access Macros */ +/* These also work for ... objects */ +#define LISTVAL(x) ((x)->u.listsxp) +#define TAG(e) ((e)->u.listsxp.tagval) +#define CAR(e) ((e)->u.listsxp.carval) +#define CDR(e) ((e)->u.listsxp.cdrval) +#define CAAR(e) CAR(CAR(e)) +#define CDAR(e) CDR(CAR(e)) +#define CADR(e) CAR(CDR(e)) +#define CDDR(e) CDR(CDR(e)) +#define CDDDR(e) CDR(CDR(CDR(e))) +#define CADDR(e) CAR(CDR(CDR(e))) +#define CADDDR(e) CAR(CDR(CDR(CDR(e)))) +#define CAD4R(e) CAR(CDR(CDR(CDR(CDR(e))))) +#define MISSING_MASK 15 /* reserve 4 bits--only 2 uses now */ +#define MISSING(x) ((x)->sxpinfo.gp & MISSING_MASK)/* for closure calls */ +#define SET_MISSING(x,v) do { \ + SEXP __x__ = (x); \ + int __v__ = (v); \ + int __other_flags__ = __x__->sxpinfo.gp & ~MISSING_MASK; \ + __x__->sxpinfo.gp = __other_flags__ | __v__; \ +} while (0) + +/* Closure Access Macros */ +#define FORMALS(x) ((x)->u.closxp.formals) +#define BODY(x) ((x)->u.closxp.body) +#define CLOENV(x) ((x)->u.closxp.env) +#define RDEBUG(x) ((x)->sxpinfo.debug) +#define SET_RDEBUG(x,v) (((x)->sxpinfo.debug)=(v)) +#define RSTEP(x) ((x)->sxpinfo.spare) +#define SET_RSTEP(x,v) (((x)->sxpinfo.spare)=(v)) + +/* Symbol Access Macros */ +#define PRINTNAME(x) ((x)->u.symsxp.pname) +#define SYMVALUE(x) ((x)->u.symsxp.value) +#define INTERNAL(x) ((x)->u.symsxp.internal) +#define DDVAL_MASK 1 +#define DDVAL(x) ((x)->sxpinfo.gp & DDVAL_MASK) /* for ..1, ..2 etc */ +#define SET_DDVAL_BIT(x) (((x)->sxpinfo.gp) |= DDVAL_MASK) +#define UNSET_DDVAL_BIT(x) (((x)->sxpinfo.gp) &= ~DDVAL_MASK) +#define SET_DDVAL(x,v) ((v) ? SET_DDVAL_BIT(x) : UNSET_DDVAL_BIT(x)) /* for ..1, ..2 etc */ + +/* Environment Access Macros */ +#define FRAME(x) ((x)->u.envsxp.frame) +#define ENCLOS(x) ((x)->u.envsxp.enclos) +#define HASHTAB(x) ((x)->u.envsxp.hashtab) +#define ENVFLAGS(x) ((x)->sxpinfo.gp) /* for environments */ +#define SET_ENVFLAGS(x,v) (((x)->sxpinfo.gp)=(v)) + +#else /* not USE_RINTERNALS */ +// ======================= not USE_RINTERNALS section + +typedef struct SEXPREC *SEXP; + +#define CHAR(x) R_CHAR(x) +const char *(R_CHAR)(SEXP x); + +/* Various tests with macro versions in the second USE_RINTERNALS section */ +Rboolean (Rf_isNull)(SEXP s); +Rboolean (Rf_isSymbol)(SEXP s); +Rboolean (Rf_isLogical)(SEXP s); +Rboolean (Rf_isReal)(SEXP s); +Rboolean (Rf_isComplex)(SEXP s); +Rboolean (Rf_isExpression)(SEXP s); +Rboolean (Rf_isEnvironment)(SEXP s); +Rboolean (Rf_isString)(SEXP s); +Rboolean (Rf_isObject)(SEXP s); + +# define IS_SCALAR(x, type) (TYPEOF(x) == (type) && XLENGTH(x) == 1) +#endif /* USE_RINTERNALS */ + +#define IS_SIMPLE_SCALAR(x, type) \ + (IS_SCALAR(x, type) && ATTRIB(x) == R_NilValue) + +#define NAMEDMAX 2 +#define INCREMENT_NAMED(x) do { \ + SEXP __x__ = (x); \ + if (NAMED(__x__) != NAMEDMAX) \ + SET_NAMED(__x__, NAMED(__x__) + 1); \ + } while (0) + +#if defined(COMPUTE_REFCNT_VALUES) +# define SET_REFCNT(x,v) (REFCNT(x) = (v)) +# if defined(EXTRA_REFCNT_FIELDS) +# define SET_TRACKREFS(x,v) (TRACKREFS(x) = (v)) +# else +# define SET_TRACKREFS(x,v) ((x)->sxpinfo.spare = ! (v)) +# endif +# define DECREMENT_REFCNT(x) do { \ + SEXP drc__x__ = (x); \ + if (REFCNT(drc__x__) > 0 && REFCNT(drc__x__) < REFCNTMAX) \ + SET_REFCNT(drc__x__, REFCNT(drc__x__) - 1); \ + } while (0) +# define INCREMENT_REFCNT(x) do { \ + SEXP irc__x__ = (x); \ + if (REFCNT(irc__x__) < REFCNTMAX) \ + SET_REFCNT(irc__x__, REFCNT(irc__x__) + 1); \ + } while (0) +#else +# define SET_REFCNT(x,v) do {} while(0) +# define SET_TRACKREFS(x,v) do {} while(0) +# define DECREMENT_REFCNT(x) do {} while(0) +# define INCREMENT_REFCNT(x) do {} while(0) +#endif + +#define ENABLE_REFCNT(x) SET_TRACKREFS(x, TRUE) +#define DISABLE_REFCNT(x) SET_TRACKREFS(x, FALSE) + +/* Macros for some common idioms. */ +#ifdef SWITCH_TO_REFCNT +# define MAYBE_SHARED(x) (REFCNT(x) > 1) +# define NO_REFERENCES(x) (REFCNT(x) == 0) +# define MARK_NOT_MUTABLE(x) SET_REFCNT(x, REFCNTMAX) +#else +# define MAYBE_SHARED(x) (NAMED(x) > 1) +# define NO_REFERENCES(x) (NAMED(x) == 0) +# define MARK_NOT_MUTABLE(x) SET_NAMED(x, NAMEDMAX) +#endif +#define MAYBE_REFERENCED(x) (! NO_REFERENCES(x)) +#define NOT_SHARED(x) (! MAYBE_SHARED(x)) + +/* Complex assignment support */ +/* temporary definition that will need to be refined to distinguish + getter from setter calls */ +#define IS_GETTER_CALL(call) (CADR(call) == R_TmpvalSymbol) + +/* Accessor functions. Many are declared using () to avoid the macro + definitions in the USE_RINTERNALS section. + The function STRING_ELT is used as an argument to arrayAssign even + if the macro version is in use. +*/ + +/* General Cons Cell Attributes */ +SEXP (ATTRIB)(SEXP x); +int (OBJECT)(SEXP x); +int (MARK)(SEXP x); +int (TYPEOF)(SEXP x); +int (NAMED)(SEXP x); +int (REFCNT)(SEXP x); +void (SET_OBJECT)(SEXP x, int v); +void (SET_TYPEOF)(SEXP x, int v); +void (SET_NAMED)(SEXP x, int v); +void SET_ATTRIB(SEXP x, SEXP v); +void DUPLICATE_ATTRIB(SEXP to, SEXP from); +void SHALLOW_DUPLICATE_ATTRIB(SEXP to, SEXP from); + +/* S4 object testing */ +int (IS_S4_OBJECT)(SEXP x); +void (SET_S4_OBJECT)(SEXP x); +void (UNSET_S4_OBJECT)(SEXP x); + +/* JIT optimization support */ +int (NOJIT)(SEXP x); +int (MAYBEJIT)(SEXP x); +void (SET_NOJIT)(SEXP x); +void (SET_MAYBEJIT)(SEXP x); +void (UNSET_MAYBEJIT)(SEXP x); + +/* Growable vector support */ +int (IS_GROWABLE)(SEXP x); +void (SET_GROWABLE_BIT)(SEXP x); + +/* Vector Access Functions */ +int (LENGTH)(SEXP x); +int (TRUELENGTH)(SEXP x); +void (SETLENGTH)(SEXP x, int v); +void (SET_TRUELENGTH)(SEXP x, int v); +R_xlen_t (XLENGTH)(SEXP x); +R_xlen_t (XTRUELENGTH)(SEXP x); +int (IS_LONG_VEC)(SEXP x); +int (LEVELS)(SEXP x); +int (SETLEVELS)(SEXP x, int v); + +int *(LOGICAL)(SEXP x); +int *(INTEGER)(SEXP x); +Rbyte *(RAW)(SEXP x); +double *(REAL)(SEXP x); +Rcomplex *(COMPLEX)(SEXP x); +SEXP (STRING_ELT)(SEXP x, R_xlen_t i); +SEXP (VECTOR_ELT)(SEXP x, R_xlen_t i); +void SET_STRING_ELT(SEXP x, R_xlen_t i, SEXP v); +SEXP SET_VECTOR_ELT(SEXP x, R_xlen_t i, SEXP v); +SEXP *(STRING_PTR)(SEXP x); +SEXP * NORET (VECTOR_PTR)(SEXP x); + +#ifdef LONG_VECTOR_SUPPORT + R_len_t NORET R_BadLongVector(SEXP, const char *, int); +#endif + +/* List Access Functions */ +/* These also work for ... objects */ +#define CONS(a, b) cons((a), (b)) /* data lists */ +#define LCONS(a, b) lcons((a), (b)) /* language lists */ +SEXP (TAG)(SEXP e); +SEXP (CAR)(SEXP e); +SEXP (CDR)(SEXP e); +SEXP (CAAR)(SEXP e); +SEXP (CDAR)(SEXP e); +SEXP (CADR)(SEXP e); +SEXP (CDDR)(SEXP e); +SEXP (CDDDR)(SEXP e); +SEXP (CADDR)(SEXP e); +SEXP (CADDDR)(SEXP e); +SEXP (CAD4R)(SEXP e); +int (MISSING)(SEXP x); +void (SET_MISSING)(SEXP x, int v); +void SET_TAG(SEXP x, SEXP y); +SEXP SETCAR(SEXP x, SEXP y); +SEXP SETCDR(SEXP x, SEXP y); +SEXP SETCADR(SEXP x, SEXP y); +SEXP SETCADDR(SEXP x, SEXP y); +SEXP SETCADDDR(SEXP x, SEXP y); +SEXP SETCAD4R(SEXP e, SEXP y); + +SEXP CONS_NR(SEXP a, SEXP b); + +/* Closure Access Functions */ +SEXP (FORMALS)(SEXP x); +SEXP (BODY)(SEXP x); +SEXP (CLOENV)(SEXP x); +int (RDEBUG)(SEXP x); +int (RSTEP)(SEXP x); +int (RTRACE)(SEXP x); +void (SET_RDEBUG)(SEXP x, int v); +void (SET_RSTEP)(SEXP x, int v); +void (SET_RTRACE)(SEXP x, int v); +void SET_FORMALS(SEXP x, SEXP v); +void SET_BODY(SEXP x, SEXP v); +void SET_CLOENV(SEXP x, SEXP v); + +/* Symbol Access Functions */ +SEXP (PRINTNAME)(SEXP x); +SEXP (SYMVALUE)(SEXP x); +SEXP (INTERNAL)(SEXP x); +int (DDVAL)(SEXP x); +void (SET_DDVAL)(SEXP x, int v); +void SET_PRINTNAME(SEXP x, SEXP v); +void SET_SYMVALUE(SEXP x, SEXP v); +void SET_INTERNAL(SEXP x, SEXP v); + +/* Environment Access Functions */ +SEXP (FRAME)(SEXP x); +SEXP (ENCLOS)(SEXP x); +SEXP (HASHTAB)(SEXP x); +int (ENVFLAGS)(SEXP x); +void (SET_ENVFLAGS)(SEXP x, int v); +void SET_FRAME(SEXP x, SEXP v); +void SET_ENCLOS(SEXP x, SEXP v); +void SET_HASHTAB(SEXP x, SEXP v); + +/* Promise Access Functions */ +/* First five have macro versions in Defn.h */ +SEXP (PRCODE)(SEXP x); +SEXP (PRENV)(SEXP x); +SEXP (PRVALUE)(SEXP x); +int (PRSEEN)(SEXP x); +void (SET_PRSEEN)(SEXP x, int v); +void SET_PRENV(SEXP x, SEXP v); +void SET_PRVALUE(SEXP x, SEXP v); +void SET_PRCODE(SEXP x, SEXP v); +void SET_PRSEEN(SEXP x, int v); + +/* Hashing Functions */ +/* There are macro versions in Defn.h */ +int (HASHASH)(SEXP x); +int (HASHVALUE)(SEXP x); +void (SET_HASHASH)(SEXP x, int v); +void (SET_HASHVALUE)(SEXP x, int v); + + +/* External pointer access macros */ +#define EXTPTR_PTR(x) CAR(x) +#define EXTPTR_PROT(x) CDR(x) +#define EXTPTR_TAG(x) TAG(x) + +/* Bytecode access macros */ +#define BCODE_CODE(x) CAR(x) +#define BCODE_CONSTS(x) CDR(x) +#define BCODE_EXPR(x) TAG(x) +#define isByteCode(x) (TYPEOF(x)==BCODESXP) + +/* Pointer Protection and Unprotection */ +#define PROTECT(s) Rf_protect(s) +#define UNPROTECT(n) Rf_unprotect(n) +#define UNPROTECT_PTR(s) Rf_unprotect_ptr(s) + +/* We sometimes need to coerce a protected value and place the new + coerced value under protection. For these cases PROTECT_WITH_INDEX + saves an index of the protection location that can be used to + replace the protected value using REPROTECT. */ +typedef int PROTECT_INDEX; +#define PROTECT_WITH_INDEX(x,i) R_ProtectWithIndex(x,i) +#define REPROTECT(x,i) R_Reprotect(x,i) + +/* Evaluation Environment */ +LibExtern SEXP R_GlobalEnv; /* The "global" environment */ + +LibExtern SEXP R_EmptyEnv; /* An empty environment at the root of the + environment tree */ +LibExtern SEXP R_BaseEnv; /* The base environment; formerly R_NilValue */ +LibExtern SEXP R_BaseNamespace; /* The (fake) namespace for base */ +LibExtern SEXP R_NamespaceRegistry;/* Registry for registered namespaces */ + +LibExtern SEXP R_Srcref; /* Current srcref, for debuggers */ + +/* Special Values */ +LibExtern SEXP R_NilValue; /* The nil object */ +LibExtern SEXP R_UnboundValue; /* Unbound marker */ +LibExtern SEXP R_MissingArg; /* Missing argument marker */ +LibExtern SEXP R_InBCInterpreter; /* To be found in BC interp. state + (marker) */ +LibExtern SEXP R_CurrentExpression; /* Use current expression (marker) */ +#ifdef __MAIN__ +attribute_hidden +#else +extern +#endif +SEXP R_RestartToken; /* Marker for restarted function calls */ + +/* Symbol Table Shortcuts */ +LibExtern SEXP R_AsCharacterSymbol;/* "as.character" */ +LibExtern SEXP R_baseSymbol; // <-- backcompatible version of: +LibExtern SEXP R_BaseSymbol; // "base" +LibExtern SEXP R_BraceSymbol; /* "{" */ +LibExtern SEXP R_Bracket2Symbol; /* "[[" */ +LibExtern SEXP R_BracketSymbol; /* "[" */ +LibExtern SEXP R_ClassSymbol; /* "class" */ +LibExtern SEXP R_DeviceSymbol; /* ".Device" */ +LibExtern SEXP R_DimNamesSymbol; /* "dimnames" */ +LibExtern SEXP R_DimSymbol; /* "dim" */ +LibExtern SEXP R_DollarSymbol; /* "$" */ +LibExtern SEXP R_DotsSymbol; /* "..." */ +LibExtern SEXP R_DoubleColonSymbol;// "::" +LibExtern SEXP R_DropSymbol; /* "drop" */ +LibExtern SEXP R_LastvalueSymbol; /* ".Last.value" */ +LibExtern SEXP R_LevelsSymbol; /* "levels" */ +LibExtern SEXP R_ModeSymbol; /* "mode" */ +LibExtern SEXP R_NaRmSymbol; /* "na.rm" */ +LibExtern SEXP R_NameSymbol; /* "name" */ +LibExtern SEXP R_NamesSymbol; /* "names" */ +LibExtern SEXP R_NamespaceEnvSymbol;// ".__NAMESPACE__." +LibExtern SEXP R_PackageSymbol; /* "package" */ +LibExtern SEXP R_PreviousSymbol; /* "previous" */ +LibExtern SEXP R_QuoteSymbol; /* "quote" */ +LibExtern SEXP R_RowNamesSymbol; /* "row.names" */ +LibExtern SEXP R_SeedsSymbol; /* ".Random.seed" */ +LibExtern SEXP R_SortListSymbol; /* "sort.list" */ +LibExtern SEXP R_SourceSymbol; /* "source" */ +LibExtern SEXP R_SpecSymbol; // "spec" +LibExtern SEXP R_TripleColonSymbol;// ":::" +LibExtern SEXP R_TspSymbol; /* "tsp" */ + +LibExtern SEXP R_dot_defined; /* ".defined" */ +LibExtern SEXP R_dot_Method; /* ".Method" */ +LibExtern SEXP R_dot_packageName;// ".packageName" +LibExtern SEXP R_dot_target; /* ".target" */ +LibExtern SEXP R_dot_Generic; /* ".Generic" */ + +/* Missing Values - others from Arith.h */ +#define NA_STRING R_NaString +LibExtern SEXP R_NaString; /* NA_STRING as a CHARSXP */ +LibExtern SEXP R_BlankString; /* "" as a CHARSXP */ +LibExtern SEXP R_BlankScalarString; /* "" as a STRSXP */ + +/* srcref related functions */ +SEXP R_GetCurrentSrcref(int); +SEXP R_GetSrcFilename(SEXP); + +/*--- FUNCTIONS ------------------------------------------------------ */ + +/* Type Coercions of all kinds */ + +SEXP Rf_asChar(SEXP); +SEXP Rf_coerceVector(SEXP, SEXPTYPE); +SEXP Rf_PairToVectorList(SEXP x); +SEXP Rf_VectorToPairList(SEXP x); +SEXP Rf_asCharacterFactor(SEXP x); +int Rf_asLogical(SEXP x); +int Rf_asInteger(SEXP x); +double Rf_asReal(SEXP x); +Rcomplex Rf_asComplex(SEXP x); + + +#ifndef R_ALLOCATOR_TYPE +#define R_ALLOCATOR_TYPE +typedef struct R_allocator R_allocator_t; +#endif + +/* Other Internally Used Functions, excluding those which are inline-able*/ + +char * Rf_acopy_string(const char *); +void Rf_addMissingVarsToNewEnv(SEXP, SEXP); +SEXP Rf_alloc3DArray(SEXPTYPE, int, int, int); +SEXP Rf_allocArray(SEXPTYPE, SEXP); +SEXP Rf_allocFormalsList2(SEXP sym1, SEXP sym2); +SEXP Rf_allocFormalsList3(SEXP sym1, SEXP sym2, SEXP sym3); +SEXP Rf_allocFormalsList4(SEXP sym1, SEXP sym2, SEXP sym3, SEXP sym4); +SEXP Rf_allocFormalsList5(SEXP sym1, SEXP sym2, SEXP sym3, SEXP sym4, SEXP sym5); +SEXP Rf_allocFormalsList6(SEXP sym1, SEXP sym2, SEXP sym3, SEXP sym4, SEXP sym5, SEXP sym6); +SEXP Rf_allocMatrix(SEXPTYPE, int, int); +SEXP Rf_allocList(int); +SEXP Rf_allocS4Object(void); +SEXP Rf_allocSExp(SEXPTYPE); +SEXP Rf_allocVector3(SEXPTYPE, R_xlen_t, R_allocator_t*); +R_xlen_t Rf_any_duplicated(SEXP x, Rboolean from_last); +R_xlen_t Rf_any_duplicated3(SEXP x, SEXP incomp, Rboolean from_last); +SEXP Rf_applyClosure(SEXP, SEXP, SEXP, SEXP, SEXP); +SEXP Rf_arraySubscript(int, SEXP, SEXP, SEXP (*)(SEXP,SEXP), + SEXP (*)(SEXP, int), SEXP); +SEXP Rf_classgets(SEXP, SEXP); +SEXP Rf_cons(SEXP, SEXP); +SEXP Rf_fixSubset3Args(SEXP, SEXP, SEXP, SEXP*); +void Rf_copyMatrix(SEXP, SEXP, Rboolean); +void Rf_copyListMatrix(SEXP, SEXP, Rboolean); +void Rf_copyMostAttrib(SEXP, SEXP); +void Rf_copyVector(SEXP, SEXP); +int Rf_countContexts(int, int); +SEXP Rf_CreateTag(SEXP); +void Rf_defineVar(SEXP, SEXP, SEXP); +SEXP Rf_dimgets(SEXP, SEXP); +SEXP Rf_dimnamesgets(SEXP, SEXP); +SEXP Rf_DropDims(SEXP); +SEXP Rf_duplicate(SEXP); +SEXP Rf_shallow_duplicate(SEXP); +SEXP Rf_lazy_duplicate(SEXP); +/* the next really should not be here and is also in Defn.h */ +SEXP Rf_duplicated(SEXP, Rboolean); +Rboolean R_envHasNoSpecialSymbols(SEXP); +SEXP Rf_eval(SEXP, SEXP); +SEXP Rf_findFun(SEXP, SEXP); +SEXP Rf_findFun3(SEXP, SEXP, SEXP); +void Rf_findFunctionForBody(SEXP); +SEXP Rf_findVar(SEXP, SEXP); +SEXP Rf_findVarInFrame(SEXP, SEXP); +SEXP Rf_findVarInFrame3(SEXP, SEXP, Rboolean); +SEXP Rf_getAttrib(SEXP, SEXP); +SEXP Rf_GetArrayDimnames(SEXP); +SEXP Rf_GetColNames(SEXP); +void Rf_GetMatrixDimnames(SEXP, SEXP*, SEXP*, const char**, const char**); +SEXP Rf_GetOption(SEXP, SEXP); /* pre-2.13.0 compatibility */ +SEXP Rf_GetOption1(SEXP); +int Rf_GetOptionDigits(void); +int Rf_GetOptionWidth(void); +SEXP Rf_GetRowNames(SEXP); +void Rf_gsetVar(SEXP, SEXP, SEXP); +SEXP Rf_install(const char *); +SEXP Rf_installChar(SEXP); +SEXP Rf_installDDVAL(int i); +SEXP Rf_installS3Signature(const char *, const char *); +Rboolean Rf_isFree(SEXP); +Rboolean Rf_isOrdered(SEXP); +Rboolean Rf_isUnmodifiedSpecSym(SEXP sym, SEXP env); +Rboolean Rf_isUnordered(SEXP); +Rboolean Rf_isUnsorted(SEXP, Rboolean); +SEXP Rf_lengthgets(SEXP, R_len_t); +SEXP Rf_xlengthgets(SEXP, R_xlen_t); +SEXP R_lsInternal(SEXP, Rboolean); +SEXP R_lsInternal3(SEXP, Rboolean, Rboolean); +SEXP Rf_match(SEXP, SEXP, int); +SEXP Rf_matchE(SEXP, SEXP, int, SEXP); +SEXP Rf_namesgets(SEXP, SEXP); +SEXP Rf_mkChar(const char *); +SEXP Rf_mkCharLen(const char *, int); +Rboolean Rf_NonNullStringMatch(SEXP, SEXP); +int Rf_ncols(SEXP); +int Rf_nrows(SEXP); +SEXP Rf_nthcdr(SEXP, int); + +// ../main/character.c : +typedef enum {Bytes, Chars, Width} nchar_type; +int R_nchar(SEXP string, nchar_type type_, + Rboolean allowNA, Rboolean keepNA, const char* msg_name); + +Rboolean Rf_pmatch(SEXP, SEXP, Rboolean); +Rboolean Rf_psmatch(const char *, const char *, Rboolean); +SEXP R_ParseEvalString(const char *, SEXP); +void Rf_PrintValue(SEXP); +#ifndef INLINE_PROTECT +SEXP Rf_protect(SEXP); +#endif +void Rf_readS3VarsFromFrame(SEXP, SEXP*, SEXP*, SEXP*, SEXP*, SEXP*, SEXP*); +SEXP Rf_setAttrib(SEXP, SEXP, SEXP); +void Rf_setSVector(SEXP*, int, SEXP); +void Rf_setVar(SEXP, SEXP, SEXP); +SEXP Rf_stringSuffix(SEXP, int); +SEXPTYPE Rf_str2type(const char *); +Rboolean Rf_StringBlank(SEXP); +SEXP Rf_substitute(SEXP,SEXP); +const char * Rf_translateChar(SEXP); +const char * Rf_translateChar0(SEXP); +const char * Rf_translateCharUTF8(SEXP); +const char * Rf_type2char(SEXPTYPE); +SEXP Rf_type2rstr(SEXPTYPE); +SEXP Rf_type2str(SEXPTYPE); +SEXP Rf_type2str_nowarn(SEXPTYPE); +#ifndef INLINE_PROTECT +void Rf_unprotect(int); +#endif +void Rf_unprotect_ptr(SEXP); + +void NORET R_signal_protect_error(void); +void NORET R_signal_unprotect_error(void); +void NORET R_signal_reprotect_error(PROTECT_INDEX i); + +#ifndef INLINE_PROTECT +void R_ProtectWithIndex(SEXP, PROTECT_INDEX *); +void R_Reprotect(SEXP, PROTECT_INDEX); +#endif +SEXP R_tryEval(SEXP, SEXP, int *); +SEXP R_tryEvalSilent(SEXP, SEXP, int *); +const char *R_curErrorBuf(); + +Rboolean Rf_isS4(SEXP); +SEXP Rf_asS4(SEXP, Rboolean, int); +SEXP Rf_S3Class(SEXP); +int Rf_isBasicClass(const char *); + +Rboolean R_cycle_detected(SEXP s, SEXP child); + +typedef enum { + CE_NATIVE = 0, + CE_UTF8 = 1, + CE_LATIN1 = 2, + CE_BYTES = 3, + CE_SYMBOL = 5, + CE_ANY =99 +} cetype_t; + +cetype_t Rf_getCharCE(SEXP); +SEXP Rf_mkCharCE(const char *, cetype_t); +SEXP Rf_mkCharLenCE(const char *, int, cetype_t); +const char *Rf_reEnc(const char *x, cetype_t ce_in, cetype_t ce_out, int subst); + + /* match(.) NOT reached : for -Wall */ +#define error_return(msg) { Rf_error(msg); return R_NilValue; } +#define errorcall_return(cl,msg){ Rf_errorcall(cl, msg); return R_NilValue; } + +#ifdef __MAIN__ +#undef extern +#undef LibExtern +#endif + +/* Calling a function with arguments evaluated */ +SEXP R_forceAndCall(SEXP e, int n, SEXP rho); + +/* External pointer interface */ +SEXP R_MakeExternalPtr(void *p, SEXP tag, SEXP prot); +void *R_ExternalPtrAddr(SEXP s); +SEXP R_ExternalPtrTag(SEXP s); +SEXP R_ExternalPtrProtected(SEXP s); +void R_ClearExternalPtr(SEXP s); +void R_SetExternalPtrAddr(SEXP s, void *p); +void R_SetExternalPtrTag(SEXP s, SEXP tag); +void R_SetExternalPtrProtected(SEXP s, SEXP p); +// Added in R 3.4.0 +SEXP R_MakeExternalPtrFn(DL_FUNC p, SEXP tag, SEXP prot); +DL_FUNC R_ExternalPtrAddrFn(SEXP s); + +/* Finalization interface */ +typedef void (*R_CFinalizer_t)(SEXP); +void R_RegisterFinalizer(SEXP s, SEXP fun); +void R_RegisterCFinalizer(SEXP s, R_CFinalizer_t fun); +void R_RegisterFinalizerEx(SEXP s, SEXP fun, Rboolean onexit); +void R_RegisterCFinalizerEx(SEXP s, R_CFinalizer_t fun, Rboolean onexit); +void R_RunPendingFinalizers(void); + +/* Weak reference interface */ +SEXP R_MakeWeakRef(SEXP key, SEXP val, SEXP fin, Rboolean onexit); +SEXP R_MakeWeakRefC(SEXP key, SEXP val, R_CFinalizer_t fin, Rboolean onexit); +SEXP R_WeakRefKey(SEXP w); +SEXP R_WeakRefValue(SEXP w); +void R_RunWeakRefFinalizer(SEXP w); + +SEXP R_PromiseExpr(SEXP); +SEXP R_ClosureExpr(SEXP); +SEXP R_BytecodeExpr(SEXP e); +void R_initialize_bcode(void); +SEXP R_bcEncode(SEXP); +SEXP R_bcDecode(SEXP); +void R_registerBC(SEXP, SEXP); +Rboolean R_checkConstants(Rboolean); +Rboolean R_BCVersionOK(SEXP); +#define PREXPR(e) R_PromiseExpr(e) +#define BODY_EXPR(e) R_ClosureExpr(e) + +/* Protected evaluation */ +Rboolean R_ToplevelExec(void (*fun)(void *), void *data); +SEXP R_ExecWithCleanup(SEXP (*fun)(void *), void *data, + void (*cleanfun)(void *), void *cleandata); +SEXP R_tryCatch(SEXP (*)(void *), void *, /* body closure*/ + SEXP, /* condition classes (STRSXP) */ + SEXP (*)(SEXP, void *), void *, /* handler closure */ + void (*)(void *), void *); /* finally closure */ +SEXP R_tryCatchError(SEXP (*)(void *), void *, /* body closure*/ + SEXP (*)(SEXP, void *), void *); /* handler closure */ + +/* Environment and Binding Features */ +void R_RestoreHashCount(SEXP rho); +Rboolean R_IsPackageEnv(SEXP rho); +SEXP R_PackageEnvName(SEXP rho); +SEXP R_FindPackageEnv(SEXP info); +Rboolean R_IsNamespaceEnv(SEXP rho); +SEXP R_NamespaceEnvSpec(SEXP rho); +SEXP R_FindNamespace(SEXP info); +void R_LockEnvironment(SEXP env, Rboolean bindings); +Rboolean R_EnvironmentIsLocked(SEXP env); +void R_LockBinding(SEXP sym, SEXP env); +void R_unLockBinding(SEXP sym, SEXP env); +void R_MakeActiveBinding(SEXP sym, SEXP fun, SEXP env); +Rboolean R_BindingIsLocked(SEXP sym, SEXP env); +Rboolean R_BindingIsActive(SEXP sym, SEXP env); +Rboolean R_HasFancyBindings(SEXP rho); + + +/* ../main/errors.c : */ +/* needed for R_load/savehistory handling in front ends */ +#if defined(__GNUC__) && __GNUC__ >= 3 +void Rf_errorcall(SEXP, const char *, ...) __attribute__((noreturn)); +#else +void Rf_errorcall(SEXP, const char *, ...); +#endif +void Rf_warningcall(SEXP, const char *, ...); +void Rf_warningcall_immediate(SEXP, const char *, ...); + +/* Save/Load Interface */ +#define R_XDR_DOUBLE_SIZE 8 +#define R_XDR_INTEGER_SIZE 4 + +void R_XDREncodeDouble(double d, void *buf); +double R_XDRDecodeDouble(void *buf); +void R_XDREncodeInteger(int i, void *buf); +int R_XDRDecodeInteger(void *buf); + +typedef void *R_pstream_data_t; + +typedef enum { + R_pstream_any_format, + R_pstream_ascii_format, + R_pstream_binary_format, + R_pstream_xdr_format, + R_pstream_asciihex_format +} R_pstream_format_t; + +typedef struct R_outpstream_st *R_outpstream_t; +struct R_outpstream_st { + R_pstream_data_t data; + R_pstream_format_t type; + int version; + void (*OutChar)(R_outpstream_t, int); + void (*OutBytes)(R_outpstream_t, void *, int); + SEXP (*OutPersistHookFunc)(SEXP, SEXP); + SEXP OutPersistHookData; +}; + +typedef struct R_inpstream_st *R_inpstream_t; +struct R_inpstream_st { + R_pstream_data_t data; + R_pstream_format_t type; + int (*InChar)(R_inpstream_t); + void (*InBytes)(R_inpstream_t, void *, int); + SEXP (*InPersistHookFunc)(SEXP, SEXP); + SEXP InPersistHookData; +}; + +void R_InitInPStream(R_inpstream_t stream, R_pstream_data_t data, + R_pstream_format_t type, + int (*inchar)(R_inpstream_t), + void (*inbytes)(R_inpstream_t, void *, int), + SEXP (*phook)(SEXP, SEXP), SEXP pdata); +void R_InitOutPStream(R_outpstream_t stream, R_pstream_data_t data, + R_pstream_format_t type, int version, + void (*outchar)(R_outpstream_t, int), + void (*outbytes)(R_outpstream_t, void *, int), + SEXP (*phook)(SEXP, SEXP), SEXP pdata); + +#ifdef __cplusplus +void R_InitFileInPStream(R_inpstream_t stream, std::FILE *fp, + R_pstream_format_t type, + SEXP (*phook)(SEXP, SEXP), SEXP pdata); +void R_InitFileOutPStream(R_outpstream_t stream, std::FILE *fp, + R_pstream_format_t type, int version, + SEXP (*phook)(SEXP, SEXP), SEXP pdata); +#else +void R_InitFileInPStream(R_inpstream_t stream, FILE *fp, + R_pstream_format_t type, + SEXP (*phook)(SEXP, SEXP), SEXP pdata); +void R_InitFileOutPStream(R_outpstream_t stream, FILE *fp, + R_pstream_format_t type, int version, + SEXP (*phook)(SEXP, SEXP), SEXP pdata); +#endif + +#ifdef NEED_CONNECTION_PSTREAMS +/* The connection interface is not available to packages. To + allow limited use of connection pointers this defines the opaque + pointer type. */ +#ifndef HAVE_RCONNECTION_TYPEDEF +typedef struct Rconn *Rconnection; +#define HAVE_RCONNECTION_TYPEDEF +#endif +void R_InitConnOutPStream(R_outpstream_t stream, Rconnection con, + R_pstream_format_t type, int version, + SEXP (*phook)(SEXP, SEXP), SEXP pdata); +void R_InitConnInPStream(R_inpstream_t stream, Rconnection con, + R_pstream_format_t type, + SEXP (*phook)(SEXP, SEXP), SEXP pdata); +#endif + +void R_Serialize(SEXP s, R_outpstream_t ops); +SEXP R_Unserialize(R_inpstream_t ips); + +/* slot management (in attrib.c) */ +SEXP R_do_slot(SEXP obj, SEXP name); +SEXP R_do_slot_assign(SEXP obj, SEXP name, SEXP value); +int R_has_slot(SEXP obj, SEXP name); +/* S3-S4 class (inheritance), attrib.c */ +SEXP R_S4_extends(SEXP klass, SEXP useTable); + +/* class definition, new objects (objects.c) */ +SEXP R_do_MAKE_CLASS(const char *what); +SEXP R_getClassDef (const char *what); +SEXP R_getClassDef_R(SEXP what); +Rboolean R_has_methods_attached(void); +Rboolean R_isVirtualClass(SEXP class_def, SEXP env); +Rboolean R_extends (SEXP class1, SEXP class2, SEXP env); +SEXP R_do_new_object(SEXP class_def); +/* supporting a C-level version of is(., .) : */ +int R_check_class_and_super(SEXP x, const char **valid, SEXP rho); +int R_check_class_etc (SEXP x, const char **valid); + +/* preserve objects across GCs */ +void R_PreserveObject(SEXP); +void R_ReleaseObject(SEXP); + +/* Shutdown actions */ +void R_dot_Last(void); /* in main.c */ +void R_RunExitFinalizers(void); /* in memory.c */ + +/* Replacements for popen and system */ +#ifdef HAVE_POPEN +# ifdef __cplusplus +std::FILE *R_popen(const char *, const char *); +# else +FILE *R_popen(const char *, const char *); +# endif +#endif +int R_system(const char *); + +/* R_compute_identical: C version of identical() function + The third arg to R_compute_identical() consists of bitmapped flags for non-default options: + currently the first 4 default to TRUE, so the flag is set for FALSE values: + 1 = !NUM_EQ + 2 = !SINGLE_NA + 4 = !ATTR_AS_SET + 8 = !IGNORE_BYTECODE + 16 = !IGNORE_ENV + Default from R's default: 16 +*/ +Rboolean R_compute_identical(SEXP, SEXP, int); + +SEXP R_body_no_src(SEXP x); // body(x) without "srcref" etc, ../main/utils.c + +/* C version of R's indx <- order(..., na.last, decreasing) : + e.g. arglist = Rf_lang2(x,y) or Rf_lang3(x,y,z) */ +void R_orderVector (int *indx, int n, SEXP arglist, Rboolean nalast, Rboolean decreasing); +// C version of R's indx <- order(x, na.last, decreasing) : +void R_orderVector1(int *indx, int n, SEXP x, Rboolean nalast, Rboolean decreasing); + +#ifndef R_NO_REMAP +#define acopy_string Rf_acopy_string +#define addMissingVarsToNewEnv Rf_addMissingVarsToNewEnv +#define alloc3DArray Rf_alloc3DArray +#define allocArray Rf_allocArray +#define allocFormalsList2 Rf_allocFormalsList2 +#define allocFormalsList3 Rf_allocFormalsList3 +#define allocFormalsList4 Rf_allocFormalsList4 +#define allocFormalsList5 Rf_allocFormalsList5 +#define allocFormalsList6 Rf_allocFormalsList6 +#define allocList Rf_allocList +#define allocMatrix Rf_allocMatrix +#define allocS4Object Rf_allocS4Object +#define allocSExp Rf_allocSExp +#define allocVector Rf_allocVector +#define allocVector3 Rf_allocVector3 +#define any_duplicated Rf_any_duplicated +#define any_duplicated3 Rf_any_duplicated3 +#define applyClosure Rf_applyClosure +#define arraySubscript Rf_arraySubscript +#define asChar Rf_asChar +#define asCharacterFactor Rf_asCharacterFactor +#define asComplex Rf_asComplex +#define asInteger Rf_asInteger +#define asLogical Rf_asLogical +#define asReal Rf_asReal +#define asS4 Rf_asS4 +#define classgets Rf_classgets +#define coerceVector Rf_coerceVector +#define conformable Rf_conformable +#define cons Rf_cons +#define fixSubset3Args Rf_fixSubset3Args +#define copyListMatrix Rf_copyListMatrix +#define copyMatrix Rf_copyMatrix +#define copyMostAttrib Rf_copyMostAttrib +#define copyVector Rf_copyVector +#define countContexts Rf_countContexts +#define CreateTag Rf_CreateTag +#define defineVar Rf_defineVar +#define dimgets Rf_dimgets +#define dimnamesgets Rf_dimnamesgets +#define DropDims Rf_DropDims +#define duplicate Rf_duplicate +#define duplicated Rf_duplicated +#define elt Rf_elt +#define errorcall Rf_errorcall +#define eval Rf_eval +#define findFun Rf_findFun +#define findFun3 Rf_findFun3 +#define findFunctionForBody Rf_findFunctionForBody +#define findVar Rf_findVar +#define findVarInFrame Rf_findVarInFrame +#define findVarInFrame3 Rf_findVarInFrame3 +#define GetArrayDimnames Rf_GetArrayDimnames +#define getAttrib Rf_getAttrib +#define getCharCE Rf_getCharCE +#define GetColNames Rf_GetColNames +#define GetMatrixDimnames Rf_GetMatrixDimnames +#define GetOption1 Rf_GetOption1 +#define GetOptionDigits Rf_GetOptionDigits +#define GetOptionWidth Rf_GetOptionWidth +#define GetOption Rf_GetOption +#define GetRowNames Rf_GetRowNames +#define gsetVar Rf_gsetVar +#define inherits Rf_inherits +#define install Rf_install +#define installChar Rf_installChar +#define installDDVAL Rf_installDDVAL +#define installS3Signature Rf_installS3Signature +#define isArray Rf_isArray +#define isBasicClass Rf_isBasicClass +#define isComplex Rf_isComplex +#define isEnvironment Rf_isEnvironment +#define isExpression Rf_isExpression +#define isFactor Rf_isFactor +#define isFrame Rf_isFrame +#define isFree Rf_isFree +#define isFunction Rf_isFunction +#define isInteger Rf_isInteger +#define isLanguage Rf_isLanguage +#define isList Rf_isList +#define isLogical Rf_isLogical +#define isSymbol Rf_isSymbol +#define isMatrix Rf_isMatrix +#define isNewList Rf_isNewList +#define isNull Rf_isNull +#define isNumeric Rf_isNumeric +#define isNumber Rf_isNumber +#define isObject Rf_isObject +#define isOrdered Rf_isOrdered +#define isPairList Rf_isPairList +#define isPrimitive Rf_isPrimitive +#define isReal Rf_isReal +#define isS4 Rf_isS4 +#define isString Rf_isString +#define isTs Rf_isTs +#define isUnmodifiedSpecSym Rf_isUnmodifiedSpecSym +#define isUnordered Rf_isUnordered +#define isUnsorted Rf_isUnsorted +#define isUserBinop Rf_isUserBinop +#define isValidString Rf_isValidString +#define isValidStringF Rf_isValidStringF +#define isVector Rf_isVector +#define isVectorAtomic Rf_isVectorAtomic +#define isVectorizable Rf_isVectorizable +#define isVectorList Rf_isVectorList +#define lang1 Rf_lang1 +#define lang2 Rf_lang2 +#define lang3 Rf_lang3 +#define lang4 Rf_lang4 +#define lang5 Rf_lang5 +#define lang6 Rf_lang6 +#define lastElt Rf_lastElt +#define lazy_duplicate Rf_lazy_duplicate +#define lcons Rf_lcons +#define length(x) Rf_length(x) +#define lengthgets Rf_lengthgets +#define list1 Rf_list1 +#define list2 Rf_list2 +#define list3 Rf_list3 +#define list4 Rf_list4 +#define list5 Rf_list5 +#define list6 Rf_list6 +#define listAppend Rf_listAppend +#define match Rf_match +#define matchE Rf_matchE +#define mkChar Rf_mkChar +#define mkCharCE Rf_mkCharCE +#define mkCharLen Rf_mkCharLen +#define mkCharLenCE Rf_mkCharLenCE +#define mkNamed Rf_mkNamed +#define mkString Rf_mkString +#define namesgets Rf_namesgets +#define ncols Rf_ncols +#define nlevels Rf_nlevels +#define NonNullStringMatch Rf_NonNullStringMatch +#define nrows Rf_nrows +#define nthcdr Rf_nthcdr +#define PairToVectorList Rf_PairToVectorList +#define pmatch Rf_pmatch +#define psmatch Rf_psmatch +#define PrintValue Rf_PrintValue +#define protect Rf_protect +#define readS3VarsFromFrame Rf_readS3VarsFromFrame +#define reEnc Rf_reEnc +#define rownamesgets Rf_rownamesgets +#define S3Class Rf_S3Class +#define ScalarComplex Rf_ScalarComplex +#define ScalarInteger Rf_ScalarInteger +#define ScalarLogical Rf_ScalarLogical +#define ScalarReal Rf_ScalarReal +#define ScalarString Rf_ScalarString +#define ScalarRaw Rf_ScalarRaw +#define setAttrib Rf_setAttrib +#define setSVector Rf_setSVector +#define setVar Rf_setVar +#define shallow_duplicate Rf_shallow_duplicate +#define str2type Rf_str2type +#define stringSuffix Rf_stringSuffix +#define stringPositionTr Rf_stringPositionTr +#define StringBlank Rf_StringBlank +#define substitute Rf_substitute +#define topenv Rf_topenv +#define translateChar Rf_translateChar +#define translateChar0 Rf_translateChar0 +#define translateCharUTF8 Rf_translateCharUTF8 +#define type2char Rf_type2char +#define type2rstr Rf_type2rstr +#define type2str Rf_type2str +#define type2str_nowarn Rf_type2str_nowarn +#define unprotect Rf_unprotect +#define unprotect_ptr Rf_unprotect_ptr +#define VectorToPairList Rf_VectorToPairList +#define warningcall Rf_warningcall +#define warningcall_immediate Rf_warningcall_immediate +#define xlength(x) Rf_xlength(x) +#define xlengthgets Rf_xlengthgets + +#endif + +#if defined(CALLED_FROM_DEFN_H) && !defined(__MAIN__) && (defined(COMPILING_R) || ( __GNUC__ && !defined(__INTEL_COMPILER) )) +#include "Rinlinedfuns.h" +#else +/* need remapped names here for use with R_NO_REMAP */ + +/* + These are the inlinable functions that are provided in Rinlinedfuns.h + It is *essential* that these do not appear in any other header file, + with or without the Rf_ prefix. +*/ +SEXP Rf_allocVector(SEXPTYPE, R_xlen_t); +Rboolean Rf_conformable(SEXP, SEXP); +SEXP Rf_elt(SEXP, int); +Rboolean Rf_inherits(SEXP, const char *); +Rboolean Rf_isArray(SEXP); +Rboolean Rf_isFactor(SEXP); +Rboolean Rf_isFrame(SEXP); +Rboolean Rf_isFunction(SEXP); +Rboolean Rf_isInteger(SEXP); +Rboolean Rf_isLanguage(SEXP); +Rboolean Rf_isList(SEXP); +Rboolean Rf_isMatrix(SEXP); +Rboolean Rf_isNewList(SEXP); +Rboolean Rf_isNumber(SEXP); +Rboolean Rf_isNumeric(SEXP); +Rboolean Rf_isPairList(SEXP); +Rboolean Rf_isPrimitive(SEXP); +Rboolean Rf_isTs(SEXP); +Rboolean Rf_isUserBinop(SEXP); +Rboolean Rf_isValidString(SEXP); +Rboolean Rf_isValidStringF(SEXP); +Rboolean Rf_isVector(SEXP); +Rboolean Rf_isVectorAtomic(SEXP); +Rboolean Rf_isVectorList(SEXP); +Rboolean Rf_isVectorizable(SEXP); +SEXP Rf_lang1(SEXP); +SEXP Rf_lang2(SEXP, SEXP); +SEXP Rf_lang3(SEXP, SEXP, SEXP); +SEXP Rf_lang4(SEXP, SEXP, SEXP, SEXP); +SEXP Rf_lang5(SEXP, SEXP, SEXP, SEXP, SEXP); +SEXP Rf_lang6(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP); +SEXP Rf_lastElt(SEXP); +SEXP Rf_lcons(SEXP, SEXP); +R_len_t Rf_length(SEXP); +SEXP Rf_list1(SEXP); +SEXP Rf_list2(SEXP, SEXP); +SEXP Rf_list3(SEXP, SEXP, SEXP); +SEXP Rf_list4(SEXP, SEXP, SEXP, SEXP); +SEXP Rf_list5(SEXP, SEXP, SEXP, SEXP, SEXP); +SEXP Rf_list6(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP); +SEXP Rf_listAppend(SEXP, SEXP); +SEXP Rf_mkNamed(SEXPTYPE, const char **); +SEXP Rf_mkString(const char *); +int Rf_nlevels(SEXP); +int Rf_stringPositionTr(SEXP, const char *); +SEXP Rf_ScalarComplex(Rcomplex); +SEXP Rf_ScalarInteger(int); +SEXP Rf_ScalarLogical(int); +SEXP Rf_ScalarRaw(Rbyte); +SEXP Rf_ScalarReal(double); +SEXP Rf_ScalarString(SEXP); +R_xlen_t Rf_xlength(SEXP); +# ifdef INLINE_PROTECT +SEXP Rf_protect(SEXP); +void Rf_unprotect(int); +void R_ProtectWithIndex(SEXP, PROTECT_INDEX *); +void R_Reprotect(SEXP, PROTECT_INDEX); +# endif +SEXP R_FixupRHS(SEXP x, SEXP y); +#endif + +#ifdef USE_RINTERNALS + +/* Test macros with function versions above */ +#undef isNull +#define isNull(s) (TYPEOF(s) == NILSXP) +#undef isSymbol +#define isSymbol(s) (TYPEOF(s) == SYMSXP) +#undef isLogical +#define isLogical(s) (TYPEOF(s) == LGLSXP) +#undef isReal +#define isReal(s) (TYPEOF(s) == REALSXP) +#undef isComplex +#define isComplex(s) (TYPEOF(s) == CPLXSXP) +#undef isExpression +#define isExpression(s) (TYPEOF(s) == EXPRSXP) +#undef isEnvironment +#define isEnvironment(s) (TYPEOF(s) == ENVSXP) +#undef isString +#define isString(s) (TYPEOF(s) == STRSXP) +#undef isObject +#define isObject(s) (OBJECT(s) != 0) + +/* macro version of R_CheckStack */ +#define R_CheckStack() do { \ + void NORET R_SignalCStackOverflow(intptr_t); \ + int dummy; \ + intptr_t usage = R_CStackDir * (R_CStackStart - (uintptr_t)&dummy); \ + if(R_CStackLimit != (uintptr_t)(-1) && usage > ((intptr_t) R_CStackLimit)) \ + R_SignalCStackOverflow(usage); \ + } while (FALSE) +#endif + + +#ifdef __cplusplus +} +#endif + +#endif /* R_INTERNALS_H_ */ diff --git a/com.oracle.truffle.r.native/gnur/patch/src/include/Rmath.h0.in b/com.oracle.truffle.r.native/gnur/patch/src/include/Rmath.h0.in new file mode 100644 index 0000000000000000000000000000000000000000..3c279384e7f788d7f7b54d76842da3a46c4e1800 --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/include/Rmath.h0.in @@ -0,0 +1,693 @@ +/* -*- C -*- + * Mathlib : A C Library of Special Functions + * Copyright (C) 1998-2016 The R Core Team + * Copyright (C) 2004 The R Foundation + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU Lesser General Public License as published by + * the Free Software Foundation; either version 2.1 of the License, or + * (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public License + * along with this program; if not, a copy is available at + * https://www.R-project.org/Licenses/ + * + + * Rmath.h should contain ALL headers from R's C code in `src/nmath' + ------- such that ``the Math library'' can be used by simply + + ``#include <Rmath.h> '' + + and nothing else. + + It is part of the API and supports 'standalone Rmath'. + +*/ +#ifndef RMATH_H +#define RMATH_H + +/* needed for cospi etc */ +#ifndef __STDC_WANT_IEC_60559_FUNCS_EXT__ +# define __STDC_WANT_IEC_60559_FUNCS_EXT__ 1 +#endif +#if defined(__cplusplus) && !defined(DO_NOT_USE_CXX_HEADERS) +# include <cmath> +// See comment in R.h +# ifdef __SUNPRO_CC +using namespace std; +# endif +#else +# include <math.h> +#endif + +#ifdef NO_C_HEADERS +# warning "use of NO_C_HEADERS is defunct and will be ignored" +#endif + +/*-- Mathlib as part of R -- define this for standalone : */ +/* #undef MATHLIB_STANDALONE */ + +#define R_VERSION_STRING "@PACKAGE_VERSION@" + +#ifndef HAVE_EXPM1 +@RMATH_HAVE_EXPM1@ +#endif + +#ifndef HAVE_HYPOT +@RMATH_HAVE_HYPOT@ +#endif + +#ifndef HAVE_LOG1P +@RMATH_HAVE_LOG1P@ +#endif + +#ifndef HAVE_WORKING_LOG1P +@RMATH_HAVE_WORKING_LOG1P@ +#endif + +#if defined(HAVE_LOG1P) && !defined(HAVE_WORKING_LOG1P) +/* remap to avoid problems with getting the right entry point */ +double Rlog1p(double); +#define log1p Rlog1p +#endif + + + /* Undo SGI Madness */ + +#ifdef __sgi +# ifdef ftrunc +# undef ftrunc +# endif +# ifdef qexp +# undef qexp +# endif +# ifdef qgamma +# undef qgamma +# endif +#endif + + +/* ----- The following constants and entry points are part of the R API ---- */ + +/* 30 Decimal-place constants */ +/* Computed with bc -l (scale=32; proper round) */ + +/* SVID & X/Open Constants */ +/* Names from Solaris math.h */ + +#ifndef M_E +#define M_E 2.718281828459045235360287471353 /* e */ +#endif + +#ifndef M_LOG2E +#define M_LOG2E 1.442695040888963407359924681002 /* log2(e) */ +#endif + +#ifndef M_LOG10E +#define M_LOG10E 0.434294481903251827651128918917 /* log10(e) */ +#endif + +#ifndef M_LN2 +#define M_LN2 0.693147180559945309417232121458 /* ln(2) */ +#endif + +#ifndef M_LN10 +#define M_LN10 2.302585092994045684017991454684 /* ln(10) */ +#endif + +#ifndef M_PI +#define M_PI 3.141592653589793238462643383280 /* pi */ +#endif + +#ifndef M_2PI +#define M_2PI 6.283185307179586476925286766559 /* 2*pi */ +#endif + +#ifndef M_PI_2 +#define M_PI_2 1.570796326794896619231321691640 /* pi/2 */ +#endif + +#ifndef M_PI_4 +#define M_PI_4 0.785398163397448309615660845820 /* pi/4 */ +#endif + +#ifndef M_1_PI +#define M_1_PI 0.318309886183790671537767526745 /* 1/pi */ +#endif + +#ifndef M_2_PI +#define M_2_PI 0.636619772367581343075535053490 /* 2/pi */ +#endif + +#ifndef M_2_SQRTPI +#define M_2_SQRTPI 1.128379167095512573896158903122 /* 2/sqrt(pi) */ +#endif + +#ifndef M_SQRT2 +#define M_SQRT2 1.414213562373095048801688724210 /* sqrt(2) */ +#endif + +#ifndef M_SQRT1_2 +#define M_SQRT1_2 0.707106781186547524400844362105 /* 1/sqrt(2) */ +#endif + +/* R-Specific Constants */ + +#ifndef M_SQRT_3 +#define M_SQRT_3 1.732050807568877293527446341506 /* sqrt(3) */ +#endif + +#ifndef M_SQRT_32 +#define M_SQRT_32 5.656854249492380195206754896838 /* sqrt(32) */ +#endif + +#ifndef M_LOG10_2 +#define M_LOG10_2 0.301029995663981195213738894724 /* log10(2) */ +#endif + +#ifndef M_SQRT_PI +#define M_SQRT_PI 1.772453850905516027298167483341 /* sqrt(pi) */ +#endif + +#ifndef M_1_SQRT_2PI +#define M_1_SQRT_2PI 0.398942280401432677939946059934 /* 1/sqrt(2pi) */ +#endif + +#ifndef M_SQRT_2dPI +#define M_SQRT_2dPI 0.797884560802865355879892119869 /* sqrt(2/pi) */ +#endif + + +#ifndef M_LN_2PI +#define M_LN_2PI 1.837877066409345483560659472811 /* log(2*pi) */ +#endif + +#ifndef M_LN_SQRT_PI +#define M_LN_SQRT_PI 0.572364942924700087071713675677 /* log(sqrt(pi)) + == log(pi)/2 */ +#endif + +#ifndef M_LN_SQRT_2PI +#define M_LN_SQRT_2PI 0.918938533204672741780329736406 /* log(sqrt(2*pi)) + == log(2*pi)/2 */ +#endif + +#ifndef M_LN_SQRT_PId2 +#define M_LN_SQRT_PId2 0.225791352644727432363097614947 /* log(sqrt(pi/2)) + == log(pi/2)/2 */ +#endif + + +#ifdef MATHLIB_STANDALONE +# ifndef R_EXT_BOOLEAN_H_ +/* "copy-paste" R_ext/Boolean.h if not already included: */ + #define R_EXT_BOOLEAN_H_ + #undef FALSE + #undef TRUE + typedef enum { FALSE = 0, TRUE } Rboolean; +# endif +#else +# include <R_ext/Boolean.h> +#endif + + +#if !defined(MATHLIB_STANDALONE) && !defined(R_NO_REMAP_RMATH) +#define bessel_i Rf_bessel_i +#define bessel_j Rf_bessel_j +#define bessel_k Rf_bessel_k +#define bessel_y Rf_bessel_y +#define bessel_i_ex Rf_bessel_i_ex +#define bessel_j_ex Rf_bessel_j_ex +#define bessel_k_ex Rf_bessel_k_ex +#define bessel_y_ex Rf_bessel_y_ex +#define beta Rf_beta +#define choose Rf_choose +#define dbeta Rf_dbeta +#define dbinom Rf_dbinom +#define dbinom_raw Rf_dbinom_raw +#define dcauchy Rf_dcauchy +#define dchisq Rf_dchisq +#define dexp Rf_dexp +#define df Rf_df +#define dgamma Rf_dgamma +#define dgeom Rf_dgeom +#define dhyper Rf_dhyper +#define digamma Rf_digamma +#define dlnorm Rf_dlnorm +#define dlogis Rf_dlogis +#define dnbeta Rf_dnbeta +#define dnbinom Rf_dnbinom +#define dnbinom_mu Rf_dnbinom_mu +#define dnchisq Rf_dnchisq +#define dnf Rf_dnf +#define dnorm4 Rf_dnorm4 +#define dnt Rf_dnt +#define dpois_raw Rf_dpois_raw +#define dpois Rf_dpois +#define dpsifn Rf_dpsifn +#define dsignrank Rf_dsignrank +#define dt Rf_dt +#define dtukey Rf_dtukey +#define dunif Rf_dunif +#define dweibull Rf_dweibull +#define dwilcox Rf_dwilcox +#define fmax2 Rf_fmax2 +#define fmin2 Rf_fmin2 +#define fprec Rf_fprec +#define fround Rf_fround +#define ftrunc Rf_ftrunc +#define fsign Rf_fsign +#define gammafn Rf_gammafn +#define imax2 Rf_imax2 +#define imin2 Rf_imin2 +#define lbeta Rf_lbeta +#define lchoose Rf_lchoose +#define lgammafn Rf_lgammafn +#define lgammafn_sign Rf_lgammafn_sign +#define lgamma1p Rf_lgamma1p +#define log1pexp Rf_log1pexp +#define log1pmx Rf_log1pmx +#define logspace_add Rf_logspace_add +#define logspace_sub Rf_logspace_sub +#define logspace_sum Rf_logspace_sum +#define pbeta Rf_pbeta +#define pbeta_raw Rf_pbeta_raw +#define pbinom Rf_pbinom +#define pcauchy Rf_pcauchy +#define pchisq Rf_pchisq +#define pentagamma Rf_pentagamma +#define pexp Rf_pexp +#define pf Rf_pf +#define pgamma Rf_pgamma +#define pgeom Rf_pgeom +#define phyper Rf_phyper +#define plnorm Rf_plnorm +#define plogis Rf_plogis +#define pnbeta Rf_pnbeta +#define pnbinom Rf_pnbinom +#define pnbinom_mu Rf_pnbinom_mu +#define pnchisq Rf_pnchisq +#define pnf Rf_pnf +#define pnorm5 Rf_pnorm5 +#define pnorm_both Rf_pnorm_both +#define pnt Rf_pnt +#define ppois Rf_ppois +#define psignrank Rf_psignrank +#define psigamma Rf_psigamma +#define pt Rf_pt +#define ptukey Rf_ptukey +#define punif Rf_punif +#define pythag Rf_pythag +#define pweibull Rf_pweibull +#define pwilcox Rf_pwilcox +#define qbeta Rf_qbeta +#define qbinom Rf_qbinom +#define qcauchy Rf_qcauchy +#define qchisq Rf_qchisq +#define qchisq_appr Rf_qchisq_appr +#define qexp Rf_qexp +#define qf Rf_qf +#define qgamma Rf_qgamma +#define qgeom Rf_qgeom +#define qhyper Rf_qhyper +#define qlnorm Rf_qlnorm +#define qlogis Rf_qlogis +#define qnbeta Rf_qnbeta +#define qnbinom Rf_qnbinom +#define qnbinom_mu Rf_qnbinom_mu +#define qnchisq Rf_qnchisq +#define qnf Rf_qnf +#define qnorm5 Rf_qnorm5 +#define qnt Rf_qnt +#define qpois Rf_qpois +#define qsignrank Rf_qsignrank +#define qt Rf_qt +#define qtukey Rf_qtukey +#define qunif Rf_qunif +#define qweibull Rf_qweibull +#define qwilcox Rf_qwilcox +#define rbeta Rf_rbeta +#define rbinom Rf_rbinom +#define rcauchy Rf_rcauchy +#define rchisq Rf_rchisq +#define rexp Rf_rexp +#define rf Rf_rf +#define rgamma Rf_rgamma +#define rgeom Rf_rgeom +#define rhyper Rf_rhyper +#define rlnorm Rf_rlnorm +#define rlogis Rf_rlogis +#define rmultinom Rf_rmultinom +#define rnbeta Rf_rnbeta +#define rnbinom Rf_rnbinom +#define rnbinom_mu Rf_rnbinom_mu +#define rnchisq Rf_rnchisq +#define rnf Rf_rnf +#define rnorm Rf_rnorm +#define rnt Rf_rnt +#define rpois Rf_rpois +#define rsignrank Rf_rsignrank +#define rt Rf_rt +#define rtukey Rf_rtukey +#define runif Rf_runif +#define rweibull Rf_rweibull +#define rwilcox Rf_rwilcox +#define sign Rf_sign +#define tetragamma Rf_tetragamma +#define trigamma Rf_trigamma +#endif + +#define dnorm dnorm4 +#define pnorm pnorm5 +#define qnorm qnorm5 + +#ifdef __cplusplus +extern "C" { +#endif + /* R's versions with !R_FINITE checks */ + +double R_pow(double x, double y); +double R_pow_di(double, int); + + /* Random Number Generators */ + +double norm_rand(void); +double unif_rand(void); +double exp_rand(void); +#ifdef MATHLIB_STANDALONE +void set_seed(unsigned int, unsigned int); +void get_seed(unsigned int *, unsigned int *); +#endif + + /* Normal Distribution */ + +double dnorm(double, double, double, int); +double pnorm(double, double, double, int, int); +double qnorm(double, double, double, int, int); +double rnorm(double, double); +void pnorm_both(double, double *, double *, int, int);/* both tails */ + + /* Uniform Distribution */ + +double dunif(double, double, double, int); +double punif(double, double, double, int, int); +double qunif(double, double, double, int, int); +double runif(double, double); + + /* Gamma Distribution */ + +double dgamma(double, double, double, int); +double pgamma(double, double, double, int, int); +double qgamma(double, double, double, int, int); +double rgamma(double, double); + +double log1pmx(double); +double log1pexp(double); // <-- ../nmath/plogis.c +double lgamma1p(double); +double logspace_add(double, double); +double logspace_sub(double, double); +double logspace_sum(const double *, int); + + /* Beta Distribution */ + +double dbeta(double, double, double, int); +double pbeta(double, double, double, int, int); +double qbeta(double, double, double, int, int); +double rbeta(double, double); + + /* Lognormal Distribution */ + +double dlnorm(double, double, double, int); +double plnorm(double, double, double, int, int); +double qlnorm(double, double, double, int, int); +double rlnorm(double, double); + + /* Chi-squared Distribution */ + +double dchisq(double, double, int); +double pchisq(double, double, int, int); +double qchisq(double, double, int, int); +double rchisq(double); + + /* Non-central Chi-squared Distribution */ + +double dnchisq(double, double, double, int); +double pnchisq(double, double, double, int, int); +double qnchisq(double, double, double, int, int); +double rnchisq(double, double); + + /* F Distibution */ + +double df(double, double, double, int); +double pf(double, double, double, int, int); +double qf(double, double, double, int, int); +double rf(double, double); + + /* Student t Distibution */ + +double dt(double, double, int); +double pt(double, double, int, int); +double qt(double, double, int, int); +double rt(double); + + /* Binomial Distribution */ + +double dbinom_raw(double x, double n, double p, double q, int give_log); +double dbinom(double, double, double, int); +double pbinom(double, double, double, int, int); +double qbinom(double, double, double, int, int); +double rbinom(double, double); + + /* Multnomial Distribution */ + +void rmultinom(int, double*, int, int*); + + /* Cauchy Distribution */ + +double dcauchy(double, double, double, int); +double pcauchy(double, double, double, int, int); +double qcauchy(double, double, double, int, int); +double rcauchy(double, double); + + /* Exponential Distribution */ + +double dexp(double, double, int); +double pexp(double, double, int, int); +double qexp(double, double, int, int); +double rexp(double); + + /* Geometric Distribution */ + +double dgeom(double, double, int); +double pgeom(double, double, int, int); +double qgeom(double, double, int, int); +double rgeom(double); + + /* Hypergeometric Distibution */ + +double dhyper(double, double, double, double, int); +double phyper(double, double, double, double, int, int); +double qhyper(double, double, double, double, int, int); +double rhyper(double, double, double); + + /* Negative Binomial Distribution */ + +double dnbinom(double, double, double, int); +double pnbinom(double, double, double, int, int); +double qnbinom(double, double, double, int, int); +double rnbinom(double, double); + +double dnbinom_mu(double, double, double, int); +double pnbinom_mu(double, double, double, int, int); +double qnbinom_mu(double, double, double, int, int); +double rnbinom_mu(double, double); + + /* Poisson Distribution */ + +double dpois_raw (double, double, int); +double dpois(double, double, int); +double ppois(double, double, int, int); +double qpois(double, double, int, int); +double rpois(double); + + /* Weibull Distribution */ + +double dweibull(double, double, double, int); +double pweibull(double, double, double, int, int); +double qweibull(double, double, double, int, int); +double rweibull(double, double); + + /* Logistic Distribution */ + +double dlogis(double, double, double, int); +double plogis(double, double, double, int, int); +double qlogis(double, double, double, int, int); +double rlogis(double, double); + + /* Non-central Beta Distribution */ + +double dnbeta(double, double, double, double, int); +double pnbeta(double, double, double, double, int, int); +double qnbeta(double, double, double, double, int, int); +double rnbeta(double, double, double); + + /* Non-central F Distribution */ + +double dnf(double, double, double, double, int); +double pnf(double, double, double, double, int, int); +double qnf(double, double, double, double, int, int); + + /* Non-central Student t Distribution */ + +double dnt(double, double, double, int); +double pnt(double, double, double, int, int); +double qnt(double, double, double, int, int); + + /* Studentized Range Distribution */ + +double ptukey(double, double, double, double, int, int); +double qtukey(double, double, double, double, int, int); + + /* Wilcoxon Rank Sum Distribution */ + +double dwilcox(double, double, double, int); +double pwilcox(double, double, double, int, int); +double qwilcox(double, double, double, int, int); +double rwilcox(double, double); + + /* Wilcoxon Signed Rank Distribution */ + +double dsignrank(double, double, int); +double psignrank(double, double, int, int); +double qsignrank(double, double, int, int); +double rsignrank(double); + + /* Gamma and Related Functions */ +double gammafn(double); +double lgammafn(double); +double lgammafn_sign(double, int*); +void dpsifn(double, int, int, int, double*, int*, int*); +double psigamma(double, double); +double digamma(double); +double trigamma(double); +double tetragamma(double); +double pentagamma(double); + +double beta(double, double); +double lbeta(double, double); + +double choose(double, double); +double lchoose(double, double); + + /* Bessel Functions */ + +double bessel_i(double, double, double); +double bessel_j(double, double); +double bessel_k(double, double, double); +double bessel_y(double, double); +double bessel_i_ex(double, double, double, double *); +double bessel_j_ex(double, double, double *); +double bessel_k_ex(double, double, double, double *); +double bessel_y_ex(double, double, double *); + + + /* General Support Functions */ + +#ifndef HAVE_HYPOT +double hypot(double, double); +#endif +double pythag(double, double); +#ifndef HAVE_EXPM1 +double expm1(double); /* = exp(x)-1 {care for small x} */ +#endif +#ifndef HAVE_LOG1P +double log1p(double); /* = log(1+x) {care for small x} */ +#endif +int imax2(int, int); +int imin2(int, int); +double fmax2(double, double); +double fmin2(double, double); +double sign(double); +double fprec(double, double); +double fround(double, double); +double fsign(double, double); +double ftrunc(double); + +double log1pmx(double); /* Accurate log(1+x) - x, {care for small x} */ +double lgamma1p(double);/* accurate log(gamma(x+1)), small x (0 < x < 0.5) */ + +/* More accurate cos(pi*x), sin(pi*x), tan(pi*x) + + These declarations might clash with system headers if someone had + already included math.h with __STDC_WANT_IEC_60559_FUNCS_EXT__ + defined (and we try, above). + We can add a check for that via the value of + __STDC_IEC_60559_FUNCS__ (>= 201506L). +*/ +double cospi(double); +double sinpi(double); +double tanpi(double); + +/* Compute the log of a sum or difference from logs of terms, i.e., + * + * log (exp (logx) + exp (logy)) + * or log (exp (logx) - exp (logy)) + * + * without causing overflows or throwing away too much accuracy: + */ +double logspace_add(double logx, double logy); +double logspace_sub(double logx, double logy); + + +/* ----------------- Private part of the header file ------------------- */ + + /* old-R Compatibility */ + +#ifdef OLD_RMATH_COMPAT +# define snorm norm_rand +# define sunif unif_rand +# define sexp exp_rand +#endif + +#if defined(MATHLIB_STANDALONE) && !defined(MATHLIB_PRIVATE_H) +/* second is defined by nmath.h */ + +/* If isnan is a macro, as C99 specifies, the C++ + math header will undefine it. This happens on macOS */ +# ifdef __cplusplus + int R_isnancpp(double); /* in mlutils.c */ +# define ISNAN(x) R_isnancpp(x) +# else +# define ISNAN(x) (isnan(x)!=0) +# endif + +# define R_FINITE(x) R_finite(x) +int R_finite(double); + +# ifdef _WIN32 /* not Win32 as no config information */ +# ifdef RMATH_DLL +# define R_EXTERN extern __declspec(dllimport) +# else +# define R_EXTERN extern +# endif +R_EXTERN double NA_REAL; +R_EXTERN double R_PosInf; +R_EXTERN double R_NegInf; +R_EXTERN int N01_kind; +# undef R_EXTERN +#else +extern int N01_kind; +# endif + +#endif /* MATHLIB_STANDALONE */ + +#ifdef __cplusplus +} +#endif + +#endif /* RMATH_H */ diff --git a/com.oracle.truffle.r.native/gnur/patch/src/include/Rmodules/RX11.h b/com.oracle.truffle.r.native/gnur/patch/src/include/Rmodules/RX11.h new file mode 100644 index 0000000000000000000000000000000000000000..e63c1f5e2843e65931f1ffa58127cf65932743cb --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/include/Rmodules/RX11.h @@ -0,0 +1,63 @@ +/* + * R : A Computer Language for Statistical Data Analysis + * Copyright (C) 2001-2014 The R Core Team. + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU Lesser General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; if not, a copy is available at + * https://www.R-project.org/Licenses/ + */ + +/* Definitions for the X11 module. Not intended for end-user use */ + +#ifndef R_X11_MODULE_H +#define R_X11_MODULE_H + +#include <Rinternals.h> +#include <Rconnections.h> + +typedef SEXP (*R_do_X11)(SEXP call, SEXP op, SEXP args, SEXP rho); +typedef SEXP (*R_X11DataEntryRoutine)(SEXP call, SEXP op, SEXP args, SEXP rho); +typedef SEXP (*R_X11DataViewer)(SEXP call, SEXP op, SEXP args, SEXP rho); +typedef Rboolean (*R_GetX11ImageRoutine)(int d, void *pximage, + int *pwidth, int *pheight); +typedef int (*R_X11_access)(void); + +typedef Rboolean (*R_X11clp)(Rclpconn, char*); + +typedef const char * (*R_version_t)(void); + + +typedef struct { + R_do_X11 X11; + R_do_X11 saveplot; + R_GetX11ImageRoutine image; + R_X11_access access; + R_X11clp readclp; + R_version_t R_pngVersion, R_jpegVersion, R_tiffVersion; +} R_X11Routines; + +typedef struct { + R_X11DataEntryRoutine de; + R_X11DataViewer dv; +} R_deRoutines; + +#ifdef __cplusplus +extern "C" { +#endif +R_X11Routines *R_setX11Routines(R_X11Routines *routines); +R_deRoutines *R_setdeRoutines(R_deRoutines *routines); +#ifdef __cplusplus +} +#endif + +#endif /* R_X11_MODULE_H */ diff --git a/com.oracle.truffle.r.native/gnur/patch/src/include/Rmodules/Rinternet.h b/com.oracle.truffle.r.native/gnur/patch/src/include/Rmodules/Rinternet.h new file mode 100644 index 0000000000000000000000000000000000000000..619992eedaa16838140ee275bf0c83d03cefed39 --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/include/Rmodules/Rinternet.h @@ -0,0 +1,86 @@ +/* + * R : A Computer Language for Statistical Data Analysis + * Copyright (C) 2004-2015 The R Core Team + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version. + * + * This program 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 this program; if not, a copy is available at + * https://www.R-project.org/Licenses/ + */ + +#ifndef R_INTERNET_MODULE_H +#define R_INTERNET_MODULE_H + + +#include <Rinternals.h> + + +typedef SEXP (*R_DownloadRoutine)(SEXP args); +typedef Rconnection (*R_NewUrlRoutine)(const char *description, const char * const mode, int method); +typedef Rconnection (*R_NewSockRoutine)(const char *host, int port, int server, const char *const mode, int timeout); + +typedef void * (*R_HTTPOpenRoutine)(const char *url, const char *headers, const int cacheOK); +typedef int (*R_HTTPReadRoutine)(void *ctx, char *dest, int len); +typedef void (*R_HTTPCloseRoutine)(void *ctx); + +typedef void * (*R_FTPOpenRoutine)(const char *url); +typedef int (*R_FTPReadRoutine)(void *ctx, char *dest, int len); +typedef void (*R_FTPCloseRoutine)(void *ctx); + +typedef void (*R_SockOpenRoutine)(int *port); +typedef void (*R_SockListenRoutine)(int *sockp, char **buf, int *len); +typedef void (*R_SockConnectRoutine)(int *port, char **host); +typedef void (*R_SockCloseRoutine)(int *sockp); + +typedef void (*R_SockReadRoutine)(int *sockp, char **buf, int *maxlen); +typedef void (*R_SockWriteRoutine)(int *sockp, char **buf, int *start, int *end, int *len); +typedef int (*R_SockSelectRoutine)(int nsock, int *insockfd, int *ready, int *write, double timeout); + +typedef int (*R_HTTPDCreateRoutine)(const char *ip, int port); +typedef void (*R_HTTPDStopRoutine)(); + +typedef SEXP (*R_CurlRoutine)(SEXP call, SEXP op, SEXP args, SEXP rho); + +typedef struct { + R_DownloadRoutine download; + R_NewUrlRoutine newurl; + R_NewSockRoutine newsock; + + R_HTTPOpenRoutine HTTPOpen; + R_HTTPReadRoutine HTTPRead; + R_HTTPCloseRoutine HTTPClose; + + R_FTPOpenRoutine FTPOpen; + R_FTPReadRoutine FTPRead; + R_FTPCloseRoutine FTPClose; + + R_SockOpenRoutine sockopen; + R_SockListenRoutine socklisten; + R_SockConnectRoutine sockconnect; + R_SockCloseRoutine sockclose; + + R_SockReadRoutine sockread; + R_SockWriteRoutine sockwrite; + R_SockSelectRoutine sockselect; + + R_HTTPDCreateRoutine HTTPDCreate; + R_HTTPDStopRoutine HTTPDStop; + + R_CurlRoutine curlVersion; + R_CurlRoutine curlGetHeaders; + R_CurlRoutine curlDownload; + R_NewUrlRoutine newcurlurl; +} R_InternetRoutines; + +R_InternetRoutines *R_setInternetRoutines(R_InternetRoutines *routines); + +#endif /* ifndef R_INTERNET_MODULE_H */ diff --git a/com.oracle.truffle.r.native/gnur/patch/src/include/Rmodules/Rlapack.h b/com.oracle.truffle.r.native/gnur/patch/src/include/Rmodules/Rlapack.h new file mode 100644 index 0000000000000000000000000000000000000000..e192d27574fd3222d80eb8e0307d4f0ecb141f37 --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/include/Rmodules/Rlapack.h @@ -0,0 +1,36 @@ +/* + * R : A Computer Language for Statistical Data Analysis + * Copyright (C) 2001-2010 The R Core Team. + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU Lesser General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; if not, a copy is available at + * https://www.R-project.org/Licenses/ + */ + +/* Definitions for the Lapack module. Not intended for end-user use */ + +#ifndef R_LAPACK_MODULE_H +#define R_LAPACK_MODULE_H + +#include <Rinternals.h> + +typedef SEXP (*Rf_do_lapack)(SEXP, SEXP, SEXP, SEXP); + +typedef struct { + Rf_do_lapack do_lapack; +} R_LapackRoutines; + +R_LapackRoutines *R_setLapackRoutines(R_LapackRoutines *routines); + + +#endif /* R_LAPACK_MODULE_H */ diff --git a/com.oracle.truffle.r.native/gnur/patch/src/include/S.h b/com.oracle.truffle.r.native/gnur/patch/src/include/S.h new file mode 100644 index 0000000000000000000000000000000000000000..03414717d39549f4dd44e58345f7259bbdcc8b6e --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/include/S.h @@ -0,0 +1,90 @@ +/* + * R : A Computer Language for Statistical Data Analysis + * Copyright (C) 1995, 1996 Robert Gentleman and Ross Ihaka + * Copyright (C) 1997--2016 The R Core Team. + * + * This header file is free software; you can redistribute it and/or modify + * it under the terms of the GNU Lesser General Public License as published by + * the Free Software Foundation; either version 2.1 of the License, or + * (at your option) any later version. + * + * This file is part of R. R is distributed under the terms of the + * GNU General Public License, either Version 2, June 1991 or Version 3, + * June 2007. See doc/COPYRIGHTS for details of the copyright status of R. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public License + * along with this program; if not, a copy is available at + * https://www.R-project.org/Licenses/ + * + * Much of this is from Doug Bates. + */ + +/* + This is a legacy header and no longer documented. + Code using it should be converted to use R.h +*/ + +/* This header includes C headers and so is not safe for inclusion + from C++: use R.h instead. */ + +#ifndef R_S_H +#define R_S_H + +#ifndef USING_R +# define USING_R +/* is this a good idea? - conflicts with many versions of f2c.h */ +# define longint int +#endif + +#ifdef __cplusplus +# error S.h can not be used from C++ code: use R.h instead +#endif + +#include <stddef.h> +#include <stdlib.h> +#include <stdio.h> +#include <limits.h> +#include <float.h> +#include <math.h> + +#include <Rconfig.h> +#include <R_ext/Constants.h> +#include <R_ext/Memory.h> /* S_alloc */ + +/* subset of those in Random.h */ +extern void seed_in(long *); +extern void seed_out(long *); +extern double unif_rand(void); +extern double norm_rand(void); + +/* Macros for S/R Compatibility */ + +#include <R_ext/RS.h> +/* for PROBLEM ... Calloc, Realloc, Free, Memcpy, F77_xxxx */ + +/* S4 uses macros equivalent to */ +#define Salloc(n,t) (t*)S_alloc(n, sizeof(t)) +#define Srealloc(p,n,old,t) (t*)S_realloc(p,n,old,sizeof(t)) + +/* S's complex is different, and is a define to S_complex now */ +typedef struct { + double re; + double im; +} S_complex; + +#ifdef S_OLD_COMPLEX +# define complex S_complex +#endif + +#ifndef NO_CALL_R +/* Not quite full compatibility: beware! */ +/* void call_R(char*, long, void**, char**, long*, char**, long, char**);*/ +#define call_S call_R +#endif + +#endif /* !R_S_H */ diff --git a/com.oracle.truffle.r.native/gnur/patch/src/include/Startup.h b/com.oracle.truffle.r.native/gnur/patch/src/include/Startup.h new file mode 100644 index 0000000000000000000000000000000000000000..cea390030872445a6ca13dfc4966b4e6c69d0fd0 --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/include/Startup.h @@ -0,0 +1,40 @@ +/* + * R : A Computer Language for Statistical Data Analysis + * Copyright (C) 1999-2014 The R Core Team + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version. + * + * This program 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 this program; if not, a copy is available at + * https://www.R-project.org/Licenses/ + */ + +/* Internal header, not installed */ + +#ifndef STARTUP_H_ +#define STARTUP_H_ + +#include <R_ext/RStartup.h> /* The meat here */ +#ifdef _WIN32 +extern UImode CharacterMode; +#endif + + +/* originally from Defn.h : */ + +void R_CleanUp(SA_TYPE, int, int); +void R_StartUp(void); + +FILE *R_OpenInitFile(void); +FILE *R_OpenSysInitFile(void); +FILE *R_OpenSiteFile(void); + +#endif diff --git a/com.oracle.truffle.r.native/gnur/patch/src/include/config.h.in b/com.oracle.truffle.r.native/gnur/patch/src/include/config.h.in new file mode 100644 index 0000000000000000000000000000000000000000..faa043acdacdb6595455dcbd79d0a7df6f6e8ec9 --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/include/config.h.in @@ -0,0 +1,1267 @@ +/* src/include/config.h.in. Generated from configure.ac by autoheader. */ + +#ifndef R_CONFIG_H +#define R_CONFIG_H + +/* Define to one of `_getb67', `GETB67', `getb67' for Cray-2 and Cray-YMP + systems. This function is required for `alloca.c' support on those systems. + */ +#undef CRAY_STACKSEG_END + +/* Define to 1 if using `alloca.c'. */ +#undef C_ALLOCA + +/* Define to 1 if translation of program messages to the user's native + language is requested. */ +#undef ENABLE_NLS + +/* Define to dummy `main' function (if any) required to link to the Fortran + libraries. */ +#undef F77_DUMMY_MAIN + +/* Define to a macro mangling the given C identifier (in lower and upper + case), which must not contain underscores, for linking with Fortran. */ +#undef F77_FUNC + +/* As F77_FUNC, but for C identifiers containing underscores. */ +#undef F77_FUNC_ + +/* Define if F77 and FC dummy `main' functions are identical. */ +#undef FC_DUMMY_MAIN_EQ_F77 + +/* Define to 1 if you have the `access' function. */ +#undef HAVE_ACCESS + +/* Define to 1 if you have `alloca', as a function or macro. */ +#undef HAVE_ALLOCA + +/* Define to 1 if you have <alloca.h> and it should be used (not on Ultrix). + */ +#undef HAVE_ALLOCA_H + +/* Define if you have the Aqua headers and libraries, and want to include + support for R.app and for the quartz() device to be built. */ +#undef HAVE_AQUA + +/* Define to 1 if you have the `argz_count' function. */ +#undef HAVE_ARGZ_COUNT + +/* Define to 1 if you have the <argz.h> header file. */ +#undef HAVE_ARGZ_H + +/* Define to 1 if you have the `argz_next' function. */ +#undef HAVE_ARGZ_NEXT + +/* Define to 1 if you have the `argz_stringify' function. */ +#undef HAVE_ARGZ_STRINGIFY + +/* Define to 1 if you have the <arpa/inet.h> header file. */ +#undef HAVE_ARPA_INET_H + +/* Define to 1 if you have the `asprintf' function. */ +#undef HAVE_ASPRINTF + +/* Define to 1 if you have the `atan2pi' function. */ +#undef HAVE_ATAN2PI + +/* Define to 1 if you have the `atanpi' function. */ +#undef HAVE_ATANPI + +/* Define to 1 if the compiler understands __builtin_expect. (For intl) */ +#undef HAVE_BUILTIN_EXPECT + +/* Define to 1 if you have the <bzlib.h> header file. */ +#undef HAVE_BZLIB_H + +/* Define to 1 if you have the `cabs' function. */ +#undef HAVE_CABS + +/* Define to 1 if you have the `cacos' function. */ +#undef HAVE_CACOS + +/* Define to 1 if you have cairo-ps. */ +#undef HAVE_CAIRO_PDF + +/* Define to 1 if you have cairo-pdf. */ +#undef HAVE_CAIRO_PS + +/* Define to 1 if you have cairo-svg. */ +#undef HAVE_CAIRO_SVG + +/* Define to 1 if you have the `carg' function. */ +#undef HAVE_CARG + +/* Define to 1 if you have the `casin' function. */ +#undef HAVE_CASIN + +/* Define to 1 if you have the `catan' function. */ +#undef HAVE_CATAN + +/* Define to 1 if you have the `ccos' function. */ +#undef HAVE_CCOS + +/* Define to 1 if you have the `ccosh' function. */ +#undef HAVE_CCOSH + +/* Define to 1 if you have the `cexp' function. */ +#undef HAVE_CEXP + +/* Define to 1 if you have the OS X function CFLocaleCopyCurrent in the + CoreFoundation framework. (For intl) */ +#undef HAVE_CFLOCALECOPYCURRENT + +/* Define to 1 if you have the OS X function CFPreferencesCopyAppValue in the + CoreFoundation framework. (For intl) */ +#undef HAVE_CFPREFERENCESCOPYAPPVALUE + +/* Define to 1 if you have the `chdir' function. */ +#undef HAVE_CHDIR + +/* Define to 1 if you have the `chmod' function. */ +#undef HAVE_CHMOD + +/* Define to 1 if you have the `clock_gettime' function. */ +#undef HAVE_CLOCK_GETTIME + +/* Define to 1 if you have the `clog' function. */ +#undef HAVE_CLOG + +/* Defined if framework CoreFoundation is present */ +#undef HAVE_COREFOUNDATION_FW + +/* Define to 1 if you have the `cospi' function. */ +#undef HAVE_COSPI + +/* Define to 1 if you have the `cpow' function. */ +#undef HAVE_CPOW + +/* Define to 1 if you have the `csin' function. */ +#undef HAVE_CSIN + +/* Define to 1 if you have the `csinh' function. */ +#undef HAVE_CSINH + +/* Define to 1 if you have the `csqrt' function. */ +#undef HAVE_CSQRT + +/* Define to 1 if you have the `ctan' function. */ +#undef HAVE_CTAN + +/* Define to 1 if you have the `ctanh' function. */ +#undef HAVE_CTANH + +/* Define to 1 if you have the <curl/curl.h> header file. */ +#undef HAVE_CURL_CURL_H + +/* Define if the GNU dcgettext() function is already present or preinstalled. + */ +#undef HAVE_DCGETTEXT + +/* Define to 1 if you have the declaration of `alloca', and to 0 if you don't. + */ +#undef HAVE_DECL_ALLOCA + +/* Define to 1 if you have the declaration of `dladdr', and to 0 if you don't. + */ +#undef HAVE_DECL_DLADDR + +/* Define to 1 if you have the declaration of `dlsym', and to 0 if you don't. + */ +#undef HAVE_DECL_DLSYM + +/* Define to 1 if you have the declaration of `feof_unlocked', and to 0 if you + don't. (For intl) */ +#undef HAVE_DECL_FEOF_UNLOCKED + +/* Define to 1 if you have the declaration of `fgets_unlocked', and to 0 if + you don't. (For intl) */ +#undef HAVE_DECL_FGETS_UNLOCKED + +/* Define to 1 if you have the declaration of `getc_unlocked', and to 0 if you + don't. (For intl) */ +#undef HAVE_DECL_GETC_UNLOCKED + +/* Define to 1 if you have the declaration of `isfinite', and to 0 if you + don't. */ +#undef HAVE_DECL_ISFINITE + +/* Define to 1 if you have the declaration of `isnan', and to 0 if you don't. + */ +#undef HAVE_DECL_ISNAN + +/* Define to 1 if you have the declaration of `mkdtemp', and to 0 if you + don't. */ +#undef HAVE_DECL_MKDTEMP + +/* Define to 1 if you have the declaration of `putenv', and to 0 if you don't. + */ +#undef HAVE_DECL_PUTENV + +/* Define to 1 if you have the declaration of `realpath', and to 0 if you + don't. */ +#undef HAVE_DECL_REALPATH + +/* Define to 1 if you have the declaration of `RTLD_DEFAULT', and to 0 if you + don't. */ +#undef HAVE_DECL_RTLD_DEFAULT + +/* Define to 1 if you have the declaration of `RTLD_NEXT', and to 0 if you + don't. */ +#undef HAVE_DECL_RTLD_NEXT + +/* Define to 1 if you have the declaration of `siglongjmp', and to 0 if you + don't. */ +#undef HAVE_DECL_SIGLONGJMP + +/* Define to 1 if you have the declaration of `sigsetjmp', and to 0 if you + don't. */ +#undef HAVE_DECL_SIGSETJMP + +/* Define to 1 if you have the declaration of `SIZE_MAX', and to 0 if you + don't. */ +#undef HAVE_DECL_SIZE_MAX + +/* Define to 1 if you have the declaration of `strdup', and to 0 if you don't. + */ +#undef HAVE_DECL_STRDUP + +/* Define to 1 if you have the declaration of `strncasecmp', and to 0 if you + don't. */ +#undef HAVE_DECL_STRNCASECMP + +/* Define to 1 if you have the declaration of `vasprintf', and to 0 if you + don't. */ +#undef HAVE_DECL_VASPRINTF + +/* Define to 1 if you have the declaration of `_snprintf', and to 0 if you + don't. (For intl) */ +#undef HAVE_DECL__SNPRINTF + +/* Define to 1 if you have the declaration of `_snwprintf', and to 0 if you + don't. (For intl) */ +#undef HAVE_DECL__SNWPRINTF + +/* Define to 1 if you have the <dirent.h> header file, and it defines `DIR'. + */ +#undef HAVE_DIRENT_H + +/* Define to 1 if you have the `dladdr' function. */ +#undef HAVE_DLADDR + +/* Define to 1 if you have the <dlfcn.h> header file. */ +#undef HAVE_DLFCN_H + +/* Define to 1 if you have the `dlsym' function. */ +#undef HAVE_DLSYM + +/* Define to 1 if you have the <dl.h> header file. */ +#undef HAVE_DL_H + +/* Define to 1 if you have the <elf.h> header file. */ +#undef HAVE_ELF_H + +/* Define to 1 if you have the <errno.h> header file. */ +#undef HAVE_ERRNO_H + +/* Define to 1 if you have the `execv' function. */ +#undef HAVE_EXECV + +/* Define to 1 if you have the `exp10' function. */ +#undef HAVE_EXP10 + +/* Define to 1 if you have the `expm1' function. */ +#undef HAVE_EXPM1 + +/* Define if your Fortran compiler appends an extra_underscore to external + names containing an underscore. */ +#undef HAVE_F77_EXTRA_UNDERSCORE + +/* Define if your Fortran compiler appends an underscore to external names. */ +#undef HAVE_F77_UNDERSCORE + +/* Define to 1 if you have the `fcntl' function. */ +#undef HAVE_FCNTL + +/* Define to 1 if you have the <fcntl.h> header file. */ +#undef HAVE_FCNTL_H + +/* Define to 1 if you have the `fdopen' function. */ +#undef HAVE_FDOPEN + +/* Define to 1 if you have the <features.h> header file. */ +#undef HAVE_FEATURES_H + +/* Define to 1 if you have the <floatingpoint.h> header file. */ +#undef HAVE_FLOATINGPOINT_H + +/* Define if C's Rcomplex and Fortran's COMPLEX*16 can be interchanged, and + can do arithmetic on the latter. */ +#undef HAVE_FORTRAN_DOUBLE_COMPLEX + +/* Define to 1 if fseeko (and presumably ftello) exists and is declared. */ +#undef HAVE_FSEEKO + +/* Define to 1 if you have the `ftello' function. */ +#undef HAVE_FTELLO + +/* Define to 1 if you have the `ftruncate' function. */ +#undef HAVE_FTRUNCATE + +/* Define to 1 if you have the `fwprintf' function. */ +#undef HAVE_FWPRINTF + +/* Define to 1 if you have the `getcwd' function. */ +#undef HAVE_GETCWD + +/* Define to 1 if you have the `getegid' function. */ +#undef HAVE_GETEGID + +/* Define to 1 if you have the `geteuid' function. */ +#undef HAVE_GETEUID + +/* Define to 1 if you have the `getgid' function. */ +#undef HAVE_GETGID + +/* Define to 1 if you have the `getgrgid' function. */ +#undef HAVE_GETGRGID + +/* Define to 1 if you have the `getline' function. */ +#undef HAVE_GETLINE + +/* Define to 1 if you have the `getpagesize' function. */ +#undef HAVE_GETPAGESIZE + +/* Define to 1 if you have the `getpriority' function. */ +#undef HAVE_GETPRIORITY + +/* Define to 1 if you have the `getpwuid' function. */ +#undef HAVE_GETPWUID + +/* Define to 1 if you have the `getrlimit' function. */ +#undef HAVE_GETRLIMIT + +/* Define to 1 if you have the `getrusage' function. */ +#undef HAVE_GETRUSAGE + +/* Define if the GNU gettext() function is already present or preinstalled. */ +#undef HAVE_GETTEXT + +/* Define to 1 if you have the `gettimeofday' function. */ +#undef HAVE_GETTIMEOFDAY + +/* Define to 1 if you have the `getuid' function. */ +#undef HAVE_GETUID + +/* Define if you have the GNU C library version >= 2. This is needed to fix a + problem with getting the prototype of strptime(). */ +#undef HAVE_GLIBC2 + +/* Define to 1 if you have the `glob' function. */ +#undef HAVE_GLOB + +/* Define to 1 if you have the <glob.h> header file. */ +#undef HAVE_GLOB_H + +/* Define to 1 if you have the `gmtime_r' function. */ +#undef HAVE_GMTIME_R + +/* Define to 1 if you have the <grp.h> header file. */ +#undef HAVE_GRP_H + +/* Define to 1 if you have the `history_truncate_file' function. */ +#undef HAVE_HISTORY_TRUNCATE_FILE + +/* Define to 1 if you have the `hypot' function. */ +#undef HAVE_HYPOT + +/* Define if you have the iconv() function. */ +#undef HAVE_ICONV + +/* Define if you have the `iconvlist' function. */ +#undef HAVE_ICONVLIST + +/* Define to 1 if you have the <iconv.h> header file. */ +#undef HAVE_ICONV_H + +/* Define to 1 if the system has the type `int64_t'. */ +#undef HAVE_INT64_T + +/* Define if you have the 'intmax_t' type in <stdint.h> or <inttypes.h>. (For + intl) */ +#undef HAVE_INTMAX_T + +/* Define to 1 if the system has the type `intptr_t'. */ +#undef HAVE_INTPTR_T + +/* Define to 1 if you have the <inttypes.h> header file. */ +#undef HAVE_INTTYPES_H + +/* Define if <inttypes.h> exists, doesn't clash with <sys/types.h>, and + declares uintmax_t. (For intl) */ +#undef HAVE_INTTYPES_H_WITH_UINTMAX + +/* Define to 1 if the system has the type `int_fast64_t'. */ +#undef HAVE_INT_FAST64_T + +/* Define to 1 if you have the `isblank' function. */ +#undef HAVE_ISBLANK + +/* Define to 1 if you have the `isnan' function. */ +#undef HAVE_ISNAN + +/* Define to 1 if you have the `iswblank' function. */ +#undef HAVE_ISWBLANK + +/* Define to 1 if you have the `iswctype' function. */ +#undef HAVE_ISWCTYPE + +/* Define if you have the JPEG headers and libraries. */ +#undef HAVE_JPEG + +/* Define if KERN_USRSTACK sysctl is supported. */ +#undef HAVE_KERN_USRSTACK + +/* Define if you have KeySym defined in X11. */ +#undef HAVE_KEYSYM + +/* Define to 1 if you have the `kill' function. */ +#undef HAVE_KILL + +/* Define if you have <langinfo.h> and nl_langinfo(CODESET). */ +#undef HAVE_LANGINFO_CODESET + +/* Define to 1 if you have the <langinfo.h> header file. */ +#undef HAVE_LANGINFO_H + +/* Define if your <locale.h> file defines LC_MESSAGES. */ +#undef HAVE_LC_MESSAGES + +/* Define if your system has libcurl >= 7.22.0 with support for https. */ +#undef HAVE_LIBCURL + +/* Define if __libc_stack_end is visible. */ +#undef HAVE_LIBC_STACK_END + +/* Define to 1 if you have the `dl' library (-ldl). */ +#undef HAVE_LIBDL + +/* Define to 1 if you have the `icucore' library (-licucore). */ +#undef HAVE_LIBICUCORE + +/* Define to 1 if you have the `m' library (-lm). */ +#undef HAVE_LIBM + +/* Define to 1 if you have the `ncurses' library (-lncurses). */ +#undef HAVE_LIBNCURSES + +/* Define to 1 if you have the `readline' library (-lreadline). */ +#undef HAVE_LIBREADLINE + +/* Define to 1 if you have the `rt' library (-lrt). */ +#undef HAVE_LIBRT + +/* Define to 1 if you have the `sunmath' library (-lsunmath). */ +#undef HAVE_LIBSUNMATH + +/* Define to 1 if you have the `termcap' library (-ltermcap). */ +#undef HAVE_LIBTERMCAP + +/* Define to 1 if you have the `termlib' library (-ltermlib). */ +#undef HAVE_LIBTERMLIB + +/* Define to 1 if you have the `tk' library (-ltk). */ +#undef HAVE_LIBTK + +/* Define to 1 if you have the <limits.h> header file. */ +#undef HAVE_LIMITS_H + +/* Define to 1 if you have the `link' function. */ +#undef HAVE_LINK + +/* Define to 1 if you have the <locale.h> header file. */ +#undef HAVE_LOCALE_H + +/* Define to 1 if you have the `localtime_r' function. */ +#undef HAVE_LOCALTIME_R + +/* Define to 1 if you have the `log10' function. */ +#undef HAVE_LOG10 + +/* Define to 1 if you have the `log1p' function. */ +#undef HAVE_LOG1P + +/* Define to 1 if you have the `log1pl' function. */ +#undef HAVE_LOG1PL + +/* Define to 1 if you have the `log2' function. */ +#undef HAVE_LOG2 + +/* Define if you wish to use the 'long double' type. */ +#undef HAVE_LONG_DOUBLE + +/* Define to 1 if the system has the type `long long int'. (For intl) */ +#undef HAVE_LONG_LONG_INT + +/* Define if your system has lzma >= 5.0.3. */ +#undef HAVE_LZMA + +/* Define to 1 if you have the <lzma.h> header file. */ +#undef HAVE_LZMA_H + +/* Define to 1 if you have the `matherr' function. */ +#undef HAVE_MATHERR + +/* Define to 1 if you have the `mbrtowc' function. */ +#undef HAVE_MBRTOWC + +/* Define to 1 if the system has the type `mbstate_t'. */ +#undef HAVE_MBSTATE_T + +/* Define to 1 if you have the `mbstowcs' function. */ +#undef HAVE_MBSTOWCS + +/* Define to 1 if you have the <memory.h> header file. */ +#undef HAVE_MEMORY_H + +/* Define to 1 if you have the `mempcpy' function. */ +#undef HAVE_MEMPCPY + +/* Define to 1 if you have the `mkdtemp' function. */ +#undef HAVE_MKDTEMP + +/* Define to 1 if you have the `mkfifo' function. */ +#undef HAVE_MKFIFO + +/* Define to 1 if you have a working `mmap' system call. */ +#undef HAVE_MMAP + +/* Define to 1 if you have the `munmap' function. */ +#undef HAVE_MUNMAP + +/* Define to 1 if you have the <ndir.h> header file, and it defines `DIR'. */ +#undef HAVE_NDIR_H + +/* Define to 1 if you have the `nearbyint' function. */ +#undef HAVE_NEARBYINT + +/* Define to 1 if you have the `nearbyintl' function. */ +#undef HAVE_NEARBYINTL + +/* Define to 1 if you have the <netdb.h> header file. */ +#undef HAVE_NETDB_H + +/* Define to 1 if you have the <netinet/in.h> header file. */ +#undef HAVE_NETINET_IN_H + +/* Define to 1 if you have the `nl_langinfo' function. */ +#undef HAVE_NL_LANGINFO + +/* Define if you have <langinfo.h> and it defines the NL_LOCALE_NAME macro if + _GNU_SOURCE is defined. */ +#undef HAVE_NL_LOCALE_NAME + +/* Define if module-loading does not need an underscore to be prepended to + external names. */ +#undef HAVE_NO_SYMBOL_UNDERSCORE + +/* Define if you have off_t, fseeko and ftello. */ +#undef HAVE_OFF_T + +/* Define if you have C OpenMP support. */ +#undef HAVE_OPENMP + +/* Define if your OpenMP 4 implementation fully supports SIMD reduction */ +#undef HAVE_OPENMP_SIMDRED + +/* Define to 1 if you have pangocairo. */ +#undef HAVE_PANGOCAIRO + +/* Define to 1 if you have the <pcre.h> header file. */ +#undef HAVE_PCRE_H + +/* Define to 1 if you have the <pcre/pcre.h> header file. */ +#undef HAVE_PCRE_PCRE_H + +/* Define if you have the PNG headers and libraries. */ +#undef HAVE_PNG + +/* Define to 1 if you have the `popen' function. */ +#undef HAVE_POPEN + +/* Define if your system time functions do not count leap seconds, as required + by POSIX. */ +#undef HAVE_POSIX_LEAPSECONDS + +/* Define if your printf() function supports format strings with positions. + (For intl) */ +#undef HAVE_POSIX_PRINTF + +/* Define if you have POSIX.1 compatible sigsetjmp/siglongjmp. */ +#undef HAVE_POSIX_SETJMP + +/* Define to 1 if you have the `powl' function. */ +#undef HAVE_POWL + +/* Define to 1 if you have the `pown' function. */ +#undef HAVE_POWN + +/* Define if the <pthread.h> defines PTHREAD_MUTEX_RECURSIVE. (For intl) */ +#undef HAVE_PTHREAD_MUTEX_RECURSIVE + +/* Define if the POSIX multithreading library has read/write locks. (For intl) + */ +#undef HAVE_PTHREAD_RWLOCK + +/* Define to 1 if you have the `putenv' function. */ +#undef HAVE_PUTENV + +/* Define if putenv("FOO") can unset an environment variable */ +#undef HAVE_PUTENV_UNSET + +/* Define if putenv("FOO=") can unset an environment variable */ +#undef HAVE_PUTENV_UNSET2 + +/* Define to 1 if you have the <pwd.h> header file. */ +#undef HAVE_PWD_H + +/* Define to 1 if you have the <readline/history.h> header file. */ +#undef HAVE_READLINE_HISTORY_H + +/* Define to 1 if you have the <readline/readline.h> header file. */ +#undef HAVE_READLINE_READLINE_H + +/* Define to 1 if you have the `readlink' function. */ +#undef HAVE_READLINK + +/* Define to 1 if you have the `realpath' function. */ +#undef HAVE_REALPATH + +/* Define to 1 if you have the `rint' function. */ +#undef HAVE_RINT + +/* Define to 1 if you have the `rintl' function. */ +#undef HAVE_RINTL + +/* Define to 1 if you have the `rl_callback_sigcleanup' function. */ +#undef HAVE_RL_CALLBACK_SIGCLEANUP + +/* Define to 1 if you have the `rl_completion_matches' function. */ +#undef HAVE_RL_COMPLETION_MATCHES + +/* Define to 1 if you have the `rl_resize_terminal' function. */ +#undef HAVE_RL_RESIZE_TERMINAL + +/* Define to 1 if you have the `rl_sort_completion_matches' function. */ +#undef HAVE_RL_SORT_COMPLETION_MATCHES + +/* Define to 1 if you have the `sched_getaffinity' function. */ +#undef HAVE_SCHED_GETAFFINITY + +/* Define to 1 if you have the <sched.h> header file. */ +#undef HAVE_SCHED_H + +/* Define to 1 if you have the `sched_setaffinity' function. */ +#undef HAVE_SCHED_SETAFFINITY + +/* Define to 1 if you have the `select' function. */ +#undef HAVE_SELECT + +/* Define to 1 if you have the `setenv' function. */ +#undef HAVE_SETENV + +/* Define to 1 if you have the `setitimer' function. */ +#undef HAVE_SETITIMER + +/* Define to 1 if you have the `setlocale' function. */ +#undef HAVE_SETLOCALE + +/* Define to 1 if you have the `sigaction' function. */ +#undef HAVE_SIGACTION + +/* Define to 1 if you have the `sigaltstack' function. */ +#undef HAVE_SIGALTSTACK + +/* Define to 1 if you have the `sigemptyset' function. */ +#undef HAVE_SIGEMPTYSET + +/* Define to 1 if you have the `sinpi' function. */ +#undef HAVE_SINPI + +/* Define to 1 if you have the `snprintf' function. */ +#undef HAVE_SNPRINTF + +/* Define to 1 if the system has the type `stack_t'. */ +#undef HAVE_STACK_T + +/* Define to 1 if you have the `stat' function. */ +#undef HAVE_STAT + +/* Define to 1 if you have the <stdalign.h> header file. */ +#undef HAVE_STDALIGN_H + +/* Define to 1 if you have the <stdarg.h> header file. */ +#undef HAVE_STDARG_H + +/* Define to 1 if you have the <stdbool.h> header file. */ +#undef HAVE_STDBOOL_H + +/* Define to 1 if you have the <stddef.h> header file. */ +#undef HAVE_STDDEF_H + +/* Define to 1 if you have the <stdint.h> header file. */ +#undef HAVE_STDINT_H + +/* Define if <stdint.h> exists, doesn't clash with <sys/types.h>, and declares + uintmax_t. (For intl) */ +#undef HAVE_STDINT_H_WITH_UINTMAX + +/* Define to 1 if you have the <stdlib.h> header file. */ +#undef HAVE_STDLIB_H + +/* Define to 1 if you have the `stpcpy' function. */ +#undef HAVE_STPCPY + +/* Define to 1 if you have the `strcasecmp' function. */ +#undef HAVE_STRCASECMP + +/* Define to 1 if you have the `strdup' function. */ +#undef HAVE_STRDUP + +/* Define to 1 if you have the <strings.h> header file. */ +#undef HAVE_STRINGS_H + +/* Define to 1 if you have the <string.h> header file. */ +#undef HAVE_STRING_H + +/* Define to 1 if you have the `strncasecmp' function. */ +#undef HAVE_STRNCASECMP + +/* Define to 1 if you have the `strtoul' function. */ +#undef HAVE_STRTOUL + +/* Define to 1 if `st_atimensec' is a member of `struct stat'. */ +#undef HAVE_STRUCT_STAT_ST_ATIMENSEC + +/* Define to 1 if `st_atimespec.tv_nsec' is a member of `struct stat'. */ +#undef HAVE_STRUCT_STAT_ST_ATIMESPEC_TV_NSEC + +/* Define to 1 if `st_atim.st__tim.tv_nsec' is a member of `struct stat'. */ +#undef HAVE_STRUCT_STAT_ST_ATIM_ST__TIM_TV_NSEC + +/* Define to 1 if `st_atim.tv_nsec' is a member of `struct stat'. */ +#undef HAVE_STRUCT_STAT_ST_ATIM_TV_NSEC + +/* Define to 1 if you have the <sunmath.h> header file. */ +#undef HAVE_SUNMATH_H + +/* Define to 1 if you have the `symlink' function. */ +#undef HAVE_SYMLINK + +/* Define to 1 if you have the `sysconf' function. */ +#undef HAVE_SYSCONF + +/* Define to 1 if you have the <sys/dir.h> header file, and it defines `DIR'. + */ +#undef HAVE_SYS_DIR_H + +/* Define to 1 if you have the <sys/ndir.h> header file, and it defines `DIR'. + */ +#undef HAVE_SYS_NDIR_H + +/* Define to 1 if you have the <sys/param.h> header file. */ +#undef HAVE_SYS_PARAM_H + +/* Define to 1 if you have the <sys/resource.h> header file. */ +#undef HAVE_SYS_RESOURCE_H + +/* Define to 1 if you have the <sys/select.h> header file. */ +#undef HAVE_SYS_SELECT_H + +/* Define to 1 if you have the <sys/socket.h> header file. */ +#undef HAVE_SYS_SOCKET_H + +/* Define to 1 if you have the <sys/stat.h> header file. */ +#undef HAVE_SYS_STAT_H + +/* Define to 1 if you have the <sys/times.h> header file. */ +#undef HAVE_SYS_TIMES_H + +/* Define to 1 if you have the <sys/time.h> header file. */ +#undef HAVE_SYS_TIME_H + +/* Define to 1 if you have the <sys/types.h> header file. */ +#undef HAVE_SYS_TYPES_H + +/* Define to 1 if you have the <sys/utsname.h> header file. */ +#undef HAVE_SYS_UTSNAME_H + +/* Define to 1 if you have <sys/wait.h> that is POSIX.1 compatible. */ +#undef HAVE_SYS_WAIT_H + +/* Define to 1 if you have the `tanpi' function. */ +#undef HAVE_TANPI + +/* Define if you have the Tcl/Tk headers and libraries and want Tcl/Tk support + to be built. */ +#undef HAVE_TCLTK + +/* Define this if libtiff is available. */ +#undef HAVE_TIFF + +/* Define to 1 if you have the <tiffio.h> header file. */ +#undef HAVE_TIFFIO_H + +/* Define to 1 if you have the `times' function. */ +#undef HAVE_TIMES + +/* Define to 1 if you have the `timespec_get' function. */ +#undef HAVE_TIMESPEC_GET + +/* Define to 1 if your 'struct tm' has tm_gmtoff. */ +#undef HAVE_TM_GMTOFF + +/* Define to 1 if your 'struct tm' has tm_zone. */ +#undef HAVE_TM_ZONE + +/* Define if your system has tre. */ +#undef HAVE_TRE + +/* Define to 1 if you have the <tre/tre.h> header file. */ +#undef HAVE_TRE_TRE_H + +/* Define to 1 if you have the `tsearch' function. */ +#undef HAVE_TSEARCH + +/* Define if you have the 'uintmax_t' type in <stdint.h> or <inttypes.h>. (For + intl) */ +#undef HAVE_UINTMAX_T + +/* Define to 1 if the system has the type `uintptr_t'. */ +#undef HAVE_UINTPTR_T + +/* Define to 1 if you have the `umask' function. */ +#undef HAVE_UMASK + +/* Define to 1 if you have the <unistd.h> header file. */ +#undef HAVE_UNISTD_H + +/* Define to 1 if you have the `unsetenv' function. */ +#undef HAVE_UNSETENV + +/* Define if you have the 'unsigned long long' type. (For intl) */ +#undef HAVE_UNSIGNED_LONG_LONG + +/* Define to 1 if the system has the type `unsigned long long int'. (For intl) + */ +#undef HAVE_UNSIGNED_LONG_LONG_INT + +/* Define to 1 if you have the `utime' function. */ +#undef HAVE_UTIME + +/* Define to 1 if you have the `utimensat' function. */ +#undef HAVE_UTIMENSAT + +/* Define to 1 if you have the `utimes' function. */ +#undef HAVE_UTIMES + +/* Define to 1 if you have the <utime.h> header file. */ +#undef HAVE_UTIME_H + +/* Define to 1 if you have the <valgrind/memcheck.h> header file. */ +#undef HAVE_VALGRIND_MEMCHECK_H + +/* Define to 1 if you have the `vasprintf' function. */ +#undef HAVE_VASPRINTF + +/* Define to 1 if you have the `va_copy' function. */ +#undef HAVE_VA_COPY + +/* Define to 1 or 0, depending whether the compiler supports simple visibility + declarations. (For intl) */ +#undef HAVE_VISIBILITY + +/* Define to 1 if __attribute__((visibility())) is supported */ +#undef HAVE_VISIBILITY_ATTRIBUTE + +/* Define to 1 if you have the <wchar.h> header file. */ +#undef HAVE_WCHAR_H + +/* Define if you have the 'wchar_t' type. (For intl) */ +#undef HAVE_WCHAR_T + +/* Define to 1 if you have the `wcrtomb' function. */ +#undef HAVE_WCRTOMB + +/* Define to 1 if you have the `wcscoll' function. */ +#undef HAVE_WCSCOLL + +/* Define to 1 if you have the `wcsftime' function. */ +#undef HAVE_WCSFTIME + +/* Define to 1 if you have the `wcslen' function. */ +#undef HAVE_WCSLEN + +/* Define to 1 if you have the `wcstod' function. */ +#undef HAVE_WCSTOD + +/* Define to 1 if you have the `wcstombs' function. */ +#undef HAVE_WCSTOMBS + +/* Define to 1 if you have the `wctrans' function. */ +#undef HAVE_WCTRANS + +/* Define to 1 if the system has the type `wctrans_t'. */ +#undef HAVE_WCTRANS_T + +/* Define to 1 if you have the `wctype' function. */ +#undef HAVE_WCTYPE + +/* Define to 1 if you have the <wctype.h> header file. */ +#undef HAVE_WCTYPE_H + +/* Define if you have the 'wint_t' type. (For intl) */ +#undef HAVE_WINT_T + +/* Define if your mktime works correctly outside 1902-2037. */ +#undef HAVE_WORKING_64BIT_MKTIME + +/* Define to 1 if you have cairo. */ +#undef HAVE_WORKING_CAIRO + +/* Define if calloc(0) returns a null pointer. */ +#undef HAVE_WORKING_CALLOC + +/* Define if your ftell works correctly on files opened for append. */ +#undef HAVE_WORKING_FTELL + +/* Define if isfinite() is correct for -Inf/NaN/Inf. */ +#undef HAVE_WORKING_ISFINITE + +/* Define if log1p() exists and is accurate enough. */ +#undef HAVE_WORKING_LOG1P + +/* Define if sigaction() is complete enough for R's usage */ +#undef HAVE_WORKING_SIGACTION + +/* Define if you have the X11 headers and libraries, and want the X11 GUI to + be built. */ +#undef HAVE_X11 + +/* Define if you have the X11/Xmu headers and libraries. */ +#undef HAVE_X11_Xmu + +/* Define to 1 if you have the `__cospi' function. */ +#undef HAVE___COSPI + +/* Define to 1 if you have the `__fsetlocking' function. */ +#undef HAVE___FSETLOCKING + +/* Define to 1 if you have the `__sinpi' function. */ +#undef HAVE___SINPI + +/* Define to 1 if you have the `__tanpi' function. */ +#undef HAVE___TANPI + +/* Define as const if the declaration of iconv() needs const. */ +#undef ICONV_CONST + +/* Define if you have IEEE 754 floating point arithmetic. */ +#undef IEEE_754 + +/* Define if integer division by zero raises signal SIGFPE. (For intl) */ +#undef INTDIV0_RAISES_SIGFPE + +/* Define if you have 32 bit ints. */ +#undef INT_32_BITS + +/* Define to the sub-directory where libtool stores uninstalled libraries. */ +#undef LT_OBJDIR + +/* Define if mktime sets errno. */ +#undef MKTIME_SETS_ERRNO + +/* Define to disable Valgrind instrumentation */ +#undef NVALGRIND + +/* Define if using GNU-style Objective C runtime. */ +#undef OBJC_GNU_RUNTIME + +/* Define if using NeXT/Apple-style Objective C runtime. */ +#undef OBJC_NEXT_RUNTIME + +/* Name of package */ +#undef PACKAGE + +/* Define to the address where bug reports for this package should be sent. */ +#undef PACKAGE_BUGREPORT + +/* Define to the full name of this package. */ +#undef PACKAGE_NAME + +/* Define to the full name and version of this package. */ +#undef PACKAGE_STRING + +/* Define to the one symbol short name of this package. */ +#undef PACKAGE_TARNAME + +/* Define to the home page for this package. */ +#undef PACKAGE_URL + +/* Define to the version of this package. */ +#undef PACKAGE_VERSION + +/* Define if <inttypes.h> exists and defines unusable PRI* macros. (For intl) + */ +#undef PRI_MACROS_BROKEN + +/* Define if the pthread_in_use() detection is hard. (For intl) */ +#undef PTHREAD_IN_USE_DETECTION_HARD + +/* Define as the return type of signal handlers (`int' or `void'). */ +#undef RETSIGTYPE + +/* Define this to use architecture-dependent subdirectories of this name. */ +#undef R_ARCH + +/* Define this to be the name of the CPU of your system. */ +#undef R_CPU + +/* Define as `inline', or `__inline__' or `__inline' if that's what the C + compiler calls it, or to nothing if it is not supported. */ +#undef R_INLINE + +/* Define this to enable memory profiling. */ +#undef R_MEMORY_PROFILING + +/* Define this to be the name of the OS of your system. */ +#undef R_OS + +/* Define this to be the canonical name (cpu-vendor-os) of your system. */ +#undef R_PLATFORM + +/* Define this to be printing command on your system. */ +#undef R_PRINTCMD + +/* Define this to enable R-level profiling. */ +#undef R_PROFILING + +/* Type for socket lengths: socklen_t, sock_t, int? */ +#undef R_SOCKLEN_T + +/* Define this to be the name of the vendor of your system. */ +#undef R_VENDOR + +/* Define this to be the extension used for shared objects on your system. */ +#undef SHLIB_EXT + +/* The size of `double', as computed by sizeof. */ +#undef SIZEOF_DOUBLE + +/* The size of `int', as computed by sizeof. */ +#undef SIZEOF_INT + +/* The size of `long', as computed by sizeof. */ +#undef SIZEOF_LONG + +/* The size of `long double', as computed by sizeof. */ +#undef SIZEOF_LONG_DOUBLE + +/* The size of `long long', as computed by sizeof. */ +#undef SIZEOF_LONG_LONG + +/* The size of `size_t', as computed by sizeof. */ +#undef SIZEOF_SIZE_T + +/* Define as the maximum value of type 'size_t', if the system doesn't define + it. (For intl) */ +#undef SIZE_MAX + +/* If using the C implementation of alloca, define if you know the + direction of stack growth for your system; otherwise it will be + automatically deduced at runtime. + STACK_DIRECTION > 0 => grows toward higher addresses + STACK_DIRECTION < 0 => grows toward lower addresses + STACK_DIRECTION = 0 => direction of growth unknown */ +#undef STACK_DIRECTION + +/* Define to 1 if you have the ANSI C header files. */ +#undef STDC_HEADERS + +/* Define if you have C/C++/Fortran OpenMP support for package code. */ +#undef SUPPORT_OPENMP + +/* Define to enable provoking compile errors on write barrier violation. */ +#undef TESTING_WRITE_BARRIER + +/* Define to 1 if the type of the st_atim member of a struct stat is struct + timespec. */ +#undef TYPEOF_STRUCT_STAT_ST_ATIM_IS_STRUCT_TIMESPEC + +/* Define to use ICU for collation. */ +#undef USE_ICU + +/* Define to use Apple's ICU. */ +#undef USE_ICU_APPLE + +/* Define to use internal time-zone code */ +#undef USE_INTERNAL_MKTIME + +/* Define if the POSIX multithreading library can be used. (For intl) */ +#undef USE_POSIX_THREADS + +/* Define if references to the POSIX multithreading library should be made + weak. (For intl) */ +#undef USE_POSIX_THREADS_WEAK + +/* Define if the GNU Pth multithreading library can be used. (For intl) */ +#undef USE_PTH_THREADS + +/* Define if references to the GNU Pth multithreading library should be made + weak. (For intl) */ +#undef USE_PTH_THREADS_WEAK + +/* Define if the old Solaris multithreading library can be used. (For intl) */ +#undef USE_SOLARIS_THREADS + +/* Define if references to the old Solaris multithreading library should be + made weak. (For intl) */ +#undef USE_SOLARIS_THREADS_WEAK + +/* Enable extensions on AIX 3, Interix. */ +#ifndef _ALL_SOURCE +# undef _ALL_SOURCE +#endif +/* Enable GNU extensions on systems that have them. */ +#ifndef _GNU_SOURCE +# undef _GNU_SOURCE +#endif +/* Enable threading extensions on Solaris. */ +#ifndef _POSIX_PTHREAD_SEMANTICS +# undef _POSIX_PTHREAD_SEMANTICS +#endif +/* Enable extensions on HP NonStop. */ +#ifndef _TANDEM_SOURCE +# undef _TANDEM_SOURCE +#endif +/* Enable general extensions on Solaris. */ +#ifndef __EXTENSIONS__ +# undef __EXTENSIONS__ +#endif + + +/* Define if the Win32 multithreading API can be used. (For intl) */ +#undef USE_WIN32_THREADS + +/* Define according to your operating system type. */ +#undef Unix + +/* Define as 1 or 2 to specify levels of Valgrind instrumentation */ +#undef VALGRIND_LEVEL + +/* Version number of package */ +#undef VERSION + +/* Define to 1 if your processor stores words with the most significant byte + first (like Motorola and SPARC, unlike Intel and VAX). */ +#undef WORDS_BIGENDIAN + +/* Define according to your operating system type. */ +#undef Win32 + +/* Define to 1 if the X Window System is missing or not being used. */ +#undef X_DISPLAY_MISSING + +/* Enable large inode numbers on Mac OS X 10.5. */ +#ifndef _DARWIN_USE_64_BIT_INODE +# define _DARWIN_USE_64_BIT_INODE 1 +#endif + +/* Number of bits in a file offset, on hosts where this is settable. */ +#undef _FILE_OFFSET_BITS + +/* Define to 1 to make fseeko visible on some hosts (e.g. glibc 2.2). */ +#undef _LARGEFILE_SOURCE + +/* Define for large files, on AIX-style hosts. */ +#undef _LARGE_FILES + +/* Define to 1 if on MINIX. */ +#undef _MINIX + +/* Define to 2 if the system does not provide POSIX.1 features except with + this defined. */ +#undef _POSIX_1_SOURCE + +/* Define to 1 if you need to in order for `stat' and other things to work. */ +#undef _POSIX_SOURCE + +/* Define for Solaris 2.5.1 so the uint64_t typedef from <sys/synch.h>, + <pthread.h>, or <semaphore.h> is not used. If the typedef were allowed, the + #define below would cause a syntax error. */ +#undef _UINT64_T + +/* Define to 'long' if <sys/types.h> does not define. Apparently necessary to + fix a GCC bug on AIX? */ +#undef blkcnt_t + +/* Define to empty if `const' does not conform to ANSI C. */ +#undef const + +/* Define to `__inline__' or `__inline' if that's what the C compiler + calls it, or to nothing if 'inline' is not supported under any name. */ +#ifndef __cplusplus +#undef inline +#endif + +/* Define to `int' if <sys/types.h> does not define. */ +#undef pid_t + +/* Define as the type of the result of subtracting two pointers, if the system + doesn't define it. (For intl) */ +#undef ptrdiff_t + +/* Define to `unsigned int' if <sys/types.h> does not define. */ +#undef size_t + +/* Define to the type of an unsigned integer type of width exactly 64 bits if + such a type exists and the standard includes do not define it. */ +#undef uint64_t + +/* Define to unsigned long or unsigned long long if <stdint.h> and + <inttypes.h> don't define. (For intl) */ +#undef uintmax_t + + +#endif /* not R_CONFIG_H */ + + +#define __libc_lock_t gl_lock_t +#define __libc_lock_define gl_lock_define +#define __libc_lock_define_initialized gl_lock_define_initialized +#define __libc_lock_init gl_lock_init +#define __libc_lock_lock gl_lock_lock +#define __libc_lock_unlock gl_lock_unlock +#define __libc_lock_recursive_t gl_recursive_lock_t +#define __libc_lock_define_recursive gl_recursive_lock_define +#define __libc_lock_define_initialized_recursive gl_recursive_lock_define_initialized +#define __libc_lock_init_recursive gl_recursive_lock_init +#define __libc_lock_lock_recursive gl_recursive_lock_lock +#define __libc_lock_unlock_recursive gl_recursive_lock_unlock +#define glthread_in_use libintl_thread_in_use +#define glthread_lock_init libintl_lock_init +#define glthread_lock_lock libintl_lock_lock +#define glthread_lock_unlock libintl_lock_unlock +#define glthread_lock_destroy libintl_lock_destroy +#define glthread_rwlock_init libintl_rwlock_init +#define glthread_rwlock_rdlock libintl_rwlock_rdlock +#define glthread_rwlock_wrlock libintl_rwlock_wrlock +#define glthread_rwlock_unlock libintl_rwlock_unlock +#define glthread_rwlock_destroy libintl_rwlock_destroy +#define glthread_recursive_lock_init libintl_recursive_lock_init +#define glthread_recursive_lock_lock libintl_recursive_lock_lock +#define glthread_recursive_lock_unlock libintl_recursive_lock_unlock +#define glthread_recursive_lock_destroy libintl_recursive_lock_destroy +#define glthread_once libintl_once +#define glthread_once_call libintl_once_call +#define glthread_once_singlethreaded libintl_once_singlethreaded + diff --git a/com.oracle.truffle.r.native/gnur/patch/src/include/rlocale.h b/com.oracle.truffle.r.native/gnur/patch/src/include/rlocale.h new file mode 100644 index 0000000000000000000000000000000000000000..bf5192190feecfbb6629601016e190bea4b44246 --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/include/rlocale.h @@ -0,0 +1,117 @@ +/* + * R : A Computer Language for Statistical Data Analysis + * Copyright (C) 2005-2016 The R Core Team + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version. + * + * This program 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 this program; if not, a copy is available at + * https://www.R-project.org/Licenses/ + */ + +/* Internal header, not installed */ + +/* This file was contributed by Ei-ji Nakama. + * See also the comments in ../main/rlocale.c. + + * It does 2 things: + * (a) supplies wrapper/substitute wc[s]width functions for use in + * character.c, errors.c, printutils.c, devPS.c, RGui console. + * (b) Defines a replacment for iswctype to be used on Windows, maxOS and AIX. + * in gram.c + * + * It is not an installed header. + */ + +#ifndef R_LOCALE_H +#define R_LOCALE_H + +#include <wchar.h> +#include <ctype.h> +#include <wctype.h> + +/* + * Windows CJK + * In Unicode, there is not a rule about character width. + * A letter of breadth is used in a CJK (China, Japan, Korea, + * Taiwan, Hong Kong, and Singapore) area, and there are a + * letter and a standard (character width is not still prescribed) + * of a cord in a country. + * Letter width is a problem of a font, but it is a rule route + * besides a alphanumeric character that use a breadth letter. + * It is generally defined as a breadth letter for a font such + * as Japanese. + * - Win32 + + * Attempted explanation by BDR + * The display widths of characters are not prescribed in Unicode. + * Double-width characters are used in the CJK area: their width can + * be font-specific, with different fonts in use in different parts + * of the CJK area. The tables supplied in many OSes and by Markus + * Kuhn are not do not take the exact locale into account. The + * tables supplied in rlocale_data.h allow different widths for + * different parts of the CJK area, and also where needed different + * widths on Windows. (The Windows differences are in zh_CN, and + * apply to European characters.) + * + * The differences are mainly (but not exclusively) in the + * Unicode 'East Asian Ambiguous' class. + * + */ +extern int Ri18n_wcwidth(wchar_t); +extern int Ri18n_wcswidth (const wchar_t *, size_t); + +/* macOS CJK and WindowXP(Japanese) + * iswctypes of macOS calls isctypes. no i18n. + * For example, iswprint of Windows does not accept a macron of + * Japanese "a-ru" of R as a letter. + * Therefore Japanese "Buraian.Ripuri-" of "Brian Ripley" is + * shown of hex-string.:-) + * We define alternatives to be used if + * defined(Win32) || defined(__APPLE__) || defined(_AIX) + */ +extern wctype_t Ri18n_wctype(const char *); +extern int Ri18n_iswctype(wint_t, wctype_t); + +#ifndef IN_RLOCALE_C +/* We want to avoid these redefinitions in rlocale.c itself */ +#undef iswupper +#undef iswlower +#undef iswalpha +#undef iswdigit +#undef iswxdigit +#undef iswspace +#undef iswprint +#undef iswgraph +#undef iswblank +#undef iswcntrl +#undef iswpunct +#undef iswalnum +#undef wctype +#undef iswctype + +#define iswupper(__x) Ri18n_iswctype(__x, Ri18n_wctype("upper")) +#define iswlower(__x) Ri18n_iswctype(__x, Ri18n_wctype("lower")) +#define iswalpha(__x) Ri18n_iswctype(__x, Ri18n_wctype("alpha")) +#define iswdigit(__x) Ri18n_iswctype(__x, Ri18n_wctype("digit")) +#define iswxdigit(__x) Ri18n_iswctype(__x, Ri18n_wctype("xdigit")) +#define iswspace(__x) Ri18n_iswctype(__x, Ri18n_wctype("space")) +#define iswprint(__x) Ri18n_iswctype(__x, Ri18n_wctype("print")) +#define iswgraph(__x) Ri18n_iswctype(__x, Ri18n_wctype("graph")) +#define iswblank(__x) Ri18n_iswctype(__x, Ri18n_wctype("blank")) +#define iswcntrl(__x) Ri18n_iswctype(__x, Ri18n_wctype("cntrl")) +#define iswpunct(__x) Ri18n_iswctype(__x, Ri18n_wctype("punct")) +#define iswalnum(__x) Ri18n_iswctype(__x, Ri18n_wctype("alnum")) +#define wctype(__x) Ri18n_wctype(__x) +#define iswctype(__x,__y) Ri18n_iswctype(__x,__y) +#endif + +#endif /* R_LOCALE_H */ diff --git a/com.oracle.truffle.r.native/gnur/patch/src/include/stamp-h.in b/com.oracle.truffle.r.native/gnur/patch/src/include/stamp-h.in new file mode 100644 index 0000000000000000000000000000000000000000..9788f70238c91894045d22366fa941580826c3c1 --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/include/stamp-h.in @@ -0,0 +1 @@ +timestamp diff --git a/com.oracle.truffle.r.native/gnur/patch/src/include/vg/memcheck.h b/com.oracle.truffle.r.native/gnur/patch/src/include/vg/memcheck.h new file mode 100644 index 0000000000000000000000000000000000000000..356ae23d00bed74f4dbe213bf3db656ad778a240 --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/include/vg/memcheck.h @@ -0,0 +1,303 @@ + +/* + ---------------------------------------------------------------- + + Notice that the following BSD-style license applies to this one + file (memcheck.h) only. The rest of Valgrind is licensed under the + terms of the GNU General Public License, version 2, unless + otherwise indicated. See the COPYING file in the source + distribution for details. + + ---------------------------------------------------------------- + + This file is part of MemCheck, a heavyweight Valgrind tool for + detecting memory errors. + + Copyright (C) 2000-2013 Julian Seward. All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions + are met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. The origin of this software must not be misrepresented; you must + not claim that you wrote the original software. If you use this + software in a product, an acknowledgment in the product + documentation would be appreciated but is not required. + + 3. Altered source versions must be plainly marked as such, and must + not be misrepresented as being the original software. + + 4. The name of the author may not be used to endorse or promote + products derived from this software without specific prior written + permission. + + THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS + OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED + WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY + DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL + DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE + GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, + WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING + NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS + SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + + ---------------------------------------------------------------- + + Notice that the above BSD-style license applies to this one file + (memcheck.h) only. The entire rest of Valgrind is licensed under + the terms of the GNU General Public License, version 2. See the + COPYING file in the source distribution for details. + + ---------------------------------------------------------------- +*/ + + +#ifndef __MEMCHECK_H +#define __MEMCHECK_H + + +/* This file is for inclusion into client (your!) code. + + You can use these macros to manipulate and query memory permissions + inside your own programs. + + See comment near the top of valgrind.h on how to use them. +*/ + +/* R change to ensure that our copy of the header is used */ +#include "vg/valgrind.h" + +/* !! ABIWARNING !! ABIWARNING !! ABIWARNING !! ABIWARNING !! + This enum comprises an ABI exported by Valgrind to programs + which use client requests. DO NOT CHANGE THE ORDER OF THESE + ENTRIES, NOR DELETE ANY -- add new ones at the end. */ +typedef + enum { + VG_USERREQ__MAKE_MEM_NOACCESS = VG_USERREQ_TOOL_BASE('M','C'), + VG_USERREQ__MAKE_MEM_UNDEFINED, + VG_USERREQ__MAKE_MEM_DEFINED, + VG_USERREQ__DISCARD, + VG_USERREQ__CHECK_MEM_IS_ADDRESSABLE, + VG_USERREQ__CHECK_MEM_IS_DEFINED, + VG_USERREQ__DO_LEAK_CHECK, + VG_USERREQ__COUNT_LEAKS, + + VG_USERREQ__GET_VBITS, + VG_USERREQ__SET_VBITS, + + VG_USERREQ__CREATE_BLOCK, + + VG_USERREQ__MAKE_MEM_DEFINED_IF_ADDRESSABLE, + + /* Not next to VG_USERREQ__COUNT_LEAKS because it was added later. */ + VG_USERREQ__COUNT_LEAK_BLOCKS, + + VG_USERREQ__ENABLE_ADDR_ERROR_REPORTING_IN_RANGE, + VG_USERREQ__DISABLE_ADDR_ERROR_REPORTING_IN_RANGE, + + /* This is just for memcheck's internal use - don't use it */ + _VG_USERREQ__MEMCHECK_RECORD_OVERLAP_ERROR + = VG_USERREQ_TOOL_BASE('M','C') + 256 + } Vg_MemCheckClientRequest; + + + +/* Client-code macros to manipulate the state of memory. */ + +/* Mark memory at _qzz_addr as unaddressable for _qzz_len bytes. */ +#define VALGRIND_MAKE_MEM_NOACCESS(_qzz_addr,_qzz_len) \ + VALGRIND_DO_CLIENT_REQUEST_EXPR(0 /* default return */, \ + VG_USERREQ__MAKE_MEM_NOACCESS, \ + (_qzz_addr), (_qzz_len), 0, 0, 0) + +/* Similarly, mark memory at _qzz_addr as addressable but undefined + for _qzz_len bytes. */ +#define VALGRIND_MAKE_MEM_UNDEFINED(_qzz_addr,_qzz_len) \ + VALGRIND_DO_CLIENT_REQUEST_EXPR(0 /* default return */, \ + VG_USERREQ__MAKE_MEM_UNDEFINED, \ + (_qzz_addr), (_qzz_len), 0, 0, 0) + +/* Similarly, mark memory at _qzz_addr as addressable and defined + for _qzz_len bytes. */ +#define VALGRIND_MAKE_MEM_DEFINED(_qzz_addr,_qzz_len) \ + VALGRIND_DO_CLIENT_REQUEST_EXPR(0 /* default return */, \ + VG_USERREQ__MAKE_MEM_DEFINED, \ + (_qzz_addr), (_qzz_len), 0, 0, 0) + +/* Similar to VALGRIND_MAKE_MEM_DEFINED except that addressability is + not altered: bytes which are addressable are marked as defined, + but those which are not addressable are left unchanged. */ +#define VALGRIND_MAKE_MEM_DEFINED_IF_ADDRESSABLE(_qzz_addr,_qzz_len) \ + VALGRIND_DO_CLIENT_REQUEST_EXPR(0 /* default return */, \ + VG_USERREQ__MAKE_MEM_DEFINED_IF_ADDRESSABLE, \ + (_qzz_addr), (_qzz_len), 0, 0, 0) + +/* Create a block-description handle. The description is an ascii + string which is included in any messages pertaining to addresses + within the specified memory range. Has no other effect on the + properties of the memory range. */ +#define VALGRIND_CREATE_BLOCK(_qzz_addr,_qzz_len, _qzz_desc) \ + VALGRIND_DO_CLIENT_REQUEST_EXPR(0 /* default return */, \ + VG_USERREQ__CREATE_BLOCK, \ + (_qzz_addr), (_qzz_len), (_qzz_desc), \ + 0, 0) + +/* Discard a block-description-handle. Returns 1 for an + invalid handle, 0 for a valid handle. */ +#define VALGRIND_DISCARD(_qzz_blkindex) \ + VALGRIND_DO_CLIENT_REQUEST_EXPR(0 /* default return */, \ + VG_USERREQ__DISCARD, \ + 0, (_qzz_blkindex), 0, 0, 0) + + +/* Client-code macros to check the state of memory. */ + +/* Check that memory at _qzz_addr is addressable for _qzz_len bytes. + If suitable addressibility is not established, Valgrind prints an + error message and returns the address of the first offending byte. + Otherwise it returns zero. */ +#define VALGRIND_CHECK_MEM_IS_ADDRESSABLE(_qzz_addr,_qzz_len) \ + VALGRIND_DO_CLIENT_REQUEST_EXPR(0, \ + VG_USERREQ__CHECK_MEM_IS_ADDRESSABLE, \ + (_qzz_addr), (_qzz_len), 0, 0, 0) + +/* Check that memory at _qzz_addr is addressable and defined for + _qzz_len bytes. If suitable addressibility and definedness are not + established, Valgrind prints an error message and returns the + address of the first offending byte. Otherwise it returns zero. */ +#define VALGRIND_CHECK_MEM_IS_DEFINED(_qzz_addr,_qzz_len) \ + VALGRIND_DO_CLIENT_REQUEST_EXPR(0, \ + VG_USERREQ__CHECK_MEM_IS_DEFINED, \ + (_qzz_addr), (_qzz_len), 0, 0, 0) + +/* Use this macro to force the definedness and addressibility of an + lvalue to be checked. If suitable addressibility and definedness + are not established, Valgrind prints an error message and returns + the address of the first offending byte. Otherwise it returns + zero. */ +#define VALGRIND_CHECK_VALUE_IS_DEFINED(__lvalue) \ + VALGRIND_CHECK_MEM_IS_DEFINED( \ + (volatile unsigned char *)&(__lvalue), \ + (unsigned long)(sizeof (__lvalue))) + + +/* Do a full memory leak check (like --leak-check=full) mid-execution. */ +#define VALGRIND_DO_LEAK_CHECK \ + VALGRIND_DO_CLIENT_REQUEST_STMT(VG_USERREQ__DO_LEAK_CHECK, \ + 0, 0, 0, 0, 0) + +/* Same as VALGRIND_DO_LEAK_CHECK but only showing the entries for + which there was an increase in leaked bytes or leaked nr of blocks + since the previous leak search. */ +#define VALGRIND_DO_ADDED_LEAK_CHECK \ + VALGRIND_DO_CLIENT_REQUEST_STMT(VG_USERREQ__DO_LEAK_CHECK, \ + 0, 1, 0, 0, 0) + +/* Same as VALGRIND_DO_ADDED_LEAK_CHECK but showing entries with + increased or decreased leaked bytes/blocks since previous leak + search. */ +#define VALGRIND_DO_CHANGED_LEAK_CHECK \ + VALGRIND_DO_CLIENT_REQUEST_STMT(VG_USERREQ__DO_LEAK_CHECK, \ + 0, 2, 0, 0, 0) + +/* Do a summary memory leak check (like --leak-check=summary) mid-execution. */ +#define VALGRIND_DO_QUICK_LEAK_CHECK \ + VALGRIND_DO_CLIENT_REQUEST_STMT(VG_USERREQ__DO_LEAK_CHECK, \ + 1, 0, 0, 0, 0) + +/* Return number of leaked, dubious, reachable and suppressed bytes found by + all previous leak checks. They must be lvalues. */ +#define VALGRIND_COUNT_LEAKS(leaked, dubious, reachable, suppressed) \ + /* For safety on 64-bit platforms we assign the results to private + unsigned long variables, then assign these to the lvalues the user + specified, which works no matter what type 'leaked', 'dubious', etc + are. We also initialise '_qzz_leaked', etc because + VG_USERREQ__COUNT_LEAKS doesn't mark the values returned as + defined. */ \ + { \ + unsigned long _qzz_leaked = 0, _qzz_dubious = 0; \ + unsigned long _qzz_reachable = 0, _qzz_suppressed = 0; \ + VALGRIND_DO_CLIENT_REQUEST_STMT( \ + VG_USERREQ__COUNT_LEAKS, \ + &_qzz_leaked, &_qzz_dubious, \ + &_qzz_reachable, &_qzz_suppressed, 0); \ + leaked = _qzz_leaked; \ + dubious = _qzz_dubious; \ + reachable = _qzz_reachable; \ + suppressed = _qzz_suppressed; \ + } + +/* Return number of leaked, dubious, reachable and suppressed bytes found by + all previous leak checks. They must be lvalues. */ +#define VALGRIND_COUNT_LEAK_BLOCKS(leaked, dubious, reachable, suppressed) \ + /* For safety on 64-bit platforms we assign the results to private + unsigned long variables, then assign these to the lvalues the user + specified, which works no matter what type 'leaked', 'dubious', etc + are. We also initialise '_qzz_leaked', etc because + VG_USERREQ__COUNT_LEAKS doesn't mark the values returned as + defined. */ \ + { \ + unsigned long _qzz_leaked = 0, _qzz_dubious = 0; \ + unsigned long _qzz_reachable = 0, _qzz_suppressed = 0; \ + VALGRIND_DO_CLIENT_REQUEST_STMT( \ + VG_USERREQ__COUNT_LEAK_BLOCKS, \ + &_qzz_leaked, &_qzz_dubious, \ + &_qzz_reachable, &_qzz_suppressed, 0); \ + leaked = _qzz_leaked; \ + dubious = _qzz_dubious; \ + reachable = _qzz_reachable; \ + suppressed = _qzz_suppressed; \ + } + + +/* Get the validity data for addresses [zza..zza+zznbytes-1] and copy it + into the provided zzvbits array. Return values: + 0 if not running on valgrind + 1 success + 2 [previously indicated unaligned arrays; these are now allowed] + 3 if any parts of zzsrc/zzvbits are not addressable. + The metadata is not copied in cases 0, 2 or 3 so it should be + impossible to segfault your system by using this call. +*/ +#define VALGRIND_GET_VBITS(zza,zzvbits,zznbytes) \ + (unsigned)VALGRIND_DO_CLIENT_REQUEST_EXPR(0, \ + VG_USERREQ__GET_VBITS, \ + (const char*)(zza), \ + (char*)(zzvbits), \ + (zznbytes), 0, 0) + +/* Set the validity data for addresses [zza..zza+zznbytes-1], copying it + from the provided zzvbits array. Return values: + 0 if not running on valgrind + 1 success + 2 [previously indicated unaligned arrays; these are now allowed] + 3 if any parts of zza/zzvbits are not addressable. + The metadata is not copied in cases 0, 2 or 3 so it should be + impossible to segfault your system by using this call. +*/ +#define VALGRIND_SET_VBITS(zza,zzvbits,zznbytes) \ + (unsigned)VALGRIND_DO_CLIENT_REQUEST_EXPR(0, \ + VG_USERREQ__SET_VBITS, \ + (const char*)(zza), \ + (const char*)(zzvbits), \ + (zznbytes), 0, 0 ) + +/* Disable and re-enable reporting of addressing errors in the + specified address range. */ +#define VALGRIND_DISABLE_ADDR_ERROR_REPORTING_IN_RANGE(_qzz_addr,_qzz_len) \ + VALGRIND_DO_CLIENT_REQUEST_EXPR(0 /* default return */, \ + VG_USERREQ__DISABLE_ADDR_ERROR_REPORTING_IN_RANGE, \ + (_qzz_addr), (_qzz_len), 0, 0, 0) + +#define VALGRIND_ENABLE_ADDR_ERROR_REPORTING_IN_RANGE(_qzz_addr,_qzz_len) \ + VALGRIND_DO_CLIENT_REQUEST_EXPR(0 /* default return */, \ + VG_USERREQ__ENABLE_ADDR_ERROR_REPORTING_IN_RANGE, \ + (_qzz_addr), (_qzz_len), 0, 0, 0) + +#endif + diff --git a/com.oracle.truffle.r.native/gnur/patch/src/include/vg/valgrind.h b/com.oracle.truffle.r.native/gnur/patch/src/include/vg/valgrind.h new file mode 100644 index 0000000000000000000000000000000000000000..6954d751d5eb0c4f47b9f05622a92e00a9609d7a --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/include/vg/valgrind.h @@ -0,0 +1,6587 @@ +/* -*- c -*- + ---------------------------------------------------------------- + + Notice that the following BSD-style license applies to this one + file (valgrind.h) only. The rest of Valgrind is licensed under the + terms of the GNU General Public License, version 2, unless + otherwise indicated. See the COPYING file in the source + distribution for details. + + ---------------------------------------------------------------- + + This file is part of Valgrind, a dynamic binary instrumentation + framework. + + Copyright (C) 2000-2013 Julian Seward. All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions + are met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. The origin of this software must not be misrepresented; you must + not claim that you wrote the original software. If you use this + software in a product, an acknowledgment in the product + documentation would be appreciated but is not required. + + 3. Altered source versions must be plainly marked as such, and must + not be misrepresented as being the original software. + + 4. The name of the author may not be used to endorse or promote + products derived from this software without specific prior written + permission. + + THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS + OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED + WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY + DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL + DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE + GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, + WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING + NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS + SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + + ---------------------------------------------------------------- + + Notice that the above BSD-style license applies to this one file + (valgrind.h) only. The entire rest of Valgrind is licensed under + the terms of the GNU General Public License, version 2. See the + COPYING file in the source distribution for details. + + ---------------------------------------------------------------- +*/ + + +/* This file is for inclusion into client (your!) code. + + You can use these macros to manipulate and query Valgrind's + execution inside your own programs. + + The resulting executables will still run without Valgrind, just a + little bit more slowly than they otherwise would, but otherwise + unchanged. When not running on valgrind, each client request + consumes very few (eg. 7) instructions, so the resulting performance + loss is negligible unless you plan to execute client requests + millions of times per second. Nevertheless, if that is still a + problem, you can compile with the NVALGRIND symbol defined (gcc + -DNVALGRIND) so that client requests are not even compiled in. */ + +#ifndef __VALGRIND_H +#define __VALGRIND_H + + +/* ------------------------------------------------------------------ */ +/* VERSION NUMBER OF VALGRIND */ +/* ------------------------------------------------------------------ */ + +/* Specify Valgrind's version number, so that user code can + conditionally compile based on our version number. Note that these + were introduced at version 3.6 and so do not exist in version 3.5 + or earlier. The recommended way to use them to check for "version + X.Y or later" is (eg) + +#if defined(__VALGRIND_MAJOR__) && defined(__VALGRIND_MINOR__) \ + && (__VALGRIND_MAJOR__ > 3 \ + || (__VALGRIND_MAJOR__ == 3 && __VALGRIND_MINOR__ >= 6)) +*/ +#define __VALGRIND_MAJOR__ 3 +#define __VALGRIND_MINOR__ 10 + + +#include <stdarg.h> + +/* Nb: this file might be included in a file compiled with -ansi. So + we can't use C++ style "//" comments nor the "asm" keyword (instead + use "__asm__"). */ + +/* Derive some tags indicating what the target platform is. Note + that in this file we're using the compiler's CPP symbols for + identifying architectures, which are different to the ones we use + within the rest of Valgrind. Note, __powerpc__ is active for both + 32 and 64-bit PPC, whereas __powerpc64__ is only active for the + latter (on Linux, that is). + + Misc note: how to find out what's predefined in gcc by default: + gcc -Wp,-dM somefile.c +*/ +#undef PLAT_x86_darwin +#undef PLAT_amd64_darwin +#undef PLAT_x86_win32 +#undef PLAT_amd64_win64 +#undef PLAT_x86_linux +#undef PLAT_amd64_linux +#undef PLAT_ppc32_linux +#undef PLAT_ppc64be_linux +#undef PLAT_ppc64le_linux +#undef PLAT_arm_linux +#undef PLAT_arm64_linux +#undef PLAT_s390x_linux +#undef PLAT_mips32_linux +#undef PLAT_mips64_linux + + +#if defined(__APPLE__) && defined(__i386__) +# define PLAT_x86_darwin 1 +#elif defined(__APPLE__) && defined(__x86_64__) +# define PLAT_amd64_darwin 1 +#elif (defined(__MINGW32__) && !defined(__MINGW64__)) \ + || defined(__CYGWIN32__) \ + || (defined(_WIN32) && defined(_M_IX86)) +# define PLAT_x86_win32 1 +#elif defined(__MINGW64__) \ + || (defined(_WIN64) && defined(_M_X64)) +# define PLAT_amd64_win64 1 +#elif defined(__linux__) && defined(__i386__) +# define PLAT_x86_linux 1 +#elif defined(__linux__) && defined(__x86_64__) +# define PLAT_amd64_linux 1 +#elif defined(__linux__) && defined(__powerpc__) && !defined(__powerpc64__) +# define PLAT_ppc32_linux 1 +#elif defined(__linux__) && defined(__powerpc__) && defined(__powerpc64__) && _CALL_ELF != 2 +/* Big Endian uses ELF version 1 */ +# define PLAT_ppc64be_linux 1 +#elif defined(__linux__) && defined(__powerpc__) && defined(__powerpc64__) && _CALL_ELF == 2 +/* Little Endian uses ELF version 2 */ +# define PLAT_ppc64le_linux 1 +#elif defined(__linux__) && defined(__arm__) && !defined(__aarch64__) +# define PLAT_arm_linux 1 +#elif defined(__linux__) && defined(__aarch64__) && !defined(__arm__) +# define PLAT_arm64_linux 1 +#elif defined(__linux__) && defined(__s390__) && defined(__s390x__) +# define PLAT_s390x_linux 1 +#elif defined(__linux__) && defined(__mips__) && (__mips==64) +# define PLAT_mips64_linux 1 +#elif defined(__linux__) && defined(__mips__) && (__mips!=64) +# define PLAT_mips32_linux 1 +#else +/* If we're not compiling for our target platform, don't generate + any inline asms. */ +# if !defined(NVALGRIND) +# define NVALGRIND 1 +# endif +#endif + + +/* ------------------------------------------------------------------ */ +/* ARCHITECTURE SPECIFICS for SPECIAL INSTRUCTIONS. There is nothing */ +/* in here of use to end-users -- skip to the next section. */ +/* ------------------------------------------------------------------ */ + +/* + * VALGRIND_DO_CLIENT_REQUEST(): a statement that invokes a Valgrind client + * request. Accepts both pointers and integers as arguments. + * + * VALGRIND_DO_CLIENT_REQUEST_STMT(): a statement that invokes a Valgrind + * client request that does not return a value. + + * VALGRIND_DO_CLIENT_REQUEST_EXPR(): a C expression that invokes a Valgrind + * client request and whose value equals the client request result. Accepts + * both pointers and integers as arguments. Note that such calls are not + * necessarily pure functions -- they may have side effects. + */ + +#define VALGRIND_DO_CLIENT_REQUEST(_zzq_rlval, _zzq_default, \ + _zzq_request, _zzq_arg1, _zzq_arg2, \ + _zzq_arg3, _zzq_arg4, _zzq_arg5) \ + do { (_zzq_rlval) = VALGRIND_DO_CLIENT_REQUEST_EXPR((_zzq_default), \ + (_zzq_request), (_zzq_arg1), (_zzq_arg2), \ + (_zzq_arg3), (_zzq_arg4), (_zzq_arg5)); } while (0) + +#define VALGRIND_DO_CLIENT_REQUEST_STMT(_zzq_request, _zzq_arg1, \ + _zzq_arg2, _zzq_arg3, _zzq_arg4, _zzq_arg5) \ + do { (void) VALGRIND_DO_CLIENT_REQUEST_EXPR(0, \ + (_zzq_request), (_zzq_arg1), (_zzq_arg2), \ + (_zzq_arg3), (_zzq_arg4), (_zzq_arg5)); } while (0) + +#if defined(NVALGRIND) + +/* Define NVALGRIND to completely remove the Valgrind magic sequence + from the compiled code (analogous to NDEBUG's effects on + assert()) */ +#define VALGRIND_DO_CLIENT_REQUEST_EXPR( \ + _zzq_default, _zzq_request, \ + _zzq_arg1, _zzq_arg2, _zzq_arg3, _zzq_arg4, _zzq_arg5) \ + (_zzq_default) + +#else /* ! NVALGRIND */ + +/* The following defines the magic code sequences which the JITter + spots and handles magically. Don't look too closely at them as + they will rot your brain. + + The assembly code sequences for all architectures is in this one + file. This is because this file must be stand-alone, and we don't + want to have multiple files. + + For VALGRIND_DO_CLIENT_REQUEST, we must ensure that the default + value gets put in the return slot, so that everything works when + this is executed not under Valgrind. Args are passed in a memory + block, and so there's no intrinsic limit to the number that could + be passed, but it's currently five. + + The macro args are: + _zzq_rlval result lvalue + _zzq_default default value (result returned when running on real CPU) + _zzq_request request code + _zzq_arg1..5 request params + + The other two macros are used to support function wrapping, and are + a lot simpler. VALGRIND_GET_NR_CONTEXT returns the value of the + guest's NRADDR pseudo-register and whatever other information is + needed to safely run the call original from the wrapper: on + ppc64-linux, the R2 value at the divert point is also needed. This + information is abstracted into a user-visible type, OrigFn. + + VALGRIND_CALL_NOREDIR_* behaves the same as the following on the + guest, but guarantees that the branch instruction will not be + redirected: x86: call *%eax, amd64: call *%rax, ppc32/ppc64: + branch-and-link-to-r11. VALGRIND_CALL_NOREDIR is just text, not a + complete inline asm, since it needs to be combined with more magic + inline asm stuff to be useful. +*/ + +/* ------------------------- x86-{linux,darwin} ---------------- */ + +#if defined(PLAT_x86_linux) || defined(PLAT_x86_darwin) \ + || (defined(PLAT_x86_win32) && defined(__GNUC__)) + +typedef + struct { + unsigned int nraddr; /* where's the code? */ + } + OrigFn; + +#define __SPECIAL_INSTRUCTION_PREAMBLE \ + "roll $3, %%edi ; roll $13, %%edi\n\t" \ + "roll $29, %%edi ; roll $19, %%edi\n\t" + +#define VALGRIND_DO_CLIENT_REQUEST_EXPR( \ + _zzq_default, _zzq_request, \ + _zzq_arg1, _zzq_arg2, _zzq_arg3, _zzq_arg4, _zzq_arg5) \ + __extension__ \ + ({volatile unsigned int _zzq_args[6]; \ + volatile unsigned int _zzq_result; \ + _zzq_args[0] = (unsigned int)(_zzq_request); \ + _zzq_args[1] = (unsigned int)(_zzq_arg1); \ + _zzq_args[2] = (unsigned int)(_zzq_arg2); \ + _zzq_args[3] = (unsigned int)(_zzq_arg3); \ + _zzq_args[4] = (unsigned int)(_zzq_arg4); \ + _zzq_args[5] = (unsigned int)(_zzq_arg5); \ + __asm__ volatile(__SPECIAL_INSTRUCTION_PREAMBLE \ + /* %EDX = client_request ( %EAX ) */ \ + "xchgl %%ebx,%%ebx" \ + : "=d" (_zzq_result) \ + : "a" (&_zzq_args[0]), "0" (_zzq_default) \ + : "cc", "memory" \ + ); \ + _zzq_result; \ + }) + +#define VALGRIND_GET_NR_CONTEXT(_zzq_rlval) \ + { volatile OrigFn* _zzq_orig = &(_zzq_rlval); \ + volatile unsigned int __addr; \ + __asm__ volatile(__SPECIAL_INSTRUCTION_PREAMBLE \ + /* %EAX = guest_NRADDR */ \ + "xchgl %%ecx,%%ecx" \ + : "=a" (__addr) \ + : \ + : "cc", "memory" \ + ); \ + _zzq_orig->nraddr = __addr; \ + } + +#define VALGRIND_CALL_NOREDIR_EAX \ + __SPECIAL_INSTRUCTION_PREAMBLE \ + /* call-noredir *%EAX */ \ + "xchgl %%edx,%%edx\n\t" + +#define VALGRIND_VEX_INJECT_IR() \ + do { \ + __asm__ volatile(__SPECIAL_INSTRUCTION_PREAMBLE \ + "xchgl %%edi,%%edi\n\t" \ + : : : "cc", "memory" \ + ); \ + } while (0) + +#endif /* PLAT_x86_linux || PLAT_x86_darwin || (PLAT_x86_win32 && __GNUC__) */ + +/* ------------------------- x86-Win32 ------------------------- */ + +#if defined(PLAT_x86_win32) && !defined(__GNUC__) + +typedef + struct { + unsigned int nraddr; /* where's the code? */ + } + OrigFn; + +#if defined(_MSC_VER) + +#define __SPECIAL_INSTRUCTION_PREAMBLE \ + __asm rol edi, 3 __asm rol edi, 13 \ + __asm rol edi, 29 __asm rol edi, 19 + +#define VALGRIND_DO_CLIENT_REQUEST_EXPR( \ + _zzq_default, _zzq_request, \ + _zzq_arg1, _zzq_arg2, _zzq_arg3, _zzq_arg4, _zzq_arg5) \ + valgrind_do_client_request_expr((uintptr_t)(_zzq_default), \ + (uintptr_t)(_zzq_request), (uintptr_t)(_zzq_arg1), \ + (uintptr_t)(_zzq_arg2), (uintptr_t)(_zzq_arg3), \ + (uintptr_t)(_zzq_arg4), (uintptr_t)(_zzq_arg5)) + +static __inline uintptr_t +valgrind_do_client_request_expr(uintptr_t _zzq_default, uintptr_t _zzq_request, + uintptr_t _zzq_arg1, uintptr_t _zzq_arg2, + uintptr_t _zzq_arg3, uintptr_t _zzq_arg4, + uintptr_t _zzq_arg5) +{ + volatile uintptr_t _zzq_args[6]; + volatile unsigned int _zzq_result; + _zzq_args[0] = (uintptr_t)(_zzq_request); + _zzq_args[1] = (uintptr_t)(_zzq_arg1); + _zzq_args[2] = (uintptr_t)(_zzq_arg2); + _zzq_args[3] = (uintptr_t)(_zzq_arg3); + _zzq_args[4] = (uintptr_t)(_zzq_arg4); + _zzq_args[5] = (uintptr_t)(_zzq_arg5); + __asm { __asm lea eax, _zzq_args __asm mov edx, _zzq_default + __SPECIAL_INSTRUCTION_PREAMBLE + /* %EDX = client_request ( %EAX ) */ + __asm xchg ebx,ebx + __asm mov _zzq_result, edx + } + return _zzq_result; +} + +#define VALGRIND_GET_NR_CONTEXT(_zzq_rlval) \ + { volatile OrigFn* _zzq_orig = &(_zzq_rlval); \ + volatile unsigned int __addr; \ + __asm { __SPECIAL_INSTRUCTION_PREAMBLE \ + /* %EAX = guest_NRADDR */ \ + __asm xchg ecx,ecx \ + __asm mov __addr, eax \ + } \ + _zzq_orig->nraddr = __addr; \ + } + +#define VALGRIND_CALL_NOREDIR_EAX ERROR + +#define VALGRIND_VEX_INJECT_IR() \ + do { \ + __asm { __SPECIAL_INSTRUCTION_PREAMBLE \ + __asm xchg edi,edi \ + } \ + } while (0) + +#else +#error Unsupported compiler. +#endif + +#endif /* PLAT_x86_win32 */ + +/* ------------------------ amd64-{linux,darwin} --------------- */ + +#if defined(PLAT_amd64_linux) || defined(PLAT_amd64_darwin) \ + || (defined(PLAT_amd64_win64) && defined(__GNUC__)) + +typedef + struct { + unsigned long long int nraddr; /* where's the code? */ + } + OrigFn; + +#define __SPECIAL_INSTRUCTION_PREAMBLE \ + "rolq $3, %%rdi ; rolq $13, %%rdi\n\t" \ + "rolq $61, %%rdi ; rolq $51, %%rdi\n\t" + +#define VALGRIND_DO_CLIENT_REQUEST_EXPR( \ + _zzq_default, _zzq_request, \ + _zzq_arg1, _zzq_arg2, _zzq_arg3, _zzq_arg4, _zzq_arg5) \ + __extension__ \ + ({ volatile unsigned long long int _zzq_args[6]; \ + volatile unsigned long long int _zzq_result; \ + _zzq_args[0] = (unsigned long long int)(_zzq_request); \ + _zzq_args[1] = (unsigned long long int)(_zzq_arg1); \ + _zzq_args[2] = (unsigned long long int)(_zzq_arg2); \ + _zzq_args[3] = (unsigned long long int)(_zzq_arg3); \ + _zzq_args[4] = (unsigned long long int)(_zzq_arg4); \ + _zzq_args[5] = (unsigned long long int)(_zzq_arg5); \ + __asm__ volatile(__SPECIAL_INSTRUCTION_PREAMBLE \ + /* %RDX = client_request ( %RAX ) */ \ + "xchgq %%rbx,%%rbx" \ + : "=d" (_zzq_result) \ + : "a" (&_zzq_args[0]), "0" (_zzq_default) \ + : "cc", "memory" \ + ); \ + _zzq_result; \ + }) + +#define VALGRIND_GET_NR_CONTEXT(_zzq_rlval) \ + { volatile OrigFn* _zzq_orig = &(_zzq_rlval); \ + volatile unsigned long long int __addr; \ + __asm__ volatile(__SPECIAL_INSTRUCTION_PREAMBLE \ + /* %RAX = guest_NRADDR */ \ + "xchgq %%rcx,%%rcx" \ + : "=a" (__addr) \ + : \ + : "cc", "memory" \ + ); \ + _zzq_orig->nraddr = __addr; \ + } + +#define VALGRIND_CALL_NOREDIR_RAX \ + __SPECIAL_INSTRUCTION_PREAMBLE \ + /* call-noredir *%RAX */ \ + "xchgq %%rdx,%%rdx\n\t" + +#define VALGRIND_VEX_INJECT_IR() \ + do { \ + __asm__ volatile(__SPECIAL_INSTRUCTION_PREAMBLE \ + "xchgq %%rdi,%%rdi\n\t" \ + : : : "cc", "memory" \ + ); \ + } while (0) + +#endif /* PLAT_amd64_linux || PLAT_amd64_darwin */ + +/* ------------------------- amd64-Win64 ------------------------- */ + +#if defined(PLAT_amd64_win64) && !defined(__GNUC__) + +#error Unsupported compiler. + +#endif /* PLAT_amd64_win64 */ + +/* ------------------------ ppc32-linux ------------------------ */ + +#if defined(PLAT_ppc32_linux) + +typedef + struct { + unsigned int nraddr; /* where's the code? */ + } + OrigFn; + +#define __SPECIAL_INSTRUCTION_PREAMBLE \ + "rlwinm 0,0,3,0,31 ; rlwinm 0,0,13,0,31\n\t" \ + "rlwinm 0,0,29,0,31 ; rlwinm 0,0,19,0,31\n\t" + +#define VALGRIND_DO_CLIENT_REQUEST_EXPR( \ + _zzq_default, _zzq_request, \ + _zzq_arg1, _zzq_arg2, _zzq_arg3, _zzq_arg4, _zzq_arg5) \ + \ + __extension__ \ + ({ unsigned int _zzq_args[6]; \ + unsigned int _zzq_result; \ + unsigned int* _zzq_ptr; \ + _zzq_args[0] = (unsigned int)(_zzq_request); \ + _zzq_args[1] = (unsigned int)(_zzq_arg1); \ + _zzq_args[2] = (unsigned int)(_zzq_arg2); \ + _zzq_args[3] = (unsigned int)(_zzq_arg3); \ + _zzq_args[4] = (unsigned int)(_zzq_arg4); \ + _zzq_args[5] = (unsigned int)(_zzq_arg5); \ + _zzq_ptr = _zzq_args; \ + __asm__ volatile("mr 3,%1\n\t" /*default*/ \ + "mr 4,%2\n\t" /*ptr*/ \ + __SPECIAL_INSTRUCTION_PREAMBLE \ + /* %R3 = client_request ( %R4 ) */ \ + "or 1,1,1\n\t" \ + "mr %0,3" /*result*/ \ + : "=b" (_zzq_result) \ + : "b" (_zzq_default), "b" (_zzq_ptr) \ + : "cc", "memory", "r3", "r4"); \ + _zzq_result; \ + }) + +#define VALGRIND_GET_NR_CONTEXT(_zzq_rlval) \ + { volatile OrigFn* _zzq_orig = &(_zzq_rlval); \ + unsigned int __addr; \ + __asm__ volatile(__SPECIAL_INSTRUCTION_PREAMBLE \ + /* %R3 = guest_NRADDR */ \ + "or 2,2,2\n\t" \ + "mr %0,3" \ + : "=b" (__addr) \ + : \ + : "cc", "memory", "r3" \ + ); \ + _zzq_orig->nraddr = __addr; \ + } + +#define VALGRIND_BRANCH_AND_LINK_TO_NOREDIR_R11 \ + __SPECIAL_INSTRUCTION_PREAMBLE \ + /* branch-and-link-to-noredir *%R11 */ \ + "or 3,3,3\n\t" + +#define VALGRIND_VEX_INJECT_IR() \ + do { \ + __asm__ volatile(__SPECIAL_INSTRUCTION_PREAMBLE \ + "or 5,5,5\n\t" \ + ); \ + } while (0) + +#endif /* PLAT_ppc32_linux */ + +/* ------------------------ ppc64-linux ------------------------ */ + +#if defined(PLAT_ppc64be_linux) + +typedef + struct { + unsigned long long int nraddr; /* where's the code? */ + unsigned long long int r2; /* what tocptr do we need? */ + } + OrigFn; + +#define __SPECIAL_INSTRUCTION_PREAMBLE \ + "rotldi 0,0,3 ; rotldi 0,0,13\n\t" \ + "rotldi 0,0,61 ; rotldi 0,0,51\n\t" + +#define VALGRIND_DO_CLIENT_REQUEST_EXPR( \ + _zzq_default, _zzq_request, \ + _zzq_arg1, _zzq_arg2, _zzq_arg3, _zzq_arg4, _zzq_arg5) \ + \ + __extension__ \ + ({ unsigned long long int _zzq_args[6]; \ + unsigned long long int _zzq_result; \ + unsigned long long int* _zzq_ptr; \ + _zzq_args[0] = (unsigned long long int)(_zzq_request); \ + _zzq_args[1] = (unsigned long long int)(_zzq_arg1); \ + _zzq_args[2] = (unsigned long long int)(_zzq_arg2); \ + _zzq_args[3] = (unsigned long long int)(_zzq_arg3); \ + _zzq_args[4] = (unsigned long long int)(_zzq_arg4); \ + _zzq_args[5] = (unsigned long long int)(_zzq_arg5); \ + _zzq_ptr = _zzq_args; \ + __asm__ volatile("mr 3,%1\n\t" /*default*/ \ + "mr 4,%2\n\t" /*ptr*/ \ + __SPECIAL_INSTRUCTION_PREAMBLE \ + /* %R3 = client_request ( %R4 ) */ \ + "or 1,1,1\n\t" \ + "mr %0,3" /*result*/ \ + : "=b" (_zzq_result) \ + : "b" (_zzq_default), "b" (_zzq_ptr) \ + : "cc", "memory", "r3", "r4"); \ + _zzq_result; \ + }) + +#define VALGRIND_GET_NR_CONTEXT(_zzq_rlval) \ + { volatile OrigFn* _zzq_orig = &(_zzq_rlval); \ + unsigned long long int __addr; \ + __asm__ volatile(__SPECIAL_INSTRUCTION_PREAMBLE \ + /* %R3 = guest_NRADDR */ \ + "or 2,2,2\n\t" \ + "mr %0,3" \ + : "=b" (__addr) \ + : \ + : "cc", "memory", "r3" \ + ); \ + _zzq_orig->nraddr = __addr; \ + __asm__ volatile(__SPECIAL_INSTRUCTION_PREAMBLE \ + /* %R3 = guest_NRADDR_GPR2 */ \ + "or 4,4,4\n\t" \ + "mr %0,3" \ + : "=b" (__addr) \ + : \ + : "cc", "memory", "r3" \ + ); \ + _zzq_orig->r2 = __addr; \ + } + +#define VALGRIND_BRANCH_AND_LINK_TO_NOREDIR_R11 \ + __SPECIAL_INSTRUCTION_PREAMBLE \ + /* branch-and-link-to-noredir *%R11 */ \ + "or 3,3,3\n\t" + +#define VALGRIND_VEX_INJECT_IR() \ + do { \ + __asm__ volatile(__SPECIAL_INSTRUCTION_PREAMBLE \ + "or 5,5,5\n\t" \ + ); \ + } while (0) + +#endif /* PLAT_ppc64be_linux */ + +#if defined(PLAT_ppc64le_linux) + +typedef + struct { + unsigned long long int nraddr; /* where's the code? */ + unsigned long long int r2; /* what tocptr do we need? */ + } + OrigFn; + +#define __SPECIAL_INSTRUCTION_PREAMBLE \ + "rotldi 0,0,3 ; rotldi 0,0,13\n\t" \ + "rotldi 0,0,61 ; rotldi 0,0,51\n\t" + +#define VALGRIND_DO_CLIENT_REQUEST_EXPR( \ + _zzq_default, _zzq_request, \ + _zzq_arg1, _zzq_arg2, _zzq_arg3, _zzq_arg4, _zzq_arg5) \ + \ + __extension__ \ + ({ unsigned long long int _zzq_args[6]; \ + unsigned long long int _zzq_result; \ + unsigned long long int* _zzq_ptr; \ + _zzq_args[0] = (unsigned long long int)(_zzq_request); \ + _zzq_args[1] = (unsigned long long int)(_zzq_arg1); \ + _zzq_args[2] = (unsigned long long int)(_zzq_arg2); \ + _zzq_args[3] = (unsigned long long int)(_zzq_arg3); \ + _zzq_args[4] = (unsigned long long int)(_zzq_arg4); \ + _zzq_args[5] = (unsigned long long int)(_zzq_arg5); \ + _zzq_ptr = _zzq_args; \ + __asm__ volatile("mr 3,%1\n\t" /*default*/ \ + "mr 4,%2\n\t" /*ptr*/ \ + __SPECIAL_INSTRUCTION_PREAMBLE \ + /* %R3 = client_request ( %R4 ) */ \ + "or 1,1,1\n\t" \ + "mr %0,3" /*result*/ \ + : "=b" (_zzq_result) \ + : "b" (_zzq_default), "b" (_zzq_ptr) \ + : "cc", "memory", "r3", "r4"); \ + _zzq_result; \ + }) + +#define VALGRIND_GET_NR_CONTEXT(_zzq_rlval) \ + { volatile OrigFn* _zzq_orig = &(_zzq_rlval); \ + unsigned long long int __addr; \ + __asm__ volatile(__SPECIAL_INSTRUCTION_PREAMBLE \ + /* %R3 = guest_NRADDR */ \ + "or 2,2,2\n\t" \ + "mr %0,3" \ + : "=b" (__addr) \ + : \ + : "cc", "memory", "r3" \ + ); \ + _zzq_orig->nraddr = __addr; \ + __asm__ volatile(__SPECIAL_INSTRUCTION_PREAMBLE \ + /* %R3 = guest_NRADDR_GPR2 */ \ + "or 4,4,4\n\t" \ + "mr %0,3" \ + : "=b" (__addr) \ + : \ + : "cc", "memory", "r3" \ + ); \ + _zzq_orig->r2 = __addr; \ + } + +#define VALGRIND_BRANCH_AND_LINK_TO_NOREDIR_R12 \ + __SPECIAL_INSTRUCTION_PREAMBLE \ + /* branch-and-link-to-noredir *%R12 */ \ + "or 3,3,3\n\t" + +#define VALGRIND_VEX_INJECT_IR() \ + do { \ + __asm__ volatile(__SPECIAL_INSTRUCTION_PREAMBLE \ + "or 5,5,5\n\t" \ + ); \ + } while (0) + +#endif /* PLAT_ppc64le_linux */ + +/* ------------------------- arm-linux ------------------------- */ + +#if defined(PLAT_arm_linux) + +typedef + struct { + unsigned int nraddr; /* where's the code? */ + } + OrigFn; + +#define __SPECIAL_INSTRUCTION_PREAMBLE \ + "mov r12, r12, ror #3 ; mov r12, r12, ror #13 \n\t" \ + "mov r12, r12, ror #29 ; mov r12, r12, ror #19 \n\t" + +#define VALGRIND_DO_CLIENT_REQUEST_EXPR( \ + _zzq_default, _zzq_request, \ + _zzq_arg1, _zzq_arg2, _zzq_arg3, _zzq_arg4, _zzq_arg5) \ + \ + __extension__ \ + ({volatile unsigned int _zzq_args[6]; \ + volatile unsigned int _zzq_result; \ + _zzq_args[0] = (unsigned int)(_zzq_request); \ + _zzq_args[1] = (unsigned int)(_zzq_arg1); \ + _zzq_args[2] = (unsigned int)(_zzq_arg2); \ + _zzq_args[3] = (unsigned int)(_zzq_arg3); \ + _zzq_args[4] = (unsigned int)(_zzq_arg4); \ + _zzq_args[5] = (unsigned int)(_zzq_arg5); \ + __asm__ volatile("mov r3, %1\n\t" /*default*/ \ + "mov r4, %2\n\t" /*ptr*/ \ + __SPECIAL_INSTRUCTION_PREAMBLE \ + /* R3 = client_request ( R4 ) */ \ + "orr r10, r10, r10\n\t" \ + "mov %0, r3" /*result*/ \ + : "=r" (_zzq_result) \ + : "r" (_zzq_default), "r" (&_zzq_args[0]) \ + : "cc","memory", "r3", "r4"); \ + _zzq_result; \ + }) + +#define VALGRIND_GET_NR_CONTEXT(_zzq_rlval) \ + { volatile OrigFn* _zzq_orig = &(_zzq_rlval); \ + unsigned int __addr; \ + __asm__ volatile(__SPECIAL_INSTRUCTION_PREAMBLE \ + /* R3 = guest_NRADDR */ \ + "orr r11, r11, r11\n\t" \ + "mov %0, r3" \ + : "=r" (__addr) \ + : \ + : "cc", "memory", "r3" \ + ); \ + _zzq_orig->nraddr = __addr; \ + } + +#define VALGRIND_BRANCH_AND_LINK_TO_NOREDIR_R4 \ + __SPECIAL_INSTRUCTION_PREAMBLE \ + /* branch-and-link-to-noredir *%R4 */ \ + "orr r12, r12, r12\n\t" + +#define VALGRIND_VEX_INJECT_IR() \ + do { \ + __asm__ volatile(__SPECIAL_INSTRUCTION_PREAMBLE \ + "orr r9, r9, r9\n\t" \ + : : : "cc", "memory" \ + ); \ + } while (0) + +#endif /* PLAT_arm_linux */ + +/* ------------------------ arm64-linux ------------------------- */ + +#if defined(PLAT_arm64_linux) + +typedef + struct { + unsigned long long int nraddr; /* where's the code? */ + } + OrigFn; + +#define __SPECIAL_INSTRUCTION_PREAMBLE \ + "ror x12, x12, #3 ; ror x12, x12, #13 \n\t" \ + "ror x12, x12, #51 ; ror x12, x12, #61 \n\t" + +#define VALGRIND_DO_CLIENT_REQUEST_EXPR( \ + _zzq_default, _zzq_request, \ + _zzq_arg1, _zzq_arg2, _zzq_arg3, _zzq_arg4, _zzq_arg5) \ + \ + __extension__ \ + ({volatile unsigned long long int _zzq_args[6]; \ + volatile unsigned long long int _zzq_result; \ + _zzq_args[0] = (unsigned long long int)(_zzq_request); \ + _zzq_args[1] = (unsigned long long int)(_zzq_arg1); \ + _zzq_args[2] = (unsigned long long int)(_zzq_arg2); \ + _zzq_args[3] = (unsigned long long int)(_zzq_arg3); \ + _zzq_args[4] = (unsigned long long int)(_zzq_arg4); \ + _zzq_args[5] = (unsigned long long int)(_zzq_arg5); \ + __asm__ volatile("mov x3, %1\n\t" /*default*/ \ + "mov x4, %2\n\t" /*ptr*/ \ + __SPECIAL_INSTRUCTION_PREAMBLE \ + /* X3 = client_request ( X4 ) */ \ + "orr x10, x10, x10\n\t" \ + "mov %0, x3" /*result*/ \ + : "=r" (_zzq_result) \ + : "r" (_zzq_default), "r" (&_zzq_args[0]) \ + : "cc","memory", "x3", "x4"); \ + _zzq_result; \ + }) + +#define VALGRIND_GET_NR_CONTEXT(_zzq_rlval) \ + { volatile OrigFn* _zzq_orig = &(_zzq_rlval); \ + unsigned long long int __addr; \ + __asm__ volatile(__SPECIAL_INSTRUCTION_PREAMBLE \ + /* X3 = guest_NRADDR */ \ + "orr x11, x11, x11\n\t" \ + "mov %0, x3" \ + : "=r" (__addr) \ + : \ + : "cc", "memory", "x3" \ + ); \ + _zzq_orig->nraddr = __addr; \ + } + +#define VALGRIND_BRANCH_AND_LINK_TO_NOREDIR_X8 \ + __SPECIAL_INSTRUCTION_PREAMBLE \ + /* branch-and-link-to-noredir X8 */ \ + "orr x12, x12, x12\n\t" + +#define VALGRIND_VEX_INJECT_IR() \ + do { \ + __asm__ volatile(__SPECIAL_INSTRUCTION_PREAMBLE \ + "orr x9, x9, x9\n\t" \ + : : : "cc", "memory" \ + ); \ + } while (0) + +#endif /* PLAT_arm64_linux */ + +/* ------------------------ s390x-linux ------------------------ */ + +#if defined(PLAT_s390x_linux) + +typedef + struct { + unsigned long long int nraddr; /* where's the code? */ + } + OrigFn; + +/* __SPECIAL_INSTRUCTION_PREAMBLE will be used to identify Valgrind specific + * code. This detection is implemented in platform specific toIR.c + * (e.g. VEX/priv/guest_s390_decoder.c). + */ +#define __SPECIAL_INSTRUCTION_PREAMBLE \ + "lr 15,15\n\t" \ + "lr 1,1\n\t" \ + "lr 2,2\n\t" \ + "lr 3,3\n\t" + +#define __CLIENT_REQUEST_CODE "lr 2,2\n\t" +#define __GET_NR_CONTEXT_CODE "lr 3,3\n\t" +#define __CALL_NO_REDIR_CODE "lr 4,4\n\t" +#define __VEX_INJECT_IR_CODE "lr 5,5\n\t" + +#define VALGRIND_DO_CLIENT_REQUEST_EXPR( \ + _zzq_default, _zzq_request, \ + _zzq_arg1, _zzq_arg2, _zzq_arg3, _zzq_arg4, _zzq_arg5) \ + __extension__ \ + ({volatile unsigned long long int _zzq_args[6]; \ + volatile unsigned long long int _zzq_result; \ + _zzq_args[0] = (unsigned long long int)(_zzq_request); \ + _zzq_args[1] = (unsigned long long int)(_zzq_arg1); \ + _zzq_args[2] = (unsigned long long int)(_zzq_arg2); \ + _zzq_args[3] = (unsigned long long int)(_zzq_arg3); \ + _zzq_args[4] = (unsigned long long int)(_zzq_arg4); \ + _zzq_args[5] = (unsigned long long int)(_zzq_arg5); \ + __asm__ volatile(/* r2 = args */ \ + "lgr 2,%1\n\t" \ + /* r3 = default */ \ + "lgr 3,%2\n\t" \ + __SPECIAL_INSTRUCTION_PREAMBLE \ + __CLIENT_REQUEST_CODE \ + /* results = r3 */ \ + "lgr %0, 3\n\t" \ + : "=d" (_zzq_result) \ + : "a" (&_zzq_args[0]), "0" (_zzq_default) \ + : "cc", "2", "3", "memory" \ + ); \ + _zzq_result; \ + }) + +#define VALGRIND_GET_NR_CONTEXT(_zzq_rlval) \ + { volatile OrigFn* _zzq_orig = &(_zzq_rlval); \ + volatile unsigned long long int __addr; \ + __asm__ volatile(__SPECIAL_INSTRUCTION_PREAMBLE \ + __GET_NR_CONTEXT_CODE \ + "lgr %0, 3\n\t" \ + : "=a" (__addr) \ + : \ + : "cc", "3", "memory" \ + ); \ + _zzq_orig->nraddr = __addr; \ + } + +#define VALGRIND_CALL_NOREDIR_R1 \ + __SPECIAL_INSTRUCTION_PREAMBLE \ + __CALL_NO_REDIR_CODE + +#define VALGRIND_VEX_INJECT_IR() \ + do { \ + __asm__ volatile(__SPECIAL_INSTRUCTION_PREAMBLE \ + __VEX_INJECT_IR_CODE); \ + } while (0) + +#endif /* PLAT_s390x_linux */ + +/* ------------------------- mips32-linux ---------------- */ + +#if defined(PLAT_mips32_linux) + +typedef + struct { + unsigned int nraddr; /* where's the code? */ + } + OrigFn; + +/* .word 0x342 + * .word 0x742 + * .word 0xC2 + * .word 0x4C2*/ +#define __SPECIAL_INSTRUCTION_PREAMBLE \ + "srl $0, $0, 13\n\t" \ + "srl $0, $0, 29\n\t" \ + "srl $0, $0, 3\n\t" \ + "srl $0, $0, 19\n\t" + +#define VALGRIND_DO_CLIENT_REQUEST_EXPR( \ + _zzq_default, _zzq_request, \ + _zzq_arg1, _zzq_arg2, _zzq_arg3, _zzq_arg4, _zzq_arg5) \ + __extension__ \ + ({ volatile unsigned int _zzq_args[6]; \ + volatile unsigned int _zzq_result; \ + _zzq_args[0] = (unsigned int)(_zzq_request); \ + _zzq_args[1] = (unsigned int)(_zzq_arg1); \ + _zzq_args[2] = (unsigned int)(_zzq_arg2); \ + _zzq_args[3] = (unsigned int)(_zzq_arg3); \ + _zzq_args[4] = (unsigned int)(_zzq_arg4); \ + _zzq_args[5] = (unsigned int)(_zzq_arg5); \ + __asm__ volatile("move $11, %1\n\t" /*default*/ \ + "move $12, %2\n\t" /*ptr*/ \ + __SPECIAL_INSTRUCTION_PREAMBLE \ + /* T3 = client_request ( T4 ) */ \ + "or $13, $13, $13\n\t" \ + "move %0, $11\n\t" /*result*/ \ + : "=r" (_zzq_result) \ + : "r" (_zzq_default), "r" (&_zzq_args[0]) \ + : "$11", "$12"); \ + _zzq_result; \ + }) + +#define VALGRIND_GET_NR_CONTEXT(_zzq_rlval) \ + { volatile OrigFn* _zzq_orig = &(_zzq_rlval); \ + volatile unsigned int __addr; \ + __asm__ volatile(__SPECIAL_INSTRUCTION_PREAMBLE \ + /* %t9 = guest_NRADDR */ \ + "or $14, $14, $14\n\t" \ + "move %0, $11" /*result*/ \ + : "=r" (__addr) \ + : \ + : "$11" \ + ); \ + _zzq_orig->nraddr = __addr; \ + } + +#define VALGRIND_CALL_NOREDIR_T9 \ + __SPECIAL_INSTRUCTION_PREAMBLE \ + /* call-noredir *%t9 */ \ + "or $15, $15, $15\n\t" + +#define VALGRIND_VEX_INJECT_IR() \ + do { \ + __asm__ volatile(__SPECIAL_INSTRUCTION_PREAMBLE \ + "or $11, $11, $11\n\t" \ + ); \ + } while (0) + + +#endif /* PLAT_mips32_linux */ + +/* ------------------------- mips64-linux ---------------- */ + +#if defined(PLAT_mips64_linux) + +typedef + struct { + unsigned long long nraddr; /* where's the code? */ + } + OrigFn; + +/* dsll $0,$0, 3 + * dsll $0,$0, 13 + * dsll $0,$0, 29 + * dsll $0,$0, 19*/ +#define __SPECIAL_INSTRUCTION_PREAMBLE \ + "dsll $0,$0, 3 ; dsll $0,$0,13\n\t" \ + "dsll $0,$0,29 ; dsll $0,$0,19\n\t" + +#define VALGRIND_DO_CLIENT_REQUEST_EXPR( \ + _zzq_default, _zzq_request, \ + _zzq_arg1, _zzq_arg2, _zzq_arg3, _zzq_arg4, _zzq_arg5) \ + __extension__ \ + ({ volatile unsigned long long int _zzq_args[6]; \ + volatile unsigned long long int _zzq_result; \ + _zzq_args[0] = (unsigned long long int)(_zzq_request); \ + _zzq_args[1] = (unsigned long long int)(_zzq_arg1); \ + _zzq_args[2] = (unsigned long long int)(_zzq_arg2); \ + _zzq_args[3] = (unsigned long long int)(_zzq_arg3); \ + _zzq_args[4] = (unsigned long long int)(_zzq_arg4); \ + _zzq_args[5] = (unsigned long long int)(_zzq_arg5); \ + __asm__ volatile("move $11, %1\n\t" /*default*/ \ + "move $12, %2\n\t" /*ptr*/ \ + __SPECIAL_INSTRUCTION_PREAMBLE \ + /* $11 = client_request ( $12 ) */ \ + "or $13, $13, $13\n\t" \ + "move %0, $11\n\t" /*result*/ \ + : "=r" (_zzq_result) \ + : "r" (_zzq_default), "r" (&_zzq_args[0]) \ + : "$11", "$12"); \ + _zzq_result; \ + }) + +#define VALGRIND_GET_NR_CONTEXT(_zzq_rlval) \ + { volatile OrigFn* _zzq_orig = &(_zzq_rlval); \ + volatile unsigned long long int __addr; \ + __asm__ volatile(__SPECIAL_INSTRUCTION_PREAMBLE \ + /* $11 = guest_NRADDR */ \ + "or $14, $14, $14\n\t" \ + "move %0, $11" /*result*/ \ + : "=r" (__addr) \ + : \ + : "$11"); \ + _zzq_orig->nraddr = __addr; \ + } + +#define VALGRIND_CALL_NOREDIR_T9 \ + __SPECIAL_INSTRUCTION_PREAMBLE \ + /* call-noredir $25 */ \ + "or $15, $15, $15\n\t" + +#define VALGRIND_VEX_INJECT_IR() \ + do { \ + __asm__ volatile(__SPECIAL_INSTRUCTION_PREAMBLE \ + "or $11, $11, $11\n\t" \ + ); \ + } while (0) + +#endif /* PLAT_mips64_linux */ + +/* Insert assembly code for other platforms here... */ + +#endif /* NVALGRIND */ + + +/* ------------------------------------------------------------------ */ +/* PLATFORM SPECIFICS for FUNCTION WRAPPING. This is all very */ +/* ugly. It's the least-worst tradeoff I can think of. */ +/* ------------------------------------------------------------------ */ + +/* This section defines magic (a.k.a appalling-hack) macros for doing + guaranteed-no-redirection macros, so as to get from function + wrappers to the functions they are wrapping. The whole point is to + construct standard call sequences, but to do the call itself with a + special no-redirect call pseudo-instruction that the JIT + understands and handles specially. This section is long and + repetitious, and I can't see a way to make it shorter. + + The naming scheme is as follows: + + CALL_FN_{W,v}_{v,W,WW,WWW,WWWW,5W,6W,7W,etc} + + 'W' stands for "word" and 'v' for "void". Hence there are + different macros for calling arity 0, 1, 2, 3, 4, etc, functions, + and for each, the possibility of returning a word-typed result, or + no result. +*/ + +/* Use these to write the name of your wrapper. NOTE: duplicates + VG_WRAP_FUNCTION_Z{U,Z} in pub_tool_redir.h. NOTE also: inserts + the default behaviour equivalance class tag "0000" into the name. + See pub_tool_redir.h for details -- normally you don't need to + think about this, though. */ + +/* Use an extra level of macroisation so as to ensure the soname/fnname + args are fully macro-expanded before pasting them together. */ +#define VG_CONCAT4(_aa,_bb,_cc,_dd) _aa##_bb##_cc##_dd + +#define I_WRAP_SONAME_FNNAME_ZU(soname,fnname) \ + VG_CONCAT4(_vgw00000ZU_,soname,_,fnname) + +#define I_WRAP_SONAME_FNNAME_ZZ(soname,fnname) \ + VG_CONCAT4(_vgw00000ZZ_,soname,_,fnname) + +/* Use this macro from within a wrapper function to collect the + context (address and possibly other info) of the original function. + Once you have that you can then use it in one of the CALL_FN_ + macros. The type of the argument _lval is OrigFn. */ +#define VALGRIND_GET_ORIG_FN(_lval) VALGRIND_GET_NR_CONTEXT(_lval) + +/* Also provide end-user facilities for function replacement, rather + than wrapping. A replacement function differs from a wrapper in + that it has no way to get hold of the original function being + called, and hence no way to call onwards to it. In a replacement + function, VALGRIND_GET_ORIG_FN always returns zero. */ + +#define I_REPLACE_SONAME_FNNAME_ZU(soname,fnname) \ + VG_CONCAT4(_vgr00000ZU_,soname,_,fnname) + +#define I_REPLACE_SONAME_FNNAME_ZZ(soname,fnname) \ + VG_CONCAT4(_vgr00000ZZ_,soname,_,fnname) + +/* Derivatives of the main macros below, for calling functions + returning void. */ + +#define CALL_FN_v_v(fnptr) \ + do { volatile unsigned long _junk; \ + CALL_FN_W_v(_junk,fnptr); } while (0) + +#define CALL_FN_v_W(fnptr, arg1) \ + do { volatile unsigned long _junk; \ + CALL_FN_W_W(_junk,fnptr,arg1); } while (0) + +#define CALL_FN_v_WW(fnptr, arg1,arg2) \ + do { volatile unsigned long _junk; \ + CALL_FN_W_WW(_junk,fnptr,arg1,arg2); } while (0) + +#define CALL_FN_v_WWW(fnptr, arg1,arg2,arg3) \ + do { volatile unsigned long _junk; \ + CALL_FN_W_WWW(_junk,fnptr,arg1,arg2,arg3); } while (0) + +#define CALL_FN_v_WWWW(fnptr, arg1,arg2,arg3,arg4) \ + do { volatile unsigned long _junk; \ + CALL_FN_W_WWWW(_junk,fnptr,arg1,arg2,arg3,arg4); } while (0) + +#define CALL_FN_v_5W(fnptr, arg1,arg2,arg3,arg4,arg5) \ + do { volatile unsigned long _junk; \ + CALL_FN_W_5W(_junk,fnptr,arg1,arg2,arg3,arg4,arg5); } while (0) + +#define CALL_FN_v_6W(fnptr, arg1,arg2,arg3,arg4,arg5,arg6) \ + do { volatile unsigned long _junk; \ + CALL_FN_W_6W(_junk,fnptr,arg1,arg2,arg3,arg4,arg5,arg6); } while (0) + +#define CALL_FN_v_7W(fnptr, arg1,arg2,arg3,arg4,arg5,arg6,arg7) \ + do { volatile unsigned long _junk; \ + CALL_FN_W_7W(_junk,fnptr,arg1,arg2,arg3,arg4,arg5,arg6,arg7); } while (0) + +/* ------------------------- x86-{linux,darwin} ---------------- */ + +#if defined(PLAT_x86_linux) || defined(PLAT_x86_darwin) + +/* These regs are trashed by the hidden call. No need to mention eax + as gcc can already see that, plus causes gcc to bomb. */ +#define __CALLER_SAVED_REGS /*"eax"*/ "ecx", "edx" + +/* Macros to save and align the stack before making a function + call and restore it afterwards as gcc may not keep the stack + pointer aligned if it doesn't realise calls are being made + to other functions. */ + +#define VALGRIND_ALIGN_STACK \ + "movl %%esp,%%edi\n\t" \ + "andl $0xfffffff0,%%esp\n\t" +#define VALGRIND_RESTORE_STACK \ + "movl %%edi,%%esp\n\t" + +/* These CALL_FN_ macros assume that on x86-linux, sizeof(unsigned + long) == 4. */ + +#define CALL_FN_W_v(lval, orig) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[1]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + __asm__ volatile( \ + VALGRIND_ALIGN_STACK \ + "movl (%%eax), %%eax\n\t" /* target->%eax */ \ + VALGRIND_CALL_NOREDIR_EAX \ + VALGRIND_RESTORE_STACK \ + : /*out*/ "=a" (_res) \ + : /*in*/ "a" (&_argvec[0]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS, "edi" \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_W(lval, orig, arg1) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[2]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)(arg1); \ + __asm__ volatile( \ + VALGRIND_ALIGN_STACK \ + "subl $12, %%esp\n\t" \ + "pushl 4(%%eax)\n\t" \ + "movl (%%eax), %%eax\n\t" /* target->%eax */ \ + VALGRIND_CALL_NOREDIR_EAX \ + VALGRIND_RESTORE_STACK \ + : /*out*/ "=a" (_res) \ + : /*in*/ "a" (&_argvec[0]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS, "edi" \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_WW(lval, orig, arg1,arg2) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[3]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)(arg1); \ + _argvec[2] = (unsigned long)(arg2); \ + __asm__ volatile( \ + VALGRIND_ALIGN_STACK \ + "subl $8, %%esp\n\t" \ + "pushl 8(%%eax)\n\t" \ + "pushl 4(%%eax)\n\t" \ + "movl (%%eax), %%eax\n\t" /* target->%eax */ \ + VALGRIND_CALL_NOREDIR_EAX \ + VALGRIND_RESTORE_STACK \ + : /*out*/ "=a" (_res) \ + : /*in*/ "a" (&_argvec[0]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS, "edi" \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_WWW(lval, orig, arg1,arg2,arg3) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[4]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)(arg1); \ + _argvec[2] = (unsigned long)(arg2); \ + _argvec[3] = (unsigned long)(arg3); \ + __asm__ volatile( \ + VALGRIND_ALIGN_STACK \ + "subl $4, %%esp\n\t" \ + "pushl 12(%%eax)\n\t" \ + "pushl 8(%%eax)\n\t" \ + "pushl 4(%%eax)\n\t" \ + "movl (%%eax), %%eax\n\t" /* target->%eax */ \ + VALGRIND_CALL_NOREDIR_EAX \ + VALGRIND_RESTORE_STACK \ + : /*out*/ "=a" (_res) \ + : /*in*/ "a" (&_argvec[0]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS, "edi" \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_WWWW(lval, orig, arg1,arg2,arg3,arg4) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[5]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)(arg1); \ + _argvec[2] = (unsigned long)(arg2); \ + _argvec[3] = (unsigned long)(arg3); \ + _argvec[4] = (unsigned long)(arg4); \ + __asm__ volatile( \ + VALGRIND_ALIGN_STACK \ + "pushl 16(%%eax)\n\t" \ + "pushl 12(%%eax)\n\t" \ + "pushl 8(%%eax)\n\t" \ + "pushl 4(%%eax)\n\t" \ + "movl (%%eax), %%eax\n\t" /* target->%eax */ \ + VALGRIND_CALL_NOREDIR_EAX \ + VALGRIND_RESTORE_STACK \ + : /*out*/ "=a" (_res) \ + : /*in*/ "a" (&_argvec[0]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS, "edi" \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_5W(lval, orig, arg1,arg2,arg3,arg4,arg5) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[6]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)(arg1); \ + _argvec[2] = (unsigned long)(arg2); \ + _argvec[3] = (unsigned long)(arg3); \ + _argvec[4] = (unsigned long)(arg4); \ + _argvec[5] = (unsigned long)(arg5); \ + __asm__ volatile( \ + VALGRIND_ALIGN_STACK \ + "subl $12, %%esp\n\t" \ + "pushl 20(%%eax)\n\t" \ + "pushl 16(%%eax)\n\t" \ + "pushl 12(%%eax)\n\t" \ + "pushl 8(%%eax)\n\t" \ + "pushl 4(%%eax)\n\t" \ + "movl (%%eax), %%eax\n\t" /* target->%eax */ \ + VALGRIND_CALL_NOREDIR_EAX \ + VALGRIND_RESTORE_STACK \ + : /*out*/ "=a" (_res) \ + : /*in*/ "a" (&_argvec[0]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS, "edi" \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_6W(lval, orig, arg1,arg2,arg3,arg4,arg5,arg6) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[7]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)(arg1); \ + _argvec[2] = (unsigned long)(arg2); \ + _argvec[3] = (unsigned long)(arg3); \ + _argvec[4] = (unsigned long)(arg4); \ + _argvec[5] = (unsigned long)(arg5); \ + _argvec[6] = (unsigned long)(arg6); \ + __asm__ volatile( \ + VALGRIND_ALIGN_STACK \ + "subl $8, %%esp\n\t" \ + "pushl 24(%%eax)\n\t" \ + "pushl 20(%%eax)\n\t" \ + "pushl 16(%%eax)\n\t" \ + "pushl 12(%%eax)\n\t" \ + "pushl 8(%%eax)\n\t" \ + "pushl 4(%%eax)\n\t" \ + "movl (%%eax), %%eax\n\t" /* target->%eax */ \ + VALGRIND_CALL_NOREDIR_EAX \ + VALGRIND_RESTORE_STACK \ + : /*out*/ "=a" (_res) \ + : /*in*/ "a" (&_argvec[0]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS, "edi" \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_7W(lval, orig, arg1,arg2,arg3,arg4,arg5,arg6, \ + arg7) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[8]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)(arg1); \ + _argvec[2] = (unsigned long)(arg2); \ + _argvec[3] = (unsigned long)(arg3); \ + _argvec[4] = (unsigned long)(arg4); \ + _argvec[5] = (unsigned long)(arg5); \ + _argvec[6] = (unsigned long)(arg6); \ + _argvec[7] = (unsigned long)(arg7); \ + __asm__ volatile( \ + VALGRIND_ALIGN_STACK \ + "subl $4, %%esp\n\t" \ + "pushl 28(%%eax)\n\t" \ + "pushl 24(%%eax)\n\t" \ + "pushl 20(%%eax)\n\t" \ + "pushl 16(%%eax)\n\t" \ + "pushl 12(%%eax)\n\t" \ + "pushl 8(%%eax)\n\t" \ + "pushl 4(%%eax)\n\t" \ + "movl (%%eax), %%eax\n\t" /* target->%eax */ \ + VALGRIND_CALL_NOREDIR_EAX \ + VALGRIND_RESTORE_STACK \ + : /*out*/ "=a" (_res) \ + : /*in*/ "a" (&_argvec[0]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS, "edi" \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_8W(lval, orig, arg1,arg2,arg3,arg4,arg5,arg6, \ + arg7,arg8) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[9]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)(arg1); \ + _argvec[2] = (unsigned long)(arg2); \ + _argvec[3] = (unsigned long)(arg3); \ + _argvec[4] = (unsigned long)(arg4); \ + _argvec[5] = (unsigned long)(arg5); \ + _argvec[6] = (unsigned long)(arg6); \ + _argvec[7] = (unsigned long)(arg7); \ + _argvec[8] = (unsigned long)(arg8); \ + __asm__ volatile( \ + VALGRIND_ALIGN_STACK \ + "pushl 32(%%eax)\n\t" \ + "pushl 28(%%eax)\n\t" \ + "pushl 24(%%eax)\n\t" \ + "pushl 20(%%eax)\n\t" \ + "pushl 16(%%eax)\n\t" \ + "pushl 12(%%eax)\n\t" \ + "pushl 8(%%eax)\n\t" \ + "pushl 4(%%eax)\n\t" \ + "movl (%%eax), %%eax\n\t" /* target->%eax */ \ + VALGRIND_CALL_NOREDIR_EAX \ + VALGRIND_RESTORE_STACK \ + : /*out*/ "=a" (_res) \ + : /*in*/ "a" (&_argvec[0]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS, "edi" \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_9W(lval, orig, arg1,arg2,arg3,arg4,arg5,arg6, \ + arg7,arg8,arg9) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[10]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)(arg1); \ + _argvec[2] = (unsigned long)(arg2); \ + _argvec[3] = (unsigned long)(arg3); \ + _argvec[4] = (unsigned long)(arg4); \ + _argvec[5] = (unsigned long)(arg5); \ + _argvec[6] = (unsigned long)(arg6); \ + _argvec[7] = (unsigned long)(arg7); \ + _argvec[8] = (unsigned long)(arg8); \ + _argvec[9] = (unsigned long)(arg9); \ + __asm__ volatile( \ + VALGRIND_ALIGN_STACK \ + "subl $12, %%esp\n\t" \ + "pushl 36(%%eax)\n\t" \ + "pushl 32(%%eax)\n\t" \ + "pushl 28(%%eax)\n\t" \ + "pushl 24(%%eax)\n\t" \ + "pushl 20(%%eax)\n\t" \ + "pushl 16(%%eax)\n\t" \ + "pushl 12(%%eax)\n\t" \ + "pushl 8(%%eax)\n\t" \ + "pushl 4(%%eax)\n\t" \ + "movl (%%eax), %%eax\n\t" /* target->%eax */ \ + VALGRIND_CALL_NOREDIR_EAX \ + VALGRIND_RESTORE_STACK \ + : /*out*/ "=a" (_res) \ + : /*in*/ "a" (&_argvec[0]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS, "edi" \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_10W(lval, orig, arg1,arg2,arg3,arg4,arg5,arg6, \ + arg7,arg8,arg9,arg10) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[11]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)(arg1); \ + _argvec[2] = (unsigned long)(arg2); \ + _argvec[3] = (unsigned long)(arg3); \ + _argvec[4] = (unsigned long)(arg4); \ + _argvec[5] = (unsigned long)(arg5); \ + _argvec[6] = (unsigned long)(arg6); \ + _argvec[7] = (unsigned long)(arg7); \ + _argvec[8] = (unsigned long)(arg8); \ + _argvec[9] = (unsigned long)(arg9); \ + _argvec[10] = (unsigned long)(arg10); \ + __asm__ volatile( \ + VALGRIND_ALIGN_STACK \ + "subl $8, %%esp\n\t" \ + "pushl 40(%%eax)\n\t" \ + "pushl 36(%%eax)\n\t" \ + "pushl 32(%%eax)\n\t" \ + "pushl 28(%%eax)\n\t" \ + "pushl 24(%%eax)\n\t" \ + "pushl 20(%%eax)\n\t" \ + "pushl 16(%%eax)\n\t" \ + "pushl 12(%%eax)\n\t" \ + "pushl 8(%%eax)\n\t" \ + "pushl 4(%%eax)\n\t" \ + "movl (%%eax), %%eax\n\t" /* target->%eax */ \ + VALGRIND_CALL_NOREDIR_EAX \ + VALGRIND_RESTORE_STACK \ + : /*out*/ "=a" (_res) \ + : /*in*/ "a" (&_argvec[0]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS, "edi" \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_11W(lval, orig, arg1,arg2,arg3,arg4,arg5, \ + arg6,arg7,arg8,arg9,arg10, \ + arg11) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[12]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)(arg1); \ + _argvec[2] = (unsigned long)(arg2); \ + _argvec[3] = (unsigned long)(arg3); \ + _argvec[4] = (unsigned long)(arg4); \ + _argvec[5] = (unsigned long)(arg5); \ + _argvec[6] = (unsigned long)(arg6); \ + _argvec[7] = (unsigned long)(arg7); \ + _argvec[8] = (unsigned long)(arg8); \ + _argvec[9] = (unsigned long)(arg9); \ + _argvec[10] = (unsigned long)(arg10); \ + _argvec[11] = (unsigned long)(arg11); \ + __asm__ volatile( \ + VALGRIND_ALIGN_STACK \ + "subl $4, %%esp\n\t" \ + "pushl 44(%%eax)\n\t" \ + "pushl 40(%%eax)\n\t" \ + "pushl 36(%%eax)\n\t" \ + "pushl 32(%%eax)\n\t" \ + "pushl 28(%%eax)\n\t" \ + "pushl 24(%%eax)\n\t" \ + "pushl 20(%%eax)\n\t" \ + "pushl 16(%%eax)\n\t" \ + "pushl 12(%%eax)\n\t" \ + "pushl 8(%%eax)\n\t" \ + "pushl 4(%%eax)\n\t" \ + "movl (%%eax), %%eax\n\t" /* target->%eax */ \ + VALGRIND_CALL_NOREDIR_EAX \ + VALGRIND_RESTORE_STACK \ + : /*out*/ "=a" (_res) \ + : /*in*/ "a" (&_argvec[0]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS, "edi" \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_12W(lval, orig, arg1,arg2,arg3,arg4,arg5, \ + arg6,arg7,arg8,arg9,arg10, \ + arg11,arg12) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[13]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)(arg1); \ + _argvec[2] = (unsigned long)(arg2); \ + _argvec[3] = (unsigned long)(arg3); \ + _argvec[4] = (unsigned long)(arg4); \ + _argvec[5] = (unsigned long)(arg5); \ + _argvec[6] = (unsigned long)(arg6); \ + _argvec[7] = (unsigned long)(arg7); \ + _argvec[8] = (unsigned long)(arg8); \ + _argvec[9] = (unsigned long)(arg9); \ + _argvec[10] = (unsigned long)(arg10); \ + _argvec[11] = (unsigned long)(arg11); \ + _argvec[12] = (unsigned long)(arg12); \ + __asm__ volatile( \ + VALGRIND_ALIGN_STACK \ + "pushl 48(%%eax)\n\t" \ + "pushl 44(%%eax)\n\t" \ + "pushl 40(%%eax)\n\t" \ + "pushl 36(%%eax)\n\t" \ + "pushl 32(%%eax)\n\t" \ + "pushl 28(%%eax)\n\t" \ + "pushl 24(%%eax)\n\t" \ + "pushl 20(%%eax)\n\t" \ + "pushl 16(%%eax)\n\t" \ + "pushl 12(%%eax)\n\t" \ + "pushl 8(%%eax)\n\t" \ + "pushl 4(%%eax)\n\t" \ + "movl (%%eax), %%eax\n\t" /* target->%eax */ \ + VALGRIND_CALL_NOREDIR_EAX \ + VALGRIND_RESTORE_STACK \ + : /*out*/ "=a" (_res) \ + : /*in*/ "a" (&_argvec[0]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS, "edi" \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#endif /* PLAT_x86_linux || PLAT_x86_darwin */ + +/* ------------------------ amd64-{linux,darwin} --------------- */ + +#if defined(PLAT_amd64_linux) || defined(PLAT_amd64_darwin) + +/* ARGREGS: rdi rsi rdx rcx r8 r9 (the rest on stack in R-to-L order) */ + +/* These regs are trashed by the hidden call. */ +#define __CALLER_SAVED_REGS /*"rax",*/ "rcx", "rdx", "rsi", \ + "rdi", "r8", "r9", "r10", "r11" + +/* This is all pretty complex. It's so as to make stack unwinding + work reliably. See bug 243270. The basic problem is the sub and + add of 128 of %rsp in all of the following macros. If gcc believes + the CFA is in %rsp, then unwinding may fail, because what's at the + CFA is not what gcc "expected" when it constructs the CFIs for the + places where the macros are instantiated. + + But we can't just add a CFI annotation to increase the CFA offset + by 128, to match the sub of 128 from %rsp, because we don't know + whether gcc has chosen %rsp as the CFA at that point, or whether it + has chosen some other register (eg, %rbp). In the latter case, + adding a CFI annotation to change the CFA offset is simply wrong. + + So the solution is to get hold of the CFA using + __builtin_dwarf_cfa(), put it in a known register, and add a + CFI annotation to say what the register is. We choose %rbp for + this (perhaps perversely), because: + + (1) %rbp is already subject to unwinding. If a new register was + chosen then the unwinder would have to unwind it in all stack + traces, which is expensive, and + + (2) %rbp is already subject to precise exception updates in the + JIT. If a new register was chosen, we'd have to have precise + exceptions for it too, which reduces performance of the + generated code. + + However .. one extra complication. We can't just whack the result + of __builtin_dwarf_cfa() into %rbp and then add %rbp to the + list of trashed registers at the end of the inline assembly + fragments; gcc won't allow %rbp to appear in that list. Hence + instead we need to stash %rbp in %r15 for the duration of the asm, + and say that %r15 is trashed instead. gcc seems happy to go with + that. + + Oh .. and this all needs to be conditionalised so that it is + unchanged from before this commit, when compiled with older gccs + that don't support __builtin_dwarf_cfa. Furthermore, since + this header file is freestanding, it has to be independent of + config.h, and so the following conditionalisation cannot depend on + configure time checks. + + Although it's not clear from + 'defined(__GNUC__) && defined(__GCC_HAVE_DWARF2_CFI_ASM)', + this expression excludes Darwin. + .cfi directives in Darwin assembly appear to be completely + different and I haven't investigated how they work. + + For even more entertainment value, note we have to use the + completely undocumented __builtin_dwarf_cfa(), which appears to + really compute the CFA, whereas __builtin_frame_address(0) claims + to but actually doesn't. See + https://bugs.kde.org/show_bug.cgi?id=243270#c47 +*/ +#if defined(__GNUC__) && defined(__GCC_HAVE_DWARF2_CFI_ASM) +# define __FRAME_POINTER \ + ,"r"(__builtin_dwarf_cfa()) +# define VALGRIND_CFI_PROLOGUE \ + "movq %%rbp, %%r15\n\t" \ + "movq %2, %%rbp\n\t" \ + ".cfi_remember_state\n\t" \ + ".cfi_def_cfa rbp, 0\n\t" +# define VALGRIND_CFI_EPILOGUE \ + "movq %%r15, %%rbp\n\t" \ + ".cfi_restore_state\n\t" +#else +# define __FRAME_POINTER +# define VALGRIND_CFI_PROLOGUE +# define VALGRIND_CFI_EPILOGUE +#endif + +/* Macros to save and align the stack before making a function + call and restore it afterwards as gcc may not keep the stack + pointer aligned if it doesn't realise calls are being made + to other functions. */ + +#define VALGRIND_ALIGN_STACK \ + "movq %%rsp,%%r14\n\t" \ + "andq $0xfffffffffffffff0,%%rsp\n\t" +#define VALGRIND_RESTORE_STACK \ + "movq %%r14,%%rsp\n\t" + +/* These CALL_FN_ macros assume that on amd64-linux, sizeof(unsigned + long) == 8. */ + +/* NB 9 Sept 07. There is a nasty kludge here in all these CALL_FN_ + macros. In order not to trash the stack redzone, we need to drop + %rsp by 128 before the hidden call, and restore afterwards. The + nastyness is that it is only by luck that the stack still appears + to be unwindable during the hidden call - since then the behaviour + of any routine using this macro does not match what the CFI data + says. Sigh. + + Why is this important? Imagine that a wrapper has a stack + allocated local, and passes to the hidden call, a pointer to it. + Because gcc does not know about the hidden call, it may allocate + that local in the redzone. Unfortunately the hidden call may then + trash it before it comes to use it. So we must step clear of the + redzone, for the duration of the hidden call, to make it safe. + + Probably the same problem afflicts the other redzone-style ABIs too + (ppc64-linux); but for those, the stack is + self describing (none of this CFI nonsense) so at least messing + with the stack pointer doesn't give a danger of non-unwindable + stack. */ + +#define CALL_FN_W_v(lval, orig) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[1]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + __asm__ volatile( \ + VALGRIND_CFI_PROLOGUE \ + VALGRIND_ALIGN_STACK \ + "subq $128,%%rsp\n\t" \ + "movq (%%rax), %%rax\n\t" /* target->%rax */ \ + VALGRIND_CALL_NOREDIR_RAX \ + VALGRIND_RESTORE_STACK \ + VALGRIND_CFI_EPILOGUE \ + : /*out*/ "=a" (_res) \ + : /*in*/ "a" (&_argvec[0]) __FRAME_POINTER \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS, "r14", "r15" \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_W(lval, orig, arg1) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[2]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)(arg1); \ + __asm__ volatile( \ + VALGRIND_CFI_PROLOGUE \ + VALGRIND_ALIGN_STACK \ + "subq $128,%%rsp\n\t" \ + "movq 8(%%rax), %%rdi\n\t" \ + "movq (%%rax), %%rax\n\t" /* target->%rax */ \ + VALGRIND_CALL_NOREDIR_RAX \ + VALGRIND_RESTORE_STACK \ + VALGRIND_CFI_EPILOGUE \ + : /*out*/ "=a" (_res) \ + : /*in*/ "a" (&_argvec[0]) __FRAME_POINTER \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS, "r14", "r15" \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_WW(lval, orig, arg1,arg2) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[3]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)(arg1); \ + _argvec[2] = (unsigned long)(arg2); \ + __asm__ volatile( \ + VALGRIND_CFI_PROLOGUE \ + VALGRIND_ALIGN_STACK \ + "subq $128,%%rsp\n\t" \ + "movq 16(%%rax), %%rsi\n\t" \ + "movq 8(%%rax), %%rdi\n\t" \ + "movq (%%rax), %%rax\n\t" /* target->%rax */ \ + VALGRIND_CALL_NOREDIR_RAX \ + VALGRIND_RESTORE_STACK \ + VALGRIND_CFI_EPILOGUE \ + : /*out*/ "=a" (_res) \ + : /*in*/ "a" (&_argvec[0]) __FRAME_POINTER \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS, "r14", "r15" \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_WWW(lval, orig, arg1,arg2,arg3) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[4]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)(arg1); \ + _argvec[2] = (unsigned long)(arg2); \ + _argvec[3] = (unsigned long)(arg3); \ + __asm__ volatile( \ + VALGRIND_CFI_PROLOGUE \ + VALGRIND_ALIGN_STACK \ + "subq $128,%%rsp\n\t" \ + "movq 24(%%rax), %%rdx\n\t" \ + "movq 16(%%rax), %%rsi\n\t" \ + "movq 8(%%rax), %%rdi\n\t" \ + "movq (%%rax), %%rax\n\t" /* target->%rax */ \ + VALGRIND_CALL_NOREDIR_RAX \ + VALGRIND_RESTORE_STACK \ + VALGRIND_CFI_EPILOGUE \ + : /*out*/ "=a" (_res) \ + : /*in*/ "a" (&_argvec[0]) __FRAME_POINTER \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS, "r14", "r15" \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_WWWW(lval, orig, arg1,arg2,arg3,arg4) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[5]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)(arg1); \ + _argvec[2] = (unsigned long)(arg2); \ + _argvec[3] = (unsigned long)(arg3); \ + _argvec[4] = (unsigned long)(arg4); \ + __asm__ volatile( \ + VALGRIND_CFI_PROLOGUE \ + VALGRIND_ALIGN_STACK \ + "subq $128,%%rsp\n\t" \ + "movq 32(%%rax), %%rcx\n\t" \ + "movq 24(%%rax), %%rdx\n\t" \ + "movq 16(%%rax), %%rsi\n\t" \ + "movq 8(%%rax), %%rdi\n\t" \ + "movq (%%rax), %%rax\n\t" /* target->%rax */ \ + VALGRIND_CALL_NOREDIR_RAX \ + VALGRIND_RESTORE_STACK \ + VALGRIND_CFI_EPILOGUE \ + : /*out*/ "=a" (_res) \ + : /*in*/ "a" (&_argvec[0]) __FRAME_POINTER \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS, "r14", "r15" \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_5W(lval, orig, arg1,arg2,arg3,arg4,arg5) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[6]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)(arg1); \ + _argvec[2] = (unsigned long)(arg2); \ + _argvec[3] = (unsigned long)(arg3); \ + _argvec[4] = (unsigned long)(arg4); \ + _argvec[5] = (unsigned long)(arg5); \ + __asm__ volatile( \ + VALGRIND_CFI_PROLOGUE \ + VALGRIND_ALIGN_STACK \ + "subq $128,%%rsp\n\t" \ + "movq 40(%%rax), %%r8\n\t" \ + "movq 32(%%rax), %%rcx\n\t" \ + "movq 24(%%rax), %%rdx\n\t" \ + "movq 16(%%rax), %%rsi\n\t" \ + "movq 8(%%rax), %%rdi\n\t" \ + "movq (%%rax), %%rax\n\t" /* target->%rax */ \ + VALGRIND_CALL_NOREDIR_RAX \ + VALGRIND_RESTORE_STACK \ + VALGRIND_CFI_EPILOGUE \ + : /*out*/ "=a" (_res) \ + : /*in*/ "a" (&_argvec[0]) __FRAME_POINTER \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS, "r14", "r15" \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_6W(lval, orig, arg1,arg2,arg3,arg4,arg5,arg6) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[7]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)(arg1); \ + _argvec[2] = (unsigned long)(arg2); \ + _argvec[3] = (unsigned long)(arg3); \ + _argvec[4] = (unsigned long)(arg4); \ + _argvec[5] = (unsigned long)(arg5); \ + _argvec[6] = (unsigned long)(arg6); \ + __asm__ volatile( \ + VALGRIND_CFI_PROLOGUE \ + VALGRIND_ALIGN_STACK \ + "subq $128,%%rsp\n\t" \ + "movq 48(%%rax), %%r9\n\t" \ + "movq 40(%%rax), %%r8\n\t" \ + "movq 32(%%rax), %%rcx\n\t" \ + "movq 24(%%rax), %%rdx\n\t" \ + "movq 16(%%rax), %%rsi\n\t" \ + "movq 8(%%rax), %%rdi\n\t" \ + "movq (%%rax), %%rax\n\t" /* target->%rax */ \ + VALGRIND_CALL_NOREDIR_RAX \ + VALGRIND_RESTORE_STACK \ + VALGRIND_CFI_EPILOGUE \ + : /*out*/ "=a" (_res) \ + : /*in*/ "a" (&_argvec[0]) __FRAME_POINTER \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS, "r14", "r15" \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_7W(lval, orig, arg1,arg2,arg3,arg4,arg5,arg6, \ + arg7) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[8]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)(arg1); \ + _argvec[2] = (unsigned long)(arg2); \ + _argvec[3] = (unsigned long)(arg3); \ + _argvec[4] = (unsigned long)(arg4); \ + _argvec[5] = (unsigned long)(arg5); \ + _argvec[6] = (unsigned long)(arg6); \ + _argvec[7] = (unsigned long)(arg7); \ + __asm__ volatile( \ + VALGRIND_CFI_PROLOGUE \ + VALGRIND_ALIGN_STACK \ + "subq $136,%%rsp\n\t" \ + "pushq 56(%%rax)\n\t" \ + "movq 48(%%rax), %%r9\n\t" \ + "movq 40(%%rax), %%r8\n\t" \ + "movq 32(%%rax), %%rcx\n\t" \ + "movq 24(%%rax), %%rdx\n\t" \ + "movq 16(%%rax), %%rsi\n\t" \ + "movq 8(%%rax), %%rdi\n\t" \ + "movq (%%rax), %%rax\n\t" /* target->%rax */ \ + VALGRIND_CALL_NOREDIR_RAX \ + VALGRIND_RESTORE_STACK \ + VALGRIND_CFI_EPILOGUE \ + : /*out*/ "=a" (_res) \ + : /*in*/ "a" (&_argvec[0]) __FRAME_POINTER \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS, "r14", "r15" \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_8W(lval, orig, arg1,arg2,arg3,arg4,arg5,arg6, \ + arg7,arg8) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[9]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)(arg1); \ + _argvec[2] = (unsigned long)(arg2); \ + _argvec[3] = (unsigned long)(arg3); \ + _argvec[4] = (unsigned long)(arg4); \ + _argvec[5] = (unsigned long)(arg5); \ + _argvec[6] = (unsigned long)(arg6); \ + _argvec[7] = (unsigned long)(arg7); \ + _argvec[8] = (unsigned long)(arg8); \ + __asm__ volatile( \ + VALGRIND_CFI_PROLOGUE \ + VALGRIND_ALIGN_STACK \ + "subq $128,%%rsp\n\t" \ + "pushq 64(%%rax)\n\t" \ + "pushq 56(%%rax)\n\t" \ + "movq 48(%%rax), %%r9\n\t" \ + "movq 40(%%rax), %%r8\n\t" \ + "movq 32(%%rax), %%rcx\n\t" \ + "movq 24(%%rax), %%rdx\n\t" \ + "movq 16(%%rax), %%rsi\n\t" \ + "movq 8(%%rax), %%rdi\n\t" \ + "movq (%%rax), %%rax\n\t" /* target->%rax */ \ + VALGRIND_CALL_NOREDIR_RAX \ + VALGRIND_RESTORE_STACK \ + VALGRIND_CFI_EPILOGUE \ + : /*out*/ "=a" (_res) \ + : /*in*/ "a" (&_argvec[0]) __FRAME_POINTER \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS, "r14", "r15" \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_9W(lval, orig, arg1,arg2,arg3,arg4,arg5,arg6, \ + arg7,arg8,arg9) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[10]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)(arg1); \ + _argvec[2] = (unsigned long)(arg2); \ + _argvec[3] = (unsigned long)(arg3); \ + _argvec[4] = (unsigned long)(arg4); \ + _argvec[5] = (unsigned long)(arg5); \ + _argvec[6] = (unsigned long)(arg6); \ + _argvec[7] = (unsigned long)(arg7); \ + _argvec[8] = (unsigned long)(arg8); \ + _argvec[9] = (unsigned long)(arg9); \ + __asm__ volatile( \ + VALGRIND_CFI_PROLOGUE \ + VALGRIND_ALIGN_STACK \ + "subq $136,%%rsp\n\t" \ + "pushq 72(%%rax)\n\t" \ + "pushq 64(%%rax)\n\t" \ + "pushq 56(%%rax)\n\t" \ + "movq 48(%%rax), %%r9\n\t" \ + "movq 40(%%rax), %%r8\n\t" \ + "movq 32(%%rax), %%rcx\n\t" \ + "movq 24(%%rax), %%rdx\n\t" \ + "movq 16(%%rax), %%rsi\n\t" \ + "movq 8(%%rax), %%rdi\n\t" \ + "movq (%%rax), %%rax\n\t" /* target->%rax */ \ + VALGRIND_CALL_NOREDIR_RAX \ + VALGRIND_RESTORE_STACK \ + VALGRIND_CFI_EPILOGUE \ + : /*out*/ "=a" (_res) \ + : /*in*/ "a" (&_argvec[0]) __FRAME_POINTER \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS, "r14", "r15" \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_10W(lval, orig, arg1,arg2,arg3,arg4,arg5,arg6, \ + arg7,arg8,arg9,arg10) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[11]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)(arg1); \ + _argvec[2] = (unsigned long)(arg2); \ + _argvec[3] = (unsigned long)(arg3); \ + _argvec[4] = (unsigned long)(arg4); \ + _argvec[5] = (unsigned long)(arg5); \ + _argvec[6] = (unsigned long)(arg6); \ + _argvec[7] = (unsigned long)(arg7); \ + _argvec[8] = (unsigned long)(arg8); \ + _argvec[9] = (unsigned long)(arg9); \ + _argvec[10] = (unsigned long)(arg10); \ + __asm__ volatile( \ + VALGRIND_CFI_PROLOGUE \ + VALGRIND_ALIGN_STACK \ + "subq $128,%%rsp\n\t" \ + "pushq 80(%%rax)\n\t" \ + "pushq 72(%%rax)\n\t" \ + "pushq 64(%%rax)\n\t" \ + "pushq 56(%%rax)\n\t" \ + "movq 48(%%rax), %%r9\n\t" \ + "movq 40(%%rax), %%r8\n\t" \ + "movq 32(%%rax), %%rcx\n\t" \ + "movq 24(%%rax), %%rdx\n\t" \ + "movq 16(%%rax), %%rsi\n\t" \ + "movq 8(%%rax), %%rdi\n\t" \ + "movq (%%rax), %%rax\n\t" /* target->%rax */ \ + VALGRIND_CALL_NOREDIR_RAX \ + VALGRIND_RESTORE_STACK \ + VALGRIND_CFI_EPILOGUE \ + : /*out*/ "=a" (_res) \ + : /*in*/ "a" (&_argvec[0]) __FRAME_POINTER \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS, "r14", "r15" \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_11W(lval, orig, arg1,arg2,arg3,arg4,arg5,arg6, \ + arg7,arg8,arg9,arg10,arg11) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[12]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)(arg1); \ + _argvec[2] = (unsigned long)(arg2); \ + _argvec[3] = (unsigned long)(arg3); \ + _argvec[4] = (unsigned long)(arg4); \ + _argvec[5] = (unsigned long)(arg5); \ + _argvec[6] = (unsigned long)(arg6); \ + _argvec[7] = (unsigned long)(arg7); \ + _argvec[8] = (unsigned long)(arg8); \ + _argvec[9] = (unsigned long)(arg9); \ + _argvec[10] = (unsigned long)(arg10); \ + _argvec[11] = (unsigned long)(arg11); \ + __asm__ volatile( \ + VALGRIND_CFI_PROLOGUE \ + VALGRIND_ALIGN_STACK \ + "subq $136,%%rsp\n\t" \ + "pushq 88(%%rax)\n\t" \ + "pushq 80(%%rax)\n\t" \ + "pushq 72(%%rax)\n\t" \ + "pushq 64(%%rax)\n\t" \ + "pushq 56(%%rax)\n\t" \ + "movq 48(%%rax), %%r9\n\t" \ + "movq 40(%%rax), %%r8\n\t" \ + "movq 32(%%rax), %%rcx\n\t" \ + "movq 24(%%rax), %%rdx\n\t" \ + "movq 16(%%rax), %%rsi\n\t" \ + "movq 8(%%rax), %%rdi\n\t" \ + "movq (%%rax), %%rax\n\t" /* target->%rax */ \ + VALGRIND_CALL_NOREDIR_RAX \ + VALGRIND_RESTORE_STACK \ + VALGRIND_CFI_EPILOGUE \ + : /*out*/ "=a" (_res) \ + : /*in*/ "a" (&_argvec[0]) __FRAME_POINTER \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS, "r14", "r15" \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_12W(lval, orig, arg1,arg2,arg3,arg4,arg5,arg6, \ + arg7,arg8,arg9,arg10,arg11,arg12) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[13]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)(arg1); \ + _argvec[2] = (unsigned long)(arg2); \ + _argvec[3] = (unsigned long)(arg3); \ + _argvec[4] = (unsigned long)(arg4); \ + _argvec[5] = (unsigned long)(arg5); \ + _argvec[6] = (unsigned long)(arg6); \ + _argvec[7] = (unsigned long)(arg7); \ + _argvec[8] = (unsigned long)(arg8); \ + _argvec[9] = (unsigned long)(arg9); \ + _argvec[10] = (unsigned long)(arg10); \ + _argvec[11] = (unsigned long)(arg11); \ + _argvec[12] = (unsigned long)(arg12); \ + __asm__ volatile( \ + VALGRIND_CFI_PROLOGUE \ + VALGRIND_ALIGN_STACK \ + "subq $128,%%rsp\n\t" \ + "pushq 96(%%rax)\n\t" \ + "pushq 88(%%rax)\n\t" \ + "pushq 80(%%rax)\n\t" \ + "pushq 72(%%rax)\n\t" \ + "pushq 64(%%rax)\n\t" \ + "pushq 56(%%rax)\n\t" \ + "movq 48(%%rax), %%r9\n\t" \ + "movq 40(%%rax), %%r8\n\t" \ + "movq 32(%%rax), %%rcx\n\t" \ + "movq 24(%%rax), %%rdx\n\t" \ + "movq 16(%%rax), %%rsi\n\t" \ + "movq 8(%%rax), %%rdi\n\t" \ + "movq (%%rax), %%rax\n\t" /* target->%rax */ \ + VALGRIND_CALL_NOREDIR_RAX \ + VALGRIND_RESTORE_STACK \ + VALGRIND_CFI_EPILOGUE \ + : /*out*/ "=a" (_res) \ + : /*in*/ "a" (&_argvec[0]) __FRAME_POINTER \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS, "r14", "r15" \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#endif /* PLAT_amd64_linux || PLAT_amd64_darwin */ + +/* ------------------------ ppc32-linux ------------------------ */ + +#if defined(PLAT_ppc32_linux) + +/* This is useful for finding out about the on-stack stuff: + + extern int f9 ( int,int,int,int,int,int,int,int,int ); + extern int f10 ( int,int,int,int,int,int,int,int,int,int ); + extern int f11 ( int,int,int,int,int,int,int,int,int,int,int ); + extern int f12 ( int,int,int,int,int,int,int,int,int,int,int,int ); + + int g9 ( void ) { + return f9(11,22,33,44,55,66,77,88,99); + } + int g10 ( void ) { + return f10(11,22,33,44,55,66,77,88,99,110); + } + int g11 ( void ) { + return f11(11,22,33,44,55,66,77,88,99,110,121); + } + int g12 ( void ) { + return f12(11,22,33,44,55,66,77,88,99,110,121,132); + } +*/ + +/* ARGREGS: r3 r4 r5 r6 r7 r8 r9 r10 (the rest on stack somewhere) */ + +/* These regs are trashed by the hidden call. */ +#define __CALLER_SAVED_REGS \ + "lr", "ctr", "xer", \ + "cr0", "cr1", "cr2", "cr3", "cr4", "cr5", "cr6", "cr7", \ + "r0", "r2", "r3", "r4", "r5", "r6", "r7", "r8", "r9", "r10", \ + "r11", "r12", "r13" + +/* Macros to save and align the stack before making a function + call and restore it afterwards as gcc may not keep the stack + pointer aligned if it doesn't realise calls are being made + to other functions. */ + +#define VALGRIND_ALIGN_STACK \ + "mr 28,1\n\t" \ + "rlwinm 1,1,0,0,27\n\t" +#define VALGRIND_RESTORE_STACK \ + "mr 1,28\n\t" + +/* These CALL_FN_ macros assume that on ppc32-linux, + sizeof(unsigned long) == 4. */ + +#define CALL_FN_W_v(lval, orig) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[1]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + __asm__ volatile( \ + VALGRIND_ALIGN_STACK \ + "mr 11,%1\n\t" \ + "lwz 11,0(11)\n\t" /* target->r11 */ \ + VALGRIND_BRANCH_AND_LINK_TO_NOREDIR_R11 \ + VALGRIND_RESTORE_STACK \ + "mr %0,3" \ + : /*out*/ "=r" (_res) \ + : /*in*/ "r" (&_argvec[0]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS, "r28" \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_W(lval, orig, arg1) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[2]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)arg1; \ + __asm__ volatile( \ + VALGRIND_ALIGN_STACK \ + "mr 11,%1\n\t" \ + "lwz 3,4(11)\n\t" /* arg1->r3 */ \ + "lwz 11,0(11)\n\t" /* target->r11 */ \ + VALGRIND_BRANCH_AND_LINK_TO_NOREDIR_R11 \ + VALGRIND_RESTORE_STACK \ + "mr %0,3" \ + : /*out*/ "=r" (_res) \ + : /*in*/ "r" (&_argvec[0]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS, "r28" \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_WW(lval, orig, arg1,arg2) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[3]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)arg1; \ + _argvec[2] = (unsigned long)arg2; \ + __asm__ volatile( \ + VALGRIND_ALIGN_STACK \ + "mr 11,%1\n\t" \ + "lwz 3,4(11)\n\t" /* arg1->r3 */ \ + "lwz 4,8(11)\n\t" \ + "lwz 11,0(11)\n\t" /* target->r11 */ \ + VALGRIND_BRANCH_AND_LINK_TO_NOREDIR_R11 \ + VALGRIND_RESTORE_STACK \ + "mr %0,3" \ + : /*out*/ "=r" (_res) \ + : /*in*/ "r" (&_argvec[0]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS, "r28" \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_WWW(lval, orig, arg1,arg2,arg3) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[4]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)arg1; \ + _argvec[2] = (unsigned long)arg2; \ + _argvec[3] = (unsigned long)arg3; \ + __asm__ volatile( \ + VALGRIND_ALIGN_STACK \ + "mr 11,%1\n\t" \ + "lwz 3,4(11)\n\t" /* arg1->r3 */ \ + "lwz 4,8(11)\n\t" \ + "lwz 5,12(11)\n\t" \ + "lwz 11,0(11)\n\t" /* target->r11 */ \ + VALGRIND_BRANCH_AND_LINK_TO_NOREDIR_R11 \ + VALGRIND_RESTORE_STACK \ + "mr %0,3" \ + : /*out*/ "=r" (_res) \ + : /*in*/ "r" (&_argvec[0]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS, "r28" \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_WWWW(lval, orig, arg1,arg2,arg3,arg4) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[5]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)arg1; \ + _argvec[2] = (unsigned long)arg2; \ + _argvec[3] = (unsigned long)arg3; \ + _argvec[4] = (unsigned long)arg4; \ + __asm__ volatile( \ + VALGRIND_ALIGN_STACK \ + "mr 11,%1\n\t" \ + "lwz 3,4(11)\n\t" /* arg1->r3 */ \ + "lwz 4,8(11)\n\t" \ + "lwz 5,12(11)\n\t" \ + "lwz 6,16(11)\n\t" /* arg4->r6 */ \ + "lwz 11,0(11)\n\t" /* target->r11 */ \ + VALGRIND_BRANCH_AND_LINK_TO_NOREDIR_R11 \ + VALGRIND_RESTORE_STACK \ + "mr %0,3" \ + : /*out*/ "=r" (_res) \ + : /*in*/ "r" (&_argvec[0]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS, "r28" \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_5W(lval, orig, arg1,arg2,arg3,arg4,arg5) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[6]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)arg1; \ + _argvec[2] = (unsigned long)arg2; \ + _argvec[3] = (unsigned long)arg3; \ + _argvec[4] = (unsigned long)arg4; \ + _argvec[5] = (unsigned long)arg5; \ + __asm__ volatile( \ + VALGRIND_ALIGN_STACK \ + "mr 11,%1\n\t" \ + "lwz 3,4(11)\n\t" /* arg1->r3 */ \ + "lwz 4,8(11)\n\t" \ + "lwz 5,12(11)\n\t" \ + "lwz 6,16(11)\n\t" /* arg4->r6 */ \ + "lwz 7,20(11)\n\t" \ + "lwz 11,0(11)\n\t" /* target->r11 */ \ + VALGRIND_BRANCH_AND_LINK_TO_NOREDIR_R11 \ + VALGRIND_RESTORE_STACK \ + "mr %0,3" \ + : /*out*/ "=r" (_res) \ + : /*in*/ "r" (&_argvec[0]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS, "r28" \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_6W(lval, orig, arg1,arg2,arg3,arg4,arg5,arg6) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[7]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)arg1; \ + _argvec[2] = (unsigned long)arg2; \ + _argvec[3] = (unsigned long)arg3; \ + _argvec[4] = (unsigned long)arg4; \ + _argvec[5] = (unsigned long)arg5; \ + _argvec[6] = (unsigned long)arg6; \ + __asm__ volatile( \ + VALGRIND_ALIGN_STACK \ + "mr 11,%1\n\t" \ + "lwz 3,4(11)\n\t" /* arg1->r3 */ \ + "lwz 4,8(11)\n\t" \ + "lwz 5,12(11)\n\t" \ + "lwz 6,16(11)\n\t" /* arg4->r6 */ \ + "lwz 7,20(11)\n\t" \ + "lwz 8,24(11)\n\t" \ + "lwz 11,0(11)\n\t" /* target->r11 */ \ + VALGRIND_BRANCH_AND_LINK_TO_NOREDIR_R11 \ + VALGRIND_RESTORE_STACK \ + "mr %0,3" \ + : /*out*/ "=r" (_res) \ + : /*in*/ "r" (&_argvec[0]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS, "r28" \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_7W(lval, orig, arg1,arg2,arg3,arg4,arg5,arg6, \ + arg7) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[8]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)arg1; \ + _argvec[2] = (unsigned long)arg2; \ + _argvec[3] = (unsigned long)arg3; \ + _argvec[4] = (unsigned long)arg4; \ + _argvec[5] = (unsigned long)arg5; \ + _argvec[6] = (unsigned long)arg6; \ + _argvec[7] = (unsigned long)arg7; \ + __asm__ volatile( \ + VALGRIND_ALIGN_STACK \ + "mr 11,%1\n\t" \ + "lwz 3,4(11)\n\t" /* arg1->r3 */ \ + "lwz 4,8(11)\n\t" \ + "lwz 5,12(11)\n\t" \ + "lwz 6,16(11)\n\t" /* arg4->r6 */ \ + "lwz 7,20(11)\n\t" \ + "lwz 8,24(11)\n\t" \ + "lwz 9,28(11)\n\t" \ + "lwz 11,0(11)\n\t" /* target->r11 */ \ + VALGRIND_BRANCH_AND_LINK_TO_NOREDIR_R11 \ + VALGRIND_RESTORE_STACK \ + "mr %0,3" \ + : /*out*/ "=r" (_res) \ + : /*in*/ "r" (&_argvec[0]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS, "r28" \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_8W(lval, orig, arg1,arg2,arg3,arg4,arg5,arg6, \ + arg7,arg8) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[9]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)arg1; \ + _argvec[2] = (unsigned long)arg2; \ + _argvec[3] = (unsigned long)arg3; \ + _argvec[4] = (unsigned long)arg4; \ + _argvec[5] = (unsigned long)arg5; \ + _argvec[6] = (unsigned long)arg6; \ + _argvec[7] = (unsigned long)arg7; \ + _argvec[8] = (unsigned long)arg8; \ + __asm__ volatile( \ + VALGRIND_ALIGN_STACK \ + "mr 11,%1\n\t" \ + "lwz 3,4(11)\n\t" /* arg1->r3 */ \ + "lwz 4,8(11)\n\t" \ + "lwz 5,12(11)\n\t" \ + "lwz 6,16(11)\n\t" /* arg4->r6 */ \ + "lwz 7,20(11)\n\t" \ + "lwz 8,24(11)\n\t" \ + "lwz 9,28(11)\n\t" \ + "lwz 10,32(11)\n\t" /* arg8->r10 */ \ + "lwz 11,0(11)\n\t" /* target->r11 */ \ + VALGRIND_BRANCH_AND_LINK_TO_NOREDIR_R11 \ + VALGRIND_RESTORE_STACK \ + "mr %0,3" \ + : /*out*/ "=r" (_res) \ + : /*in*/ "r" (&_argvec[0]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS, "r28" \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_9W(lval, orig, arg1,arg2,arg3,arg4,arg5,arg6, \ + arg7,arg8,arg9) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[10]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)arg1; \ + _argvec[2] = (unsigned long)arg2; \ + _argvec[3] = (unsigned long)arg3; \ + _argvec[4] = (unsigned long)arg4; \ + _argvec[5] = (unsigned long)arg5; \ + _argvec[6] = (unsigned long)arg6; \ + _argvec[7] = (unsigned long)arg7; \ + _argvec[8] = (unsigned long)arg8; \ + _argvec[9] = (unsigned long)arg9; \ + __asm__ volatile( \ + VALGRIND_ALIGN_STACK \ + "mr 11,%1\n\t" \ + "addi 1,1,-16\n\t" \ + /* arg9 */ \ + "lwz 3,36(11)\n\t" \ + "stw 3,8(1)\n\t" \ + /* args1-8 */ \ + "lwz 3,4(11)\n\t" /* arg1->r3 */ \ + "lwz 4,8(11)\n\t" \ + "lwz 5,12(11)\n\t" \ + "lwz 6,16(11)\n\t" /* arg4->r6 */ \ + "lwz 7,20(11)\n\t" \ + "lwz 8,24(11)\n\t" \ + "lwz 9,28(11)\n\t" \ + "lwz 10,32(11)\n\t" /* arg8->r10 */ \ + "lwz 11,0(11)\n\t" /* target->r11 */ \ + VALGRIND_BRANCH_AND_LINK_TO_NOREDIR_R11 \ + VALGRIND_RESTORE_STACK \ + "mr %0,3" \ + : /*out*/ "=r" (_res) \ + : /*in*/ "r" (&_argvec[0]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS, "r28" \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_10W(lval, orig, arg1,arg2,arg3,arg4,arg5,arg6, \ + arg7,arg8,arg9,arg10) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[11]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)arg1; \ + _argvec[2] = (unsigned long)arg2; \ + _argvec[3] = (unsigned long)arg3; \ + _argvec[4] = (unsigned long)arg4; \ + _argvec[5] = (unsigned long)arg5; \ + _argvec[6] = (unsigned long)arg6; \ + _argvec[7] = (unsigned long)arg7; \ + _argvec[8] = (unsigned long)arg8; \ + _argvec[9] = (unsigned long)arg9; \ + _argvec[10] = (unsigned long)arg10; \ + __asm__ volatile( \ + VALGRIND_ALIGN_STACK \ + "mr 11,%1\n\t" \ + "addi 1,1,-16\n\t" \ + /* arg10 */ \ + "lwz 3,40(11)\n\t" \ + "stw 3,12(1)\n\t" \ + /* arg9 */ \ + "lwz 3,36(11)\n\t" \ + "stw 3,8(1)\n\t" \ + /* args1-8 */ \ + "lwz 3,4(11)\n\t" /* arg1->r3 */ \ + "lwz 4,8(11)\n\t" \ + "lwz 5,12(11)\n\t" \ + "lwz 6,16(11)\n\t" /* arg4->r6 */ \ + "lwz 7,20(11)\n\t" \ + "lwz 8,24(11)\n\t" \ + "lwz 9,28(11)\n\t" \ + "lwz 10,32(11)\n\t" /* arg8->r10 */ \ + "lwz 11,0(11)\n\t" /* target->r11 */ \ + VALGRIND_BRANCH_AND_LINK_TO_NOREDIR_R11 \ + VALGRIND_RESTORE_STACK \ + "mr %0,3" \ + : /*out*/ "=r" (_res) \ + : /*in*/ "r" (&_argvec[0]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS, "r28" \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_11W(lval, orig, arg1,arg2,arg3,arg4,arg5,arg6, \ + arg7,arg8,arg9,arg10,arg11) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[12]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)arg1; \ + _argvec[2] = (unsigned long)arg2; \ + _argvec[3] = (unsigned long)arg3; \ + _argvec[4] = (unsigned long)arg4; \ + _argvec[5] = (unsigned long)arg5; \ + _argvec[6] = (unsigned long)arg6; \ + _argvec[7] = (unsigned long)arg7; \ + _argvec[8] = (unsigned long)arg8; \ + _argvec[9] = (unsigned long)arg9; \ + _argvec[10] = (unsigned long)arg10; \ + _argvec[11] = (unsigned long)arg11; \ + __asm__ volatile( \ + VALGRIND_ALIGN_STACK \ + "mr 11,%1\n\t" \ + "addi 1,1,-32\n\t" \ + /* arg11 */ \ + "lwz 3,44(11)\n\t" \ + "stw 3,16(1)\n\t" \ + /* arg10 */ \ + "lwz 3,40(11)\n\t" \ + "stw 3,12(1)\n\t" \ + /* arg9 */ \ + "lwz 3,36(11)\n\t" \ + "stw 3,8(1)\n\t" \ + /* args1-8 */ \ + "lwz 3,4(11)\n\t" /* arg1->r3 */ \ + "lwz 4,8(11)\n\t" \ + "lwz 5,12(11)\n\t" \ + "lwz 6,16(11)\n\t" /* arg4->r6 */ \ + "lwz 7,20(11)\n\t" \ + "lwz 8,24(11)\n\t" \ + "lwz 9,28(11)\n\t" \ + "lwz 10,32(11)\n\t" /* arg8->r10 */ \ + "lwz 11,0(11)\n\t" /* target->r11 */ \ + VALGRIND_BRANCH_AND_LINK_TO_NOREDIR_R11 \ + VALGRIND_RESTORE_STACK \ + "mr %0,3" \ + : /*out*/ "=r" (_res) \ + : /*in*/ "r" (&_argvec[0]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS, "r28" \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_12W(lval, orig, arg1,arg2,arg3,arg4,arg5,arg6, \ + arg7,arg8,arg9,arg10,arg11,arg12) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[13]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)arg1; \ + _argvec[2] = (unsigned long)arg2; \ + _argvec[3] = (unsigned long)arg3; \ + _argvec[4] = (unsigned long)arg4; \ + _argvec[5] = (unsigned long)arg5; \ + _argvec[6] = (unsigned long)arg6; \ + _argvec[7] = (unsigned long)arg7; \ + _argvec[8] = (unsigned long)arg8; \ + _argvec[9] = (unsigned long)arg9; \ + _argvec[10] = (unsigned long)arg10; \ + _argvec[11] = (unsigned long)arg11; \ + _argvec[12] = (unsigned long)arg12; \ + __asm__ volatile( \ + VALGRIND_ALIGN_STACK \ + "mr 11,%1\n\t" \ + "addi 1,1,-32\n\t" \ + /* arg12 */ \ + "lwz 3,48(11)\n\t" \ + "stw 3,20(1)\n\t" \ + /* arg11 */ \ + "lwz 3,44(11)\n\t" \ + "stw 3,16(1)\n\t" \ + /* arg10 */ \ + "lwz 3,40(11)\n\t" \ + "stw 3,12(1)\n\t" \ + /* arg9 */ \ + "lwz 3,36(11)\n\t" \ + "stw 3,8(1)\n\t" \ + /* args1-8 */ \ + "lwz 3,4(11)\n\t" /* arg1->r3 */ \ + "lwz 4,8(11)\n\t" \ + "lwz 5,12(11)\n\t" \ + "lwz 6,16(11)\n\t" /* arg4->r6 */ \ + "lwz 7,20(11)\n\t" \ + "lwz 8,24(11)\n\t" \ + "lwz 9,28(11)\n\t" \ + "lwz 10,32(11)\n\t" /* arg8->r10 */ \ + "lwz 11,0(11)\n\t" /* target->r11 */ \ + VALGRIND_BRANCH_AND_LINK_TO_NOREDIR_R11 \ + VALGRIND_RESTORE_STACK \ + "mr %0,3" \ + : /*out*/ "=r" (_res) \ + : /*in*/ "r" (&_argvec[0]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS, "r28" \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#endif /* PLAT_ppc32_linux */ + +/* ------------------------ ppc64-linux ------------------------ */ + +#if defined(PLAT_ppc64be_linux) + +/* ARGREGS: r3 r4 r5 r6 r7 r8 r9 r10 (the rest on stack somewhere) */ + +/* These regs are trashed by the hidden call. */ +#define __CALLER_SAVED_REGS \ + "lr", "ctr", "xer", \ + "cr0", "cr1", "cr2", "cr3", "cr4", "cr5", "cr6", "cr7", \ + "r0", "r2", "r3", "r4", "r5", "r6", "r7", "r8", "r9", "r10", \ + "r11", "r12", "r13" + +/* Macros to save and align the stack before making a function + call and restore it afterwards as gcc may not keep the stack + pointer aligned if it doesn't realise calls are being made + to other functions. */ + +#define VALGRIND_ALIGN_STACK \ + "mr 28,1\n\t" \ + "rldicr 1,1,0,59\n\t" +#define VALGRIND_RESTORE_STACK \ + "mr 1,28\n\t" + +/* These CALL_FN_ macros assume that on ppc64-linux, sizeof(unsigned + long) == 8. */ + +#define CALL_FN_W_v(lval, orig) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[3+0]; \ + volatile unsigned long _res; \ + /* _argvec[0] holds current r2 across the call */ \ + _argvec[1] = (unsigned long)_orig.r2; \ + _argvec[2] = (unsigned long)_orig.nraddr; \ + __asm__ volatile( \ + VALGRIND_ALIGN_STACK \ + "mr 11,%1\n\t" \ + "std 2,-16(11)\n\t" /* save tocptr */ \ + "ld 2,-8(11)\n\t" /* use nraddr's tocptr */ \ + "ld 11, 0(11)\n\t" /* target->r11 */ \ + VALGRIND_BRANCH_AND_LINK_TO_NOREDIR_R11 \ + "mr 11,%1\n\t" \ + "mr %0,3\n\t" \ + "ld 2,-16(11)\n\t" /* restore tocptr */ \ + VALGRIND_RESTORE_STACK \ + : /*out*/ "=r" (_res) \ + : /*in*/ "r" (&_argvec[2]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS, "r28" \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_W(lval, orig, arg1) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[3+1]; \ + volatile unsigned long _res; \ + /* _argvec[0] holds current r2 across the call */ \ + _argvec[1] = (unsigned long)_orig.r2; \ + _argvec[2] = (unsigned long)_orig.nraddr; \ + _argvec[2+1] = (unsigned long)arg1; \ + __asm__ volatile( \ + VALGRIND_ALIGN_STACK \ + "mr 11,%1\n\t" \ + "std 2,-16(11)\n\t" /* save tocptr */ \ + "ld 2,-8(11)\n\t" /* use nraddr's tocptr */ \ + "ld 3, 8(11)\n\t" /* arg1->r3 */ \ + "ld 11, 0(11)\n\t" /* target->r11 */ \ + VALGRIND_BRANCH_AND_LINK_TO_NOREDIR_R11 \ + "mr 11,%1\n\t" \ + "mr %0,3\n\t" \ + "ld 2,-16(11)\n\t" /* restore tocptr */ \ + VALGRIND_RESTORE_STACK \ + : /*out*/ "=r" (_res) \ + : /*in*/ "r" (&_argvec[2]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS, "r28" \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_WW(lval, orig, arg1,arg2) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[3+2]; \ + volatile unsigned long _res; \ + /* _argvec[0] holds current r2 across the call */ \ + _argvec[1] = (unsigned long)_orig.r2; \ + _argvec[2] = (unsigned long)_orig.nraddr; \ + _argvec[2+1] = (unsigned long)arg1; \ + _argvec[2+2] = (unsigned long)arg2; \ + __asm__ volatile( \ + VALGRIND_ALIGN_STACK \ + "mr 11,%1\n\t" \ + "std 2,-16(11)\n\t" /* save tocptr */ \ + "ld 2,-8(11)\n\t" /* use nraddr's tocptr */ \ + "ld 3, 8(11)\n\t" /* arg1->r3 */ \ + "ld 4, 16(11)\n\t" /* arg2->r4 */ \ + "ld 11, 0(11)\n\t" /* target->r11 */ \ + VALGRIND_BRANCH_AND_LINK_TO_NOREDIR_R11 \ + "mr 11,%1\n\t" \ + "mr %0,3\n\t" \ + "ld 2,-16(11)\n\t" /* restore tocptr */ \ + VALGRIND_RESTORE_STACK \ + : /*out*/ "=r" (_res) \ + : /*in*/ "r" (&_argvec[2]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS, "r28" \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_WWW(lval, orig, arg1,arg2,arg3) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[3+3]; \ + volatile unsigned long _res; \ + /* _argvec[0] holds current r2 across the call */ \ + _argvec[1] = (unsigned long)_orig.r2; \ + _argvec[2] = (unsigned long)_orig.nraddr; \ + _argvec[2+1] = (unsigned long)arg1; \ + _argvec[2+2] = (unsigned long)arg2; \ + _argvec[2+3] = (unsigned long)arg3; \ + __asm__ volatile( \ + VALGRIND_ALIGN_STACK \ + "mr 11,%1\n\t" \ + "std 2,-16(11)\n\t" /* save tocptr */ \ + "ld 2,-8(11)\n\t" /* use nraddr's tocptr */ \ + "ld 3, 8(11)\n\t" /* arg1->r3 */ \ + "ld 4, 16(11)\n\t" /* arg2->r4 */ \ + "ld 5, 24(11)\n\t" /* arg3->r5 */ \ + "ld 11, 0(11)\n\t" /* target->r11 */ \ + VALGRIND_BRANCH_AND_LINK_TO_NOREDIR_R11 \ + "mr 11,%1\n\t" \ + "mr %0,3\n\t" \ + "ld 2,-16(11)\n\t" /* restore tocptr */ \ + VALGRIND_RESTORE_STACK \ + : /*out*/ "=r" (_res) \ + : /*in*/ "r" (&_argvec[2]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS, "r28" \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_WWWW(lval, orig, arg1,arg2,arg3,arg4) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[3+4]; \ + volatile unsigned long _res; \ + /* _argvec[0] holds current r2 across the call */ \ + _argvec[1] = (unsigned long)_orig.r2; \ + _argvec[2] = (unsigned long)_orig.nraddr; \ + _argvec[2+1] = (unsigned long)arg1; \ + _argvec[2+2] = (unsigned long)arg2; \ + _argvec[2+3] = (unsigned long)arg3; \ + _argvec[2+4] = (unsigned long)arg4; \ + __asm__ volatile( \ + VALGRIND_ALIGN_STACK \ + "mr 11,%1\n\t" \ + "std 2,-16(11)\n\t" /* save tocptr */ \ + "ld 2,-8(11)\n\t" /* use nraddr's tocptr */ \ + "ld 3, 8(11)\n\t" /* arg1->r3 */ \ + "ld 4, 16(11)\n\t" /* arg2->r4 */ \ + "ld 5, 24(11)\n\t" /* arg3->r5 */ \ + "ld 6, 32(11)\n\t" /* arg4->r6 */ \ + "ld 11, 0(11)\n\t" /* target->r11 */ \ + VALGRIND_BRANCH_AND_LINK_TO_NOREDIR_R11 \ + "mr 11,%1\n\t" \ + "mr %0,3\n\t" \ + "ld 2,-16(11)\n\t" /* restore tocptr */ \ + VALGRIND_RESTORE_STACK \ + : /*out*/ "=r" (_res) \ + : /*in*/ "r" (&_argvec[2]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS, "r28" \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_5W(lval, orig, arg1,arg2,arg3,arg4,arg5) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[3+5]; \ + volatile unsigned long _res; \ + /* _argvec[0] holds current r2 across the call */ \ + _argvec[1] = (unsigned long)_orig.r2; \ + _argvec[2] = (unsigned long)_orig.nraddr; \ + _argvec[2+1] = (unsigned long)arg1; \ + _argvec[2+2] = (unsigned long)arg2; \ + _argvec[2+3] = (unsigned long)arg3; \ + _argvec[2+4] = (unsigned long)arg4; \ + _argvec[2+5] = (unsigned long)arg5; \ + __asm__ volatile( \ + VALGRIND_ALIGN_STACK \ + "mr 11,%1\n\t" \ + "std 2,-16(11)\n\t" /* save tocptr */ \ + "ld 2,-8(11)\n\t" /* use nraddr's tocptr */ \ + "ld 3, 8(11)\n\t" /* arg1->r3 */ \ + "ld 4, 16(11)\n\t" /* arg2->r4 */ \ + "ld 5, 24(11)\n\t" /* arg3->r5 */ \ + "ld 6, 32(11)\n\t" /* arg4->r6 */ \ + "ld 7, 40(11)\n\t" /* arg5->r7 */ \ + "ld 11, 0(11)\n\t" /* target->r11 */ \ + VALGRIND_BRANCH_AND_LINK_TO_NOREDIR_R11 \ + "mr 11,%1\n\t" \ + "mr %0,3\n\t" \ + "ld 2,-16(11)\n\t" /* restore tocptr */ \ + VALGRIND_RESTORE_STACK \ + : /*out*/ "=r" (_res) \ + : /*in*/ "r" (&_argvec[2]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS, "r28" \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_6W(lval, orig, arg1,arg2,arg3,arg4,arg5,arg6) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[3+6]; \ + volatile unsigned long _res; \ + /* _argvec[0] holds current r2 across the call */ \ + _argvec[1] = (unsigned long)_orig.r2; \ + _argvec[2] = (unsigned long)_orig.nraddr; \ + _argvec[2+1] = (unsigned long)arg1; \ + _argvec[2+2] = (unsigned long)arg2; \ + _argvec[2+3] = (unsigned long)arg3; \ + _argvec[2+4] = (unsigned long)arg4; \ + _argvec[2+5] = (unsigned long)arg5; \ + _argvec[2+6] = (unsigned long)arg6; \ + __asm__ volatile( \ + VALGRIND_ALIGN_STACK \ + "mr 11,%1\n\t" \ + "std 2,-16(11)\n\t" /* save tocptr */ \ + "ld 2,-8(11)\n\t" /* use nraddr's tocptr */ \ + "ld 3, 8(11)\n\t" /* arg1->r3 */ \ + "ld 4, 16(11)\n\t" /* arg2->r4 */ \ + "ld 5, 24(11)\n\t" /* arg3->r5 */ \ + "ld 6, 32(11)\n\t" /* arg4->r6 */ \ + "ld 7, 40(11)\n\t" /* arg5->r7 */ \ + "ld 8, 48(11)\n\t" /* arg6->r8 */ \ + "ld 11, 0(11)\n\t" /* target->r11 */ \ + VALGRIND_BRANCH_AND_LINK_TO_NOREDIR_R11 \ + "mr 11,%1\n\t" \ + "mr %0,3\n\t" \ + "ld 2,-16(11)\n\t" /* restore tocptr */ \ + VALGRIND_RESTORE_STACK \ + : /*out*/ "=r" (_res) \ + : /*in*/ "r" (&_argvec[2]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS, "r28" \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_7W(lval, orig, arg1,arg2,arg3,arg4,arg5,arg6, \ + arg7) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[3+7]; \ + volatile unsigned long _res; \ + /* _argvec[0] holds current r2 across the call */ \ + _argvec[1] = (unsigned long)_orig.r2; \ + _argvec[2] = (unsigned long)_orig.nraddr; \ + _argvec[2+1] = (unsigned long)arg1; \ + _argvec[2+2] = (unsigned long)arg2; \ + _argvec[2+3] = (unsigned long)arg3; \ + _argvec[2+4] = (unsigned long)arg4; \ + _argvec[2+5] = (unsigned long)arg5; \ + _argvec[2+6] = (unsigned long)arg6; \ + _argvec[2+7] = (unsigned long)arg7; \ + __asm__ volatile( \ + VALGRIND_ALIGN_STACK \ + "mr 11,%1\n\t" \ + "std 2,-16(11)\n\t" /* save tocptr */ \ + "ld 2,-8(11)\n\t" /* use nraddr's tocptr */ \ + "ld 3, 8(11)\n\t" /* arg1->r3 */ \ + "ld 4, 16(11)\n\t" /* arg2->r4 */ \ + "ld 5, 24(11)\n\t" /* arg3->r5 */ \ + "ld 6, 32(11)\n\t" /* arg4->r6 */ \ + "ld 7, 40(11)\n\t" /* arg5->r7 */ \ + "ld 8, 48(11)\n\t" /* arg6->r8 */ \ + "ld 9, 56(11)\n\t" /* arg7->r9 */ \ + "ld 11, 0(11)\n\t" /* target->r11 */ \ + VALGRIND_BRANCH_AND_LINK_TO_NOREDIR_R11 \ + "mr 11,%1\n\t" \ + "mr %0,3\n\t" \ + "ld 2,-16(11)\n\t" /* restore tocptr */ \ + VALGRIND_RESTORE_STACK \ + : /*out*/ "=r" (_res) \ + : /*in*/ "r" (&_argvec[2]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS, "r28" \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_8W(lval, orig, arg1,arg2,arg3,arg4,arg5,arg6, \ + arg7,arg8) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[3+8]; \ + volatile unsigned long _res; \ + /* _argvec[0] holds current r2 across the call */ \ + _argvec[1] = (unsigned long)_orig.r2; \ + _argvec[2] = (unsigned long)_orig.nraddr; \ + _argvec[2+1] = (unsigned long)arg1; \ + _argvec[2+2] = (unsigned long)arg2; \ + _argvec[2+3] = (unsigned long)arg3; \ + _argvec[2+4] = (unsigned long)arg4; \ + _argvec[2+5] = (unsigned long)arg5; \ + _argvec[2+6] = (unsigned long)arg6; \ + _argvec[2+7] = (unsigned long)arg7; \ + _argvec[2+8] = (unsigned long)arg8; \ + __asm__ volatile( \ + VALGRIND_ALIGN_STACK \ + "mr 11,%1\n\t" \ + "std 2,-16(11)\n\t" /* save tocptr */ \ + "ld 2,-8(11)\n\t" /* use nraddr's tocptr */ \ + "ld 3, 8(11)\n\t" /* arg1->r3 */ \ + "ld 4, 16(11)\n\t" /* arg2->r4 */ \ + "ld 5, 24(11)\n\t" /* arg3->r5 */ \ + "ld 6, 32(11)\n\t" /* arg4->r6 */ \ + "ld 7, 40(11)\n\t" /* arg5->r7 */ \ + "ld 8, 48(11)\n\t" /* arg6->r8 */ \ + "ld 9, 56(11)\n\t" /* arg7->r9 */ \ + "ld 10, 64(11)\n\t" /* arg8->r10 */ \ + "ld 11, 0(11)\n\t" /* target->r11 */ \ + VALGRIND_BRANCH_AND_LINK_TO_NOREDIR_R11 \ + "mr 11,%1\n\t" \ + "mr %0,3\n\t" \ + "ld 2,-16(11)\n\t" /* restore tocptr */ \ + VALGRIND_RESTORE_STACK \ + : /*out*/ "=r" (_res) \ + : /*in*/ "r" (&_argvec[2]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS, "r28" \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_9W(lval, orig, arg1,arg2,arg3,arg4,arg5,arg6, \ + arg7,arg8,arg9) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[3+9]; \ + volatile unsigned long _res; \ + /* _argvec[0] holds current r2 across the call */ \ + _argvec[1] = (unsigned long)_orig.r2; \ + _argvec[2] = (unsigned long)_orig.nraddr; \ + _argvec[2+1] = (unsigned long)arg1; \ + _argvec[2+2] = (unsigned long)arg2; \ + _argvec[2+3] = (unsigned long)arg3; \ + _argvec[2+4] = (unsigned long)arg4; \ + _argvec[2+5] = (unsigned long)arg5; \ + _argvec[2+6] = (unsigned long)arg6; \ + _argvec[2+7] = (unsigned long)arg7; \ + _argvec[2+8] = (unsigned long)arg8; \ + _argvec[2+9] = (unsigned long)arg9; \ + __asm__ volatile( \ + VALGRIND_ALIGN_STACK \ + "mr 11,%1\n\t" \ + "std 2,-16(11)\n\t" /* save tocptr */ \ + "ld 2,-8(11)\n\t" /* use nraddr's tocptr */ \ + "addi 1,1,-128\n\t" /* expand stack frame */ \ + /* arg9 */ \ + "ld 3,72(11)\n\t" \ + "std 3,112(1)\n\t" \ + /* args1-8 */ \ + "ld 3, 8(11)\n\t" /* arg1->r3 */ \ + "ld 4, 16(11)\n\t" /* arg2->r4 */ \ + "ld 5, 24(11)\n\t" /* arg3->r5 */ \ + "ld 6, 32(11)\n\t" /* arg4->r6 */ \ + "ld 7, 40(11)\n\t" /* arg5->r7 */ \ + "ld 8, 48(11)\n\t" /* arg6->r8 */ \ + "ld 9, 56(11)\n\t" /* arg7->r9 */ \ + "ld 10, 64(11)\n\t" /* arg8->r10 */ \ + "ld 11, 0(11)\n\t" /* target->r11 */ \ + VALGRIND_BRANCH_AND_LINK_TO_NOREDIR_R11 \ + "mr 11,%1\n\t" \ + "mr %0,3\n\t" \ + "ld 2,-16(11)\n\t" /* restore tocptr */ \ + VALGRIND_RESTORE_STACK \ + : /*out*/ "=r" (_res) \ + : /*in*/ "r" (&_argvec[2]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS, "r28" \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_10W(lval, orig, arg1,arg2,arg3,arg4,arg5,arg6, \ + arg7,arg8,arg9,arg10) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[3+10]; \ + volatile unsigned long _res; \ + /* _argvec[0] holds current r2 across the call */ \ + _argvec[1] = (unsigned long)_orig.r2; \ + _argvec[2] = (unsigned long)_orig.nraddr; \ + _argvec[2+1] = (unsigned long)arg1; \ + _argvec[2+2] = (unsigned long)arg2; \ + _argvec[2+3] = (unsigned long)arg3; \ + _argvec[2+4] = (unsigned long)arg4; \ + _argvec[2+5] = (unsigned long)arg5; \ + _argvec[2+6] = (unsigned long)arg6; \ + _argvec[2+7] = (unsigned long)arg7; \ + _argvec[2+8] = (unsigned long)arg8; \ + _argvec[2+9] = (unsigned long)arg9; \ + _argvec[2+10] = (unsigned long)arg10; \ + __asm__ volatile( \ + VALGRIND_ALIGN_STACK \ + "mr 11,%1\n\t" \ + "std 2,-16(11)\n\t" /* save tocptr */ \ + "ld 2,-8(11)\n\t" /* use nraddr's tocptr */ \ + "addi 1,1,-128\n\t" /* expand stack frame */ \ + /* arg10 */ \ + "ld 3,80(11)\n\t" \ + "std 3,120(1)\n\t" \ + /* arg9 */ \ + "ld 3,72(11)\n\t" \ + "std 3,112(1)\n\t" \ + /* args1-8 */ \ + "ld 3, 8(11)\n\t" /* arg1->r3 */ \ + "ld 4, 16(11)\n\t" /* arg2->r4 */ \ + "ld 5, 24(11)\n\t" /* arg3->r5 */ \ + "ld 6, 32(11)\n\t" /* arg4->r6 */ \ + "ld 7, 40(11)\n\t" /* arg5->r7 */ \ + "ld 8, 48(11)\n\t" /* arg6->r8 */ \ + "ld 9, 56(11)\n\t" /* arg7->r9 */ \ + "ld 10, 64(11)\n\t" /* arg8->r10 */ \ + "ld 11, 0(11)\n\t" /* target->r11 */ \ + VALGRIND_BRANCH_AND_LINK_TO_NOREDIR_R11 \ + "mr 11,%1\n\t" \ + "mr %0,3\n\t" \ + "ld 2,-16(11)\n\t" /* restore tocptr */ \ + VALGRIND_RESTORE_STACK \ + : /*out*/ "=r" (_res) \ + : /*in*/ "r" (&_argvec[2]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS, "r28" \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_11W(lval, orig, arg1,arg2,arg3,arg4,arg5,arg6, \ + arg7,arg8,arg9,arg10,arg11) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[3+11]; \ + volatile unsigned long _res; \ + /* _argvec[0] holds current r2 across the call */ \ + _argvec[1] = (unsigned long)_orig.r2; \ + _argvec[2] = (unsigned long)_orig.nraddr; \ + _argvec[2+1] = (unsigned long)arg1; \ + _argvec[2+2] = (unsigned long)arg2; \ + _argvec[2+3] = (unsigned long)arg3; \ + _argvec[2+4] = (unsigned long)arg4; \ + _argvec[2+5] = (unsigned long)arg5; \ + _argvec[2+6] = (unsigned long)arg6; \ + _argvec[2+7] = (unsigned long)arg7; \ + _argvec[2+8] = (unsigned long)arg8; \ + _argvec[2+9] = (unsigned long)arg9; \ + _argvec[2+10] = (unsigned long)arg10; \ + _argvec[2+11] = (unsigned long)arg11; \ + __asm__ volatile( \ + VALGRIND_ALIGN_STACK \ + "mr 11,%1\n\t" \ + "std 2,-16(11)\n\t" /* save tocptr */ \ + "ld 2,-8(11)\n\t" /* use nraddr's tocptr */ \ + "addi 1,1,-144\n\t" /* expand stack frame */ \ + /* arg11 */ \ + "ld 3,88(11)\n\t" \ + "std 3,128(1)\n\t" \ + /* arg10 */ \ + "ld 3,80(11)\n\t" \ + "std 3,120(1)\n\t" \ + /* arg9 */ \ + "ld 3,72(11)\n\t" \ + "std 3,112(1)\n\t" \ + /* args1-8 */ \ + "ld 3, 8(11)\n\t" /* arg1->r3 */ \ + "ld 4, 16(11)\n\t" /* arg2->r4 */ \ + "ld 5, 24(11)\n\t" /* arg3->r5 */ \ + "ld 6, 32(11)\n\t" /* arg4->r6 */ \ + "ld 7, 40(11)\n\t" /* arg5->r7 */ \ + "ld 8, 48(11)\n\t" /* arg6->r8 */ \ + "ld 9, 56(11)\n\t" /* arg7->r9 */ \ + "ld 10, 64(11)\n\t" /* arg8->r10 */ \ + "ld 11, 0(11)\n\t" /* target->r11 */ \ + VALGRIND_BRANCH_AND_LINK_TO_NOREDIR_R11 \ + "mr 11,%1\n\t" \ + "mr %0,3\n\t" \ + "ld 2,-16(11)\n\t" /* restore tocptr */ \ + VALGRIND_RESTORE_STACK \ + : /*out*/ "=r" (_res) \ + : /*in*/ "r" (&_argvec[2]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS, "r28" \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_12W(lval, orig, arg1,arg2,arg3,arg4,arg5,arg6, \ + arg7,arg8,arg9,arg10,arg11,arg12) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[3+12]; \ + volatile unsigned long _res; \ + /* _argvec[0] holds current r2 across the call */ \ + _argvec[1] = (unsigned long)_orig.r2; \ + _argvec[2] = (unsigned long)_orig.nraddr; \ + _argvec[2+1] = (unsigned long)arg1; \ + _argvec[2+2] = (unsigned long)arg2; \ + _argvec[2+3] = (unsigned long)arg3; \ + _argvec[2+4] = (unsigned long)arg4; \ + _argvec[2+5] = (unsigned long)arg5; \ + _argvec[2+6] = (unsigned long)arg6; \ + _argvec[2+7] = (unsigned long)arg7; \ + _argvec[2+8] = (unsigned long)arg8; \ + _argvec[2+9] = (unsigned long)arg9; \ + _argvec[2+10] = (unsigned long)arg10; \ + _argvec[2+11] = (unsigned long)arg11; \ + _argvec[2+12] = (unsigned long)arg12; \ + __asm__ volatile( \ + VALGRIND_ALIGN_STACK \ + "mr 11,%1\n\t" \ + "std 2,-16(11)\n\t" /* save tocptr */ \ + "ld 2,-8(11)\n\t" /* use nraddr's tocptr */ \ + "addi 1,1,-144\n\t" /* expand stack frame */ \ + /* arg12 */ \ + "ld 3,96(11)\n\t" \ + "std 3,136(1)\n\t" \ + /* arg11 */ \ + "ld 3,88(11)\n\t" \ + "std 3,128(1)\n\t" \ + /* arg10 */ \ + "ld 3,80(11)\n\t" \ + "std 3,120(1)\n\t" \ + /* arg9 */ \ + "ld 3,72(11)\n\t" \ + "std 3,112(1)\n\t" \ + /* args1-8 */ \ + "ld 3, 8(11)\n\t" /* arg1->r3 */ \ + "ld 4, 16(11)\n\t" /* arg2->r4 */ \ + "ld 5, 24(11)\n\t" /* arg3->r5 */ \ + "ld 6, 32(11)\n\t" /* arg4->r6 */ \ + "ld 7, 40(11)\n\t" /* arg5->r7 */ \ + "ld 8, 48(11)\n\t" /* arg6->r8 */ \ + "ld 9, 56(11)\n\t" /* arg7->r9 */ \ + "ld 10, 64(11)\n\t" /* arg8->r10 */ \ + "ld 11, 0(11)\n\t" /* target->r11 */ \ + VALGRIND_BRANCH_AND_LINK_TO_NOREDIR_R11 \ + "mr 11,%1\n\t" \ + "mr %0,3\n\t" \ + "ld 2,-16(11)\n\t" /* restore tocptr */ \ + VALGRIND_RESTORE_STACK \ + : /*out*/ "=r" (_res) \ + : /*in*/ "r" (&_argvec[2]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS, "r28" \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#endif /* PLAT_ppc64be_linux */ + +/* ------------------------- ppc64le-linux ----------------------- */ +#if defined(PLAT_ppc64le_linux) + +/* ARGREGS: r3 r4 r5 r6 r7 r8 r9 r10 (the rest on stack somewhere) */ + +/* These regs are trashed by the hidden call. */ +#define __CALLER_SAVED_REGS \ + "lr", "ctr", "xer", \ + "cr0", "cr1", "cr2", "cr3", "cr4", "cr5", "cr6", "cr7", \ + "r0", "r2", "r3", "r4", "r5", "r6", "r7", "r8", "r9", "r10", \ + "r11", "r12", "r13" + +/* Macros to save and align the stack before making a function + call and restore it afterwards as gcc may not keep the stack + pointer aligned if it doesn't realise calls are being made + to other functions. */ + +#define VALGRIND_ALIGN_STACK \ + "mr 28,1\n\t" \ + "rldicr 1,1,0,59\n\t" +#define VALGRIND_RESTORE_STACK \ + "mr 1,28\n\t" + +/* These CALL_FN_ macros assume that on ppc64-linux, sizeof(unsigned + long) == 8. */ + +#define CALL_FN_W_v(lval, orig) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[3+0]; \ + volatile unsigned long _res; \ + /* _argvec[0] holds current r2 across the call */ \ + _argvec[1] = (unsigned long)_orig.r2; \ + _argvec[2] = (unsigned long)_orig.nraddr; \ + __asm__ volatile( \ + VALGRIND_ALIGN_STACK \ + "mr 12,%1\n\t" \ + "std 2,-16(12)\n\t" /* save tocptr */ \ + "ld 2,-8(12)\n\t" /* use nraddr's tocptr */ \ + "ld 12, 0(12)\n\t" /* target->r12 */ \ + VALGRIND_BRANCH_AND_LINK_TO_NOREDIR_R12 \ + "mr 12,%1\n\t" \ + "mr %0,3\n\t" \ + "ld 2,-16(12)\n\t" /* restore tocptr */ \ + VALGRIND_RESTORE_STACK \ + : /*out*/ "=r" (_res) \ + : /*in*/ "r" (&_argvec[2]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS, "r28" \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_W(lval, orig, arg1) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[3+1]; \ + volatile unsigned long _res; \ + /* _argvec[0] holds current r2 across the call */ \ + _argvec[1] = (unsigned long)_orig.r2; \ + _argvec[2] = (unsigned long)_orig.nraddr; \ + _argvec[2+1] = (unsigned long)arg1; \ + __asm__ volatile( \ + VALGRIND_ALIGN_STACK \ + "mr 12,%1\n\t" \ + "std 2,-16(12)\n\t" /* save tocptr */ \ + "ld 2,-8(12)\n\t" /* use nraddr's tocptr */ \ + "ld 3, 8(12)\n\t" /* arg1->r3 */ \ + "ld 12, 0(12)\n\t" /* target->r12 */ \ + VALGRIND_BRANCH_AND_LINK_TO_NOREDIR_R12 \ + "mr 12,%1\n\t" \ + "mr %0,3\n\t" \ + "ld 2,-16(12)\n\t" /* restore tocptr */ \ + VALGRIND_RESTORE_STACK \ + : /*out*/ "=r" (_res) \ + : /*in*/ "r" (&_argvec[2]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS, "r28" \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_WW(lval, orig, arg1,arg2) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[3+2]; \ + volatile unsigned long _res; \ + /* _argvec[0] holds current r2 across the call */ \ + _argvec[1] = (unsigned long)_orig.r2; \ + _argvec[2] = (unsigned long)_orig.nraddr; \ + _argvec[2+1] = (unsigned long)arg1; \ + _argvec[2+2] = (unsigned long)arg2; \ + __asm__ volatile( \ + VALGRIND_ALIGN_STACK \ + "mr 12,%1\n\t" \ + "std 2,-16(12)\n\t" /* save tocptr */ \ + "ld 2,-8(12)\n\t" /* use nraddr's tocptr */ \ + "ld 3, 8(12)\n\t" /* arg1->r3 */ \ + "ld 4, 16(12)\n\t" /* arg2->r4 */ \ + "ld 12, 0(12)\n\t" /* target->r12 */ \ + VALGRIND_BRANCH_AND_LINK_TO_NOREDIR_R12 \ + "mr 12,%1\n\t" \ + "mr %0,3\n\t" \ + "ld 2,-16(12)\n\t" /* restore tocptr */ \ + VALGRIND_RESTORE_STACK \ + : /*out*/ "=r" (_res) \ + : /*in*/ "r" (&_argvec[2]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS, "r28" \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_WWW(lval, orig, arg1,arg2,arg3) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[3+3]; \ + volatile unsigned long _res; \ + /* _argvec[0] holds current r2 across the call */ \ + _argvec[1] = (unsigned long)_orig.r2; \ + _argvec[2] = (unsigned long)_orig.nraddr; \ + _argvec[2+1] = (unsigned long)arg1; \ + _argvec[2+2] = (unsigned long)arg2; \ + _argvec[2+3] = (unsigned long)arg3; \ + __asm__ volatile( \ + VALGRIND_ALIGN_STACK \ + "mr 12,%1\n\t" \ + "std 2,-16(12)\n\t" /* save tocptr */ \ + "ld 2,-8(12)\n\t" /* use nraddr's tocptr */ \ + "ld 3, 8(12)\n\t" /* arg1->r3 */ \ + "ld 4, 16(12)\n\t" /* arg2->r4 */ \ + "ld 5, 24(12)\n\t" /* arg3->r5 */ \ + "ld 12, 0(12)\n\t" /* target->r12 */ \ + VALGRIND_BRANCH_AND_LINK_TO_NOREDIR_R12 \ + "mr 12,%1\n\t" \ + "mr %0,3\n\t" \ + "ld 2,-16(12)\n\t" /* restore tocptr */ \ + VALGRIND_RESTORE_STACK \ + : /*out*/ "=r" (_res) \ + : /*in*/ "r" (&_argvec[2]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS, "r28" \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_WWWW(lval, orig, arg1,arg2,arg3,arg4) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[3+4]; \ + volatile unsigned long _res; \ + /* _argvec[0] holds current r2 across the call */ \ + _argvec[1] = (unsigned long)_orig.r2; \ + _argvec[2] = (unsigned long)_orig.nraddr; \ + _argvec[2+1] = (unsigned long)arg1; \ + _argvec[2+2] = (unsigned long)arg2; \ + _argvec[2+3] = (unsigned long)arg3; \ + _argvec[2+4] = (unsigned long)arg4; \ + __asm__ volatile( \ + VALGRIND_ALIGN_STACK \ + "mr 12,%1\n\t" \ + "std 2,-16(12)\n\t" /* save tocptr */ \ + "ld 2,-8(12)\n\t" /* use nraddr's tocptr */ \ + "ld 3, 8(12)\n\t" /* arg1->r3 */ \ + "ld 4, 16(12)\n\t" /* arg2->r4 */ \ + "ld 5, 24(12)\n\t" /* arg3->r5 */ \ + "ld 6, 32(12)\n\t" /* arg4->r6 */ \ + "ld 12, 0(12)\n\t" /* target->r12 */ \ + VALGRIND_BRANCH_AND_LINK_TO_NOREDIR_R12 \ + "mr 12,%1\n\t" \ + "mr %0,3\n\t" \ + "ld 2,-16(12)\n\t" /* restore tocptr */ \ + VALGRIND_RESTORE_STACK \ + : /*out*/ "=r" (_res) \ + : /*in*/ "r" (&_argvec[2]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS, "r28" \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_5W(lval, orig, arg1,arg2,arg3,arg4,arg5) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[3+5]; \ + volatile unsigned long _res; \ + /* _argvec[0] holds current r2 across the call */ \ + _argvec[1] = (unsigned long)_orig.r2; \ + _argvec[2] = (unsigned long)_orig.nraddr; \ + _argvec[2+1] = (unsigned long)arg1; \ + _argvec[2+2] = (unsigned long)arg2; \ + _argvec[2+3] = (unsigned long)arg3; \ + _argvec[2+4] = (unsigned long)arg4; \ + _argvec[2+5] = (unsigned long)arg5; \ + __asm__ volatile( \ + VALGRIND_ALIGN_STACK \ + "mr 12,%1\n\t" \ + "std 2,-16(12)\n\t" /* save tocptr */ \ + "ld 2,-8(12)\n\t" /* use nraddr's tocptr */ \ + "ld 3, 8(12)\n\t" /* arg1->r3 */ \ + "ld 4, 16(12)\n\t" /* arg2->r4 */ \ + "ld 5, 24(12)\n\t" /* arg3->r5 */ \ + "ld 6, 32(12)\n\t" /* arg4->r6 */ \ + "ld 7, 40(12)\n\t" /* arg5->r7 */ \ + "ld 12, 0(12)\n\t" /* target->r12 */ \ + VALGRIND_BRANCH_AND_LINK_TO_NOREDIR_R12 \ + "mr 12,%1\n\t" \ + "mr %0,3\n\t" \ + "ld 2,-16(12)\n\t" /* restore tocptr */ \ + VALGRIND_RESTORE_STACK \ + : /*out*/ "=r" (_res) \ + : /*in*/ "r" (&_argvec[2]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS, "r28" \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_6W(lval, orig, arg1,arg2,arg3,arg4,arg5,arg6) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[3+6]; \ + volatile unsigned long _res; \ + /* _argvec[0] holds current r2 across the call */ \ + _argvec[1] = (unsigned long)_orig.r2; \ + _argvec[2] = (unsigned long)_orig.nraddr; \ + _argvec[2+1] = (unsigned long)arg1; \ + _argvec[2+2] = (unsigned long)arg2; \ + _argvec[2+3] = (unsigned long)arg3; \ + _argvec[2+4] = (unsigned long)arg4; \ + _argvec[2+5] = (unsigned long)arg5; \ + _argvec[2+6] = (unsigned long)arg6; \ + __asm__ volatile( \ + VALGRIND_ALIGN_STACK \ + "mr 12,%1\n\t" \ + "std 2,-16(12)\n\t" /* save tocptr */ \ + "ld 2,-8(12)\n\t" /* use nraddr's tocptr */ \ + "ld 3, 8(12)\n\t" /* arg1->r3 */ \ + "ld 4, 16(12)\n\t" /* arg2->r4 */ \ + "ld 5, 24(12)\n\t" /* arg3->r5 */ \ + "ld 6, 32(12)\n\t" /* arg4->r6 */ \ + "ld 7, 40(12)\n\t" /* arg5->r7 */ \ + "ld 8, 48(12)\n\t" /* arg6->r8 */ \ + "ld 12, 0(12)\n\t" /* target->r12 */ \ + VALGRIND_BRANCH_AND_LINK_TO_NOREDIR_R12 \ + "mr 12,%1\n\t" \ + "mr %0,3\n\t" \ + "ld 2,-16(12)\n\t" /* restore tocptr */ \ + VALGRIND_RESTORE_STACK \ + : /*out*/ "=r" (_res) \ + : /*in*/ "r" (&_argvec[2]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS, "r28" \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_7W(lval, orig, arg1,arg2,arg3,arg4,arg5,arg6, \ + arg7) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[3+7]; \ + volatile unsigned long _res; \ + /* _argvec[0] holds current r2 across the call */ \ + _argvec[1] = (unsigned long)_orig.r2; \ + _argvec[2] = (unsigned long)_orig.nraddr; \ + _argvec[2+1] = (unsigned long)arg1; \ + _argvec[2+2] = (unsigned long)arg2; \ + _argvec[2+3] = (unsigned long)arg3; \ + _argvec[2+4] = (unsigned long)arg4; \ + _argvec[2+5] = (unsigned long)arg5; \ + _argvec[2+6] = (unsigned long)arg6; \ + _argvec[2+7] = (unsigned long)arg7; \ + __asm__ volatile( \ + VALGRIND_ALIGN_STACK \ + "mr 12,%1\n\t" \ + "std 2,-16(12)\n\t" /* save tocptr */ \ + "ld 2,-8(12)\n\t" /* use nraddr's tocptr */ \ + "ld 3, 8(12)\n\t" /* arg1->r3 */ \ + "ld 4, 16(12)\n\t" /* arg2->r4 */ \ + "ld 5, 24(12)\n\t" /* arg3->r5 */ \ + "ld 6, 32(12)\n\t" /* arg4->r6 */ \ + "ld 7, 40(12)\n\t" /* arg5->r7 */ \ + "ld 8, 48(12)\n\t" /* arg6->r8 */ \ + "ld 9, 56(12)\n\t" /* arg7->r9 */ \ + "ld 12, 0(12)\n\t" /* target->r12 */ \ + VALGRIND_BRANCH_AND_LINK_TO_NOREDIR_R12 \ + "mr 12,%1\n\t" \ + "mr %0,3\n\t" \ + "ld 2,-16(12)\n\t" /* restore tocptr */ \ + VALGRIND_RESTORE_STACK \ + : /*out*/ "=r" (_res) \ + : /*in*/ "r" (&_argvec[2]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS, "r28" \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_8W(lval, orig, arg1,arg2,arg3,arg4,arg5,arg6, \ + arg7,arg8) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[3+8]; \ + volatile unsigned long _res; \ + /* _argvec[0] holds current r2 across the call */ \ + _argvec[1] = (unsigned long)_orig.r2; \ + _argvec[2] = (unsigned long)_orig.nraddr; \ + _argvec[2+1] = (unsigned long)arg1; \ + _argvec[2+2] = (unsigned long)arg2; \ + _argvec[2+3] = (unsigned long)arg3; \ + _argvec[2+4] = (unsigned long)arg4; \ + _argvec[2+5] = (unsigned long)arg5; \ + _argvec[2+6] = (unsigned long)arg6; \ + _argvec[2+7] = (unsigned long)arg7; \ + _argvec[2+8] = (unsigned long)arg8; \ + __asm__ volatile( \ + VALGRIND_ALIGN_STACK \ + "mr 12,%1\n\t" \ + "std 2,-16(12)\n\t" /* save tocptr */ \ + "ld 2,-8(12)\n\t" /* use nraddr's tocptr */ \ + "ld 3, 8(12)\n\t" /* arg1->r3 */ \ + "ld 4, 16(12)\n\t" /* arg2->r4 */ \ + "ld 5, 24(12)\n\t" /* arg3->r5 */ \ + "ld 6, 32(12)\n\t" /* arg4->r6 */ \ + "ld 7, 40(12)\n\t" /* arg5->r7 */ \ + "ld 8, 48(12)\n\t" /* arg6->r8 */ \ + "ld 9, 56(12)\n\t" /* arg7->r9 */ \ + "ld 10, 64(12)\n\t" /* arg8->r10 */ \ + "ld 12, 0(12)\n\t" /* target->r12 */ \ + VALGRIND_BRANCH_AND_LINK_TO_NOREDIR_R12 \ + "mr 12,%1\n\t" \ + "mr %0,3\n\t" \ + "ld 2,-16(12)\n\t" /* restore tocptr */ \ + VALGRIND_RESTORE_STACK \ + : /*out*/ "=r" (_res) \ + : /*in*/ "r" (&_argvec[2]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS, "r28" \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_9W(lval, orig, arg1,arg2,arg3,arg4,arg5,arg6, \ + arg7,arg8,arg9) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[3+9]; \ + volatile unsigned long _res; \ + /* _argvec[0] holds current r2 across the call */ \ + _argvec[1] = (unsigned long)_orig.r2; \ + _argvec[2] = (unsigned long)_orig.nraddr; \ + _argvec[2+1] = (unsigned long)arg1; \ + _argvec[2+2] = (unsigned long)arg2; \ + _argvec[2+3] = (unsigned long)arg3; \ + _argvec[2+4] = (unsigned long)arg4; \ + _argvec[2+5] = (unsigned long)arg5; \ + _argvec[2+6] = (unsigned long)arg6; \ + _argvec[2+7] = (unsigned long)arg7; \ + _argvec[2+8] = (unsigned long)arg8; \ + _argvec[2+9] = (unsigned long)arg9; \ + __asm__ volatile( \ + VALGRIND_ALIGN_STACK \ + "mr 12,%1\n\t" \ + "std 2,-16(12)\n\t" /* save tocptr */ \ + "ld 2,-8(12)\n\t" /* use nraddr's tocptr */ \ + "addi 1,1,-128\n\t" /* expand stack frame */ \ + /* arg9 */ \ + "ld 3,72(12)\n\t" \ + "std 3,96(1)\n\t" \ + /* args1-8 */ \ + "ld 3, 8(12)\n\t" /* arg1->r3 */ \ + "ld 4, 16(12)\n\t" /* arg2->r4 */ \ + "ld 5, 24(12)\n\t" /* arg3->r5 */ \ + "ld 6, 32(12)\n\t" /* arg4->r6 */ \ + "ld 7, 40(12)\n\t" /* arg5->r7 */ \ + "ld 8, 48(12)\n\t" /* arg6->r8 */ \ + "ld 9, 56(12)\n\t" /* arg7->r9 */ \ + "ld 10, 64(12)\n\t" /* arg8->r10 */ \ + "ld 12, 0(12)\n\t" /* target->r12 */ \ + VALGRIND_BRANCH_AND_LINK_TO_NOREDIR_R12 \ + "mr 12,%1\n\t" \ + "mr %0,3\n\t" \ + "ld 2,-16(12)\n\t" /* restore tocptr */ \ + VALGRIND_RESTORE_STACK \ + : /*out*/ "=r" (_res) \ + : /*in*/ "r" (&_argvec[2]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS, "r28" \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_10W(lval, orig, arg1,arg2,arg3,arg4,arg5,arg6, \ + arg7,arg8,arg9,arg10) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[3+10]; \ + volatile unsigned long _res; \ + /* _argvec[0] holds current r2 across the call */ \ + _argvec[1] = (unsigned long)_orig.r2; \ + _argvec[2] = (unsigned long)_orig.nraddr; \ + _argvec[2+1] = (unsigned long)arg1; \ + _argvec[2+2] = (unsigned long)arg2; \ + _argvec[2+3] = (unsigned long)arg3; \ + _argvec[2+4] = (unsigned long)arg4; \ + _argvec[2+5] = (unsigned long)arg5; \ + _argvec[2+6] = (unsigned long)arg6; \ + _argvec[2+7] = (unsigned long)arg7; \ + _argvec[2+8] = (unsigned long)arg8; \ + _argvec[2+9] = (unsigned long)arg9; \ + _argvec[2+10] = (unsigned long)arg10; \ + __asm__ volatile( \ + VALGRIND_ALIGN_STACK \ + "mr 12,%1\n\t" \ + "std 2,-16(12)\n\t" /* save tocptr */ \ + "ld 2,-8(12)\n\t" /* use nraddr's tocptr */ \ + "addi 1,1,-128\n\t" /* expand stack frame */ \ + /* arg10 */ \ + "ld 3,80(12)\n\t" \ + "std 3,104(1)\n\t" \ + /* arg9 */ \ + "ld 3,72(12)\n\t" \ + "std 3,96(1)\n\t" \ + /* args1-8 */ \ + "ld 3, 8(12)\n\t" /* arg1->r3 */ \ + "ld 4, 16(12)\n\t" /* arg2->r4 */ \ + "ld 5, 24(12)\n\t" /* arg3->r5 */ \ + "ld 6, 32(12)\n\t" /* arg4->r6 */ \ + "ld 7, 40(12)\n\t" /* arg5->r7 */ \ + "ld 8, 48(12)\n\t" /* arg6->r8 */ \ + "ld 9, 56(12)\n\t" /* arg7->r9 */ \ + "ld 10, 64(12)\n\t" /* arg8->r10 */ \ + "ld 12, 0(12)\n\t" /* target->r12 */ \ + VALGRIND_BRANCH_AND_LINK_TO_NOREDIR_R12 \ + "mr 12,%1\n\t" \ + "mr %0,3\n\t" \ + "ld 2,-16(12)\n\t" /* restore tocptr */ \ + VALGRIND_RESTORE_STACK \ + : /*out*/ "=r" (_res) \ + : /*in*/ "r" (&_argvec[2]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS, "r28" \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_11W(lval, orig, arg1,arg2,arg3,arg4,arg5,arg6, \ + arg7,arg8,arg9,arg10,arg11) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[3+11]; \ + volatile unsigned long _res; \ + /* _argvec[0] holds current r2 across the call */ \ + _argvec[1] = (unsigned long)_orig.r2; \ + _argvec[2] = (unsigned long)_orig.nraddr; \ + _argvec[2+1] = (unsigned long)arg1; \ + _argvec[2+2] = (unsigned long)arg2; \ + _argvec[2+3] = (unsigned long)arg3; \ + _argvec[2+4] = (unsigned long)arg4; \ + _argvec[2+5] = (unsigned long)arg5; \ + _argvec[2+6] = (unsigned long)arg6; \ + _argvec[2+7] = (unsigned long)arg7; \ + _argvec[2+8] = (unsigned long)arg8; \ + _argvec[2+9] = (unsigned long)arg9; \ + _argvec[2+10] = (unsigned long)arg10; \ + _argvec[2+11] = (unsigned long)arg11; \ + __asm__ volatile( \ + VALGRIND_ALIGN_STACK \ + "mr 12,%1\n\t" \ + "std 2,-16(12)\n\t" /* save tocptr */ \ + "ld 2,-8(12)\n\t" /* use nraddr's tocptr */ \ + "addi 1,1,-144\n\t" /* expand stack frame */ \ + /* arg11 */ \ + "ld 3,88(12)\n\t" \ + "std 3,112(1)\n\t" \ + /* arg10 */ \ + "ld 3,80(12)\n\t" \ + "std 3,104(1)\n\t" \ + /* arg9 */ \ + "ld 3,72(12)\n\t" \ + "std 3,96(1)\n\t" \ + /* args1-8 */ \ + "ld 3, 8(12)\n\t" /* arg1->r3 */ \ + "ld 4, 16(12)\n\t" /* arg2->r4 */ \ + "ld 5, 24(12)\n\t" /* arg3->r5 */ \ + "ld 6, 32(12)\n\t" /* arg4->r6 */ \ + "ld 7, 40(12)\n\t" /* arg5->r7 */ \ + "ld 8, 48(12)\n\t" /* arg6->r8 */ \ + "ld 9, 56(12)\n\t" /* arg7->r9 */ \ + "ld 10, 64(12)\n\t" /* arg8->r10 */ \ + "ld 12, 0(12)\n\t" /* target->r12 */ \ + VALGRIND_BRANCH_AND_LINK_TO_NOREDIR_R12 \ + "mr 12,%1\n\t" \ + "mr %0,3\n\t" \ + "ld 2,-16(12)\n\t" /* restore tocptr */ \ + VALGRIND_RESTORE_STACK \ + : /*out*/ "=r" (_res) \ + : /*in*/ "r" (&_argvec[2]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS, "r28" \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_12W(lval, orig, arg1,arg2,arg3,arg4,arg5,arg6, \ + arg7,arg8,arg9,arg10,arg11,arg12) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[3+12]; \ + volatile unsigned long _res; \ + /* _argvec[0] holds current r2 across the call */ \ + _argvec[1] = (unsigned long)_orig.r2; \ + _argvec[2] = (unsigned long)_orig.nraddr; \ + _argvec[2+1] = (unsigned long)arg1; \ + _argvec[2+2] = (unsigned long)arg2; \ + _argvec[2+3] = (unsigned long)arg3; \ + _argvec[2+4] = (unsigned long)arg4; \ + _argvec[2+5] = (unsigned long)arg5; \ + _argvec[2+6] = (unsigned long)arg6; \ + _argvec[2+7] = (unsigned long)arg7; \ + _argvec[2+8] = (unsigned long)arg8; \ + _argvec[2+9] = (unsigned long)arg9; \ + _argvec[2+10] = (unsigned long)arg10; \ + _argvec[2+11] = (unsigned long)arg11; \ + _argvec[2+12] = (unsigned long)arg12; \ + __asm__ volatile( \ + VALGRIND_ALIGN_STACK \ + "mr 12,%1\n\t" \ + "std 2,-16(12)\n\t" /* save tocptr */ \ + "ld 2,-8(12)\n\t" /* use nraddr's tocptr */ \ + "addi 1,1,-144\n\t" /* expand stack frame */ \ + /* arg12 */ \ + "ld 3,96(12)\n\t" \ + "std 3,120(1)\n\t" \ + /* arg11 */ \ + "ld 3,88(12)\n\t" \ + "std 3,112(1)\n\t" \ + /* arg10 */ \ + "ld 3,80(12)\n\t" \ + "std 3,104(1)\n\t" \ + /* arg9 */ \ + "ld 3,72(12)\n\t" \ + "std 3,96(1)\n\t" \ + /* args1-8 */ \ + "ld 3, 8(12)\n\t" /* arg1->r3 */ \ + "ld 4, 16(12)\n\t" /* arg2->r4 */ \ + "ld 5, 24(12)\n\t" /* arg3->r5 */ \ + "ld 6, 32(12)\n\t" /* arg4->r6 */ \ + "ld 7, 40(12)\n\t" /* arg5->r7 */ \ + "ld 8, 48(12)\n\t" /* arg6->r8 */ \ + "ld 9, 56(12)\n\t" /* arg7->r9 */ \ + "ld 10, 64(12)\n\t" /* arg8->r10 */ \ + "ld 12, 0(12)\n\t" /* target->r12 */ \ + VALGRIND_BRANCH_AND_LINK_TO_NOREDIR_R12 \ + "mr 12,%1\n\t" \ + "mr %0,3\n\t" \ + "ld 2,-16(12)\n\t" /* restore tocptr */ \ + VALGRIND_RESTORE_STACK \ + : /*out*/ "=r" (_res) \ + : /*in*/ "r" (&_argvec[2]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS, "r28" \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#endif /* PLAT_ppc64le_linux */ + +/* ------------------------- arm-linux ------------------------- */ + +#if defined(PLAT_arm_linux) + +/* These regs are trashed by the hidden call. */ +#define __CALLER_SAVED_REGS "r0", "r1", "r2", "r3","r4","r14" + +/* Macros to save and align the stack before making a function + call and restore it afterwards as gcc may not keep the stack + pointer aligned if it doesn't realise calls are being made + to other functions. */ + +/* This is a bit tricky. We store the original stack pointer in r10 + as it is callee-saves. gcc doesn't allow the use of r11 for some + reason. Also, we can't directly "bic" the stack pointer in thumb + mode since r13 isn't an allowed register number in that context. + So use r4 as a temporary, since that is about to get trashed + anyway, just after each use of this macro. Side effect is we need + to be very careful about any future changes, since + VALGRIND_ALIGN_STACK simply assumes r4 is usable. */ +#define VALGRIND_ALIGN_STACK \ + "mov r10, sp\n\t" \ + "mov r4, sp\n\t" \ + "bic r4, r4, #7\n\t" \ + "mov sp, r4\n\t" +#define VALGRIND_RESTORE_STACK \ + "mov sp, r10\n\t" + +/* These CALL_FN_ macros assume that on arm-linux, sizeof(unsigned + long) == 4. */ + +#define CALL_FN_W_v(lval, orig) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[1]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + __asm__ volatile( \ + VALGRIND_ALIGN_STACK \ + "ldr r4, [%1] \n\t" /* target->r4 */ \ + VALGRIND_BRANCH_AND_LINK_TO_NOREDIR_R4 \ + VALGRIND_RESTORE_STACK \ + "mov %0, r0\n" \ + : /*out*/ "=r" (_res) \ + : /*in*/ "0" (&_argvec[0]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS, "r10" \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_W(lval, orig, arg1) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[2]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)(arg1); \ + __asm__ volatile( \ + VALGRIND_ALIGN_STACK \ + "ldr r0, [%1, #4] \n\t" \ + "ldr r4, [%1] \n\t" /* target->r4 */ \ + VALGRIND_BRANCH_AND_LINK_TO_NOREDIR_R4 \ + VALGRIND_RESTORE_STACK \ + "mov %0, r0\n" \ + : /*out*/ "=r" (_res) \ + : /*in*/ "0" (&_argvec[0]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS, "r10" \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_WW(lval, orig, arg1,arg2) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[3]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)(arg1); \ + _argvec[2] = (unsigned long)(arg2); \ + __asm__ volatile( \ + VALGRIND_ALIGN_STACK \ + "ldr r0, [%1, #4] \n\t" \ + "ldr r1, [%1, #8] \n\t" \ + "ldr r4, [%1] \n\t" /* target->r4 */ \ + VALGRIND_BRANCH_AND_LINK_TO_NOREDIR_R4 \ + VALGRIND_RESTORE_STACK \ + "mov %0, r0\n" \ + : /*out*/ "=r" (_res) \ + : /*in*/ "0" (&_argvec[0]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS, "r10" \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_WWW(lval, orig, arg1,arg2,arg3) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[4]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)(arg1); \ + _argvec[2] = (unsigned long)(arg2); \ + _argvec[3] = (unsigned long)(arg3); \ + __asm__ volatile( \ + VALGRIND_ALIGN_STACK \ + "ldr r0, [%1, #4] \n\t" \ + "ldr r1, [%1, #8] \n\t" \ + "ldr r2, [%1, #12] \n\t" \ + "ldr r4, [%1] \n\t" /* target->r4 */ \ + VALGRIND_BRANCH_AND_LINK_TO_NOREDIR_R4 \ + VALGRIND_RESTORE_STACK \ + "mov %0, r0\n" \ + : /*out*/ "=r" (_res) \ + : /*in*/ "0" (&_argvec[0]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS, "r10" \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_WWWW(lval, orig, arg1,arg2,arg3,arg4) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[5]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)(arg1); \ + _argvec[2] = (unsigned long)(arg2); \ + _argvec[3] = (unsigned long)(arg3); \ + _argvec[4] = (unsigned long)(arg4); \ + __asm__ volatile( \ + VALGRIND_ALIGN_STACK \ + "ldr r0, [%1, #4] \n\t" \ + "ldr r1, [%1, #8] \n\t" \ + "ldr r2, [%1, #12] \n\t" \ + "ldr r3, [%1, #16] \n\t" \ + "ldr r4, [%1] \n\t" /* target->r4 */ \ + VALGRIND_BRANCH_AND_LINK_TO_NOREDIR_R4 \ + VALGRIND_RESTORE_STACK \ + "mov %0, r0" \ + : /*out*/ "=r" (_res) \ + : /*in*/ "0" (&_argvec[0]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS, "r10" \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_5W(lval, orig, arg1,arg2,arg3,arg4,arg5) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[6]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)(arg1); \ + _argvec[2] = (unsigned long)(arg2); \ + _argvec[3] = (unsigned long)(arg3); \ + _argvec[4] = (unsigned long)(arg4); \ + _argvec[5] = (unsigned long)(arg5); \ + __asm__ volatile( \ + VALGRIND_ALIGN_STACK \ + "sub sp, sp, #4 \n\t" \ + "ldr r0, [%1, #20] \n\t" \ + "push {r0} \n\t" \ + "ldr r0, [%1, #4] \n\t" \ + "ldr r1, [%1, #8] \n\t" \ + "ldr r2, [%1, #12] \n\t" \ + "ldr r3, [%1, #16] \n\t" \ + "ldr r4, [%1] \n\t" /* target->r4 */ \ + VALGRIND_BRANCH_AND_LINK_TO_NOREDIR_R4 \ + VALGRIND_RESTORE_STACK \ + "mov %0, r0" \ + : /*out*/ "=r" (_res) \ + : /*in*/ "0" (&_argvec[0]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS, "r10" \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_6W(lval, orig, arg1,arg2,arg3,arg4,arg5,arg6) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[7]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)(arg1); \ + _argvec[2] = (unsigned long)(arg2); \ + _argvec[3] = (unsigned long)(arg3); \ + _argvec[4] = (unsigned long)(arg4); \ + _argvec[5] = (unsigned long)(arg5); \ + _argvec[6] = (unsigned long)(arg6); \ + __asm__ volatile( \ + VALGRIND_ALIGN_STACK \ + "ldr r0, [%1, #20] \n\t" \ + "ldr r1, [%1, #24] \n\t" \ + "push {r0, r1} \n\t" \ + "ldr r0, [%1, #4] \n\t" \ + "ldr r1, [%1, #8] \n\t" \ + "ldr r2, [%1, #12] \n\t" \ + "ldr r3, [%1, #16] \n\t" \ + "ldr r4, [%1] \n\t" /* target->r4 */ \ + VALGRIND_BRANCH_AND_LINK_TO_NOREDIR_R4 \ + VALGRIND_RESTORE_STACK \ + "mov %0, r0" \ + : /*out*/ "=r" (_res) \ + : /*in*/ "0" (&_argvec[0]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS, "r10" \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_7W(lval, orig, arg1,arg2,arg3,arg4,arg5,arg6, \ + arg7) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[8]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)(arg1); \ + _argvec[2] = (unsigned long)(arg2); \ + _argvec[3] = (unsigned long)(arg3); \ + _argvec[4] = (unsigned long)(arg4); \ + _argvec[5] = (unsigned long)(arg5); \ + _argvec[6] = (unsigned long)(arg6); \ + _argvec[7] = (unsigned long)(arg7); \ + __asm__ volatile( \ + VALGRIND_ALIGN_STACK \ + "sub sp, sp, #4 \n\t" \ + "ldr r0, [%1, #20] \n\t" \ + "ldr r1, [%1, #24] \n\t" \ + "ldr r2, [%1, #28] \n\t" \ + "push {r0, r1, r2} \n\t" \ + "ldr r0, [%1, #4] \n\t" \ + "ldr r1, [%1, #8] \n\t" \ + "ldr r2, [%1, #12] \n\t" \ + "ldr r3, [%1, #16] \n\t" \ + "ldr r4, [%1] \n\t" /* target->r4 */ \ + VALGRIND_BRANCH_AND_LINK_TO_NOREDIR_R4 \ + VALGRIND_RESTORE_STACK \ + "mov %0, r0" \ + : /*out*/ "=r" (_res) \ + : /*in*/ "0" (&_argvec[0]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS, "r10" \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_8W(lval, orig, arg1,arg2,arg3,arg4,arg5,arg6, \ + arg7,arg8) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[9]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)(arg1); \ + _argvec[2] = (unsigned long)(arg2); \ + _argvec[3] = (unsigned long)(arg3); \ + _argvec[4] = (unsigned long)(arg4); \ + _argvec[5] = (unsigned long)(arg5); \ + _argvec[6] = (unsigned long)(arg6); \ + _argvec[7] = (unsigned long)(arg7); \ + _argvec[8] = (unsigned long)(arg8); \ + __asm__ volatile( \ + VALGRIND_ALIGN_STACK \ + "ldr r0, [%1, #20] \n\t" \ + "ldr r1, [%1, #24] \n\t" \ + "ldr r2, [%1, #28] \n\t" \ + "ldr r3, [%1, #32] \n\t" \ + "push {r0, r1, r2, r3} \n\t" \ + "ldr r0, [%1, #4] \n\t" \ + "ldr r1, [%1, #8] \n\t" \ + "ldr r2, [%1, #12] \n\t" \ + "ldr r3, [%1, #16] \n\t" \ + "ldr r4, [%1] \n\t" /* target->r4 */ \ + VALGRIND_BRANCH_AND_LINK_TO_NOREDIR_R4 \ + VALGRIND_RESTORE_STACK \ + "mov %0, r0" \ + : /*out*/ "=r" (_res) \ + : /*in*/ "0" (&_argvec[0]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS, "r10" \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_9W(lval, orig, arg1,arg2,arg3,arg4,arg5,arg6, \ + arg7,arg8,arg9) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[10]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)(arg1); \ + _argvec[2] = (unsigned long)(arg2); \ + _argvec[3] = (unsigned long)(arg3); \ + _argvec[4] = (unsigned long)(arg4); \ + _argvec[5] = (unsigned long)(arg5); \ + _argvec[6] = (unsigned long)(arg6); \ + _argvec[7] = (unsigned long)(arg7); \ + _argvec[8] = (unsigned long)(arg8); \ + _argvec[9] = (unsigned long)(arg9); \ + __asm__ volatile( \ + VALGRIND_ALIGN_STACK \ + "sub sp, sp, #4 \n\t" \ + "ldr r0, [%1, #20] \n\t" \ + "ldr r1, [%1, #24] \n\t" \ + "ldr r2, [%1, #28] \n\t" \ + "ldr r3, [%1, #32] \n\t" \ + "ldr r4, [%1, #36] \n\t" \ + "push {r0, r1, r2, r3, r4} \n\t" \ + "ldr r0, [%1, #4] \n\t" \ + "ldr r1, [%1, #8] \n\t" \ + "ldr r2, [%1, #12] \n\t" \ + "ldr r3, [%1, #16] \n\t" \ + "ldr r4, [%1] \n\t" /* target->r4 */ \ + VALGRIND_BRANCH_AND_LINK_TO_NOREDIR_R4 \ + VALGRIND_RESTORE_STACK \ + "mov %0, r0" \ + : /*out*/ "=r" (_res) \ + : /*in*/ "0" (&_argvec[0]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS, "r10" \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_10W(lval, orig, arg1,arg2,arg3,arg4,arg5,arg6, \ + arg7,arg8,arg9,arg10) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[11]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)(arg1); \ + _argvec[2] = (unsigned long)(arg2); \ + _argvec[3] = (unsigned long)(arg3); \ + _argvec[4] = (unsigned long)(arg4); \ + _argvec[5] = (unsigned long)(arg5); \ + _argvec[6] = (unsigned long)(arg6); \ + _argvec[7] = (unsigned long)(arg7); \ + _argvec[8] = (unsigned long)(arg8); \ + _argvec[9] = (unsigned long)(arg9); \ + _argvec[10] = (unsigned long)(arg10); \ + __asm__ volatile( \ + VALGRIND_ALIGN_STACK \ + "ldr r0, [%1, #40] \n\t" \ + "push {r0} \n\t" \ + "ldr r0, [%1, #20] \n\t" \ + "ldr r1, [%1, #24] \n\t" \ + "ldr r2, [%1, #28] \n\t" \ + "ldr r3, [%1, #32] \n\t" \ + "ldr r4, [%1, #36] \n\t" \ + "push {r0, r1, r2, r3, r4} \n\t" \ + "ldr r0, [%1, #4] \n\t" \ + "ldr r1, [%1, #8] \n\t" \ + "ldr r2, [%1, #12] \n\t" \ + "ldr r3, [%1, #16] \n\t" \ + "ldr r4, [%1] \n\t" /* target->r4 */ \ + VALGRIND_BRANCH_AND_LINK_TO_NOREDIR_R4 \ + VALGRIND_RESTORE_STACK \ + "mov %0, r0" \ + : /*out*/ "=r" (_res) \ + : /*in*/ "0" (&_argvec[0]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS, "r10" \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_11W(lval, orig, arg1,arg2,arg3,arg4,arg5, \ + arg6,arg7,arg8,arg9,arg10, \ + arg11) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[12]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)(arg1); \ + _argvec[2] = (unsigned long)(arg2); \ + _argvec[3] = (unsigned long)(arg3); \ + _argvec[4] = (unsigned long)(arg4); \ + _argvec[5] = (unsigned long)(arg5); \ + _argvec[6] = (unsigned long)(arg6); \ + _argvec[7] = (unsigned long)(arg7); \ + _argvec[8] = (unsigned long)(arg8); \ + _argvec[9] = (unsigned long)(arg9); \ + _argvec[10] = (unsigned long)(arg10); \ + _argvec[11] = (unsigned long)(arg11); \ + __asm__ volatile( \ + VALGRIND_ALIGN_STACK \ + "sub sp, sp, #4 \n\t" \ + "ldr r0, [%1, #40] \n\t" \ + "ldr r1, [%1, #44] \n\t" \ + "push {r0, r1} \n\t" \ + "ldr r0, [%1, #20] \n\t" \ + "ldr r1, [%1, #24] \n\t" \ + "ldr r2, [%1, #28] \n\t" \ + "ldr r3, [%1, #32] \n\t" \ + "ldr r4, [%1, #36] \n\t" \ + "push {r0, r1, r2, r3, r4} \n\t" \ + "ldr r0, [%1, #4] \n\t" \ + "ldr r1, [%1, #8] \n\t" \ + "ldr r2, [%1, #12] \n\t" \ + "ldr r3, [%1, #16] \n\t" \ + "ldr r4, [%1] \n\t" /* target->r4 */ \ + VALGRIND_BRANCH_AND_LINK_TO_NOREDIR_R4 \ + VALGRIND_RESTORE_STACK \ + "mov %0, r0" \ + : /*out*/ "=r" (_res) \ + : /*in*/ "0" (&_argvec[0]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS, "r10" \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_12W(lval, orig, arg1,arg2,arg3,arg4,arg5, \ + arg6,arg7,arg8,arg9,arg10, \ + arg11,arg12) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[13]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)(arg1); \ + _argvec[2] = (unsigned long)(arg2); \ + _argvec[3] = (unsigned long)(arg3); \ + _argvec[4] = (unsigned long)(arg4); \ + _argvec[5] = (unsigned long)(arg5); \ + _argvec[6] = (unsigned long)(arg6); \ + _argvec[7] = (unsigned long)(arg7); \ + _argvec[8] = (unsigned long)(arg8); \ + _argvec[9] = (unsigned long)(arg9); \ + _argvec[10] = (unsigned long)(arg10); \ + _argvec[11] = (unsigned long)(arg11); \ + _argvec[12] = (unsigned long)(arg12); \ + __asm__ volatile( \ + VALGRIND_ALIGN_STACK \ + "ldr r0, [%1, #40] \n\t" \ + "ldr r1, [%1, #44] \n\t" \ + "ldr r2, [%1, #48] \n\t" \ + "push {r0, r1, r2} \n\t" \ + "ldr r0, [%1, #20] \n\t" \ + "ldr r1, [%1, #24] \n\t" \ + "ldr r2, [%1, #28] \n\t" \ + "ldr r3, [%1, #32] \n\t" \ + "ldr r4, [%1, #36] \n\t" \ + "push {r0, r1, r2, r3, r4} \n\t" \ + "ldr r0, [%1, #4] \n\t" \ + "ldr r1, [%1, #8] \n\t" \ + "ldr r2, [%1, #12] \n\t" \ + "ldr r3, [%1, #16] \n\t" \ + "ldr r4, [%1] \n\t" /* target->r4 */ \ + VALGRIND_BRANCH_AND_LINK_TO_NOREDIR_R4 \ + VALGRIND_RESTORE_STACK \ + "mov %0, r0" \ + : /*out*/ "=r" (_res) \ + : /*in*/ "0" (&_argvec[0]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS, "r10" \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#endif /* PLAT_arm_linux */ + +/* ------------------------ arm64-linux ------------------------ */ + +#if defined(PLAT_arm64_linux) + +/* These regs are trashed by the hidden call. */ +#define __CALLER_SAVED_REGS \ + "x0", "x1", "x2", "x3","x4", "x5", "x6", "x7", "x8", "x9", \ + "x10", "x11", "x12", "x13", "x14", "x15", "x16", "x17", \ + "x18", "x19", "x20", "x30", \ + "v0", "v1", "v2", "v3", "v4", "v5", "v6", "v7", "v8", "v9", \ + "v10", "v11", "v12", "v13", "v14", "v15", "v16", "v17", \ + "v18", "v19", "v20", "v21", "v22", "v23", "v24", "v25", \ + "v26", "v27", "v28", "v29", "v30", "v31" + +/* x21 is callee-saved, so we can use it to save and restore SP around + the hidden call. */ +#define VALGRIND_ALIGN_STACK \ + "mov x21, sp\n\t" \ + "bic sp, x21, #15\n\t" +#define VALGRIND_RESTORE_STACK \ + "mov sp, x21\n\t" + +/* These CALL_FN_ macros assume that on arm64-linux, + sizeof(unsigned long) == 8. */ + +#define CALL_FN_W_v(lval, orig) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[1]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + __asm__ volatile( \ + VALGRIND_ALIGN_STACK \ + "ldr x8, [%1] \n\t" /* target->x8 */ \ + VALGRIND_BRANCH_AND_LINK_TO_NOREDIR_X8 \ + VALGRIND_RESTORE_STACK \ + "mov %0, x0\n" \ + : /*out*/ "=r" (_res) \ + : /*in*/ "0" (&_argvec[0]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS, "x21" \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_W(lval, orig, arg1) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[2]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)(arg1); \ + __asm__ volatile( \ + VALGRIND_ALIGN_STACK \ + "ldr x0, [%1, #8] \n\t" \ + "ldr x8, [%1] \n\t" /* target->x8 */ \ + VALGRIND_BRANCH_AND_LINK_TO_NOREDIR_X8 \ + VALGRIND_RESTORE_STACK \ + "mov %0, x0\n" \ + : /*out*/ "=r" (_res) \ + : /*in*/ "0" (&_argvec[0]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS, "x21" \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_WW(lval, orig, arg1,arg2) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[3]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)(arg1); \ + _argvec[2] = (unsigned long)(arg2); \ + __asm__ volatile( \ + VALGRIND_ALIGN_STACK \ + "ldr x0, [%1, #8] \n\t" \ + "ldr x1, [%1, #16] \n\t" \ + "ldr x8, [%1] \n\t" /* target->x8 */ \ + VALGRIND_BRANCH_AND_LINK_TO_NOREDIR_X8 \ + VALGRIND_RESTORE_STACK \ + "mov %0, x0\n" \ + : /*out*/ "=r" (_res) \ + : /*in*/ "0" (&_argvec[0]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS, "x21" \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_WWW(lval, orig, arg1,arg2,arg3) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[4]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)(arg1); \ + _argvec[2] = (unsigned long)(arg2); \ + _argvec[3] = (unsigned long)(arg3); \ + __asm__ volatile( \ + VALGRIND_ALIGN_STACK \ + "ldr x0, [%1, #8] \n\t" \ + "ldr x1, [%1, #16] \n\t" \ + "ldr x2, [%1, #24] \n\t" \ + "ldr x8, [%1] \n\t" /* target->x8 */ \ + VALGRIND_BRANCH_AND_LINK_TO_NOREDIR_X8 \ + VALGRIND_RESTORE_STACK \ + "mov %0, x0\n" \ + : /*out*/ "=r" (_res) \ + : /*in*/ "0" (&_argvec[0]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS, "x21" \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_WWWW(lval, orig, arg1,arg2,arg3,arg4) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[5]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)(arg1); \ + _argvec[2] = (unsigned long)(arg2); \ + _argvec[3] = (unsigned long)(arg3); \ + _argvec[4] = (unsigned long)(arg4); \ + __asm__ volatile( \ + VALGRIND_ALIGN_STACK \ + "ldr x0, [%1, #8] \n\t" \ + "ldr x1, [%1, #16] \n\t" \ + "ldr x2, [%1, #24] \n\t" \ + "ldr x3, [%1, #32] \n\t" \ + "ldr x8, [%1] \n\t" /* target->x8 */ \ + VALGRIND_BRANCH_AND_LINK_TO_NOREDIR_X8 \ + VALGRIND_RESTORE_STACK \ + "mov %0, x0" \ + : /*out*/ "=r" (_res) \ + : /*in*/ "0" (&_argvec[0]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS, "x21" \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_5W(lval, orig, arg1,arg2,arg3,arg4,arg5) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[6]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)(arg1); \ + _argvec[2] = (unsigned long)(arg2); \ + _argvec[3] = (unsigned long)(arg3); \ + _argvec[4] = (unsigned long)(arg4); \ + _argvec[5] = (unsigned long)(arg5); \ + __asm__ volatile( \ + VALGRIND_ALIGN_STACK \ + "ldr x0, [%1, #8] \n\t" \ + "ldr x1, [%1, #16] \n\t" \ + "ldr x2, [%1, #24] \n\t" \ + "ldr x3, [%1, #32] \n\t" \ + "ldr x4, [%1, #40] \n\t" \ + "ldr x8, [%1] \n\t" /* target->x8 */ \ + VALGRIND_BRANCH_AND_LINK_TO_NOREDIR_X8 \ + VALGRIND_RESTORE_STACK \ + "mov %0, x0" \ + : /*out*/ "=r" (_res) \ + : /*in*/ "0" (&_argvec[0]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS, "x21" \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_6W(lval, orig, arg1,arg2,arg3,arg4,arg5,arg6) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[7]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)(arg1); \ + _argvec[2] = (unsigned long)(arg2); \ + _argvec[3] = (unsigned long)(arg3); \ + _argvec[4] = (unsigned long)(arg4); \ + _argvec[5] = (unsigned long)(arg5); \ + _argvec[6] = (unsigned long)(arg6); \ + __asm__ volatile( \ + VALGRIND_ALIGN_STACK \ + "ldr x0, [%1, #8] \n\t" \ + "ldr x1, [%1, #16] \n\t" \ + "ldr x2, [%1, #24] \n\t" \ + "ldr x3, [%1, #32] \n\t" \ + "ldr x4, [%1, #40] \n\t" \ + "ldr x5, [%1, #48] \n\t" \ + "ldr x8, [%1] \n\t" /* target->x8 */ \ + VALGRIND_BRANCH_AND_LINK_TO_NOREDIR_X8 \ + VALGRIND_RESTORE_STACK \ + "mov %0, x0" \ + : /*out*/ "=r" (_res) \ + : /*in*/ "0" (&_argvec[0]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS, "x21" \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_7W(lval, orig, arg1,arg2,arg3,arg4,arg5,arg6, \ + arg7) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[8]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)(arg1); \ + _argvec[2] = (unsigned long)(arg2); \ + _argvec[3] = (unsigned long)(arg3); \ + _argvec[4] = (unsigned long)(arg4); \ + _argvec[5] = (unsigned long)(arg5); \ + _argvec[6] = (unsigned long)(arg6); \ + _argvec[7] = (unsigned long)(arg7); \ + __asm__ volatile( \ + VALGRIND_ALIGN_STACK \ + "ldr x0, [%1, #8] \n\t" \ + "ldr x1, [%1, #16] \n\t" \ + "ldr x2, [%1, #24] \n\t" \ + "ldr x3, [%1, #32] \n\t" \ + "ldr x4, [%1, #40] \n\t" \ + "ldr x5, [%1, #48] \n\t" \ + "ldr x6, [%1, #56] \n\t" \ + "ldr x8, [%1] \n\t" /* target->x8 */ \ + VALGRIND_BRANCH_AND_LINK_TO_NOREDIR_X8 \ + VALGRIND_RESTORE_STACK \ + "mov %0, x0" \ + : /*out*/ "=r" (_res) \ + : /*in*/ "0" (&_argvec[0]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS, "x21" \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_8W(lval, orig, arg1,arg2,arg3,arg4,arg5,arg6, \ + arg7,arg8) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[9]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)(arg1); \ + _argvec[2] = (unsigned long)(arg2); \ + _argvec[3] = (unsigned long)(arg3); \ + _argvec[4] = (unsigned long)(arg4); \ + _argvec[5] = (unsigned long)(arg5); \ + _argvec[6] = (unsigned long)(arg6); \ + _argvec[7] = (unsigned long)(arg7); \ + _argvec[8] = (unsigned long)(arg8); \ + __asm__ volatile( \ + VALGRIND_ALIGN_STACK \ + "ldr x0, [%1, #8] \n\t" \ + "ldr x1, [%1, #16] \n\t" \ + "ldr x2, [%1, #24] \n\t" \ + "ldr x3, [%1, #32] \n\t" \ + "ldr x4, [%1, #40] \n\t" \ + "ldr x5, [%1, #48] \n\t" \ + "ldr x6, [%1, #56] \n\t" \ + "ldr x7, [%1, #64] \n\t" \ + "ldr x8, [%1] \n\t" /* target->x8 */ \ + VALGRIND_BRANCH_AND_LINK_TO_NOREDIR_X8 \ + VALGRIND_RESTORE_STACK \ + "mov %0, x0" \ + : /*out*/ "=r" (_res) \ + : /*in*/ "0" (&_argvec[0]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS, "x21" \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_9W(lval, orig, arg1,arg2,arg3,arg4,arg5,arg6, \ + arg7,arg8,arg9) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[10]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)(arg1); \ + _argvec[2] = (unsigned long)(arg2); \ + _argvec[3] = (unsigned long)(arg3); \ + _argvec[4] = (unsigned long)(arg4); \ + _argvec[5] = (unsigned long)(arg5); \ + _argvec[6] = (unsigned long)(arg6); \ + _argvec[7] = (unsigned long)(arg7); \ + _argvec[8] = (unsigned long)(arg8); \ + _argvec[9] = (unsigned long)(arg9); \ + __asm__ volatile( \ + VALGRIND_ALIGN_STACK \ + "sub sp, sp, #0x20 \n\t" \ + "ldr x0, [%1, #8] \n\t" \ + "ldr x1, [%1, #16] \n\t" \ + "ldr x2, [%1, #24] \n\t" \ + "ldr x3, [%1, #32] \n\t" \ + "ldr x4, [%1, #40] \n\t" \ + "ldr x5, [%1, #48] \n\t" \ + "ldr x6, [%1, #56] \n\t" \ + "ldr x7, [%1, #64] \n\t" \ + "ldr x8, [%1, #72] \n\t" \ + "str x8, [sp, #0] \n\t" \ + "ldr x8, [%1] \n\t" /* target->x8 */ \ + VALGRIND_BRANCH_AND_LINK_TO_NOREDIR_X8 \ + VALGRIND_RESTORE_STACK \ + "mov %0, x0" \ + : /*out*/ "=r" (_res) \ + : /*in*/ "0" (&_argvec[0]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS, "x21" \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_10W(lval, orig, arg1,arg2,arg3,arg4,arg5,arg6, \ + arg7,arg8,arg9,arg10) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[11]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)(arg1); \ + _argvec[2] = (unsigned long)(arg2); \ + _argvec[3] = (unsigned long)(arg3); \ + _argvec[4] = (unsigned long)(arg4); \ + _argvec[5] = (unsigned long)(arg5); \ + _argvec[6] = (unsigned long)(arg6); \ + _argvec[7] = (unsigned long)(arg7); \ + _argvec[8] = (unsigned long)(arg8); \ + _argvec[9] = (unsigned long)(arg9); \ + _argvec[10] = (unsigned long)(arg10); \ + __asm__ volatile( \ + VALGRIND_ALIGN_STACK \ + "sub sp, sp, #0x20 \n\t" \ + "ldr x0, [%1, #8] \n\t" \ + "ldr x1, [%1, #16] \n\t" \ + "ldr x2, [%1, #24] \n\t" \ + "ldr x3, [%1, #32] \n\t" \ + "ldr x4, [%1, #40] \n\t" \ + "ldr x5, [%1, #48] \n\t" \ + "ldr x6, [%1, #56] \n\t" \ + "ldr x7, [%1, #64] \n\t" \ + "ldr x8, [%1, #72] \n\t" \ + "str x8, [sp, #0] \n\t" \ + "ldr x8, [%1, #80] \n\t" \ + "str x8, [sp, #8] \n\t" \ + "ldr x8, [%1] \n\t" /* target->x8 */ \ + VALGRIND_BRANCH_AND_LINK_TO_NOREDIR_X8 \ + VALGRIND_RESTORE_STACK \ + "mov %0, x0" \ + : /*out*/ "=r" (_res) \ + : /*in*/ "0" (&_argvec[0]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS, "x21" \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_11W(lval, orig, arg1,arg2,arg3,arg4,arg5,arg6, \ + arg7,arg8,arg9,arg10,arg11) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[12]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)(arg1); \ + _argvec[2] = (unsigned long)(arg2); \ + _argvec[3] = (unsigned long)(arg3); \ + _argvec[4] = (unsigned long)(arg4); \ + _argvec[5] = (unsigned long)(arg5); \ + _argvec[6] = (unsigned long)(arg6); \ + _argvec[7] = (unsigned long)(arg7); \ + _argvec[8] = (unsigned long)(arg8); \ + _argvec[9] = (unsigned long)(arg9); \ + _argvec[10] = (unsigned long)(arg10); \ + _argvec[11] = (unsigned long)(arg11); \ + __asm__ volatile( \ + VALGRIND_ALIGN_STACK \ + "sub sp, sp, #0x30 \n\t" \ + "ldr x0, [%1, #8] \n\t" \ + "ldr x1, [%1, #16] \n\t" \ + "ldr x2, [%1, #24] \n\t" \ + "ldr x3, [%1, #32] \n\t" \ + "ldr x4, [%1, #40] \n\t" \ + "ldr x5, [%1, #48] \n\t" \ + "ldr x6, [%1, #56] \n\t" \ + "ldr x7, [%1, #64] \n\t" \ + "ldr x8, [%1, #72] \n\t" \ + "str x8, [sp, #0] \n\t" \ + "ldr x8, [%1, #80] \n\t" \ + "str x8, [sp, #8] \n\t" \ + "ldr x8, [%1, #88] \n\t" \ + "str x8, [sp, #16] \n\t" \ + "ldr x8, [%1] \n\t" /* target->x8 */ \ + VALGRIND_BRANCH_AND_LINK_TO_NOREDIR_X8 \ + VALGRIND_RESTORE_STACK \ + "mov %0, x0" \ + : /*out*/ "=r" (_res) \ + : /*in*/ "0" (&_argvec[0]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS, "x21" \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_12W(lval, orig, arg1,arg2,arg3,arg4,arg5,arg6, \ + arg7,arg8,arg9,arg10,arg11, \ + arg12) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[13]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)(arg1); \ + _argvec[2] = (unsigned long)(arg2); \ + _argvec[3] = (unsigned long)(arg3); \ + _argvec[4] = (unsigned long)(arg4); \ + _argvec[5] = (unsigned long)(arg5); \ + _argvec[6] = (unsigned long)(arg6); \ + _argvec[7] = (unsigned long)(arg7); \ + _argvec[8] = (unsigned long)(arg8); \ + _argvec[9] = (unsigned long)(arg9); \ + _argvec[10] = (unsigned long)(arg10); \ + _argvec[11] = (unsigned long)(arg11); \ + _argvec[12] = (unsigned long)(arg12); \ + __asm__ volatile( \ + VALGRIND_ALIGN_STACK \ + "sub sp, sp, #0x30 \n\t" \ + "ldr x0, [%1, #8] \n\t" \ + "ldr x1, [%1, #16] \n\t" \ + "ldr x2, [%1, #24] \n\t" \ + "ldr x3, [%1, #32] \n\t" \ + "ldr x4, [%1, #40] \n\t" \ + "ldr x5, [%1, #48] \n\t" \ + "ldr x6, [%1, #56] \n\t" \ + "ldr x7, [%1, #64] \n\t" \ + "ldr x8, [%1, #72] \n\t" \ + "str x8, [sp, #0] \n\t" \ + "ldr x8, [%1, #80] \n\t" \ + "str x8, [sp, #8] \n\t" \ + "ldr x8, [%1, #88] \n\t" \ + "str x8, [sp, #16] \n\t" \ + "ldr x8, [%1, #96] \n\t" \ + "str x8, [sp, #24] \n\t" \ + "ldr x8, [%1] \n\t" /* target->x8 */ \ + VALGRIND_BRANCH_AND_LINK_TO_NOREDIR_X8 \ + VALGRIND_RESTORE_STACK \ + "mov %0, x0" \ + : /*out*/ "=r" (_res) \ + : /*in*/ "0" (&_argvec[0]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS, "x21" \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#endif /* PLAT_arm64_linux */ + +/* ------------------------- s390x-linux ------------------------- */ + +#if defined(PLAT_s390x_linux) + +/* Similar workaround as amd64 (see above), but we use r11 as frame + pointer and save the old r11 in r7. r11 might be used for + argvec, therefore we copy argvec in r1 since r1 is clobbered + after the call anyway. */ +#if defined(__GNUC__) && defined(__GCC_HAVE_DWARF2_CFI_ASM) +# define __FRAME_POINTER \ + ,"d"(__builtin_dwarf_cfa()) +# define VALGRIND_CFI_PROLOGUE \ + ".cfi_remember_state\n\t" \ + "lgr 1,%1\n\t" /* copy the argvec pointer in r1 */ \ + "lgr 7,11\n\t" \ + "lgr 11,%2\n\t" \ + ".cfi_def_cfa r11, 0\n\t" +# define VALGRIND_CFI_EPILOGUE \ + "lgr 11, 7\n\t" \ + ".cfi_restore_state\n\t" +#else +# define __FRAME_POINTER +# define VALGRIND_CFI_PROLOGUE \ + "lgr 1,%1\n\t" +# define VALGRIND_CFI_EPILOGUE +#endif + +/* Nb: On s390 the stack pointer is properly aligned *at all times* + according to the s390 GCC maintainer. (The ABI specification is not + precise in this regard.) Therefore, VALGRIND_ALIGN_STACK and + VALGRIND_RESTORE_STACK are not defined here. */ + +/* These regs are trashed by the hidden call. Note that we overwrite + r14 in s390_irgen_noredir (VEX/priv/guest_s390_irgen.c) to give the + function a proper return address. All others are ABI defined call + clobbers. */ +#define __CALLER_SAVED_REGS "0","1","2","3","4","5","14", \ + "f0","f1","f2","f3","f4","f5","f6","f7" + +/* Nb: Although r11 is modified in the asm snippets below (inside + VALGRIND_CFI_PROLOGUE) it is not listed in the clobber section, for + two reasons: + (1) r11 is restored in VALGRIND_CFI_EPILOGUE, so effectively it is not + modified + (2) GCC will complain that r11 cannot appear inside a clobber section, + when compiled with -O -fno-omit-frame-pointer + */ + +#define CALL_FN_W_v(lval, orig) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[1]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + __asm__ volatile( \ + VALGRIND_CFI_PROLOGUE \ + "aghi 15,-160\n\t" \ + "lg 1, 0(1)\n\t" /* target->r1 */ \ + VALGRIND_CALL_NOREDIR_R1 \ + "lgr %0, 2\n\t" \ + "aghi 15,160\n\t" \ + VALGRIND_CFI_EPILOGUE \ + : /*out*/ "=d" (_res) \ + : /*in*/ "d" (&_argvec[0]) __FRAME_POINTER \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS,"7" \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +/* The call abi has the arguments in r2-r6 and stack */ +#define CALL_FN_W_W(lval, orig, arg1) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[2]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)arg1; \ + __asm__ volatile( \ + VALGRIND_CFI_PROLOGUE \ + "aghi 15,-160\n\t" \ + "lg 2, 8(1)\n\t" \ + "lg 1, 0(1)\n\t" \ + VALGRIND_CALL_NOREDIR_R1 \ + "lgr %0, 2\n\t" \ + "aghi 15,160\n\t" \ + VALGRIND_CFI_EPILOGUE \ + : /*out*/ "=d" (_res) \ + : /*in*/ "a" (&_argvec[0]) __FRAME_POINTER \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS,"7" \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_WW(lval, orig, arg1, arg2) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[3]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)arg1; \ + _argvec[2] = (unsigned long)arg2; \ + __asm__ volatile( \ + VALGRIND_CFI_PROLOGUE \ + "aghi 15,-160\n\t" \ + "lg 2, 8(1)\n\t" \ + "lg 3,16(1)\n\t" \ + "lg 1, 0(1)\n\t" \ + VALGRIND_CALL_NOREDIR_R1 \ + "lgr %0, 2\n\t" \ + "aghi 15,160\n\t" \ + VALGRIND_CFI_EPILOGUE \ + : /*out*/ "=d" (_res) \ + : /*in*/ "a" (&_argvec[0]) __FRAME_POINTER \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS,"7" \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_WWW(lval, orig, arg1, arg2, arg3) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[4]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)arg1; \ + _argvec[2] = (unsigned long)arg2; \ + _argvec[3] = (unsigned long)arg3; \ + __asm__ volatile( \ + VALGRIND_CFI_PROLOGUE \ + "aghi 15,-160\n\t" \ + "lg 2, 8(1)\n\t" \ + "lg 3,16(1)\n\t" \ + "lg 4,24(1)\n\t" \ + "lg 1, 0(1)\n\t" \ + VALGRIND_CALL_NOREDIR_R1 \ + "lgr %0, 2\n\t" \ + "aghi 15,160\n\t" \ + VALGRIND_CFI_EPILOGUE \ + : /*out*/ "=d" (_res) \ + : /*in*/ "a" (&_argvec[0]) __FRAME_POINTER \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS,"7" \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_WWWW(lval, orig, arg1, arg2, arg3, arg4) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[5]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)arg1; \ + _argvec[2] = (unsigned long)arg2; \ + _argvec[3] = (unsigned long)arg3; \ + _argvec[4] = (unsigned long)arg4; \ + __asm__ volatile( \ + VALGRIND_CFI_PROLOGUE \ + "aghi 15,-160\n\t" \ + "lg 2, 8(1)\n\t" \ + "lg 3,16(1)\n\t" \ + "lg 4,24(1)\n\t" \ + "lg 5,32(1)\n\t" \ + "lg 1, 0(1)\n\t" \ + VALGRIND_CALL_NOREDIR_R1 \ + "lgr %0, 2\n\t" \ + "aghi 15,160\n\t" \ + VALGRIND_CFI_EPILOGUE \ + : /*out*/ "=d" (_res) \ + : /*in*/ "a" (&_argvec[0]) __FRAME_POINTER \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS,"7" \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_5W(lval, orig, arg1, arg2, arg3, arg4, arg5) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[6]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)arg1; \ + _argvec[2] = (unsigned long)arg2; \ + _argvec[3] = (unsigned long)arg3; \ + _argvec[4] = (unsigned long)arg4; \ + _argvec[5] = (unsigned long)arg5; \ + __asm__ volatile( \ + VALGRIND_CFI_PROLOGUE \ + "aghi 15,-160\n\t" \ + "lg 2, 8(1)\n\t" \ + "lg 3,16(1)\n\t" \ + "lg 4,24(1)\n\t" \ + "lg 5,32(1)\n\t" \ + "lg 6,40(1)\n\t" \ + "lg 1, 0(1)\n\t" \ + VALGRIND_CALL_NOREDIR_R1 \ + "lgr %0, 2\n\t" \ + "aghi 15,160\n\t" \ + VALGRIND_CFI_EPILOGUE \ + : /*out*/ "=d" (_res) \ + : /*in*/ "a" (&_argvec[0]) __FRAME_POINTER \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS,"6","7" \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_6W(lval, orig, arg1, arg2, arg3, arg4, arg5, \ + arg6) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[7]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)arg1; \ + _argvec[2] = (unsigned long)arg2; \ + _argvec[3] = (unsigned long)arg3; \ + _argvec[4] = (unsigned long)arg4; \ + _argvec[5] = (unsigned long)arg5; \ + _argvec[6] = (unsigned long)arg6; \ + __asm__ volatile( \ + VALGRIND_CFI_PROLOGUE \ + "aghi 15,-168\n\t" \ + "lg 2, 8(1)\n\t" \ + "lg 3,16(1)\n\t" \ + "lg 4,24(1)\n\t" \ + "lg 5,32(1)\n\t" \ + "lg 6,40(1)\n\t" \ + "mvc 160(8,15), 48(1)\n\t" \ + "lg 1, 0(1)\n\t" \ + VALGRIND_CALL_NOREDIR_R1 \ + "lgr %0, 2\n\t" \ + "aghi 15,168\n\t" \ + VALGRIND_CFI_EPILOGUE \ + : /*out*/ "=d" (_res) \ + : /*in*/ "a" (&_argvec[0]) __FRAME_POINTER \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS,"6","7" \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_7W(lval, orig, arg1, arg2, arg3, arg4, arg5, \ + arg6, arg7) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[8]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)arg1; \ + _argvec[2] = (unsigned long)arg2; \ + _argvec[3] = (unsigned long)arg3; \ + _argvec[4] = (unsigned long)arg4; \ + _argvec[5] = (unsigned long)arg5; \ + _argvec[6] = (unsigned long)arg6; \ + _argvec[7] = (unsigned long)arg7; \ + __asm__ volatile( \ + VALGRIND_CFI_PROLOGUE \ + "aghi 15,-176\n\t" \ + "lg 2, 8(1)\n\t" \ + "lg 3,16(1)\n\t" \ + "lg 4,24(1)\n\t" \ + "lg 5,32(1)\n\t" \ + "lg 6,40(1)\n\t" \ + "mvc 160(8,15), 48(1)\n\t" \ + "mvc 168(8,15), 56(1)\n\t" \ + "lg 1, 0(1)\n\t" \ + VALGRIND_CALL_NOREDIR_R1 \ + "lgr %0, 2\n\t" \ + "aghi 15,176\n\t" \ + VALGRIND_CFI_EPILOGUE \ + : /*out*/ "=d" (_res) \ + : /*in*/ "a" (&_argvec[0]) __FRAME_POINTER \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS,"6","7" \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_8W(lval, orig, arg1, arg2, arg3, arg4, arg5, \ + arg6, arg7 ,arg8) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[9]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)arg1; \ + _argvec[2] = (unsigned long)arg2; \ + _argvec[3] = (unsigned long)arg3; \ + _argvec[4] = (unsigned long)arg4; \ + _argvec[5] = (unsigned long)arg5; \ + _argvec[6] = (unsigned long)arg6; \ + _argvec[7] = (unsigned long)arg7; \ + _argvec[8] = (unsigned long)arg8; \ + __asm__ volatile( \ + VALGRIND_CFI_PROLOGUE \ + "aghi 15,-184\n\t" \ + "lg 2, 8(1)\n\t" \ + "lg 3,16(1)\n\t" \ + "lg 4,24(1)\n\t" \ + "lg 5,32(1)\n\t" \ + "lg 6,40(1)\n\t" \ + "mvc 160(8,15), 48(1)\n\t" \ + "mvc 168(8,15), 56(1)\n\t" \ + "mvc 176(8,15), 64(1)\n\t" \ + "lg 1, 0(1)\n\t" \ + VALGRIND_CALL_NOREDIR_R1 \ + "lgr %0, 2\n\t" \ + "aghi 15,184\n\t" \ + VALGRIND_CFI_EPILOGUE \ + : /*out*/ "=d" (_res) \ + : /*in*/ "a" (&_argvec[0]) __FRAME_POINTER \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS,"6","7" \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_9W(lval, orig, arg1, arg2, arg3, arg4, arg5, \ + arg6, arg7 ,arg8, arg9) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[10]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)arg1; \ + _argvec[2] = (unsigned long)arg2; \ + _argvec[3] = (unsigned long)arg3; \ + _argvec[4] = (unsigned long)arg4; \ + _argvec[5] = (unsigned long)arg5; \ + _argvec[6] = (unsigned long)arg6; \ + _argvec[7] = (unsigned long)arg7; \ + _argvec[8] = (unsigned long)arg8; \ + _argvec[9] = (unsigned long)arg9; \ + __asm__ volatile( \ + VALGRIND_CFI_PROLOGUE \ + "aghi 15,-192\n\t" \ + "lg 2, 8(1)\n\t" \ + "lg 3,16(1)\n\t" \ + "lg 4,24(1)\n\t" \ + "lg 5,32(1)\n\t" \ + "lg 6,40(1)\n\t" \ + "mvc 160(8,15), 48(1)\n\t" \ + "mvc 168(8,15), 56(1)\n\t" \ + "mvc 176(8,15), 64(1)\n\t" \ + "mvc 184(8,15), 72(1)\n\t" \ + "lg 1, 0(1)\n\t" \ + VALGRIND_CALL_NOREDIR_R1 \ + "lgr %0, 2\n\t" \ + "aghi 15,192\n\t" \ + VALGRIND_CFI_EPILOGUE \ + : /*out*/ "=d" (_res) \ + : /*in*/ "a" (&_argvec[0]) __FRAME_POINTER \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS,"6","7" \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_10W(lval, orig, arg1, arg2, arg3, arg4, arg5, \ + arg6, arg7 ,arg8, arg9, arg10) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[11]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)arg1; \ + _argvec[2] = (unsigned long)arg2; \ + _argvec[3] = (unsigned long)arg3; \ + _argvec[4] = (unsigned long)arg4; \ + _argvec[5] = (unsigned long)arg5; \ + _argvec[6] = (unsigned long)arg6; \ + _argvec[7] = (unsigned long)arg7; \ + _argvec[8] = (unsigned long)arg8; \ + _argvec[9] = (unsigned long)arg9; \ + _argvec[10] = (unsigned long)arg10; \ + __asm__ volatile( \ + VALGRIND_CFI_PROLOGUE \ + "aghi 15,-200\n\t" \ + "lg 2, 8(1)\n\t" \ + "lg 3,16(1)\n\t" \ + "lg 4,24(1)\n\t" \ + "lg 5,32(1)\n\t" \ + "lg 6,40(1)\n\t" \ + "mvc 160(8,15), 48(1)\n\t" \ + "mvc 168(8,15), 56(1)\n\t" \ + "mvc 176(8,15), 64(1)\n\t" \ + "mvc 184(8,15), 72(1)\n\t" \ + "mvc 192(8,15), 80(1)\n\t" \ + "lg 1, 0(1)\n\t" \ + VALGRIND_CALL_NOREDIR_R1 \ + "lgr %0, 2\n\t" \ + "aghi 15,200\n\t" \ + VALGRIND_CFI_EPILOGUE \ + : /*out*/ "=d" (_res) \ + : /*in*/ "a" (&_argvec[0]) __FRAME_POINTER \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS,"6","7" \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_11W(lval, orig, arg1, arg2, arg3, arg4, arg5, \ + arg6, arg7 ,arg8, arg9, arg10, arg11) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[12]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)arg1; \ + _argvec[2] = (unsigned long)arg2; \ + _argvec[3] = (unsigned long)arg3; \ + _argvec[4] = (unsigned long)arg4; \ + _argvec[5] = (unsigned long)arg5; \ + _argvec[6] = (unsigned long)arg6; \ + _argvec[7] = (unsigned long)arg7; \ + _argvec[8] = (unsigned long)arg8; \ + _argvec[9] = (unsigned long)arg9; \ + _argvec[10] = (unsigned long)arg10; \ + _argvec[11] = (unsigned long)arg11; \ + __asm__ volatile( \ + VALGRIND_CFI_PROLOGUE \ + "aghi 15,-208\n\t" \ + "lg 2, 8(1)\n\t" \ + "lg 3,16(1)\n\t" \ + "lg 4,24(1)\n\t" \ + "lg 5,32(1)\n\t" \ + "lg 6,40(1)\n\t" \ + "mvc 160(8,15), 48(1)\n\t" \ + "mvc 168(8,15), 56(1)\n\t" \ + "mvc 176(8,15), 64(1)\n\t" \ + "mvc 184(8,15), 72(1)\n\t" \ + "mvc 192(8,15), 80(1)\n\t" \ + "mvc 200(8,15), 88(1)\n\t" \ + "lg 1, 0(1)\n\t" \ + VALGRIND_CALL_NOREDIR_R1 \ + "lgr %0, 2\n\t" \ + "aghi 15,208\n\t" \ + VALGRIND_CFI_EPILOGUE \ + : /*out*/ "=d" (_res) \ + : /*in*/ "a" (&_argvec[0]) __FRAME_POINTER \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS,"6","7" \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_12W(lval, orig, arg1, arg2, arg3, arg4, arg5, \ + arg6, arg7 ,arg8, arg9, arg10, arg11, arg12)\ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[13]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)arg1; \ + _argvec[2] = (unsigned long)arg2; \ + _argvec[3] = (unsigned long)arg3; \ + _argvec[4] = (unsigned long)arg4; \ + _argvec[5] = (unsigned long)arg5; \ + _argvec[6] = (unsigned long)arg6; \ + _argvec[7] = (unsigned long)arg7; \ + _argvec[8] = (unsigned long)arg8; \ + _argvec[9] = (unsigned long)arg9; \ + _argvec[10] = (unsigned long)arg10; \ + _argvec[11] = (unsigned long)arg11; \ + _argvec[12] = (unsigned long)arg12; \ + __asm__ volatile( \ + VALGRIND_CFI_PROLOGUE \ + "aghi 15,-216\n\t" \ + "lg 2, 8(1)\n\t" \ + "lg 3,16(1)\n\t" \ + "lg 4,24(1)\n\t" \ + "lg 5,32(1)\n\t" \ + "lg 6,40(1)\n\t" \ + "mvc 160(8,15), 48(1)\n\t" \ + "mvc 168(8,15), 56(1)\n\t" \ + "mvc 176(8,15), 64(1)\n\t" \ + "mvc 184(8,15), 72(1)\n\t" \ + "mvc 192(8,15), 80(1)\n\t" \ + "mvc 200(8,15), 88(1)\n\t" \ + "mvc 208(8,15), 96(1)\n\t" \ + "lg 1, 0(1)\n\t" \ + VALGRIND_CALL_NOREDIR_R1 \ + "lgr %0, 2\n\t" \ + "aghi 15,216\n\t" \ + VALGRIND_CFI_EPILOGUE \ + : /*out*/ "=d" (_res) \ + : /*in*/ "a" (&_argvec[0]) __FRAME_POINTER \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS,"6","7" \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + + +#endif /* PLAT_s390x_linux */ + +/* ------------------------- mips32-linux ----------------------- */ + +#if defined(PLAT_mips32_linux) + +/* These regs are trashed by the hidden call. */ +#define __CALLER_SAVED_REGS "$2", "$3", "$4", "$5", "$6", \ +"$7", "$8", "$9", "$10", "$11", "$12", "$13", "$14", "$15", "$24", \ +"$25", "$31" + +/* These CALL_FN_ macros assume that on mips-linux, sizeof(unsigned + long) == 4. */ + +#define CALL_FN_W_v(lval, orig) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[1]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + __asm__ volatile( \ + "subu $29, $29, 8 \n\t" \ + "sw $28, 0($29) \n\t" \ + "sw $31, 4($29) \n\t" \ + "subu $29, $29, 16 \n\t" \ + "lw $25, 0(%1) \n\t" /* target->t9 */ \ + VALGRIND_CALL_NOREDIR_T9 \ + "addu $29, $29, 16\n\t" \ + "lw $28, 0($29) \n\t" \ + "lw $31, 4($29) \n\t" \ + "addu $29, $29, 8 \n\t" \ + "move %0, $2\n" \ + : /*out*/ "=r" (_res) \ + : /*in*/ "0" (&_argvec[0]) \ + : /*trash*/ "memory", __CALLER_SAVED_REGS \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_W(lval, orig, arg1) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[2]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)(arg1); \ + __asm__ volatile( \ + "subu $29, $29, 8 \n\t" \ + "sw $28, 0($29) \n\t" \ + "sw $31, 4($29) \n\t" \ + "subu $29, $29, 16 \n\t" \ + "lw $4, 4(%1) \n\t" /* arg1*/ \ + "lw $25, 0(%1) \n\t" /* target->t9 */ \ + VALGRIND_CALL_NOREDIR_T9 \ + "addu $29, $29, 16 \n\t" \ + "lw $28, 0($29) \n\t" \ + "lw $31, 4($29) \n\t" \ + "addu $29, $29, 8 \n\t" \ + "move %0, $2\n" \ + : /*out*/ "=r" (_res) \ + : /*in*/ "0" (&_argvec[0]) \ + : /*trash*/ "memory", __CALLER_SAVED_REGS \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_WW(lval, orig, arg1,arg2) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[3]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)(arg1); \ + _argvec[2] = (unsigned long)(arg2); \ + __asm__ volatile( \ + "subu $29, $29, 8 \n\t" \ + "sw $28, 0($29) \n\t" \ + "sw $31, 4($29) \n\t" \ + "subu $29, $29, 16 \n\t" \ + "lw $4, 4(%1) \n\t" \ + "lw $5, 8(%1) \n\t" \ + "lw $25, 0(%1) \n\t" /* target->t9 */ \ + VALGRIND_CALL_NOREDIR_T9 \ + "addu $29, $29, 16 \n\t" \ + "lw $28, 0($29) \n\t" \ + "lw $31, 4($29) \n\t" \ + "addu $29, $29, 8 \n\t" \ + "move %0, $2\n" \ + : /*out*/ "=r" (_res) \ + : /*in*/ "0" (&_argvec[0]) \ + : /*trash*/ "memory", __CALLER_SAVED_REGS \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_WWW(lval, orig, arg1,arg2,arg3) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[4]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)(arg1); \ + _argvec[2] = (unsigned long)(arg2); \ + _argvec[3] = (unsigned long)(arg3); \ + __asm__ volatile( \ + "subu $29, $29, 8 \n\t" \ + "sw $28, 0($29) \n\t" \ + "sw $31, 4($29) \n\t" \ + "subu $29, $29, 16 \n\t" \ + "lw $4, 4(%1) \n\t" \ + "lw $5, 8(%1) \n\t" \ + "lw $6, 12(%1) \n\t" \ + "lw $25, 0(%1) \n\t" /* target->t9 */ \ + VALGRIND_CALL_NOREDIR_T9 \ + "addu $29, $29, 16 \n\t" \ + "lw $28, 0($29) \n\t" \ + "lw $31, 4($29) \n\t" \ + "addu $29, $29, 8 \n\t" \ + "move %0, $2\n" \ + : /*out*/ "=r" (_res) \ + : /*in*/ "0" (&_argvec[0]) \ + : /*trash*/ "memory", __CALLER_SAVED_REGS \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_WWWW(lval, orig, arg1,arg2,arg3,arg4) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[5]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)(arg1); \ + _argvec[2] = (unsigned long)(arg2); \ + _argvec[3] = (unsigned long)(arg3); \ + _argvec[4] = (unsigned long)(arg4); \ + __asm__ volatile( \ + "subu $29, $29, 8 \n\t" \ + "sw $28, 0($29) \n\t" \ + "sw $31, 4($29) \n\t" \ + "subu $29, $29, 16 \n\t" \ + "lw $4, 4(%1) \n\t" \ + "lw $5, 8(%1) \n\t" \ + "lw $6, 12(%1) \n\t" \ + "lw $7, 16(%1) \n\t" \ + "lw $25, 0(%1) \n\t" /* target->t9 */ \ + VALGRIND_CALL_NOREDIR_T9 \ + "addu $29, $29, 16 \n\t" \ + "lw $28, 0($29) \n\t" \ + "lw $31, 4($29) \n\t" \ + "addu $29, $29, 8 \n\t" \ + "move %0, $2\n" \ + : /*out*/ "=r" (_res) \ + : /*in*/ "0" (&_argvec[0]) \ + : /*trash*/ "memory", __CALLER_SAVED_REGS \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_5W(lval, orig, arg1,arg2,arg3,arg4,arg5) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[6]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)(arg1); \ + _argvec[2] = (unsigned long)(arg2); \ + _argvec[3] = (unsigned long)(arg3); \ + _argvec[4] = (unsigned long)(arg4); \ + _argvec[5] = (unsigned long)(arg5); \ + __asm__ volatile( \ + "subu $29, $29, 8 \n\t" \ + "sw $28, 0($29) \n\t" \ + "sw $31, 4($29) \n\t" \ + "lw $4, 20(%1) \n\t" \ + "subu $29, $29, 24\n\t" \ + "sw $4, 16($29) \n\t" \ + "lw $4, 4(%1) \n\t" \ + "lw $5, 8(%1) \n\t" \ + "lw $6, 12(%1) \n\t" \ + "lw $7, 16(%1) \n\t" \ + "lw $25, 0(%1) \n\t" /* target->t9 */ \ + VALGRIND_CALL_NOREDIR_T9 \ + "addu $29, $29, 24 \n\t" \ + "lw $28, 0($29) \n\t" \ + "lw $31, 4($29) \n\t" \ + "addu $29, $29, 8 \n\t" \ + "move %0, $2\n" \ + : /*out*/ "=r" (_res) \ + : /*in*/ "0" (&_argvec[0]) \ + : /*trash*/ "memory", __CALLER_SAVED_REGS \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) +#define CALL_FN_W_6W(lval, orig, arg1,arg2,arg3,arg4,arg5,arg6) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[7]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)(arg1); \ + _argvec[2] = (unsigned long)(arg2); \ + _argvec[3] = (unsigned long)(arg3); \ + _argvec[4] = (unsigned long)(arg4); \ + _argvec[5] = (unsigned long)(arg5); \ + _argvec[6] = (unsigned long)(arg6); \ + __asm__ volatile( \ + "subu $29, $29, 8 \n\t" \ + "sw $28, 0($29) \n\t" \ + "sw $31, 4($29) \n\t" \ + "lw $4, 20(%1) \n\t" \ + "subu $29, $29, 32\n\t" \ + "sw $4, 16($29) \n\t" \ + "lw $4, 24(%1) \n\t" \ + "nop\n\t" \ + "sw $4, 20($29) \n\t" \ + "lw $4, 4(%1) \n\t" \ + "lw $5, 8(%1) \n\t" \ + "lw $6, 12(%1) \n\t" \ + "lw $7, 16(%1) \n\t" \ + "lw $25, 0(%1) \n\t" /* target->t9 */ \ + VALGRIND_CALL_NOREDIR_T9 \ + "addu $29, $29, 32 \n\t" \ + "lw $28, 0($29) \n\t" \ + "lw $31, 4($29) \n\t" \ + "addu $29, $29, 8 \n\t" \ + "move %0, $2\n" \ + : /*out*/ "=r" (_res) \ + : /*in*/ "0" (&_argvec[0]) \ + : /*trash*/ "memory", __CALLER_SAVED_REGS \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_7W(lval, orig, arg1,arg2,arg3,arg4,arg5,arg6, \ + arg7) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[8]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)(arg1); \ + _argvec[2] = (unsigned long)(arg2); \ + _argvec[3] = (unsigned long)(arg3); \ + _argvec[4] = (unsigned long)(arg4); \ + _argvec[5] = (unsigned long)(arg5); \ + _argvec[6] = (unsigned long)(arg6); \ + _argvec[7] = (unsigned long)(arg7); \ + __asm__ volatile( \ + "subu $29, $29, 8 \n\t" \ + "sw $28, 0($29) \n\t" \ + "sw $31, 4($29) \n\t" \ + "lw $4, 20(%1) \n\t" \ + "subu $29, $29, 32\n\t" \ + "sw $4, 16($29) \n\t" \ + "lw $4, 24(%1) \n\t" \ + "sw $4, 20($29) \n\t" \ + "lw $4, 28(%1) \n\t" \ + "sw $4, 24($29) \n\t" \ + "lw $4, 4(%1) \n\t" \ + "lw $5, 8(%1) \n\t" \ + "lw $6, 12(%1) \n\t" \ + "lw $7, 16(%1) \n\t" \ + "lw $25, 0(%1) \n\t" /* target->t9 */ \ + VALGRIND_CALL_NOREDIR_T9 \ + "addu $29, $29, 32 \n\t" \ + "lw $28, 0($29) \n\t" \ + "lw $31, 4($29) \n\t" \ + "addu $29, $29, 8 \n\t" \ + "move %0, $2\n" \ + : /*out*/ "=r" (_res) \ + : /*in*/ "0" (&_argvec[0]) \ + : /*trash*/ "memory", __CALLER_SAVED_REGS \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_8W(lval, orig, arg1,arg2,arg3,arg4,arg5,arg6, \ + arg7,arg8) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[9]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)(arg1); \ + _argvec[2] = (unsigned long)(arg2); \ + _argvec[3] = (unsigned long)(arg3); \ + _argvec[4] = (unsigned long)(arg4); \ + _argvec[5] = (unsigned long)(arg5); \ + _argvec[6] = (unsigned long)(arg6); \ + _argvec[7] = (unsigned long)(arg7); \ + _argvec[8] = (unsigned long)(arg8); \ + __asm__ volatile( \ + "subu $29, $29, 8 \n\t" \ + "sw $28, 0($29) \n\t" \ + "sw $31, 4($29) \n\t" \ + "lw $4, 20(%1) \n\t" \ + "subu $29, $29, 40\n\t" \ + "sw $4, 16($29) \n\t" \ + "lw $4, 24(%1) \n\t" \ + "sw $4, 20($29) \n\t" \ + "lw $4, 28(%1) \n\t" \ + "sw $4, 24($29) \n\t" \ + "lw $4, 32(%1) \n\t" \ + "sw $4, 28($29) \n\t" \ + "lw $4, 4(%1) \n\t" \ + "lw $5, 8(%1) \n\t" \ + "lw $6, 12(%1) \n\t" \ + "lw $7, 16(%1) \n\t" \ + "lw $25, 0(%1) \n\t" /* target->t9 */ \ + VALGRIND_CALL_NOREDIR_T9 \ + "addu $29, $29, 40 \n\t" \ + "lw $28, 0($29) \n\t" \ + "lw $31, 4($29) \n\t" \ + "addu $29, $29, 8 \n\t" \ + "move %0, $2\n" \ + : /*out*/ "=r" (_res) \ + : /*in*/ "0" (&_argvec[0]) \ + : /*trash*/ "memory", __CALLER_SAVED_REGS \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_9W(lval, orig, arg1,arg2,arg3,arg4,arg5,arg6, \ + arg7,arg8,arg9) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[10]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)(arg1); \ + _argvec[2] = (unsigned long)(arg2); \ + _argvec[3] = (unsigned long)(arg3); \ + _argvec[4] = (unsigned long)(arg4); \ + _argvec[5] = (unsigned long)(arg5); \ + _argvec[6] = (unsigned long)(arg6); \ + _argvec[7] = (unsigned long)(arg7); \ + _argvec[8] = (unsigned long)(arg8); \ + _argvec[9] = (unsigned long)(arg9); \ + __asm__ volatile( \ + "subu $29, $29, 8 \n\t" \ + "sw $28, 0($29) \n\t" \ + "sw $31, 4($29) \n\t" \ + "lw $4, 20(%1) \n\t" \ + "subu $29, $29, 40\n\t" \ + "sw $4, 16($29) \n\t" \ + "lw $4, 24(%1) \n\t" \ + "sw $4, 20($29) \n\t" \ + "lw $4, 28(%1) \n\t" \ + "sw $4, 24($29) \n\t" \ + "lw $4, 32(%1) \n\t" \ + "sw $4, 28($29) \n\t" \ + "lw $4, 36(%1) \n\t" \ + "sw $4, 32($29) \n\t" \ + "lw $4, 4(%1) \n\t" \ + "lw $5, 8(%1) \n\t" \ + "lw $6, 12(%1) \n\t" \ + "lw $7, 16(%1) \n\t" \ + "lw $25, 0(%1) \n\t" /* target->t9 */ \ + VALGRIND_CALL_NOREDIR_T9 \ + "addu $29, $29, 40 \n\t" \ + "lw $28, 0($29) \n\t" \ + "lw $31, 4($29) \n\t" \ + "addu $29, $29, 8 \n\t" \ + "move %0, $2\n" \ + : /*out*/ "=r" (_res) \ + : /*in*/ "0" (&_argvec[0]) \ + : /*trash*/ "memory", __CALLER_SAVED_REGS \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_10W(lval, orig, arg1,arg2,arg3,arg4,arg5,arg6, \ + arg7,arg8,arg9,arg10) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[11]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)(arg1); \ + _argvec[2] = (unsigned long)(arg2); \ + _argvec[3] = (unsigned long)(arg3); \ + _argvec[4] = (unsigned long)(arg4); \ + _argvec[5] = (unsigned long)(arg5); \ + _argvec[6] = (unsigned long)(arg6); \ + _argvec[7] = (unsigned long)(arg7); \ + _argvec[8] = (unsigned long)(arg8); \ + _argvec[9] = (unsigned long)(arg9); \ + _argvec[10] = (unsigned long)(arg10); \ + __asm__ volatile( \ + "subu $29, $29, 8 \n\t" \ + "sw $28, 0($29) \n\t" \ + "sw $31, 4($29) \n\t" \ + "lw $4, 20(%1) \n\t" \ + "subu $29, $29, 48\n\t" \ + "sw $4, 16($29) \n\t" \ + "lw $4, 24(%1) \n\t" \ + "sw $4, 20($29) \n\t" \ + "lw $4, 28(%1) \n\t" \ + "sw $4, 24($29) \n\t" \ + "lw $4, 32(%1) \n\t" \ + "sw $4, 28($29) \n\t" \ + "lw $4, 36(%1) \n\t" \ + "sw $4, 32($29) \n\t" \ + "lw $4, 40(%1) \n\t" \ + "sw $4, 36($29) \n\t" \ + "lw $4, 4(%1) \n\t" \ + "lw $5, 8(%1) \n\t" \ + "lw $6, 12(%1) \n\t" \ + "lw $7, 16(%1) \n\t" \ + "lw $25, 0(%1) \n\t" /* target->t9 */ \ + VALGRIND_CALL_NOREDIR_T9 \ + "addu $29, $29, 48 \n\t" \ + "lw $28, 0($29) \n\t" \ + "lw $31, 4($29) \n\t" \ + "addu $29, $29, 8 \n\t" \ + "move %0, $2\n" \ + : /*out*/ "=r" (_res) \ + : /*in*/ "0" (&_argvec[0]) \ + : /*trash*/ "memory", __CALLER_SAVED_REGS \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_11W(lval, orig, arg1,arg2,arg3,arg4,arg5, \ + arg6,arg7,arg8,arg9,arg10, \ + arg11) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[12]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)(arg1); \ + _argvec[2] = (unsigned long)(arg2); \ + _argvec[3] = (unsigned long)(arg3); \ + _argvec[4] = (unsigned long)(arg4); \ + _argvec[5] = (unsigned long)(arg5); \ + _argvec[6] = (unsigned long)(arg6); \ + _argvec[7] = (unsigned long)(arg7); \ + _argvec[8] = (unsigned long)(arg8); \ + _argvec[9] = (unsigned long)(arg9); \ + _argvec[10] = (unsigned long)(arg10); \ + _argvec[11] = (unsigned long)(arg11); \ + __asm__ volatile( \ + "subu $29, $29, 8 \n\t" \ + "sw $28, 0($29) \n\t" \ + "sw $31, 4($29) \n\t" \ + "lw $4, 20(%1) \n\t" \ + "subu $29, $29, 48\n\t" \ + "sw $4, 16($29) \n\t" \ + "lw $4, 24(%1) \n\t" \ + "sw $4, 20($29) \n\t" \ + "lw $4, 28(%1) \n\t" \ + "sw $4, 24($29) \n\t" \ + "lw $4, 32(%1) \n\t" \ + "sw $4, 28($29) \n\t" \ + "lw $4, 36(%1) \n\t" \ + "sw $4, 32($29) \n\t" \ + "lw $4, 40(%1) \n\t" \ + "sw $4, 36($29) \n\t" \ + "lw $4, 44(%1) \n\t" \ + "sw $4, 40($29) \n\t" \ + "lw $4, 4(%1) \n\t" \ + "lw $5, 8(%1) \n\t" \ + "lw $6, 12(%1) \n\t" \ + "lw $7, 16(%1) \n\t" \ + "lw $25, 0(%1) \n\t" /* target->t9 */ \ + VALGRIND_CALL_NOREDIR_T9 \ + "addu $29, $29, 48 \n\t" \ + "lw $28, 0($29) \n\t" \ + "lw $31, 4($29) \n\t" \ + "addu $29, $29, 8 \n\t" \ + "move %0, $2\n" \ + : /*out*/ "=r" (_res) \ + : /*in*/ "0" (&_argvec[0]) \ + : /*trash*/ "memory", __CALLER_SAVED_REGS \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_12W(lval, orig, arg1,arg2,arg3,arg4,arg5, \ + arg6,arg7,arg8,arg9,arg10, \ + arg11,arg12) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[13]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)(arg1); \ + _argvec[2] = (unsigned long)(arg2); \ + _argvec[3] = (unsigned long)(arg3); \ + _argvec[4] = (unsigned long)(arg4); \ + _argvec[5] = (unsigned long)(arg5); \ + _argvec[6] = (unsigned long)(arg6); \ + _argvec[7] = (unsigned long)(arg7); \ + _argvec[8] = (unsigned long)(arg8); \ + _argvec[9] = (unsigned long)(arg9); \ + _argvec[10] = (unsigned long)(arg10); \ + _argvec[11] = (unsigned long)(arg11); \ + _argvec[12] = (unsigned long)(arg12); \ + __asm__ volatile( \ + "subu $29, $29, 8 \n\t" \ + "sw $28, 0($29) \n\t" \ + "sw $31, 4($29) \n\t" \ + "lw $4, 20(%1) \n\t" \ + "subu $29, $29, 56\n\t" \ + "sw $4, 16($29) \n\t" \ + "lw $4, 24(%1) \n\t" \ + "sw $4, 20($29) \n\t" \ + "lw $4, 28(%1) \n\t" \ + "sw $4, 24($29) \n\t" \ + "lw $4, 32(%1) \n\t" \ + "sw $4, 28($29) \n\t" \ + "lw $4, 36(%1) \n\t" \ + "sw $4, 32($29) \n\t" \ + "lw $4, 40(%1) \n\t" \ + "sw $4, 36($29) \n\t" \ + "lw $4, 44(%1) \n\t" \ + "sw $4, 40($29) \n\t" \ + "lw $4, 48(%1) \n\t" \ + "sw $4, 44($29) \n\t" \ + "lw $4, 4(%1) \n\t" \ + "lw $5, 8(%1) \n\t" \ + "lw $6, 12(%1) \n\t" \ + "lw $7, 16(%1) \n\t" \ + "lw $25, 0(%1) \n\t" /* target->t9 */ \ + VALGRIND_CALL_NOREDIR_T9 \ + "addu $29, $29, 56 \n\t" \ + "lw $28, 0($29) \n\t" \ + "lw $31, 4($29) \n\t" \ + "addu $29, $29, 8 \n\t" \ + "move %0, $2\n" \ + : /*out*/ "=r" (_res) \ + : /*in*/ "r" (&_argvec[0]) \ + : /*trash*/ "memory", __CALLER_SAVED_REGS \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#endif /* PLAT_mips32_linux */ + +/* ------------------------- mips64-linux ------------------------- */ + +#if defined(PLAT_mips64_linux) + +/* These regs are trashed by the hidden call. */ +#define __CALLER_SAVED_REGS "$2", "$3", "$4", "$5", "$6", \ +"$7", "$8", "$9", "$10", "$11", "$12", "$13", "$14", "$15", "$24", \ +"$25", "$31" + +/* These CALL_FN_ macros assume that on mips-linux, sizeof(unsigned + long) == 4. */ + +#define CALL_FN_W_v(lval, orig) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[1]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + __asm__ volatile( \ + "ld $25, 0(%1)\n\t" /* target->t9 */ \ + VALGRIND_CALL_NOREDIR_T9 \ + "move %0, $2\n" \ + : /*out*/ "=r" (_res) \ + : /*in*/ "0" (&_argvec[0]) \ + : /*trash*/ "memory", __CALLER_SAVED_REGS \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_W(lval, orig, arg1) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[2]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)(arg1); \ + __asm__ volatile( \ + "ld $4, 8(%1)\n\t" /* arg1*/ \ + "ld $25, 0(%1)\n\t" /* target->t9 */ \ + VALGRIND_CALL_NOREDIR_T9 \ + "move %0, $2\n" \ + : /*out*/ "=r" (_res) \ + : /*in*/ "r" (&_argvec[0]) \ + : /*trash*/ "memory", __CALLER_SAVED_REGS \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_WW(lval, orig, arg1,arg2) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[3]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)(arg1); \ + _argvec[2] = (unsigned long)(arg2); \ + __asm__ volatile( \ + "ld $4, 8(%1)\n\t" \ + "ld $5, 16(%1)\n\t" \ + "ld $25, 0(%1)\n\t" /* target->t9 */ \ + VALGRIND_CALL_NOREDIR_T9 \ + "move %0, $2\n" \ + : /*out*/ "=r" (_res) \ + : /*in*/ "r" (&_argvec[0]) \ + : /*trash*/ "memory", __CALLER_SAVED_REGS \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_WWW(lval, orig, arg1,arg2,arg3) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[4]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)(arg1); \ + _argvec[2] = (unsigned long)(arg2); \ + _argvec[3] = (unsigned long)(arg3); \ + __asm__ volatile( \ + "ld $4, 8(%1)\n\t" \ + "ld $5, 16(%1)\n\t" \ + "ld $6, 24(%1)\n\t" \ + "ld $25, 0(%1)\n\t" /* target->t9 */ \ + VALGRIND_CALL_NOREDIR_T9 \ + "move %0, $2\n" \ + : /*out*/ "=r" (_res) \ + : /*in*/ "r" (&_argvec[0]) \ + : /*trash*/ "memory", __CALLER_SAVED_REGS \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_WWWW(lval, orig, arg1,arg2,arg3,arg4) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[5]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)(arg1); \ + _argvec[2] = (unsigned long)(arg2); \ + _argvec[3] = (unsigned long)(arg3); \ + _argvec[4] = (unsigned long)(arg4); \ + __asm__ volatile( \ + "ld $4, 8(%1)\n\t" \ + "ld $5, 16(%1)\n\t" \ + "ld $6, 24(%1)\n\t" \ + "ld $7, 32(%1)\n\t" \ + "ld $25, 0(%1)\n\t" /* target->t9 */ \ + VALGRIND_CALL_NOREDIR_T9 \ + "move %0, $2\n" \ + : /*out*/ "=r" (_res) \ + : /*in*/ "r" (&_argvec[0]) \ + : /*trash*/ "memory", __CALLER_SAVED_REGS \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_5W(lval, orig, arg1,arg2,arg3,arg4,arg5) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[6]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)(arg1); \ + _argvec[2] = (unsigned long)(arg2); \ + _argvec[3] = (unsigned long)(arg3); \ + _argvec[4] = (unsigned long)(arg4); \ + _argvec[5] = (unsigned long)(arg5); \ + __asm__ volatile( \ + "ld $4, 8(%1)\n\t" \ + "ld $5, 16(%1)\n\t" \ + "ld $6, 24(%1)\n\t" \ + "ld $7, 32(%1)\n\t" \ + "ld $8, 40(%1)\n\t" \ + "ld $25, 0(%1)\n\t" /* target->t9 */ \ + VALGRIND_CALL_NOREDIR_T9 \ + "move %0, $2\n" \ + : /*out*/ "=r" (_res) \ + : /*in*/ "r" (&_argvec[0]) \ + : /*trash*/ "memory", __CALLER_SAVED_REGS \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_6W(lval, orig, arg1,arg2,arg3,arg4,arg5,arg6) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[7]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)(arg1); \ + _argvec[2] = (unsigned long)(arg2); \ + _argvec[3] = (unsigned long)(arg3); \ + _argvec[4] = (unsigned long)(arg4); \ + _argvec[5] = (unsigned long)(arg5); \ + _argvec[6] = (unsigned long)(arg6); \ + __asm__ volatile( \ + "ld $4, 8(%1)\n\t" \ + "ld $5, 16(%1)\n\t" \ + "ld $6, 24(%1)\n\t" \ + "ld $7, 32(%1)\n\t" \ + "ld $8, 40(%1)\n\t" \ + "ld $9, 48(%1)\n\t" \ + "ld $25, 0(%1)\n\t" /* target->t9 */ \ + VALGRIND_CALL_NOREDIR_T9 \ + "move %0, $2\n" \ + : /*out*/ "=r" (_res) \ + : /*in*/ "r" (&_argvec[0]) \ + : /*trash*/ "memory", __CALLER_SAVED_REGS \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_7W(lval, orig, arg1,arg2,arg3,arg4,arg5,arg6, \ + arg7) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[8]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)(arg1); \ + _argvec[2] = (unsigned long)(arg2); \ + _argvec[3] = (unsigned long)(arg3); \ + _argvec[4] = (unsigned long)(arg4); \ + _argvec[5] = (unsigned long)(arg5); \ + _argvec[6] = (unsigned long)(arg6); \ + _argvec[7] = (unsigned long)(arg7); \ + __asm__ volatile( \ + "ld $4, 8(%1)\n\t" \ + "ld $5, 16(%1)\n\t" \ + "ld $6, 24(%1)\n\t" \ + "ld $7, 32(%1)\n\t" \ + "ld $8, 40(%1)\n\t" \ + "ld $9, 48(%1)\n\t" \ + "ld $10, 56(%1)\n\t" \ + "ld $25, 0(%1) \n\t" /* target->t9 */ \ + VALGRIND_CALL_NOREDIR_T9 \ + "move %0, $2\n" \ + : /*out*/ "=r" (_res) \ + : /*in*/ "r" (&_argvec[0]) \ + : /*trash*/ "memory", __CALLER_SAVED_REGS \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_8W(lval, orig, arg1,arg2,arg3,arg4,arg5,arg6, \ + arg7,arg8) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[9]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)(arg1); \ + _argvec[2] = (unsigned long)(arg2); \ + _argvec[3] = (unsigned long)(arg3); \ + _argvec[4] = (unsigned long)(arg4); \ + _argvec[5] = (unsigned long)(arg5); \ + _argvec[6] = (unsigned long)(arg6); \ + _argvec[7] = (unsigned long)(arg7); \ + _argvec[8] = (unsigned long)(arg8); \ + __asm__ volatile( \ + "ld $4, 8(%1)\n\t" \ + "ld $5, 16(%1)\n\t" \ + "ld $6, 24(%1)\n\t" \ + "ld $7, 32(%1)\n\t" \ + "ld $8, 40(%1)\n\t" \ + "ld $9, 48(%1)\n\t" \ + "ld $10, 56(%1)\n\t" \ + "ld $11, 64(%1)\n\t" \ + "ld $25, 0(%1) \n\t" /* target->t9 */ \ + VALGRIND_CALL_NOREDIR_T9 \ + "move %0, $2\n" \ + : /*out*/ "=r" (_res) \ + : /*in*/ "r" (&_argvec[0]) \ + : /*trash*/ "memory", __CALLER_SAVED_REGS \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_9W(lval, orig, arg1,arg2,arg3,arg4,arg5,arg6, \ + arg7,arg8,arg9) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[10]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)(arg1); \ + _argvec[2] = (unsigned long)(arg2); \ + _argvec[3] = (unsigned long)(arg3); \ + _argvec[4] = (unsigned long)(arg4); \ + _argvec[5] = (unsigned long)(arg5); \ + _argvec[6] = (unsigned long)(arg6); \ + _argvec[7] = (unsigned long)(arg7); \ + _argvec[8] = (unsigned long)(arg8); \ + _argvec[9] = (unsigned long)(arg9); \ + __asm__ volatile( \ + "dsubu $29, $29, 8\n\t" \ + "ld $4, 72(%1)\n\t" \ + "sd $4, 0($29)\n\t" \ + "ld $4, 8(%1)\n\t" \ + "ld $5, 16(%1)\n\t" \ + "ld $6, 24(%1)\n\t" \ + "ld $7, 32(%1)\n\t" \ + "ld $8, 40(%1)\n\t" \ + "ld $9, 48(%1)\n\t" \ + "ld $10, 56(%1)\n\t" \ + "ld $11, 64(%1)\n\t" \ + "ld $25, 0(%1)\n\t" /* target->t9 */ \ + VALGRIND_CALL_NOREDIR_T9 \ + "daddu $29, $29, 8\n\t" \ + "move %0, $2\n" \ + : /*out*/ "=r" (_res) \ + : /*in*/ "r" (&_argvec[0]) \ + : /*trash*/ "memory", __CALLER_SAVED_REGS \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_10W(lval, orig, arg1,arg2,arg3,arg4,arg5,arg6, \ + arg7,arg8,arg9,arg10) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[11]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)(arg1); \ + _argvec[2] = (unsigned long)(arg2); \ + _argvec[3] = (unsigned long)(arg3); \ + _argvec[4] = (unsigned long)(arg4); \ + _argvec[5] = (unsigned long)(arg5); \ + _argvec[6] = (unsigned long)(arg6); \ + _argvec[7] = (unsigned long)(arg7); \ + _argvec[8] = (unsigned long)(arg8); \ + _argvec[9] = (unsigned long)(arg9); \ + _argvec[10] = (unsigned long)(arg10); \ + __asm__ volatile( \ + "dsubu $29, $29, 16\n\t" \ + "ld $4, 72(%1)\n\t" \ + "sd $4, 0($29)\n\t" \ + "ld $4, 80(%1)\n\t" \ + "sd $4, 8($29)\n\t" \ + "ld $4, 8(%1)\n\t" \ + "ld $5, 16(%1)\n\t" \ + "ld $6, 24(%1)\n\t" \ + "ld $7, 32(%1)\n\t" \ + "ld $8, 40(%1)\n\t" \ + "ld $9, 48(%1)\n\t" \ + "ld $10, 56(%1)\n\t" \ + "ld $11, 64(%1)\n\t" \ + "ld $25, 0(%1)\n\t" /* target->t9 */ \ + VALGRIND_CALL_NOREDIR_T9 \ + "daddu $29, $29, 16\n\t" \ + "move %0, $2\n" \ + : /*out*/ "=r" (_res) \ + : /*in*/ "r" (&_argvec[0]) \ + : /*trash*/ "memory", __CALLER_SAVED_REGS \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_11W(lval, orig, arg1,arg2,arg3,arg4,arg5, \ + arg6,arg7,arg8,arg9,arg10, \ + arg11) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[12]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)(arg1); \ + _argvec[2] = (unsigned long)(arg2); \ + _argvec[3] = (unsigned long)(arg3); \ + _argvec[4] = (unsigned long)(arg4); \ + _argvec[5] = (unsigned long)(arg5); \ + _argvec[6] = (unsigned long)(arg6); \ + _argvec[7] = (unsigned long)(arg7); \ + _argvec[8] = (unsigned long)(arg8); \ + _argvec[9] = (unsigned long)(arg9); \ + _argvec[10] = (unsigned long)(arg10); \ + _argvec[11] = (unsigned long)(arg11); \ + __asm__ volatile( \ + "dsubu $29, $29, 24\n\t" \ + "ld $4, 72(%1)\n\t" \ + "sd $4, 0($29)\n\t" \ + "ld $4, 80(%1)\n\t" \ + "sd $4, 8($29)\n\t" \ + "ld $4, 88(%1)\n\t" \ + "sd $4, 16($29)\n\t" \ + "ld $4, 8(%1)\n\t" \ + "ld $5, 16(%1)\n\t" \ + "ld $6, 24(%1)\n\t" \ + "ld $7, 32(%1)\n\t" \ + "ld $8, 40(%1)\n\t" \ + "ld $9, 48(%1)\n\t" \ + "ld $10, 56(%1)\n\t" \ + "ld $11, 64(%1)\n\t" \ + "ld $25, 0(%1)\n\t" /* target->t9 */ \ + VALGRIND_CALL_NOREDIR_T9 \ + "daddu $29, $29, 24\n\t" \ + "move %0, $2\n" \ + : /*out*/ "=r" (_res) \ + : /*in*/ "r" (&_argvec[0]) \ + : /*trash*/ "memory", __CALLER_SAVED_REGS \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_12W(lval, orig, arg1,arg2,arg3,arg4,arg5, \ + arg6,arg7,arg8,arg9,arg10, \ + arg11,arg12) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[13]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)(arg1); \ + _argvec[2] = (unsigned long)(arg2); \ + _argvec[3] = (unsigned long)(arg3); \ + _argvec[4] = (unsigned long)(arg4); \ + _argvec[5] = (unsigned long)(arg5); \ + _argvec[6] = (unsigned long)(arg6); \ + _argvec[7] = (unsigned long)(arg7); \ + _argvec[8] = (unsigned long)(arg8); \ + _argvec[9] = (unsigned long)(arg9); \ + _argvec[10] = (unsigned long)(arg10); \ + _argvec[11] = (unsigned long)(arg11); \ + _argvec[12] = (unsigned long)(arg12); \ + __asm__ volatile( \ + "dsubu $29, $29, 32\n\t" \ + "ld $4, 72(%1)\n\t" \ + "sd $4, 0($29)\n\t" \ + "ld $4, 80(%1)\n\t" \ + "sd $4, 8($29)\n\t" \ + "ld $4, 88(%1)\n\t" \ + "sd $4, 16($29)\n\t" \ + "ld $4, 96(%1)\n\t" \ + "sd $4, 24($29)\n\t" \ + "ld $4, 8(%1)\n\t" \ + "ld $5, 16(%1)\n\t" \ + "ld $6, 24(%1)\n\t" \ + "ld $7, 32(%1)\n\t" \ + "ld $8, 40(%1)\n\t" \ + "ld $9, 48(%1)\n\t" \ + "ld $10, 56(%1)\n\t" \ + "ld $11, 64(%1)\n\t" \ + "ld $25, 0(%1)\n\t" /* target->t9 */ \ + VALGRIND_CALL_NOREDIR_T9 \ + "daddu $29, $29, 32\n\t" \ + "move %0, $2\n" \ + : /*out*/ "=r" (_res) \ + : /*in*/ "r" (&_argvec[0]) \ + : /*trash*/ "memory", __CALLER_SAVED_REGS \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#endif /* PLAT_mips64_linux */ + + +/* ------------------------------------------------------------------ */ +/* ARCHITECTURE INDEPENDENT MACROS for CLIENT REQUESTS. */ +/* */ +/* ------------------------------------------------------------------ */ + +/* Some request codes. There are many more of these, but most are not + exposed to end-user view. These are the public ones, all of the + form 0x1000 + small_number. + + Core ones are in the range 0x00000000--0x0000ffff. The non-public + ones start at 0x2000. +*/ + +/* These macros are used by tools -- they must be public, but don't + embed them into other programs. */ +#define VG_USERREQ_TOOL_BASE(a,b) \ + ((unsigned int)(((a)&0xff) << 24 | ((b)&0xff) << 16)) +#define VG_IS_TOOL_USERREQ(a, b, v) \ + (VG_USERREQ_TOOL_BASE(a,b) == ((v) & 0xffff0000)) + +/* !! ABIWARNING !! ABIWARNING !! ABIWARNING !! ABIWARNING !! + This enum comprises an ABI exported by Valgrind to programs + which use client requests. DO NOT CHANGE THE ORDER OF THESE + ENTRIES, NOR DELETE ANY -- add new ones at the end. */ +typedef + enum { VG_USERREQ__RUNNING_ON_VALGRIND = 0x1001, + VG_USERREQ__DISCARD_TRANSLATIONS = 0x1002, + + /* These allow any function to be called from the simulated + CPU but run on the real CPU. Nb: the first arg passed to + the function is always the ThreadId of the running + thread! So CLIENT_CALL0 actually requires a 1 arg + function, etc. */ + VG_USERREQ__CLIENT_CALL0 = 0x1101, + VG_USERREQ__CLIENT_CALL1 = 0x1102, + VG_USERREQ__CLIENT_CALL2 = 0x1103, + VG_USERREQ__CLIENT_CALL3 = 0x1104, + + /* Can be useful in regression testing suites -- eg. can + send Valgrind's output to /dev/null and still count + errors. */ + VG_USERREQ__COUNT_ERRORS = 0x1201, + + /* Allows the client program and/or gdbserver to execute a monitor + command. */ + VG_USERREQ__GDB_MONITOR_COMMAND = 0x1202, + + /* These are useful and can be interpreted by any tool that + tracks malloc() et al, by using vg_replace_malloc.c. */ + VG_USERREQ__MALLOCLIKE_BLOCK = 0x1301, + VG_USERREQ__RESIZEINPLACE_BLOCK = 0x130b, + VG_USERREQ__FREELIKE_BLOCK = 0x1302, + /* Memory pool support. */ + VG_USERREQ__CREATE_MEMPOOL = 0x1303, + VG_USERREQ__DESTROY_MEMPOOL = 0x1304, + VG_USERREQ__MEMPOOL_ALLOC = 0x1305, + VG_USERREQ__MEMPOOL_FREE = 0x1306, + VG_USERREQ__MEMPOOL_TRIM = 0x1307, + VG_USERREQ__MOVE_MEMPOOL = 0x1308, + VG_USERREQ__MEMPOOL_CHANGE = 0x1309, + VG_USERREQ__MEMPOOL_EXISTS = 0x130a, + + /* Allow printfs to valgrind log. */ + /* The first two pass the va_list argument by value, which + assumes it is the same size as or smaller than a UWord, + which generally isn't the case. Hence are deprecated. + The second two pass the vargs by reference and so are + immune to this problem. */ + /* both :: char* fmt, va_list vargs (DEPRECATED) */ + VG_USERREQ__PRINTF = 0x1401, + VG_USERREQ__PRINTF_BACKTRACE = 0x1402, + /* both :: char* fmt, va_list* vargs */ + VG_USERREQ__PRINTF_VALIST_BY_REF = 0x1403, + VG_USERREQ__PRINTF_BACKTRACE_VALIST_BY_REF = 0x1404, + + /* Stack support. */ + VG_USERREQ__STACK_REGISTER = 0x1501, + VG_USERREQ__STACK_DEREGISTER = 0x1502, + VG_USERREQ__STACK_CHANGE = 0x1503, + + /* Wine support */ + VG_USERREQ__LOAD_PDB_DEBUGINFO = 0x1601, + + /* Querying of debug info. */ + VG_USERREQ__MAP_IP_TO_SRCLOC = 0x1701, + + /* Disable/enable error reporting level. Takes a single + Word arg which is the delta to this thread's error + disablement indicator. Hence 1 disables or further + disables errors, and -1 moves back towards enablement. + Other values are not allowed. */ + VG_USERREQ__CHANGE_ERR_DISABLEMENT = 0x1801, + + /* Initialise IR injection */ + VG_USERREQ__VEX_INIT_FOR_IRI = 0x1901 + } Vg_ClientRequest; + +#if !defined(__GNUC__) +# define __extension__ /* */ +#endif + + +/* Returns the number of Valgrinds this code is running under. That + is, 0 if running natively, 1 if running under Valgrind, 2 if + running under Valgrind which is running under another Valgrind, + etc. */ +#define RUNNING_ON_VALGRIND \ + (unsigned)VALGRIND_DO_CLIENT_REQUEST_EXPR(0 /* if not */, \ + VG_USERREQ__RUNNING_ON_VALGRIND, \ + 0, 0, 0, 0, 0) \ + + +/* Discard translation of code in the range [_qzz_addr .. _qzz_addr + + _qzz_len - 1]. Useful if you are debugging a JITter or some such, + since it provides a way to make sure valgrind will retranslate the + invalidated area. Returns no value. */ +#define VALGRIND_DISCARD_TRANSLATIONS(_qzz_addr,_qzz_len) \ + VALGRIND_DO_CLIENT_REQUEST_STMT(VG_USERREQ__DISCARD_TRANSLATIONS, \ + _qzz_addr, _qzz_len, 0, 0, 0) + + +/* These requests are for getting Valgrind itself to print something. + Possibly with a backtrace. This is a really ugly hack. The return value + is the number of characters printed, excluding the "**<pid>** " part at the + start and the backtrace (if present). */ + +#if defined(__GNUC__) || defined(__INTEL_COMPILER) && !defined(_MSC_VER) +/* Modern GCC will optimize the static routine out if unused, + and unused attribute will shut down warnings about it. */ +static int VALGRIND_PRINTF(const char *format, ...) + __attribute__((format(__printf__, 1, 2), __unused__)); +#endif +static int +#if defined(_MSC_VER) +__inline +#endif +VALGRIND_PRINTF(const char *format, ...) +{ +#if defined(NVALGRIND) + return 0; +#else /* NVALGRIND */ +#if defined(_MSC_VER) || defined(__MINGW64__) + uintptr_t _qzz_res; +#else + unsigned long _qzz_res; +#endif + va_list vargs; + va_start(vargs, format); +#if defined(_MSC_VER) || defined(__MINGW64__) + _qzz_res = VALGRIND_DO_CLIENT_REQUEST_EXPR(0, + VG_USERREQ__PRINTF_VALIST_BY_REF, + (uintptr_t)format, + (uintptr_t)&vargs, + 0, 0, 0); +#else + _qzz_res = VALGRIND_DO_CLIENT_REQUEST_EXPR(0, + VG_USERREQ__PRINTF_VALIST_BY_REF, + (unsigned long)format, + (unsigned long)&vargs, + 0, 0, 0); +#endif + va_end(vargs); + return (int)_qzz_res; +#endif /* NVALGRIND */ +} + +#if defined(__GNUC__) || defined(__INTEL_COMPILER) && !defined(_MSC_VER) +static int VALGRIND_PRINTF_BACKTRACE(const char *format, ...) + __attribute__((format(__printf__, 1, 2), __unused__)); +#endif +static int +#if defined(_MSC_VER) +__inline +#endif +VALGRIND_PRINTF_BACKTRACE(const char *format, ...) +{ +#if defined(NVALGRIND) + return 0; +#else /* NVALGRIND */ +#if defined(_MSC_VER) || defined(__MINGW64__) + uintptr_t _qzz_res; +#else + unsigned long _qzz_res; +#endif + va_list vargs; + va_start(vargs, format); +#if defined(_MSC_VER) || defined(__MINGW64__) + _qzz_res = VALGRIND_DO_CLIENT_REQUEST_EXPR(0, + VG_USERREQ__PRINTF_BACKTRACE_VALIST_BY_REF, + (uintptr_t)format, + (uintptr_t)&vargs, + 0, 0, 0); +#else + _qzz_res = VALGRIND_DO_CLIENT_REQUEST_EXPR(0, + VG_USERREQ__PRINTF_BACKTRACE_VALIST_BY_REF, + (unsigned long)format, + (unsigned long)&vargs, + 0, 0, 0); +#endif + va_end(vargs); + return (int)_qzz_res; +#endif /* NVALGRIND */ +} + + +/* These requests allow control to move from the simulated CPU to the + real CPU, calling an arbitary function. + + Note that the current ThreadId is inserted as the first argument. + So this call: + + VALGRIND_NON_SIMD_CALL2(f, arg1, arg2) + + requires f to have this signature: + + Word f(Word tid, Word arg1, Word arg2) + + where "Word" is a word-sized type. + + Note that these client requests are not entirely reliable. For example, + if you call a function with them that subsequently calls printf(), + there's a high chance Valgrind will crash. Generally, your prospects of + these working are made higher if the called function does not refer to + any global variables, and does not refer to any libc or other functions + (printf et al). Any kind of entanglement with libc or dynamic linking is + likely to have a bad outcome, for tricky reasons which we've grappled + with a lot in the past. +*/ +#define VALGRIND_NON_SIMD_CALL0(_qyy_fn) \ + VALGRIND_DO_CLIENT_REQUEST_EXPR(0 /* default return */, \ + VG_USERREQ__CLIENT_CALL0, \ + _qyy_fn, \ + 0, 0, 0, 0) + +#define VALGRIND_NON_SIMD_CALL1(_qyy_fn, _qyy_arg1) \ + VALGRIND_DO_CLIENT_REQUEST_EXPR(0 /* default return */, \ + VG_USERREQ__CLIENT_CALL1, \ + _qyy_fn, \ + _qyy_arg1, 0, 0, 0) + +#define VALGRIND_NON_SIMD_CALL2(_qyy_fn, _qyy_arg1, _qyy_arg2) \ + VALGRIND_DO_CLIENT_REQUEST_EXPR(0 /* default return */, \ + VG_USERREQ__CLIENT_CALL2, \ + _qyy_fn, \ + _qyy_arg1, _qyy_arg2, 0, 0) + +#define VALGRIND_NON_SIMD_CALL3(_qyy_fn, _qyy_arg1, _qyy_arg2, _qyy_arg3) \ + VALGRIND_DO_CLIENT_REQUEST_EXPR(0 /* default return */, \ + VG_USERREQ__CLIENT_CALL3, \ + _qyy_fn, \ + _qyy_arg1, _qyy_arg2, \ + _qyy_arg3, 0) + + +/* Counts the number of errors that have been recorded by a tool. Nb: + the tool must record the errors with VG_(maybe_record_error)() or + VG_(unique_error)() for them to be counted. */ +#define VALGRIND_COUNT_ERRORS \ + (unsigned)VALGRIND_DO_CLIENT_REQUEST_EXPR( \ + 0 /* default return */, \ + VG_USERREQ__COUNT_ERRORS, \ + 0, 0, 0, 0, 0) + +/* Several Valgrind tools (Memcheck, Massif, Helgrind, DRD) rely on knowing + when heap blocks are allocated in order to give accurate results. This + happens automatically for the standard allocator functions such as + malloc(), calloc(), realloc(), memalign(), new, new[], free(), delete, + delete[], etc. + + But if your program uses a custom allocator, this doesn't automatically + happen, and Valgrind will not do as well. For example, if you allocate + superblocks with mmap() and then allocates chunks of the superblocks, all + Valgrind's observations will be at the mmap() level and it won't know that + the chunks should be considered separate entities. In Memcheck's case, + that means you probably won't get heap block overrun detection (because + there won't be redzones marked as unaddressable) and you definitely won't + get any leak detection. + + The following client requests allow a custom allocator to be annotated so + that it can be handled accurately by Valgrind. + + VALGRIND_MALLOCLIKE_BLOCK marks a region of memory as having been allocated + by a malloc()-like function. For Memcheck (an illustrative case), this + does two things: + + - It records that the block has been allocated. This means any addresses + within the block mentioned in error messages will be + identified as belonging to the block. It also means that if the block + isn't freed it will be detected by the leak checker. + + - It marks the block as being addressable and undefined (if 'is_zeroed' is + not set), or addressable and defined (if 'is_zeroed' is set). This + controls how accesses to the block by the program are handled. + + 'addr' is the start of the usable block (ie. after any + redzone), 'sizeB' is its size. 'rzB' is the redzone size if the allocator + can apply redzones -- these are blocks of padding at the start and end of + each block. Adding redzones is recommended as it makes it much more likely + Valgrind will spot block overruns. `is_zeroed' indicates if the memory is + zeroed (or filled with another predictable value), as is the case for + calloc(). + + VALGRIND_MALLOCLIKE_BLOCK should be put immediately after the point where a + heap block -- that will be used by the client program -- is allocated. + It's best to put it at the outermost level of the allocator if possible; + for example, if you have a function my_alloc() which calls + internal_alloc(), and the client request is put inside internal_alloc(), + stack traces relating to the heap block will contain entries for both + my_alloc() and internal_alloc(), which is probably not what you want. + + For Memcheck users: if you use VALGRIND_MALLOCLIKE_BLOCK to carve out + custom blocks from within a heap block, B, that has been allocated with + malloc/calloc/new/etc, then block B will be *ignored* during leak-checking + -- the custom blocks will take precedence. + + VALGRIND_FREELIKE_BLOCK is the partner to VALGRIND_MALLOCLIKE_BLOCK. For + Memcheck, it does two things: + + - It records that the block has been deallocated. This assumes that the + block was annotated as having been allocated via + VALGRIND_MALLOCLIKE_BLOCK. Otherwise, an error will be issued. + + - It marks the block as being unaddressable. + + VALGRIND_FREELIKE_BLOCK should be put immediately after the point where a + heap block is deallocated. + + VALGRIND_RESIZEINPLACE_BLOCK informs a tool about reallocation. For + Memcheck, it does four things: + + - It records that the size of a block has been changed. This assumes that + the block was annotated as having been allocated via + VALGRIND_MALLOCLIKE_BLOCK. Otherwise, an error will be issued. + + - If the block shrunk, it marks the freed memory as being unaddressable. + + - If the block grew, it marks the new area as undefined and defines a red + zone past the end of the new block. + + - The V-bits of the overlap between the old and the new block are preserved. + + VALGRIND_RESIZEINPLACE_BLOCK should be put after allocation of the new block + and before deallocation of the old block. + + In many cases, these three client requests will not be enough to get your + allocator working well with Memcheck. More specifically, if your allocator + writes to freed blocks in any way then a VALGRIND_MAKE_MEM_UNDEFINED call + will be necessary to mark the memory as addressable just before the zeroing + occurs, otherwise you'll get a lot of invalid write errors. For example, + you'll need to do this if your allocator recycles freed blocks, but it + zeroes them before handing them back out (via VALGRIND_MALLOCLIKE_BLOCK). + Alternatively, if your allocator reuses freed blocks for allocator-internal + data structures, VALGRIND_MAKE_MEM_UNDEFINED calls will also be necessary. + + Really, what's happening is a blurring of the lines between the client + program and the allocator... after VALGRIND_FREELIKE_BLOCK is called, the + memory should be considered unaddressable to the client program, but the + allocator knows more than the rest of the client program and so may be able + to safely access it. Extra client requests are necessary for Valgrind to + understand the distinction between the allocator and the rest of the + program. + + Ignored if addr == 0. +*/ +#define VALGRIND_MALLOCLIKE_BLOCK(addr, sizeB, rzB, is_zeroed) \ + VALGRIND_DO_CLIENT_REQUEST_STMT(VG_USERREQ__MALLOCLIKE_BLOCK, \ + addr, sizeB, rzB, is_zeroed, 0) + +/* See the comment for VALGRIND_MALLOCLIKE_BLOCK for details. + Ignored if addr == 0. +*/ +#define VALGRIND_RESIZEINPLACE_BLOCK(addr, oldSizeB, newSizeB, rzB) \ + VALGRIND_DO_CLIENT_REQUEST_STMT(VG_USERREQ__RESIZEINPLACE_BLOCK, \ + addr, oldSizeB, newSizeB, rzB, 0) + +/* See the comment for VALGRIND_MALLOCLIKE_BLOCK for details. + Ignored if addr == 0. +*/ +#define VALGRIND_FREELIKE_BLOCK(addr, rzB) \ + VALGRIND_DO_CLIENT_REQUEST_STMT(VG_USERREQ__FREELIKE_BLOCK, \ + addr, rzB, 0, 0, 0) + +/* Create a memory pool. */ +#define VALGRIND_CREATE_MEMPOOL(pool, rzB, is_zeroed) \ + VALGRIND_DO_CLIENT_REQUEST_STMT(VG_USERREQ__CREATE_MEMPOOL, \ + pool, rzB, is_zeroed, 0, 0) + +/* Destroy a memory pool. */ +#define VALGRIND_DESTROY_MEMPOOL(pool) \ + VALGRIND_DO_CLIENT_REQUEST_STMT(VG_USERREQ__DESTROY_MEMPOOL, \ + pool, 0, 0, 0, 0) + +/* Associate a piece of memory with a memory pool. */ +#define VALGRIND_MEMPOOL_ALLOC(pool, addr, size) \ + VALGRIND_DO_CLIENT_REQUEST_STMT(VG_USERREQ__MEMPOOL_ALLOC, \ + pool, addr, size, 0, 0) + +/* Disassociate a piece of memory from a memory pool. */ +#define VALGRIND_MEMPOOL_FREE(pool, addr) \ + VALGRIND_DO_CLIENT_REQUEST_STMT(VG_USERREQ__MEMPOOL_FREE, \ + pool, addr, 0, 0, 0) + +/* Disassociate any pieces outside a particular range. */ +#define VALGRIND_MEMPOOL_TRIM(pool, addr, size) \ + VALGRIND_DO_CLIENT_REQUEST_STMT(VG_USERREQ__MEMPOOL_TRIM, \ + pool, addr, size, 0, 0) + +/* Resize and/or move a piece associated with a memory pool. */ +#define VALGRIND_MOVE_MEMPOOL(poolA, poolB) \ + VALGRIND_DO_CLIENT_REQUEST_STMT(VG_USERREQ__MOVE_MEMPOOL, \ + poolA, poolB, 0, 0, 0) + +/* Resize and/or move a piece associated with a memory pool. */ +#define VALGRIND_MEMPOOL_CHANGE(pool, addrA, addrB, size) \ + VALGRIND_DO_CLIENT_REQUEST_STMT(VG_USERREQ__MEMPOOL_CHANGE, \ + pool, addrA, addrB, size, 0) + +/* Return 1 if a mempool exists, else 0. */ +#define VALGRIND_MEMPOOL_EXISTS(pool) \ + (unsigned)VALGRIND_DO_CLIENT_REQUEST_EXPR(0, \ + VG_USERREQ__MEMPOOL_EXISTS, \ + pool, 0, 0, 0, 0) + +/* Mark a piece of memory as being a stack. Returns a stack id. + start is the lowest addressable stack byte, end is the highest + addressable stack byte. */ +#define VALGRIND_STACK_REGISTER(start, end) \ + (unsigned)VALGRIND_DO_CLIENT_REQUEST_EXPR(0, \ + VG_USERREQ__STACK_REGISTER, \ + start, end, 0, 0, 0) + +/* Unmark the piece of memory associated with a stack id as being a + stack. */ +#define VALGRIND_STACK_DEREGISTER(id) \ + VALGRIND_DO_CLIENT_REQUEST_STMT(VG_USERREQ__STACK_DEREGISTER, \ + id, 0, 0, 0, 0) + +/* Change the start and end address of the stack id. + start is the new lowest addressable stack byte, end is the new highest + addressable stack byte. */ +#define VALGRIND_STACK_CHANGE(id, start, end) \ + VALGRIND_DO_CLIENT_REQUEST_STMT(VG_USERREQ__STACK_CHANGE, \ + id, start, end, 0, 0) + +/* Load PDB debug info for Wine PE image_map. */ +#define VALGRIND_LOAD_PDB_DEBUGINFO(fd, ptr, total_size, delta) \ + VALGRIND_DO_CLIENT_REQUEST_STMT(VG_USERREQ__LOAD_PDB_DEBUGINFO, \ + fd, ptr, total_size, delta, 0) + +/* Map a code address to a source file name and line number. buf64 + must point to a 64-byte buffer in the caller's address space. The + result will be dumped in there and is guaranteed to be zero + terminated. If no info is found, the first byte is set to zero. */ +#define VALGRIND_MAP_IP_TO_SRCLOC(addr, buf64) \ + (unsigned)VALGRIND_DO_CLIENT_REQUEST_EXPR(0, \ + VG_USERREQ__MAP_IP_TO_SRCLOC, \ + addr, buf64, 0, 0, 0) + +/* Disable error reporting for this thread. Behaves in a stack like + way, so you can safely call this multiple times provided that + VALGRIND_ENABLE_ERROR_REPORTING is called the same number of times + to re-enable reporting. The first call of this macro disables + reporting. Subsequent calls have no effect except to increase the + number of VALGRIND_ENABLE_ERROR_REPORTING calls needed to re-enable + reporting. Child threads do not inherit this setting from their + parents -- they are always created with reporting enabled. */ +#define VALGRIND_DISABLE_ERROR_REPORTING \ + VALGRIND_DO_CLIENT_REQUEST_STMT(VG_USERREQ__CHANGE_ERR_DISABLEMENT, \ + 1, 0, 0, 0, 0) + +/* Re-enable error reporting, as per comments on + VALGRIND_DISABLE_ERROR_REPORTING. */ +#define VALGRIND_ENABLE_ERROR_REPORTING \ + VALGRIND_DO_CLIENT_REQUEST_STMT(VG_USERREQ__CHANGE_ERR_DISABLEMENT, \ + -1, 0, 0, 0, 0) + +/* Execute a monitor command from the client program. + If a connection is opened with GDB, the output will be sent + according to the output mode set for vgdb. + If no connection is opened, output will go to the log output. + Returns 1 if command not recognised, 0 otherwise. */ +#define VALGRIND_MONITOR_COMMAND(command) \ + VALGRIND_DO_CLIENT_REQUEST_EXPR(0, VG_USERREQ__GDB_MONITOR_COMMAND, \ + command, 0, 0, 0, 0) + + +#undef PLAT_x86_darwin +#undef PLAT_amd64_darwin +#undef PLAT_x86_win32 +#undef PLAT_amd64_win64 +#undef PLAT_x86_linux +#undef PLAT_amd64_linux +#undef PLAT_ppc32_linux +#undef PLAT_ppc64be_linux +#undef PLAT_ppc64le_linux +#undef PLAT_arm_linux +#undef PLAT_s390x_linux +#undef PLAT_mips32_linux +#undef PLAT_mips64_linux + +#endif /* __VALGRIND_H */ diff --git a/com.oracle.truffle.r.native/gnur/patch/src/library/base/makebasedb.R b/com.oracle.truffle.r.native/gnur/patch/src/library/base/makebasedb.R new file mode 100644 index 0000000000000000000000000000000000000000..893397c9b28cf73adb76f1799b46d78314f009a7 --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/library/base/makebasedb.R @@ -0,0 +1,130 @@ +# File src/library/base/makebasedb.R +# Part of the R package, https://www.R-project.org +# +# Copyright (C) 1995-2012 The R Core Team +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# This program 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. +# +# A copy of the GNU General Public License is available at +# https://www.R-project.org/Licenses/ + +local({ + makeLazyLoadDB <- function(from, filebase, compress = TRUE, ascii = FALSE, + variables) { + + envlist <- function(e) + .Internal(getVarsFromFrame(ls(e, all = TRUE), e, FALSE)) + + envtable <- function() { + idx <- 0 + envs <- NULL + enames <- character(0) + find <- function(v, keys, vals) { + for (i in seq_along(keys)) + if (identical(v, keys[[i]])) + return(vals[i]) + NULL + } + getname <- function(e) find(e, envs, enames) + getenv <- function(n) find(n, enames, envs) + insert <- function(e) { + idx <<- idx + 1 + name <- paste("env", idx, sep="::") + envs <<- c(e, envs) + enames <<- c(name, enames) + name + } + list(insert = insert, getenv = getenv, getname = getname) + } + + lazyLoadDBinsertValue <- function(value, file, ascii, compress, hook) + .Internal(lazyLoadDBinsertValue(value, file, ascii, compress, hook)) + + lazyLoadDBinsertListElement <- function(x, i, file, ascii, compress, hook) + .Internal(lazyLoadDBinsertValue(x[[i]], file, ascii, compress, hook)) + + lazyLoadDBinsertVariable <- function(n, e, file, ascii, compress, hook) { + x <- .Internal(getVarsFromFrame(n, e, FALSE)) + .Internal(lazyLoadDBinsertValue(x[[1L]], file, ascii, compress, hook)) + } + + mapfile <- paste(filebase, "rdx", sep = ".") + datafile <- paste(filebase, "rdb", sep = ".") + close(file(datafile, "w")) # truncate to zero + table <- envtable() + varenv <- new.env(hash = TRUE) + envenv <- new.env(hash = TRUE) + + envhook <- function(e) { + if (is.environment(e)) { + name <- table$getname(e) + if (is.null(name)) { + name <- table$insert(e) + data <- list(bindings = envlist(e), + enclos = parent.env(e)) + key <- lazyLoadDBinsertValue(data, datafile, ascii, + compress, envhook) + assign(name, key, envir = envenv) + } + name + } + } + + if (is.environment(from)) { + if (! missing(variables)) + vars <- variables + else vars <- ls(from, all = TRUE) + } + else if (is.list(from)) { + vars <- names(from) + if (length(vars) != length(from) || any(nchar(vars) == 0)) + stop("source list must have names for all elements") + } + else stop("source must be an environment or a list"); + + for (i in seq_along(vars)) { + if (is.environment(from)) + key <- lazyLoadDBinsertVariable(vars[i], from, datafile, + ascii, compress, envhook) + else key <- lazyLoadDBinsertListElement(from, i, datafile, ascii, + compress, envhook) + assign(vars[i], key, envir = varenv) + } + + vals <- lapply(vars, get, envir = varenv, inherits = FALSE) + names(vals) <- vars + + rvars <- ls(envenv, all = TRUE) + rvals <- lapply(rvars, get, envir = envenv, inherits = FALSE) + names(rvals) <- rvars + + val <- list(variables = vals, references = rvals, + compressed = compress) + saveRDS(val, mapfile) + } + + omit <- c(".Last.value", ".AutoloadEnv", ".BaseNamespaceEnv", + ".Device", ".Devices", ".Machine", ".Options", ".Platform") + + if (length(search()[search()!="Autoloads"]) != 2) + stop("start R with NO packages loaded to create the data base") + + baseFileBase <- file.path(.Library,"base","R","base") + + if (file.info(baseFileBase)["size"] < 20000) # crude heuristic + stop("may already be using lazy loading on base"); + + basevars <- ls(baseenv(), all.names=TRUE) + prims <- basevars[sapply(basevars, function(n) is.primitive(get(n, baseenv())))] + basevars <- basevars[! basevars %in% c(omit, prims)] + + makeLazyLoadDB(baseenv(), baseFileBase, variables = basevars) +}) diff --git a/com.oracle.truffle.r.native/gnur/patch/src/library/grDevices/src/axis_scales.c b/com.oracle.truffle.r.native/gnur/patch/src/library/grDevices/src/axis_scales.c new file mode 100644 index 0000000000000000000000000000000000000000..40d648b3836de0dd6c1946922900c36451c1e616 --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/library/grDevices/src/axis_scales.c @@ -0,0 +1,70 @@ +/* + * R : A Computer Language for Statistical Data Analysis + * Copyright (C) 2004-11 The R Core Team. + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version. + * + * This program 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 this program; if not, a copy is available at + * https://www.R-project.org/Licenses/ + */ + +#ifdef HAVE_CONFIG_H +#include <config.h> +#endif + +#include <R.h> +#include <Rinternals.h> +#include <R_ext/GraphicsEngine.h> + +#include "grDevices.h" + +SEXP R_CreateAtVector(SEXP axp, SEXP usr, SEXP nint, SEXP is_log) +{ + int nint_v = asInteger(nint); + Rboolean logflag = asLogical(is_log); + + PROTECT(axp = coerceVector(axp, REALSXP)); + PROTECT(usr = coerceVector(usr, REALSXP)); + if(LENGTH(axp) != 3) error(_("'%s' must be numeric of length %d"), "axp", 3); + if(LENGTH(usr) != 2) error(_("'%s' must be numeric of length %d"), "usr", 2); + + SEXP res = CreateAtVector(REAL(axp), REAL(usr), nint_v, logflag); + // -> ../../../main/plot.c + UNPROTECT(2); + return res; +} + +SEXP R_GAxisPars(SEXP usr, SEXP is_log, SEXP nintLog) +{ + Rboolean logflag = asLogical(is_log); + int n = asInteger(nintLog);// will be changed on output .. + double min, max; + const char *nms[] = {"axp", "n", ""}; + SEXP axp, ans; + + usr = coerceVector(usr, REALSXP); + if(LENGTH(usr) != 2) error(_("'%s' must be numeric of length %d"), "usr", 2); + min = REAL(usr)[0]; + max = REAL(usr)[1]; + + GAxisPars(&min, &max, &n, logflag, 0);// axis = 0 :<==> do not warn.. [TODO!] + // -> ../../../main/graphics.c + + PROTECT(ans = mkNamed(VECSXP, nms)); + SET_VECTOR_ELT(ans, 0, (axp = allocVector(REALSXP, 2)));// protected + SET_VECTOR_ELT(ans, 1, ScalarInteger(n)); + REAL(axp)[0] = min; + REAL(axp)[1] = max; + + UNPROTECT(1); + return ans; +} diff --git a/com.oracle.truffle.r.native/gnur/patch/src/library/grDevices/src/cairo/cairoBM.c b/com.oracle.truffle.r.native/gnur/patch/src/library/grDevices/src/cairo/cairoBM.c new file mode 100644 index 0000000000000000000000000000000000000000..f93e54ffd04f7b59c209da03ab003cf410be25d6 --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/library/grDevices/src/cairo/cairoBM.c @@ -0,0 +1,615 @@ +/* + * R : A Computer Language for Statistical Data Analysis + * Copyright (C) 1995, 1996 Robert Gentleman and Ross Ihaka + * Copyright (C) 1997--2015 The R Core Team + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version. + * + * This program 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 this program; if not, a copy is available at + * https://www.R-project.org/Licenses/ + */ + +#ifdef HAVE_CONFIG_H +# include <config.h> +#endif + +/* This module is only compiled if HAVE_WORKING_CAIRO is true */ + +/* additional entry points used here + + cairo_show_page + cairo_pdf_surface_create (1.2) + cairo_ps_surface_create (1.2) + cairo_ps_surface_set_eps (1.6) + cairo_surface_set_fallback_resolution (1.2) + cairo_surface_write_to_png + cairo_svg_surface_create (1.2) + cairo_svg_surface_restrict_to_version (1.2) + + */ + +#ifdef Win32 +//#define HAVE_PANGOCAIRO 1 +#define HAVE_CAIRO_SVG 1 +#define HAVE_CAIRO_PDF 1 +#define HAVE_CAIRO_PS 1 +/* and if not using pango, this selects fontconfig */ +//#define USE_FC 1 + +# define raise our_raise +# include <Defn.h> +# undef raise +#else +# include <Defn.h> +#endif + +#define R_USE_PROTOTYPES 1 +#include <R_ext/GraphicsEngine.h> +#include <Defn.h> +#include "Fileio.h" /* R_fopen */ + +#include "cairoBM.h" + +#ifdef ENABLE_NLS +#include <libintl.h> +#undef _ +#define _(String) dgettext ("grDevices", String) +#else +#define _(String) (String) +#endif + + +static double RedGamma = 1.0; +static double GreenGamma = 1.0; +static double BlueGamma = 1.0; + +static void cbm_Size(double *left, double *right, + double *bottom, double *top, + pDevDesc dd) +{ + pX11Desc xd = (pX11Desc) dd->deviceSpecific; + + *left = 0.0; + *right = xd->windowWidth; + *bottom = xd->windowHeight; + *top = 0.0; +} + +#define NO_X11 1 +#include "cairoFns.c" + +#ifdef Win32 +# include "winbitmap.h" +#else +# include "bitmap.h" +#endif + +static Rboolean +BM_Open(pDevDesc dd, pX11Desc xd, int width, int height) +{ + char buf[PATH_MAX]; + cairo_status_t res; + if (xd->type == PNG || xd->type == JPEG || + xd->type == TIFF || xd->type == BMP || + xd->type == PNGdirect) { + xd->cs = cairo_image_surface_create(CAIRO_FORMAT_ARGB32, + xd->windowWidth, + xd->windowHeight); + res = cairo_surface_status(xd->cs); + if (res != CAIRO_STATUS_SUCCESS) { + warning("cairo error '%s'", cairo_status_to_string(res)); + return FALSE; + } + xd->cc = cairo_create(xd->cs); + res = cairo_status(xd->cc); + if (res != CAIRO_STATUS_SUCCESS) { + warning("cairo error '%s'", cairo_status_to_string(res)); + return FALSE; + } + cairo_set_operator(xd->cc, CAIRO_OPERATOR_OVER); + cairo_reset_clip(xd->cc); + cairo_set_antialias(xd->cc, xd->antialias); + } +#ifdef HAVE_CAIRO_SVG + else if(xd->type == SVG) { + snprintf(buf, PATH_MAX, xd->filename, xd->npages + 1); + xd->cs = cairo_svg_surface_create(R_ExpandFileName(buf), + (double)xd->windowWidth, + (double)xd->windowHeight); + res = cairo_surface_status(xd->cs); + if (res != CAIRO_STATUS_SUCCESS) { + xd->cs = NULL; + warning("cairo error '%s'", cairo_status_to_string(res)); + return FALSE; + } + if(xd->onefile) + cairo_svg_surface_restrict_to_version(xd->cs, CAIRO_SVG_VERSION_1_2); + xd->cc = cairo_create(xd->cs); + res = cairo_status(xd->cc); + if (res != CAIRO_STATUS_SUCCESS) { + warning("cairo error '%s'", cairo_status_to_string(res)); + return FALSE; + } + cairo_set_antialias(xd->cc, xd->antialias); + } +#endif +#ifdef HAVE_CAIRO_PDF + else if(xd->type == PDF) { + snprintf(buf, PATH_MAX, xd->filename, xd->npages + 1); + xd->cs = cairo_pdf_surface_create(R_ExpandFileName(buf), + (double)xd->windowWidth, + (double)xd->windowHeight); + res = cairo_surface_status(xd->cs); + if (res != CAIRO_STATUS_SUCCESS) { + warning("cairo error '%s'", cairo_status_to_string(res)); + return FALSE; + } + cairo_surface_set_fallback_resolution(xd->cs, xd->fallback_dpi, + xd->fallback_dpi); + xd->cc = cairo_create(xd->cs); + res = cairo_status(xd->cc); + if (res != CAIRO_STATUS_SUCCESS) { + warning("cairo error '%s'", cairo_status_to_string(res)); + return FALSE; + } + cairo_set_antialias(xd->cc, xd->antialias); + } +#endif +#ifdef HAVE_CAIRO_PS + else if(xd->type == PS) { + snprintf(buf, PATH_MAX, xd->filename, xd->npages + 1); + xd->cs = cairo_ps_surface_create(R_ExpandFileName(buf), + (double)xd->windowWidth, + (double)xd->windowHeight); + res = cairo_surface_status(xd->cs); + if (res != CAIRO_STATUS_SUCCESS) { + warning("cairo error '%s'", cairo_status_to_string(res)); + return FALSE; + } +// We already require >= 1.2 +#if CAIRO_VERSION_MAJOR > 2 || CAIRO_VERSION_MINOR >= 6 + if(!xd->onefile) + cairo_ps_surface_set_eps(xd->cs, TRUE); +#endif + cairo_surface_set_fallback_resolution(xd->cs, xd->fallback_dpi, + xd->fallback_dpi); + xd->cc = cairo_create(xd->cs); + res = cairo_status(xd->cc); + if (res != CAIRO_STATUS_SUCCESS) { + warning("cairo error '%s'", cairo_status_to_string(res)); + return FALSE; + } + cairo_set_antialias(xd->cc, xd->antialias); + } +#endif + else + error(_("unimplemented cairo-based device")); + + return TRUE; +} + + +static int stride; + +static unsigned int Cbitgp(void *xi, int x, int y) +{ + unsigned int *data = xi; + return data[x*stride+y]; +} + +static void BM_Close_bitmap(pX11Desc xd) +{ + if (xd->type == PNGdirect) { + char buf[PATH_MAX]; + snprintf(buf, PATH_MAX, xd->filename, xd->npages); + cairo_surface_write_to_png(xd->cs, buf); + return; + } + + void *xi = cairo_image_surface_get_data(xd->cs); + if (!xi) { + warning("BM_Close_bitmap called on non-surface"); + return; + } + + stride = cairo_image_surface_get_stride(xd->cs)/4; + if (xd->type == PNG) + R_SaveAsPng(xi, xd->windowWidth, xd->windowHeight, + Cbitgp, 0, xd->fp, 0, xd->res_dpi); + else if(xd->type == JPEG) + R_SaveAsJpeg(xi, xd->windowWidth, xd->windowHeight, + Cbitgp, 0, xd->quality, xd->fp, xd->res_dpi); + else if(xd->type == BMP) + R_SaveAsBmp(xi, xd->windowWidth, xd->windowHeight, + Cbitgp, 0, xd->fp, xd->res_dpi); + else { + char buf[PATH_MAX]; + snprintf(buf, PATH_MAX, xd->filename, xd->npages); + R_SaveAsTIFF(xi, xd->windowWidth, xd->windowHeight, + Cbitgp, 0, R_ExpandFileName(buf), xd->res_dpi, + xd->quality); + } +} + +static void BM_NewPage(const pGEcontext gc, pDevDesc dd) +{ + pX11Desc xd = (pX11Desc) dd->deviceSpecific; + char buf[PATH_MAX]; + cairo_status_t res; + + xd->npages++; + if (xd->type == PNG || xd->type == JPEG || xd->type == BMP) { + if (xd->npages > 1) { + /* try to preserve the page we do have */ + BM_Close_bitmap(xd); + if (xd->fp) fclose(xd->fp); + } + snprintf(buf, PATH_MAX, xd->filename, xd->npages); + xd->fp = R_fopen(R_ExpandFileName(buf), "wb"); + if (!xd->fp) + error(_("could not open file '%s'"), buf); + } + else if(xd->type == PNGdirect || xd->type == TIFF) { + if (xd->npages > 1) { + xd->npages--; + BM_Close_bitmap(xd); + xd->npages++; + } + } +#ifdef HAVE_CAIRO_SVG + else if(xd->type == SVG) { + if (xd->npages > 1 && xd->cs) { + cairo_show_page(xd->cc); + if(!xd->onefile) { + cairo_surface_destroy(xd->cs); + cairo_destroy(xd->cc); + snprintf(buf, PATH_MAX, xd->filename, xd->npages); + xd->cs = cairo_svg_surface_create(R_ExpandFileName(buf), + (double)xd->windowWidth, + (double)xd->windowHeight); + res = cairo_surface_status(xd->cs); + if (res != CAIRO_STATUS_SUCCESS) { + xd->cs = NULL; + error("cairo error '%s'", cairo_status_to_string(res)); + } + if(xd->onefile) + cairo_svg_surface_restrict_to_version(xd->cs, CAIRO_SVG_VERSION_1_2); + xd->cc = cairo_create(xd->cs); + res = cairo_status(xd->cc); + if (res != CAIRO_STATUS_SUCCESS) { + error("cairo error '%s'", cairo_status_to_string(res)); + } + cairo_set_antialias(xd->cc, xd->antialias); + } + } + } +#endif +#ifdef HAVE_CAIRO_PDF + else if(xd->type == PDF) { + if (xd->npages > 1) { + cairo_show_page(xd->cc); + if(!xd->onefile) { + cairo_surface_destroy(xd->cs); + cairo_destroy(xd->cc); + snprintf(buf, PATH_MAX, xd->filename, xd->npages); + xd->cs = cairo_pdf_surface_create(R_ExpandFileName(buf), + (double)xd->windowWidth, + (double)xd->windowHeight); + res = cairo_surface_status(xd->cs); + if (res != CAIRO_STATUS_SUCCESS) { + error("cairo error '%s'", cairo_status_to_string(res)); + } + cairo_surface_set_fallback_resolution(xd->cs, xd->fallback_dpi, + xd->fallback_dpi); + xd->cc = cairo_create(xd->cs); + res = cairo_status(xd->cc); + if (res != CAIRO_STATUS_SUCCESS) { + error("cairo error '%s'", cairo_status_to_string(res)); + } + cairo_set_antialias(xd->cc, xd->antialias); + } + } + } +#endif +#ifdef HAVE_CAIRO_PS + else if(xd->type == PS) { + if (xd->npages > 1) { + cairo_show_page(xd->cc); + if(!xd->onefile) { + cairo_surface_destroy(xd->cs); + cairo_destroy(xd->cc); + snprintf(buf, PATH_MAX, xd->filename, xd->npages); + xd->cs = cairo_ps_surface_create(R_ExpandFileName(buf), + (double)xd->windowWidth, + (double)xd->windowHeight); + res = cairo_surface_status(xd->cs); + if (res != CAIRO_STATUS_SUCCESS) { + error("cairo error '%s'", cairo_status_to_string(res)); + } +// We already require >= 1.2 +#if CAIRO_VERSION_MAJOR > 2 || CAIRO_VERSION_MINOR >= 6 + if(!xd->onefile) + cairo_ps_surface_set_eps(xd->cs, TRUE); +#endif + cairo_surface_set_fallback_resolution(xd->cs, xd->fallback_dpi, + xd->fallback_dpi); + xd->cc = cairo_create(xd->cs); + res = cairo_status(xd->cc); + if (res != CAIRO_STATUS_SUCCESS) { + error("cairo error '%s'", cairo_status_to_string(res)); + } + cairo_set_antialias(xd->cc, xd->antialias); + } + } + } +#endif + else + error(_("unimplemented cairo-based device")); + + cairo_reset_clip(xd->cc); + if (xd->type == PNG || xd->type == TIFF|| xd->type == PNGdirect) { + /* First clear it */ + cairo_set_operator (xd->cc, CAIRO_OPERATOR_CLEAR); + cairo_paint (xd->cc); + cairo_set_operator (xd->cc, CAIRO_OPERATOR_OVER); + xd->fill = gc->fill; + } else + xd->fill = R_OPAQUE(gc->fill) ? gc->fill: xd->canvas; + CairoColor(xd->fill, xd); + cairo_new_path(xd->cc); + cairo_paint(xd->cc); +} + + +static void BM_Close(pDevDesc dd) +{ + pX11Desc xd = (pX11Desc) dd->deviceSpecific; + + if (xd->npages) + if (xd->type == PNG || xd->type == JPEG || + xd->type == TIFF || xd->type == BMP || xd->type == PNGdirect) + BM_Close_bitmap(xd); + if (xd->fp) fclose(xd->fp); + if (xd->cc) cairo_show_page(xd->cc); + if (xd->cs) cairo_surface_destroy(xd->cs); + if (xd->cc) cairo_destroy(xd->cc); + free(xd); +} + + + +static Rboolean +BMDeviceDriver(pDevDesc dd, int kind, const char *filename, + int quality, int width, int height, int ps, + int bg, int res, int antialias, const char *family, + double dpi) +{ + pX11Desc xd; + int res0 = (res > 0) ? res : 72; + double dps = ps; + + /* allocate new device description */ + if (!(xd = (pX11Desc) calloc(1, sizeof(X11Desc)))) return FALSE; + strcpy(xd->filename, filename); + xd->quality = quality; + xd->windowWidth = width; + xd->windowHeight = height; + strncpy(xd->basefontfamily, family, 500); +#ifdef HAVE_PANGOCAIRO + /* Pango's default resolution is 96 dpi */ + dps *= res0/96.0; +#else + dps *= res0/72.0; +#endif + xd->pointsize = dps; + xd->bg = bg; + xd->res_dpi = res; + xd->fallback_dpi = dpi; + switch(antialias){ + case 1: xd->antialias = CAIRO_ANTIALIAS_DEFAULT; break; + case 2: xd->antialias = CAIRO_ANTIALIAS_NONE; break; + case 3: xd->antialias = CAIRO_ANTIALIAS_GRAY; break; + case 4: xd->antialias = CAIRO_ANTIALIAS_SUBPIXEL; break; + default: xd->antialias = CAIRO_ANTIALIAS_DEFAULT; + } + xd->npages = 0; + xd->col = R_RGB(0, 0, 0); + xd->fill = xd->canvas = bg; + xd->type = kind; + xd->fp = NULL; + xd->lty = -1; + xd->lwd = -1; + xd->lend = 0; + xd->ljoin = 0; + + if (!BM_Open(dd, xd, width, height)) { + free(xd); + return FALSE; + } + if (xd->type == SVG || xd->type == PDF || xd->type == PS) + xd->onefile = quality != 0; + + /* Set up Data Structures */ + dd->size = cbm_Size; + dd->clip = Cairo_Clip; + dd->rect = Cairo_Rect; + dd->circle = Cairo_Circle; + dd->line = Cairo_Line; + dd->polyline = Cairo_Polyline; + dd->polygon = Cairo_Polygon; + dd->path = Cairo_Path; + dd->raster = Cairo_Raster; +#ifdef HAVE_PANGOCAIRO + dd->metricInfo = PangoCairo_MetricInfo; + dd->strWidth = dd->strWidthUTF8 = PangoCairo_StrWidth; + dd->text = dd->textUTF8 = PangoCairo_Text; +#else + dd->metricInfo = Cairo_MetricInfo; + dd->strWidth = dd->strWidthUTF8 = Cairo_StrWidth; + dd->text = dd->textUTF8 = Cairo_Text; +#endif + dd->hasTextUTF8 = TRUE; +#if defined(Win32) && !defined(USE_FC) + dd->wantSymbolUTF8 = NA_LOGICAL; +#else + dd->wantSymbolUTF8 = TRUE; +#endif + dd->useRotatedTextInContour = FALSE; + + dd->haveTransparency = 2; + dd->haveRaster = 2; + switch(xd->type) { + case PDF: + case SVG: + case PNG: + case PNGdirect: + dd->haveTransparentBg = 3; + break; + case PS: + dd->haveTransparentBg = 2; + dd->haveRaster = 3; /* ?? */ + break; + default: /* TIFF, BMP */ + dd->haveTransparency = 1; + } + + dd->newPage = BM_NewPage; + dd->close = BM_Close; + + dd->left = 0; + dd->right = width; + dd->top = 0; + dd->bottom = height; + /* rescale points to pixels */ + dd->cra[0] = 0.9 * ps * res0/72.0; + dd->cra[1] = 1.2 * ps * res0/72.0; + dd->startps = ps; + xd->fontscale = dps/ps; + dd->ipr[0] = dd->ipr[1] = 1.0/res0; + xd->lwdscale = res0/96.0; + dd->xCharOffset = 0.4900; + dd->yCharOffset = 0.3333; + dd->yLineBias = 0.2; + dd->canClip= TRUE; + dd->canHAdj = 2; + dd->canChangeGamma = FALSE; + dd->startcol = xd->col; + dd->startfill = xd->fill; + dd->startlty = LTY_SOLID; + dd->startfont = 1; + dd->startgamma = 1; + dd->displayListOn = FALSE; + dd->deviceSpecific = (void *) xd; + + return TRUE; +} + +const static struct { + const char * const name; + X_GTYPE gtype; +} devtable[] = { + { "", WINDOW }, + { "", XIMAGE }, + { "png", PNG }, + { "jpeg", JPEG }, + { "svg", SVG }, + { "png", PNGdirect }, + { "cairo_pdf", PDF }, + { "cairo_ps", PS }, + { "tiff", TIFF }, + { "bmp", BMP } +}; + +/* + cairo(filename, type, width, height, pointsize, bg, res, antialias, + quality, family) +*/ +SEXP in_Cairo(SEXP args) +{ + pGEDevDesc gdd; + SEXP sc; + const char *filename, *family; + int type, quality, width, height, pointsize, bgcolor, res, antialias; + double dpi; + const void *vmax = vmaxget(); + + args = CDR(args); /* skip entry point name */ + if (!isString(CAR(args)) || LENGTH(CAR(args)) < 1) + error(_("invalid '%s' argument"), "filename"); + filename = translateChar(STRING_ELT(CAR(args), 0)); + args = CDR(args); + type = asInteger(CAR(args)); + if(type == NA_INTEGER || type <= 0) + error(_("invalid '%s' argument"), "type"); + args = CDR(args); + width = asInteger(CAR(args)); + if(width == NA_INTEGER || width <= 0) + error(_("invalid '%s' argument"), "width"); + args = CDR(args); + height = asInteger(CAR(args)); + if(height == NA_INTEGER || height <= 0) + error(_("invalid '%s' argument"), "height"); + args = CDR(args); + pointsize = asInteger(CAR(args)); + if(pointsize == NA_INTEGER || pointsize <= 0) + error(_("invalid '%s' argument"), "pointsize"); + args = CDR(args); + sc = CAR(args); + if (!isString(sc) && !isInteger(sc) && !isLogical(sc) && !isReal(sc)) + error(_("invalid '%s' value"), "bg"); + bgcolor = RGBpar(sc, 0); + args = CDR(args); + res = asInteger(CAR(args)); + args = CDR(args); + antialias = asInteger(CAR(args)); + if(antialias == NA_INTEGER) + error(_("invalid '%s' argument"), "antialias"); + args = CDR(args); + quality = asInteger(CAR(args)); + if(quality == NA_INTEGER || quality < 0 || quality > 100) + error(_("invalid '%s' argument"), "quality"); + args = CDR(args); + if (!isString(CAR(args)) || LENGTH(CAR(args)) < 1) + error(_("invalid '%s' argument"), "family"); + family = translateChar(STRING_ELT(CAR(args), 0)); + args = CDR(args); + dpi = asReal(CAR(args)); + if(ISNAN(dpi) || dpi <= 0) + error(_("invalid '%s' argument"), "dpi"); + + R_GE_checkVersionOrDie(R_GE_version); + R_CheckDeviceAvailable(); + BEGIN_SUSPEND_INTERRUPTS { + pDevDesc dev; + /* Allocate and initialize the device driver data */ + if (!(dev = (pDevDesc) calloc(1, sizeof(DevDesc)))) return 0; + if (!BMDeviceDriver(dev, devtable[type].gtype, filename, quality, + width, height, pointsize, + bgcolor, res, antialias, family, dpi)) { + free(dev); + error(_("unable to start device '%s'"), devtable[type].name); + } + gdd = GEcreateDevDesc(dev); + GEaddDevice2f(gdd, devtable[type].name, filename); + } END_SUSPEND_INTERRUPTS; + + vmaxset(vmax); + return R_NilValue; +} + +SEXP in_CairoVersion(void) +{ + SEXP ans = PROTECT(allocVector(STRSXP, 1)); + SET_STRING_ELT(ans, 0, mkChar(cairo_version_string())); + UNPROTECT(1); + return ans; +} diff --git a/com.oracle.truffle.r.native/gnur/patch/src/library/grDevices/src/cairo/cairoBM.h b/com.oracle.truffle.r.native/gnur/patch/src/library/grDevices/src/cairo/cairoBM.h new file mode 100644 index 0000000000000000000000000000000000000000..bdb1b09a7bf1383dc73b95915a0e9d503efbbe6d --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/library/grDevices/src/cairo/cairoBM.h @@ -0,0 +1,102 @@ +/* + * R : A Computer Language for Statistical Data Analysis + * Copyright (C) 1997--2015 R Core Team + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version. + * + * This program 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 this program; if not, a copy is available at + * https://www.R-project.org/Licenses/ + */ + +#ifndef R_DEV_CAIRO_H +#define R_DEV_CAIRO_H + +#define SYMBOL_FONTFACE 5 + +typedef enum { + WINDOW, + XIMAGE, + PNG, + JPEG, + TIFF, + PNGdirect, + SVG, + PDF, + PS, + BMP +} X_GTYPE; + + +#include <stdio.h> + +#ifdef HAVE_PANGOCAIRO +# include <pango/pango.h> +# include <pango/pangocairo.h> +#else +# include <cairo.h> +#endif +#ifdef HAVE_CAIRO_SVG +# include <cairo-svg.h> +# endif +#ifdef HAVE_CAIRO_PDF +# include <cairo-pdf.h> +# endif +#ifdef HAVE_CAIRO_PS +# include <cairo-ps.h> +# endif + +typedef struct { + /* Graphics Parameters */ + /* Local device copy so that we can detect */ + /* when parameter changes. */ + + /* Used to detect changes */ + int lty; /* Line type */ + double lwd; + R_GE_lineend lend; + R_GE_linejoin ljoin; + + double lwdscale; /* scaling to get a multiple + of 1/96" */ + + int col; /* Color */ + int fill; + int bg; /* bg */ + int canvas; /* Canvas colour */ + int fontface; /* Typeface 1:5 */ + int fontsize; /* Size in points */ + double pointsize; /* Size in points */ + char basefontfamily[500]; /* Initial font family */ + + int windowWidth; /* Window width (pixels) */ + int windowHeight; /* Window height (pixels) */ + X_GTYPE type; /* Window or pixmap? */ + int npages; /* counter for a pixmap */ + FILE *fp; /* file for a bitmap device */ + char filename[PATH_MAX]; /* filename for a bitmap device */ + int quality; /* JPEG quality/TIFF compression */ + + int res_dpi; /* used for png/jpeg */ + double fallback_dpi; /* used for ps/pdf */ + char title[101]; + Rboolean onefile; + + Rboolean useCairo, buffered; + cairo_t *cc, *xcc; + cairo_surface_t *cs, *xcs; + cairo_antialias_t antialias; + + double fontscale; +} X11Desc; + +typedef X11Desc* pX11Desc; +#endif diff --git a/com.oracle.truffle.r.native/gnur/patch/src/library/grDevices/src/cairo/cairoFns.c b/com.oracle.truffle.r.native/gnur/patch/src/library/grDevices/src/cairo/cairoFns.c new file mode 100644 index 0000000000000000000000000000000000000000..308ee98ad0245555ccfdc68aae872575728b167e --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/library/grDevices/src/cairo/cairoFns.c @@ -0,0 +1,890 @@ +/* + * R : A Computer Language for Statistical Data Analysis + * Copyright (C) 2008--2013 R Core Team + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version. + * + * This program 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 this program; if not, a copy is available at + * https://www.R-project.org/Licenses/ + */ + + +/* Entry points used + + cairo_arc + cairo_clip + cairo_close_path + cairo_create + cairo_destroy + cairo_fill_preserve + cairo_get_source + cairo_get_target + cairo_image_surface_create + cairo_image_surface_create_for_data + cairo_image_surface_get_data (1.2) + cairo_image_surface_get_stride + cairo_line_to + cairo_move_to + cairo_new_path + cairo_paint + cairo_pattern_set_extend + cairo_pattern_set_filter + cairo_rectangle + cairo_rel_move_to + cairo_reset_clip + cairo_restore + cairo_rotate + cairo_save + cairo_scale + cairo_set_antialias + cairo_set_dash + cairo_set_fill_rule + cairo_set_line_cap + cairo_set_line_join + cairo_set_line_width + cairo_set_miter_limit + cairo_set_operator + cairo_set_source_rgb + cairo_set_source_rgba + cairo_set_source_surface + cairo_status + cairo_status_to_string + cairo_stroke + cairo_surface_destroy + cairo_surface_status + + cairo_xlib_surface_create + cairo_xlib_surface_set_size + + cairo_show_text + cairo_text_extents + + cairo_ft_font_face_create_for_ft_face [macOS] + + g_object_unref (glib) + + pango_cairo_create_layout (1.10) + pango_cairo_show_layout (1.10) + pango_font_description_free + pango_font_description_new + pango_font_description_set_family + pango_font_description_set_size + pango_font_description_set_style + pango_font_description_set_weight + pango_layout_get_line + pango_layout_line_get_pixel_extents + pango_layout_set_font_description + pango_layout_set_text + +*/ + +static void CairoColor(unsigned int col, pX11Desc xd) +{ + unsigned int alpha = R_ALPHA(col); + double red, blue, green; + + red = R_RED(col)/255.0; + green = R_GREEN(col)/255.0; + blue = R_BLUE(col)/255.0; + red = pow(red, RedGamma); + green = pow(green, GreenGamma); + blue = pow(blue, BlueGamma); + + /* This optimization should not be necessary, but alpha = 1 seems + to cause image fallback in some backends */ + if (alpha == 255) + cairo_set_source_rgb(xd->cc, red, green, blue); + else + cairo_set_source_rgba(xd->cc, red, green, blue, alpha/255.0); +} + +static void CairoLineType(const pGEcontext gc, pX11Desc xd) +{ + cairo_t *cc = xd->cc; + double lwd = gc->lwd; + cairo_line_cap_t lcap = CAIRO_LINE_CAP_SQUARE; + cairo_line_join_t ljoin = CAIRO_LINE_JOIN_ROUND; + switch(gc->lend){ + case GE_ROUND_CAP: lcap = CAIRO_LINE_CAP_ROUND; break; + case GE_BUTT_CAP: lcap = CAIRO_LINE_CAP_BUTT; break; + case GE_SQUARE_CAP: lcap = CAIRO_LINE_CAP_SQUARE; break; + } + switch(gc->ljoin){ + case GE_ROUND_JOIN: ljoin = CAIRO_LINE_JOIN_ROUND; break; + case GE_MITRE_JOIN: ljoin = CAIRO_LINE_JOIN_MITER; break; + case GE_BEVEL_JOIN: ljoin = CAIRO_LINE_JOIN_BEVEL; break; + } + cairo_set_line_width(cc, (lwd > 0.01 ? lwd : 0.01) * xd->lwdscale); + cairo_set_line_cap(cc, lcap); + cairo_set_line_join(cc, ljoin); + cairo_set_miter_limit(cc, gc->lmitre); + + if (gc->lty == 0 || gc->lty == -1 || gc->lty == NA_INTEGER) + cairo_set_dash(cc, 0, 0, 0); + else { + double ls[16], lwd = (gc->lwd > 1) ? gc->lwd : 1; + int l; + /* Use unsigned int otherwise right shift of 'dt' + may not terminate for loop */ + unsigned int dt = gc->lty; + for (l = 0; dt != 0; dt >>= 4, l++) + ls[l] = (dt & 0xF) * lwd * xd->lwdscale; + cairo_set_dash(cc, ls, l, 0); + } +} + +static void Cairo_Clip(double x0, double x1, double y0, double y1, + pDevDesc dd) +{ + pX11Desc xd = (pX11Desc) dd->deviceSpecific; + + if (x1 < x0) { double h = x1; x1 = x0; x0 = h; }; + if (y1 < y0) { double h = y1; y1 = y0; y0 = h; }; + + cairo_reset_clip(xd->cc); + cairo_new_path(xd->cc); + /* Add 1 per X11_Clip */ + cairo_rectangle(xd->cc, x0, y0, x1 - x0 + 1, y1 - y0 + 1); + cairo_clip(xd->cc); +} + + +static void Cairo_Rect(double x0, double y0, double x1, double y1, + const pGEcontext gc, pDevDesc dd) +{ + pX11Desc xd = (pX11Desc) dd->deviceSpecific; + + cairo_new_path(xd->cc); + cairo_rectangle(xd->cc, x0, y0, x1 - x0, y1 - y0); + + if (R_ALPHA(gc->fill) > 0) { + cairo_set_antialias(xd->cc, CAIRO_ANTIALIAS_NONE); + CairoColor(gc->fill, xd); + cairo_fill_preserve(xd->cc); + cairo_set_antialias(xd->cc, xd->antialias); + } + + if (R_ALPHA(gc->col) > 0 && gc->lty != -1) { + CairoColor(gc->col, xd); + CairoLineType(gc, xd); + cairo_stroke(xd->cc); + } +} + +static void Cairo_Circle(double x, double y, double r, + const pGEcontext gc, pDevDesc dd) +{ + pX11Desc xd = (pX11Desc) dd->deviceSpecific; + + cairo_new_path(xd->cc); + /* radius 0.5 seems to be visible */ + cairo_arc(xd->cc, x, y, (r > 0.5 ? r : 0.5), 0.0, 2 * M_PI); + + if (R_ALPHA(gc->fill) > 0) { + cairo_set_antialias(xd->cc, CAIRO_ANTIALIAS_NONE); + CairoColor(gc->fill, xd); + cairo_fill_preserve(xd->cc); + cairo_set_antialias(xd->cc, xd->antialias); + } + if (R_ALPHA(gc->col) > 0 && gc->lty != -1) { + CairoColor(gc->col, xd); + CairoLineType(gc, xd); + cairo_stroke(xd->cc); + } +} + +static void Cairo_Line(double x1, double y1, double x2, double y2, + const pGEcontext gc, pDevDesc dd) +{ + pX11Desc xd = (pX11Desc) dd->deviceSpecific; + + if (R_ALPHA(gc->col) > 0) { + CairoColor(gc->col, xd); + CairoLineType(gc, xd); + cairo_new_path(xd->cc); + cairo_move_to(xd->cc, x1, y1); + cairo_line_to(xd->cc, x2, y2); + cairo_stroke(xd->cc); + } +} + +static void Cairo_Polyline(int n, double *x, double *y, + const pGEcontext gc, pDevDesc dd) +{ + int i; + pX11Desc xd = (pX11Desc) dd->deviceSpecific; + + if (R_ALPHA(gc->col) > 0) { + CairoColor(gc->col, xd); + CairoLineType(gc, xd); + cairo_new_path(xd->cc); + cairo_move_to(xd->cc, x[0], y[0]); + for(i = 0; i < n; i++) cairo_line_to(xd->cc, x[i], y[i]); + cairo_stroke(xd->cc); + } +} + +static void Cairo_Polygon(int n, double *x, double *y, + const pGEcontext gc, pDevDesc dd) +{ + int i; + pX11Desc xd = (pX11Desc) dd->deviceSpecific; + + cairo_new_path(xd->cc); + cairo_move_to(xd->cc, x[0], y[0]); + for(i = 0; i < n; i++) cairo_line_to(xd->cc, x[i], y[i]); + cairo_close_path(xd->cc); + + if (R_ALPHA(gc->fill) > 0) { + cairo_set_antialias(xd->cc, CAIRO_ANTIALIAS_NONE); + CairoColor(gc->fill, xd); + cairo_fill_preserve(xd->cc); + cairo_set_antialias(xd->cc, xd->antialias); + } + if (R_ALPHA(gc->col) > 0 && gc->lty != -1) { + CairoColor(gc->col, xd); + CairoLineType(gc, xd); + cairo_stroke(xd->cc); + } +} + +static void Cairo_Path(double *x, double *y, + int npoly, int *nper, + Rboolean winding, + const pGEcontext gc, pDevDesc dd) +{ + int i, j, n; + pX11Desc xd = (pX11Desc) dd->deviceSpecific; + + cairo_new_path(xd->cc); + n = 0; + for (i=0; i < npoly; i++) { + cairo_move_to(xd->cc, x[n], y[n]); + n++; + for(j=1; j < nper[i]; j++) { + cairo_line_to(xd->cc, x[n], y[n]); + n++; + } + cairo_close_path(xd->cc); + } + + if (R_ALPHA(gc->fill) > 0) { + cairo_set_antialias(xd->cc, CAIRO_ANTIALIAS_NONE); + if (winding) + cairo_set_fill_rule(xd->cc, CAIRO_FILL_RULE_WINDING); + else + cairo_set_fill_rule(xd->cc, CAIRO_FILL_RULE_EVEN_ODD); + CairoColor(gc->fill, xd); + cairo_fill_preserve(xd->cc); + cairo_set_antialias(xd->cc, xd->antialias); + } + if (R_ALPHA(gc->col) > 0 && gc->lty != -1) { + CairoColor(gc->col, xd); + CairoLineType(gc, xd); + cairo_stroke(xd->cc); + } +} + +static cairo_surface_t* createImageSurface(unsigned int *raster, int w, int h) +{ + int i; + cairo_surface_t *image; + unsigned char *imageData; + + imageData = (unsigned char *) R_alloc(4*w*h, sizeof(unsigned char)); + /* The R ABGR needs to be converted to a Cairo ARGB + * AND values need to by premultiplied by alpha + */ + for (i=0; i<w*h; i++) { + int alpha = R_ALPHA(raster[i]); + imageData[i*4 + 3] = (unsigned char) alpha; + if (alpha < 255) { + imageData[i*4 + 2] = (unsigned char)(R_RED(raster[i]) * alpha / 255); + imageData[i*4 + 1] = (unsigned char)(R_GREEN(raster[i]) * alpha / 255); + imageData[i*4 + 0] = (unsigned char)(R_BLUE(raster[i]) * alpha / 255); + } else { + imageData[i*4 + 2] = R_RED(raster[i]); + imageData[i*4 + 1] = R_GREEN(raster[i]); + imageData[i*4 + 0] = R_BLUE(raster[i]); + } + } + image = cairo_image_surface_create_for_data(imageData, + CAIRO_FORMAT_ARGB32, + w, h, + 4*w); + return(image); +} + + +static void Cairo_Raster(unsigned int *raster, int w, int h, + double x, double y, + double width, double height, + double rot, + Rboolean interpolate, + const pGEcontext gc, pDevDesc dd) +{ + int imageWidth, imageHeight; + const void *vmax = vmaxget(); + cairo_surface_t *image; + pX11Desc xd = (pX11Desc) dd->deviceSpecific; + + cairo_save(xd->cc); + + /* If we are going to use the graphics engine for interpolation + * the image used for the Cairo surface is going to be a + * different size + */ + if (interpolate && CAIRO_VERSION_MAJOR < 2 && CAIRO_VERSION_MINOR < 6) { + imageWidth = (int) (width + .5); + imageHeight = abs((int) (height + .5)); + } else { + imageWidth = w; + imageHeight = h; + } + + cairo_translate(xd->cc, x, y); + cairo_rotate(xd->cc, -rot*M_PI/180); + cairo_scale(xd->cc, width/imageWidth, height/imageHeight); + /* Flip vertical first */ + cairo_translate(xd->cc, 0, imageHeight/2.0); + cairo_scale(xd->cc, 1, -1); + cairo_translate(xd->cc, 0, -imageHeight/2.0); + + if (interpolate) { + if (CAIRO_VERSION_MAJOR < 2 && CAIRO_VERSION_MINOR < 6) { + /* CAIRO_EXTEND_PAD not supported for image sources + * so use graphics engine for interpolation + */ + unsigned int *rasterImage; + rasterImage = (unsigned int *) R_alloc(imageWidth * imageHeight, + sizeof(unsigned int)); + R_GE_rasterInterpolate(raster, w, h, + rasterImage, imageWidth, imageHeight); + image = createImageSurface(rasterImage, imageWidth, imageHeight); + cairo_set_source_surface(xd->cc, image, 0, 0); + } else { + image = createImageSurface(raster, w, h); + cairo_set_source_surface(xd->cc, image, 0, 0); + cairo_pattern_set_filter(cairo_get_source(xd->cc), + CAIRO_FILTER_BILINEAR); + cairo_pattern_set_extend(cairo_get_source(xd->cc), + CAIRO_EXTEND_PAD); + } + } else { + image = createImageSurface(raster, w, h); + cairo_set_source_surface(xd->cc, image, 0, 0); + cairo_pattern_set_filter(cairo_get_source(xd->cc), + CAIRO_FILTER_NEAREST); + } + + cairo_new_path(xd->cc); + cairo_rectangle(xd->cc, 0, 0, imageWidth, imageHeight); + cairo_clip(xd->cc); + cairo_paint(xd->cc); + + cairo_restore(xd->cc); + cairo_surface_destroy(image); + + vmaxset(vmax); +} + +#ifndef NO_X11 +static SEXP Cairo_Cap(pDevDesc dd) +{ + int i, width, height, size; + pX11Desc xd = (pX11Desc) dd->deviceSpecific; + cairo_surface_t* screen; + cairo_format_t format; + unsigned int *screenData; + SEXP dim, raster = R_NilValue; + unsigned int *rint; + + screen = cairo_surface_reference(cairo_get_target(xd->cc)); + width = cairo_image_surface_get_width(screen); + height = cairo_image_surface_get_height(screen); + screenData = (unsigned int*) cairo_image_surface_get_data(screen); + + /* The type of image surface will depend on what sort + * of X11 color model has been used */ + format = cairo_image_surface_get_format(screen); + /* For now, if format is not RGB24 just bail out */ + if (format != CAIRO_FORMAT_RGB24) { + cairo_surface_destroy(screen); + return raster; + } + + size = width*height; + + /* FIXME: the screen surface reference will leak if allocVector() fails */ + PROTECT(raster = allocVector(INTSXP, size)); + + /* Copy each byte of screen to an R matrix. + * The Cairo RGB24 needs to be converted to an R ABGR32. + * Cairo uses native endiannes (A=msb,R,G,B=lsb) so use int* instead of char* */ + rint = (unsigned int *) INTEGER(raster); + for (i = 0; i < size; i++) + rint[i] = R_RGB((screenData[i] >> 16) & 255, (screenData[i] >> 8) & 255, screenData[i] & 255); + + /* Release MY reference to the screen surface (do it here in case anything fails below) */ + cairo_surface_destroy(screen); + + PROTECT(dim = allocVector(INTSXP, 2)); + INTEGER(dim)[0] = height; + INTEGER(dim)[1] = width; + setAttrib(raster, R_DimSymbol, dim); + + UNPROTECT(2); + return raster; +} +#endif + +#ifdef HAVE_PANGOCAIRO +/* ------------- pangocairo section --------------- */ + +static PangoFontDescription +*PG_getFont(const pGEcontext gc, double fs, const char *family) +{ + PangoFontDescription *fontdesc; + gint face = gc->fontface; + double size = gc->cex * gc->ps * fs, ssize = PANGO_SCALE * size; +#ifdef Win32 + const char *times = "Times New Roman", *hv = "Arial"; +#else + const char *times = "times", *hv = "Helvetica"; +#endif + if (face < 1 || face > 5) face = 1; + + fontdesc = pango_font_description_new(); + if (face == 5) + pango_font_description_set_family(fontdesc, "symbol"); + else { + const char *fm = gc->fontfamily; + if (!fm[0]) fm = family; + if (streql(fm, "mono")) fm = "courier"; + else if (streql(fm, "serif")) fm = times; + else if (streql(fm, "sans")) fm = hv; + pango_font_description_set_family(fontdesc, fm); + if (face == 2 || face == 4) + pango_font_description_set_weight(fontdesc, PANGO_WEIGHT_BOLD); + if (face == 3 || face == 4) + pango_font_description_set_style(fontdesc, PANGO_STYLE_OBLIQUE); + } + /* seems a ssize < 1 gums up pango, PR#14369 */ + if (ssize < 1) ssize = 1.0; + pango_font_description_set_size(fontdesc, (gint) ssize); + + return fontdesc; +} + +static PangoLayout +*PG_layout(PangoFontDescription *desc, cairo_t *cc, const char *str) +{ + PangoLayout *layout; + + layout = pango_cairo_create_layout(cc); + pango_layout_set_font_description(layout, desc); + pango_layout_set_text(layout, str, -1); + return layout; +} + +static void +PG_text_extents(cairo_t *cc, PangoLayout *layout, + gint *lbearing, gint *rbearing, + gint *width, gint *ascent, gint *descent, int ink) +{ + PangoRectangle rect, lrect; + + // This could be pango_layout_get_line_readonly since 1.16 + // Something like #if PANGO_VERSION_CHECK(1,16,0) + pango_layout_line_get_pixel_extents(pango_layout_get_line(layout, 0), + &rect, &lrect); + + if (width) *width = lrect.width; + if (ink) { + if (ascent) *ascent = PANGO_ASCENT(rect); + if (descent) *descent = PANGO_DESCENT(rect); + if (lbearing) *lbearing = PANGO_LBEARING(rect); + if (rbearing) *rbearing = PANGO_RBEARING(rect); + } else { + if (ascent) *ascent = PANGO_ASCENT(lrect); + if (descent) *descent = PANGO_DESCENT(lrect); + if (lbearing) *lbearing = PANGO_LBEARING(lrect); + if (rbearing) *rbearing = PANGO_RBEARING(lrect); + } +} + +static void +PangoCairo_MetricInfo(int c, const pGEcontext gc, + double* ascent, double* descent, + double* width, pDevDesc dd) +{ + pX11Desc xd = (pX11Desc) dd->deviceSpecific; + char str[16]; + int Unicode = mbcslocale; + PangoFontDescription *desc = + PG_getFont(gc, xd->fontscale, xd->basefontfamily); + PangoLayout *layout; + gint iascent, idescent, iwidth; + + if (c == 0) c = 77; + if (c < 0) {c = -c; Unicode = 1;} + + if (Unicode) { + Rf_ucstoutf8(str, (unsigned int) c); + } else { + /* Here we assume that c < 256 */ + str[0] = (char) c; str[1] = (char) 0; + } + layout = PG_layout(desc, xd->cc, str); + PG_text_extents(xd->cc, layout, NULL, NULL, &iwidth, + &iascent, &idescent, 1); + g_object_unref(layout); + pango_font_description_free(desc); + *ascent = iascent; + *descent = idescent; + *width = iwidth; +#if 0 + printf("c = %d, '%s', face %d %f %f %f\n", + c, str, gc->fontface, *width, *ascent, *descent); +#endif +} + + +static double +PangoCairo_StrWidth(const char *str, const pGEcontext gc, pDevDesc dd) +{ + pX11Desc xd = (pX11Desc) dd->deviceSpecific; + gint width; + PangoFontDescription *desc = + PG_getFont(gc, xd->fontscale, xd->basefontfamily); + PangoLayout *layout = PG_layout(desc, xd->cc, str); + + PG_text_extents(xd->cc, layout, NULL, NULL, &width, NULL, NULL, 0); + g_object_unref(layout); + pango_font_description_free(desc); + return (double) width; +} + +static void +PangoCairo_Text(double x, double y, + const char *str, double rot, double hadj, + const pGEcontext gc, pDevDesc dd) +{ + if (R_ALPHA(gc->col) > 0) { + pX11Desc xd = (pX11Desc) dd->deviceSpecific; + gint ascent, lbearing, width; + PangoLayout *layout; + PangoFontDescription *desc = + PG_getFont(gc, xd->fontscale, xd->basefontfamily); + cairo_save(xd->cc); + layout = PG_layout(desc, xd->cc, str); + PG_text_extents(xd->cc, layout, &lbearing, NULL, &width, + &ascent, NULL, 0); + cairo_move_to(xd->cc, x, y); + if (rot != 0.0) cairo_rotate(xd->cc, -rot/180.*M_PI); + /* pango has a coord system at top left */ + cairo_rel_move_to(xd->cc, -lbearing - width*hadj, -ascent); + CairoColor(gc->col, xd); + pango_cairo_show_layout(xd->cc, layout); + cairo_restore(xd->cc); + g_object_unref(layout); + pango_font_description_free(desc); + } +} + +#else +/* ------------- cairo-ft section --------------- */ + +/* This uses what cairo refers to as its 'toy' interface: + http://cairographics.org/manual/cairo-text.html + + No diagnostics that glyphs are present, no kerning. + */ + +#ifdef __APPLE__ +# define USE_FC 1 +#endif + +#if CAIRO_HAS_FT_FONT && USE_FC + +/* FT implies FC in Cairo */ +#include <cairo-ft.h> + +/* cairo font cache - to prevent unnecessary font look ups */ +typedef struct Rc_font_cache_s { + const char *family; + int face; + cairo_font_face_t *font; + struct Rc_font_cache_s *next; +} Rc_font_cache_t; + +static Rc_font_cache_t *cache, *cache_tail; + +static cairo_font_face_t *Rc_findFont(const char *family, int face) +{ + Rc_font_cache_t *here = cache; + while (here) { + if (here->face == face && streql(here->family, family)) + return here->font; + here = here->next; + } + return NULL; +} + +static void Rc_addFont(const char *family, int face, cairo_font_face_t* font) +{ + Rc_font_cache_t *fc = (Rc_font_cache_t*) malloc(sizeof(Rc_font_cache_t)); + if (!fc) return; + fc->family = strdup(family); + fc->face = face; + fc->font = font; + fc->next = NULL; + if (cache) + cache_tail = cache_tail->next = fc; + else + cache = cache_tail = fc; +} + +/* FC patterns to append to font family names */ +static const char *face_styles[4] = { + ":style=Regular", + ":style=Bold", + ":style=Italic", + ":style=Bold Italic,BoldItalic" +}; + +static int fc_loaded; +static FT_Library ft_library; + +/* use FC to find a font, load it in FT and return the Cairo FT font face */ +static cairo_font_face_t *FC_getFont(const char *family, int style) +{ + FcFontSet *fs; + FcPattern *pat, *match; + FcResult result; + FcChar8 *file; + char fcname[250]; /* 200 for family + 50 for style */ + + /* find candidate fonts via FontConfig */ + if (!fc_loaded) { + if (!FcInit()) return NULL; + fc_loaded = 1; + } + style &= 3; + strcpy(fcname, family); + strcat(fcname, face_styles[style]); + pat = FcNameParse((FcChar8 *)fcname); + if (!pat) return NULL; + FcConfigSubstitute (0, pat, FcMatchPattern); + FcDefaultSubstitute (pat); + fs = FcFontSetCreate (); + match = FcFontMatch (0, pat, &result); + FcPatternDestroy (pat); + if (!match) { + FcFontSetDestroy (fs); + return NULL; + } + FcFontSetAdd (fs, match); + + /* then try to load the font into FT */ + if (fs) { + int j = 0, index = 0; + while (j < fs->nfont) { + /* find the font file + face index and use it with FreeType */ + if (FcPatternGetString (fs->fonts[j], FC_FILE, 0, &file) + == FcResultMatch && + FcPatternGetInteger(fs->fonts[j], FC_INDEX, 0, &index) + == FcResultMatch) { + FT_Face face; + if (!ft_library && FT_Init_FreeType(&ft_library)) { + FcFontSetDestroy (fs); + return NULL; + } + /* some FreeType versions have broken index support, + fall back to index 0 */ + if (!FT_New_Face(ft_library, + (const char *) file, index, &face) || + (index && !FT_New_Face(ft_library, + (const char *) file, 0, &face))) { + FcFontSetDestroy (fs); + +#ifdef __APPLE__ + /* FreeType is broken on macOS in that face index + is often wrong (unfortunately even for Helvetica!) + - we try to find the best match through enumeration. + And italic and bold are swapped */ + if (style == 2) style = 1; else if (style == 1) style = 2; + if (face->num_faces > 1 && + (face->style_flags & 3) != style) { + FT_Face alt_face; + int i = 0; + while (i < face->num_faces) + if (!FT_New_Face(ft_library, + (const char *) file, + i++, &alt_face)) { + if ((alt_face->style_flags & 3) == style) { + FT_Done_Face(face); + face = alt_face; + break; + } else FT_Done_Face(alt_face); + } + } +#endif + + return cairo_ft_font_face_create_for_ft_face(face, FT_LOAD_DEFAULT); + } + } + j++; + } + FcFontSetDestroy (fs); + } + return NULL; +} + +static void FT_getFont(pGEcontext gc, pDevDesc dd, double fs) +{ + pX11Desc xd = (pX11Desc) dd->deviceSpecific; + int face = gc->fontface; + double size = gc->cex * gc->ps *fs; + cairo_font_face_t *cairo_face = NULL; + const char *family; +#ifdef Win32 + char *times = "Times New Roman", *hv = "Arial"; +#else + char *times = "times", *hv = "Helvetica"; +#endif + + if (face < 1 || face > 5) face = 1; + family = gc->fontfamily; + if (face == 5) { +#ifdef Win32 + if (!*family) family = "Standard Symbols L"; +#else + if (!*family) family = "Symbol"; +#endif + } else { + if (!*family) family = xd->basefontfamily; + if (streql(family, "sans")) family = hv; + else if (streql(family, "serif")) family = times; + else if (streql(family, "mono")) family = "Courier"; + } + /* check the cache first */ + cairo_face = Rc_findFont(family, face); + if (!cairo_face) { + cairo_face = FC_getFont(family, face - 1); + if (!cairo_face) return; /* No message? */ + Rc_addFont(family, face, cairo_face); + } + cairo_set_font_face (xd->cc, cairo_face); + /* FIXME: this should really use cairo_set_font_matrix + if pixels are non-square on a screen device. */ + cairo_set_font_size (xd->cc, size); +} + +#else + +static void FT_getFont(pGEcontext gc, pDevDesc dd, double fs) +{ + pX11Desc xd = (pX11Desc) dd->deviceSpecific; + int face = gc->fontface; + double size = gc->cex * gc->ps *fs; + char *family; + int slant = CAIRO_FONT_SLANT_NORMAL, wt = CAIRO_FONT_WEIGHT_NORMAL; +#ifdef Win32 + char *times = "Times New Roman", *hv = "Arial"; +#else + char *times = "times", *hv = "Helvetica"; +#endif + + if (face < 1 || face > 5) face = 1; + if (face == 5) family = "Symbol"; + if (face == 2 || face == 4) wt = CAIRO_FONT_WEIGHT_BOLD; + if (face == 3 || face == 4) slant = CAIRO_FONT_SLANT_ITALIC; + if (face != 5) { + /* This is a 'toy', remember? + The manual recommnends the CSS2 names "serif", "sans-serif", + "monospace" */ + char *fm = gc->fontfamily; + if (!fm[0]) fm = xd->basefontfamily; + if (streql(fm, "mono")) family = "courier"; + else if (streql(fm, "serif")) family = times; + else if (streql(fm, "sans")) family = hv; + else if (fm[0]) family = fm; + } + + cairo_select_font_face (xd->cc, family, slant, wt); + /* FIXME: this should really use cairo_set_font_matrix + if pixels are non-square on a screen device. */ + cairo_set_font_size (xd->cc, size); +} +#endif + +static void Cairo_MetricInfo(int c, pGEcontext gc, + double* ascent, double* descent, + double* width, pDevDesc dd) +{ + pX11Desc xd = (pX11Desc) dd->deviceSpecific; + cairo_text_extents_t exts; + char str[16]; + int Unicode = mbcslocale; + + if (c == 0) c = 77; + if (c < 0) {c = -c; Unicode = 1;} + + if (Unicode) { + Rf_ucstoutf8(str, (unsigned int) c); + } else { + /* Here, we assume that c < 256 */ + str[0] = (char)c; str[1] = 0; + } + + FT_getFont(gc, dd, xd->fontscale); + cairo_text_extents(xd->cc, str, &exts); + *ascent = -exts.y_bearing; + *descent = exts.height + exts.y_bearing; + *width = exts.x_advance; +} + +static double Cairo_StrWidth(const char *str, pGEcontext gc, pDevDesc dd) +{ + pX11Desc xd = (pX11Desc) dd->deviceSpecific; + cairo_text_extents_t exts; + + if (!utf8Valid(str)) error("invalid string in Cairo_StrWidth"); + FT_getFont(gc, dd, xd->fontscale); + cairo_text_extents(xd->cc, str, &exts); + return exts.x_advance; +} + +static void Cairo_Text(double x, double y, + const char *str, double rot, double hadj, + pGEcontext gc, pDevDesc dd) +{ + if (!utf8Valid(str)) error("invalid string in Cairo_Text"); + if (R_ALPHA(gc->col) > 0) { + pX11Desc xd = (pX11Desc) dd->deviceSpecific; + cairo_save(xd->cc); + FT_getFont(gc, dd, xd->fontscale); + cairo_move_to(xd->cc, x, y); + if (hadj != 0.0 || rot != 0.0) { + cairo_text_extents_t te; + cairo_text_extents(xd->cc, str, &te); + if (rot != 0.0) cairo_rotate(xd->cc, -rot/180.*M_PI); + if (hadj != 0.0) + cairo_rel_move_to(xd->cc, -te.x_advance * hadj, 0); + } + CairoColor(gc->col, xd); + cairo_show_text(xd->cc, str); + cairo_restore(xd->cc); + } +} +#endif diff --git a/com.oracle.truffle.r.native/gnur/patch/src/library/grDevices/src/chull.c b/com.oracle.truffle.r.native/gnur/patch/src/library/grDevices/src/chull.c new file mode 100644 index 0000000000000000000000000000000000000000..69347dcea61f071633526d96bbcca84b937cd2b6 --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/library/grDevices/src/chull.c @@ -0,0 +1,441 @@ +/* + * chull finds the convex hull of a set of points in the plane. + * + * It is based on a C translation (by f2c) of + * ACM TOMS algorithm 523 by W. F. Eddy, vol 3 (1977), 398-403, 411-2. + * + * converted to double precision, output order altered + * by B.D. Ripley, March 1999 + * + */ + +#ifdef HAVE_CONFIG_H +# include <config.h> +#endif + +#include <R_ext/Boolean.h> /* TRUE,... */ + +static void split(int n, double *x, + int m, int *in, + int ii, int jj, + int s, + int *iabv, int *na, int *maxa, + int *ibel, int *nb, int *maxb) +{ +/* split() takes the m points of array x whose + subscripts are in array in and partitions them by the + line joining the two points in array x whose subscripts are ii and jj. + The subscripts of the points above the line are put into array + iabv, and the subscripts of the points below are put into array ibel. + + na and nb are, respectively, the number of points + above the line and the number below. + maxa and maxb are the subscripts for array + x of the point furthest above the line and the point + furthest below, respectively. if either subset is null + the corresponding subscript (maxa or maxb) is set to zero. + + formal parameters + INPUT + n integer total number of data points + x real array (2,n) (x,y) co-ordinates of the data + m integer number of points in input subset + in integer array (m) subscripts for array x of the + points in the input subset + ii integer subscript for array x of one point + on the partitioning line + jj integer subscript for array x of another + point on the partitioning line + s integer switch to determine output. + refer to comments below + OUTPUT + iabv integer array (m) subscripts for array x of the + points above the partitioning line + na integer number of elements in iabv + maxa integer subscript for array x of point + furthest above the line. + set to zero if na is zero + ibel integer array (m) subscripts for array x of the + points below the partitioning line + nb integer number of elements in ibel + maxb integer subscript for array x of point + furthest below the line. + set to zero if nb is zero + + if s = 2 dont save ibel,nb,maxb. + if s =-2 dont save iabv,na,maxa. + otherwise save everything + if s is positive the array being partitioned is above + the initial partitioning line. + if it is negative, then the set of points is below. +*/ + + /* Local variables (=0 : -Wall) */ + double a=0, b=0, down, d1, up, xt, z; + int i, is; + Rboolean vert, neg_dir=0; + + /* Parameter adjustments */ + --x; + + xt = x[ii]; + /* Check to see if the line is vertical */ + vert = (x[jj] == xt); + d1 = x[jj + n] - x[ii + n]; + if (vert) { + neg_dir = ((s > 0 && d1 < 0.) || (s < 0 && d1 > 0.)); + } else { + a = d1 / (x[jj] - xt); + b = x[ii + n] - a * xt; + } + up = 0.; *na = 0; *maxa = 0; + down = 0.; *nb = 0; *maxb = 0; + for (i = 0; i < m; ++i) { + is = in[i]; + if (vert) { + if(neg_dir) z = xt - x[is]; + else z = x[is] - xt; + } else { + z = x[is + n] - a * x[is] - b; + } + if (z > 0.) { /* the point is ABOVE the line */ + if (s == -2) continue; + iabv[*na] = is; + ++(*na); + if (z >= up) { + up = z; + *maxa = *na; + } + } + else if (s != 2 && z < 0.) { /* the point is BELOW the line */ + ibel[*nb] = is; + ++(*nb); + if (z <= down) { + down = z; + *maxb = *nb; + } + } + } +} + +static void in_chull(int *n, double *x, int *m, int *in, + int *ia, int *ib, int *ih, int *nh, int *il) +{ +/* this subroutine determines which of the m points of array + x whose subscripts are in array in are vertices of the + minimum area convex polygon containing the m points. the + subscripts of the vertices are placed in array ih in the + order they are found. nh is the number of elements in + array ih and array il. array il is a linked list giving + the order of the elements of array ih in a counter + clockwise direction. this algorithm corresponds to a + preorder traversal of a certain binary tree. each vertex + of the binary tree represents a subset of the m points. + at each step the subset of points corresponding to the + current vertex of the tree is partitioned by a line + joining two vertices of the convex polygon. the left son + vertex in the binary tree represents the subset of points + above the partitioning line and the right son vertex, the + subset below the line. the leaves of the tree represent + either null subsets or subsets inside a triangle whose + vertices coincide with vertices of the convex polygon. + + formal parameters + INPUT + n integer total number of data points (= nrow(x)) + x real array (2,n) (x,y) co-ordinates of the data + m integer number of points in the input subset + in integer array (m) subscripts for array x of the points + in the input subset + work area + ia integer array (m) subscripts for array x of left son subsets. + see comments after dimension statements + ib integer array (m) subscripts for array x of right son subsets + + OUTPUT + ih integer array (m) subscripts for array x of the + vertices of the convex hull + nh integer number of elements in arrays ih and il. + == number of vertices of the convex polygon + il is used internally here. + il integer array (m) a linked list giving in order in a + counter-clockwise direction the + elements of array ih + the upper end of array ia is used to store temporarily + the sizes of the subsets which correspond to right son + vertices, while traversing down the left sons when on the + left half of the tree, and to store the sizes of the left + sons while traversing the right sons(down the right half) + */ +#define y(k) x[k + x_dim1] + + Rboolean mine, maxe; + int i, j, ilinh, ma, mb, kn, mm, kx, mx, mp1, mbb, nia, nib, + inh, min, mxa, mxb, mxbb; + int x_dim1, x_offset; + double d1; + + /* Parameter adjustments */ + x_dim1 = *n; + x_offset = 1; + x -= x_offset; + --il; + --ih; + --ib; + --ia; + --in; + + if (*m == 1) { + goto L_1pt; + } + il[1] = 2; + il[2] = 1; + kn = in[1]; + kx = in[2]; + if (*m == 2) { + goto L_2pts; + } + mp1 = *m + 1; + min = 1; + mx = 1; + kx = in[1]; + maxe = FALSE; + mine = FALSE; + /* find two vertices of the convex hull for the initial partition */ + for (i = 2; i <= *m; ++i) { + j = in[i]; + if ((d1 = x[j] - x[kx]) < 0.) { + } else if (d1 == 0) { + maxe = TRUE; + } else { + maxe = FALSE; + mx = i; + kx = j; + } + if ((d1 = x[j] - x[kn]) < 0.) { + mine = FALSE; + min = i; + kn = j; + } else if (d1 == 0) { + mine = TRUE; + } + } + + if (kx == kn) { /* if the max and min are equal, + * all m points lie on a vertical line */ + goto L_vertical; + } + + if (maxe || mine) {/* if maxe (or mine) is TRUE, there are several + maxima (or minima) with equal first coordinates */ + + if (maxe) {/* have several points with the (same) largest x[] */ + for (i = 1; i <= *m; ++i) { + j = in[i]; + if (x[j] != x[kx]) continue; + if (y(j) <= y(kx)) continue; + mx = i; + kx = j; + } + } + + if (mine) {/* have several points with the (same) smallest x[] */ + for (i = 1; i <= *m; ++i) { + j = in[i]; + if (x[j] != x[kn]) continue; + if (y(j) >= y(kn)) continue; + min = i; + kn = j; + } + } + + } + +/* L7:*/ + ih[1] = kx; + ih[2] = kn; + *nh = 3; + inh = 1; + nib = 1; + ma = *m; + in[mx] = in[*m]; + in[*m] = kx; + mm = *m - 2; + if (min == *m) { + min = mx; + } + in[min] = in[*m - 1]; + in[*m - 1] = kn; +/* begin by partitioning the root of the tree */ + split(*n, &x[x_offset], mm, &in[1], + ih[1], ih[2], + 0, + &ia[1], &mb, &mxa, + &ib[1], &ia[ma], &mxbb); + +/* first traverse the LEFT HALF of the tree */ + +/* start with the left son */ + L8: + nib += ia[ma]; + --ma; + do { + if (mxa != 0) { + il[*nh] = il[inh]; + il[inh] = *nh; + ih[*nh] = ia[mxa]; + ia[mxa] = ia[mb]; + --mb; + ++(*nh); + if (mb != 0) { + ilinh = il[inh]; + split(*n, &x[x_offset], mb, &ia[1], + ih[inh], ih[ilinh], + 1, + &ia[1], &mbb, &mxa, + &ib[nib], &ia[ma], &mxb); + mb = mbb; + goto L8; + } +/* then the right son */ + inh = il[inh]; + } + + do { + inh = il[inh]; + ++ma; + nib -= ia[ma]; + if (ma >= *m) goto L12; + } while(ia[ma] == 0); + ilinh = il[inh]; +/* on the left side of the tree, the right son of a right son */ +/* must represent a subset of points which is inside a */ +/* triangle with vertices which are also vertices of the */ +/* convex polygon and hence the subset may be neglected. */ + split(*n, &x[x_offset], ia[ma], &ib[nib], + ih[inh], ih[ilinh], + 2, + &ia[1], &mb, &mxa, + &ib[nib], &mbb, &mxb); + ia[ma] = mbb; + } while(TRUE); + +/* now traverse the RIGHT HALF of the tree */ + L12: + mxb = mxbb; + ma = *m; + mb = ia[ma]; + nia = 1; + ia[ma] = 0; +/* start with the right son */ + L13: + nia += ia[ma]; + --ma; + + do { + if (mxb != 0) { + il[*nh] = il[inh]; + il[inh] = *nh; + ih[*nh] = ib[mxb]; + ib[mxb] = ib[mb]; + --mb; + ++(*nh); + if (mb != 0) { + ilinh = il[inh]; + split(*n, &x[x_offset], mb, &ib[nib], + ih[inh], ih[ilinh], + -1, + &ia[nia], &ia[ma], &mxa, + &ib[nib], &mbb, &mxb); + mb = mbb; + goto L13; + } + +/* then the left son */ + inh = il[inh]; + } + + do { + inh = il[inh]; + ++ma; + nia -= ia[ma]; + if (ma == mp1) goto Finis; + } while(ia[ma] == 0); + ilinh = il[inh]; +/* on the right side of the tree, the left son of a left son */ +/* must represent a subset of points which is inside a */ +/* triangle with vertices which are also vertices of the */ +/* convex polygon and hence the subset may be neglected. */ + split(*n, &x[x_offset], ia[ma], &ia[nia], + ih[inh], ih[ilinh], + -2, + &ia[nia], &mbb, &mxa, + &ib[nib], &mb, &mxb); + } while(TRUE); + +/* -------------------------------------------------------------- */ + + L_vertical:/* all the points lie on a vertical line */ + + kx = in[1]; + kn = in[1]; + for (i = 1; i <= *m; ++i) { + j = in[i]; + if (y(j) > y(kx)) { + mx = i; + kx = j; + } + if (y(j) < y(kn)) { + min = i; + kn = j; + } + } + if (kx == kn) goto L_1pt; + + L_2pts:/* only two points */ + ih[1] = kx; + ih[2] = kn; + if (x[kn] == x[kx] && y(kn) == y(kx)) + *nh = 2; + else + *nh = 3; + goto Finis; + + L_1pt:/* only one point */ + *nh = 2; + ih[1] = in[1]; + il[1] = 1; + + Finis: + --(*nh); + /* put the results in order, as given by IH */ + for (i = 1; i <= *nh; ++i) { + ia[i] = ih[i]; + } + j = il[1]; + for (i = 2; i <= *nh; ++i) { + ih[i] = ia[j]; + j = il[j]; + } + return; + +#undef y +} /* chull */ + +#include <Rinternals.h> +SEXP chull(SEXP x) +{ + // x is a two-column matrix + int n = nrows(x), nh; + int *in = (int*)R_alloc(n, sizeof(int)); + for (int i = 0; i < n; i++) in[i] = i+1; + int *ih = (int*)R_alloc(4*n, sizeof(int)); + x = PROTECT(coerceVector(x, REALSXP)); + if(TYPEOF(x) != REALSXP) error("'x' is not numeric"); + in_chull(&n, REAL(x), &n, in, ih+n, ih+2*n, ih, &nh, ih+3*n); + SEXP ans = allocVector(INTSXP, nh); + int *ians = INTEGER(ans); + for (int i = 0; i < nh; i++) ians[i] = ih[nh - 1 -i]; + UNPROTECT(1); + return ans; +} diff --git a/com.oracle.truffle.r.native/gnur/patch/src/library/grDevices/src/colors.c b/com.oracle.truffle.r.native/gnur/patch/src/library/grDevices/src/colors.c new file mode 100644 index 0000000000000000000000000000000000000000..a500f496edb448c4b0768531f2687982562e782f --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/library/grDevices/src/colors.c @@ -0,0 +1,1588 @@ +/* + * R : A Computer Language for Statistical Data Analysis + * Copyright (C) 1997-2014 The R Core Team + * Copyright (C) 2003 The R Foundation + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version. + * + * This program 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 this program; if not, a copy is available at + * https://www.R-project.org/Licenses/ + */ + +/* This should be regarded as part of the graphics engine */ + +#ifdef HAVE_CONFIG_H +#include <config.h> +#endif + +#include <Defn.h> +#include <R_ext/GraphicsEngine.h> + +#include "grDevices.h" + +static char ColBuf[10]; +static char HexDigits[] = "0123456789ABCDEF"; + +static +char *RGB2rgb(unsigned int r, unsigned int g, unsigned int b) +{ + ColBuf[0] = '#'; + ColBuf[1] = HexDigits[(r >> 4) & 15]; + ColBuf[2] = HexDigits[r & 15]; + ColBuf[3] = HexDigits[(g >> 4) & 15]; + ColBuf[4] = HexDigits[g & 15]; + ColBuf[5] = HexDigits[(b >> 4) & 15]; + ColBuf[6] = HexDigits[b & 15]; + ColBuf[7] = '\0'; + return &ColBuf[0]; +} + +static +char *RGBA2rgb(unsigned int r, unsigned int g, unsigned int b, unsigned int a) +{ + ColBuf[0] = '#'; + ColBuf[1] = HexDigits[(r >> 4) & 15]; + ColBuf[2] = HexDigits[r & 15]; + ColBuf[3] = HexDigits[(g >> 4) & 15]; + ColBuf[4] = HexDigits[g & 15]; + ColBuf[5] = HexDigits[(b >> 4) & 15]; + ColBuf[6] = HexDigits[b & 15]; + ColBuf[7] = HexDigits[(a >> 4) & 15]; + ColBuf[8] = HexDigits[a & 15]; + ColBuf[9] = '\0'; + return &ColBuf[0]; +} + + +static unsigned int ScaleColor(double x) +{ + if (ISNA(x)) + error(_("color intensity %s, not in [0,1]"), "NA"); + if (!R_FINITE(x) || x < 0.0 || x > 1.0) + error(_("color intensity %g, not in [0,1]"), x); + return (unsigned int)(255*x + 0.5); +} + +static unsigned int CheckColor(int x) +{ + if (x == NA_INTEGER) + error(_("color intensity %s, not in 0:255"), "NA"); + if (x < 0 || x > 255) + error(_("color intensity %d, not in 0:255"), x); + return (unsigned int)x; +} + +static unsigned int ScaleAlpha(double x) +{ + if (ISNA(x)) + error(_("alpha level %s, not in [0,1]"), "NA"); + if (!R_FINITE(x) || x < 0.0 || x > 1.0) + error(_("alpha level %g, not in [0,1]"), x); + return (unsigned int)(255*x + 0.5); +} + +static unsigned int CheckAlpha(int x) +{ + if (x == NA_INTEGER) + error(_("alpha level %s, not in 0:255"), "NA"); + if (x < 0 || x > 255) + error(_("alpha level %d, not in 0:255"), x); + return (unsigned int)x; +} + +/* hsv2rgb -- HSV to RGB conversion */ +/* Based on HSV_TO_RGB from Foley and Van Dam First Ed. Page 616 */ +/* See Alvy Ray Smith, Color Gamut Transform Pairs, SIGGRAPH '78 */ + +static void hsv2rgb(double h, double s, double v, + double *r, double *g, double *b) +{ + double f, p, q, t; + int i; + + if (!R_FINITE(h) || !R_FINITE(s) || !R_FINITE(v)) + error(_("inputs must be finite")); + f = modf(h * 6.0, &t); + i = ((int) t) % 6; + + p = v * (1 - s); + q = v * (1 - s * f); + t = v * (1 - (s * (1 - f))); + switch (i) { + case 0: *r = v; *g = t; *b = p; break; + case 1: *r = q; *g = v; *b = p; break; + case 2: *r = p; *g = v; *b = t; break; + case 3: *r = p; *g = q; *b = v; break; + case 4: *r = t; *g = p; *b = v; break; + case 5: *r = v; *g = p; *b = q; break; + default: + error(_("bad hsv to rgb color conversion")); + } +} + +/* rgb2hsv() -- the reverse (same reference as above) + * this implementation is adapted from code by Nicholas Lewin-Koh. + */ +static void rgb2hsv(double r, double g, double b, + double *h, double *s, double *v) + /* all (r,g,b, h,s,v) values in [0,1] */ +{ + double min, max, delta; + Rboolean r_max = TRUE, b_max = FALSE; + /* Compute min(r,g,b) and max(r,g,b) and remember where max is: */ + min = max = r; + if(min > g) { /* g < r */ + if(b < g) + min = b;/* & max = r */ + else { /* g <= b, g < r */ + min = g; + if(b > r) { max = b; b_max = TRUE; r_max = FALSE; } + /* else : g <= b <=r */ + } + } else { /* r <= g */ + if(b > g) { + max = b; b_max = TRUE; r_max = FALSE; /* & min = r */ + } else { /* b,r <= g */ + max = g; r_max = FALSE; /* & min = r */ + if(b < r) min = b; /* else : r <= b <= g */ + } + } + + *v = max; + if( max == 0 || (delta = max - min) == 0) { + /* r = g = b : "gray" : s = h = 0 */ + *s = *h = 0; + return; + } + /* else : */ + *s = delta / max; + + if(r_max) + *h = ( g - b ) / delta; /* between yellow & magenta */ + else if(b_max) + *h = 4 + ( r - g ) / delta; /* between magenta & cyan */ + else /* g == max */ + *h = 2 + ( b - r ) / delta; /* between cyan & yellow*/ + + *h /= 6; + if(*h < 0) + *h += 1.; + return; +} + + +SEXP hsv(SEXP h, SEXP s, SEXP v, SEXP a) +{ + double hh, ss, vv, aa, r=0., g=0., b=0.; /* -Wall */ + R_xlen_t i, max, nh, ns, nv, na = 1; + + PROTECT(h = coerceVector(h,REALSXP)); + PROTECT(s = coerceVector(s,REALSXP)); + PROTECT(v = coerceVector(v,REALSXP)); + if (!isNull(a)) { + a = coerceVector(a, REALSXP); + na = XLENGTH(a); + } + PROTECT(a); + + nh = XLENGTH(h); + ns = XLENGTH(s); + nv = XLENGTH(v); + if (nh <= 0 || ns <= 0 || nv <= 0 || na <= 0) { + UNPROTECT(4); + return allocVector(STRSXP, 0); + } + max = nh; + if (max < ns) max = ns; + if (max < nv) max = nv; + if (max < na) max = na; + SEXP c = PROTECT(allocVector(STRSXP, max)); + if(max == 0) { + UNPROTECT(5); + return(c); + } + + if(isNull(a)) { + for (i = 0; i < max; i++) { + hh = REAL(h)[i % nh]; + ss = REAL(s)[i % ns]; + vv = REAL(v)[i % nv]; + if (hh < 0 || hh > 1 || ss < 0 || ss > 1 || vv < 0 || vv > 1) + error(_("invalid hsv color")); + hsv2rgb(hh, ss, vv, &r, &g, &b); + SET_STRING_ELT(c, i, mkChar(RGB2rgb(ScaleColor(r), ScaleColor(g), + ScaleColor(b)))); + + } + } else { + for (i = 0; i < max; i++) { + hh = REAL(h)[i % nh]; + ss = REAL(s)[i % ns]; + vv = REAL(v)[i % nv]; + aa = REAL(a)[i % na]; + if (hh < 0 || hh > 1 || ss < 0 || ss > 1 || vv < 0 || vv > 1 || + aa < 0 || aa > 1) + error(_("invalid hsv color")); + hsv2rgb(hh, ss, vv, &r, &g, &b); + SET_STRING_ELT(c, i, mkChar(RGBA2rgb(ScaleColor(r), ScaleColor(g), + ScaleColor(b), ScaleAlpha(aa)))); + } + } + UNPROTECT(5); + return c; +} + +/* D65 White Point */ + +#define WHITE_X 95.047 +#define WHITE_Y 100.000 +#define WHITE_Z 108.883 +#define WHITE_u 0.1978398 +#define WHITE_v 0.4683363 + +/* Standard CRT Gamma */ + +#define GAMMA 2.4 + +static double gtrans(double u) +{ + if (u > 0.00304) + return 1.055 * pow(u, (1 / GAMMA)) - 0.055; + else + return 12.92 * u; +} + +static int FixupColor(int *r, int *g, int *b) +{ + int fix = 0; + if (*r < 0) { *r = 0; fix = 1; } else if (*r > 255) { *r = 255; fix = 1; } + if (*g < 0) { *g = 0; fix = 1; } else if (*g > 255) { *g = 255; fix = 1; } + if (*b < 0) { *b = 0; fix = 1; } else if (*b > 255) { *b = 255; fix = 1; } + return fix; +} + +static void +hcl2rgb(double h, double c, double l, double *R, double *G, double *B) +{ + if (l <= 0.0) { + *R = *G = *B = 0.0; + return; + } + double L, U, V; + double u, v; + double X, Y, Z; + + /* Step 1 : Convert to CIE-LUV */ + + h = DEG2RAD * h; + L = l; + U = c * cos(h); + V = c * sin(h); + + /* Step 2 : Convert to CIE-XYZ */ + + if (L <= 0 && U == 0 && V == 0) { + X = 0; Y = 0; Z = 0; + } + else { + Y = WHITE_Y * ((L > 7.999592) ? pow((L + 16)/116, 3) : L / 903.3); + u = U / (13 * L) + WHITE_u; + v = V / (13 * L) + WHITE_v; + X = 9.0 * Y * u / (4 * v); + Z = - X / 3 - 5 * Y + 3 * Y / v; + } + + /* Step 4 : CIE-XYZ to sRGB */ + + *R = gtrans(( 3.240479 * X - 1.537150 * Y - 0.498535 * Z) / WHITE_Y); + *G = gtrans((-0.969256 * X + 1.875992 * Y + 0.041556 * Z) / WHITE_Y); + *B = gtrans(( 0.055648 * X - 0.204043 * Y + 1.057311 * Z) / WHITE_Y); +} + +// People call this with non-finite inputs. +SEXP hcl(SEXP h, SEXP c, SEXP l, SEXP a, SEXP sfixup) +{ + double H, C, L, A, r, g, b; + R_xlen_t nh, nc, nl, na = 1, max, i; + int ir, ig, ib; + int fixup; + + PROTECT(h = coerceVector(h, REALSXP)); + PROTECT(c = coerceVector(c, REALSXP)); + PROTECT(l = coerceVector(l, REALSXP)); + if (!isNull(a)) { + a = coerceVector(a, REALSXP); + na = XLENGTH(a); + } + PROTECT(a); + fixup = asLogical(sfixup); + nh = XLENGTH(h); + nc = XLENGTH(c); + nl = XLENGTH(l); + if (nh <= 0 || nc <= 0 || nl <= 0 || na <= 0) { + UNPROTECT(4); + return(allocVector(STRSXP, 0)); + } + max = nh; + if (max < nc) max = nc; + if (max < nl) max = nl; + if (max < na) max = na; + SEXP ans = PROTECT(allocVector(STRSXP, max)); + if (isNull(a)) { + for (i = 0; i < max; i++) { + H = REAL(h)[i % nh]; + C = REAL(c)[i % nc]; + L = REAL(l)[i % nl]; + if (R_FINITE(H) && R_FINITE(C) && R_FINITE(L)) { + if (L < 0 || L > WHITE_Y || C < 0) error(_("invalid hcl color")); + hcl2rgb(H, C, L, &r, &g, &b); + ir = (int) (255 * r + .5); + ig = (int) (255 * g + .5); + ib = (int) (255 * b + .5); + if (FixupColor(&ir, &ig, &ib) && !fixup) + SET_STRING_ELT(ans, i, NA_STRING); + else + SET_STRING_ELT(ans, i, mkChar(RGB2rgb(ir, ig, ib))); + } else SET_STRING_ELT(ans, i, NA_STRING); + } + } else { + for (i = 0; i < max; i++) { + H = REAL(h)[i % nh]; + C = REAL(c)[i % nc]; + L = REAL(l)[i % nl]; + A = REAL(a)[i % na]; + if (!R_FINITE(A)) A = 1; + if (R_FINITE(H) && R_FINITE(C) && R_FINITE(L)) { + if (L < 0 || L > WHITE_Y || C < 0 || A < 0 || A > 1) + error(_("invalid hcl color")); + hcl2rgb(H, C, L, &r, &g, &b); + ir = (int) (255 * r + .5); + ig = (int) (255 * g + .5); + ib = (int) (255 * b + .5); + if (FixupColor(&ir, &ig, &ib) && !fixup) + SET_STRING_ELT(ans, i, NA_STRING); + else + SET_STRING_ELT(ans, i, mkChar(RGBA2rgb(ir, ig, ib, + ScaleAlpha(A)))); + } else SET_STRING_ELT(ans, i, NA_STRING); + } + } + UNPROTECT(5); + return ans; +} + +#define _R_set_c_RGB(_R,_G,_B) \ + { for (i = 0; i < l_max; i++) \ + SET_STRING_ELT(c, i, mkChar(RGB2rgb(_R,_G,_B))); } + +#define _R_set_c_RGBA(_R,_G,_B,_A) \ + { for (i = 0; i < l_max; i++) \ + SET_STRING_ELT(c, i, mkChar(RGBA2rgb(_R,_G,_B,_A))); } + +SEXP rgb(SEXP r, SEXP g, SEXP b, SEXP a, SEXP MCV, SEXP nam) +{ + R_xlen_t i, l_max, nr, ng, nb, na = 1; + Rboolean max_1 = FALSE; + double mV = asReal(MCV); + + if(!R_FINITE(mV) || mV == 0.) + error(_("invalid value of 'maxColorValue'")); + if(mV == 255.) { + PROTECT(r = coerceVector(r, INTSXP)); + PROTECT(g = coerceVector(g, INTSXP)); + PROTECT(b = coerceVector(b, INTSXP)); + if(!isNull(a)) a = coerceVector(a, INTSXP); + } else { + PROTECT(r = coerceVector(r, REALSXP)); + PROTECT(g = coerceVector(g, REALSXP)); + PROTECT(b = coerceVector(b, REALSXP)); + if(!isNull(a)) a = coerceVector(a, REALSXP); + max_1 = (mV == 1.); + } + PROTECT(a); + + nr = XLENGTH(r); ng = XLENGTH(g); nb = XLENGTH(b); + if (!isNull(a)) na = XLENGTH(a); + if (nr <= 0 || ng <= 0 || nb <= 0 || na <= 0) { + UNPROTECT(4); + return allocVector(STRSXP, 0); + } + l_max = nr; + if (l_max < ng) l_max = ng; + if (l_max < nb) l_max = nb; + if (l_max < na) l_max = na; + + PROTECT(nam = coerceVector(nam, STRSXP)); + if (length(nam) != 0 && length(nam) != l_max) + error(_("invalid 'names' vector")); + SEXP c = PROTECT(allocVector(STRSXP, l_max)); + + if(mV == 255.0) { + if(isNull(a)) { + _R_set_c_RGB(CheckColor(INTEGER(r)[i%nr]), + CheckColor(INTEGER(g)[i%ng]), + CheckColor(INTEGER(b)[i%nb])); + } else { + _R_set_c_RGBA(CheckColor(INTEGER(r)[i%nr]), + CheckColor(INTEGER(g)[i%ng]), + CheckColor(INTEGER(b)[i%nb]), + CheckAlpha(INTEGER(a)[i%na])); + } + } + else if(max_1) { + if(isNull(a)) { + _R_set_c_RGB(ScaleColor(REAL(r)[i%nr]), + ScaleColor(REAL(g)[i%ng]), + ScaleColor(REAL(b)[i%nb])); + } else { + _R_set_c_RGBA(ScaleColor(REAL(r)[i%nr]), + ScaleColor(REAL(g)[i%ng]), + ScaleColor(REAL(b)[i%nb]), + ScaleAlpha(REAL(a)[i%na])); + } + } + else { /* maxColorVal not in {1, 255} */ + if(isNull(a)) { + _R_set_c_RGB(ScaleColor(REAL(r)[i%nr] / mV), + ScaleColor(REAL(g)[i%ng] / mV), + ScaleColor(REAL(b)[i%nb] / mV)); + } else { + _R_set_c_RGBA(ScaleColor(REAL(r)[i%nr] / mV), + ScaleColor(REAL(g)[i%ng] / mV), + ScaleColor(REAL(b)[i%nb] / mV), + ScaleAlpha(REAL(a)[i%na] / mV)); + } + } + if (length(nam) != 0) setAttrib(c, R_NamesSymbol, nam); + UNPROTECT(6); + return c; +} + +SEXP gray(SEXP lev, SEXP a) +{ + SEXP ans; + double level; + int i, ilevel, nlev; + + lev = PROTECT(coerceVector(lev,REALSXP)); + if(!isNull(a)) a = coerceVector(a,REALSXP); + PROTECT(a); + nlev = LENGTH(lev); + PROTECT(ans = allocVector(STRSXP, nlev)); + if(isNull(a)) { + for (i = 0; i < nlev; i++) { + level = REAL(lev)[i]; + if (ISNAN(level) || level < 0 || level > 1) + error(_("invalid gray level, must be in [0,1].")); + ilevel = (int)(255 * level + 0.5); + SET_STRING_ELT(ans, i, mkChar(RGB2rgb(ilevel, ilevel, ilevel))); + } + } else { + int na = length(a); + for (i = 0; i < (nlev > na ? nlev : na); i++) { + level = REAL(lev)[i % nlev]; + if (ISNAN(level) || level < 0 || level > 1) + error(_("invalid gray level, must be in [0,1].")); + ilevel = (int)(255 * level + 0.5); + double aa = REAL(a)[i % na]; + SET_STRING_ELT(ans, i, mkChar(RGBA2rgb(ilevel, ilevel, ilevel, + ScaleAlpha(aa)))); + } + } + UNPROTECT(3); + return ans; +} + + + + + +SEXP RGB2hsv(SEXP rgb) +{ +/* (r,g,b) -> (h,s,v) conversion */ + SEXP dd, ans, names, dmns; + int n, i, i3; + + rgb = PROTECT(coerceVector(rgb, REALSXP)); + if(!isMatrix(rgb)) error("rgb is not a matrix (internally)"); + dd = getAttrib(rgb, R_DimSymbol); + if(INTEGER(dd)[0] != 3) error("rgb must have 3 rows (internally)"); + n = INTEGER(dd)[1]; + + ans = PROTECT(allocMatrix(REALSXP, 3, n)); + PROTECT(dmns = allocVector(VECSXP, 2)); + /* row names: */ + PROTECT(names = allocVector(STRSXP, 3)); + SET_STRING_ELT(names, 0, mkChar("h")); + SET_STRING_ELT(names, 1, mkChar("s")); + SET_STRING_ELT(names, 2, mkChar("v")); + SET_VECTOR_ELT(dmns, 0, names); + /* column names if input has: */ + if ((dd = getAttrib(rgb, R_DimNamesSymbol)) != R_NilValue && + (names = VECTOR_ELT(dd, 1)) != R_NilValue) + SET_VECTOR_ELT(dmns, 1, names); + setAttrib(ans, R_DimNamesSymbol, dmns); + UNPROTECT(2);/* names, dmns */ + + for(i = i3 = 0; i < n; i++, i3 += 3) { + rgb2hsv(REAL(rgb)[i3+ 0], REAL(rgb)[i3+ 1], REAL(rgb)[i3+ 2], + &REAL(ans)[i3+ 0], &REAL(ans)[i3+ 1], &REAL(ans)[i3 +2]); + } + UNPROTECT(2); + return ans; +} + + +SEXP col2rgb(SEXP colors, SEXP alpha) +{ + SEXP ans, names, dmns; + + int alph = asLogical(alpha); + if(alph == NA_LOGICAL) error(_("invalid '%s' value"), "alpha"); + switch(TYPEOF(colors)) { + case INTSXP: + case STRSXP: + break; + case REALSXP: + colors = coerceVector(colors, INTSXP); + break; + default: + colors = coerceVector(colors, STRSXP); + break; + } + PROTECT(colors); + int n = LENGTH(colors); + + /* First set up the output matrix */ + PROTECT(ans = allocMatrix(INTSXP, 3+alph, n)); + PROTECT(dmns = allocVector(VECSXP, 2)); + PROTECT(names = allocVector(STRSXP, 3+alph)); + SET_STRING_ELT(names, 0, mkChar("red")); + SET_STRING_ELT(names, 1, mkChar("green")); + SET_STRING_ELT(names, 2, mkChar("blue")); + if(alph) SET_STRING_ELT(names, 3, mkChar("alpha")); + SET_VECTOR_ELT(dmns, 0, names); + if ((names = getAttrib(colors, R_NamesSymbol)) != R_NilValue) + SET_VECTOR_ELT(dmns, 1, names); + setAttrib(ans, R_DimNamesSymbol, dmns); + + for(int i = 0, j = 0; i < n; i++) { + rcolor icol = inRGBpar3(colors, i, R_TRANWHITE); + INTEGER(ans)[j++] = R_RED(icol); + INTEGER(ans)[j++] = R_GREEN(icol); + INTEGER(ans)[j++] = R_BLUE(icol); + if(alph) INTEGER(ans)[j++] = R_ALPHA(icol); + } + UNPROTECT(4); + return ans; +} + + +// ------------------ code for tables to export to main executable -------- + +#include <ctype.h> /* for tolower, isdigit */ + +#define MAX_PALETTE_SIZE 1024 +static int PaletteSize = 8; +static rcolor Palette[MAX_PALETTE_SIZE] = { + 0xff000000, + 0xff0000ff, + 0xff00cd00, + 0xffff0000, + 0xffffff00, + 0xffff00ff, + 0xff00ffff, + 0xffbebebe +}; + +static rcolor Palette0[MAX_PALETTE_SIZE]; + + +/* String comparison ignoring case and squeezing out blanks */ +static int StrMatch(const char *s, const char *t) +{ + for(;;) { + if(*s == '\0' && *t == '\0') return 1; + if(*s == ' ') { s++; continue; } + if(*t == ' ') { t++; continue; } + if(tolower(*s++) != tolower(*t++)) return 0; + } +} + + +/* + * Color Specification + * + * Colors are stored internally in integers. Each integer is + * broken into four bytes. The three least significant bytes + * are used to contain levels of red, green and blue. These + * levels are integers in the range [0,255]. + * + * Externally, colors are specified either: + * + * a) by name, using a large table of color names, + * + * b) by RGB values using a string of the form "#rrggbb" + * where rr, gg and bb are hex integers giving the level + * of red green and blue, + * + * c) as an index into a user setable palette of colors. + * + */ + +/* Default Color Palette */ +/* Paul Murrell 05/06/02 (2002, probably) + * Changed "white" to "grey" in the default palette + * in response to user suggestion + */ +attribute_hidden +const char *DefaultPalette[] = { + "black", + "red", + "green3", + "blue", + "cyan", + "magenta", + "yellow", + "grey", + NULL +}; + +/* The Table of Known Color Names */ +/* Adapted from the X11 RGB database */ +/* Note: the color "white" was moved to the top of the database + to avoid its being looked up by col2name as "gray100" */ + +typedef +struct colorDataBaseEntry { + char *name; // X11 Color Name + char *rgb; // #RRGGBB String, no longer used + rcolor code; // Internal R Color Code +} ColorDataBaseEntry; + +static ColorDataBaseEntry ColorDataBase[] = { + /* name rgb code */ + {"white", "#FFFFFF", 0xffffffff}, + {"aliceblue", "#F0F8FF", 0xfffff8f0}, + {"antiquewhite", "#FAEBD7", 0xffd7ebfa}, + {"antiquewhite1", "#FFEFDB", 0xffdbefff}, + {"antiquewhite2", "#EEDFCC", 0xffccdfee}, + {"antiquewhite3", "#CDC0B0", 0xffb0c0cd}, + {"antiquewhite4", "#8B8378", 0xff78838b}, + {"aquamarine", "#7FFFD4", 0xffd4ff7f}, + {"aquamarine1", "#7FFFD4", 0xffd4ff7f}, + {"aquamarine2", "#76EEC6", 0xffc6ee76}, + {"aquamarine3", "#66CDAA", 0xffaacd66}, + {"aquamarine4", "#458B74", 0xff748b45}, + {"azure", "#F0FFFF", 0xfffffff0}, + {"azure1", "#F0FFFF", 0xfffffff0}, + {"azure2", "#E0EEEE", 0xffeeeee0}, + {"azure3", "#C1CDCD", 0xffcdcdc1}, + {"azure4", "#838B8B", 0xff8b8b83}, + {"beige", "#F5F5DC", 0xffdcf5f5}, + {"bisque", "#FFE4C4", 0xffc4e4ff}, + {"bisque1", "#FFE4C4", 0xffc4e4ff}, + {"bisque2", "#EED5B7", 0xffb7d5ee}, + {"bisque3", "#CDB79E", 0xff9eb7cd}, + {"bisque4", "#8B7D6B", 0xff6b7d8b}, + {"black", "#000000", 0xff000000}, + {"blanchedalmond", "#FFEBCD", 0xffcdebff}, + {"blue", "#0000FF", 0xffff0000}, + {"blue1", "#0000FF", 0xffff0000}, + {"blue2", "#0000EE", 0xffee0000}, + {"blue3", "#0000CD", 0xffcd0000}, + {"blue4", "#00008B", 0xff8b0000}, + {"blueviolet", "#8A2BE2", 0xffe22b8a}, + {"brown", "#A52A2A", 0xff2a2aa5}, + {"brown1", "#FF4040", 0xff4040ff}, + {"brown2", "#EE3B3B", 0xff3b3bee}, + {"brown3", "#CD3333", 0xff3333cd}, + {"brown4", "#8B2323", 0xff23238b}, + {"burlywood", "#DEB887", 0xff87b8de}, + {"burlywood1", "#FFD39B", 0xff9bd3ff}, + {"burlywood2", "#EEC591", 0xff91c5ee}, + {"burlywood3", "#CDAA7D", 0xff7daacd}, + {"burlywood4", "#8B7355", 0xff55738b}, + {"cadetblue", "#5F9EA0", 0xffa09e5f}, + {"cadetblue1", "#98F5FF", 0xfffff598}, + {"cadetblue2", "#8EE5EE", 0xffeee58e}, + {"cadetblue3", "#7AC5CD", 0xffcdc57a}, + {"cadetblue4", "#53868B", 0xff8b8653}, + {"chartreuse", "#7FFF00", 0xff00ff7f}, + {"chartreuse1", "#7FFF00", 0xff00ff7f}, + {"chartreuse2", "#76EE00", 0xff00ee76}, + {"chartreuse3", "#66CD00", 0xff00cd66}, + {"chartreuse4", "#458B00", 0xff008b45}, + {"chocolate", "#D2691E", 0xff1e69d2}, + {"chocolate1", "#FF7F24", 0xff247fff}, + {"chocolate2", "#EE7621", 0xff2176ee}, + {"chocolate3", "#CD661D", 0xff1d66cd}, + {"chocolate4", "#8B4513", 0xff13458b}, + {"coral", "#FF7F50", 0xff507fff}, + {"coral1", "#FF7256", 0xff5672ff}, + {"coral2", "#EE6A50", 0xff506aee}, + {"coral3", "#CD5B45", 0xff455bcd}, + {"coral4", "#8B3E2F", 0xff2f3e8b}, + {"cornflowerblue", "#6495ED", 0xffed9564}, + {"cornsilk", "#FFF8DC", 0xffdcf8ff}, + {"cornsilk1", "#FFF8DC", 0xffdcf8ff}, + {"cornsilk2", "#EEE8CD", 0xffcde8ee}, + {"cornsilk3", "#CDC8B1", 0xffb1c8cd}, + {"cornsilk4", "#8B8878", 0xff78888b}, + {"cyan", "#00FFFF", 0xffffff00}, + {"cyan1", "#00FFFF", 0xffffff00}, + {"cyan2", "#00EEEE", 0xffeeee00}, + {"cyan3", "#00CDCD", 0xffcdcd00}, + {"cyan4", "#008B8B", 0xff8b8b00}, + {"darkblue", "#00008B", 0xff8b0000}, + {"darkcyan", "#008B8B", 0xff8b8b00}, + {"darkgoldenrod", "#B8860B", 0xff0b86b8}, + {"darkgoldenrod1", "#FFB90F", 0xff0fb9ff}, + {"darkgoldenrod2", "#EEAD0E", 0xff0eadee}, + {"darkgoldenrod3", "#CD950C", 0xff0c95cd}, + {"darkgoldenrod4", "#8B6508", 0xff08658b}, + {"darkgray", "#A9A9A9", 0xffa9a9a9}, + {"darkgreen", "#006400", 0xff006400}, + {"darkgrey", "#A9A9A9", 0xffa9a9a9}, + {"darkkhaki", "#BDB76B", 0xff6bb7bd}, + {"darkmagenta", "#8B008B", 0xff8b008b}, + {"darkolivegreen", "#556B2F", 0xff2f6b55}, + {"darkolivegreen1", "#CAFF70", 0xff70ffca}, + {"darkolivegreen2", "#BCEE68", 0xff68eebc}, + {"darkolivegreen3", "#A2CD5A", 0xff5acda2}, + {"darkolivegreen4", "#6E8B3D", 0xff3d8b6e}, + {"darkorange", "#FF8C00", 0xff008cff}, + {"darkorange1", "#FF7F00", 0xff007fff}, + {"darkorange2", "#EE7600", 0xff0076ee}, + {"darkorange3", "#CD6600", 0xff0066cd}, + {"darkorange4", "#8B4500", 0xff00458b}, + {"darkorchid", "#9932CC", 0xffcc3299}, + {"darkorchid1", "#BF3EFF", 0xffff3ebf}, + {"darkorchid2", "#B23AEE", 0xffee3ab2}, + {"darkorchid3", "#9A32CD", 0xffcd329a}, + {"darkorchid4", "#68228B", 0xff8b2268}, + {"darkred", "#8B0000", 0xff00008b}, + {"darksalmon", "#E9967A", 0xff7a96e9}, + {"darkseagreen", "#8FBC8F", 0xff8fbc8f}, + {"darkseagreen1", "#C1FFC1", 0xffc1ffc1}, + {"darkseagreen2", "#B4EEB4", 0xffb4eeb4}, + {"darkseagreen3", "#9BCD9B", 0xff9bcd9b}, + {"darkseagreen4", "#698B69", 0xff698b69}, + {"darkslateblue", "#483D8B", 0xff8b3d48}, + {"darkslategray", "#2F4F4F", 0xff4f4f2f}, + {"darkslategray1", "#97FFFF", 0xffffff97}, + {"darkslategray2", "#8DEEEE", 0xffeeee8d}, + {"darkslategray3", "#79CDCD", 0xffcdcd79}, + {"darkslategray4", "#528B8B", 0xff8b8b52}, + {"darkslategrey", "#2F4F4F", 0xff4f4f2f}, + {"darkturquoise", "#00CED1", 0xffd1ce00}, + {"darkviolet", "#9400D3", 0xffd30094}, + {"deeppink", "#FF1493", 0xff9314ff}, + {"deeppink1", "#FF1493", 0xff9314ff}, + {"deeppink2", "#EE1289", 0xff8912ee}, + {"deeppink3", "#CD1076", 0xff7610cd}, + {"deeppink4", "#8B0A50", 0xff500a8b}, + {"deepskyblue", "#00BFFF", 0xffffbf00}, + {"deepskyblue1", "#00BFFF", 0xffffbf00}, + {"deepskyblue2", "#00B2EE", 0xffeeb200}, + {"deepskyblue3", "#009ACD", 0xffcd9a00}, + {"deepskyblue4", "#00688B", 0xff8b6800}, + {"dimgray", "#696969", 0xff696969}, + {"dimgrey", "#696969", 0xff696969}, + {"dodgerblue", "#1E90FF", 0xffff901e}, + {"dodgerblue1", "#1E90FF", 0xffff901e}, + {"dodgerblue2", "#1C86EE", 0xffee861c}, + {"dodgerblue3", "#1874CD", 0xffcd7418}, + {"dodgerblue4", "#104E8B", 0xff8b4e10}, + {"firebrick", "#B22222", 0xff2222b2}, + {"firebrick1", "#FF3030", 0xff3030ff}, + {"firebrick2", "#EE2C2C", 0xff2c2cee}, + {"firebrick3", "#CD2626", 0xff2626cd}, + {"firebrick4", "#8B1A1A", 0xff1a1a8b}, + {"floralwhite", "#FFFAF0", 0xfff0faff}, + {"forestgreen", "#228B22", 0xff228b22}, + {"gainsboro", "#DCDCDC", 0xffdcdcdc}, + {"ghostwhite", "#F8F8FF", 0xfffff8f8}, + {"gold", "#FFD700", 0xff00d7ff}, + {"gold1", "#FFD700", 0xff00d7ff}, + {"gold2", "#EEC900", 0xff00c9ee}, + {"gold3", "#CDAD00", 0xff00adcd}, + {"gold4", "#8B7500", 0xff00758b}, + {"goldenrod", "#DAA520", 0xff20a5da}, + {"goldenrod1", "#FFC125", 0xff25c1ff}, + {"goldenrod2", "#EEB422", 0xff22b4ee}, + {"goldenrod3", "#CD9B1D", 0xff1d9bcd}, + {"goldenrod4", "#8B6914", 0xff14698b}, + {"gray", "#BEBEBE", 0xffbebebe}, + {"gray0", "#000000", 0xff000000}, + {"gray1", "#030303", 0xff030303}, + {"gray2", "#050505", 0xff050505}, + {"gray3", "#080808", 0xff080808}, + {"gray4", "#0A0A0A", 0xff0a0a0a}, + {"gray5", "#0D0D0D", 0xff0d0d0d}, + {"gray6", "#0F0F0F", 0xff0f0f0f}, + {"gray7", "#121212", 0xff121212}, + {"gray8", "#141414", 0xff141414}, + {"gray9", "#171717", 0xff171717}, + {"gray10", "#1A1A1A", 0xff1a1a1a}, + {"gray11", "#1C1C1C", 0xff1c1c1c}, + {"gray12", "#1F1F1F", 0xff1f1f1f}, + {"gray13", "#212121", 0xff212121}, + {"gray14", "#242424", 0xff242424}, + {"gray15", "#262626", 0xff262626}, + {"gray16", "#292929", 0xff292929}, + {"gray17", "#2B2B2B", 0xff2b2b2b}, + {"gray18", "#2E2E2E", 0xff2e2e2e}, + {"gray19", "#303030", 0xff303030}, + {"gray20", "#333333", 0xff333333}, + {"gray21", "#363636", 0xff363636}, + {"gray22", "#383838", 0xff383838}, + {"gray23", "#3B3B3B", 0xff3b3b3b}, + {"gray24", "#3D3D3D", 0xff3d3d3d}, + {"gray25", "#404040", 0xff404040}, + {"gray26", "#424242", 0xff424242}, + {"gray27", "#454545", 0xff454545}, + {"gray28", "#474747", 0xff474747}, + {"gray29", "#4A4A4A", 0xff4a4a4a}, + {"gray30", "#4D4D4D", 0xff4d4d4d}, + {"gray31", "#4F4F4F", 0xff4f4f4f}, + {"gray32", "#525252", 0xff525252}, + {"gray33", "#545454", 0xff545454}, + {"gray34", "#575757", 0xff575757}, + {"gray35", "#595959", 0xff595959}, + {"gray36", "#5C5C5C", 0xff5c5c5c}, + {"gray37", "#5E5E5E", 0xff5e5e5e}, + {"gray38", "#616161", 0xff616161}, + {"gray39", "#636363", 0xff636363}, + {"gray40", "#666666", 0xff666666}, + {"gray41", "#696969", 0xff696969}, + {"gray42", "#6B6B6B", 0xff6b6b6b}, + {"gray43", "#6E6E6E", 0xff6e6e6e}, + {"gray44", "#707070", 0xff707070}, + {"gray45", "#737373", 0xff737373}, + {"gray46", "#757575", 0xff757575}, + {"gray47", "#787878", 0xff787878}, + {"gray48", "#7A7A7A", 0xff7a7a7a}, + {"gray49", "#7D7D7D", 0xff7d7d7d}, + {"gray50", "#7F7F7F", 0xff7f7f7f}, + {"gray51", "#828282", 0xff828282}, + {"gray52", "#858585", 0xff858585}, + {"gray53", "#878787", 0xff878787}, + {"gray54", "#8A8A8A", 0xff8a8a8a}, + {"gray55", "#8C8C8C", 0xff8c8c8c}, + {"gray56", "#8F8F8F", 0xff8f8f8f}, + {"gray57", "#919191", 0xff919191}, + {"gray58", "#949494", 0xff949494}, + {"gray59", "#969696", 0xff969696}, + {"gray60", "#999999", 0xff999999}, + {"gray61", "#9C9C9C", 0xff9c9c9c}, + {"gray62", "#9E9E9E", 0xff9e9e9e}, + {"gray63", "#A1A1A1", 0xffa1a1a1}, + {"gray64", "#A3A3A3", 0xffa3a3a3}, + {"gray65", "#A6A6A6", 0xffa6a6a6}, + {"gray66", "#A8A8A8", 0xffa8a8a8}, + {"gray67", "#ABABAB", 0xffababab}, + {"gray68", "#ADADAD", 0xffadadad}, + {"gray69", "#B0B0B0", 0xffb0b0b0}, + {"gray70", "#B3B3B3", 0xffb3b3b3}, + {"gray71", "#B5B5B5", 0xffb5b5b5}, + {"gray72", "#B8B8B8", 0xffb8b8b8}, + {"gray73", "#BABABA", 0xffbababa}, + {"gray74", "#BDBDBD", 0xffbdbdbd}, + {"gray75", "#BFBFBF", 0xffbfbfbf}, + {"gray76", "#C2C2C2", 0xffc2c2c2}, + {"gray77", "#C4C4C4", 0xffc4c4c4}, + {"gray78", "#C7C7C7", 0xffc7c7c7}, + {"gray79", "#C9C9C9", 0xffc9c9c9}, + {"gray80", "#CCCCCC", 0xffcccccc}, + {"gray81", "#CFCFCF", 0xffcfcfcf}, + {"gray82", "#D1D1D1", 0xffd1d1d1}, + {"gray83", "#D4D4D4", 0xffd4d4d4}, + {"gray84", "#D6D6D6", 0xffd6d6d6}, + {"gray85", "#D9D9D9", 0xffd9d9d9}, + {"gray86", "#DBDBDB", 0xffdbdbdb}, + {"gray87", "#DEDEDE", 0xffdedede}, + {"gray88", "#E0E0E0", 0xffe0e0e0}, + {"gray89", "#E3E3E3", 0xffe3e3e3}, + {"gray90", "#E5E5E5", 0xffe5e5e5}, + {"gray91", "#E8E8E8", 0xffe8e8e8}, + {"gray92", "#EBEBEB", 0xffebebeb}, + {"gray93", "#EDEDED", 0xffededed}, + {"gray94", "#F0F0F0", 0xfff0f0f0}, + {"gray95", "#F2F2F2", 0xfff2f2f2}, + {"gray96", "#F5F5F5", 0xfff5f5f5}, + {"gray97", "#F7F7F7", 0xfff7f7f7}, + {"gray98", "#FAFAFA", 0xfffafafa}, + {"gray99", "#FCFCFC", 0xfffcfcfc}, + {"gray100", "#FFFFFF", 0xffffffff}, + {"green", "#00FF00", 0xff00ff00}, + {"green1", "#00FF00", 0xff00ff00}, + {"green2", "#00EE00", 0xff00ee00}, + {"green3", "#00CD00", 0xff00cd00}, + {"green4", "#008B00", 0xff008b00}, + {"greenyellow", "#ADFF2F", 0xff2fffad}, + {"grey", "#BEBEBE", 0xffbebebe}, + {"grey0", "#000000", 0xff000000}, + {"grey1", "#030303", 0xff030303}, + {"grey2", "#050505", 0xff050505}, + {"grey3", "#080808", 0xff080808}, + {"grey4", "#0A0A0A", 0xff0a0a0a}, + {"grey5", "#0D0D0D", 0xff0d0d0d}, + {"grey6", "#0F0F0F", 0xff0f0f0f}, + {"grey7", "#121212", 0xff121212}, + {"grey8", "#141414", 0xff141414}, + {"grey9", "#171717", 0xff171717}, + {"grey10", "#1A1A1A", 0xff1a1a1a}, + {"grey11", "#1C1C1C", 0xff1c1c1c}, + {"grey12", "#1F1F1F", 0xff1f1f1f}, + {"grey13", "#212121", 0xff212121}, + {"grey14", "#242424", 0xff242424}, + {"grey15", "#262626", 0xff262626}, + {"grey16", "#292929", 0xff292929}, + {"grey17", "#2B2B2B", 0xff2b2b2b}, + {"grey18", "#2E2E2E", 0xff2e2e2e}, + {"grey19", "#303030", 0xff303030}, + {"grey20", "#333333", 0xff333333}, + {"grey21", "#363636", 0xff363636}, + {"grey22", "#383838", 0xff383838}, + {"grey23", "#3B3B3B", 0xff3b3b3b}, + {"grey24", "#3D3D3D", 0xff3d3d3d}, + {"grey25", "#404040", 0xff404040}, + {"grey26", "#424242", 0xff424242}, + {"grey27", "#454545", 0xff454545}, + {"grey28", "#474747", 0xff474747}, + {"grey29", "#4A4A4A", 0xff4a4a4a}, + {"grey30", "#4D4D4D", 0xff4d4d4d}, + {"grey31", "#4F4F4F", 0xff4f4f4f}, + {"grey32", "#525252", 0xff525252}, + {"grey33", "#545454", 0xff545454}, + {"grey34", "#575757", 0xff575757}, + {"grey35", "#595959", 0xff595959}, + {"grey36", "#5C5C5C", 0xff5c5c5c}, + {"grey37", "#5E5E5E", 0xff5e5e5e}, + {"grey38", "#616161", 0xff616161}, + {"grey39", "#636363", 0xff636363}, + {"grey40", "#666666", 0xff666666}, + {"grey41", "#696969", 0xff696969}, + {"grey42", "#6B6B6B", 0xff6b6b6b}, + {"grey43", "#6E6E6E", 0xff6e6e6e}, + {"grey44", "#707070", 0xff707070}, + {"grey45", "#737373", 0xff737373}, + {"grey46", "#757575", 0xff757575}, + {"grey47", "#787878", 0xff787878}, + {"grey48", "#7A7A7A", 0xff7a7a7a}, + {"grey49", "#7D7D7D", 0xff7d7d7d}, + {"grey50", "#7F7F7F", 0xff7f7f7f}, + {"grey51", "#828282", 0xff828282}, + {"grey52", "#858585", 0xff858585}, + {"grey53", "#878787", 0xff878787}, + {"grey54", "#8A8A8A", 0xff8a8a8a}, + {"grey55", "#8C8C8C", 0xff8c8c8c}, + {"grey56", "#8F8F8F", 0xff8f8f8f}, + {"grey57", "#919191", 0xff919191}, + {"grey58", "#949494", 0xff949494}, + {"grey59", "#969696", 0xff969696}, + {"grey60", "#999999", 0xff999999}, + {"grey61", "#9C9C9C", 0xff9c9c9c}, + {"grey62", "#9E9E9E", 0xff9e9e9e}, + {"grey63", "#A1A1A1", 0xffa1a1a1}, + {"grey64", "#A3A3A3", 0xffa3a3a3}, + {"grey65", "#A6A6A6", 0xffa6a6a6}, + {"grey66", "#A8A8A8", 0xffa8a8a8}, + {"grey67", "#ABABAB", 0xffababab}, + {"grey68", "#ADADAD", 0xffadadad}, + {"grey69", "#B0B0B0", 0xffb0b0b0}, + {"grey70", "#B3B3B3", 0xffb3b3b3}, + {"grey71", "#B5B5B5", 0xffb5b5b5}, + {"grey72", "#B8B8B8", 0xffb8b8b8}, + {"grey73", "#BABABA", 0xffbababa}, + {"grey74", "#BDBDBD", 0xffbdbdbd}, + {"grey75", "#BFBFBF", 0xffbfbfbf}, + {"grey76", "#C2C2C2", 0xffc2c2c2}, + {"grey77", "#C4C4C4", 0xffc4c4c4}, + {"grey78", "#C7C7C7", 0xffc7c7c7}, + {"grey79", "#C9C9C9", 0xffc9c9c9}, + {"grey80", "#CCCCCC", 0xffcccccc}, + {"grey81", "#CFCFCF", 0xffcfcfcf}, + {"grey82", "#D1D1D1", 0xffd1d1d1}, + {"grey83", "#D4D4D4", 0xffd4d4d4}, + {"grey84", "#D6D6D6", 0xffd6d6d6}, + {"grey85", "#D9D9D9", 0xffd9d9d9}, + {"grey86", "#DBDBDB", 0xffdbdbdb}, + {"grey87", "#DEDEDE", 0xffdedede}, + {"grey88", "#E0E0E0", 0xffe0e0e0}, + {"grey89", "#E3E3E3", 0xffe3e3e3}, + {"grey90", "#E5E5E5", 0xffe5e5e5}, + {"grey91", "#E8E8E8", 0xffe8e8e8}, + {"grey92", "#EBEBEB", 0xffebebeb}, + {"grey93", "#EDEDED", 0xffededed}, + {"grey94", "#F0F0F0", 0xfff0f0f0}, + {"grey95", "#F2F2F2", 0xfff2f2f2}, + {"grey96", "#F5F5F5", 0xfff5f5f5}, + {"grey97", "#F7F7F7", 0xfff7f7f7}, + {"grey98", "#FAFAFA", 0xfffafafa}, + {"grey99", "#FCFCFC", 0xfffcfcfc}, + {"grey100", "#FFFFFF", 0xffffffff}, + {"honeydew", "#F0FFF0", 0xfff0fff0}, + {"honeydew1", "#F0FFF0", 0xfff0fff0}, + {"honeydew2", "#E0EEE0", 0xffe0eee0}, + {"honeydew3", "#C1CDC1", 0xffc1cdc1}, + {"honeydew4", "#838B83", 0xff838b83}, + {"hotpink", "#FF69B4", 0xffb469ff}, + {"hotpink1", "#FF6EB4", 0xffb46eff}, + {"hotpink2", "#EE6AA7", 0xffa76aee}, + {"hotpink3", "#CD6090", 0xff9060cd}, + {"hotpink4", "#8B3A62", 0xff623a8b}, + {"indianred", "#CD5C5C", 0xff5c5ccd}, + {"indianred1", "#FF6A6A", 0xff6a6aff}, + {"indianred2", "#EE6363", 0xff6363ee}, + {"indianred3", "#CD5555", 0xff5555cd}, + {"indianred4", "#8B3A3A", 0xff3a3a8b}, + {"ivory", "#FFFFF0", 0xfff0ffff}, + {"ivory1", "#FFFFF0", 0xfff0ffff}, + {"ivory2", "#EEEEE0", 0xffe0eeee}, + {"ivory3", "#CDCDC1", 0xffc1cdcd}, + {"ivory4", "#8B8B83", 0xff838b8b}, + {"khaki", "#F0E68C", 0xff8ce6f0}, + {"khaki1", "#FFF68F", 0xff8ff6ff}, + {"khaki2", "#EEE685", 0xff85e6ee}, + {"khaki3", "#CDC673", 0xff73c6cd}, + {"khaki4", "#8B864E", 0xff4e868b}, + {"lavender", "#E6E6FA", 0xfffae6e6}, + {"lavenderblush", "#FFF0F5", 0xfff5f0ff}, + {"lavenderblush1", "#FFF0F5", 0xfff5f0ff}, + {"lavenderblush2", "#EEE0E5", 0xffe5e0ee}, + {"lavenderblush3", "#CDC1C5", 0xffc5c1cd}, + {"lavenderblush4", "#8B8386", 0xff86838b}, + {"lawngreen", "#7CFC00", 0xff00fc7c}, + {"lemonchiffon", "#FFFACD", 0xffcdfaff}, + {"lemonchiffon1", "#FFFACD", 0xffcdfaff}, + {"lemonchiffon2", "#EEE9BF", 0xffbfe9ee}, + {"lemonchiffon3", "#CDC9A5", 0xffa5c9cd}, + {"lemonchiffon4", "#8B8970", 0xff70898b}, + {"lightblue", "#ADD8E6", 0xffe6d8ad}, + {"lightblue1", "#BFEFFF", 0xffffefbf}, + {"lightblue2", "#B2DFEE", 0xffeedfb2}, + {"lightblue3", "#9AC0CD", 0xffcdc09a}, + {"lightblue4", "#68838B", 0xff8b8368}, + {"lightcoral", "#F08080", 0xff8080f0}, + {"lightcyan", "#E0FFFF", 0xffffffe0}, + {"lightcyan1", "#E0FFFF", 0xffffffe0}, + {"lightcyan2", "#D1EEEE", 0xffeeeed1}, + {"lightcyan3", "#B4CDCD", 0xffcdcdb4}, + {"lightcyan4", "#7A8B8B", 0xff8b8b7a}, + {"lightgoldenrod", "#EEDD82", 0xff82ddee}, + {"lightgoldenrod1", "#FFEC8B", 0xff8becff}, + {"lightgoldenrod2", "#EEDC82", 0xff82dcee}, + {"lightgoldenrod3", "#CDBE70", 0xff70becd}, + {"lightgoldenrod4", "#8B814C", 0xff4c818b}, + {"lightgoldenrodyellow", "#FAFAD2", 0xffd2fafa}, + {"lightgray", "#D3D3D3", 0xffd3d3d3}, + {"lightgreen", "#90EE90", 0xff90ee90}, + {"lightgrey", "#D3D3D3", 0xffd3d3d3}, + {"lightpink", "#FFB6C1", 0xffc1b6ff}, + {"lightpink1", "#FFAEB9", 0xffb9aeff}, + {"lightpink2", "#EEA2AD", 0xffada2ee}, + {"lightpink3", "#CD8C95", 0xff958ccd}, + {"lightpink4", "#8B5F65", 0xff655f8b}, + {"lightsalmon", "#FFA07A", 0xff7aa0ff}, + {"lightsalmon1", "#FFA07A", 0xff7aa0ff}, + {"lightsalmon2", "#EE9572", 0xff7295ee}, + {"lightsalmon3", "#CD8162", 0xff6281cd}, + {"lightsalmon4", "#8B5742", 0xff42578b}, + {"lightseagreen", "#20B2AA", 0xffaab220}, + {"lightskyblue", "#87CEFA", 0xffface87}, + {"lightskyblue1", "#B0E2FF", 0xffffe2b0}, + {"lightskyblue2", "#A4D3EE", 0xffeed3a4}, + {"lightskyblue3", "#8DB6CD", 0xffcdb68d}, + {"lightskyblue4", "#607B8B", 0xff8b7b60}, + {"lightslateblue", "#8470FF", 0xffff7084}, + {"lightslategray", "#778899", 0xff998877}, + {"lightslategrey", "#778899", 0xff998877}, + {"lightsteelblue", "#B0C4DE", 0xffdec4b0}, + {"lightsteelblue1", "#CAE1FF", 0xffffe1ca}, + {"lightsteelblue2", "#BCD2EE", 0xffeed2bc}, + {"lightsteelblue3", "#A2B5CD", 0xffcdb5a2}, + {"lightsteelblue4", "#6E7B8B", 0xff8b7b6e}, + {"lightyellow", "#FFFFE0", 0xffe0ffff}, + {"lightyellow1", "#FFFFE0", 0xffe0ffff}, + {"lightyellow2", "#EEEED1", 0xffd1eeee}, + {"lightyellow3", "#CDCDB4", 0xffb4cdcd}, + {"lightyellow4", "#8B8B7A", 0xff7a8b8b}, + {"limegreen", "#32CD32", 0xff32cd32}, + {"linen", "#FAF0E6", 0xffe6f0fa}, + {"magenta", "#FF00FF", 0xffff00ff}, + {"magenta1", "#FF00FF", 0xffff00ff}, + {"magenta2", "#EE00EE", 0xffee00ee}, + {"magenta3", "#CD00CD", 0xffcd00cd}, + {"magenta4", "#8B008B", 0xff8b008b}, + {"maroon", "#B03060", 0xff6030b0}, + {"maroon1", "#FF34B3", 0xffb334ff}, + {"maroon2", "#EE30A7", 0xffa730ee}, + {"maroon3", "#CD2990", 0xff9029cd}, + {"maroon4", "#8B1C62", 0xff621c8b}, + {"mediumaquamarine", "#66CDAA", 0xffaacd66}, + {"mediumblue", "#0000CD", 0xffcd0000}, + {"mediumorchid", "#BA55D3", 0xffd355ba}, + {"mediumorchid1", "#E066FF", 0xffff66e0}, + {"mediumorchid2", "#D15FEE", 0xffee5fd1}, + {"mediumorchid3", "#B452CD", 0xffcd52b4}, + {"mediumorchid4", "#7A378B", 0xff8b377a}, + {"mediumpurple", "#9370DB", 0xffdb7093}, + {"mediumpurple1", "#AB82FF", 0xffff82ab}, + {"mediumpurple2", "#9F79EE", 0xffee799f}, + {"mediumpurple3", "#8968CD", 0xffcd6889}, + {"mediumpurple4", "#5D478B", 0xff8b475d}, + {"mediumseagreen", "#3CB371", 0xff71b33c}, + {"mediumslateblue", "#7B68EE", 0xffee687b}, + {"mediumspringgreen", "#00FA9A", 0xff9afa00}, + {"mediumturquoise", "#48D1CC", 0xffccd148}, + {"mediumvioletred", "#C71585", 0xff8515c7}, + {"midnightblue", "#191970", 0xff701919}, + {"mintcream", "#F5FFFA", 0xfffafff5}, + {"mistyrose", "#FFE4E1", 0xffe1e4ff}, + {"mistyrose1", "#FFE4E1", 0xffe1e4ff}, + {"mistyrose2", "#EED5D2", 0xffd2d5ee}, + {"mistyrose3", "#CDB7B5", 0xffb5b7cd}, + {"mistyrose4", "#8B7D7B", 0xff7b7d8b}, + {"moccasin", "#FFE4B5", 0xffb5e4ff}, + {"navajowhite", "#FFDEAD", 0xffaddeff}, + {"navajowhite1", "#FFDEAD", 0xffaddeff}, + {"navajowhite2", "#EECFA1", 0xffa1cfee}, + {"navajowhite3", "#CDB38B", 0xff8bb3cd}, + {"navajowhite4", "#8B795E", 0xff5e798b}, + {"navy", "#000080", 0xff800000}, + {"navyblue", "#000080", 0xff800000}, + {"oldlace", "#FDF5E6", 0xffe6f5fd}, + {"olivedrab", "#6B8E23", 0xff238e6b}, + {"olivedrab1", "#C0FF3E", 0xff3effc0}, + {"olivedrab2", "#B3EE3A", 0xff3aeeb3}, + {"olivedrab3", "#9ACD32", 0xff32cd9a}, + {"olivedrab4", "#698B22", 0xff228b69}, + {"orange", "#FFA500", 0xff00a5ff}, + {"orange1", "#FFA500", 0xff00a5ff}, + {"orange2", "#EE9A00", 0xff009aee}, + {"orange3", "#CD8500", 0xff0085cd}, + {"orange4", "#8B5A00", 0xff005a8b}, + {"orangered", "#FF4500", 0xff0045ff}, + {"orangered1", "#FF4500", 0xff0045ff}, + {"orangered2", "#EE4000", 0xff0040ee}, + {"orangered3", "#CD3700", 0xff0037cd}, + {"orangered4", "#8B2500", 0xff00258b}, + {"orchid", "#DA70D6", 0xffd670da}, + {"orchid1", "#FF83FA", 0xfffa83ff}, + {"orchid2", "#EE7AE9", 0xffe97aee}, + {"orchid3", "#CD69C9", 0xffc969cd}, + {"orchid4", "#8B4789", 0xff89478b}, + {"palegoldenrod", "#EEE8AA", 0xffaae8ee}, + {"palegreen", "#98FB98", 0xff98fb98}, + {"palegreen1", "#9AFF9A", 0xff9aff9a}, + {"palegreen2", "#90EE90", 0xff90ee90}, + {"palegreen3", "#7CCD7C", 0xff7ccd7c}, + {"palegreen4", "#548B54", 0xff548b54}, + {"paleturquoise", "#AFEEEE", 0xffeeeeaf}, + {"paleturquoise1", "#BBFFFF", 0xffffffbb}, + {"paleturquoise2", "#AEEEEE", 0xffeeeeae}, + {"paleturquoise3", "#96CDCD", 0xffcdcd96}, + {"paleturquoise4", "#668B8B", 0xff8b8b66}, + {"palevioletred", "#DB7093", 0xff9370db}, + {"palevioletred1", "#FF82AB", 0xffab82ff}, + {"palevioletred2", "#EE799F", 0xff9f79ee}, + {"palevioletred3", "#CD6889", 0xff8968cd}, + {"palevioletred4", "#8B475D", 0xff5d478b}, + {"papayawhip", "#FFEFD5", 0xffd5efff}, + {"peachpuff", "#FFDAB9", 0xffb9daff}, + {"peachpuff1", "#FFDAB9", 0xffb9daff}, + {"peachpuff2", "#EECBAD", 0xffadcbee}, + {"peachpuff3", "#CDAF95", 0xff95afcd}, + {"peachpuff4", "#8B7765", 0xff65778b}, + {"peru", "#CD853F", 0xff3f85cd}, + {"pink", "#FFC0CB", 0xffcbc0ff}, + {"pink1", "#FFB5C5", 0xffc5b5ff}, + {"pink2", "#EEA9B8", 0xffb8a9ee}, + {"pink3", "#CD919E", 0xff9e91cd}, + {"pink4", "#8B636C", 0xff6c638b}, + {"plum", "#DDA0DD", 0xffdda0dd}, + {"plum1", "#FFBBFF", 0xffffbbff}, + {"plum2", "#EEAEEE", 0xffeeaeee}, + {"plum3", "#CD96CD", 0xffcd96cd}, + {"plum4", "#8B668B", 0xff8b668b}, + {"powderblue", "#B0E0E6", 0xffe6e0b0}, + {"purple", "#A020F0", 0xfff020a0}, + {"purple1", "#9B30FF", 0xffff309b}, + {"purple2", "#912CEE", 0xffee2c91}, + {"purple3", "#7D26CD", 0xffcd267d}, + {"purple4", "#551A8B", 0xff8b1a55}, + {"red", "#FF0000", 0xff0000ff}, + {"red1", "#FF0000", 0xff0000ff}, + {"red2", "#EE0000", 0xff0000ee}, + {"red3", "#CD0000", 0xff0000cd}, + {"red4", "#8B0000", 0xff00008b}, + {"rosybrown", "#BC8F8F", 0xff8f8fbc}, + {"rosybrown1", "#FFC1C1", 0xffc1c1ff}, + {"rosybrown2", "#EEB4B4", 0xffb4b4ee}, + {"rosybrown3", "#CD9B9B", 0xff9b9bcd}, + {"rosybrown4", "#8B6969", 0xff69698b}, + {"royalblue", "#4169E1", 0xffe16941}, + {"royalblue1", "#4876FF", 0xffff7648}, + {"royalblue2", "#436EEE", 0xffee6e43}, + {"royalblue3", "#3A5FCD", 0xffcd5f3a}, + {"royalblue4", "#27408B", 0xff8b4027}, + {"saddlebrown", "#8B4513", 0xff13458b}, + {"salmon", "#FA8072", 0xff7280fa}, + {"salmon1", "#FF8C69", 0xff698cff}, + {"salmon2", "#EE8262", 0xff6282ee}, + {"salmon3", "#CD7054", 0xff5470cd}, + {"salmon4", "#8B4C39", 0xff394c8b}, + {"sandybrown", "#F4A460", 0xff60a4f4}, + {"seagreen", "#2E8B57", 0xff578b2e}, + {"seagreen1", "#54FF9F", 0xff9fff54}, + {"seagreen2", "#4EEE94", 0xff94ee4e}, + {"seagreen3", "#43CD80", 0xff80cd43}, + {"seagreen4", "#2E8B57", 0xff578b2e}, + {"seashell", "#FFF5EE", 0xffeef5ff}, + {"seashell1", "#FFF5EE", 0xffeef5ff}, + {"seashell2", "#EEE5DE", 0xffdee5ee}, + {"seashell3", "#CDC5BF", 0xffbfc5cd}, + {"seashell4", "#8B8682", 0xff82868b}, + {"sienna", "#A0522D", 0xff2d52a0}, + {"sienna1", "#FF8247", 0xff4782ff}, + {"sienna2", "#EE7942", 0xff4279ee}, + {"sienna3", "#CD6839", 0xff3968cd}, + {"sienna4", "#8B4726", 0xff26478b}, + {"skyblue", "#87CEEB", 0xffebce87}, + {"skyblue1", "#87CEFF", 0xffffce87}, + {"skyblue2", "#7EC0EE", 0xffeec07e}, + {"skyblue3", "#6CA6CD", 0xffcda66c}, + {"skyblue4", "#4A708B", 0xff8b704a}, + {"slateblue", "#6A5ACD", 0xffcd5a6a}, + {"slateblue1", "#836FFF", 0xffff6f83}, + {"slateblue2", "#7A67EE", 0xffee677a}, + {"slateblue3", "#6959CD", 0xffcd5969}, + {"slateblue4", "#473C8B", 0xff8b3c47}, + {"slategray", "#708090", 0xff908070}, + {"slategray1", "#C6E2FF", 0xffffe2c6}, + {"slategray2", "#B9D3EE", 0xffeed3b9}, + {"slategray3", "#9FB6CD", 0xffcdb69f}, + {"slategray4", "#6C7B8B", 0xff8b7b6c}, + {"slategrey", "#708090", 0xff908070}, + {"snow", "#FFFAFA", 0xfffafaff}, + {"snow1", "#FFFAFA", 0xfffafaff}, + {"snow2", "#EEE9E9", 0xffe9e9ee}, + {"snow3", "#CDC9C9", 0xffc9c9cd}, + {"snow4", "#8B8989", 0xff89898b}, + {"springgreen", "#00FF7F", 0xff7fff00}, + {"springgreen1", "#00FF7F", 0xff7fff00}, + {"springgreen2", "#00EE76", 0xff76ee00}, + {"springgreen3", "#00CD66", 0xff66cd00}, + {"springgreen4", "#008B45", 0xff458b00}, + {"steelblue", "#4682B4", 0xffb48246}, + {"steelblue1", "#63B8FF", 0xffffb863}, + {"steelblue2", "#5CACEE", 0xffeeac5c}, + {"steelblue3", "#4F94CD", 0xffcd944f}, + {"steelblue4", "#36648B", 0xff8b6436}, + {"tan", "#D2B48C", 0xff8cb4d2}, + {"tan1", "#FFA54F", 0xff4fa5ff}, + {"tan2", "#EE9A49", 0xff499aee}, + {"tan3", "#CD853F", 0xff3f85cd}, + {"tan4", "#8B5A2B", 0xff2b5a8b}, + {"thistle", "#D8BFD8", 0xffd8bfd8}, + {"thistle1", "#FFE1FF", 0xffffe1ff}, + {"thistle2", "#EED2EE", 0xffeed2ee}, + {"thistle3", "#CDB5CD", 0xffcdb5cd}, + {"thistle4", "#8B7B8B", 0xff8b7b8b}, + {"tomato", "#FF6347", 0xff4763ff}, + {"tomato1", "#FF6347", 0xff4763ff}, + {"tomato2", "#EE5C42", 0xff425cee}, + {"tomato3", "#CD4F39", 0xff394fcd}, + {"tomato4", "#8B3626", 0xff26368b}, + {"turquoise", "#40E0D0", 0xffd0e040}, + {"turquoise1", "#00F5FF", 0xfffff500}, + {"turquoise2", "#00E5EE", 0xffeee500}, + {"turquoise3", "#00C5CD", 0xffcdc500}, + {"turquoise4", "#00868B", 0xff8b8600}, + {"violet", "#EE82EE", 0xffee82ee}, + {"violetred", "#D02090", 0xff9020d0}, + {"violetred1", "#FF3E96", 0xff963eff}, + {"violetred2", "#EE3A8C", 0xff8c3aee}, + {"violetred3", "#CD3278", 0xff7832cd}, + {"violetred4", "#8B2252", 0xff52228b}, + {"wheat", "#F5DEB3", 0xffb3def5}, + {"wheat1", "#FFE7BA", 0xffbae7ff}, + {"wheat2", "#EED8AE", 0xffaed8ee}, + {"wheat3", "#CDBA96", 0xff96bacd}, + {"wheat4", "#8B7E66", 0xff667e8b}, + {"whitesmoke", "#F5F5F5", 0xfff5f5f5}, + {"yellow", "#FFFF00", 0xff00ffff}, + {"yellow1", "#FFFF00", 0xff00ffff}, + {"yellow2", "#EEEE00", 0xff00eeee}, + {"yellow3", "#CDCD00", 0xff00cdcd}, + {"yellow4", "#8B8B00", 0xff008b8b}, + {"yellowgreen", "#9ACD32", 0xff32cd9a}, + {NULL, NULL, 0} +}; + + +/* Hex Digit to Integer Conversion */ + +static unsigned int hexdigit(int digit) +{ + if('0' <= digit && digit <= '9') return digit - '0'; + if('A' <= digit && digit <= 'F') return 10 + digit - 'A'; + if('a' <= digit && digit <= 'f') return 10 + digit - 'a'; + /*else */ error(_("invalid hex digit in 'color' or 'lty'")); + return digit; /* never occurs (-Wall) */ +} + + +/* #RRGGBB[AA] String to Internal Color Code */ +static rcolor rgb2col(const char *rgb) +{ + unsigned int r = 0, g = 0, b = 0, a = 0; /* -Wall */ + if(rgb[0] != '#') + error(_("invalid RGB specification")); + switch (strlen(rgb)) { + case 9: + a = 16 * hexdigit(rgb[7]) + hexdigit(rgb[8]); + case 7: + r = 16 * hexdigit(rgb[1]) + hexdigit(rgb[2]); + g = 16 * hexdigit(rgb[3]) + hexdigit(rgb[4]); + b = 16 * hexdigit(rgb[5]) + hexdigit(rgb[6]); + break; + default: + error(_("invalid RGB specification")); + } + if (strlen(rgb) == 7) + return R_RGB(r, g, b); + else + return R_RGBA(r, g, b, a); +} + +/* External Color Name to Internal Color Code */ + +static rcolor name2col(const char *nm) +{ + int i; + if(strcmp(nm, "NA") == 0 || strcmp(nm, "transparent") == 0) + /* + * Paul 01/07/04 (2004-07-01?) + * + * Used to be set to NA_INTEGER. + * + * Now set to fully transparent white. + * + * In some cases, fully transparent gets caught by + * the graphics engine and no drawing occurs, but + * in other cases, transparent colours are passed to devices. + * + * All devices should respond to fully transparent by + * not drawing. + */ + return R_TRANWHITE; + for(i = 0; ColorDataBase[i].name ; i++) { + if(StrMatch(ColorDataBase[i].name, nm)) + return ColorDataBase[i].code; + } + error(_("invalid color name '%s'"), nm); + return 0U; /* never occurs but avoid compiler warnings */ +} + + +/* Internal to External Color Representation */ +/* Search the color name database first */ +/* If this fails, create an #RRGGBB string */ + +const char *incol2name(rcolor col) +{ + static char ColBuf[10]; // used for return value + + if(R_OPAQUE(col)) { + for(int i = 0 ; ColorDataBase[i].name ; i++) { + if(col == ColorDataBase[i].code) + return ColorDataBase[i].name; + } + ColBuf[0] = '#'; + ColBuf[1] = HexDigits[(col >> 4) & 15]; + ColBuf[2] = HexDigits[(col ) & 15]; + ColBuf[3] = HexDigits[(col >> 12) & 15]; + ColBuf[4] = HexDigits[(col >> 8) & 15]; + ColBuf[5] = HexDigits[(col >> 20) & 15]; + ColBuf[6] = HexDigits[(col >> 16) & 15]; + ColBuf[7] = '\0'; + return &ColBuf[0]; + } else if (R_TRANSPARENT(col)) { + return "transparent"; + } else { + ColBuf[0] = '#'; + ColBuf[1] = HexDigits[(col >> 4) & 15]; + ColBuf[2] = HexDigits[(col ) & 15]; + ColBuf[3] = HexDigits[(col >> 12) & 15]; + ColBuf[4] = HexDigits[(col >> 8) & 15]; + ColBuf[5] = HexDigits[(col >> 20) & 15]; + ColBuf[6] = HexDigits[(col >> 16) & 15]; + ColBuf[7] = HexDigits[(col >> 28) & 15]; + ColBuf[8] = HexDigits[(col >> 24) & 15]; + ColBuf[9] = '\0'; + return &ColBuf[0]; + } +} + +static rcolor str2col(const char *s, rcolor bg) +{ + if(s[0] == '#') return rgb2col(s); + else if(isdigit((int)s[0])) { + char *ptr; + int indx = (int) strtod(s, &ptr); + if(*ptr) error(_("invalid color specification \"%s\""), s); + if (indx == 0) return bg; + return Palette[(indx-1) % PaletteSize]; + } else return name2col(s); +} + +rcolor inR_GE_str2col(const char *s) +{ + if (streql(s, "0")) + error(_("invalid color specification \"%s\""), s); + return str2col(s, R_TRANWHITE); // bg is irrelevant +} + +/* Convert a sexp element to an R color desc */ +/* We Assume that Checks Have Been Done */ + + +rcolor inRGBpar3(SEXP x, int i, rcolor bg) +{ + int indx; + switch(TYPEOF(x)) + { + case STRSXP: + return str2col(CHAR(STRING_ELT(x, i)), bg); + case LGLSXP: + indx = LOGICAL(x)[i]; + if (indx == NA_LOGICAL) return R_TRANWHITE; + break; + case INTSXP: + indx = INTEGER(x)[i]; + if (indx == NA_INTEGER) return R_TRANWHITE; + break; + case REALSXP: + if(!R_FINITE(REAL(x)[i])) return R_TRANWHITE; + indx = (int) REAL(x)[i]; + break; + default: + warning(_("supplied color is neither numeric nor character")); + return bg; + } + if (indx < 0) + error(_("numerical color values must be >= 0, found %d"), indx); + if (indx == 0) return bg; + else return Palette[(indx-1) % PaletteSize]; +} + +SEXP palette(SEXP val) +{ + SEXP ans; + rcolor color[MAX_PALETTE_SIZE]; + int i, n; + + if (!isString(val)) error(_("invalid argument type")); + /* Record the current palette */ + PROTECT(ans = allocVector(STRSXP, PaletteSize)); + for (i = 0; i < PaletteSize; i++) + SET_STRING_ELT(ans, i, mkChar(incol2name(Palette[i]))); + if ((n = length(val)) == 1) { + if (StrMatch("default", CHAR(STRING_ELT(val, 0)))) { + int i; + for (i = 0; (i < MAX_PALETTE_SIZE) && DefaultPalette[i]; i++) + Palette[i] = name2col(DefaultPalette[i]); + PaletteSize = i; + } else error(_("unknown palette (need >= 2 colors)")); + } + else if (n > 1) { + if (n > MAX_PALETTE_SIZE) + error(_("maximum number of colors is %d"), MAX_PALETTE_SIZE); + for (i = 0; i < n; i++) { + const char *s = CHAR(STRING_ELT(val, i)); + color[i] = (s[0] == '#') ? rgb2col(s) : name2col(s); + } + for (i = 0; i < n; i++) + Palette[i] = color[i]; + PaletteSize = n; + } + UNPROTECT(1); + return ans; +} + +/* A version using 'rcolor' type */ +SEXP palette2(SEXP val) +{ + SEXP ans = PROTECT(allocVector(INTSXP, PaletteSize)); + int n = length(val), *ians = INTEGER(ans); + for (int i = 0; i < PaletteSize; i++) ians[i] = (int)Palette[i]; + if (n) { + if (TYPEOF(val) != INTSXP) error("requires INTSXP argment"); + if (n > MAX_PALETTE_SIZE) + error(_("maximum number of colors is %d"), MAX_PALETTE_SIZE); + for (int i = 0; i < n; i++) Palette[i] = (rcolor)INTEGER(val)[i]; + PaletteSize = n; + } + UNPROTECT(1); + return ans; +} + +SEXP colors(void) +{ + int n; + + for (n = 0; ColorDataBase[n].name != NULL; n++) ; + SEXP ans = PROTECT(allocVector(STRSXP, n)); + for (n = 0; ColorDataBase[n].name != NULL; n++) + SET_STRING_ELT(ans, n, mkChar(ColorDataBase[n].name)); + UNPROTECT(1); + return ans; +} + +/* Used to push/pop palette when replaying display list */ +static void savePalette(Rboolean save) +{ + if (save) + for (int i = 0; i < PaletteSize; i++) + Palette0[i] = Palette[i]; + else + for (int i = 0; i < PaletteSize; i++) + Palette[i] = Palette0[i]; +} + +/* same as src/main/colors.c */ +typedef unsigned int (*F1)(SEXP x, int i, unsigned int bg); +typedef const char * (*F2)(unsigned int col); +typedef unsigned int (*F3)(const char *s); +typedef void (*F4)(Rboolean save); + +void Rg_set_col_ptrs(F1 f1, F2 f2, F3 f3, F4 f4); + +void initPalette(void) +{ + Rg_set_col_ptrs(&inRGBpar3, &incol2name, &inR_GE_str2col, &savePalette); + + /* Initialize the Color Database: we now pre-compute this + for(int i = 0 ; ColorDataBase[i].name ; i++) + ColorDataBase[i].code = rgb2col(ColorDataBase[i].rgb); + + Install Default Palette: precomputed + int i; + for(i = 0 ; DefaultPalette[i] ; i++) + Palette[i] = name2col(DefaultPalette[i]); + PaletteSize = i; // 8 + */ +} + diff --git a/com.oracle.truffle.r.native/gnur/patch/src/library/grDevices/src/devCairo.c b/com.oracle.truffle.r.native/gnur/patch/src/library/grDevices/src/devCairo.c new file mode 100644 index 0000000000000000000000000000000000000000..0cf774bcb813af4275f239a8666d96e3cf48e225 --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/library/grDevices/src/devCairo.c @@ -0,0 +1,68 @@ +/* + * R : A Computer Langage for Statistical Data Analysis + * Copyright (C) 2011-2014 The R Core Team + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version. + * + * This program 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 this program; if not, a copy is available at + * https://www.R-project.org/Licenses/ + */ + +#ifdef HAVE_CONFIG_H +#include <config.h> +#endif + +#include <Defn.h> + + +#include <R_ext/Rdynload.h> +int R_cairoCdynload(int local, int now); + +typedef SEXP (*R_cairo)(SEXP args); +typedef SEXP (*R_cairoVersion_t)(void); + +static R_cairo R_devCairo; +static R_cairoVersion_t R_cairoVersion; + +static int Load_Rcairo_Dll(void) +{ + static int initialized = 0; + + if (initialized) return initialized; + initialized = -1; + + int res = R_cairoCdynload(1, 1); + if(!res) return initialized; + R_devCairo = (R_cairo) R_FindSymbol("in_Cairo", "cairo", NULL); + if (!R_devCairo) error("failed to load cairo DLL"); + R_cairoVersion = (R_cairoVersion_t) R_FindSymbol("in_CairoVersion", "cairo", NULL); + initialized = 1; + return initialized; +} + + +SEXP devCairo(SEXP args) +{ + if (Load_Rcairo_Dll() < 0) warning("failed to load cairo DLL"); + else (R_devCairo)(args); + return R_NilValue; +} + +SEXP cairoVersion(void) +{ +#ifdef HAVE_WORKING_CAIRO + if (Load_Rcairo_Dll() < 0) return mkString(""); + else return (R_cairoVersion)(); +#else + return mkString(""); +#endif +} diff --git a/com.oracle.truffle.r.native/gnur/patch/src/library/grDevices/src/devPS.c b/com.oracle.truffle.r.native/gnur/patch/src/library/grDevices/src/devPS.c new file mode 100644 index 0000000000000000000000000000000000000000..9375b4482bc0eef47228eb9139b1d82c1672a7c4 --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/library/grDevices/src/devPS.c @@ -0,0 +1,8444 @@ +/* + * R : A Computer Language for Statistical Data Analysis + * Copyright (C) 1995, 1996 Robert Gentleman and Ross Ihaka + * Copyright (C) 1998--2015 The R Core Team + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version. + * + * This program 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 this program; if not, a copy is available at + * https://www.R-project.org/Licenses/ + */ + + +#ifdef HAVE_CONFIG_H +#include <config.h> +#endif + +#include <Defn.h> + +#include <stdio.h> +#include <ctype.h> +#include <limits.h> /* required for MB_LEN_MAX */ + +#include <wchar.h> +#include <wctype.h> +static void +mbcsToSbcs(const char *in, char *out, const char *encoding, int enc); + + +#include <R_ext/Riconv.h> + +#include <Rmath.h> /* for fround */ +#define R_USE_PROTOTYPES 1 +#include <R_ext/GraphicsEngine.h> +#include <R_ext/Error.h> +#include <R_ext/RS.h> +#include "Fileio.h" +#include "grDevices.h" + +#ifdef HAVE_ERRNO_H +#include <errno.h> +#else +extern int errno; +#endif + +#include "zlib.h" + +#ifndef max +#define max(a,b) ((a > b) ? a : b) +#endif + +/* from connections.o */ +extern gzFile R_gzopen (const char *path, const char *mode); +extern char *R_gzgets(gzFile file, char *buf, int len); +extern int R_gzclose (gzFile file); + +#define INVALID_COL 0xff0a0b0c + +/* Define this to use hyphen except in -[0-9] */ +#undef USE_HYPHEN +/* In ISOLatin1, minus is 45 and hyphen is 173 */ +#ifdef USE_HYPHEN +static char PS_hyphen = 173; +#endif + +#define USERAFM 999 + +/* Part 0. AFM File Names */ + +static const char *CIDBoldFontStr1 = +"16 dict begin\n" +" /basecidfont exch def\n" +" /basefont-H /.basefont-H /Identity-H [ basecidfont ] composefont def\n" +" /basefont-V /.basefont-V /Identity-V [ basecidfont ] composefont def\n" +" /CIDFontName dup basecidfont exch get def\n" +" /CIDFontType 1 def\n" +" /CIDSystemInfo dup basecidfont exch get def\n" +" /FontInfo dup basecidfont exch get def\n" +" /FontMatrix [ 1 0 0 1 0 0 ] def\n" +" /FontBBox [\n" +" basecidfont /FontBBox get cvx exec\n" +" 4 2 roll basecidfont /FontMatrix get transform\n" +" 4 2 roll basecidfont /FontMatrix get transform\n" +" ] def\n" +" /cid 2 string def\n"; +static const char *CIDBoldFontStr2 = +" /BuildGlyph {\n" +" gsave\n" +" exch begin\n" +" dup 256 idiv cid exch 0 exch put\n" +" 256 mod cid exch 1 exch put\n" +" rootfont\n" +" /WMode known { rootfont /WMode get 1 eq } { false } ifelse\n" +" { basefont-V } { basefont-H } ifelse setfont\n" +" .03 setlinewidth 1 setlinejoin\n" +" newpath\n" +" 0 0 moveto cid false charpath stroke\n" +" 0 0 moveto cid show\n" +" currentpoint setcharwidth\n" +" end\n" +" grestore\n" +" } bind def\n" +" currentdict\n" +"end\n" +"/CIDFont defineresource pop\n"; + + +/* Part 1. AFM File Parsing. */ + +/* These are the basic entities in the AFM file */ + +#define BUFSIZE 512 +#define NA_SHORT -30000 + +typedef struct { + unsigned char c1; + unsigned char c2; + short kern; +} KP; + +typedef struct { + short FontBBox[4]; + short CapHeight; + short XHeight; + short Descender; + short Ascender; + short StemH; + short StemV; + short ItalicAngle; + struct { + short WX; + short BBox[4]; + } CharInfo[256]; + KP *KernPairs; + short KPstart[256]; + short KPend[256]; + short nKP; + short IsFixedPitch; +} FontMetricInfo; + +enum { + Empty, + StartFontMetrics, + Comment, + FontName, + EncodingScheme, + FullName, + FamilyName, + Weight, + ItalicAngle, + IsFixedPitch, + UnderlinePosition, + UnderlineThickness, + Version, + Notice, + FontBBox, + CapHeight, + XHeight, + Descender, + Ascender, + StartCharMetrics, + C, + CH, + EndCharMetrics, + StartKernData, + StartKernPairs, + KPX, + EndKernPairs, + EndKernData, + StartComposites, + CC, + EndComposites, + EndFontMetrics, + StdHW, + StdVW, + CharacterSet, + Unknown +}; + +static const struct { + const char *keyword; + const int code; +} +KeyWordDictionary[] = { + { "StartFontMetrics", StartFontMetrics }, + { "Comment", Comment }, + { "FontName", FontName }, + { "EncodingScheme", EncodingScheme }, + { "FullName", FullName }, + { "FamilyName", FamilyName }, + { "Weight", Weight }, + { "ItalicAngle", ItalicAngle }, + { "IsFixedPitch", IsFixedPitch }, + { "UnderlinePosition", UnderlinePosition }, + { "UnderlineThickness", UnderlineThickness }, + { "Version", Version }, + { "Notice", Notice }, + { "FontBBox", FontBBox }, + { "CapHeight", CapHeight }, + { "XHeight", XHeight }, + { "Descender", Descender }, + { "Ascender", Ascender }, + { "StartCharMetrics", StartCharMetrics }, + { "C ", C }, + { "CH ", CH }, + { "EndCharMetrics", EndCharMetrics }, + { "StartKernData", StartKernData }, + { "StartKernPairs", StartKernPairs }, + { "KPX ", KPX }, + { "EndKernPairs", EndKernPairs }, + { "EndKernData", EndKernData }, + { "StartComposites", StartComposites }, + { "CC ", CC }, + { "EndComposites", EndComposites }, + { "EndFontMetrics", EndFontMetrics }, + { "StdHW", StdHW }, + { "StdVW", StdVW }, + { "CharacterSet", CharacterSet}, + { NULL, Unknown }, +}; + +static int MatchKey(char const * l, char const * k) +{ + while (*k) + if (*k++ != *l++) return 0; + return 1; +} + +static int KeyType(const char * const s) +{ + int i; + if (*s == '\n') + return Empty; + for (i = 0; KeyWordDictionary[i].keyword; i++) + if (MatchKey(s, KeyWordDictionary[i].keyword)) + return KeyWordDictionary[i].code; +// printf("Unknown %s\n", s); // not needed, PR#15057 found it annoying + return Unknown; +} + +static char *SkipToNextItem(char *p) +{ + while (!isspace((int)*p)) p++; + while (isspace((int)*p)) p++; + return p; +} + +static char *SkipToNextKey(char *p) +{ + while (*p != ';') p++; + p++; + while (isspace((int)*p)) p++; + return p; +} + +static int GetFontBBox(const char *buf, FontMetricInfo *metrics) +{ + if (sscanf(buf, "FontBBox %hd %hd %hd %hd", + &(metrics->FontBBox[0]), + &(metrics->FontBBox[1]), + &(metrics->FontBBox[2]), + &(metrics->FontBBox[3])) != 4) return 0; +#ifdef DEBUG_PS2 + Rprintf("FontBBox %d %d %d %d\n", + (metrics->FontBBox[0]), + (metrics->FontBBox[1]), + (metrics->FontBBox[2]), + (metrics->FontBBox[3])); +#endif + return 1; +} + +/* The longest named Adobe glyph is 39 chars: + whitediamondcontainingblacksmalldiamond + */ +typedef struct { + char cname[40]; +} CNAME; + + +/* If reencode > 0, remap to new encoding */ +static int GetCharInfo(char *buf, FontMetricInfo *metrics, + CNAME *charnames, CNAME *encnames, + int reencode) +{ + char *p = buf, charname[40]; + int nchar, nchar2 = -1, i; + short WX; + + if (!MatchKey(buf, "C ")) return 0; + p = SkipToNextItem(p); + sscanf(p, "%d", &nchar); + if ((nchar < 0 || nchar > 255) && !reencode) return 1; + p = SkipToNextKey(p); + + if (!MatchKey(p, "WX")) return 0; + p = SkipToNextItem(p); + sscanf(p, "%hd", &WX); + p = SkipToNextKey(p); + + if (!MatchKey(p, "N ")) return 0; + p = SkipToNextItem(p); + if(reencode) { + sscanf(p, "%s", charname); +#ifdef DEBUG_PS2 + Rprintf("char name %s\n", charname); +#endif + /* a few chars appear twice in ISOLatin1 */ + nchar = nchar2 = -1; + for (i = 0; i < 256; i++) + if(!strcmp(charname, encnames[i].cname)) { + strcpy(charnames[i].cname, charname); + if(nchar == -1) nchar = i; else nchar2 = i; + } + if (nchar == -1) return 1; + } else { + sscanf(p, "%s", charnames[nchar].cname); + } + metrics->CharInfo[nchar].WX = WX; + p = SkipToNextKey(p); + + if (!MatchKey(p, "B ")) return 0; + p = SkipToNextItem(p); + sscanf(p, "%hd %hd %hd %hd", + &(metrics->CharInfo[nchar].BBox[0]), + &(metrics->CharInfo[nchar].BBox[1]), + &(metrics->CharInfo[nchar].BBox[2]), + &(metrics->CharInfo[nchar].BBox[3])); + +#ifdef DEBUG_PS2 + Rprintf("nchar = %d %d %d %d %d %d\n", nchar, + metrics->CharInfo[nchar].WX, + metrics->CharInfo[nchar].BBox[0], + metrics->CharInfo[nchar].BBox[1], + metrics->CharInfo[nchar].BBox[2], + metrics->CharInfo[nchar].BBox[3]); +#endif + if (nchar2 > 0) { + metrics->CharInfo[nchar2].WX = WX; + sscanf(p, "%hd %hd %hd %hd", + &(metrics->CharInfo[nchar2].BBox[0]), + &(metrics->CharInfo[nchar2].BBox[1]), + &(metrics->CharInfo[nchar2].BBox[2]), + &(metrics->CharInfo[nchar2].BBox[3])); + +#ifdef DEBUG_PS2 + Rprintf("nchar = %d %d %d %d %d %d\n", nchar2, + metrics->CharInfo[nchar2].WX, + metrics->CharInfo[nchar2].BBox[0], + metrics->CharInfo[nchar2].BBox[1], + metrics->CharInfo[nchar2].BBox[2], + metrics->CharInfo[nchar2].BBox[3]); +#endif + } + return 1; +} + +static int GetKPX(char *buf, int nkp, FontMetricInfo *metrics, + CNAME *charnames) +{ + char *p = buf, c1[50], c2[50]; + int i, done = 0; + + p = SkipToNextItem(p); + sscanf(p, "%s %s %hd", c1, c2, &(metrics->KernPairs[nkp].kern)); + if (streql(c1, "space") || streql(c2, "space")) return 0; + for(i = 0; i < 256; i++) { + if (!strcmp(c1, charnames[i].cname)) { + metrics->KernPairs[nkp].c1 = (unsigned char) i; + done++; + break; + } + } + for(i = 0; i < 256; i++) + if (!strcmp(c2, charnames[i].cname)) { + metrics->KernPairs[nkp].c2 = (unsigned char) i; + done++; + break; + } + return (done==2); +} + +/* Encode File Parsing. */ +/* Statics here are OK, as all the calls are in one initialization + so no concurrency (until threads?) */ + +typedef struct { + /* Probably can make buf and p0 local variables. Only p needs to be + stored across calls. Need to investigate this more closely. */ + char buf[1000]; + char *p; + char *p0; +} EncodingInputState; + +/* read in the next encoding item, separated by white space. */ +static int GetNextItem(FILE *fp, char *dest, int c, EncodingInputState *state) +{ + if (c < 0) state->p = NULL; + while (1) { + if (feof(fp)) { state->p = NULL; return 1; } + if (!state->p || *state->p == '\n' || *state->p == '\0') { + state->p = fgets(state->buf, 1000, fp); + } + /* check for incomplete encoding file */ + if(!state->p) return 1; + while (isspace((int)* state->p)) state->p++; + if (*state->p == '\0' || *state->p == '%'|| *state->p == '\n') { state->p = NULL; continue; } + state->p0 = state->p; + while (!isspace((int)*state->p)) state->p++; + if (*state->p != '\0') *state->p++ = '\0'; + if(c == 45) strcpy(dest, "/minus"); else strcpy(dest, state->p0); + break; + } + return 0; +} + +/* + * Convert the encoding file name into a name to be used with iconv() + * in mbcsToSbcs() + * + * FIXME: Doesn't trim path/to/encfile (i.e., doesn't handle + * custom encoding file selected by user). + * Also assumes that encpath has ".enc" suffix supplied + * (not required by R interface) + */ + +static int pathcmp(const char *encpath, const char *comparison) { + char pathcopy[PATH_MAX]; + char *p1, *p2; + strcpy(pathcopy, encpath); + /* + * Strip path/to/encfile/ + */ + p1 = &(pathcopy[0]); + while ((p2 = strchr(p1, FILESEP[0]))) { + p1 = p2 + sizeof(char); + } + /* + * Strip suffix + */ + p2 = (strchr(p1, '.')); + if (p2) + *p2 = '\0'; + return strcmp(p1, comparison); +} + +static void seticonvName(const char *encpath, char *convname) +{ + /* + * Default to "latin1" + */ + char *p; + strcpy(convname, "latin1"); + if(pathcmp(encpath, "ISOLatin1")==0) + strcpy(convname, "latin1"); + else if(pathcmp(encpath, "ISOLatin2")==0) + strcpy(convname, "latin2"); + else if(pathcmp(encpath, "ISOLatin7")==0) + strcpy(convname, "latin7"); + else if(pathcmp(encpath, "ISOLatin9")==0) + strcpy(convname, "latin-9"); + else if (pathcmp(encpath, "WinAnsi")==0) + strcpy(convname, "CP1252"); + else { + /* + * Last resort = trim .enc off encpath to produce convname + */ + strcpy(convname, encpath); + p = strrchr(convname, '.'); + if(p) *p = '\0'; + } +} + +/* Load encoding array from a file: defaults to the R_HOME/library/grDevices/afm directory */ + +/* + * encpath gives the file to read from + * encname is filled with the encoding name from the file + * encconvname is filled with a "translation" of the encoding name into + * one that can be used with iconv() + * encnames is filled with the character names from the file + * enccode is filled with the raw source of the file + */ +static int +LoadEncoding(const char *encpath, char *encname, + char *encconvname, CNAME *encnames, + char *enccode, Rboolean isPDF) +{ + char buf[BUFSIZE]; + int i; + FILE *fp; + EncodingInputState state; + state.p = state.p0 = NULL; + + seticonvName(encpath, encconvname); + + if(strchr(encpath, FILESEP[0])) strcpy(buf, encpath); + else snprintf(buf, BUFSIZE,"%s%slibrary%sgrDevices%senc%s%s", + R_Home, FILESEP, FILESEP, FILESEP, FILESEP, encpath); +#ifdef DEBUG_PS + Rprintf("encoding path is %s\n", buf); +#endif + if (!(fp = R_fopen(R_ExpandFileName(buf), "r"))) { + strcat(buf, ".enc"); + if (!(fp = R_fopen(R_ExpandFileName(buf), "r"))) return 0; + } + if (GetNextItem(fp, buf, -1, &state)) return 0; /* encoding name */ + strncpy(encname, buf+1, 99); + encname[99] = '\0'; + if (!isPDF) snprintf(enccode, 5000, "/%s [\n", encname); + else enccode[0] = '\0'; + if (GetNextItem(fp, buf, 0, &state)) { fclose(fp); return 0;} /* [ */ + for(i = 0; i < 256; i++) { + if (GetNextItem(fp, buf, i, &state)) { fclose(fp); return 0; } + strncpy(encnames[i].cname, buf+1, 39); + encnames[i].cname[39] = '\0'; + strcat(enccode, " /"); strcat(enccode, encnames[i].cname); + if(i%8 == 7) strcat(enccode, "\n"); + } + if (GetNextItem(fp, buf, 0, &state)) { fclose(fp); return 0;} /* ] */ + fclose(fp); + if (!isPDF) strcat(enccode,"]\n"); + return 1; +} + +/* Load font metrics from a file: defaults to the + R_HOME/library/grDevices/afm directory */ +static int +PostScriptLoadFontMetrics(const char * const fontpath, + FontMetricInfo *metrics, + char *fontname, + CNAME *charnames, + CNAME *encnames, + int reencode) +{ + char buf[BUFSIZE], *p, truth[10]; + int mode, i = 0, j, ii, nKPX=0; + gzFile fp; + + if(strchr(fontpath, FILESEP[0])) strcpy(buf, fontpath); + else + snprintf(buf, BUFSIZE,"%s%slibrary%sgrDevices%safm%s%s.gz", + R_Home, FILESEP, FILESEP, FILESEP, FILESEP, fontpath); +#ifdef DEBUG_PS + Rprintf("afmpath is %s\n", buf); + Rprintf("reencode is %d\n", reencode); +#endif + + if (!(fp = R_gzopen(R_ExpandFileName(buf), "rb"))) { + /* try uncompressed version */ + snprintf(buf, BUFSIZE,"%s%slibrary%sgrDevices%safm%s%s", + R_Home, FILESEP, FILESEP, FILESEP, FILESEP, fontpath); + if (!(fp = R_gzopen(R_ExpandFileName(buf), "rb"))) { + warning(_("afm file '%s' could not be opened"), + R_ExpandFileName(buf)); + return 0; + } + } + + metrics->KernPairs = NULL; + metrics->CapHeight = metrics->XHeight = metrics->Descender = + metrics->Ascender = metrics->StemH = metrics->StemV = NA_SHORT; + metrics->IsFixedPitch = -1; + metrics->ItalicAngle = 0; + mode = 0; + for (ii = 0; ii < 256; ii++) { + charnames[ii].cname[0] = '\0'; + metrics->CharInfo[ii].WX = NA_SHORT; + for(j = 0; j < 4; j++) metrics->CharInfo[ii].BBox[j] = 0; + } + while (R_gzgets(fp, buf, BUFSIZE)) { + switch(KeyType(buf)) { + + case StartFontMetrics: + mode = StartFontMetrics; + break; + + case EndFontMetrics: + mode = 0; + break; + + case FontBBox: + if (!GetFontBBox(buf, metrics)) { + warning("'FontBBox' could not be parsed"); + goto pserror; + } + break; + + case C: + if (mode != StartFontMetrics) goto pserror; + if (!GetCharInfo(buf, metrics, charnames, encnames, reencode)) { + warning("'CharInfo' could not be parsed"); + goto pserror; + } + break; + + case StartKernData: + mode = StartKernData; + break; + + case StartKernPairs: + if(mode != StartKernData) goto pserror; + p = SkipToNextItem(buf); + sscanf(p, "%d", &nKPX); + if(nKPX > 0) { + /* nPKX == 0 should not happen, but has */ + metrics->KernPairs = (KP *) malloc(nKPX * sizeof(KP)); + if (!metrics->KernPairs) goto pserror; + } + break; + + case KPX: + if(mode != StartKernData || i >= nKPX) goto pserror; + if (GetKPX(buf, i, metrics, charnames)) i++; + break; + + case EndKernData: + mode = 0; + break; + + case Unknown: + warning(_("unknown AFM entity encountered")); + break; + + case FontName: + p = SkipToNextItem(buf); + sscanf(p, "%[^\n\f\r]", fontname); + break; + + case CapHeight: + p = SkipToNextItem(buf); + sscanf(p, "%hd", &metrics->CapHeight); + break; + + case XHeight: + p = SkipToNextItem(buf); + sscanf(p, "%hd", &metrics->XHeight); + break; + + case Ascender: + p = SkipToNextItem(buf); + sscanf(p, "%hd", &metrics->Ascender); + break; + + case Descender: + p = SkipToNextItem(buf); + sscanf(p, "%hd", &metrics->Descender); + break; + + case StdHW: + p = SkipToNextItem(buf); + sscanf(p, "%hd", &metrics->StemH); + break; + + case StdVW: + p = SkipToNextItem(buf); + sscanf(p, "%hd", &metrics->StemV); + break; + + case ItalicAngle: + p = SkipToNextItem(buf); + sscanf(p, "%hd", &metrics->ItalicAngle); + break; + + case IsFixedPitch: + p = SkipToNextItem(buf); + sscanf(p, "%[^\n\f\r]", truth); + metrics->IsFixedPitch = strcmp(truth, "true") == 0; + break; + + case Empty: + default: + break; + } + } + metrics->nKP = (short) i; + R_gzclose(fp); + /* Make an index for kern-pair searches: relies on having contiguous + blocks by first char for efficiency, but works in all cases. */ + { + short ind, tmp; + for (j = 0; j < 256; j++) { + metrics->KPstart[j] = (short) i; + metrics->KPend[j] = 0; + } + for (j = 0; j < i; j++) { + ind = metrics->KernPairs[j].c1; + tmp = metrics->KPstart[ind]; + if(j < tmp) metrics->KPstart[ind] = (short) j; + tmp = metrics->KPend[ind]; + if(j > tmp) metrics->KPend[ind] = (short) j; + } + } + return 1; +pserror: + R_gzclose(fp); + return 0; +} + + +#include <rlocale.h> /* for Ri18n_wcwidth */ + + +static double + PostScriptStringWidth(const unsigned char *str, int enc, + FontMetricInfo *metrics, + Rboolean useKerning, + int face, const char *encoding) +{ + int sum = 0, i; + short wx; + const unsigned char *p = NULL, *str1 = str; + unsigned char p1, p2; + + int status; + if(!metrics && (face % 5) != 0) { + /* This is the CID font case, and should only happen for + non-symbol fonts. So we assume monospaced with multipliers. + We need to remap even if we are in a SBCS, should we get to here */ + size_t ucslen; + ucslen = mbcsToUcs2((char *)str, NULL, 0, enc); + if (ucslen != (size_t)-1) { + /* We convert the characters but not the terminator here */ + R_CheckStack2(ucslen * sizeof(ucs2_t)); + ucs2_t ucs2s[ucslen]; + status = (int) mbcsToUcs2((char *)str, ucs2s, (int) ucslen, enc); + if (status >= 0) + for(i = 0 ; i < ucslen ; i++) { + wx = (short)(500 * Ri18n_wcwidth(ucs2s[i])); + /* printf("width for U+%04x is %d\n", ucs2s[i], wx); */ + sum += wx; + } + else + warning(_("invalid string in '%s'"), "PostScriptStringWidth"); + return 0.001 * sum; + } else { + warning(_("invalid string in '%s'"), "PostScriptStringWidth"); + return 0.0; + } + } else + if(!strIsASCII((char *) str) && + /* + * Every fifth font is a symbol font: + * see postscriptFonts() + */ + (face % 5) != 0) { + R_CheckStack2(strlen((char *)str)+1); + char buff[strlen((char *)str)+1]; + /* Output string cannot be longer */ + mbcsToSbcs((char *)str, buff, encoding, enc); + str1 = (unsigned char *)buff; + } + + /* safety */ + if(!metrics) return 0.0; + + + /* Now we know we have an 8-bit encoded string in the encoding to + be used for output. */ + for (p = str1; *p; p++) { +#ifdef USE_HYPHEN + if (*p == '-' && !isdigit(p[1])) + wx = metrics->CharInfo[(int)PS_hyphen].WX; + else +#endif + wx = metrics->CharInfo[*p].WX; + if(wx == NA_SHORT) + warning(_("font width unknown for character 0x%x"), *p); + else sum += wx; + + if(useKerning) { + /* check for kerning adjustment */ + p1 = p[0]; p2 = p[1]; + for (i = metrics->KPstart[p1]; i < metrics->KPend[p1]; i++) + /* second test is a safety check: should all start with p1 */ + if(metrics->KernPairs[i].c2 == p2 && + metrics->KernPairs[i].c1 == p1) { + sum += metrics->KernPairs[i].kern; + break; + } + } + } + return 0.001 * sum; +} + + +/* Be careful about the assumptions here. In an 8-bit locale 0 <= c < 256 + and it is in the encoding in use. As it is not going to be + re-encoded when text is output, it is correct not to re-encode here. + + When called in an MBCS locale and font != 5, chars < 128 are sent + as is (we assume that is ASCII) and others are re-encoded to + Unicode in GEText (and interpreted as Unicode in GESymbol). +*/ +# ifdef WORDS_BIGENDIAN +static const char UCS2ENC[] = "UCS-2BE"; +# else +static const char UCS2ENC[] = "UCS-2LE"; +# endif + +static void +PostScriptMetricInfo(int c, double *ascent, double *descent, double *width, + FontMetricInfo *metrics, + Rboolean isSymbol, + const char *encoding) +{ + Rboolean Unicode = mbcslocale; + + if (c == 0) { + *ascent = 0.001 * metrics->FontBBox[3]; + *descent = -0.001 * metrics->FontBBox[1]; + *width = 0.001 * (metrics->FontBBox[2] - metrics->FontBBox[0]); + return; + } + + if (c < 0) { Unicode = TRUE; c = -c; } + /* We don't need the restriction to 65536 here any more as we could + convert from UCS4ENC, but there are few language chars above 65536. */ + if(Unicode && !isSymbol && c >= 128 && c < 65536) { /* Unicode */ + void *cd = NULL; + const char *i_buf; char *o_buf, out[2]; + size_t i_len, o_len, status; + unsigned short w[2]; + + if ((void*)-1 == (cd = Riconv_open(encoding, UCS2ENC))) + error(_("unknown encoding '%s' in 'PostScriptMetricInfo'"), + encoding); + + /* Here we use terminated strings, but could use one char */ + w[0] = (unsigned short) c; w[1] = 0; + i_buf = (char *)w; + i_len = 4; + o_buf = out; + o_len = 2; + status = Riconv(cd, &i_buf, (size_t *)&i_len, + (char **)&o_buf, (size_t *)&o_len); + Riconv_close(cd); + if (status == (size_t)-1) { + *ascent = 0; + *descent = 0; + *width = 0; + warning(_("font metrics unknown for Unicode character U+%04x"), c); + return; + } else { + c = out[0] & 0xff; + } + } + + if (c > 255) { /* Unicode */ + *ascent = 0; + *descent = 0; + *width = 0; + warning(_("font metrics unknown for Unicode character U+%04x"), c); + } else { + short wx; + + *ascent = 0.001 * metrics->CharInfo[c].BBox[3]; + *descent = -0.001 * metrics->CharInfo[c].BBox[1]; + wx = metrics->CharInfo[c].WX; + if(wx == NA_SHORT) { + warning(_("font metrics unknown for character 0x%x"), c); + wx = 0; + } + *width = 0.001 * wx; + } +} + +static void +PostScriptCIDMetricInfo(int c, double *ascent, double *descent, double *width) +{ + /* calling in a SBCS is probably not intentional, but we should try to + cope sensibly. */ + if(!mbcslocale && c > 0) { + if (c > 255) + error(_("invalid character (%04x) sent to 'PostScriptCIDMetricInfo' in a single-byte locale"), + c); + else { + /* convert to UCS-2 to use wcwidth. */ + char str[2]={0,0}; + ucs2_t out; + str[0] = (char) c; + if(mbcsToUcs2(str, &out, 1, CE_NATIVE) == (size_t)-1) + error(_("invalid character sent to 'PostScriptCIDMetricInfo' in a single-byte locale")); + c = out; + } + } + + /* Design values for all CJK fonts */ + *ascent = 0.880; + *descent = -0.120; + if (c == 0 || c > 65535) *width = 1.; else *width = 0.5*Ri18n_wcwidth(c); +} + + +/******************************************************* + * Data structures and functions for loading Type 1 fonts into an R session. + * + * Used by PostScript, XFig and PDF drivers. + * + * The idea is that font information is only loaded once for each font + * within an R session. Also, each encoding is only loaded once per + * session. A global list of loaded fonts and a global list of + * loaded encodings are maintained. Devices maintain their own list + * of fonts and encodings used on the device; the elements of these + * lists are just pointers to the elements of the global lists. + * + * Cleaning up device lists just involves free'ing the lists themselves. + * When the R session closes, the actual font and encoding information + * is unloaded using the global lists. + */ + +/* + * Information about one Type 1 font + */ +typedef struct CIDFontInfo { + char name[50]; +} CIDFontInfo, *cidfontinfo; + +typedef struct T1FontInfo { + char name[50]; + FontMetricInfo metrics; + CNAME charnames[256]; +} Type1FontInfo, *type1fontinfo; + +/* + * Information about a font encoding + */ +typedef struct EncInfo { + char encpath[PATH_MAX]; + char name[100]; /* Name written to PostScript/PDF file */ + char convname[50]; /* Name used in mbcsToSbcs() with iconv() */ + CNAME encnames[256]; + char enccode[5000]; +} EncodingInfo, *encodinginfo; + +/* + * Information about a font family + * (5 fonts representing plain, bold, italic, bolditalic, and symbol) + * + * The name is a graphics engine font family name + * (distinct from the Type 1 font name) + */ +typedef struct CIDFontFamily { + char fxname[50]; + cidfontinfo cidfonts[4]; + type1fontinfo symfont; + char cmap[50]; + char encoding[50]; +} CIDFontFamily, *cidfontfamily; + +typedef struct T1FontFamily { + char fxname[50]; + type1fontinfo fonts[5]; + encodinginfo encoding; +} Type1FontFamily, *type1fontfamily; + +/* + * A list of Type 1 font families + * + * Used to keep track of fonts currently loaded in the session + * AND by each device to keep track of fonts currently used on the device. + */ +typedef struct CIDFontList { + cidfontfamily cidfamily; + struct CIDFontList *next; +} CIDFontList, *cidfontlist; + +typedef struct T1FontList { + type1fontfamily family; + struct T1FontList *next; +} Type1FontList, *type1fontlist; + +/* + * Same as type 1 font list, but for encodings. + */ +typedef struct EncList { + encodinginfo encoding; + struct EncList *next; +} EncodingList, *encodinglist; + +/* + * Various constructors and destructors + */ +static cidfontinfo makeCIDFont() +{ + cidfontinfo font = (CIDFontInfo *) malloc(sizeof(CIDFontInfo)); + if (!font) + warning(_("failed to allocate CID font info")); + return font; +} + +static type1fontinfo makeType1Font() +{ + type1fontinfo font = (Type1FontInfo *) malloc(sizeof(Type1FontInfo)); + /* + * Initialise font->metrics.KernPairs to NULL + * so that we know NOT to free it if we fail to + * load this font and have to + * bail out and free this type1fontinfo + */ + font->metrics.KernPairs = NULL; + if (!font) + warning(_("failed to allocate Type 1 font info")); + return font; +} + +static void freeCIDFont(cidfontinfo font) +{ + free(font); +} + +static void freeType1Font(type1fontinfo font) +{ + if (font->metrics.KernPairs) + free(font->metrics.KernPairs); + free(font); +} + +static encodinginfo makeEncoding() +{ + encodinginfo encoding = (EncodingInfo *) malloc(sizeof(EncodingInfo)); + if (!encoding) + warning(_("failed to allocate encoding info")); + return encoding; +} + +static void freeEncoding(encodinginfo encoding) +{ + free(encoding); +} + +static cidfontfamily makeCIDFontFamily() +{ + cidfontfamily family = (CIDFontFamily *) malloc(sizeof(CIDFontFamily)); + if (family) { + int i; + for (i = 0; i < 4; i++) + family->cidfonts[i] = NULL; + family->symfont = NULL; + } else + warning(_("failed to allocate CID font family")); + return family; +} + +static type1fontfamily makeFontFamily() +{ + type1fontfamily family = (Type1FontFamily *) malloc(sizeof(Type1FontFamily)); + if (family) { + int i; + for (i = 0; i < 5; i++) + family->fonts[i] = NULL; + family->encoding = NULL; + } else + warning(_("failed to allocate Type 1 font family")); + return family; +} +/* + * Frees a font family, including fonts, but NOT encoding + * + * Used by global font list to free all fonts loaded in session + * (should not be used by devices; else may free fonts more than once) + * + * Encodings are freed using the global encoding list + * (to ensure that each encoding is only freed once) + */ +static void freeCIDFontFamily(cidfontfamily family) +{ + int i; + for (i = 0; i < 4; i++) + if (family->cidfonts[i]) + freeCIDFont(family->cidfonts[i]); + if (family->symfont) + freeType1Font(family->symfont); + free(family); +} + +static void freeFontFamily(type1fontfamily family) +{ + int i; + for (i=0; i<5; i++) + if (family->fonts[i]) + freeType1Font(family->fonts[i]); + free(family); +} + +static cidfontlist makeCIDFontList() +{ + cidfontlist fontlist = (CIDFontList *) malloc(sizeof(CIDFontList)); + if (fontlist) { + fontlist->cidfamily = NULL; + fontlist->next = NULL; + } else + warning(_("failed to allocate font list")); + return fontlist; +} + +static type1fontlist makeFontList() +{ + type1fontlist fontlist = (Type1FontList *) malloc(sizeof(Type1FontList)); + if (fontlist) { + fontlist->family = NULL; + fontlist->next = NULL; + } else + warning(_("failed to allocate font list")); + return fontlist; +} + +/* + * Just free the Type1FontList structure, do NOT free elements it points to + * + * Used by both global font list and devices to free the font lists + * (global font list separately takes care of the fonts pointed to) + */ +static void freeCIDFontList(cidfontlist fontlist) { + /* + * These will help to find any errors if attempt to + * use freed font list. + */ + fontlist->cidfamily = NULL; + fontlist->next = NULL; + free(fontlist); +} +static void freeFontList(type1fontlist fontlist) { + /* + * These will help to find any errors if attempt to + * use freed font list. + */ + fontlist->family = NULL; + fontlist->next = NULL; + free(fontlist); +} + +static void freeDeviceCIDFontList(cidfontlist fontlist) { + if (fontlist) { + if (fontlist->next) + freeDeviceCIDFontList(fontlist->next); + freeCIDFontList(fontlist); + } +} +static void freeDeviceFontList(type1fontlist fontlist) { + if (fontlist) { + if (fontlist->next) + freeDeviceFontList(fontlist->next); + freeFontList(fontlist); + } +} + +static encodinglist makeEncList() +{ + encodinglist enclist = (EncodingList *) malloc(sizeof(EncodingList)); + if (enclist) { + enclist->encoding = NULL; + enclist->next = NULL; + } else + warning(_("failed to allocated encoding list")); + return enclist; +} + +static void freeEncList(encodinglist enclist) +{ + enclist->encoding = NULL; + enclist->next = NULL; + free(enclist); +} + +static void freeDeviceEncList(encodinglist enclist) { + if (enclist) { + if (enclist->next) + freeDeviceEncList(enclist->next); + freeEncList(enclist); + } +} + +/* + * Global list of fonts and encodings that have been loaded this session + */ +static cidfontlist loadedCIDFonts = NULL; +static type1fontlist loadedFonts = NULL; +static encodinglist loadedEncodings = NULL; +/* + * There are separate PostScript and PDF font databases at R level + * so MUST have separate C level records too + * (because SAME device-independent font family name could map + * to DIFFERENT font for PostScript and PDF) + */ +static cidfontlist PDFloadedCIDFonts = NULL; +static type1fontlist PDFloadedFonts = NULL; +static encodinglist PDFloadedEncodings = NULL; + +/* + * Names of R level font databases + */ +static char PostScriptFonts[] = ".PostScript.Fonts"; +static char PDFFonts[] = ".PDF.Fonts"; + +/* + * Free the above globals + * + * NOTE that freeing the font families does NOT free the encodings + * Hence we free all encodings first. + */ + +/* NB this is exported, and was at some point used by KillAllDevices + in src/main/graphics.c. That would be a problem now it is in a + separate DLL. +*/ +#if 0 +void freeType1Fonts() +{ + encodinglist enclist = loadedEncodings; + type1fontlist fl = loadedFonts; + cidfontlist cidfl = loadedCIDFonts; + type1fontlist pdffl = PDFloadedFonts; + cidfontlist pdfcidfl = PDFloadedCIDFonts; + while (enclist) { + enclist = enclist->next; + freeEncoding(loadedEncodings->encoding); + freeEncList(loadedEncodings); + loadedEncodings = enclist; + } + while (fl) { + fl = fl->next; + freeFontFamily(loadedFonts->family); + freeFontList(loadedFonts); + loadedFonts = fl; + } + while (cidfl) { + cidfl = cidfl->next; + freeCIDFontFamily(loadedCIDFonts->cidfamily); + freeCIDFontList(loadedCIDFonts); + loadedCIDFonts = cidfl; + } + while (pdffl) { + pdffl = pdffl->next; + freeFontFamily(PDFloadedFonts->family); + freeFontList(PDFloadedFonts); + PDFloadedFonts = pdffl; + } + while (pdfcidfl) { + pdfcidfl = pdfcidfl->next; + freeCIDFontFamily(PDFloadedCIDFonts->cidfamily); + freeCIDFontList(PDFloadedCIDFonts); + PDFloadedCIDFonts = pdfcidfl; + } +} +#endif + +/* + * Given a path to an encoding file, + * find an EncodingInfo that corresponds + */ +static encodinginfo +findEncoding(const char *encpath, encodinglist deviceEncodings, Rboolean isPDF) +{ + encodinglist enclist = isPDF ? PDFloadedEncodings : loadedEncodings; + encodinginfo encoding = NULL; + int found = 0; + /* + * "default" is a special encoding which means use the + * default (FIRST) encoding set up ON THIS DEVICE. + */ + if (!strcmp(encpath, "default")) { + found = 1; + encoding = deviceEncodings->encoding; + } else { + while (enclist && !found) { + found = !strcmp(encpath, enclist->encoding->encpath); + if (found) + encoding = enclist->encoding; + enclist = enclist->next; + } + } + return encoding; +} + +/* + * Find an encoding in device encoding list + */ +static encodinginfo +findDeviceEncoding(const char *encpath, encodinglist enclist, int *index) +{ + encodinginfo encoding = NULL; + int found = 0; + *index = 0; + while (enclist && !found) { + found = !strcmp(encpath, enclist->encoding->encpath); + if (found) + encoding = enclist->encoding; + enclist = enclist->next; + *index = *index + 1; + } + return encoding; +} + +/* + * Utility to avoid string overrun + */ +static void safestrcpy(char *dest, const char *src, int maxlen) +{ + if (strlen(src) < maxlen) + strcpy(dest, src); + else { + warning(_("truncated string which was too long for copy")); + strncpy(dest, src, maxlen-1); + dest[maxlen-1] = '\0'; + } +} + +/* + * Add an encoding to the list of loaded encodings ... + * + * ... and return the new encoding + */ +static encodinginfo addEncoding(const char *encpath, Rboolean isPDF) +{ + encodinginfo encoding = makeEncoding(); + if (encoding) { + if (LoadEncoding(encpath, + encoding->name, + encoding->convname, + encoding->encnames, + encoding->enccode, + isPDF)) { + encodinglist newenc = makeEncList(); + if (!newenc) { + freeEncoding(encoding); + encoding = NULL; + } else { + encodinglist enclist = + isPDF ? PDFloadedEncodings : loadedEncodings; + safestrcpy(encoding->encpath, encpath, PATH_MAX); + newenc->encoding = encoding; + if (!enclist) { + if(isPDF) PDFloadedEncodings = newenc; + else loadedEncodings = newenc; + } else { + while (enclist->next) + enclist = enclist->next; + enclist->next = newenc; + } + } + } else { + warning(_("failed to load encoding file '%s'"), encpath); + freeEncoding(encoding); + encoding = NULL; + } + } else + encoding = NULL; + return encoding; +} + +/* + * Add an encoding to a list of device encodings ... + * + * ... and return the new list + */ +static encodinglist addDeviceEncoding(encodinginfo encoding, + encodinglist devEncs) +{ + encodinglist newenc = makeEncList(); + if (!newenc) { + devEncs = NULL; + } else { + encodinglist enclist = devEncs; + newenc->encoding = encoding; + if (!devEncs) + devEncs = newenc; + else { + while (enclist->next) + enclist = enclist->next; + enclist->next = newenc; + } + } + return devEncs; +} + +/* + * Given a graphics engine font family name, + * find a Type1FontFamily that corresponds + * + * If get fxname match, check whether the encoding in the + * R database is "default" + * (i.e., the graphics engine font family encoding is unspecified) + * If it is "default" then check that the loaded encoding is the + * same as the encoding we want. A matching encoding is defined + * as one which leads to the same iconvname (see seticonvName()). + * This could perhaps be made more rigorous by actually looking inside + * the relevant encoding file for the encoding name. + * + * If the encoding we want is NULL, then we just don't care. + * + * Returns NULL if can't find font in loadedFonts + */ + +static const char *getFontEncoding(const char *family, const char *fontdbname); + +static type1fontfamily +findLoadedFont(const char *name, const char *encoding, Rboolean isPDF) +{ + type1fontlist fontlist; + type1fontfamily font = NULL; + char *fontdbname; + int found = 0; + + if (isPDF) { + fontlist = PDFloadedFonts; + fontdbname = PDFFonts; + } else { + fontlist = loadedFonts; + fontdbname = PostScriptFonts; + } + while (fontlist && !found) { + found = !strcmp(name, fontlist->family->fxname); + if (found) { + font = fontlist->family; + if (encoding) { + char encconvname[50]; + const char *encname = getFontEncoding(name, fontdbname); + seticonvName(encoding, encconvname); + if (!strcmp(encname, "default") && + strcmp(fontlist->family->encoding->convname, + encconvname)) { + font = NULL; + found = 0; + } + } + } + fontlist = fontlist->next; + } + return font; +} + +SEXP Type1FontInUse(SEXP name, SEXP isPDF) +{ + if (!isString(name) || LENGTH(name) > 1) + error(_("invalid font name or more than one font name")); + return ScalarLogical( + findLoadedFont(CHAR(STRING_ELT(name, 0)), NULL, asLogical(isPDF)) + != NULL); +} + +static cidfontfamily findLoadedCIDFont(const char *family, Rboolean isPDF) +{ + cidfontlist fontlist; + cidfontfamily font = NULL; + int found = 0; + + if (isPDF) { + fontlist = PDFloadedCIDFonts; + } else { + fontlist = loadedCIDFonts; + } + while (fontlist && !found) { + found = !strcmp(family, fontlist->cidfamily->cidfonts[0]->name); + if (found) + font = fontlist->cidfamily; + fontlist = fontlist->next; + } +#ifdef PS_DEBUG + if(found) + Rprintf("findLoadedCIDFont found = %s\n",family); +#endif + return font; +} + +SEXP CIDFontInUse(SEXP name, SEXP isPDF) +{ + if (!isString(name) || LENGTH(name) > 1) + error(_("invalid font name or more than one font name")); + return ScalarLogical( + findLoadedCIDFont(CHAR(STRING_ELT(name, 0)), asLogical(isPDF)) + != NULL); +} + +/* + * Find a font in device font list + */ +static cidfontfamily +findDeviceCIDFont(const char *name, cidfontlist fontlist, int *index) +{ + cidfontfamily font = NULL; + int found = 0; + *index = 0; + /* + * If the graphics engine font family is "" + * just use the default font that was loaded when the device + * was created. + * This will (MUST) be the first font in the device + */ +#ifdef DEBUG_PS + Rprintf("findDeviceCIDFont=%s\n", name); + Rprintf("? cidfontlist %s\n", (fontlist) ? "found" : "not found"); +#endif + + if (strlen(name) > 0) { + while (fontlist && !found) { +#ifdef DEBUG_PS + Rprintf("findDeviceCIDFont=%s\n", name); + Rprintf("findDeviceCIDFont fontlist->cidfamily->name=%s\n", + fontlist->cidfamily->fxname); +#endif + + found = !strcmp(name, fontlist->cidfamily->fxname); + if (found) + font = fontlist->cidfamily; + fontlist = fontlist->next; + *index = *index + 1; + } + } else { + font = fontlist->cidfamily; + *index = 1; + } +#ifdef DEBUG_PS + Rprintf("findDeviceCIDFont find index=%d\n", *index); + Rprintf("findDeviceCIDFont find font=%s\n", (font) ? "Found" : "NULL"); +#endif + return font; +} + +/* + * Must only be called once a device has at least one font added + * (i.e., after the default font has been added) + */ +static type1fontfamily +findDeviceFont(const char *name, type1fontlist fontlist, int *index) +{ + type1fontfamily font = NULL; + int found = 0; + *index = 0; + /* + * If the graphics engine font family is "" + * just use the default font that was loaded when the device + * was created. + * This will (MUST) be the first font in the device + */ + if (strlen(name) > 0) { + while (fontlist && !found) { + found = !strcmp(name, fontlist->family->fxname); + if (found) + font = fontlist->family; + fontlist = fontlist->next; + *index = *index + 1; + } + } else { + font = fontlist->family; + *index = 1; + } + return font; +} + +/* + * Get an R-level font database + */ +static SEXP getFontDB(const char *fontdbname) { + SEXP graphicsNS, PSenv; + SEXP fontdb; + PROTECT(graphicsNS = R_FindNamespace(ScalarString(mkChar("grDevices")))); + PROTECT(PSenv = findVar(install(".PSenv"), graphicsNS)); + /* under lazy loading this will be a promise on first use */ + if(TYPEOF(PSenv) == PROMSXP) { + PROTECT(PSenv); + PSenv = eval(PSenv, graphicsNS); + UNPROTECT(2); + PROTECT(PSenv); + } + PROTECT(fontdb = findVar(install(fontdbname), PSenv)); + UNPROTECT(3); + return fontdb; +} + +/* + * Get an R-level font object + */ +static SEXP getFont(const char *family, const char *fontdbname) { + int i, nfonts; + SEXP result = R_NilValue; + int found = 0; + SEXP fontdb = PROTECT(getFontDB(fontdbname)); + SEXP fontnames; + PROTECT(fontnames = getAttrib(fontdb, R_NamesSymbol)); + nfonts = LENGTH(fontdb); + for (i=0; i<nfonts && !found; i++) { + const char *fontFamily = CHAR(STRING_ELT(fontnames, i)); + if (strcmp(family, fontFamily) == 0) { + found = 1; + result = VECTOR_ELT(fontdb, i); + } + } + if (!found) + warning(_("font family '%s' not found in PostScript font database"), + family); + UNPROTECT(2); + return result; +} + +/* + * Get the path to the afm file for a user-specifed font + * given a graphics engine font family and the face + * index (0..4) + * + * Do this by looking up the font name in the PostScript + * font database + */ +static const char* +fontMetricsFileName(const char *family, int faceIndex, + const char *fontdbname) +{ + int i, nfonts; + const char *result = NULL; + int found = 0; + SEXP fontdb = PROTECT(getFontDB(fontdbname)); + SEXP fontnames; + PROTECT(fontnames = getAttrib(fontdb, R_NamesSymbol)); + nfonts = LENGTH(fontdb); + for (i = 0; i < nfonts && !found; i++) { + const char *fontFamily = CHAR(STRING_ELT(fontnames, i)); + if (strcmp(family, fontFamily) == 0) { + found = 1; + /* 1 means vector of font afm file paths */ + result = CHAR(STRING_ELT(VECTOR_ELT(VECTOR_ELT(fontdb, i), 1), + faceIndex)); + } + } + if (!found) + warning(_("font family '%s' not found in PostScript font database"), + family); + UNPROTECT(2); + return result; +} + +static const char *getFontType(const char *family, const char *fontdbname) +{ + return CHAR(STRING_ELT(getAttrib(getFont(family, fontdbname), + R_ClassSymbol), 0)); +} + +static Rboolean isType1Font(const char *family, const char *fontdbname, + type1fontfamily defaultFont) +{ + /* + * If family is "" then we're referring to the default device + * font, so the test is just whether the default font is + * type1 + * + * If loading font, send NULL for defaultFont + */ + if (strlen(family) == 0) { + if (defaultFont) + return TRUE; + else + return FALSE; + } else + return !strcmp(getFontType(family, fontdbname), + "Type1Font"); +} + +static Rboolean isCIDFont(const char *family, const char *fontdbname, + cidfontfamily defaultCIDFont) { + /* + * If family is "" then we're referring to the default device + * font, so the test is just whether the default font is + * type1 + * + * If loading font, send NULL for defaultCIDFont + */ + if (strlen(family) == 0) { + if (defaultCIDFont) + return TRUE; + else + return FALSE; + } else + return !strcmp(getFontType(family, fontdbname), + "CIDFont"); +} + +/* + * Get encoding name from font database + */ +static const char *getFontEncoding(const char *family, const char *fontdbname) +{ + SEXP fontnames; + int i, nfonts; + const char *result = NULL; + int found = 0; + SEXP fontdb = PROTECT(getFontDB(fontdbname)); + PROTECT(fontnames = getAttrib(fontdb, R_NamesSymbol)); + nfonts = LENGTH(fontdb); + for (i=0; i<nfonts && !found; i++) { + const char *fontFamily = CHAR(STRING_ELT(fontnames, i)); + if (strcmp(family, fontFamily) == 0) { + found = 1; + /* 2 means 'encoding' element */ + result = CHAR(STRING_ELT(VECTOR_ELT(VECTOR_ELT(fontdb, i), 2), 0)); + } + } + if (!found) + warning(_("font encoding for family '%s' not found in font database"), + family); + UNPROTECT(2); + return result; +} + +/* + * Get Font name from font database + */ +static const char *getFontName(const char *family, const char *fontdbname) +{ + SEXP fontnames; + int i, nfonts; + const char *result = NULL; + int found = 0; + SEXP fontdb = PROTECT(getFontDB(fontdbname)); + PROTECT(fontnames = getAttrib(fontdb, R_NamesSymbol)); + nfonts = LENGTH(fontdb); + for (i=0; i<nfonts && !found; i++) { + const char *fontFamily = CHAR(STRING_ELT(fontnames, i)); + if (strcmp(family, fontFamily) == 0) { + found = 1; + /* 0 means 'family' element */ + result = CHAR(STRING_ELT(VECTOR_ELT(VECTOR_ELT(fontdb, i), 0), 0)); + } + } + if (!found) + warning(_("font CMap for family '%s' not found in font database"), + family); + UNPROTECT(2); + return result; +} + +/* + * Get CMap name from font database + */ +static const char *getFontCMap(const char *family, const char *fontdbname) +{ + SEXP fontnames; + int i, nfonts; + const char *result = NULL; + int found = 0; + SEXP fontdb = PROTECT(getFontDB(fontdbname)); + PROTECT(fontnames = getAttrib(fontdb, R_NamesSymbol)); + nfonts = LENGTH(fontdb); + for (i=0; i<nfonts && !found; i++) { + const char *fontFamily = CHAR(STRING_ELT(fontnames, i)); + if (strcmp(family, fontFamily) == 0) { + found = 1; + /* 2 means 'cmap' element */ + result = CHAR(STRING_ELT(VECTOR_ELT(VECTOR_ELT(fontdb, i), 2), 0)); + } + } + if (!found) + warning(_("font CMap for family '%s' not found in font database"), + family); + UNPROTECT(2); + return result; +} + +/* + * Get Encoding name from CID font in font database + */ +static const char * +getCIDFontEncoding(const char *family, const char *fontdbname) +{ + SEXP fontnames; + int i, nfonts; + const char *result = NULL; + int found = 0; + SEXP fontdb = PROTECT(getFontDB(fontdbname)); + PROTECT(fontnames = getAttrib(fontdb, R_NamesSymbol)); + nfonts = LENGTH(fontdb); + for (i=0; i<nfonts && !found; i++) { + const char *fontFamily = CHAR(STRING_ELT(fontnames, i)); + if (strcmp(family, fontFamily) == 0) { + found = 1; + /* 3 means 'encoding' element */ + result = CHAR(STRING_ELT(VECTOR_ELT(VECTOR_ELT(fontdb, i), 3), 0)); + } + } + if (!found) + warning(_("font encoding for family '%s' not found in font database"), + family); + UNPROTECT(2); + return result; +} + +/* + * Get Encoding name from CID font in font database + */ +static const char *getCIDFontPDFResource(const char *family) +{ + SEXP fontnames; + int i, nfonts; + const char *result = NULL; + int found = 0; + SEXP fontdb = PROTECT(getFontDB(PDFFonts)); + PROTECT(fontnames = getAttrib(fontdb, R_NamesSymbol)); + nfonts = LENGTH(fontdb); + for (i=0; i<nfonts && !found; i++) { + const char *fontFamily = CHAR(STRING_ELT(fontnames, i)); + if (strcmp(family, fontFamily) == 0) { + found = 1; + /* 4 means 'pdfresource' element */ + result = CHAR(STRING_ELT(VECTOR_ELT(VECTOR_ELT(fontdb, i), 4), 0)); + } + } + if (!found) + warning(_("font encoding for family '%s' not found in font database"), + family); + UNPROTECT(2); + return result; +} + +/* + * Add a graphics engine font family/encoding to the list of loaded fonts ... + * + * ... and return the new font + */ +static cidfontfamily addLoadedCIDFont(cidfontfamily font, Rboolean isPDF) +{ + cidfontlist newfont = makeCIDFontList(); + if (!newfont) { + freeCIDFontFamily(font); + font = NULL; + } else { + cidfontlist fontlist; + if (isPDF) + fontlist = PDFloadedCIDFonts; + else + fontlist = loadedCIDFonts; + newfont->cidfamily = font; + if (!fontlist) { + if (isPDF) + PDFloadedCIDFonts = newfont; + else + loadedCIDFonts = newfont; + } else { + while (fontlist->next) + fontlist = fontlist->next; + fontlist->next = newfont; + } + } + return font; +} +static type1fontfamily addLoadedFont(type1fontfamily font, + Rboolean isPDF) +{ + type1fontlist newfont = makeFontList(); + if (!newfont) { + freeFontFamily(font); + font = NULL; + } else { + type1fontlist fontlist; + if (isPDF) + fontlist = PDFloadedFonts; + else + fontlist = loadedFonts; + newfont->family = font; + if (!fontlist) { + if (isPDF) + PDFloadedFonts = newfont; + else + loadedFonts = newfont; + } else { + while (fontlist->next) + fontlist = fontlist->next; + fontlist->next = newfont; + } + } + return font; +} + +/* + * Add a font from a graphics engine font family name + */ +static cidfontfamily addCIDFont(const char *name, Rboolean isPDF) +{ + cidfontfamily fontfamily = makeCIDFontFamily(); + char *fontdbname; + if (isPDF) + fontdbname = PDFFonts; + else + fontdbname = PostScriptFonts; + if (fontfamily) { + int i; + const char *cmap = getFontCMap(name, fontdbname); + if (!cmap) { + freeCIDFontFamily(fontfamily); + fontfamily = NULL; + } else { + /* + * Set the name of the font + */ + safestrcpy(fontfamily->fxname, name, 50); + /* + * Get the font CMap + */ + safestrcpy(fontfamily->cmap, cmap, 50); + /* + * Get the font Encoding (name) + * + * If we have got here then we know there is a + * match in the font database because we already + * have the CMap => don't need to check for failure + */ + safestrcpy(fontfamily->encoding, + getCIDFontEncoding(name, fontdbname), 50); + /* + * Load font info + */ + for(i = 0; i < 4; i++) { + fontfamily->cidfonts[i] = makeCIDFont(); + /* + * Use name from R object font database. + */ + safestrcpy(fontfamily->cidfonts[i]->name, + getFontName(name, fontdbname), 50); + } + /* + * Load the (Type 1!) symbol font + * + * Gratuitous loop of length 1 so "break" jumps to end of loop + */ + for (i = 0; i < 1; i++) { + type1fontinfo font = makeType1Font(); + const char *afmpath = fontMetricsFileName(name, 4, fontdbname); + if (!font) { + freeCIDFontFamily(fontfamily); + fontfamily = NULL; + break; + } + if (!afmpath) { + freeCIDFontFamily(fontfamily); + fontfamily = NULL; + freeType1Font(font); + break; + } + fontfamily->symfont = font; + if (!PostScriptLoadFontMetrics(afmpath, + &(fontfamily->symfont->metrics), + fontfamily->symfont->name, + fontfamily->symfont->charnames, + /* + * Reencode all but + * symbol face + */ + NULL, 0)) { + warning(_("cannot load afm file '%s'"), afmpath); + freeCIDFontFamily(fontfamily); + fontfamily = NULL; + break; + } + } + /* + * Add font + */ + if (fontfamily) + fontfamily = addLoadedCIDFont(fontfamily, isPDF); + } + } else + fontfamily = NULL; +#ifdef DEBUG_PS + Rprintf("%d fontfamily = %s\n", __LINE__, (fontfamily) ? "set" : "null"); + Rprintf("%d addCIDFont = %s\n", __LINE__, fontfamily->fxname); +#endif + return fontfamily; +} + +static type1fontfamily addFont(const char *name, Rboolean isPDF, + encodinglist deviceEncodings) +{ + type1fontfamily fontfamily = makeFontFamily(); + char *fontdbname; + if (isPDF) + fontdbname = PDFFonts; + else + fontdbname = PostScriptFonts; + if (fontfamily) { + int i; + encodinginfo encoding; + const char *encpath = getFontEncoding(name, fontdbname); + if (!encpath) { + freeFontFamily(fontfamily); + fontfamily = NULL; + } else { + /* + * Set the name of the font + */ + safestrcpy(fontfamily->fxname, name, 50); + /* + * Find or add encoding + */ + if (!(encoding = findEncoding(encpath, deviceEncodings, isPDF))) + encoding = addEncoding(encpath, isPDF); + if (!encoding) { + freeFontFamily(fontfamily); + fontfamily = NULL; + } else { + /* + * Load font info + */ + fontfamily->encoding = encoding; + for(i = 0; i < 5 ; i++) { + type1fontinfo font = makeType1Font(); + const char *afmpath = fontMetricsFileName(name, i, fontdbname); + if (!font) { + freeFontFamily(fontfamily); + fontfamily = NULL; + break; + } + if (!afmpath) { + freeFontFamily(fontfamily); + fontfamily = NULL; + freeType1Font(font); + break; + } + fontfamily->fonts[i] = font; + if (!PostScriptLoadFontMetrics(afmpath, + &(fontfamily->fonts[i]->metrics), + fontfamily->fonts[i]->name, + fontfamily->fonts[i]->charnames, + /* + * Reencode all but + * symbol face + */ + encoding->encnames, + (i < 4)?1:0)) { + warning(_("cannot load afm file '%s'"), afmpath); + freeFontFamily(fontfamily); + fontfamily = NULL; + break; + } + } + /* + * Add font + */ + if (fontfamily) + fontfamily = addLoadedFont(fontfamily, isPDF); + } + } + } else + fontfamily = NULL; + return fontfamily; +} + +/* + * Add a default font family/encoding to the list of loaded fonts ... + * + * ... using a set of AFM paths ... + * + * ... and return the new font + */ + +static type1fontfamily +addDefaultFontFromAFMs(const char *encpath, const char **afmpaths, + Rboolean isPDF, + encodinglist deviceEncodings) +{ + encodinginfo encoding; + type1fontfamily fontfamily = makeFontFamily(); + if (fontfamily) { + int i; + if (!(encoding = findEncoding(encpath, deviceEncodings, isPDF))) + encoding = addEncoding(encpath, isPDF); + if (!encoding) { + freeFontFamily(fontfamily); + fontfamily = NULL; + } else { + /* + * This is the device default font, so set the + * graphics engine font family name to "" + */ + fontfamily->fxname[0] ='\0'; + /* + * Load font info + */ + fontfamily->encoding = encoding; + for(i = 0; i < 5 ; i++) { + type1fontinfo font = makeType1Font(); + if (!font) { + freeFontFamily(fontfamily); + fontfamily = NULL; + break; + } + fontfamily->fonts[i] = font; + if (!PostScriptLoadFontMetrics(afmpaths[i], + &(fontfamily->fonts[i]->metrics), + fontfamily->fonts[i]->name, + fontfamily->fonts[i]->charnames, + /* + * Reencode all but + * symbol face + */ + encoding->encnames, + (i < 4)?1:0)) { + warning(_("cannot load afm file '%s'"), afmpaths[i]); + freeFontFamily(fontfamily); + fontfamily = NULL; + break; + } + } + /* + * Add font + */ + if (fontfamily) + fontfamily = addLoadedFont(fontfamily, isPDF); + } + } else + fontfamily = NULL; + return fontfamily; +} + +/* + * Add a graphics engine font family/encoding to a list of device fonts ... + * + * ... and return the new font list + */ +static cidfontlist addDeviceCIDFont(cidfontfamily font, + cidfontlist devFonts, + int *index) +{ + cidfontlist newfont = makeCIDFontList(); + *index = 0; + if (!newfont) { + devFonts = NULL; + } else { + cidfontlist fontlist = devFonts; + newfont->cidfamily = font; + *index = 1; + if (!devFonts) { + devFonts = newfont; + } else { + while (fontlist->next) { + fontlist = fontlist->next; + *index = *index + 1; + } + fontlist->next = newfont; + } + } + return devFonts; +} +static type1fontlist addDeviceFont(type1fontfamily font, + type1fontlist devFonts, + int *index) +{ + type1fontlist newfont = makeFontList(); + *index = 0; + if (!newfont) { + devFonts = NULL; + } else { + type1fontlist fontlist = devFonts; + newfont->family = font; + *index = 1; + if (!devFonts) { + devFonts = newfont; + } else { + while (fontlist->next) { + fontlist = fontlist->next; + *index = *index + 1; + } + fontlist->next = newfont; + } + } + return devFonts; +} + +/* +*********************************************************** +*/ + +/* Part 2. Device Driver State. */ + +typedef struct { + char filename[PATH_MAX]; + int open_type; + + char papername[64]; /* paper name */ + int paperwidth; /* paper width in big points (1/72 in) */ + int paperheight; /* paper height in big points */ + Rboolean landscape; /* landscape mode */ + int pageno; /* page number */ + int fileno; /* file number */ + + int maxpointsize; + + double width; /* plot width in inches */ + double height; /* plot height in inches */ + double pagewidth; /* page width in inches */ + double pageheight; /* page height in inches */ + Rboolean pagecentre;/* centre image on page? */ + Rboolean printit; /* print page at close? */ + char command[2*PATH_MAX]; + char title[1024]; + char colormodel[30]; + + FILE *psfp; /* output file */ + + Rboolean onefile; /* EPSF header etc*/ + Rboolean paperspecial; /* suppress %%Orientation */ + Rboolean warn_trans; /* have we warned about translucent cols? */ + Rboolean useKern; + Rboolean fillOddEven; /* polygon fill mode */ + + /* This group of variables track the current device status. + * They should only be set by routines that emit PostScript code. */ + struct { + double lwd; /* line width */ + int lty; /* line type */ + R_GE_lineend lend; + R_GE_linejoin ljoin; + double lmitre; + int font; + int cidfont; + int fontsize; /* font size in points */ + rcolor col; /* color */ + rcolor fill; /* fill color */ + } current; + + /* + * Fonts and encodings used on the device + */ + type1fontlist fonts; + cidfontlist cidfonts; + encodinglist encodings; + /* + * These next two just record the default device font + */ + type1fontfamily defaultFont; + cidfontfamily defaultCIDFont; +} +PostScriptDesc; + +/* Part 3. Graphics Support Code. */ + +static void specialCaseCM(FILE *fp, type1fontfamily family, int familynum) +{ + fprintf(fp, "%% begin encoding\n"); + fprintf(fp, "/SymbolEncoding [\n"); + fprintf(fp, " /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef\n"); + fprintf(fp, " /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef\n"); + fprintf(fp, " /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef\n"); + fprintf(fp, " /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef\n"); + fprintf(fp, " /space /exclam /universal /numbersign /existential /percent /ampersand /suchthat\n"); + fprintf(fp, " /parenleft /parenright /asteriskmath /plus /comma /minus /period /slash\n"); + fprintf(fp, " /zero /one /two /three /four /five /six /seven\n"); + fprintf(fp, " /eight /nine /colon /semicolon /less /equal /greater /question\n"); + fprintf(fp, " /congruent /Alpha /Beta /Chi /Delta /Epsilon /Phi /Gamma\n"); + fprintf(fp, " /Eta /Iota /theta1 /Kappa /Lambda /Mu /Nu /Omicron\n"); + fprintf(fp, " /Pi /Theta /Rho /Sigma /Tau /Upsilon /sigma1 /Omega\n"); + fprintf(fp, " /Xi /Psi /Zeta /bracketleft /therefore /bracketright /perpendicular /underscore\n"); + fprintf(fp, " /radicalex /alpha /beta /chi /delta /epsilon /phi /gamma\n"); + fprintf(fp, " /eta /iota /phi1 /kappa /lambda /mu /nu /omicron\n"); + fprintf(fp, " /pi /theta /rho /sigma /tau /upsilon /omega1 /omega\n"); + fprintf(fp, " /xi /psi /zeta /braceleft /bar /braceright /similar /.notdef\n"); + fprintf(fp, " /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef\n"); + fprintf(fp, " /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef\n"); + fprintf(fp, " /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef\n"); + fprintf(fp, " /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef\n"); + fprintf(fp, " /Euro /Upsilon1 /minute /lessequal /fraction /infinity /florin /club\n"); + fprintf(fp, " /diamond /heart /spade /arrowboth /arrowleft /arrowup /arrowright /arrowdown\n"); + fprintf(fp, " /degree /plusminus /second /greaterequal /multiply /proportional /partialdiff /bullet\n"); + fprintf(fp, " /divide /notequal /equivalence /approxequal /ellipsis /arrowvertex /arrowhorizex /carriagereturn\n"); + fprintf(fp, " /aleph /Ifraktur /Rfraktur /weierstrass /circlemultiply /circleplus /emptyset /intersection\n"); + fprintf(fp, " /union /propersuperset /reflexsuperset /notsubset /propersubset /reflexsubset /element /notelement\n"); + fprintf(fp, " /angle /gradient /registerserif /copyrightserif /trademarkserif /product /radical /dotmath\n"); + fprintf(fp, " /logicalnot /logicaland /logicalor /arrowdblboth /arrowdblleft /arrowdblup /arrowdblright /arrowdbldown\n"); + fprintf(fp, " /lozenge /angleleft /registersans /copyrightsans /trademarksans /summation /parenlefttp /parenleftex\n"); + fprintf(fp, " /parenleftbt /bracketlefttp /bracketleftex /bracketleftbt /bracelefttp /braceleftmid /braceleftbt /braceex\n"); + fprintf(fp, " /.notdef /angleright /integral /integraltp /integralex /integralbt /parenrighttp /parenrightex\n"); + fprintf(fp, " /parenrightbt /bracketrighttp /bracketrightex /bracketrightbt /bracerighttp /bracerightmid /bracerightbt /.notdef\n"); + fprintf(fp, "] def\n"); + fprintf(fp, "%% end encoding\n"); + fprintf(fp, "/mergefonts\n"); + fprintf(fp, "{ /targetencoding exch def\n"); + fprintf(fp, " /fontarray exch def\n"); + fprintf(fp, " fontarray 0 get dup maxlength dict begin\n"); + fprintf(fp, " { 1 index /FID ne { def } { pop pop } ifelse } forall\n"); + fprintf(fp, " %% Create a new dictionary\n"); + fprintf(fp, " /CharStrings 256 dict def\n"); + fprintf(fp, " %% Add a definition of .notdef\n"); + fprintf(fp, " fontarray\n"); + fprintf(fp, " { /CharStrings get dup /.notdef known\n"); + fprintf(fp, " { /.notdef get /result exch def exit }\n"); + fprintf(fp, " { pop } ifelse\n"); + fprintf(fp, " } forall\n"); + fprintf(fp, " CharStrings /.notdef result put\n"); + fprintf(fp, " %% Add in the other definitions\n"); + fprintf(fp, " targetencoding\n"); + fprintf(fp, " { /code exch def\n"); + fprintf(fp, " %% Check that it is not a .notdef\n"); + fprintf(fp, " code /.notdef eq\n"); + fprintf(fp, " { /.notdef }\n"); + fprintf(fp, " { fontarray\n"); + fprintf(fp, " { /CharStrings get dup code known\n"); + fprintf(fp, " { code get /result exch def /found true def exit }\n"); + fprintf(fp, " { pop /found false def } ifelse\n"); + fprintf(fp, " } forall\n"); + fprintf(fp, " %% define character if it was found and accumulate encoding\n"); + fprintf(fp, " found { CharStrings code result put code } { /.notdef } ifelse\n"); + fprintf(fp, " } ifelse\n"); + fprintf(fp, " } forall\n"); + fprintf(fp, " %% grab new encoding off of stack\n"); + fprintf(fp, " 256 array astore /Encoding exch def\n"); + fprintf(fp, " %% Undefine some local variables\n"); + fprintf(fp, " currentdict /fontarray undef\n"); + fprintf(fp, " currentdict /targetencoding undef\n"); + fprintf(fp, " currentdict /code undef\n"); + fprintf(fp, " currentdict /result undef\n"); + fprintf(fp, " currentdict /found undef\n"); + fprintf(fp, " %% Leave new font on the stack\n"); + fprintf(fp, " currentdict\n"); + fprintf(fp, " end\n"); + fprintf(fp, "} def\n"); + fprintf(fp, "%%%%IncludeResource: font %s\n", + family->fonts[0]->name); + fprintf(fp, "%%%%IncludeResource: font CMSY10\n"); + fprintf(fp, "[ /%s findfont /CMSY10 findfont ] %s mergefonts\n", + family->fonts[0]->name, family->encoding->name); + fprintf(fp, "/Font%d exch definefont pop\n", + (familynum - 1)*5 + 1); + fprintf(fp, "%%%%IncludeResource: font %s\n", + family->fonts[1]->name); + fprintf(fp, "%%%%IncludeResource: font CMBSY10\n"); + fprintf(fp, "[ /%s findfont /CMBSY10 findfont ] %s mergefonts\n", + family->fonts[1]->name, family->encoding->name); + fprintf(fp, "/Font%d exch definefont pop\n", + (familynum - 1)*5 + 2); + fprintf(fp, "%%%%IncludeResource: font %s\n", + family->fonts[2]->name); + fprintf(fp, "[ /%s findfont /CMSY10 findfont ] %s mergefonts\n", + family->fonts[2]->name, family->encoding->name); + fprintf(fp, "/Font%d exch definefont pop\n", + (familynum - 1)*5 + 3); + fprintf(fp, "%%%%IncludeResource: font %s\n", + family->fonts[3]->name); + fprintf(fp, "[ /%s findfont /CMBSY10 findfont ] %s mergefonts\n", + family->fonts[3]->name, family->encoding->name); + fprintf(fp, "/Font%d exch definefont pop\n", + (familynum - 1)*5 + 4); + fprintf(fp, "%%%%IncludeResource: font CMMI10\n"); + fprintf(fp, "[ /CMR10 findfont /CMSY10 findfont /CMMI10 findfont ] SymbolEncoding mergefonts\n"); + fprintf(fp, "/Font%d exch definefont pop\n", + (familynum - 1)*5 + 5); +} + +static void PSEncodeFonts(FILE *fp, PostScriptDesc *pd) +{ + type1fontlist fonts = pd->fonts; + int familynum = 1; + int haveWrittenDefaultEnc = 0; + cidfontlist cidfonts = pd->cidfonts; + int cidfamilynum = 1; + + while (fonts) { + int dontcare; + /* + * Has the encoding already been used on the device? + */ + encodinginfo encoding = + findDeviceEncoding(fonts->family->encoding->encpath, + pd->encodings, &dontcare); + /* + * If we've added the encoding to the device then it has been + * written to file ... + * + * ... UNLESS this is the default encoding for the device, in + * which case it has been added, but not written to file. + * + * Use haveWrittenDefaultEnc to make sure we only do it once. + */ + if (!encoding || + (encoding == pd->encodings->encoding && !haveWrittenDefaultEnc)) { + /* + * Don't need to add default encoding again. + */ + if (encoding != pd->encodings->encoding) { + /* + * The encoding should have been loaded when the + * font was loaded + */ + encoding = findEncoding(fonts->family->encoding->encpath, + pd->encodings, FALSE); + if (!encoding) + warning(_("corrupt loaded encodings; encoding not recorded")); + else { + /* + * Record encoding on device's list of encodings so + * don't write same encoding more than once + */ + encodinglist enclist = addDeviceEncoding(encoding, + pd->encodings); + if (enclist) + pd->encodings = enclist; + else + warning(_("failed to record device encoding")); + } + } else { + /* + * Make sure we only write default encoding once. + */ + haveWrittenDefaultEnc = 1; + } + /* + * Include encoding unless it is ISOLatin1Encoding, + * which is predefined + */ + if (strcmp(fonts->family->encoding->name, "ISOLatin1Encoding")) + fprintf(fp, "%% begin encoding\n%s def\n%% end encoding\n", + fonts->family->encoding->enccode); + } + if(strcmp(fonts->family->fonts[4]->name, + "CMSY10 CMBSY10 CMMI10") == 0) { + /* use different ps fragment for CM fonts */ + specialCaseCM(fp, fonts->family, familynum); + } else { + int i; + for (i = 0; i < 4 ; i++) { + fprintf(fp, "%%%%IncludeResource: font %s\n", + fonts->family->fonts[i]->name); + fprintf(fp, "/%s findfont\n", + fonts->family->fonts[i]->name); + fprintf(fp, "dup length dict begin\n"); + fprintf(fp, " {1 index /FID ne {def} {pop pop} ifelse} forall\n"); + fprintf(fp, " /Encoding %s def\n", + fonts->family->encoding->name); + fprintf(fp, " currentdict\n"); + fprintf(fp, " end\n"); + fprintf(fp, "/Font%d exch definefont pop\n", + (familynum - 1)*5 + i + 1); + } + fprintf(fp, "%%%%IncludeResource: font %s\n", + fonts->family->fonts[4]->name); + fprintf(fp, "/%s findfont\n", + fonts->family->fonts[4]->name); + fprintf(fp, "dup length dict begin\n"); + fprintf(fp, " {1 index /FID ne {def} {pop pop} ifelse} forall\n"); + fprintf(fp, " currentdict\n"); + fprintf(fp, " end\n"); + fprintf(fp, "/Font%d exch definefont pop\n", + (familynum - 1)*5 + 5); + } + + familynum++; + fonts = fonts->next; + } + while(cidfonts) { + int i; + char *name = cidfonts->cidfamily->cidfonts[0]->name; + fprintf(fp, "%%%%IncludeResource: CID fake Bold font %s\n", name); + fprintf(fp, "/%s-Bold\n/%s /CIDFont findresource\n", name, name); + fprintf(fp, "%s", CIDBoldFontStr1); + fprintf(fp, "%s", CIDBoldFontStr2); + for (i = 0; i < 4 ; i++) { + char *fmt = NULL /* -Wall */; + fprintf(fp, "%%%%IncludeResource: CID font %s-%s\n", name, + cidfonts->cidfamily->cmap); + switch(i) { + case 0: fmt = "/%s-%s findfont\n"; + break; + case 1: fmt = "/%s-Bold-%s findfont\n"; + break; + case 2: fmt = "/%s-%s findfont [1 0 .3 1 0 0] makefont\n"; + break; + case 3: fmt = "/%s-Bold-%s findfont [1 0 .3 1 0 0] makefont\n"; + break; + default: + break; + } + fprintf(fp, fmt, name, cidfonts->cidfamily->cmap); + fprintf(fp, "dup length dict begin\n"); + fprintf(fp, " {1 index /FID ne {def} {pop pop} ifelse} forall\n"); + fprintf(fp, " currentdict\n"); + fprintf(fp, " end\n"); + fprintf(fp, "/Font%d exch definefont pop\n", + (familynum - 1)*5 + (cidfamilynum - 1)*5 + i + 1); + } + /* + * Symbol font + */ + fprintf(fp, "%%%%IncludeResource: font %s\n", + cidfonts->cidfamily->symfont->name); + fprintf(fp, "/%s findfont\n", + cidfonts->cidfamily->symfont->name); + fprintf(fp, "dup length dict begin\n"); + fprintf(fp, " {1 index /FID ne {def} {pop pop} ifelse} forall\n"); + fprintf(fp, " currentdict\n"); + fprintf(fp, " end\n"); + fprintf(fp, "/Font%d exch definefont pop\n", + (familynum - 1)*5 + (cidfamilynum - 1)*5 + 5); + cidfamilynum++; + cidfonts = cidfonts->next; + } +} + +/* The variables "paperwidth" and "paperheight" give the dimensions */ +/* of the (unrotated) printer page in points whereas the graphics */ +/* region box is for the rotated page. */ + +static void PSFileHeader(FILE *fp, + const char *papername, double paperwidth, + double paperheight, Rboolean landscape, + int EPSFheader, Rboolean paperspecial, + double left, double bottom, double right, double top, + const char *title, + PostScriptDesc *pd) +{ + int i; + SEXP prolog; + type1fontlist fonts = pd->fonts; + int firstfont = 1; + + if(EPSFheader) + fprintf(fp, "%%!PS-Adobe-3.0 EPSF-3.0\n"); + else + fprintf(fp, "%%!PS-Adobe-3.0\n"); + /* + * DocumentNeededResources names all fonts + */ + while (fonts) { + for (i=0; i<5; i++) + if (firstfont) { + fprintf(fp, "%%%%DocumentNeededResources: font %s\n", + fonts->family->fonts[0]->name); + firstfont = 0; + } else + fprintf(fp, "%%%%+ font %s\n", fonts->family->fonts[i]->name); + fonts = fonts->next; + } + + if(!EPSFheader) + fprintf(fp, "%%%%DocumentMedia: %s %.0f %.0f 0 () ()\n", + papername, paperwidth, paperheight); + fprintf(fp, "%%%%Title: %s\n", title); + fprintf(fp, "%%%%Creator: R Software\n"); + fprintf(fp, "%%%%Pages: (atend)\n"); + if (!EPSFheader && !paperspecial) { /* gs gets confused by this */ + if (landscape) + fprintf(fp, "%%%%Orientation: Landscape\n"); + else + fprintf(fp, "%%%%Orientation: Portrait\n"); + } + fprintf(fp, "%%%%BoundingBox: %.0f %.0f %.0f %.0f\n", + left, bottom, right, top); + fprintf(fp, "%%%%EndComments\n"); + fprintf(fp, "%%%%BeginProlog\n"); + fprintf(fp, "/bp { gs"); + if (streql(pd->colormodel, "srgb")) fprintf(fp, " sRGB"); + if (landscape) + fprintf(fp, " %.2f 0 translate 90 rotate", paperwidth); + fprintf(fp, " gs } def\n"); + prolog = findVar(install(".ps.prolog"), R_GlobalEnv); + if(prolog == R_UnboundValue) { + /* if no object is visible, look in the graphics namespace */ + SEXP graphicsNS = R_FindNamespace(ScalarString(mkChar("grDevices"))); + PROTECT(graphicsNS); + prolog = findVar(install(".ps.prolog"), graphicsNS); + /* under lazy loading this will be a promise on first use */ + if(TYPEOF(prolog) == PROMSXP) { + PROTECT(prolog); + prolog = eval(prolog, graphicsNS); + UNPROTECT(1); + } + UNPROTECT(1); + } + if(!isString(prolog)) + error(_("object '.ps.prolog' is not a character vector")); + fprintf(fp, "%% begin .ps.prolog\n"); + for (i = 0; i < length(prolog); i++) + fprintf(fp, "%s\n", CHAR(STRING_ELT(prolog, i))); + fprintf(fp, "%% end .ps.prolog\n"); + if (streql(pd->colormodel, "srgb+gray") || streql(pd->colormodel, "srgb")) { + SEXP graphicsNS = R_FindNamespace(ScalarString(mkChar("grDevices"))); + PROTECT(graphicsNS); + prolog = findVar(install(".ps.prolog.srgb"), graphicsNS); + /* under lazy loading this will be a promise on first use */ + if(TYPEOF(prolog) == PROMSXP) { + PROTECT(prolog); + prolog = eval(prolog, graphicsNS); + UNPROTECT(1); + } + UNPROTECT(1); + for (i = 0; i < length(prolog); i++) + fprintf(fp, "%s\n", CHAR(STRING_ELT(prolog, i))); + } + if (streql(pd->colormodel, "srgb+gray")) + fprintf(fp, "/srgb { sRGB setcolor } bind def\n"); + else if (streql(pd->colormodel, "srgb")) + fprintf(fp, "/srgb { setcolor } bind def\n"); + PSEncodeFonts(fp, pd); + + fprintf(fp, "%%%%EndProlog\n"); +} + +static void PostScriptFileTrailer(FILE *fp, int pageno) +{ + fprintf(fp, "ep\n"); + fprintf(fp, "%%%%Trailer\n"); + fprintf(fp, "%%%%Pages: %d\n", pageno); + fprintf(fp, "%%%%EOF\n"); +} + +static void PostScriptStartPage(FILE *fp, int pageno) +{ + fprintf(fp, "%%%%Page: %d %d\n", pageno, pageno); + fprintf(fp, "bp\n"); +} + +static void PostScriptEndPage(FILE *fp) +{ + fprintf(fp, "ep\n"); +} + +static void PostScriptSetClipRect(FILE *fp, double x0, double x1, + double y0, double y1) +{ + fprintf(fp, "%.2f %.2f %.2f %.2f cl\n", x0, y0, x1, y1); +} + +static void PostScriptSetLineWidth(FILE *fp, double linewidth) +{ + /* Must not allow line width to be zero */ + if (linewidth < .01) + linewidth = .01; + fprintf(fp, "%.2f setlinewidth\n", linewidth); +} + +static void PostScriptSetLineEnd(FILE *fp, R_GE_lineend lend) +{ + int lineend = 1; /* -Wall */ + switch (lend) { + case GE_ROUND_CAP: + lineend = 1; + break; + case GE_BUTT_CAP: + lineend = 0; + break; + case GE_SQUARE_CAP: + lineend = 2; + break; + default: + error(_("invalid line end")); + } + fprintf(fp, "%1d setlinecap\n", lineend); +} + +static void PostScriptSetLineJoin(FILE *fp, R_GE_linejoin ljoin) +{ + int linejoin = 1; /* -Wall */ + switch (ljoin) { + case GE_ROUND_JOIN: + linejoin = 1; + break; + case GE_MITRE_JOIN: + linejoin = 0; + break; + case GE_BEVEL_JOIN: + linejoin = 2; + break; + default: + error(_("invalid line join")); + } + fprintf(fp, "%1d setlinejoin\n", linejoin); +} + +static void PostScriptSetLineMitre(FILE *fp, double linemitre) +{ + if (linemitre < 1) + error(_("invalid line mitre")); + fprintf(fp, "%.2f setmiterlimit\n", linemitre); +} + +static void PostScriptSetFont(FILE *fp, int fontnum, double size) +{ + fprintf(fp, "/Font%d findfont %.0f s\n", fontnum, size); +} + +static void +PostScriptSetLineTexture(FILE *fp, const char *dashlist, int nlty, + double lwd, int lend) +{ +/* use same macro for Postscript and PDF */ +/* Historically the adjustment was 1 to allow for round end caps. + As from 2.11.0, no adjustment is done for butt endcaps. + The + 1 adjustment on the 'off' segments seems wrong, but it + has been left in for back-compatibility +*/ +#define PP_SetLineTexture(_CMD_, adj) \ + double dash[8], a = adj; \ + int i; \ + Rboolean allzero = TRUE; \ + for (i = 0; i < nlty; i++) { \ + dash[i] = lwd * \ + ((i % 2) ? (dashlist[i] + a) \ + : ((nlty == 1 && dashlist[i] == 1.) ? 1. : dashlist[i] - a) ); \ + if (dash[i] < 0) dash[i] = 0; \ + if (dash[i] > .01) allzero = FALSE; \ + } \ + fprintf(fp,"["); \ + if (!allzero) { \ + for (i = 0; i < nlty; i++) { \ + fprintf(fp," %.2f", dash[i]); \ + } \ + } \ + fprintf(fp,"] 0 %s\n", _CMD_) + + PP_SetLineTexture("setdash", (lend == GE_BUTT_CAP) ? 0. : 1.); +} + + +static void PostScriptMoveTo(FILE *fp, double x, double y) +{ + fprintf(fp, "%.2f %.2f m\n", x, y); +} + +static void PostScriptRLineTo(FILE *fp, double x0, double y0, + double x1, double y1) +{ + double x = fround(x1, 2) - fround(x0, 2), + y = fround(y1, 2) - fround(y0, 2); + /* Warning: some machines seem to compute these differently from + others, and we do want to diff the output. x and y should be + above around 0.01 or negligible (1e-14), and it is the latter case + we are watching out for here. + */ + + if(fabs(x) < 0.005) fprintf(fp, "0"); else fprintf(fp, "%.2f", x); + if(fabs(y) < 0.005) fprintf(fp, " 0"); else fprintf(fp, " %.2f", y); + fprintf(fp, " l\n"); +} + +static void PostScriptStartPath(FILE *fp) +{ + fprintf(fp, "np\n"); +} + +static void PostScriptEndPath(FILE *fp) +{ + fprintf(fp, "o\n"); +} + +static void PostScriptRectangle(FILE *fp, double x0, double y0, + double x1, double y1) +{ + fprintf(fp, "%.2f %.2f %.2f %.2f r ", x0, y0, x1-x0, y1-y0); +} + +static void PostScriptCircle(FILE *fp, double x, double y, double r) +{ + fprintf(fp, "%.2f %.2f %.2f c ", x, y, r); +} + +static void PostScriptWriteString(FILE *fp, const char *str, size_t nb) +{ + size_t i; + + fputc('(', fp); + for (i = 0 ; i < nb && *str; i++, str++) + switch(*str) { + case '\n': + fprintf(fp, "\\n"); + break; + case '\\': + fprintf(fp, "\\\\"); + break; + case '-': +#ifdef USE_HYPHEN + if (!isdigit((int)str[1])) + fputc(PS_hyphen, fp); + else +#endif + fputc(*str, fp); + break; + case '(': + case ')': + fprintf(fp, "\\%c", *str); + break; + default: + fputc(*str, fp); + break; + } + fputc(')', fp); +} + + +static FontMetricInfo *metricInfo(const char *, int, PostScriptDesc *); + +static void PostScriptText(FILE *fp, double x, double y, + const char *str, size_t nb, double xc, double rot, + const pGEcontext gc, + pDevDesc dd) +{ + int face = gc->fontface; + + if(face < 1 || face > 5) face = 1; + + fprintf(fp, "%.2f %.2f ", x, y); + + PostScriptWriteString(fp, str, nb); + + if(xc == 0) fprintf(fp, " 0"); + else if(xc == 0.5) fprintf(fp, " .5"); + else if(xc == 1) fprintf(fp, " 1"); + else fprintf(fp, " %.2f", xc); + + if(rot == 0) fprintf(fp, " 0"); + else if(rot == 90) fprintf(fp, " 90"); + else fprintf(fp, " %.2f", rot); + + fprintf(fp, " t\n"); +} + +static void PostScriptText2(FILE *fp, double x, double y, + const char *str, size_t nb, + Rboolean relative, double rot, + const pGEcontext gc, + pDevDesc dd) +{ + int face = gc->fontface; + + if(face < 1 || face > 5) face = 1; + + if(relative) { + fprintf(fp, "\n%.3f ", x); + PostScriptWriteString(fp, str, nb); + fprintf(fp, " tb"); + } else { + fprintf(fp, "%.2f %.2f ", x, y); + PostScriptWriteString(fp, str, nb); + if(rot == 0) fprintf(fp, " 0"); + else if(rot == 90) fprintf(fp, " 90"); + else fprintf(fp, " %.2f", rot); + fprintf(fp, " ta"); + } +} + +static void PostScriptHexText(FILE *fp, double x, double y, + const char *str, size_t strlen, + double xc, double rot) +{ + unsigned char *p = (unsigned char *)str; + size_t i; + + fprintf(fp, "%.2f %.2f ", x, y); + fprintf(fp, "<"); + for(i = 0; i < strlen; i++) fprintf(fp, "%02x", *p++); + fprintf(fp, ">"); + + if(xc == 0) fprintf(fp, " 0"); + else if(xc == 0.5) fprintf(fp, " .5"); + else if(xc == 1) fprintf(fp, " 1"); + else fprintf(fp, " %.2f", xc); + + if(rot == 0) fprintf(fp, " 0"); + else if(rot == 90) fprintf(fp, " 90"); + else fprintf(fp, " %.2f", rot); + + fprintf(fp, " t\n"); +} + +static void +PostScriptTextKern(FILE *fp, double x, double y, + const char *str, double xc, double rot, + const pGEcontext gc, + pDevDesc dd) +{ + PostScriptDesc *pd = (PostScriptDesc *) dd->deviceSpecific; + int face = gc->fontface; + FontMetricInfo *metrics; + size_t i, n, nout = 0; + int j, w; + unsigned char p1, p2; + double fac = 0.001 * floor(gc->cex * gc->ps + 0.5); + Rboolean relative = FALSE; + Rboolean haveKerning = FALSE; + + if(face < 1 || face > 5) { + warning(_("attempt to use invalid font %d replaced by font 1"), face); + face = 1; + } + /* check if this is T1 -- should be, but be safe*/ + if(!isType1Font(gc->fontfamily, PostScriptFonts, pd->defaultFont)) { + PostScriptText(fp, x, y, str, strlen(str), xc, rot, gc, dd); + return; + } + metrics = metricInfo(gc->fontfamily, face, pd); + + n = strlen(str); + if (n < 1) return; + /* First check for any kerning */ + for(i = 0; i < n-1; i++) { + p1 = str[i]; + p2 = str[i+1]; +#ifdef USE_HYPHEN + if (p1 == '-' && !isdigit((int)p2)) + p1 = (unsigned char)PS_hyphen; +#endif + for (j = metrics->KPstart[p1]; j < metrics->KPend[p1]; j++) + if(metrics->KernPairs[j].c2 == p2 && + metrics->KernPairs[j].c1 == p1) { + haveKerning = TRUE; + break; + } + } + + if(haveKerning) { + /* We have to start at the left edge, as we are going + to do this in pieces */ + if (xc != 0) { + double rot1 = rot * M_PI/180.; + int w = 0; short wx; + for(i = 0; i < n; i++) { + unsigned char p1 = str[i]; + wx = metrics->CharInfo[(int)p1].WX; + w += (wx == NA_SHORT) ? 0 : wx; + } + x -= xc*fac*cos(rot1)*w; + y -= xc*fac*sin(rot1)*w; + } + for(i = 0; i < n-1; i++) { + p1 = str[i]; + p2 = str[i+1]; +#ifdef USE_HYPHEN + if (p1 == '-' && !isdigit((int)p2)) + p1 = (unsigned char)PS_hyphen; +#endif + for (j = metrics->KPstart[p1]; j < metrics->KPend[p1]; j++) + if(metrics->KernPairs[j].c2 == p2 && + metrics->KernPairs[j].c1 == p1) { + PostScriptText2(fp, x, y, str+nout, i+1-nout, + relative, rot, gc, dd); + nout = i+1; + w = metrics->KernPairs[j].kern; + x = fac*w; y = 0; + relative = TRUE; + break; + } + } + PostScriptText2(fp, x, y, str+nout, n-nout, relative, rot, gc, dd); + fprintf(fp, " gr\n"); + } else + PostScriptText(fp, x, y, str, strlen(str), xc, rot, gc, dd); +} + +/* Device Driver Actions */ + +static void PS_Circle(double x, double y, double r, + const pGEcontext gc, + pDevDesc dd); +static void PS_Clip(double x0, double x1, double y0, double y1, + pDevDesc dd); +static void PS_Close(pDevDesc dd); +static void PS_Line(double x1, double y1, double x2, double y2, + const pGEcontext gc, + pDevDesc dd); +static void PS_MetricInfo(int c, + const pGEcontext gc, + double* ascent, double* descent, + double* width, pDevDesc dd); +static void PS_NewPage(const pGEcontext gc, + pDevDesc dd); +static Rboolean PS_Open(pDevDesc, PostScriptDesc*); +static void PS_Polygon(int n, double *x, double *y, + const pGEcontext gc, + pDevDesc dd); +static void PS_Polyline(int n, double *x, double *y, + const pGEcontext gc, + pDevDesc dd); +static void PS_Rect(double x0, double y0, double x1, double y1, + const pGEcontext gc, + pDevDesc dd); +static void PS_Path(double *x, double *y, + int npoly, int *nper, + Rboolean winding, + const pGEcontext gc, + pDevDesc dd); +static void PS_Raster(unsigned int *raster, int w, int h, + double x, double y, double width, double height, + double rot, Rboolean interpolate, + const pGEcontext gc, pDevDesc dd); +static void PS_Size(double *left, double *right, + double *bottom, double *top, + pDevDesc dd); +static double PS_StrWidth(const char *str, + const pGEcontext gc, + pDevDesc dd); +static void PS_Text(double x, double y, const char *str, + double rot, double hadj, + const pGEcontext gc, + pDevDesc dd); +static double PS_StrWidthUTF8(const char *str, + const pGEcontext gc, + pDevDesc dd); +static void PS_TextUTF8(double x, double y, const char *str, + double rot, double hadj, + const pGEcontext gc, + pDevDesc dd); + +/* PostScript Support (formerly in PostScript.c) */ + +static void PostScriptSetCol(FILE *fp, double r, double g, double b, + PostScriptDesc *pd) +{ + const char *mm = pd->colormodel; + if(r == g && g == b && + !(streql(mm, "cmyk") || streql(mm, "srgb") + || streql(mm, "rgb-nogray")) ) { /* grey */ + if(r == 0) fprintf(fp, "0"); + else if (r == 1) fprintf(fp, "1"); + else fprintf(fp, "%.4f", r); + fprintf(fp," setgray"); + } else { + if(strcmp(mm, "gray") == 0) { + fprintf(fp, "%.4f setgray", 0.213*r + 0.715*g + 0.072*b); + // error(_("only gray colors are allowed in this color model")); + } else if(strcmp(mm, "cmyk") == 0) { + double c = 1.0-r, m=1.0-g, y=1.0-b, k=c; + k = fmin2(k, m); + k = fmin2(k, y); + if(k == 1.0) c = m = y = 0.0; + else { c = (c-k)/(1-k); m = (m-k)/(1-k); y = (y-k)/(1-k); } + /* else {c /= (1.-k); m /= (1.-k); y /= (1.-k);} */ + if(c == 0) fprintf(fp, "0"); + else if (c == 1) fprintf(fp, "1"); + else fprintf(fp, "%.4f", c); + if(m == 0) fprintf(fp, " 0"); + else if (m == 1) fprintf(fp, " 1"); + else fprintf(fp, " %.4f", m); + if(y == 0) fprintf(fp, " 0"); + else if (y == 1) fprintf(fp, " 1"); + else fprintf(fp, " %.4f", y); + if(k == 0) fprintf(fp, " 0"); + else if (k == 1) fprintf(fp, " 1"); + else fprintf(fp, " %.4f", k); + fprintf(fp," setcmykcolor\n"); + } else { + if(r == 0) fprintf(fp, "0"); + else if (r == 1) fprintf(fp, "1"); + else fprintf(fp, "%.4f", r); + if(g == 0) fprintf(fp, " 0"); + else if (g == 1) fprintf(fp, " 1"); + else fprintf(fp, " %.4f", g); + if(b == 0) fprintf(fp, " 0"); + else if (b == 1) fprintf(fp, " 1"); + else fprintf(fp, " %.4f", b); + if (streql(mm, "srgb+gray") || streql(mm, "srgb")) + fprintf(fp," srgb"); + else fprintf(fp," rgb"); + } + } +} + +static void PostScriptSetFill(FILE *fp, double r, double g, double b, + PostScriptDesc *pd) +{ + fprintf(fp,"/bg { "); + PostScriptSetCol(fp, r, g, b, pd); + fprintf(fp, " } def\n"); +} + + + +/* Driver Support Routines */ + +static void SetColor(int, pDevDesc); +static void SetFill(int, pDevDesc); +static void SetFont(int, int, pDevDesc); +static void SetLineStyle(const pGEcontext, pDevDesc dd); +static void Invalidate(pDevDesc); + +static void PS_cleanup(int stage, pDevDesc dd, PostScriptDesc *pd); + + +Rboolean +PSDeviceDriver(pDevDesc dd, const char *file, const char *paper, + const char *family, const char **afmpaths, const char *encoding, + const char *bg, const char *fg, double width, double height, + Rboolean horizontal, double ps, + Rboolean onefile, Rboolean pagecentre, Rboolean printit, + const char *cmd, const char *title, SEXP fonts, + const char *colormodel, int useKern, Rboolean fillOddEven) +{ + /* If we need to bail out with some sort of "error" + then we must free(dd) */ + + double xoff, yoff, pointsize; + rcolor setbg, setfg; + encodinginfo enc; + encodinglist enclist; + type1fontfamily font; + cidfontfamily cidfont = NULL; + int gotFont; + + PostScriptDesc *pd; + + /* Check and extract the device parameters */ + + if(strlen(file) > PATH_MAX - 1) { + free(dd); + error(_("filename too long in %s()"), "postscript"); + } + + /* allocate new postscript device description */ + if (!(pd = (PostScriptDesc *) malloc(sizeof(PostScriptDesc)))) { + free(dd); + error(_("memory allocation problem in %s()"), "postscript"); + } + + /* from here on, if need to bail out with "error", must also */ + /* free(pd) */ + + /* initialise postscript device description */ + strcpy(pd->filename, file); + strcpy(pd->papername, paper); + strncpy(pd->title, title, 1024); + if (streql(colormodel, "grey")) strcpy(pd->colormodel, "grey"); + else strncpy(pd->colormodel, colormodel, 30); + pd->useKern = (useKern != 0); + pd->fillOddEven = fillOddEven; + + if(strlen(encoding) > PATH_MAX - 1) { + PS_cleanup(1, dd, pd); + error(_("encoding path is too long in %s()"), "postscript"); + } + /* + * Load the default encoding AS THE FIRST ENCODING FOR THIS DEVICE. + * + * encpath MUST NOT BE "default" + */ + pd->encodings = NULL; + if (!(enc = findEncoding(encoding, pd->encodings, FALSE))) + enc = addEncoding(encoding, 0); + if (enc && (enclist = addDeviceEncoding(enc, pd->encodings))) { + pd->encodings = enclist; + } else { + PS_cleanup(1, dd, pd); + error(_("failed to load encoding file in %s()"), "postscript"); + } + + /***************************** + * Load fonts + *****************************/ + pd->fonts = NULL; + pd->cidfonts = NULL; + + gotFont = 0; + /* + * If user specified afms then assume the font hasn't been loaded + * Could lead to redundant extra loading of a font, but not often(?) + */ + if (!strcmp(family, "User")) { + font = addDefaultFontFromAFMs(encoding, afmpaths, 0, pd->encodings); + } else { + /* + * Otherwise, family is a device-independent font family. + * One of the elements of postscriptFonts(). + * NOTE this is the first font loaded on this device! + */ + /* + * Check first whether this font has been loaded + * in this R session + */ + font = findLoadedFont(family, encoding, FALSE); + cidfont = findLoadedCIDFont(family, FALSE); + if (!(font || cidfont)) { + /* + * If the font has not been loaded yet, load it. + * + * The family SHOULD be in the font database to get this far. + * (checked at R level in postscript() in postscript.R) + */ + if (isType1Font(family, PostScriptFonts, NULL)) { + font = addFont(family, FALSE, pd->encodings); + } else if (isCIDFont(family, PostScriptFonts, NULL)) { + cidfont = addCIDFont(family, FALSE); + } else { + /* + * Should NOT get here. + * AND if we do, we should free + */ + PS_cleanup(3, dd, pd); + error(_("invalid font type")); + } + } + } + if (font || cidfont) { + /* + * At this point the font is loaded, so add it to the + * device's list of fonts. + * + * If the user specified a vector of AFMs, it is a Type 1 font + */ + if (!strcmp(family, "User") || + isType1Font(family, PostScriptFonts, NULL)) { + pd->fonts = addDeviceFont(font, pd->fonts, &gotFont); + pd->defaultFont = pd->fonts->family; + pd->defaultCIDFont = NULL; + } else /* (isCIDFont(family, PostScriptFonts)) */ { + pd->cidfonts = addDeviceCIDFont(cidfont, pd->cidfonts, &gotFont); + pd->defaultFont = NULL; + pd->defaultCIDFont = pd->cidfonts->cidfamily; + } + } + if (!gotFont) { + PS_cleanup(3, dd, pd); + error(_("failed to initialise default PostScript font")); + } + + /* + * Load the font names sent in via the fonts arg + * NOTE that these are the font names specified at the + * R-level, NOT the translated font names. + */ + if (!isNull(fonts)) { + int i, dontcare, gotFonts = 0, nfonts = LENGTH(fonts); + type1fontlist fontlist; + cidfontlist cidfontlist; + for (i = 0; i < nfonts; i++) { + int index, cidindex; + const char *name = CHAR(STRING_ELT(fonts, i)); + /* + * Check first whether this device is already + * using this font. + */ + if (findDeviceFont(name, pd->fonts, &index) || + findDeviceCIDFont(name, pd->cidfonts, &cidindex)) + gotFonts++; + else { + /* + * Check whether the font is loaded and, if not, + * load it. + */ + font = findLoadedFont(name, encoding, FALSE); + cidfont = findLoadedCIDFont(name, FALSE); + if (!(font || cidfont)) { + if (isType1Font(name, PostScriptFonts, NULL)) { + font = addFont(name, FALSE, pd->encodings); + } else if (isCIDFont(name, PostScriptFonts, NULL)) { + cidfont = addCIDFont(name, FALSE); + } else { + /* + * Should NOT get here. + */ + PS_cleanup(4, dd, pd); + error(_("invalid font type")); + } + } + /* + * Once the font is loaded, add it to the device's + * list of fonts. + */ + if (font || cidfont) { + if (isType1Font(name, PostScriptFonts, NULL)) { + if ((fontlist = addDeviceFont(font, pd->fonts, + &dontcare))) { + pd->fonts = fontlist; + gotFonts++; + } + } else /* (isCIDFont(family, PostScriptFonts)) */ { + if ((cidfontlist = addDeviceCIDFont(cidfont, + pd->cidfonts, + &dontcare))) { + pd->cidfonts = cidfontlist; + gotFonts++; + } + } + } + } + } + if (gotFonts < nfonts) { + PS_cleanup(4, dd, pd); + error(_("failed to initialise additional PostScript fonts")); + } + } + /***************************** + * END Load fonts + *****************************/ + + setbg = R_GE_str2col(bg); + setfg = R_GE_str2col(fg); + + pd->width = width; + pd->height = height; + pd->landscape = horizontal; + pointsize = floor(ps); + if(R_TRANSPARENT(setbg) && R_TRANSPARENT(setfg)) { + PS_cleanup(4, dd, pd); + error(_("invalid foreground/background color (postscript)")); + } + pd->printit = printit; + if(strlen(cmd) > 2*PATH_MAX - 1) { + PS_cleanup(4, dd, pd); + error(_("'command' is too long")); + } + strcpy(pd->command, cmd); + if (printit && strlen(cmd) == 0) { + PS_cleanup(4, dd, pd); + error(_("'postscript(print.it=TRUE)' used with an empty 'print' command")); + } + strcpy(pd->command, cmd); + + + /* Deal with paper and plot size and orientation */ + + pd->paperspecial = FALSE; + if(!strcmp(pd->papername, "Default") || + !strcmp(pd->papername, "default")) { + SEXP s = STRING_ELT(GetOption1(install("papersize")), 0); + if(s != NA_STRING && strlen(CHAR(s)) > 0) + strcpy(pd->papername, CHAR(s)); + else strcpy(pd->papername, "a4"); + } + if(!strcmp(pd->papername, "A4") || + !strcmp(pd->papername, "a4")) { + pd->pagewidth = 21.0 / 2.54; + pd->pageheight = 29.7 /2.54; + } + else if(!strcmp(pd->papername, "Letter") || + !strcmp(pd->papername, "letter") || + !strcmp(pd->papername, "US") || + !strcmp(pd->papername, "us")) { + pd->pagewidth = 8.5; + pd->pageheight = 11.0; + } + else if(!strcmp(pd->papername, "Legal") || + !strcmp(pd->papername, "legal")) { + pd->pagewidth = 8.5; + pd->pageheight = 14.0; + } + else if(!strcmp(pd->papername, "Executive") || + !strcmp(pd->papername, "executive")) { + pd->pagewidth = 7.25; + pd->pageheight = 10.5; + } + else if(!strcmp(pd->papername, "special")) { + if(pd->landscape) { + pd->pagewidth = height; + pd->pageheight = width; + } else { + pd->pagewidth = width; + pd->pageheight = height; + } + pd->paperspecial = TRUE; + } + else { + PS_cleanup(4, dd, pd); + error(_("invalid page type '%s' (postscript)"), pd->papername); + } + pd->pagecentre = pagecentre; + pd->paperwidth = (int)(72 * pd->pagewidth); + pd->paperheight = (int)(72 * pd->pageheight); + pd->onefile = onefile; + if(pd->landscape) { + double tmp; + tmp = pd->pagewidth; + pd->pagewidth = pd->pageheight; + pd->pageheight = tmp; + } + if(strcmp(pd->papername, "special")) + { + if(pd->width < 0.1 || pd->width > pd->pagewidth-0.5) + pd->width = pd->pagewidth-0.5; + if(pd->height < 0.1 || pd->height > pd->pageheight-0.5) + pd->height = pd->pageheight-0.5; + } + if(pagecentre) + { + xoff = (pd->pagewidth - pd->width)/2.0; + yoff = (pd->pageheight - pd->height)/2.0; + } else { + xoff = yoff = 0.0; + } + pd->maxpointsize = (int)(72.0 * ((pd->pageheight > pd->pagewidth) ? + pd->pageheight : pd->pagewidth)); + pd->pageno = pd->fileno = 0; + pd->warn_trans = FALSE; + + /* Base Pointsize */ + /* Nominal Character Sizes in Pixels */ + /* Only right for 12 point font. */ + /* Max pointsize suggested by Peter Dalgaard */ + + if(pointsize < 6.0) pointsize = 6.0; + if(pointsize > pd->maxpointsize) pointsize = pd->maxpointsize; + dd->startps = pointsize; + dd->startfont = 1; + dd->startlty = 0; + dd->startfill = setbg; + dd->startcol = setfg; + dd->startgamma = 1; + + /* Set graphics parameters that must be set by device driver. */ + /* Page dimensions in points. */ + + dd->left = 72 * xoff; /* left */ + dd->right = 72 * (xoff + pd->width); /* right */ + dd->bottom = 72 * yoff; /* bottom */ + dd->top = 72 * (yoff + pd->height); /* top */ + dd->clipLeft = dd->left; dd->clipRight = dd->right; + dd->clipBottom = dd->bottom; dd->clipTop = dd->top; + + dd->cra[0] = 0.9 * pointsize; + dd->cra[1] = 1.2 * pointsize; + + /* Character Addressing Offsets */ + /* These offsets should center a single */ + /* plotting character over the plotting point. */ + /* Pure guesswork and eyeballing ... */ + + dd->xCharOffset = 0.4900; + dd->yCharOffset = 0.3333; + dd->yLineBias = 0.2; + + /* Inches per Raster Unit */ + /* We use points (72 dots per inch) */ + + dd->ipr[0] = 1.0/72.0; + dd->ipr[1] = 1.0/72.0; + /* GREset(.) dd->gp.mkh = dd->gp.cra[0] * dd->gp.ipr[0]; */ + + dd->canClip = TRUE; + dd->canHAdj = 2; + dd->canChangeGamma = FALSE; + + /* Start the driver */ + PS_Open(dd, pd); + + dd->close = PS_Close; + dd->size = PS_Size; + dd->newPage = PS_NewPage; + dd->clip = PS_Clip; + dd->text = PS_Text; + dd->strWidth = PS_StrWidth; + dd->metricInfo = PS_MetricInfo; + dd->rect = PS_Rect; + dd->path = PS_Path; + dd->raster = PS_Raster; + dd->circle = PS_Circle; + dd->line = PS_Line; + dd->polygon = PS_Polygon; + dd->polyline = PS_Polyline; + /* dd->locator = PS_Locator; + dd->mode = PS_Mode; */ + dd->hasTextUTF8 = TRUE; + dd->textUTF8 = PS_TextUTF8; + dd->strWidthUTF8 = PS_StrWidthUTF8; + dd->useRotatedTextInContour = TRUE; + dd->haveTransparency = 1; + dd->haveTransparentBg = 2; + dd->haveRaster = 3; /* non-missing colours */ + + dd->deviceSpecific = (void *) pd; + dd->displayListOn = FALSE; + return TRUE; +} + +static void CheckAlpha(int color, PostScriptDesc *pd) +{ + unsigned int alpha = R_ALPHA(color); + if (alpha > 0 && alpha < 255 && !pd->warn_trans) { + warning(_("semi-transparency is not supported on this device: reported only once per page")); + pd->warn_trans = TRUE; + } +} + +static void SetColor(int color, pDevDesc dd) +{ + PostScriptDesc *pd = (PostScriptDesc *) dd->deviceSpecific; + if(color != pd->current.col) { + PostScriptSetCol(pd->psfp, + R_RED(color)/255.0, + R_GREEN(color)/255.0, + R_BLUE(color)/255.0, pd); + fprintf(pd->psfp, "\n"); + pd->current.col = color; + } +} + +static void SetFill(int color, pDevDesc dd) +{ + PostScriptDesc *pd = (PostScriptDesc *) dd->deviceSpecific; + if(color != pd->current.fill) { + PostScriptSetFill(pd->psfp, + R_RED(color)/255.0, + R_GREEN(color)/255.0, + R_BLUE(color)/255.0, pd); + pd->current.fill = color; + } +} + +/* Note that the line texture is scaled by the line width. */ + +static void SetLineStyle(const pGEcontext gc, pDevDesc dd) +{ + PostScriptDesc *pd = (PostScriptDesc *) dd->deviceSpecific; + char dashlist[8]; + int i; + int newlty = gc->lty; + double newlwd = gc->lwd; + R_GE_lineend newlend = gc->lend; + R_GE_linejoin newljoin = gc->ljoin; + double newlmitre = gc->lmitre; + + if (pd->current.lty != newlty || pd->current.lwd != newlwd) { + pd->current.lwd = newlwd; + pd->current.lty = newlty; + PostScriptSetLineWidth(pd->psfp, newlwd * 0.75); + /* process lty : */ + for(i = 0; i < 8 && newlty & 15 ; i++) { + dashlist[i] = newlty & 15; + newlty = newlty >> 4; + } + PostScriptSetLineTexture(pd->psfp, dashlist, i, newlwd * 0.75, newlend); + } + if (pd->current.lend != newlend) { + pd->current.lend = newlend; + PostScriptSetLineEnd(pd->psfp, newlend); + } + if (pd->current.ljoin != newljoin) { + pd->current.ljoin = newljoin; + PostScriptSetLineJoin(pd->psfp, newljoin); + } + if (pd->current.lmitre != newlmitre) { + pd->current.lmitre = newlmitre; + PostScriptSetLineMitre(pd->psfp, newlmitre); + } +} + +static void SetFont(int font, int size, pDevDesc dd) +{ + PostScriptDesc *pd = (PostScriptDesc *) dd->deviceSpecific; + if(size < 1 || size > pd->maxpointsize) + size = 10; + if (size != pd->current.fontsize || font != pd->current.font) { + PostScriptSetFont(pd->psfp, font, size); + pd->current.fontsize = size; + pd->current.font = font; + } +} + +static void PS_cleanup(int stage, pDevDesc dd, PostScriptDesc *pd) +{ + switch (stage) { + case 4: /* Allocated fonts */ + freeDeviceFontList(pd->fonts); + freeDeviceCIDFontList(pd->cidfonts); + case 3: /* Allocated encodings */ + freeDeviceEncList(pd->encodings); + case 1: /* Allocated PDFDesc */ + free(pd); + free(dd); + } +} + + +static Rboolean PS_Open(pDevDesc dd, PostScriptDesc *pd) +{ + char buf[512]; + + if (strlen(pd->filename) == 0) { + if(strlen(pd->command) == 0) return FALSE; + errno = 0; + pd->psfp = R_popen(pd->command, "w"); + pd->open_type = 1; + if (!pd->psfp || errno != 0) { + PS_cleanup(4, dd, pd); + error(_("cannot open 'postscript' pipe to '%s'"), pd->command); + return FALSE; + } + } else if (pd->filename[0] == '|') { + errno = 0; + pd->psfp = R_popen(pd->filename + 1, "w"); + pd->open_type = 1; + if (!pd->psfp || errno != 0) { + PS_cleanup(4, dd, pd); + error(_("cannot open 'postscript' pipe to '%s'"), + pd->filename + 1); + return FALSE; + } + } else { + snprintf(buf, 512, pd->filename, pd->fileno + 1); /* file 1 to start */ + pd->psfp = R_fopen(R_ExpandFileName(buf), "w"); + pd->open_type = 0; + } + if (!pd->psfp) { + PS_cleanup(4, dd, pd); + error(_("cannot open file '%s'"), buf); + return FALSE; + } + + if(pd->landscape) + PSFileHeader(pd->psfp, + pd->papername, + pd->paperwidth, + pd->paperheight, + pd->landscape, + !(pd->onefile), + pd->paperspecial, + dd->bottom, + dd->left, + dd->top, + dd->right, + pd->title, + pd); + else + PSFileHeader(pd->psfp, + pd->papername, + pd->paperwidth, + pd->paperheight, + pd->landscape, + !(pd->onefile), + pd->paperspecial, + dd->left, + dd->bottom, + dd->right, + dd->top, + pd->title, + pd); + + return TRUE; +} + +/* The driver keeps track of the current values of colors, fonts and + line parameters, to save emitting some PostScript. In some cases, + the state becomes unknown, notably after changing the clipping and + at the start of a new page, so we have the following routine to + invalidate the saved values, which in turn causes the parameters to + be set before usage. + + Called at the start of each page and by PS_Clip (since that + does a grestore). +*/ + +static void Invalidate(pDevDesc dd) +{ + PostScriptDesc *pd = (PostScriptDesc *) dd->deviceSpecific; + + pd->current.font = -1; + pd->current.fontsize = -1; + pd->current.lwd = -1; + pd->current.lty = -1; + pd->current.lend = 0; + pd->current.ljoin = 0; + pd->current.lmitre = 0; + pd->current.col = INVALID_COL; + pd->current.fill = INVALID_COL; +} + +static void PS_Clip(double x0, double x1, double y0, double y1, pDevDesc dd) +{ + PostScriptDesc *pd = (PostScriptDesc *) dd->deviceSpecific; + + PostScriptSetClipRect(pd->psfp, x0, x1, y0, y1); + /* clipping does grestore so invalidate monitor variables */ + Invalidate(dd); +} + +static void PS_Size(double *left, double *right, + double *bottom, double *top, + pDevDesc dd) +{ + *left = dd->left; + *right = dd->right; + *bottom = dd->bottom; + *top = dd->top; +} + +static void PostScriptClose(pDevDesc dd); + +static void PS_NewPage(const pGEcontext gc, + pDevDesc dd) +{ + PostScriptDesc *pd = (PostScriptDesc *) dd->deviceSpecific; + + + if(pd->onefile) { + if(++pd->pageno > 1) PostScriptEndPage(pd->psfp); + } else if(pd->pageno > 0) { + PostScriptClose(dd); + pd->fileno++; + PS_Open(dd, pd); + pd->pageno = 1; + } else pd->pageno++; + PostScriptStartPage(pd->psfp, pd->pageno); + Invalidate(dd); + CheckAlpha(gc->fill, pd); + if(R_OPAQUE(gc->fill)) { + /* + * Override some gc settings + */ + gc->col = R_TRANWHITE; + PS_Rect(0, 0, 72.0 * pd->pagewidth, 72.0 * pd->pageheight, gc, dd); + } + pd->warn_trans = FALSE; +} + +#ifdef Win32 +#include "run.h" /* for runcmd */ +#endif +static void PostScriptClose(pDevDesc dd) +{ + PostScriptDesc *pd = (PostScriptDesc *) dd->deviceSpecific; + + PostScriptFileTrailer(pd->psfp, pd->pageno); + if(pd->open_type == 1) + pclose(pd->psfp); + else { + fclose(pd->psfp); + if (pd->printit) { + char buff[3*PATH_MAX+ 10]; + int err = 0; + /* This should not be possible: the command is limited + to 2*PATH_MAX */ + if(strlen(pd->command) + strlen(pd->filename) > 3*PATH_MAX) { + warning(_("error from postscript() in running:\n %s"), + pd->command); + return; + } + strcpy(buff, pd->command); + strcat(buff, " "); + strcat(buff, pd->filename); +/* Rprintf("buff is %s\n", buff); */ +#ifdef Unix + err = R_system(buff); +#endif +#ifdef Win32 + err = Rf_runcmd(buff, CE_NATIVE, 0, 0, NULL, NULL, NULL); +#endif + if (err) + warning(_("error from postscript() in running:\n %s"), + buff); + } + } +} + +static void PS_Close(pDevDesc dd) +{ + PostScriptDesc *pd = (PostScriptDesc *) dd->deviceSpecific; + + PostScriptClose(dd); + freeDeviceCIDFontList(pd->cidfonts); + freeDeviceFontList(pd->fonts); + freeDeviceEncList(pd->encodings); + pd->cidfonts = NULL; + pd->fonts = NULL; + pd->encodings = NULL; + free(pd); +} + +static FontMetricInfo +*CIDsymbolmetricInfo(const char *family, PostScriptDesc *pd) +{ + FontMetricInfo *result = NULL; + int fontIndex; + cidfontfamily fontfamily; + + fontfamily = findDeviceCIDFont(family, pd->cidfonts, &fontIndex); + if (fontfamily) { + /* (Type 1!) symbol font */ + result = &(fontfamily->symfont->metrics); + } else + error(_("CID family '%s' not included in postscript() device"), + family); + return result; +} + +static FontMetricInfo *metricInfo(const char *family, int face, + PostScriptDesc *pd) { + FontMetricInfo *result = NULL; + int fontIndex; + type1fontfamily fontfamily = findDeviceFont(family, pd->fonts, &fontIndex); + if (fontfamily) { + if(face < 1 || face > 5) { + warning(_("attempt to use invalid font %d replaced by font 1"), + face); + face = 1; + } + result = &(fontfamily->fonts[face-1]->metrics); + } else + error(_("family '%s' not included in postscript() device"), family); + return result; +} + +static char *convname(const char *family, PostScriptDesc *pd) { + char *result = NULL; + int fontIndex; + type1fontfamily fontfamily = findDeviceFont(family, pd->fonts, &fontIndex); + if (fontfamily) + result = fontfamily->encoding->convname; + else + error(_("family '%s' not included in postscript() device"), family); + return result; +} + +static double PS_StrWidth(const char *str, + const pGEcontext gc, + pDevDesc dd) +{ + PostScriptDesc *pd = (PostScriptDesc *) dd->deviceSpecific; + int face = gc->fontface; + + if(face < 1 || face > 5) face = 1; + if (isType1Font(gc->fontfamily, PostScriptFonts, pd->defaultFont)) { + return floor(gc->cex * gc->ps + 0.5) * + PostScriptStringWidth((const unsigned char *)str, CE_NATIVE, + metricInfo(gc->fontfamily, face, pd), + pd->useKern, face, + convname(gc->fontfamily, pd)); + } else { /* cidfont(gc->fontfamily, PostScriptFonts) */ + if (face < 5) { + return floor(gc->cex * gc->ps + 0.5) * + PostScriptStringWidth((const unsigned char *)str, CE_NATIVE, + NULL, FALSE, face, NULL); + } else { + return floor(gc->cex * gc->ps + 0.5) * + PostScriptStringWidth((const unsigned char *)str, CE_NATIVE, + /* Send symbol face metric info */ + CIDsymbolmetricInfo(gc->fontfamily, pd), + FALSE, face, NULL); + } + } +} + +static double PS_StrWidthUTF8(const char *str, + const pGEcontext gc, + pDevDesc dd) +{ + PostScriptDesc *pd = (PostScriptDesc *) dd->deviceSpecific; + int face = gc->fontface; + + if(face < 1 || face > 5) face = 1; + if (isType1Font(gc->fontfamily, PostScriptFonts, pd->defaultFont)) { + return floor(gc->cex * gc->ps + 0.5) * + PostScriptStringWidth((const unsigned char *)str, CE_UTF8, + metricInfo(gc->fontfamily, face, pd), + pd->useKern, face, + convname(gc->fontfamily, pd)); + } else { /* cidfont(gc->fontfamily, PostScriptFonts) */ + if (face < 5) { + return floor(gc->cex * gc->ps + 0.5) * + PostScriptStringWidth((const unsigned char *)str, CE_UTF8, + NULL, FALSE, face, NULL); + } else { + return floor(gc->cex * gc->ps + 0.5) * + PostScriptStringWidth((const unsigned char *)str, CE_UTF8, + /* Send symbol face metric info */ + CIDsymbolmetricInfo(gc->fontfamily, pd), + FALSE, face, NULL); + } + } +} + +static void PS_MetricInfo(int c, + const pGEcontext gc, + double* ascent, double* descent, + double* width, pDevDesc dd) +{ + PostScriptDesc *pd = (PostScriptDesc *) dd->deviceSpecific; + int face = gc->fontface; + + if(face < 1 || face > 5) face = 1; + + if (isType1Font(gc->fontfamily, PostScriptFonts, pd->defaultFont)) { + PostScriptMetricInfo(c, ascent, descent, width, + metricInfo(gc->fontfamily, face, pd), + face == 5, convname(gc->fontfamily, pd)); + } else { /* cidfont(gc->fontfamily, PostScriptFonts) */ + if (face < 5) { + PostScriptCIDMetricInfo(c, ascent, descent, width); + } else { + PostScriptMetricInfo(c, ascent, descent, width, + CIDsymbolmetricInfo(gc->fontfamily, pd), + TRUE, ""); + } + } + *ascent = floor(gc->cex * gc->ps + 0.5) * *ascent; + *descent = floor(gc->cex * gc->ps + 0.5) * *descent; + *width = floor(gc->cex * gc->ps + 0.5) * *width; +} + +static void PS_Rect(double x0, double y0, double x1, double y1, + const pGEcontext gc, + pDevDesc dd) +{ + int code; + PostScriptDesc *pd = (PostScriptDesc *) dd->deviceSpecific; + + /* code is set as follows */ + /* code == 0, nothing to draw */ + /* code == 1, outline only */ + /* code == 2, fill only */ + /* code == 3, outline and fill */ + + CheckAlpha(gc->fill, pd); + CheckAlpha(gc->col, pd); + code = 2 * (R_OPAQUE(gc->fill)) + (R_OPAQUE(gc->col)); + + if (code) { + if(code & 2) + SetFill(gc->fill, dd); + if(code & 1) { + SetColor(gc->col, dd); + SetLineStyle(gc, dd); + } + PostScriptRectangle(pd->psfp, x0, y0, x1, y1); + fprintf(pd->psfp, "p%d\n", code); + } +} + +typedef rcolor * rcolorPtr; + +static void PS_imagedata(rcolorPtr raster, + int w, int h, + PostScriptDesc *pd) +{ + /* Each original byte is translated to two hex digits + (representing a number between 0 and 255) */ + for (int i = 0; i < w*h; i++) + fprintf(pd->psfp, "%02x%02x%02x", + R_RED(raster[i]), R_GREEN(raster[i]), R_BLUE(raster[i])); +} + +static void PS_grayimagedata(rcolorPtr raster, + int w, int h, + PostScriptDesc *pd) +{ + /* Weights as in PDF gray conversion */ + for (int i = 0; i < w*h; i++) { + double r = 0.213 * R_RED(raster[i]) + 0.715 * R_GREEN(raster[i]) + + 0.072 * R_BLUE(raster[i]); + fprintf(pd->psfp, "%02x", (int)(r+0.49)); + } +} + +/* Could support 'colormodel = "cmyk"' */ +static void PS_writeRaster(unsigned int *raster, int w, int h, + double x, double y, + double width, double height, + double rot, + Rboolean interpolate, + pDevDesc dd) +{ + PostScriptDesc *pd = (PostScriptDesc *) dd->deviceSpecific; + + /* This takes the simple approach of creating an inline + * image. + * There is no support for semitransparent images, not even + * for transparent pixels (missing values in image(useRaster = TRUE) ). + * + * The version in R < 2.13.2 used colorimage, hence the DeviceRGB + * colour space. + */ + + /* Now we are using level-2 features, there are other things we could do + (a) encode the data more compactly, e.g. using + /DataSource currentfile /ASCII85Decode filter /FlateDecode filter def + + (b) add a mask with ImageType 3: see PLRM 3rd ed section 4.10.6. + + (c) interpolation (done but disabled, as at least ghostscript + seems to ignore the request, and Mac preview always + interpolates.) + + (d) sRGB colorspace (done) + */ + + /* Save graphics state */ + fprintf(pd->psfp, "gsave\n"); + /* set the colour space: this form of the image operator uses the + current colour space. */ + if (streql(pd->colormodel, "srgb+gray")) + fprintf(pd->psfp, "sRGB\n"); + else if (streql(pd->colormodel, "srgb")) /* set for page */ ; + else if (streql(pd->colormodel, "gray")) + fprintf(pd->psfp, "/DeviceGray setcolorspace\n"); + else + fprintf(pd->psfp, "/DeviceRGB setcolorspace\n"); + /* translate */ + fprintf(pd->psfp, "%.2f %.2f translate\n", x, y); + /* rotate */ + if (rot != 0.0) fprintf(pd->psfp, "%.2f rotate\n", rot); + /* scale */ + fprintf(pd->psfp, "%.2f %.2f scale\n", width, height); + /* write dictionary */ + fprintf(pd->psfp, "8 dict dup begin\n"); + fprintf(pd->psfp, " /ImageType 1 def\n"); + fprintf(pd->psfp, " /Width %d def\n", w); + fprintf(pd->psfp, " /Height %d def\n", h); + fprintf(pd->psfp, " /BitsPerComponent 8 def\n"); + if (interpolate) + fprintf(pd->psfp, " /Interpolate true def\n"); + if (streql(pd->colormodel, "gray")) + fprintf(pd->psfp, " /Decode [0 1] def\n"); + else + fprintf(pd->psfp, " /Decode [0 1 0 1 0 1] def\n"); + fprintf(pd->psfp, " /DataSource currentfile /ASCIIHexDecode filter def\n"); + fprintf(pd->psfp, " /ImageMatrix [%d 0 0 %d 0 %d] def\n", w, -h, h); + fprintf(pd->psfp, "end\n"); + fprintf(pd->psfp, "image\n"); + /* now the data */ + if (streql(pd->colormodel, "gray")) + PS_grayimagedata(raster, w, h, pd); + else + PS_imagedata(raster, w, h, pd); + fprintf(pd->psfp, ">\n"); + /* Restore graphics state */ + fprintf(pd->psfp, "grestore\n"); +} + +/* see comments above */ +#define OLD 1 +static void PS_Raster(unsigned int *raster, int w, int h, + double x, double y, + double width, double height, + double rot, + Rboolean interpolate, + const pGEcontext gc, pDevDesc dd) +{ +#ifdef OLD + if (interpolate) { + /* Generate a new raster + * which is interpolated from the original + * Assume a resolution for the new raster of 72 dpi + * Ideally would allow user to set this. + */ + const void *vmax; + vmax = vmaxget(); + int newW = (int) width; + int newH = (int) height; + unsigned int *newRaster = + (unsigned int *) R_alloc(newW * newH, sizeof(unsigned int)); + + R_GE_rasterInterpolate(raster, w, h, + newRaster, newW, newH); + PS_writeRaster(newRaster, newW, newH, + x, y, width, height, rot, FALSE, dd); + vmaxset(vmax); + } else { + PS_writeRaster(raster, w, h, + x, y, width, height, rot, FALSE, dd); + } +#else + PS_writeRaster(raster, w, h, + x, y, width, height, rot, interpolate, dd); +#endif +} + +static void PS_Circle(double x, double y, double r, + const pGEcontext gc, + pDevDesc dd) +{ + int code; + PostScriptDesc *pd = (PostScriptDesc *) dd->deviceSpecific; + + /* code is set as follows */ + /* code == 0, nothing to draw */ + /* code == 1, outline only */ + /* code == 2, fill only */ + /* code == 3, outline and fill */ + + CheckAlpha(gc->fill, pd); + CheckAlpha(gc->col, pd); + code = 2 * (R_OPAQUE(gc->fill)) + (R_OPAQUE(gc->col)); + + if (code) { + if(code & 2) + SetFill(gc->fill, dd); + if(code & 1) { + SetColor(gc->col, dd); + SetLineStyle(gc, dd); + } + PostScriptCircle(pd->psfp, x, y, r); + fprintf(pd->psfp, "p%d\n", code); + } +} + +static void PS_Line(double x1, double y1, double x2, double y2, + const pGEcontext gc, + pDevDesc dd) +{ + PostScriptDesc *pd = (PostScriptDesc *) dd->deviceSpecific; + + CheckAlpha(gc->col, pd); + /* FIXME : clip to the device extents here */ + if(R_OPAQUE(gc->col)) { + SetColor(gc->col, dd); + SetLineStyle(gc, dd); + PostScriptStartPath(pd->psfp); + PostScriptMoveTo(pd->psfp, x1, y1); + PostScriptRLineTo(pd->psfp, x1, y1, x2, y2); + /* fprintf(pd->psfp, "%.2f %.2f rl\n", x2 - x1, y2 - y1);*/ + PostScriptEndPath(pd->psfp); + } +} + +static void PS_Polygon(int n, double *x, double *y, + const pGEcontext gc, + pDevDesc dd) +{ + PostScriptDesc *pd; + int i, code; + + pd = (PostScriptDesc *) dd->deviceSpecific; + + /* code is set as follows */ + /* code == 0, nothing to draw */ + /* code == 1, outline only */ + /* code == 2, fill only */ + /* code == 3, outline and fill */ + /* code == 6, eofill only */ + /* code == 7, outline and eofill */ + + CheckAlpha(gc->fill, pd); + CheckAlpha(gc->col, pd); + code = 2 * (R_OPAQUE(gc->fill)) + (R_OPAQUE(gc->col)); + + if (code) { + if(code & 2) { + SetFill(gc->fill, dd); + if (pd->fillOddEven) code |= 4; + } + if(code & 1) { + SetColor(gc->col, dd); + SetLineStyle(gc, dd); + } + fprintf(pd->psfp, "np\n"); + fprintf(pd->psfp, " %.2f %.2f m\n", x[0], y[0]); + for(i = 1 ; i < n ; i++) + if (i % 100 == 0) + fprintf(pd->psfp, "%.2f %.2f lineto\n", x[i], y[i]); + else + PostScriptRLineTo(pd->psfp, x[i-1], y[i-1], x[i], y[i]); + fprintf(pd->psfp, "cp p%d\n", code); + } +} + +static void PS_Path(double *x, double *y, + int npoly, int *nper, + Rboolean winding, + const pGEcontext gc, + pDevDesc dd) +{ + PostScriptDesc *pd; + int i, j, index, code; + + pd = (PostScriptDesc *) dd->deviceSpecific; + + /* code is set as follows */ + /* code == 0, nothing to draw */ + /* code == 1, outline only */ + /* code == 2, fill only */ + /* code == 3, outline and fill */ + /* code == 6, eofill only */ + /* code == 7, outline and eofill */ + + CheckAlpha(gc->fill, pd); + CheckAlpha(gc->col, pd); + code = 2 * (R_OPAQUE(gc->fill)) + (R_OPAQUE(gc->col)); + + if (code) { + if(code & 2) { + SetFill(gc->fill, dd); + if (!winding) code |= 4; + } + if(code & 1) { + SetColor(gc->col, dd); + SetLineStyle(gc, dd); + } + fprintf(pd->psfp, "np\n"); + index = 0; + for (i = 0; i < npoly; i++) { + fprintf(pd->psfp, " %.2f %.2f m\n", x[index], y[index]); + index++; + for(j = 1; j < nper[i]; j++) { + if (j % 100 == 0) + fprintf(pd->psfp, "%.2f %.2f lineto\n", + x[index], y[index]); + else + PostScriptRLineTo(pd->psfp, x[index-1], y[index-1], + x[index], y[index]); + index++; + } + fprintf(pd->psfp, "cp\n"); + } + fprintf(pd->psfp, "p%d\n", code); + } +} + +static void PS_Polyline(int n, double *x, double *y, + const pGEcontext gc, + pDevDesc dd) +{ + PostScriptDesc *pd; + int i; + + pd = (PostScriptDesc*) dd->deviceSpecific; + CheckAlpha(gc->col, pd); + if(R_OPAQUE(gc->col)) { + SetColor(gc->col, dd); + SetLineStyle(gc, dd); + fprintf(pd->psfp, "np\n"); + fprintf(pd->psfp, "%.2f %.2f m\n", x[0], y[0]); + for(i = 1 ; i < n ; i++) { + /* split up solid lines (only) into chunks of size 1000 */ + if(gc->lty == 0 && i%1000 == 0) + fprintf(pd->psfp, "currentpoint o m\n"); + if (i % 100 == 0) + fprintf(pd->psfp, "%.2f %.2f lineto\n", x[i], y[i]); + else + PostScriptRLineTo(pd->psfp, x[i-1], y[i-1], x[i], y[i]); + } + fprintf(pd->psfp, "o\n"); + } +} + +static int translateFont(char *family, int style, PostScriptDesc *pd) +{ + int result = style; + type1fontfamily fontfamily; + int fontIndex; + if(style < 1 || style > 5) { + warning(_("attempt to use invalid font %d replaced by font 1"), style); + style = 1; + } + fontfamily = findDeviceFont(family, pd->fonts, &fontIndex); + if (fontfamily) { + result = (fontIndex - 1)*5 + style; + } else { + warning(_("family '%s' not included in postscript() device"), family); + } + return result; +} + +static int numFonts(type1fontlist fonts) { + int i = 0; + while (fonts) { + i++; + fonts = fonts->next; + } + return i; +} + +static int translateCIDFont(char *family, int style, PostScriptDesc *pd) +{ + int result = style; + cidfontfamily fontfamily; + int fontIndex; + if(style < 1 || style > 5) { + warning(_("attempt to use invalid font %d replaced by font 1"), style); + style = 1; + } + fontfamily = findDeviceCIDFont(family, pd->cidfonts, &fontIndex); + if (fontfamily) { + /* + * CID fonts all listed after all Type 1 fonts. + */ + result = (numFonts(pd->fonts)*5) + (fontIndex - 1)*5 + style; + } else { + warning(_("family '%s' not included in postscript() device"), family); + } + return result; +} + +static void drawSimpleText(double x, double y, const char *str, + double rot, double hadj, + int font, + const pGEcontext gc, + pDevDesc dd) { + PostScriptDesc *pd = (PostScriptDesc *) dd->deviceSpecific; + + SetFont(font, + (int)floor(gc->cex * gc->ps + 0.5),dd); + CheckAlpha(gc->col, pd); + if(R_OPAQUE(gc->col)) { + SetColor(gc->col, dd); + if(pd->useKern) + PostScriptTextKern(pd->psfp, x, y, str, hadj, rot, gc, dd); + else + PostScriptText(pd->psfp, x, y, str, strlen(str), hadj, rot, gc, dd); + } +} + +/* <FIXME> it would make sense to cache 'cd' here, but we would also + need to know if the current locale's charset changes. However, + currently this is only called in a UTF-8 locale. + */ +static void mbcsToSbcs(const char *in, char *out, const char *encoding, + int enc) +{ + void *cd = NULL; + const char *i_buf; char *o_buf; + size_t i_len, o_len, status; + +#if 0 + if(enc != CE_UTF8 && + ( !strcmp(encoding, "latin1") || !strcmp(encoding, "ISOLatin1")) ) { + mbcsToLatin1(in, out); /* more tolerant */ + return; + } +#endif + + if ((void*)-1 == + (cd = Riconv_open(encoding, (enc == CE_UTF8) ? "UTF-8" : ""))) + error(_("unknown encoding '%s' in 'mbcsToSbcs'"), encoding); + + i_buf = (char *) in; + i_len = strlen(in)+1; /* include terminator */ + o_buf = (char *) out; + o_len = i_len; /* must be the same or fewer chars */ +next_char: + status = Riconv(cd, &i_buf, &i_len, &o_buf, &o_len); + /* libiconv 1.13 gives EINVAL on \xe0 in UTF-8 (as used in fBasics) */ + if(status == (size_t) -1 && (errno == EILSEQ || errno == EINVAL)) { + warning(_("conversion failure on '%s' in 'mbcsToSbcs': dot substituted for <%02x>"), + in, (unsigned char) *i_buf), + *o_buf++ = '.'; i_buf++; o_len--; i_len--; + if(i_len > 0) goto next_char; + } + + Riconv_close(cd); + if (status == (size_t)-1) /* internal error? */ + error("conversion failure from %s to %s on '%s' in 'mbcsToSbcs'", + (enc == CE_UTF8) ? "UTF-8" : "native", encoding, in); +} + +static void PS_Text0(double x, double y, const char *str, int enc, + double rot, double hadj, + const pGEcontext gc, + pDevDesc dd) +{ + const char *str1 = str; + char *buff; + + PostScriptDesc *pd = (PostScriptDesc *) dd->deviceSpecific; + + if (gc->fontface == 5) { + if (isCIDFont(gc->fontfamily, PostScriptFonts, pd->defaultCIDFont)) { + drawSimpleText(x, y, str, rot, hadj, + translateCIDFont(gc->fontfamily, gc->fontface, pd), + gc, dd); + return; + } else { + drawSimpleText(x, y, str, rot, hadj, + translateFont(gc->fontfamily, gc->fontface, pd), + gc, dd); + return; + } + } + + /* No symbol fonts from now on */ + + if (isCIDFont(gc->fontfamily, PostScriptFonts, pd->defaultCIDFont)) { + /* NB, we could be in a SBCS here */ + size_t ucslen; + int fontIndex; + + /* + * CID convert optimize PS encoding == locale encode case + */ + cidfontfamily cidfont = findDeviceCIDFont(gc->fontfamily, + pd->cidfonts, + &fontIndex); + if(!cidfont) + error(_("family '%s' not included in postscript() device"), + gc->fontfamily); + + if (!dd->hasTextUTF8 && + !strcmp(locale2charset(NULL), cidfont->encoding)) { + SetFont(translateCIDFont(gc->fontfamily, gc->fontface, pd), + (int)floor(gc->cex * gc->ps + 0.5),dd); + CheckAlpha(gc->col, pd); + if(R_OPAQUE(gc->col)) { + SetColor(gc->col, dd); + PostScriptHexText(pd->psfp, x, y, str, strlen(str), hadj, rot); + } + return; + } + + /* + * CID convert PS encoding != locale encode case + */ + ucslen = (dd->hasTextUTF8) ? Rf_utf8towcs(NULL, str, 0) : mbstowcs(NULL, str, 0); + if (ucslen != (size_t)-1) { + void *cd; + const char *i_buf; char *o_buf; + size_t nb, i_len, o_len, buflen = ucslen * sizeof(ucs2_t); + size_t status; + + cd = (void*) Riconv_open(cidfont->encoding, + (enc == CE_UTF8) ? "UTF-8" : ""); + if(cd == (void*)-1) { + warning(_("failed open converter to encoding '%s'"), + cidfont->encoding); + return; + } + + R_CheckStack2(buflen); + unsigned char buf[buflen]; + + i_buf = (char *)str; + o_buf = (char *)buf; + i_len = strlen(str); /* do not include terminator */ + nb = o_len = buflen; + + status = Riconv(cd, &i_buf, (size_t *)&i_len, + (char **)&o_buf, (size_t *)&o_len); + + Riconv_close(cd); + if(status == (size_t)-1) + warning(_("failed in text conversion to encoding '%s'"), + cidfont->encoding); + else { + SetFont(translateCIDFont(gc->fontfamily, gc->fontface, pd), + (int)floor(gc->cex * gc->ps + 0.5), dd); + CheckAlpha(gc->col, pd); + if(R_OPAQUE(gc->col)) { + SetColor(gc->col, dd); + PostScriptHexText(pd->psfp, x, y, (char *)buf, + nb - o_len, hadj, rot); + } + } + return; + } else { + warning(_("invalid string in '%s'"), "PS_Text"); + return; + } + } + + /* Now using single-byte non-symbol font. + + Was utf8locale, but it is not entirely obvious that only UTF-8 + needs re-encoding, although we don't have any other MBCSs that + can sensibly be mapped to a SBCS. + It would be perverse (but possible) to write English in a + CJK MBCS. + */ + if((enc == CE_UTF8 || mbcslocale) && !strIsASCII(str)) { + R_CheckStack2(strlen(str)+1); + buff = alloca(strlen(str)+1); /* Output string cannot be longer */ + mbcsToSbcs(str, buff, convname(gc->fontfamily, pd), enc); + str1 = buff; + } + drawSimpleText(x, y, str1, rot, hadj, + translateFont(gc->fontfamily, gc->fontface, pd), + gc, dd); +} + +static void PS_Text(double x, double y, const char *str, + double rot, double hadj, + const pGEcontext gc, + pDevDesc dd) +{ + PS_Text0(x, y, str, CE_NATIVE, rot, hadj, gc, dd); +} + +static void PS_TextUTF8(double x, double y, const char *str, + double rot, double hadj, + const pGEcontext gc, + pDevDesc dd) +{ + PS_Text0(x, y, str, CE_UTF8, rot, hadj, gc, dd); +} + + + +/*********************************************************************** + + XFig driver shares font handling + +************************************************************************/ + + + +typedef struct { + char filename[PATH_MAX]; + + char papername[64]; /* paper name */ + int paperwidth; /* paper width in big points (1/72 in) */ + int paperheight; /* paper height in big points */ + Rboolean landscape; /* landscape mode */ + int pageno; /* page number */ + + int fontnum; /* font number in XFig */ + int maxpointsize; + + double width; /* plot width in inches */ + double height; /* plot height in inches */ + double pagewidth; /* page width in inches */ + double pageheight; /* page height in inches */ + Rboolean pagecentre; /* centre image on page? */ + + double lwd; /* current line width */ + int lty; /* current line type */ + rcolor col; /* current color */ + rcolor fill; /* current fill color */ + rcolor bg; /* background color */ + int XFigColors[534]; + int nXFigColors; + + FILE *psfp; /* output file */ + FILE *tmpfp; /* temp file */ + char tmpname[PATH_MAX]; + + Rboolean onefile; + Rboolean warn_trans; /* have we warned about translucent cols? */ + int ymax; /* used to invert coord system */ + char encoding[50]; /* for writing text */ + + Rboolean textspecial; /* use textspecial flag in xfig for latex integration */ + Rboolean defaultfont; /* use the default font in xfig */ + + /* + * Fonts and encodings used on the device + * + * ASSUME ONLY ONE (DEFAULT) FOR NOW + */ + type1fontlist fonts; + encodinglist encodings; +} XFigDesc; + +static void +XF_FileHeader(FILE *fp, const char *papername, Rboolean landscape, + Rboolean onefile) +{ + fprintf(fp, "#FIG 3.2\n"); + fprintf(fp, landscape ? "Landscape\n" : "Portrait\n"); + fprintf(fp, "Flush Left\nInches\n"); + /* Fix */fprintf(fp, "%s\n", papername); + fprintf(fp, "100.0\n"); + fprintf(fp, onefile ? "Multiple\n" : "Single\n"); + fprintf(fp, "-2\n"); /* no background */ + fprintf(fp, "1200 2\n"); /* coordinate system */ + fprintf(fp, "# End of XFig header\n"); +} + +static void XF_FileTrailer(FILE *fp) +{ + fprintf(fp, "# end of XFig file\n"); +} + + +static void XF_EndPage(FILE *fp) +{ + fprintf(fp, "# end of XFig page\n"); +} + +static void XF_WriteString(FILE *fp, const char *str) +{ + unsigned int c; + for ( ; *str; str++) { + c = (unsigned char)*str; + if (c > 127) { + fprintf(fp, "\\%o", c); + } else { + switch(*str) { + case '\n': + fprintf(fp, "\\n"); + break; + case '\\': + fprintf(fp, "\\\\"); + break; + default: + fputc(*str, fp); + break; + } + } + } +} + +static void XF_CheckAlpha(int color, XFigDesc *pd) +{ + unsigned int alpha = R_ALPHA(color); + if (alpha > 0 && alpha < 255 && !pd->warn_trans) { + warning(_("semi-transparency is not supported on this device: reported only once per page")); + pd->warn_trans = TRUE; + } +} + + +static int XF_SetColor(int color, XFigDesc *pd) +{ + int i; + if(!R_OPAQUE(color)) return -1; + color = color & 0xffffff; + for (i = 0; i < pd->nXFigColors; i++) + if(color == pd->XFigColors[i]) return i; + if(pd->nXFigColors == 534) + error(_("ran out of colors in xfig()")); + /* new colour */ + fprintf(pd->psfp, "0 %d #%02x%02x%02x\n", pd->nXFigColors, + R_RED(color), R_GREEN(color), R_BLUE(color)); + pd->XFigColors[pd->nXFigColors] = color; + return pd->nXFigColors++; +} + +static void XFconvert(double *x, double *y, XFigDesc *pd) +{ + (*x) *= 16.667; + (*y) = pd->ymax - 16.667*(*y); +} + + +static int XF_SetLty(int lty) +{ + switch(lty) { + case LTY_BLANK: + return -1; + case LTY_SOLID: + return 0; + case LTY_DASHED: + return 1; + case LTY_DOTTED: + return 2; + case LTY_DOTDASH: + return 3; + default: + warning(_("unimplemented line texture %08x: using Dash-double-dotted"), + lty); + return 4; + } +} + +/* Device Driver Actions */ + +static void XFig_Circle(double x, double y, double r, + const pGEcontext gc, + pDevDesc dd); +static void XFig_Clip(double x0, double x1, double y0, double y1, + pDevDesc dd); +static void XFig_Close(pDevDesc dd); +static void XFig_Line(double x1, double y1, double x2, double y2, + const pGEcontext gc, + pDevDesc dd); +static void XFig_MetricInfo(int c, + const pGEcontext gc, + double* ascent, double* descent, + double* width, pDevDesc dd); +static void XFig_NewPage(const pGEcontext gc, pDevDesc dd); +static void XFig_Polygon(int n, double *x, double *y, + const pGEcontext gc, + pDevDesc dd); +static void XFig_Polyline(int n, double *x, double *y, + const pGEcontext gc, + pDevDesc dd); +static void XFig_Rect(double x0, double y0, double x1, double y1, + const pGEcontext gc, + pDevDesc dd); +static void XFig_Size(double *left, double *right, + double *bottom, double *top, + pDevDesc dd); +static double XFig_StrWidth(const char *str, + const pGEcontext gc, + pDevDesc dd); +static void XFig_Text(double x, double y, const char *str, + double rot, double hadj, + const pGEcontext gc, + pDevDesc dd); +static Rboolean XFig_Open(pDevDesc, XFigDesc*); + +/* + * Values taken from FIG format definition + */ +static int XFigBaseNum(const char *name) +{ + int i; + if (!strcmp(name, "Times")) + i = 0; + else if (!strcmp(name, "AvantGarde")) + i = 4; + else if (!strcmp(name, "Bookman")) + i = 8; + else if (!strcmp(name, "Courier")) + i = 12; + else if (!strcmp(name, "Helvetica")) + i = 16; + else if (!strcmp(name, "Helvetica-Narrow")) + i = 20; + else if (!strcmp(name, "NewCenturySchoolbook")) + i = 24; + else if (!strcmp(name, "Palatino")) + i = 28; + else { + warning(_("unknown postscript font family '%s', using Helvetica"), + name); + i = 16; + } + return i; +} + +static void XF_resetColors(XFigDesc *pd) +{ + int i; + for(i = 0; i < 32; i++) pd->XFigColors[i] = 0; + pd->XFigColors[7] = 0xffffff; /* white */ + pd->nXFigColors = 32; +} + +/* Driver Support Routines */ + +static Rboolean +XFigDeviceDriver(pDevDesc dd, const char *file, const char *paper, + const char *family, + const char *bg, const char *fg, + double width, double height, + Rboolean horizontal, double ps, + Rboolean onefile, Rboolean pagecentre, + Rboolean defaultfont, Rboolean textspecial, + const char *encoding) +{ + /* If we need to bail out with some sort of "error" */ + /* then we must free(dd) */ + + int gotFont; + double xoff, yoff, pointsize; + XFigDesc *pd; + type1fontfamily font; + encodinginfo enc; + encodinglist enclist; + + /* Check and extract the device parameters */ + + if(strlen(file) > PATH_MAX - 1) { + free(dd); + error(_("filename too long in %s()"), "xfig"); + } + + /* allocate new xfig device description */ + if (!(pd = (XFigDesc *) malloc(sizeof(XFigDesc)))) { + free(dd); + error(_("memory allocation problem in %s()"), "xfig"); + return FALSE; + } + + /* from here on, if need to bail out with "error", must also */ + /* free(pd) */ + + /* initialize xfig device description */ + strcpy(pd->filename, file); + strcpy(pd->papername, paper); + pd->fontnum = XFigBaseNum(family); + /* this might have changed the family, so update */ + if(pd->fontnum == 16) family = "Helvetica"; + pd->bg = R_GE_str2col(bg); + pd->col = R_GE_str2col(fg); + pd->fill = R_TRANWHITE; + pd->width = width; + pd->height = height; + pd->landscape = horizontal; + pd->textspecial = textspecial; + pd->defaultfont = defaultfont; + pointsize = floor(ps); + if(R_TRANSPARENT(pd->bg) && R_TRANSPARENT(pd->col)) { + free(dd); + free(pd); + error(_("invalid foreground/background color (xfig)")); + } + pd->warn_trans = FALSE; + + /* + * Load the default encoding AS THE FIRST ENCODING FOR THIS DEVICE. + */ + pd->encodings = NULL; + if (!(enc = findEncoding("ISOLatin1.enc", pd->encodings, FALSE))) + enc = addEncoding("ISOLatin1.enc", 0); + if (enc && (enclist = addDeviceEncoding(enc, pd->encodings))) { + pd->encodings = enclist; + } else { + free(dd); + free(pd); + error(_("failed to load encoding file in %s()"), "xfig"); + } + + /* Load default font */ + pd->fonts = NULL; + + gotFont = 0; + font = findLoadedFont(family, "ISOLatin1.enc", FALSE); + if (!font) { + /* + * If the font has not been loaded yet, load it. + * + * The family SHOULD be in the font database to get this far. + * (checked at R level in postscript() in postscript.R) + */ + if (isType1Font(family, PostScriptFonts, NULL)) { + font = addFont(family, FALSE, pd->encodings); + } else { + error(_("only Type 1 fonts supported for XFig")); + } + } + if (font) { + /* + * At this point the font is loaded, so add it to the + * device's list of fonts. + */ + pd->fonts = addDeviceFont(font, pd->fonts, &gotFont); + } + if (!gotFont) { + free(dd); + free(pd); + error(_("failed to initialise default XFig font")); + } + + /* Deal with paper and plot size and orientation */ + + if(!strcmp(pd->papername, "Default") || + !strcmp(pd->papername, "default")) { + SEXP s = STRING_ELT(GetOption1(install("papersize")), 0); + if(s != NA_STRING && strlen(CHAR(s)) > 0) + strcpy(pd->papername, CHAR(s)); + else strcpy(pd->papername, "A4"); + } + if(!strcmp(pd->papername, "A4") || + !strcmp(pd->papername, "a4")) { + strcpy(pd->papername, "A4"); + pd->pagewidth = 21.0 / 2.54; + pd->pageheight = 29.7 / 2.54; + } + else if(!strcmp(pd->papername, "Letter") || + !strcmp(pd->papername, "letter")) { + strcpy(pd->papername, "Letter"); + pd->pagewidth = 8.5; + pd->pageheight = 11.0; + } + else if(!strcmp(pd->papername, "Legal") || + !strcmp(pd->papername, "legal")) { + strcpy(pd->papername, "Legal"); + pd->pagewidth = 8.5; + pd->pageheight = 14.0; + } + else { + freeDeviceFontList(pd->fonts); + freeDeviceEncList(pd->encodings); + pd->fonts = NULL; + pd->encodings = NULL; + free(dd); + free(pd); + error(_("invalid page type '%s' (xfig)"), pd->papername); + } + pd->pagecentre = pagecentre; + pd->paperwidth = (int)(72 * pd->pagewidth); + pd->paperheight = (int)(72 * pd->pageheight); + if(!onefile) { + char *p = strrchr(pd->filename, '%'); + if(!p) + warning(_("xfig(%s, onefile=FALSE) will only return the last plot"), pd->filename); + } + if(pd->landscape) { + double tmp; + tmp = pd->pagewidth; + pd->pagewidth = pd->pageheight; + pd->pageheight = tmp; + } + if(pd->width < 0.1 || pd->width > pd->pagewidth-0.5) + pd->width = pd->pagewidth-0.5; + if(pd->height < 0.1 || pd->height > pd->pageheight-0.5) + pd->height = pd->pageheight-0.5; + if(pagecentre) { + xoff = (pd->pagewidth - pd->width)/2.0; + yoff = (pd->pageheight - pd->height)/2.0; + } else { + xoff = yoff = 0.0; + } + if(pagecentre) + pd->ymax = (int)(1200.0 * pd->pageheight); + else + pd->ymax = (int)(1200.0 * pd->height); + pd->onefile = onefile; + pd->maxpointsize = (int)(72.0 * ((pd->pageheight > pd->pagewidth) ? + pd->pageheight : pd->pagewidth)); + pd->pageno = 0; + /* Base Pointsize */ + /* Nominal Character Sizes in Pixels */ + /* Only right for 12 point font. */ + /* Max pointsize suggested by Peter Dalgaard */ + + if(pointsize < 6.0) pointsize = 6.0; + if(pointsize > pd->maxpointsize) pointsize = pd->maxpointsize; + dd->startps = pointsize; + dd->startlty = LTY_SOLID; + dd->startfont = 1; + dd->startfill = pd->bg; + dd->startcol = pd->col; + dd->startgamma = 1; + + /* Set graphics parameters that must be set by device driver. */ + /* Page dimensions in points. */ + + dd->left = 72 * xoff; /* left */ + dd->right = 72 * (xoff + pd->width); /* right */ + dd->bottom = 72 * yoff; /* bottom */ + dd->top = 72 * (yoff + pd->height); /* top */ + dd->clipLeft = dd->left; dd->clipRight = dd->right; + dd->clipBottom = dd->bottom; dd->clipTop = dd->top; + + dd->cra[0] = 0.9 * pointsize; + dd->cra[1] = 1.2 * pointsize; + + /* Character Addressing Offsets */ + /* These offsets should center a single */ + /* plotting character over the plotting point. */ + /* Pure guesswork and eyeballing ... */ + + dd->xCharOffset = 0.4900; + dd->yCharOffset = 0.3333; + dd->yLineBias = 0.2; + + /* Inches per Raster Unit */ + /* 1200 dpi */ + dd->ipr[0] = 1.0/72.0; + dd->ipr[1] = 1.0/72.0; + + dd->canClip = FALSE; + dd->canHAdj = 1; /* 0, 0.5, 1 */ + dd->canChangeGamma = FALSE; + strncpy(pd->encoding, encoding, 50); + + XF_resetColors(pd); + + /* Start the driver */ + + XFig_Open(dd, pd); + + dd->close = XFig_Close; + dd->size = XFig_Size; + dd->newPage = XFig_NewPage; + dd->clip = XFig_Clip; + dd->text = XFig_Text; + dd->strWidth = XFig_StrWidth; + dd->metricInfo = XFig_MetricInfo; + dd->rect = XFig_Rect; + /* dd->path = XFig_Path; + dd->raster = XFig_Raster; + dd->cap = XFig_Cap; */ + dd->circle = XFig_Circle; + dd->line = XFig_Line; + dd->polygon = XFig_Polygon; + dd->polyline = XFig_Polyline; + /* dd->locator = XFig_Locator; + dd->mode = XFig_Mode; */ + dd->hasTextUTF8 = FALSE; + dd->useRotatedTextInContour = FALSE; /* maybe */ + dd->haveTransparency = 1; + dd->haveTransparentBg = 1; + dd->haveRaster = 1; + dd->haveCapture = 1; + dd->haveLocator = 1; + + dd->deviceSpecific = (void *) pd; + dd->displayListOn = FALSE; + return 1; +} + +static void XFig_cleanup(pDevDesc dd, XFigDesc *pd) +{ + freeDeviceFontList(pd->fonts); + freeDeviceEncList(pd->encodings); + pd->fonts = NULL; + pd->encodings = NULL; + free(dd); + free(pd); +} + + +static Rboolean XFig_Open(pDevDesc dd, XFigDesc *pd) +{ + char buf[512], *tmp; + + if (strlen(pd->filename) == 0) { + XFig_cleanup(dd, pd); + error(_("empty file name")); + return FALSE; + } else { + snprintf(buf, 512, pd->filename, pd->pageno + 1); /* page 1 to start */ + pd->psfp = R_fopen(R_ExpandFileName(buf), "w"); + } + if (!pd->psfp) { + XFig_cleanup(dd, pd); + error(_("cannot open file '%s'"), buf); + return FALSE; + } + /* assume tmpname is less than PATH_MAX */ + tmp = R_tmpnam("Rxfig", R_TempDir); + strcpy(pd->tmpname, tmp); + free(tmp); + pd->tmpfp = R_fopen(pd->tmpname, "w"); + if (!pd->tmpfp) { + fclose(pd->psfp); + XFig_cleanup(dd, pd); + error(_("cannot open file '%s'"), pd->tmpname); + return FALSE; + } + XF_FileHeader(pd->psfp, pd->papername, pd->landscape, pd->onefile); + pd->pageno = 0; + return TRUE; +} + + +static void XFig_Clip(double x0, double x1, double y0, double y1, + pDevDesc dd) +{ +} + +static void XFig_Size(double *left, double *right, + double *bottom, double *top, + pDevDesc dd) +{ + *left = dd->left; + *right = dd->right; + *bottom = dd->bottom; + *top = dd->top; +} + +#define CHUNK 10000 +static void XFig_NewPage(const pGEcontext gc, + pDevDesc dd) +{ + char buf[PATH_MAX]; + XFigDesc *pd = (XFigDesc *) dd->deviceSpecific; + + pd->pageno++; + if(pd->onefile) { + fprintf(pd->tmpfp, "#Start of page %d\n", pd->pageno); + if(pd->pageno > 1) XF_EndPage(pd->tmpfp); + } else { + char buffer[CHUNK]; + size_t nread, res; + if(pd->pageno == 1) return; + XF_FileTrailer(pd->tmpfp); + fclose(pd->tmpfp); + pd->tmpfp = R_fopen(pd->tmpname, "r"); + while(1) { + nread = fread(buffer, 1, CHUNK, pd->tmpfp); + if(nread > 0) { + res = fwrite(buffer, 1, nread, pd->psfp); + if(res != nread) error(_("write failed")); + } + if(nread < CHUNK) break; + } + fclose(pd->tmpfp); + fclose(pd->psfp); + snprintf(buf, PATH_MAX, pd->filename, pd->pageno); + pd->psfp = R_fopen(R_ExpandFileName(buf), "w"); + pd->tmpfp = R_fopen(pd->tmpname, "w"); + XF_FileHeader(pd->psfp, pd->papername, pd->landscape, pd->onefile); + XF_resetColors(pd); + } + XF_CheckAlpha(gc->fill, pd); + if(R_OPAQUE(gc->fill)) { + FILE *fp = pd->tmpfp; + int cbg = XF_SetColor(gc->fill, pd); + int ix0, iy0, ix1, iy1; + double x0 = 0.0, y0 = 0.0, x1 = 72.0 * pd->pagewidth, + y1 = 72.0 * pd->pageheight; + XFconvert(&x0, &y0, pd); XFconvert(&x1, &y1, pd); + ix0 = (int)x0; iy0 = (int)y0; ix1 = (int)x1; iy1 = (int)y1; + fprintf(fp, "2 2 "); /* Polyline */ + fprintf(fp, "%d %d ", 0, 0); /* style, thickness */ + fprintf(fp, "%d %d ", cbg, cbg); /* pen colour fill colour */ + fprintf(fp, "200 0 20 4.0 0 0 -1 0 0 "); + fprintf(fp, "%d\n", 5); /* number of points */ + fprintf(fp, "%d %d ", ix0, iy0); + fprintf(fp, "%d %d ", ix0, iy1); + fprintf(fp, "%d %d ", ix1, iy1); + fprintf(fp, "%d %d ", ix1, iy0); + fprintf(fp, "%d %d\n", ix0, iy0); + } + pd->warn_trans = FALSE; +} + +#ifdef HAVE_UNISTD_H +#include <unistd.h> +#endif + +static void XFig_Close(pDevDesc dd) +{ + char buf[CHUNK]; + size_t nread, res; + XFigDesc *pd = (XFigDesc *) dd->deviceSpecific; + + XF_FileTrailer(pd->tmpfp); + fclose(pd->tmpfp); + pd->tmpfp = R_fopen(pd->tmpname, "r"); + while(1) { + nread = fread(buf, 1, CHUNK, pd->tmpfp); + if(nread > 0) { + res = fwrite(buf, 1, nread, pd->psfp); + if(res != nread) error(_("write failed")); + } + if(nread < CHUNK) break; + } + fclose(pd->tmpfp); + unlink(pd->tmpname); + fclose(pd->psfp); + free(pd); +} + +static void XFig_Rect(double x0, double y0, double x1, double y1, + const pGEcontext gc, + pDevDesc dd) +{ + XFigDesc *pd = (XFigDesc *) dd->deviceSpecific; + FILE *fp = pd->tmpfp; + int ix0, iy0, ix1, iy1; + int cbg = XF_SetColor(gc->fill, pd), cfg = XF_SetColor(gc->col, pd), cpen, + dofill, lty = XF_SetLty(gc->lty), lwd = (int)(gc->lwd*0.833 + 0.5); + + if(lty < 0) return; + + XF_CheckAlpha(gc->col, pd); + XF_CheckAlpha(gc->fill, pd); + cpen = (R_OPAQUE(gc->col))? cfg: -1; + dofill = (R_OPAQUE(gc->fill))? 20: -1; + + XFconvert(&x0, &y0, pd); + XFconvert(&x1, &y1, pd); + ix0 = (int)x0; iy0 = (int)y0; ix1 = (int)x1; iy1 = (int)y1; + fprintf(fp, "2 2 "); /* Polyline */ + fprintf(fp, "%d %d ", lty, lwd>0?lwd:1); /* style, thickness */ + fprintf(fp, "%d %d ", cpen, cbg); /* pen colour fill colour */ + fprintf(fp, "100 0 %d ", dofill); /* depth, pen style, area fill */ + fprintf(fp, "%.2f 0 0 -1 0 0 ", 4.0*lwd); /* style value, join .... */ + fprintf(fp, "%d\n", 5); /* number of points */ + fprintf(fp, " %d %d ", ix0, iy0); + fprintf(fp, " %d %d ", ix0, iy1); + fprintf(fp, " %d %d ", ix1, iy1); + fprintf(fp, " %d %d ", ix1, iy0); + fprintf(fp, " %d %d\n", ix0, iy0); +} + +static void XFig_Circle(double x, double y, double r, + const pGEcontext gc, + pDevDesc dd) +{ + XFigDesc *pd = (XFigDesc *) dd->deviceSpecific; + FILE *fp = pd->tmpfp; + int ix, iy, ir; + int cbg = XF_SetColor(gc->fill, pd), cfg = XF_SetColor(gc->col, pd), cpen, + dofill, lty = XF_SetLty(gc->lty), lwd = (int)(gc->lwd*0.833 + 0.5); + + if(lty < 0) return; + + XF_CheckAlpha(gc->col, pd); + XF_CheckAlpha(gc->fill, pd); + cpen = (R_OPAQUE(gc->col))? cfg: -1; + dofill = (R_OPAQUE(gc->fill))? 20: -1; + + XFconvert(&x, &y, pd); + ix = (int)x; iy = (int)y; ir = (int)(16.667*r); + + fprintf(fp, "1 3 "); /* Circle + radius */ + fprintf(fp, "%d %d ", lty, lwd>0?lwd:1); /* style, thickness */ + fprintf(fp, "%d %d ", cpen, cbg); /* pen colour fill colour */ + fprintf(fp, "100 0 %d ", dofill); /* depth, pen style, area fill */ + fprintf(fp, "%.2f 1 0 ", 4.0*lwd); /* style value, direction, x, angle */ + fprintf(fp, " %d %d %d %d %d %d %d %d \n", + ix, iy, ir, ir, ix, iy, ix+ir, iy); +} + +static void XFig_Line(double x1, double y1, double x2, double y2, + const pGEcontext gc, + pDevDesc dd) +{ + XFigDesc *pd = (XFigDesc *) dd->deviceSpecific; + FILE *fp = pd->tmpfp; + int lty = XF_SetLty(gc->lty), lwd = (int)(gc->lwd*0.833 + 0.5); + + if(lty < 0) return; + + XFconvert(&x1, &y1, pd); + XFconvert(&x2, &y2, pd); + XF_CheckAlpha(gc->col, pd); + if(R_OPAQUE(gc->col)) { + fprintf(fp, "2 1 "); /* Polyline */ + fprintf(fp, "%d %d ", lty, lwd>0?lwd:1); /* style, thickness */ + fprintf(fp, "%d %d ", XF_SetColor(gc->col, pd), 7); + /* pen colour fill colour */ + fprintf(fp, "100 0 -1 "); /* depth, pen style, area fill */ + fprintf(fp, "%.2f 0 0 -1 0 0 ", 4.0*lwd); /* style value, join .... */ + fprintf(fp, "%d\n", 2); /* number of points */ + fprintf(fp, "%d %d %d %d\n", (int)x1, (int)y1, (int)x2, (int)y2); + } +} + +static void XFig_Polygon(int n, double *x, double *y, + const pGEcontext gc, + pDevDesc dd) +{ + XFigDesc *pd = (XFigDesc *) dd->deviceSpecific; + FILE *fp = pd->tmpfp; + double xx, yy; + int i; + int cbg = XF_SetColor(gc->fill, pd), cfg = XF_SetColor(gc->col, pd), cpen, + dofill, lty = XF_SetLty(gc->lty), lwd = (int)(gc->lwd*0.833 + 0.5); + + if(lty < 0) return; + + XF_CheckAlpha(gc->col, pd); + XF_CheckAlpha(gc->fill, pd); + cpen = (R_OPAQUE(gc->col))? cfg: -1; + dofill = (R_OPAQUE(gc->fill))? 20: -1; + + fprintf(fp, "2 3 "); /* Polyline */ + fprintf(fp, "%d %d ", lty, lwd>0?lwd:1); /* style, thickness */ + fprintf(fp, "%d %d ", cpen, cbg); /* pen colour fill colour */ + fprintf(fp, "100 0 %d ", dofill); /* depth, pen style, area fill */ + fprintf(fp, "%.2f 0 0 -1 0 0 ", 4.0*lwd); /* style value, join .... */ + fprintf(fp, "%d\n", n+1); /* number of points */ + /* close the path */ + for(i = 0 ; i <= n ; i++) { + xx = x[i%n]; + yy = y[i%n]; + XFconvert(&xx, &yy, pd); + fprintf(fp, " %d %d\n", (int)xx, (int)yy); + } +} + +static void XFig_Polyline(int n, double *x, double *y, + const pGEcontext gc, + pDevDesc dd) +{ + XFigDesc *pd = (XFigDesc*) dd->deviceSpecific; + FILE *fp = pd->tmpfp; + double xx, yy; + int i, lty = XF_SetLty(gc->lty), lwd = (int)(gc->lwd*0.833 + 0.5); + + XF_CheckAlpha(gc->col, pd); + if(R_OPAQUE(gc->col) && lty >= 0) { + fprintf(fp, "2 1 "); /* Polyline */ + fprintf(fp, "%d %d ", lty, lwd>0?lwd:1); /* style, thickness */ + fprintf(fp, "%d %d ", XF_SetColor(gc->col, pd), 7); /* pen colour fill colour */ + fprintf(fp, "100 0 -1 "); /* depth, pen style, area fill */ + fprintf(fp, "%.2f 0 0 -1 0 0 ", 4.0*lwd); /* style value, join .... */ + fprintf(fp, "%d\n", n); /* number of points */ + for(i = 0 ; i < n ; i++) { + xx = x[i]; + yy = y[i]; + XFconvert(&xx, &yy, pd); + fprintf(fp, " %d %d\n", (int)xx, (int)yy); + } + } +} + +static const int styles[4] = {0,2,1,3}; + +static void XFig_Text(double x, double y, const char *str, + double rot, double hadj, + const pGEcontext gc, + pDevDesc dd) +{ + XFigDesc *pd = (XFigDesc *) dd->deviceSpecific; + FILE *fp = pd->tmpfp; + int fontnum, style = gc->fontface; + double size = floor(gc->cex * gc->ps + 0.5); + const char *str1 = str; + char *buf; + + if(style < 1 || style > 5) { + warning(_("attempt to use invalid font %d replaced by font 1"), style); + style = 1; + } + if(style == 5) fontnum = 32; + else fontnum = pd->fontnum + styles[style-1]; + + /* + * xfig -international hoge.fig + * mapping multibyte(EUC only) string Times{Romani,Bold} font Only + */ + if ( mbcslocale && style != 5 ) + if (!strncmp("EUC", locale2charset(NULL), 3)) + fontnum = ((style & 1) ^ 1 ) << 1 ; + + XFconvert(&x, &y, pd); + XF_CheckAlpha(gc->col, pd); + if(R_OPAQUE(gc->col)) { + fprintf(fp, "4 %d ", (int)floor(2*hadj)); /* Text, how justified */ + fprintf(fp, "%d 100 0 ", XF_SetColor(gc->col, pd)); + /* color, depth, pen_style */ + fprintf(fp, "%d %d %.4f %d ", pd->defaultfont?-1:fontnum, (int)size, rot * DEG2RAD,pd->textspecial?6:4); + /* font pointsize angle flags (Postscript font) */ + fprintf(fp, "%d %d ", (int)(size*12), + (int)(16.667*XFig_StrWidth(str, gc, dd) +0.5)); + fprintf(fp, "%d %d ", (int)x, (int)y); + if(strcmp(pd->encoding, "none") != 0) { + /* reencode the text */ + void *cd; + const char *i_buf; char *o_buf; + size_t i_len, o_len, status; + size_t buflen = MB_LEN_MAX*strlen(str) + 1; + + cd = (void*)Riconv_open(pd->encoding, ""); + if(cd == (void*)-1) { + warning(_("unable to use encoding '%s'"), pd->encoding); + } else { + R_CheckStack2(buflen); + buf = (char *) alloca(buflen); + i_buf = (char *) str; + o_buf = buf; + i_len = strlen(str) + 1; /* including terminator */ + o_len = buflen; + status = Riconv(cd, &i_buf, &i_len, &o_buf, &o_len); + Riconv_close(cd); + if(status == (size_t)-1) + warning(_("failed in text conversion to encoding '%s'"), + pd->encoding); + else str1 = buf; + } + } + XF_WriteString(fp, str1); + fprintf(fp, "\\001\n"); + } +} + +static double XFig_StrWidth(const char *str, + const pGEcontext gc, + pDevDesc dd) +{ + XFigDesc *pd = (XFigDesc *) dd->deviceSpecific; + int face = gc->fontface; + + if(face < 1 || face > 5) face = 1; + + return floor(gc->cex * gc->ps + 0.5) * + PostScriptStringWidth((const unsigned char *)str, CE_NATIVE, + &(pd->fonts->family->fonts[face-1]->metrics), + FALSE, face, "latin1"); +} + +static void XFig_MetricInfo(int c, + const pGEcontext gc, + double* ascent, double* descent, + double* width, pDevDesc dd) +{ + XFigDesc *pd = (XFigDesc *) dd->deviceSpecific; + int face = gc->fontface; + + if(face < 1 || face > 5) face = 1; + + PostScriptMetricInfo(c, ascent, descent, width, + &(pd->fonts->family->fonts[face-1]->metrics), + face == 5, ""); + *ascent = floor(gc->cex * gc->ps + 0.5) * *ascent; + *descent = floor(gc->cex * gc->ps + 0.5) * *descent; + *width = floor(gc->cex * gc->ps + 0.5) * *width; +} + + + +/*********************************************************************** + + PDF driver also shares font handling + +************************************************************************/ + +typedef struct { + rcolorPtr raster; + int w; + int h; + Rboolean interpolate; + int nobj; /* The object number when written out */ + int nmaskobj; /* The mask object number */ +} rasterImage; + +typedef struct { + char filename[PATH_MAX]; + int open_type; + char cmd[PATH_MAX]; + + char papername[64]; /* paper name */ + int paperwidth; /* paper width in big points (1/72 in) */ + int paperheight; /* paper height in big points */ + int pageno; /* page number */ + int fileno; /* file number */ + + int maxpointsize; + + double width; /* plot width in inches */ + double height; /* plot height in inches */ + double pagewidth; /* page width in inches */ + double pageheight; /* page height in inches */ + Rboolean pagecentre; /* centre image on page? */ + Rboolean onefile; /* one file or one file per page? */ + + FILE *pdffp; /* output file */ + FILE *mainfp; + FILE *pipefp; + + /* This group of variables track the current device status. + * They should only be set by routines that emit PDF. */ + struct { + double lwd; /* line width */ + int lty; /* line type */ + R_GE_lineend lend; + R_GE_linejoin ljoin; + double lmitre; + int fontsize; /* font size in points */ + rcolor col; /* color */ + rcolor fill; /* fill color */ + rcolor bg; /* color */ + int srgb_fg, srgb_bg; /* Are stroke and fill colorspaces set? */ + } current; + + /* + * This is a record of the alpha transparency levels used during + * drawing to the device. + * Only allow 256 different alpha levels + * (because R uses 8-bit alpha channel). + * "alphas" is a record of alphas used so far (unused set to -1) + * There are separate alpha levels for stroking and filling + * (i.e., col and fill) + */ + short colAlpha[256]; + short fillAlpha[256]; + Rboolean usedAlpha; + + /* + * What version of PDF are we trying to work with? + * This is used (so far) for implementing transparency and CID fonts + * Alphas are only used if version is at least 1.4 + */ + int versionMajor; + int versionMinor; + + int nobjs; /* number of objects */ + int *pos; /* object positions */ + int max_nobjs; /* current allocation size */ + int *pageobj; /* page object numbers */ + int pagemax; + int startstream; /* position of start of current stream */ + Rboolean inText; + char title[1024]; + char colormodel[30]; + Rboolean dingbats, useKern; + Rboolean fillOddEven; /* polygon fill mode */ + Rboolean useCompression; + char tmpname[PATH_MAX]; /* used before compression */ + + /* + * Fonts and encodings used on the device + */ + type1fontlist fonts; + cidfontlist cidfonts; + encodinglist encodings; + /* + * These next two just record the default device font + */ + type1fontfamily defaultFont; + cidfontfamily defaultCIDFont; + /* Record if fonts are used */ + Rboolean fontUsed[100]; + + /* Raster images used on the device */ + rasterImage *rasters; + int numRasters; /* number in use */ + int writtenRasters; /* number written out */ + int maxRasters; /* size of array allocated */ + /* Soft masks for raster images */ + int *masks; + int numMasks; + + /* Is the device "offline" (does not write out to a file) */ + Rboolean offline; +} +PDFDesc; + +/* Macro for driver actions to check for "offline" device and bail out */ + +#define PDF_checkOffline() if (pd->offline) return + +/* Device Driver Actions */ + +static Rboolean PDF_Open(pDevDesc, PDFDesc*); +static void PDF_Circle(double x, double y, double r, + const pGEcontext gc, + pDevDesc dd); +static void PDF_Clip(double x0, double x1, double y0, double y1, + pDevDesc dd); +static void PDF_Close(pDevDesc dd); +static void PDF_Line(double x1, double y1, double x2, double y2, + const pGEcontext gc, + pDevDesc dd); +void PDF_MetricInfo(int c, + const pGEcontext gc, + double* ascent, double* descent, + double* width, pDevDesc dd); +static void PDF_NewPage(const pGEcontext gc, pDevDesc dd); +static void PDF_Polygon(int n, double *x, double *y, + const pGEcontext gc, + pDevDesc dd); +static void PDF_Polyline(int n, double *x, double *y, + const pGEcontext gc, + pDevDesc dd); +static void PDF_Rect(double x0, double y0, double x1, double y1, + const pGEcontext gc, + pDevDesc dd); +static void PDF_Path(double *x, double *y, + int npoly, int *nper, + Rboolean winding, + const pGEcontext gc, + pDevDesc dd); +static void PDF_Raster(unsigned int *raster, int w, int h, + double x, double y, double width, double height, + double rot, Rboolean interpolate, + const pGEcontext gc, pDevDesc dd); +static void PDF_Size(double *left, double *right, + double *bottom, double *top, + pDevDesc dd); +double PDF_StrWidth(const char *str, + const pGEcontext gc, + pDevDesc dd); +static void PDF_Text(double x, double y, const char *str, + double rot, double hadj, + const pGEcontext gc, + pDevDesc dd); +static double PDF_StrWidthUTF8(const char *str, + const pGEcontext gc, + pDevDesc dd); +static void PDF_TextUTF8(double x, double y, const char *str, + double rot, double hadj, + const pGEcontext gc, + pDevDesc dd); + +/*********************************************************************** + * Some stuff for recording raster images + */ +/* Detect an image by non-NULL rasters[] */ +static rasterImage* initRasterArray(int numRasters) +{ + int i; + /* why not use calloc? */ + rasterImage* rasters = malloc(numRasters*sizeof(rasterImage)); + if (rasters) { + for (i = 0; i < numRasters; i++) { + rasters[i].raster = NULL; + } + } /* else error thrown in PDFDeviceDriver */ + return rasters; +} + +/* Add a raster (by making a copy) + * Return value indicates whether the image is semi-transparent + */ +static int addRaster(rcolorPtr raster, int w, int h, + Rboolean interpolate, PDFDesc *pd) +{ + int i, alpha = 0; + rcolorPtr newRaster; + + if (pd->numRasters == pd->maxRasters) { + int new = 2*pd->maxRasters; + void *tmp; + /* Do it this way so previous pointer is retained if it fails */ + tmp = realloc(pd->masks, new*sizeof(int)); + if(!tmp) error(_("failed to increase 'maxRaster'")); + pd->masks = tmp; + tmp = realloc(pd->rasters, new*sizeof(rasterImage)); + if(!tmp) error(_("failed to increase 'maxRaster'")); + pd->rasters = tmp; + for (i = pd->maxRasters; i < new; i++) { + pd->rasters[i].raster = NULL; + pd->masks[i] = -1; + } + pd->maxRasters = new; + } + + newRaster = malloc(w*h*sizeof(rcolor)); + + if (!newRaster) + error(_("unable to allocate raster image")); + + for (i = 0; i < w*h; i++) { + newRaster[i] = raster[i]; + if (!alpha && R_ALPHA(raster[i]) < 255) alpha = 1; + } + pd->rasters[pd->numRasters].raster = newRaster; + pd->rasters[pd->numRasters].w = w; + pd->rasters[pd->numRasters].h = h; + pd->rasters[pd->numRasters].interpolate = interpolate; + pd->rasters[pd->numRasters].nobj = -1; /* not yet written out */ + pd->rasters[pd->numRasters].nmaskobj = -1; /* not yet written out */ + + /* If any of the pixels are not opaque, we need to add + * a mask as well */ + if (alpha) + pd->masks[pd->numRasters] = pd->numMasks++; + + pd->numRasters++; + + return alpha; +} + +static void killRasterArray(rasterImage *rasters, int numRasters) { + int i; + for (i = 0; i < numRasters; i++) + if (rasters[i].raster != NULL) free(rasters[i].raster); +} + +/* Detect a mask by masks[] >= 0 */ +static int* initMaskArray(int numRasters) { + int i; + int* masks = malloc(numRasters*sizeof(int)); + if (masks) { + for (i = 0; i < numRasters; i++) masks[i] = -1; + } /* else error thrown in PDFDeviceDriver */ + return masks; +} + +static void writeRasterXObject(rasterImage raster, int n, + int mask, int maskObj, PDFDesc *pd) +{ + Bytef *buf, *buf2, *p; + uLong inlen; + + if (streql(pd->colormodel, "gray")) { + inlen = raster.w * raster.h; + p = buf = Calloc(inlen, Bytef); + for(int i = 0; i < raster.w * raster.h; i++) { + double r = 0.213 * R_RED(raster.raster[i]) + + 0.715 * R_GREEN(raster.raster[i]) + + 0.072 * R_BLUE(raster.raster[i]); + *p++ = (Bytef)(r + 0.49); + } + } else { + inlen = 3 * raster.w * raster.h; + p = buf = Calloc(inlen, Bytef); + for(int i = 0; i < raster.w * raster.h; i++) { + *p++ = R_RED(raster.raster[i]); + *p++ = R_GREEN(raster.raster[i]); + *p++ = R_BLUE(raster.raster[i]); + } + } + uLong outlen = inlen; + if (pd->useCompression) { + outlen = (int)(1.001*inlen + 20); + buf2 = Calloc(outlen, Bytef); + int res = compress(buf2, &outlen, buf, inlen); + if(res != Z_OK) error("internal error %d in writeRasterXObject", res); + Free(buf); + buf = buf2; + } + fprintf(pd->pdffp, "%d 0 obj <<\n", n); + fprintf(pd->pdffp, " /Type /XObject\n"); + fprintf(pd->pdffp, " /Subtype /Image\n"); + fprintf(pd->pdffp, " /Width %d\n", raster.w); + fprintf(pd->pdffp, " /Height %d\n", raster.h); + if (streql(pd->colormodel, "gray")) + fprintf(pd->pdffp, " /ColorSpace /DeviceGray\n"); + else if (streql(pd->colormodel, "srgb")) + fprintf(pd->pdffp, " /ColorSpace 5 0 R\n"); /* sRGB */ + else + fprintf(pd->pdffp, " /ColorSpace /DeviceRGB\n"); + fprintf(pd->pdffp, " /BitsPerComponent 8\n"); + fprintf(pd->pdffp, " /Length %u\n", (unsigned) + (pd->useCompression ? outlen : 2 * outlen + 1)); + if (raster.interpolate) + fprintf(pd->pdffp, " /Interpolate true\n"); + if (pd->useCompression) + fprintf(pd->pdffp, " /Filter /FlateDecode\n"); + else + fprintf(pd->pdffp, " /Filter /ASCIIHexDecode\n"); + if (mask >= 0) + fprintf(pd->pdffp, " /SMask %d 0 R\n", maskObj); + fprintf(pd->pdffp, " >>\nstream\n"); + if (pd->useCompression) { + size_t res = fwrite(buf, 1, outlen, pd->pdffp); + if(res != outlen) error(_("write failed")); + } else { + for(int i = 0; i < outlen; i++) + fprintf(pd->pdffp, "%02x", buf[i]); + fprintf(pd->pdffp, ">\n"); + } + Free(buf); + fprintf(pd->pdffp, "endstream\nendobj\n"); +} + +static void writeMaskXObject(rasterImage raster, int n, PDFDesc *pd) +{ + Bytef *buf, *buf2, *p; + uLong inlen = raster.w * raster.h, outlen = inlen; + p = buf = Calloc(outlen, Bytef); + for(int i = 0; i < raster.w * raster.h; i++) + *p++ = R_ALPHA(raster.raster[i]); + if (pd->useCompression) { + outlen = (uLong)(1.001*inlen + 20); + buf2 = Calloc(outlen, Bytef); + int res = compress(buf2, &outlen, buf, inlen); + if(res != Z_OK) error("internal error %d in writeRasterXObject", res); + Free(buf); + buf = buf2; + } + fprintf(pd->pdffp, "%d 0 obj <<\n", n); + fprintf(pd->pdffp, " /Type /XObject\n"); + fprintf(pd->pdffp, " /Subtype /Image\n"); + fprintf(pd->pdffp, " /Width %d\n", raster.w); + fprintf(pd->pdffp, " /Height %d\n", raster.h); + /* This is not a mask but a 'soft mask' */ + fprintf(pd->pdffp, " /ColorSpace /DeviceGray\n"); + fprintf(pd->pdffp, " /BitsPerComponent 8\n"); + fprintf(pd->pdffp, " /Length %u\n", (unsigned) + (pd->useCompression ? outlen : 2 * outlen + 1)); + if (raster.interpolate) + fprintf(pd->pdffp, " /Interpolate true\n"); + if (pd->useCompression) + fprintf(pd->pdffp, " /Filter /FlateDecode\n"); + else + fprintf(pd->pdffp, " /Filter /ASCIIHexDecode\n"); + fprintf(pd->pdffp, " >>\nstream\n"); + if (pd->useCompression) { + size_t res = fwrite(buf, 1, outlen, pd->pdffp); + if(res != outlen) error(_("write failed")); + } else { + for(int i = 0; i < outlen; i++) + fprintf(pd->pdffp, "%02x", buf[i]); + fprintf(pd->pdffp, ">\n"); + } + Free(buf); + fprintf(pd->pdffp, "endstream\nendobj\n"); +} + +/*********************************************************************** + * Some stuff for fonts + */ +/* + * Add a graphics engine font family to the list of fonts used on a + * PDF device ... + * + * ... AND add the font encoding to the list of encodings used on the + * device (if necessary) + */ +/* + * Differs from addDeviceFont (used in PostScript device) + * because we do not need to immediately write font + * information to file. In PDF, the font information is + * all written at the end as part of the file footer. + */ +static Rboolean addPDFDeviceCIDfont(cidfontfamily family, + PDFDesc *pd, + int *fontIndex) +{ + Rboolean result = FALSE; + cidfontlist fontlist = addDeviceCIDFont(family, pd->cidfonts, fontIndex); + if (fontlist) { + pd->cidfonts = fontlist; + result = TRUE; + } + return result; +} + +static Rboolean addPDFDevicefont(type1fontfamily family, + PDFDesc *pd, + int *fontIndex) +{ + Rboolean result = FALSE; + type1fontlist fontlist = addDeviceFont(family, pd->fonts, fontIndex); + if (fontlist) { + int dontcare; + encodinginfo encoding = + findDeviceEncoding(family->encoding->encpath, + pd->encodings, &dontcare); + if (encoding) { + pd->fonts = fontlist; + result = TRUE; + } else { + /* + * The encoding should have been loaded when the font was loaded + */ + encoding = findEncoding(family->encoding->encpath, + pd->encodings, TRUE); + if (!encoding) { + warning(_("corrupt loaded encodings; font not added")); + } else { + encodinglist enclist = addDeviceEncoding(encoding, + pd->encodings); + if (enclist) { + pd->fonts = fontlist; + pd->encodings = enclist; + result = TRUE; + } else + warning(_("failed to record device encoding; font not added")); + } + } + } + return result; +} + +static void PDFcleanup(int stage, PDFDesc *pd) { + switch (stage) { + case 6: /* Allocated masks */ + free(pd->masks); + case 5: /* Allocated rasters */ + free(pd->rasters); + case 4: /* Allocated fonts */ + freeDeviceFontList(pd->fonts); + freeDeviceCIDFontList(pd->cidfonts); + freeDeviceEncList(pd->encodings); + pd->fonts = NULL; + pd->cidfonts = NULL; + pd->encodings = NULL; + case 3: /* Allocated pageobj */ + free(pd->pageobj); + case 2: /* Allocated pos */ + free(pd->pos); + case 1: /* Allocated PDFDesc */ + free(pd); + } +} + +Rboolean +PDFDeviceDriver(pDevDesc dd, const char *file, const char *paper, + const char *family, const char **afmpaths, + const char *encoding, + const char *bg, const char *fg, double width, double height, + double ps, int onefile, int pagecentre, + const char *title, SEXP fonts, + int versionMajor, int versionMinor, + const char *colormodel, int dingbats, int useKern, + Rboolean fillOddEven, Rboolean useCompression) +{ + /* If we need to bail out with some sort of "error" */ + /* then we must free(dd) */ + + int i, gotFont; + double xoff = 0.0, yoff = 0.0, pointsize; + rcolor setbg, setfg; + encodinginfo enc; + encodinglist enclist; + type1fontfamily font; + cidfontfamily cidfont = NULL; + + PDFDesc *pd; + + /* Check and extract the device parameters */ + + /* 'file' could be NULL */ + if(file && strlen(file) > PATH_MAX - 1) { + /* not yet created PDFcleanup(0, pd); */ + free(dd); + error(_("filename too long in %s()"), "pdf"); + } + + /* allocate new PDF device description */ + if (!(pd = (PDFDesc *) malloc(sizeof(PDFDesc)))) { + free(dd); + error(_("memory allocation problem in %s()"), "pdf"); + } + /* from here on, if need to bail out with "error", must also + free(pd) */ + + pd->versionMajor = versionMajor; + pd->versionMinor = versionMinor; + + /* This is checked at the start of every page. We typically have + three objects per page plus one or two for each raster image, + so this is an ample initial allocation. + */ + pd->max_nobjs = 2000; + pd->pos = (int *) calloc(pd->max_nobjs, sizeof(int)); + if(!pd->pos) { + PDFcleanup(1, pd); + free(dd); + error("cannot allocate pd->pos"); + } + /* This one is dynamic: initial allocation */ + pd->pagemax = 100; + pd->pageobj = (int *) calloc(pd->pagemax, sizeof(int)); + if(!pd->pageobj) { + PDFcleanup(2, pd); + free(dd); + error("cannot allocate pd->pageobj"); + } + + + /* initialize PDF device description */ + /* 'file' could be NULL */ + if (file) + strcpy(pd->filename, file); + else + strcpy(pd->filename, "nullPDF"); + strcpy(pd->papername, paper); + strncpy(pd->title, title, 1024); + memset(pd->fontUsed, 0, 100*sizeof(Rboolean)); + if (streql(colormodel, "grey")) strcpy(pd->colormodel, "gray"); + else strncpy(pd->colormodel, colormodel, 30); + pd->dingbats = (dingbats != 0); + pd->useKern = (useKern != 0); + pd->fillOddEven = fillOddEven; + pd->useCompression = useCompression; + if(useCompression && pd->versionMajor == 1 && pd->versionMinor < 2) { + pd->versionMinor = 2; + warning(_("increasing the PDF version to 1.2")); + } + + pd->width = width; + pd->height = height; + + if (file) + pd->offline = FALSE; + else + pd->offline = TRUE; + + if(strlen(encoding) > PATH_MAX - 1) { + PDFcleanup(3, pd); + free(dd); + error(_("encoding path is too long in %s()"), "pdf"); + } + /* + * Load the default encoding AS THE FIRST ENCODING FOR THIS DEVICE. + * + * encpath MUST NOT BE "default" + */ + pd->encodings = NULL; + if (!(enc = findEncoding(encoding, pd->encodings, TRUE))) + enc = addEncoding(encoding, 1); + if (enc && (enclist = addDeviceEncoding(enc, + pd->encodings))) { + pd->encodings = enclist; + } else { + PDFcleanup(3, pd); + free(dd); + error(_("failed to load default encoding")); + } + + /***************************** + * Load fonts + *****************************/ + pd->fonts = NULL; + pd->cidfonts = NULL; + + gotFont = 0; + /* + * If user specified afms then assume the font hasn't been loaded + * Could lead to redundant extra loading of a font, but not often(?) + */ + if (!strcmp(family, "User")) { + font = addDefaultFontFromAFMs(encoding, afmpaths, 0, pd->encodings); + } else { + /* + * Otherwise, family is a device-independent font family. + * One of the elements of pdfFonts(). + * NOTE this is the first font loaded on this device! + */ + /* + * Check first whether this font has been loaded + * in this R session + */ + font = findLoadedFont(family, encoding, TRUE); + cidfont = findLoadedCIDFont(family, TRUE); + if (!(font || cidfont)) { + /* + * If the font has not been loaded yet, load it. + * + * The family SHOULD be in the font database to get this far. + * (checked at R level in postscript() in postscript.R) + */ + if (isType1Font(family, PDFFonts, NULL)) { + font = addFont(family, TRUE, pd->encodings); + } else if (isCIDFont(family, PDFFonts, NULL)) { + cidfont = addCIDFont(family, TRUE); + } else { + /* + * Should NOT get here. + */ + error(_("invalid font type")); + } + } + } + if (font || cidfont) { + /* + * At this point the font is loaded, so add it to the + * device's list of fonts. + */ + if (!strcmp(family, "User") || + isType1Font(family, PDFFonts, NULL)) { + addPDFDevicefont(font, pd, &gotFont); + pd->defaultFont = pd->fonts->family; + pd->defaultCIDFont = NULL; + } else /* (isCIDFont(family, PDFFonts)) */ { + addPDFDeviceCIDfont(cidfont, pd, &gotFont); + pd->defaultFont = NULL; + pd->defaultCIDFont = pd->cidfonts->cidfamily; + } + } + if (!gotFont) { + PDFcleanup(3, pd); + free(dd); + error(_("failed to initialise default PDF font")); + } + + /* + * Load the font names sent in via the fonts arg + * NOTE that these are the font names specified at the + * R-level, NOT the translated font names. + */ + if (!isNull(fonts)) { + int i, dontcare, gotFonts = 0, nfonts = LENGTH(fonts); + for (i = 0; i < nfonts; i++) { + int index, cidindex; + const char *name = CHAR(STRING_ELT(fonts, i)); + if (findDeviceFont(name, pd->fonts, &index) || + findDeviceCIDFont(name, pd->cidfonts, &cidindex)) + gotFonts++; + else { + /* + * Check whether the font is loaded and, if not, + * load it. + */ + font = findLoadedFont(name, encoding, TRUE); + cidfont = findLoadedCIDFont(name, TRUE); + if (!(font || cidfont)) { + if (isType1Font(name, PDFFonts, NULL)) { + font = addFont(name, TRUE, pd->encodings); + } else if (isCIDFont(name, PDFFonts, NULL)) { + cidfont = addCIDFont(name, TRUE); + } else { + /* + * Should NOT get here. + */ + error(_("invalid font type")); + } + } + /* + * Once the font is loaded, add it to the device's + * list of fonts. + */ + if (font || cidfont) { + if (isType1Font(name, PDFFonts, NULL)) { + if (addPDFDevicefont(font, pd, &dontcare)) { + gotFonts++; + } + } else /* (isCIDFont(family, PDFFonts)) */ { + if (addPDFDeviceCIDfont(cidfont, pd, &dontcare)) { + gotFonts++; + } + } + } + } + } + if (gotFonts < nfonts) { + PDFcleanup(4, pd); + free(dd); + error(_("failed to initialise additional PDF fonts")); + } + } + /***************************** + * END Load fonts + *****************************/ + + pd->numRasters = pd->writtenRasters = 0; + pd->maxRasters = 64; /* dynamic */ + pd->rasters = initRasterArray(pd->maxRasters); + if (!pd->rasters) { + PDFcleanup(4, pd); + free(dd); + error(_("failed to allocate rasters")); + } + pd->numMasks = 0; + pd->masks = initMaskArray(pd->maxRasters); + if (!pd->masks) { + PDFcleanup(5, pd); + free(dd); + error(_("failed to allocate masks")); + } + + setbg = R_GE_str2col(bg); + setfg = R_GE_str2col(fg); + + /* + * Initialise all alphas to -1 + */ + pd->usedAlpha = FALSE; + for (i = 0; i < 256; i++) { + pd->colAlpha[i] = -1; + pd->fillAlpha[i] = -1; + } + + /* Deal with paper and plot size and orientation */ + + if(!strcmp(pd->papername, "Default") || + !strcmp(pd->papername, "default")) { + SEXP s = STRING_ELT(GetOption1(install("papersize")), 0); + if(s != NA_STRING && strlen(CHAR(s)) > 0) + strcpy(pd->papername, CHAR(s)); + else strcpy(pd->papername, "a4"); + } + if(!strcmp(pd->papername, "A4") || + !strcmp(pd->papername, "a4")) { + pd->pagewidth = 21.0 / 2.54; + pd->pageheight = 29.7 /2.54; + } + else if(!strcmp(pd->papername, "A4r") || + !strcmp(pd->papername, "a4r")) { + pd->pageheight = 21.0 / 2.54; + pd->pagewidth = 29.7 /2.54; + } + else if(!strcmp(pd->papername, "Letter") || + !strcmp(pd->papername, "letter") || + !strcmp(pd->papername, "US") || + !strcmp(pd->papername, "us")) { + pd->pagewidth = 8.5; + pd->pageheight = 11.0; + } + else if(!strcmp(pd->papername, "USr") || + !strcmp(pd->papername, "usr")) { + pd->pageheight = 8.5; + pd->pagewidth = 11.0; + } + else if(!strcmp(pd->papername, "Legal") || + !strcmp(pd->papername, "legal")) { + pd->pagewidth = 8.5; + pd->pageheight = 14.0; + } + else if(!strcmp(pd->papername, "Executive") || + !strcmp(pd->papername, "executive")) { + pd->pagewidth = 7.25; + pd->pageheight = 10.5; + } + else if(!strcmp(pd->papername, "special")) { + pd->pagewidth = width; + pd->pageheight = height; + } + else { + PDFcleanup(6, pd); + free(dd); + error(_("invalid paper type '%s' (pdf)"), pd->papername); + } + pd->pagecentre = pagecentre; + pd->paperwidth = (int)(72 * pd->pagewidth); + pd->paperheight = (int)(72 * pd->pageheight); + if(strcmp(pd->papername, "special")) + { + if(pd->width < 0.1 || pd->width > pd->pagewidth-0.5) + pd->width = pd->pagewidth-0.5; + if(pd->height < 0.1 || pd->height > pd->pageheight-0.5) + pd->height = pd->pageheight-0.5; + } + if(pagecentre) + { + xoff = (pd->pagewidth - pd->width)/2.0; + yoff = (pd->pageheight - pd->height)/2.0; + } else { + xoff = yoff = 0.0; + } + + pointsize = floor(ps); + if(R_TRANSPARENT(setbg) && R_TRANSPARENT(setfg)) { + PDFcleanup(6, pd); + free(dd); + error(_("invalid foreground/background color (pdf)")); + } + + pd->onefile = onefile; + pd->maxpointsize = (int)(72.0 * ((pd->pageheight > pd->pagewidth) ? + pd->pageheight : pd->pagewidth)); + pd->pageno = pd->fileno = 0; + /* Base Pointsize */ + /* Nominal Character Sizes in Pixels */ + /* Only right for 12 point font. */ + /* Max pointsize suggested by Peter Dalgaard */ + + if(pointsize < 6.0) pointsize = 6.0; + if(pointsize > pd->maxpointsize) pointsize = pd->maxpointsize; + dd->startps = pointsize; + dd->startlty = 0; + dd->startfont = 1; + dd->startfill = setbg; + dd->startcol = setfg; + dd->startgamma = 1; + + /* Set graphics parameters that must be set by device driver. */ + /* Page dimensions in points. */ + + dd->left = 72 * xoff; /* left */ + dd->right = 72 * (xoff + pd->width); /* right */ + dd->bottom = 72 * yoff; /* bottom */ + dd->top = 72 * (yoff + pd->height); /* top */ + dd->clipLeft = dd->left; dd->clipRight = dd->right; + dd->clipBottom = dd->bottom; dd->clipTop = dd->top; + + dd->cra[0] = 0.9 * pointsize; + dd->cra[1] = 1.2 * pointsize; + + /* Character Addressing Offsets */ + /* These offsets should center a single */ + /* plotting character over the plotting point. */ + /* Pure guesswork and eyeballing ... */ + + dd->xCharOffset = 0.4900; + dd->yCharOffset = 0.3333; + dd->yLineBias = 0.2; + + /* Inches per Raster Unit */ + /* 1200 dpi */ + dd->ipr[0] = 1.0/72.0; + dd->ipr[1] = 1.0/72.0; + + dd->canClip = TRUE; + dd->canHAdj = 0; + dd->canChangeGamma = FALSE; + + /* Start the driver */ + PDF_Open(dd, pd); /* errors on failure */ + + dd->close = PDF_Close; + dd->size = PDF_Size; + dd->newPage = PDF_NewPage; + dd->clip = PDF_Clip; + dd->text = PDF_Text; + dd->strWidth = PDF_StrWidth; + dd->metricInfo = PDF_MetricInfo; + dd->rect = PDF_Rect; + dd->path = PDF_Path; + dd->raster = PDF_Raster; + dd->circle = PDF_Circle; + dd->line = PDF_Line; + dd->polygon = PDF_Polygon; + dd->polyline = PDF_Polyline; + /* dd->locator = PDF_Locator; + dd->mode = PDF_Mode; */ + dd->hasTextUTF8 = TRUE; + dd->textUTF8 = PDF_TextUTF8; + dd->strWidthUTF8 = PDF_StrWidthUTF8; + dd->useRotatedTextInContour = TRUE; + dd->haveTransparency = 2; + dd->haveTransparentBg = 3; + dd->haveRaster = 2; + + dd->deviceSpecific = (void *) pd; + dd->displayListOn = FALSE; + return TRUE; +} + +/* Called at the start of a page and when clipping is reset */ +static void PDF_Invalidate(pDevDesc dd) +{ + PDFDesc *pd = (PDFDesc *) dd->deviceSpecific; + + pd->current.fontsize = -1; + pd->current.lwd = -1; + pd->current.lty = -1; + pd->current.lend = 0; + pd->current.ljoin = 0; + pd->current.lmitre = 0; + /* page starts with black as the default fill and stroke colours */ + pd->current.col = INVALID_COL; + pd->current.fill = INVALID_COL; + pd->current.bg = INVALID_COL; + pd->current.srgb_fg = pd->current.srgb_bg = 0; +} + + +/* + * Search through the alphas used so far and return + * existing index if there is one. + * Otherwise, add alpha to the list and return new index + */ +static int alphaIndex(int alpha, short *alphas) { + int i, found = 0; + for (i = 0; i < 256 && !found; i++) { + if (alphas[i] < 0) { + alphas[i] = (short) alpha; + found = 1; + } + else if (alpha == alphas[i]) + found = 1; + } + if (!found) + error(_("invalid 'alpha' value in PDF")); + return i; +} + +/* + * colAlpha graphics state parameter dictionaries are named + * /GS1 to /GS256 + * fillAlpha graphics state parameter dictionaries are named + * /GS257 to /GS512 + */ +static int colAlphaIndex(int alpha, PDFDesc *pd) { + return alphaIndex(alpha, pd->colAlpha); +} + +static int fillAlphaIndex(int alpha, PDFDesc *pd) { + return alphaIndex(alpha, pd->fillAlpha) + 256; +} + +/* + * Does the version support alpha transparency? + * As from R 2.4.0 bump the version number so it does. + */ +static void alphaVersion(PDFDesc *pd) { + if(pd->versionMajor == 1 && pd->versionMinor < 4) { + pd->versionMinor = 4; + warning(_("increasing the PDF version to 1.4")); + } + pd->usedAlpha = TRUE; +} + +/* + * Do we need to bother with semi-transparency? + */ +static int semiTransparent(int col) +{ + return !(R_OPAQUE(col) || R_TRANSPARENT(col)); +} + +static void PDF_SetLineColor(int color, pDevDesc dd) +{ + PDFDesc *pd = (PDFDesc *) dd->deviceSpecific; + + if(color != pd->current.col) { + unsigned int alpha = R_ALPHA(color); + if (0 < alpha && alpha < 255) alphaVersion(pd); + if (pd->usedAlpha) { + /* + * Apply graphics state parameter dictionary + * to set alpha + */ + fprintf(pd->pdffp, "/GS%i gs\n", colAlphaIndex(alpha, pd)); + } + if(streql(pd->colormodel, "gray")) { + double r = R_RED(color)/255.0, g = R_GREEN(color)/255.0, + b = R_BLUE(color)/255.0; + /* weights from C-9 of + http://www.faqs.org/faqs/graphics/colorspace-faq/ + Those from C-11 might be more appropriate. + */ + fprintf(pd->pdffp, "%.3f G\n", (0.213*r+0.715*g+0.072*b)); + } else if(streql(pd->colormodel, "cmyk")) { + double r = R_RED(color)/255.0, g = R_GREEN(color)/255.0, + b = R_BLUE(color)/255.0; + double c = 1.0-r, m = 1.0-g, y = 1.0-b, k = c; + k = fmin2(k, m); + k = fmin2(k, y); + if(k == 1.0) c = m = y = 0.0; + else { c = (c-k)/(1-k); m = (m-k)/(1-k); y = (y-k)/(1-k); } + fprintf(pd->pdffp, "%.3f %.3f %.3f %.3f K\n", c, m, y, k); + } else if(streql(pd->colormodel, "rgb")) { + fprintf(pd->pdffp, "%.3f %.3f %.3f RG\n", + R_RED(color)/255.0, + R_GREEN(color)/255.0, + R_BLUE(color)/255.0); + } else { + if (!streql(pd->colormodel, "srgb")) + warning(_("unknown 'colormodel', using 'srgb'")); + if (!pd->current.srgb_bg) { + fprintf(pd->pdffp, "/sRGB CS\n"); + pd->current.srgb_bg = 1; + } + fprintf(pd->pdffp, "%.3f %.3f %.3f SCN\n", + R_RED(color)/255.0, + R_GREEN(color)/255.0, + R_BLUE(color)/255.0); + } + pd->current.col = color; + } +} + +static void PDF_SetFill(int color, pDevDesc dd) +{ + PDFDesc *pd = (PDFDesc *) dd->deviceSpecific; + if(color != pd->current.fill) { + unsigned int alpha = R_ALPHA(color); + if (0 < alpha && alpha < 255) alphaVersion(pd); + if (pd->usedAlpha) { + /* + * Apply graphics state parameter dictionary + * to set alpha + */ + fprintf(pd->pdffp, "/GS%i gs\n", fillAlphaIndex(alpha, pd)); + } + if(streql(pd->colormodel, "gray")) { + double r = R_RED(color)/255.0, g = R_GREEN(color)/255.0, + b = R_BLUE(color)/255.0; + fprintf(pd->pdffp, "%.3f g\n", (0.213*r+0.715*g+0.072*b)); + } else if(streql(pd->colormodel, "cmyk")) { + double r = R_RED(color)/255.0, g = R_GREEN(color)/255.0, + b = R_BLUE(color)/255.0; + double c = 1.0-r, m = 1.0-g, y = 1.0-b, k = c; + k = fmin2(k, m); + k = fmin2(k, y); + if(k == 1.0) c = m = y = 0.0; + else { c = (c-k)/(1-k); m = (m-k)/(1-k); y = (y-k)/(1-k); } + fprintf(pd->pdffp, "%.3f %.3f %.3f %.3f k\n", c, m, y, k); + } else if(streql(pd->colormodel, "rgb")) { + fprintf(pd->pdffp, "%.3f %.3f %.3f rg\n", + R_RED(color)/255.0, + R_GREEN(color)/255.0, + R_BLUE(color)/255.0); + } else { + if (!streql(pd->colormodel, "srgb")) + warning(_("unknown 'colormodel', using 'srgb'")); + if (!pd->current.srgb_fg) { + fprintf(pd->pdffp, "/sRGB cs\n"); + pd->current.srgb_fg = 1; + } + fprintf(pd->pdffp, "%.3f %.3f %.3f scn\n", + R_RED(color)/255.0, + R_GREEN(color)/255.0, + R_BLUE(color)/255.0); + } + + pd->current.fill = color; + } +} + +static void PDFSetLineEnd(FILE *fp, R_GE_lineend lend) +{ + int lineend = 1; /* -Wall */ + switch (lend) { + case GE_ROUND_CAP: + lineend = 1; + break; + case GE_BUTT_CAP: + lineend = 0; + break; + case GE_SQUARE_CAP: + lineend = 2; + break; + default: + error(_("invalid line end")); + } + fprintf(fp, "%1d J\n", lineend); +} + +static void PDFSetLineJoin(FILE *fp, R_GE_linejoin ljoin) +{ + int linejoin = 1; /* -Wall */ + switch (ljoin) { + case GE_ROUND_JOIN: + linejoin = 1; + break; + case GE_MITRE_JOIN: + linejoin = 0; + break; + case GE_BEVEL_JOIN: + linejoin = 2; + break; + default: + error(_("invalid line join")); + } + fprintf(fp, "%1d j\n", linejoin); +} + +/* Note that the line texture is scaled by the line width.*/ +static void PDFSetLineTexture(FILE *fp, const char *dashlist, int nlty, + double lwd, int lend) +{ + PP_SetLineTexture("d", (lend == GE_BUTT_CAP) ? 0. : 1.); +} + +static void PDF_SetLineStyle(const pGEcontext gc, pDevDesc dd) +{ + PDFDesc *pd = (PDFDesc *) dd->deviceSpecific; + char dashlist[8]; + int i; + int newlty = gc->lty; + double linewidth; + double newlwd = gc->lwd; + R_GE_lineend newlend = gc->lend; + R_GE_linejoin newljoin = gc->ljoin; + double newlmitre = gc->lmitre; + + if (pd->current.lty != newlty || pd->current.lwd != newlwd || + pd->current.lend != newlend) { + pd->current.lwd = newlwd; + pd->current.lty = newlty; + linewidth = newlwd * 0.75; + /* Must not allow line width to be zero */ + if (linewidth < .01) + linewidth = .01; + fprintf(pd->pdffp, "%.2f w\n", linewidth); + /* process lty : */ + for(i = 0; i < 8 && newlty & 15 ; i++) { + dashlist[i] = newlty & 15; + newlty = newlty >> 4; + } + PDFSetLineTexture(pd->pdffp, dashlist, i, newlwd * 0.75, newlend); + } + if (pd->current.lend != newlend) { + pd->current.lend = newlend; + PDFSetLineEnd(pd->pdffp, newlend); + } + if (pd->current.ljoin != newljoin) { + pd->current.ljoin = newljoin; + PDFSetLineJoin(pd->pdffp, newljoin); + } + if (pd->current.lmitre != newlmitre) { + pd->current.lmitre = newlmitre; + fprintf(pd->pdffp, "%.2f M\n", newlmitre); + } +} + +/* This was an optimization that has effectively been disabled in + 2.8.0, to avoid repeatedly going in and out of text mode. Howver, + Acrobat puts all text rendering calls in BT...ET into a single + transparency group, and other viewers do not. So for consistent + rendering we put each text() call into a separate group. +*/ +static void texton(PDFDesc *pd) +{ + fprintf(pd->pdffp, "BT\n"); + pd->inText = TRUE; +} + +static void textoff(PDFDesc *pd) +{ + fprintf(pd->pdffp, "ET\n"); + pd->inText = FALSE; +} + +static void PDF_Encodings(PDFDesc *pd) +{ + encodinglist enclist = pd->encodings; + + while (enclist) { + encodinginfo encoding = enclist->encoding; + pd->pos[++pd->nobjs] = (int) ftell(pd->pdffp); + + fprintf(pd->pdffp, "%d 0 obj\n<<\n/Type /Encoding ", pd->nobjs); + if (strcmp(encoding->name, "WinAnsiEncoding") == 0 || + strcmp(encoding->name, "MacRomanEncoding") == 0 || + strcmp(encoding->name, "PDFDocEncoding") == 0) { + fprintf(pd->pdffp, "/BaseEncoding /%s\n", encoding->name); + fprintf(pd->pdffp, "/Differences [ 45/minus ]\n"); + } else if (strcmp(encoding->name, "ISOLatin1Encoding") == 0) { + fprintf(pd->pdffp, "/BaseEncoding /WinAnsiEncoding\n"); + fprintf(pd->pdffp, "/Differences [ 45/minus 96/quoteleft\n144/dotlessi /grave /acute /circumflex /tilde /macron /breve /dotaccent\n/dieresis /.notdef /ring /cedilla /.notdef /hungarumlaut /ogonek /caron /space]\n"); + } else { + int enc_first; + int c = 0; + int len; + char buf[128]; + for(enc_first=0;encoding->enccode[enc_first]!='[' && + encoding->enccode[enc_first]!='\0' ;enc_first++); + if (enc_first >= strlen(encoding->enccode)) + enc_first=0; + fprintf(pd->pdffp, "/BaseEncoding /PDFDocEncoding\n"); + fprintf(pd->pdffp, "/Differences [\n"); + while(encoding->enccode[enc_first]) { + switch (encoding->enccode[enc_first]) { + case ' ': + case '\t': + case '\n': + case '[': + case ']': + enc_first++; + continue; + } + for(len=0; + (encoding->enccode[enc_first+len]!=' ') && + (encoding->enccode[enc_first+len]!=']') && + (encoding->enccode[enc_first+len]!='\t') && + (encoding->enccode[enc_first+len]!='\0') && + (encoding->enccode[enc_first+len]!='\n') ; + len++); + memcpy(buf,encoding->enccode + enc_first , len); + buf[len]='\0'; + fprintf(pd->pdffp, " %d%s", c, buf); + if ( (c+1) % 8 == 0 ) fprintf(pd->pdffp, "\n"); + c++; + enc_first+=len; + } + fprintf(pd->pdffp, "\n]\n"); + } + fprintf(pd->pdffp, ">>\nendobj\n"); + + enclist = enclist->next; + } +} + +/* Read sRGB profile from icc/srgb.flate + * HexCode original from + * http://code.google.com/p/ghostscript/source/browse/trunk/gs/iccprofiles/srgb.icc + */ +#define BUFSIZE2 10000 +static void PDFwritesRGBcolorspace(PDFDesc *pd) +{ + char buf[BUFSIZE2]; + FILE *fp; + + snprintf(buf, BUFSIZE2, "%s%slibrary%sgrDevices%sicc%s%s", + R_Home, FILESEP, FILESEP, FILESEP, FILESEP, + pd->useCompression ? "srgb.flate" : "srgb"); + if (!(fp = R_fopen(R_ExpandFileName(buf), "rb"))) + error(_("failed to load sRGB colorspace file")); + size_t res = fread(buf, 1, BUFSIZE2, fp); + res = fwrite(buf, 1, res, pd->pdffp); + fclose(fp); +} + +#include <time.h> // for time_t, time, localtime +#include <Rversion.h> + +static void PDF_startfile(PDFDesc *pd) +{ + struct tm *ltm; + time_t ct; + + pd->nobjs = 0; + pd->pageno = 0; + /* + * I destroy it when I open in Japanese environment carelessly + */ + fprintf(pd->pdffp, "%%PDF-%i.%i\n%%\x81\xe2\x81\xe3\x81\xcf\x81\xd3\x5c\x72\n", + pd->versionMajor, pd->versionMinor); + pd->pos[++pd->nobjs] = (int) ftell(pd->pdffp); + + /* Object 1 is Info node. Date format is from the PDF manual */ + + ct = time(NULL); + ltm = localtime(&ct); + fprintf(pd->pdffp, + "1 0 obj\n<<\n/CreationDate (D:%04d%02d%02d%02d%02d%02d)\n", + 1900 + ltm->tm_year, ltm->tm_mon+1, ltm->tm_mday, + ltm->tm_hour, ltm->tm_min, ltm->tm_sec); + fprintf(pd->pdffp, + "/ModDate (D:%04d%02d%02d%02d%02d%02d)\n", + 1900 + ltm->tm_year, ltm->tm_mon+1, ltm->tm_mday, + ltm->tm_hour, ltm->tm_min, ltm->tm_sec); + fprintf(pd->pdffp, "/Title (%s)\n", pd->title); + fprintf(pd->pdffp, "/Producer (R %s.%s)\n/Creator (R)\n>>\nendobj\n", + R_MAJOR, R_MINOR); + + /* Object 2 is the Catalog, pointing to pages list in object 3 (at end) */ + + pd->pos[++pd->nobjs] = (int) ftell(pd->pdffp); + fprintf(pd->pdffp, "2 0 obj\n<< /Type /Catalog /Pages 3 0 R >>\nendobj\n"); + + /* Objects at the end */ + pd->nobjs += 2; + if (streql(pd->colormodel, "srgb")) pd->nobjs += 2; +} + +static const char *Base14[] = +{ + "Courier", "Courier-Oblique", "Courier-Bold", "Courier-BoldOblique", + "Helvetica", "Helvetica-Oblique", "Helvetica-Bold", + "Helvetica-BoldOblique", "Symbol", "Times-Roman", "Times-Italic", + "Times-Bold", "Times-BoldItalic", "ZapfDingbats" +}; + +static int isBase14(const char *name) +{ + int i; + for(i = 0; i < 14; i++) + if(strcmp(name, Base14[i]) == 0) return 1; + return 0; +} + +static const char *KnownSanSerif[] = +{ + "AvantGarde", "Helvetica-Narrow", "URWGothic", "NimbusSan" +}; + + +static int isSans(const char *name) +{ + int i; + for(i = 0; i < 4; i++) + if(strncmp(name, KnownSanSerif[i], strlen(KnownSanSerif[i])) == 0) + return 1; + return 0; +} + +#define boldslant(x) ((x==3)?",BoldItalic":((x==2)?",Italic":((x==1)?",Bold":""))) + +#if defined(BUFSIZ) && (BUFSIZ > 512) +/* OS's buffer size in stdio.h, probably. + Windows has 512, Solaris 1024, glibc 8192 + */ +# define APPENDBUFSIZE BUFSIZ +#else +# define APPENDBUFSIZE 512 +#endif + +static void PDF_endfile(PDFDesc *pd) +{ + int i, startxref, tempnobj, nenc, nfonts, cidnfonts, firstencobj; + int nraster, nmask; + + /* object 3 lists all the pages */ + + pd->pos[3] = (int) ftell(pd->pdffp); + fprintf(pd->pdffp, "3 0 obj\n<< /Type /Pages /Kids [ "); + for(i = 0; i < pd->pageno; i++) + fprintf(pd->pdffp, "%d 0 R ", pd->pageobj[i]); + + fprintf(pd->pdffp, + "] /Count %d /MediaBox [0 0 %d %d] >>\nendobj\n", + pd->pageno, + (int) (0.5 + pd->paperwidth), (int) (0.5 + pd->paperheight)); + + /* Object 4 is the standard resources dict for each page */ + + /* Count how many images and masks */ + nraster = pd->numRasters; + nmask = pd->numMasks; + + if(pd->nobjs + nraster + nmask + 500 >= pd->max_nobjs) { + int new = pd->nobjs + nraster + nmask + 500; + void *tmp = realloc(pd->pos, new * sizeof(int)); + if(!tmp) + error("unable to increase object limit: please shutdown the pdf device"); + pd->pos = (int *) tmp; + pd->max_nobjs = new; + } + + pd->pos[4] = (int) ftell(pd->pdffp); + + /* The resource dictionary for each page */ + /* ProcSet is regarded as obsolete as from PDF 1.4 */ + if (nraster > 0) { + if (nmask > 0) { + fprintf(pd->pdffp, + "4 0 obj\n<<\n/ProcSet [/PDF /Text /ImageC /ImageB]\n/Font <<"); + + } else { + fprintf(pd->pdffp, + "4 0 obj\n<<\n/ProcSet [/PDF /Text /ImageC]\n/Font <<"); + } + } else { + /* fonts */ + fprintf(pd->pdffp, + "4 0 obj\n<<\n/ProcSet [/PDF /Text]\n/Font <<"); + } + + /* Count how many encodings will be included: + * fonts come after encodings */ + nenc = 0; + if (pd->encodings) { + encodinglist enclist = pd->encodings; + while (enclist) { + nenc++; + enclist = enclist->next; + } + } + /* Should be a default text font at least, plus possibly others */ + tempnobj = pd->nobjs + nenc; + + /* Dingbats always F1 */ + if(pd->fontUsed[1]) fprintf(pd->pdffp, " /F1 %d 0 R ", ++tempnobj); + + nfonts = 2; + if (pd->fonts) { + type1fontlist fontlist = pd->fonts; + while (fontlist) { + for (i = 0; i < 5; i++) { + if(nfonts >= 100 || pd->fontUsed[nfonts]) { + fprintf(pd->pdffp, "/F%d %d 0 R ", nfonts, ++tempnobj); + /* Allow for the font descriptor object, if present */ + if(!isBase14(fontlist->family->fonts[i]->name)) tempnobj++; + } + nfonts++; + } + fontlist = fontlist->next; + } + } + cidnfonts = 0; + if (pd->cidfonts) { + cidfontlist fontlist = pd->cidfonts; + while (fontlist) { + for (i = 0; i < 5; i++) { + fprintf(pd->pdffp, "/F%d %d 0 R ", + 1000 + cidnfonts + 1, ++tempnobj); + cidnfonts++; + } + fontlist = fontlist->next; + } + } + fprintf(pd->pdffp, ">>\n"); + + if (nraster > 0) { + /* image XObjects */ + fprintf(pd->pdffp, "/XObject <<\n"); + for (i = 0; i < nraster; i++) { + fprintf(pd->pdffp, " /Im%d %d 0 R\n", i, pd->rasters[i].nobj); + if (pd->masks[i] >= 0) + fprintf(pd->pdffp, " /Mask%d %d 0 R\n", + pd->masks[i], pd->rasters[i].nmaskobj); + } + fprintf(pd->pdffp, ">>\n"); + } + + /* graphics state parameter dictionaries */ + fprintf(pd->pdffp, "/ExtGState << "); + for (i = 0; i < 256 && pd->colAlpha[i] >= 0; i++) + fprintf(pd->pdffp, "/GS%i %d 0 R ", i + 1, ++tempnobj); + for (i = 0; i < 256 && pd->fillAlpha[i] >= 0; i++) + fprintf(pd->pdffp, "/GS%i %d 0 R ", i + 257, ++tempnobj); + /* Special state to set AIS if we have soft masks */ + if (nmask > 0) + fprintf(pd->pdffp, "/GSais %d 0 R ", ++tempnobj); + fprintf(pd->pdffp, ">>\n"); + + if (streql(pd->colormodel, "srgb")) { + /* Objects 5 and 6 are the sRGB color space, if required */ + fprintf(pd->pdffp, "/ColorSpace << /sRGB 5 0 R >>\n"); + fprintf(pd->pdffp, ">>\nendobj\n"); + pd->pos[5] = (int) ftell(pd->pdffp); + fprintf(pd->pdffp, "5 0 obj\n[/ICCBased 6 0 R]\nendobj\n"); + pd->pos[6] = (int) ftell(pd->pdffp); + fprintf(pd->pdffp, "6 0 obj\n"); + PDFwritesRGBcolorspace(pd); + fprintf(pd->pdffp, "endobj\n"); + } else { + fprintf(pd->pdffp, ">>\nendobj\n"); + } + + if(tempnobj >= pd->max_nobjs) { + int new = tempnobj + 500; + void *tmp = realloc(pd->pos, new * sizeof(int)); + if(!tmp) + error("unable to increase object limit: please shutdown the pdf device"); + pd->pos = (int *) tmp; + pd->max_nobjs = new; + } + + /* + * Write out objects representing the encodings + */ + + firstencobj = pd->nobjs; + PDF_Encodings(pd); + + /* + * Write out objects representing the fonts + */ + + if (pd->fontUsed[1]) { + pd->pos[++pd->nobjs] = (int) ftell(pd->pdffp); + fprintf(pd->pdffp, "%d 0 obj\n<< /Type /Font /Subtype /Type1 /Name /F1 /BaseFont /ZapfDingbats >>\nendobj\n", pd->nobjs); + } + + + nfonts = 2; + if (pd->fonts) { + type1fontlist fontlist = pd->fonts; + while (fontlist) { + FontMetricInfo *metrics; + /* + * Find the index of the device encoding + * This really should be there + */ + int encIndex; + encodinginfo encoding = + findDeviceEncoding(fontlist->family->encoding->encpath, + pd->encodings, &encIndex); + if (!encoding) + error(_("corrupt encodings in PDF device")); + for (i = 0; i < 5; i++) { + if (nfonts >= 100 || pd->fontUsed[nfonts]) { + type1fontinfo fn = fontlist->family->fonts[i]; + int base = isBase14(fn->name); + metrics = &fn->metrics; + pd->pos[++pd->nobjs] = (int) ftell(pd->pdffp); + fprintf(pd->pdffp, "%d 0 obj\n<< /Type /Font /Subtype /Type1 /Name /F%d /BaseFont /%s\n", + pd->nobjs, + nfonts, + fn->name); + if (!base) { + int ii, first, last, tmp; + for(first = 1, ii = 0; ii < 255; ii++) + if(metrics->CharInfo[ii].WX != NA_SHORT) { + first = ii; + break; + } + for(last = 255, ii = 254; ii >= 0; ii--) + if(metrics->CharInfo[ii].WX != NA_SHORT) { + last = ii + 1; + break; + } + fprintf(pd->pdffp, + "/FirstChar %d /LastChar %d /Widths [\n", + first, last); + for (ii = first; ii <= last; ii++) { + tmp = metrics->CharInfo[ii].WX; + fprintf(pd->pdffp, " %d", tmp==NA_SHORT ? 0 : tmp); + if ((ii + 1) % 15 == 0) fprintf(pd->pdffp, "\n"); + } + fprintf(pd->pdffp, "]\n"); + fprintf(pd->pdffp, "/FontDescriptor %d 0 R\n", + pd->nobjs + 1); + } + if(i < 4) + fprintf(pd->pdffp, "/Encoding %d 0 R ", + /* Encodings come after dingbats font which is + * object 5 */ + encIndex + firstencobj); + fprintf(pd->pdffp, ">>\nendobj\n"); + if(!base) { + /* write font descriptor */ + int flags = 32 /*bit 6, non-symbolic*/ + + ((i==2 || i==3) ? 64/* italic */: 0) + + (metrics->IsFixedPitch > 0 ? 1 : 0) + + (isSans(fn->name) ? 0 : 2); + /* <FIXME> we have no real way to know + if this is serif or not */ + pd->pos[++pd->nobjs] = (int) ftell(pd->pdffp); + fprintf(pd->pdffp, + "%d 0 obj <<\n" + " /Type /FontDescriptor\n" + " /FontName /%s\n" + " /Flags %d\n" + " /FontBBox [%d %d %d %d]\n" + " /CapHeight %d\n /Ascent %d\n /Descent %d\n" + " /ItalicAngle %d\n /XHeight %d\n /StemV %d\n" + ">>\nendobj\n", + pd->nobjs, + fn->name, + (i == 4) ? 4 : flags, + metrics->FontBBox[0], metrics->FontBBox[1], + metrics->FontBBox[2], metrics->FontBBox[3], + metrics->CapHeight, metrics->Ascender, + metrics->Descender, + metrics->ItalicAngle, metrics->XHeight, + (metrics->StemV != NA_SHORT) ? metrics->StemV : + (i==2 || i==3) ? 140 : 83); + } + } + nfonts++; + } + fontlist = fontlist->next; + } + } + cidnfonts = 0; + if (pd->cidfonts) { + cidfontlist fontlist = pd->cidfonts; + if(pd->versionMajor == 1 && pd->versionMinor < 3) { + pd->versionMinor = 3; + warning(_("increasing the PDF version to 1.3")); + } + while (fontlist) { + for (i = 0; i < 4; i++) { + pd->pos[++pd->nobjs] = (int) ftell(pd->pdffp); + fprintf(pd->pdffp, + /** format **/ + "%d 0 obj\n" + "<<\n" + " /Type /Font\n" + " /Subtype /Type0\n" + " /Name /F%d\n" + " /BaseFont /%s%s\n" + " /DescendantFonts [\n" + " <<\n" + " /Type /Font\n" + " /Subtype /CIDFontType0\n" + " /BaseFont /%s%s\n" + " %s" + " >>\n" + " ]\n" + " /Encoding /%s\n" + ">>\n" + "endobj\n", + /** vararg **/ + pd->nobjs, /* pdf objnum */ + 1000 + cidnfonts + 1, /* - face */ + fontlist->cidfamily->cidfonts[i]->name,/* /BaseFont*/ + boldslant(i), /* - boldslant */ + fontlist->cidfamily->cidfonts[i]->name,/* /BaseFont*/ + boldslant(i), /* - boldslant */ + /* Resource */ + /* + * Pull the resource out of R object + * Hopefully one day this will be unnecessary + */ + getCIDFontPDFResource(fontlist->cidfamily->fxname), + fontlist->cidfamily->cmap /* /Encoding */ + ); + cidnfonts++; + } + /* Symbol face does not use encoding */ + pd->pos[++pd->nobjs] = (int) ftell(pd->pdffp); + fprintf(pd->pdffp, "%d 0 obj\n<<\n/Type /Font\n/Subtype /Type1\n/Name /F%d\n/BaseFont /%s\n>>\nendobj\n", + pd->nobjs, + 1000 + cidnfonts + 1, + fontlist->cidfamily->symfont->name); + cidnfonts++; + fontlist = fontlist->next; + } + } + + /* + * Write out objects representing the graphics state parameter + * dictionaries for alpha transparency + */ + for (i = 0; i < 256 && pd->colAlpha[i] >= 0; i++) { + pd->pos[++pd->nobjs] = (int) ftell(pd->pdffp); + fprintf(pd->pdffp, + "%d 0 obj\n<<\n/Type /ExtGState\n/CA %1.3f >>\nendobj\n", + pd->nobjs, pd->colAlpha[i]/255.0); + } + for (i = 0; i < 256 && pd->fillAlpha[i] >= 0; i++) { + pd->pos[++pd->nobjs] = (int) ftell(pd->pdffp); + fprintf(pd->pdffp, + "%d 0 obj\n<<\n/Type /ExtGState\n/ca %1.3f\n>>\nendobj\n", + pd->nobjs, pd->fillAlpha[i]/255.0); + } + + if (nmask > 0) { + pd->pos[++pd->nobjs] = (int) ftell(pd->pdffp); + fprintf(pd->pdffp, + "%d 0 obj\n<<\n/Type /ExtGState\n/AIS false\n>>\nendobj\n", + pd->nobjs); + } + + /* write out xref table */ + + startxref = (int) ftell(pd->pdffp); + /* items here must be exactly 20 bytes including terminator */ + fprintf(pd->pdffp, "xref\n0 %d\n", pd->nobjs+1); + fprintf(pd->pdffp, "0000000000 65535 f \n"); + for(i = 1; i <= pd->nobjs; i++) + fprintf(pd->pdffp, "%010d 00000 n \n", pd->pos[i]); + fprintf(pd->pdffp, + "trailer\n<< /Size %d /Info 1 0 R /Root 2 0 R >>\nstartxref\n%d\n", + pd->nobjs+1, startxref); + fprintf(pd->pdffp, "%%%%EOF\n"); + + /* now seek back and update the header */ + rewind(pd->pdffp); + fprintf(pd->pdffp, "%%PDF-%i.%i\n", pd->versionMajor, pd->versionMinor); + fclose(pd->pdffp); + if (pd->open_type == 1) { + char buf[APPENDBUFSIZE]; + size_t nc; + pd->pdffp = R_fopen(pd->filename, "rb"); + while((nc = fread(buf, 1, APPENDBUFSIZE, pd->pdffp))) { + if(nc != fwrite(buf, 1, nc, pd->pipefp)) + error("write error"); + if (nc < APPENDBUFSIZE) break; + } + fclose(pd->pdffp); + pclose(pd->pipefp); + unlink(pd->filename); + } +} + + +static Rboolean PDF_Open(pDevDesc dd, PDFDesc *pd) +{ + char buf[512]; + + if (pd->offline) + return TRUE; + + if (pd->filename[0] == '|') { + strncpy(pd->cmd, pd->filename + 1, PATH_MAX); + char *tmp = R_tmpnam("Rpdf", R_TempDir); + strncpy(pd->filename, tmp, PATH_MAX); + free(tmp); + errno = 0; + pd->pipefp = R_popen(pd->cmd, "w"); + if (!pd->pipefp || errno != 0) { + PDFcleanup(6, pd); + error(_("cannot open 'pdf' pipe to '%s'"), pd->cmd); + return FALSE; + } + pd->open_type = 1; + if (!pd->onefile) { + pd->onefile = TRUE; + warning(_("file = \"|cmd\" implies 'onefile = TRUE'")); + } + } else pd->open_type = 0; + snprintf(buf, 512, pd->filename, pd->fileno + 1); /* file 1 to start */ + /* NB: this must be binary to get tell positions and line endings right, + as well as allowing binary streams */ + pd->mainfp = R_fopen(R_ExpandFileName(buf), "wb"); + if (!pd->mainfp) { + PDFcleanup(6, pd); + free(dd); + error(_("cannot open file '%s'"), buf); + } + pd->pdffp = pd->mainfp; + + PDF_startfile(pd); + return TRUE; +} + +static void pdfClip(double x0, double x1, double y0, double y1, PDFDesc *pd) +{ + if(x0 != 0.0 || y0 != 0.0 || x1 != 72*pd->width || y1 != 72*pd->height) + fprintf(pd->pdffp, "Q q %.2f %.2f %.2f %.2f re W n\n", + x0, y0, x1 - x0, y1 - y0); + else fprintf(pd->pdffp, "Q q\n"); +} + +static void PDF_Clip(double x0, double x1, double y0, double y1, pDevDesc dd) +{ + PDFDesc *pd = (PDFDesc *) dd->deviceSpecific; + + PDF_checkOffline(); + + if(pd->inText) textoff(pd); + pdfClip(x0, x1, y0, y1, pd); + PDF_Invalidate(dd); +} + +static void PDF_Size(double *left, double *right, + double *bottom, double *top, + pDevDesc dd) +{ + *left = dd->left; + *right = dd->right; + *bottom = dd->bottom; + *top = dd->top; +} + +static void PDF_endpage(PDFDesc *pd) +{ + if(pd->inText) textoff(pd); + fprintf(pd->pdffp, "Q\n"); + if (pd->useCompression) { + fflush(pd->pdffp); + fseek(pd->pdffp, 0, SEEK_END); + unsigned int len = (unsigned int) ftell(pd->pdffp); + fseek(pd->pdffp, 0, SEEK_SET); + Bytef *buf = Calloc(len, Bytef); + uLong outlen = (uLong)(1.001*len + 20); + Bytef *buf2 = Calloc(outlen, Bytef); + size_t res = fread(buf, 1, len, pd->pdffp); + if (res < len) error("internal read error in PDF_endpage"); + fclose(pd->pdffp); + unlink(pd->tmpname); + pd->pdffp = pd->mainfp; + int res2 = compress(buf2, &outlen, buf, len); + if(res2 != Z_OK) + error("internal compression error %d in PDF_endpage", res2); + fprintf(pd->pdffp, "%d 0 obj\n<<\n/Length %d /Filter /FlateDecode\n>>\nstream\n", + pd->nobjs, (int) outlen); + size_t nwrite = fwrite(buf2, 1, outlen, pd->pdffp); + if(nwrite != outlen) error(_("write failed")); + Free(buf); Free(buf2); + fprintf(pd->pdffp, "endstream\nendobj\n"); + } else { + int here = (int) ftell(pd->pdffp); + fprintf(pd->pdffp, "endstream\nendobj\n"); + pd->pos[++pd->nobjs] = (int) ftell(pd->pdffp); + fprintf(pd->pdffp, "%d 0 obj\n%d\nendobj\n", pd->nobjs, + here - pd->startstream); + } + + if(pd->nobjs + 2*(pd->numRasters-pd->writtenRasters) + 500 + >= pd->max_nobjs) { + int new = pd->nobjs + 2*(pd->numRasters-pd->writtenRasters) + 2000; + void *tmp = realloc(pd->pos, new * sizeof(int)); + if(!tmp) + error("unable to increase object limit: please shutdown the pdf device"); + pd->pos = (int *) tmp; + pd->max_nobjs = new; + } + + /* Write out any new rasters */ + for (int i = pd->writtenRasters; i < pd->numRasters; i++) { + pd->pos[++pd->nobjs] = (int) ftell(pd->pdffp); + pd->rasters[i].nobj = pd->nobjs; + writeRasterXObject(pd->rasters[i], pd->nobjs, + pd->masks[i], pd->nobjs+1, pd); + if (pd->masks[i] >= 0) { + pd->pos[++pd->nobjs] = (int) ftell(pd->pdffp); + pd->rasters[i].nmaskobj = pd->nobjs; + writeMaskXObject(pd->rasters[i], pd->nobjs, pd); + } + free(pd->rasters[i].raster); + pd->rasters[i].raster = NULL; + pd->writtenRasters = pd->numRasters; + } +} + +#define R_VIS(col) (R_ALPHA(col) > 0) + +static void PDF_NewPage(const pGEcontext gc, + pDevDesc dd) +{ + PDFDesc *pd = (PDFDesc *) dd->deviceSpecific; + char buf[512]; + + PDF_checkOffline(); + + if(pd->pageno >= pd->pagemax) { + void * tmp = realloc(pd->pageobj, 2*pd->pagemax * sizeof(int)); + if(!tmp) + error("unable to increase page limit: please shutdown the pdf device"); + pd->pageobj = (int *) tmp; + pd->pagemax *= 2; + } + if(pd->nobjs + 500 >= pd->max_nobjs) { + int new = pd->max_nobjs + 2000; + void *tmp = realloc(pd->pos, new * sizeof(int)); + if(!tmp) + error("unable to increase object limit: please shutdown the pdf device"); + pd->pos = (int *) tmp; + pd->max_nobjs = new; + } + + + if(pd->pageno > 0) { + PDF_endpage(pd); + if(!pd->onefile) { + PDF_endfile(pd); + pd->fileno++; + snprintf(buf, 512, pd->filename, pd->fileno + 1); /* file 1 to start */ + pd->mainfp = R_fopen(R_ExpandFileName(buf), "wb"); + if (!pd->mainfp) + error(_("cannot open 'pdf' file argument '%s'\n please shut down the PDF device"), buf); + pd->pdffp = pd->mainfp; + PDF_startfile(pd); + } + } + + pd->pos[++pd->nobjs] = (int) ftell(pd->pdffp); + pd->pageobj[pd->pageno++] = pd->nobjs; + fprintf(pd->pdffp, "%d 0 obj\n<< /Type /Page /Parent 3 0 R /Contents %d 0 R /Resources 4 0 R >>\nendobj\n", + pd->nobjs, pd->nobjs+1); + pd->pos[++pd->nobjs] = (int) ftell(pd->pdffp); + if (pd->useCompression) { + char *tmp = R_tmpnam("pdf", R_TempDir); + /* assume tmpname is less than PATH_MAX */ + strcpy(pd->tmpname, tmp); + pd->pdffp = fopen(tmp, "w+b"); + if (! pd->pdffp) { + pd->pdffp = pd->mainfp; + pd->useCompression = 0; + warning(_("Cannot open temporary file '%s' for compression (reason: %s); compression has been turned off for this device"), + tmp, strerror(errno)); + } + free(tmp); + } + /* May have turned compression off in previous block */ + if (!pd->useCompression) { + fprintf(pd->pdffp, "%d 0 obj\n<<\n/Length %d 0 R\n>>\nstream\n", + pd->nobjs, pd->nobjs + 1); + pd->startstream = (int) ftell(pd->pdffp); + } + + /* + * Line end/join/mitre now controlled by user + * Same old defaults + * .. but they are still needed because SetXXX produces the corresponding + * command only if the value changes - so we have to define base defaults + * according to the values reset by Invalidate. I'm pretty sure about j/J + * but not so about M because Invalidate uses 0 yet the default used to be + * 10. + * + * fprintf(pd->pdffp, "1 J 1 j 10 M q\n"); + */ + fprintf(pd->pdffp, "1 J 1 j q\n"); + PDF_Invalidate(dd); + if(R_VIS(gc->fill)) { + PDF_SetFill(gc->fill, dd); + fprintf(pd->pdffp, "0 0 %.2f %.2f re f\n", + 72.0 * pd->width, 72.0 * pd->height); + } + pd->inText = FALSE; +} + +static void PDF_Close(pDevDesc dd) +{ + PDFDesc *pd = (PDFDesc *) dd->deviceSpecific; + + if (!pd->offline) { + if(pd->pageno > 0) PDF_endpage(pd); + PDF_endfile(pd); + /* may no longer be needed */ + killRasterArray(pd->rasters, pd->maxRasters); + } + PDFcleanup(6, pd); /* which frees masks and rasters */ +} + +static void PDF_Rect(double x0, double y0, double x1, double y1, + const pGEcontext gc, + pDevDesc dd) +{ + PDFDesc *pd = (PDFDesc *) dd->deviceSpecific; + int code; + + PDF_checkOffline(); + + code = 2 * (R_VIS(gc->fill)) + (R_VIS(gc->col)); + if (code) { + if(pd->inText) textoff(pd); + if(code & 2) + PDF_SetFill(gc->fill, dd); + if(code & 1) { + PDF_SetLineColor(gc->col, dd); + PDF_SetLineStyle(gc, dd); + } + fprintf(pd->pdffp, "%.2f %.2f %.2f %.2f re", x0, y0, x1-x0, y1-y0); + switch(code) { + case 1: fprintf(pd->pdffp, " S\n"); break; + case 2: fprintf(pd->pdffp, " f\n"); break; + case 3: fprintf(pd->pdffp, " B\n"); break; + } + } +} + +#ifdef SIMPLE_RASTER +/* Maybe reincoporate this simpler approach as an alternative + * (for opaque raster images) because it has the advantage of + * NOT keeping the raster in memory until the PDF file is complete + */ +static void PDF_Raster(unsigned int *raster, + int w, int h, + double x, double y, + double width, double height, + double rot, Rboolean interpolate, + const pGEcontext gc, pDevDesc dd) +{ + PDFDesc *pd = (PDFDesc *) dd->deviceSpecific; + double angle, cosa, sina; + + PDF_checkOffline(); + + /* This takes the simple approach of creating an inline + * image. This is not recommended for larger images + * because it makes more work for the PDF viewer. + * It also does not allow for semitransparent images. + */ + if(pd->inText) textoff(pd); + /* Save graphics state */ + fprintf(pd->pdffp, "q\n"); + /* translate */ + fprintf(pd->pdffp, + "1 0 0 1 %.2f %.2f cm\n", + x, y); + /* rotate */ + angle = rot*M_PI/180; + cosa = cos(angle); + sina = sin(angle); + fprintf(pd->pdffp, + "%.2f %.2f %.2f %.2f 0 0 cm\n", + cosa, sina, -sina, cosa); + /* scale */ + fprintf(pd->pdffp, + "%.2f 0 0 %.2f 0 0 cm\n", + width, height); + /* Begin image */ + fprintf(pd->pdffp, "BI\n"); + /* Image characteristics */ + /* Use ASCIIHexDecode filter for now, just because + * it's easier to implement */ + fprintf(pd->pdffp, + " /W %d\n /H %d\n /CS /RGB\n /BPC 8\n /F [/AHx]\n", + w, h); + if (interpolate) { + fprintf(pd->pdffp, " /I true\n"); + } + /* Begin image data */ + fprintf(pd->pdffp, "ID\n"); + /* The image stream */ + PDF_imagedata(raster, w, h, pd); + /* End image */ + fprintf(pd->pdffp, "EI\n"); + /* Restore graphics state */ + fprintf(pd->pdffp, "Q\n"); +} +#else + +static void PDF_Raster(unsigned int *raster, + int w, int h, + double x, double y, + double width, double height, + double rot, Rboolean interpolate, + const pGEcontext gc, pDevDesc dd) +{ + PDFDesc *pd = (PDFDesc *) dd->deviceSpecific; + double angle, cosa, sina; + int alpha; + + PDF_checkOffline(); + + /* Record the raster so can write it out when page is finished */ + alpha = addRaster(raster, w, h, interpolate, pd); + + if(pd->inText) textoff(pd); + /* Save graphics state */ + fprintf(pd->pdffp, "q\n"); + /* Need to set AIS graphics state parameter ? */ + if (alpha) fprintf(pd->pdffp, "/GSais gs\n"); + /* translate */ + fprintf(pd->pdffp, + "1 0 0 1 %.2f %.2f cm\n", + x, y); + /* rotate */ + angle = rot*M_PI/180; + cosa = cos(angle); + sina = sin(angle); + fprintf(pd->pdffp, + "%.2f %.2f %.2f %.2f 0 0 cm\n", + cosa, sina, -sina, cosa); + /* scale */ + fprintf(pd->pdffp, + "%.2f 0 0 %.2f 0 0 cm\n", + width, height); + /* Refer to XObject which will be written to file when page is finished */ + fprintf(pd->pdffp, "/Im%d Do\n", pd->numRasters - 1); + /* Restore graphics state */ + fprintf(pd->pdffp, "Q\n"); +} + +#endif + +/* r is in device coords */ +static void PDF_Circle(double x, double y, double r, + const pGEcontext gc, + pDevDesc dd) +{ + PDFDesc *pd = (PDFDesc *) dd->deviceSpecific; + int code, tr; + double xx, yy, a; + + PDF_checkOffline(); + + if (r <= 0.0) return; /* since PR#14797 use 0-sized pch=1, but now + GECircle omits such circles */ + + code = 2 * (R_VIS(gc->fill)) + (R_VIS(gc->col)); + if (code) { + if(code & 2) + PDF_SetFill(gc->fill, dd); + if(code & 1) { + PDF_SetLineColor(gc->col, dd); + PDF_SetLineStyle(gc, dd); + } + } + if (code) { + if (semiTransparent(gc->col) || semiTransparent(gc->fill) + || r > 10 || !pd->dingbats) { + /* + * Due to possible bug in Acrobat Reader for rendering + * semi-transparent text, only ever draw Bezier curves + * regardless of circle size. Otherwise use font up to 20pt + */ + { + /* Use four Bezier curves, hand-fitted to quadrants */ + double s = 0.55 * r; + if(pd->inText) textoff(pd); + fprintf(pd->pdffp, " %.2f %.2f m\n", x - r, y); + fprintf(pd->pdffp, " %.2f %.2f %.2f %.2f %.2f %.2f c\n", + x - r, y + s, x - s, y + r, x, y + r); + fprintf(pd->pdffp, " %.2f %.2f %.2f %.2f %.2f %.2f c\n", + x + s, y + r, x + r, y + s, x + r, y); + fprintf(pd->pdffp, " %.2f %.2f %.2f %.2f %.2f %.2f c\n", + x + r, y - s, x + s, y - r, x, y - r); + fprintf(pd->pdffp, " %.2f %.2f %.2f %.2f %.2f %.2f c\n", + x - s, y - r, x - r, y - s, x - r, y); + switch(code) { + case 1: fprintf(pd->pdffp, "S\n"); break; + case 2: fprintf(pd->pdffp, "f\n"); break; + case 3: fprintf(pd->pdffp, "B\n"); break; + } + } + } else { + pd->fontUsed[1] = TRUE; + /* Use char 108 in Dingbats, which is a solid disc + afm is C 108 ; WX 791 ; N a71 ; B 35 -14 757 708 ; + so diameter = 0.722 * size + centre = (0.396, 0.347) * size + */ + a = 2./0.722 * r; + if (a < 0.01) return; // avoid 0 dims below. + xx = x - 0.396*a; + yy = y - 0.347*a; + tr = (R_OPAQUE(gc->fill)) + + 2 * (R_OPAQUE(gc->col)) - 1; + if(!pd->inText) texton(pd); + fprintf(pd->pdffp, + "/F1 1 Tf %d Tr %.2f 0 0 %.2f %.2f %.2f Tm", + tr, a, a, xx, yy); + fprintf(pd->pdffp, " (l) Tj 0 Tr\n"); + textoff(pd); /* added in 2.8.0 */ + } + } +} + +static void PDF_Line(double x1, double y1, double x2, double y2, + const pGEcontext gc, + pDevDesc dd) +{ + PDFDesc *pd = (PDFDesc *) dd->deviceSpecific; + + PDF_checkOffline(); + + if(!R_VIS(gc->col)) return; + + PDF_SetLineColor(gc->col, dd); + PDF_SetLineStyle(gc, dd); + if(pd->inText) textoff(pd); + fprintf(pd->pdffp, "%.2f %.2f m %.2f %.2f l S\n", x1, y1, x2, y2); +} + +static void PDF_Polygon(int n, double *x, double *y, + const pGEcontext gc, + pDevDesc dd) +{ + PDFDesc *pd = (PDFDesc *) dd->deviceSpecific; + double xx, yy; + int i, code; + + PDF_checkOffline(); + + code = 2 * (R_VIS(gc->fill)) + (R_VIS(gc->col)); + if (code) { + if(pd->inText) textoff(pd); + if(code & 2) + PDF_SetFill(gc->fill, dd); + if(code & 1) { + PDF_SetLineColor(gc->col, dd); + PDF_SetLineStyle(gc, dd); + } + xx = x[0]; + yy = y[0]; + fprintf(pd->pdffp, "%.2f %.2f m\n", xx, yy); + for(i = 1 ; i < n ; i++) { + xx = x[i]; + yy = y[i]; + fprintf(pd->pdffp, "%.2f %.2f l\n", xx, yy); + } + if (pd->fillOddEven) { + switch(code) { + case 1: fprintf(pd->pdffp, "s\n"); break; + case 2: fprintf(pd->pdffp, "h f*\n"); break; + case 3: fprintf(pd->pdffp, "b*\n"); break; + } + } else { + switch(code) { + case 1: fprintf(pd->pdffp, "s\n"); break; + case 2: fprintf(pd->pdffp, "h f\n"); break; + case 3: fprintf(pd->pdffp, "b\n"); break; + } + } + } +} + +static void PDF_Path(double *x, double *y, + int npoly, int *nper, + Rboolean winding, + const pGEcontext gc, + pDevDesc dd) +{ + PDFDesc *pd = (PDFDesc *) dd->deviceSpecific; + double xx, yy; + int i, j, index, code; + + PDF_checkOffline(); + + code = 2 * (R_VIS(gc->fill)) + (R_VIS(gc->col)); + if (code) { + if(pd->inText) textoff(pd); + if(code & 2) + PDF_SetFill(gc->fill, dd); + if(code & 1) { + PDF_SetLineColor(gc->col, dd); + PDF_SetLineStyle(gc, dd); + } + index = 0; + for (i=0; i < npoly; i++) { + xx = x[index]; + yy = y[index]; + index++; + fprintf(pd->pdffp, "%.2f %.2f m\n", xx, yy); + for(j=1; j < nper[i]; j++) { + xx = x[index]; + yy = y[index]; + index++; + fprintf(pd->pdffp, "%.2f %.2f l\n", xx, yy); + } + if (i < npoly - 1) + fprintf(pd->pdffp, "h\n"); + } + if (winding) { + switch(code) { + case 1: fprintf(pd->pdffp, "s\n"); break; + case 2: fprintf(pd->pdffp, "h f\n"); break; + case 3: fprintf(pd->pdffp, "b\n"); break; + } + } else { + switch(code) { + case 1: fprintf(pd->pdffp, "s\n"); break; + case 2: fprintf(pd->pdffp, "h f*\n"); break; + case 3: fprintf(pd->pdffp, "b*\n"); break; + } + } + } +} + +static void PDF_Polyline(int n, double *x, double *y, + const pGEcontext gc, + pDevDesc dd) +{ + PDFDesc *pd = (PDFDesc*) dd->deviceSpecific; + double xx, yy; + int i; + + PDF_checkOffline(); + + if(pd->inText) textoff(pd); + if(R_VIS(gc->col)) { + PDF_SetLineColor(gc->col, dd); + PDF_SetLineStyle(gc, dd); + xx = x[0]; + yy = y[0]; + fprintf(pd->pdffp, "%.2f %.2f m\n", xx, yy); + for(i = 1 ; i < n ; i++) { + xx = x[i]; + yy = y[i]; + fprintf(pd->pdffp, "%.2f %.2f l\n", xx, yy); + } + fprintf(pd->pdffp, "S\n"); + } +} + +static int PDFfontNumber(const char *family, int face, PDFDesc *pd) +{ + /* DingBats is font 1 */ + int num = 1; + + if (strlen(family) > 0) { + int fontIndex, cidfontIndex; + /* + * Try to find font in already loaded fonts + */ + type1fontfamily fontfamily = findDeviceFont(family, pd->fonts, + &fontIndex); + cidfontfamily cidfontfamily = findDeviceCIDFont(family, pd->cidfonts, + &cidfontIndex); + if (fontfamily) + num = (fontIndex - 1)*5 + 1 + face; + else if (cidfontfamily) + /* + * Use very high font number for CID fonts to avoid + * Type 1 fonts + */ + num = 1000 + (cidfontIndex - 1)*5 + face; + else { + /* + * Check whether the font is loaded and, if not, + * load it. + */ + fontfamily = findLoadedFont(family, + pd->encodings->encoding->encpath, + TRUE); + cidfontfamily = findLoadedCIDFont(family, TRUE); + if (!(fontfamily || cidfontfamily)) { + if (isType1Font(family, PDFFonts, NULL)) { + fontfamily = addFont(family, TRUE, pd->encodings); + } else if (isCIDFont(family, PDFFonts, NULL)) { + cidfontfamily = addCIDFont(family, TRUE); + } else { + /* + * Should NOT get here. + */ + error(_("invalid font type")); + } + } + /* + * Once the font is loaded, add it to the device's + * list of fonts. + */ + if (fontfamily || cidfontfamily) { + if (isType1Font(family, PDFFonts, NULL)) { + if (addPDFDevicefont(fontfamily, pd, &fontIndex)) { + num = (fontIndex - 1)*5 + 1 + face; + } else { + fontfamily = NULL; + } + } else /* (isCIDFont(family, PDFFonts)) */ { + if (addPDFDeviceCIDfont(cidfontfamily, pd, + &cidfontIndex)) { + num = 1000 + (cidfontIndex - 1)*5 + face; + } else { + cidfontfamily = NULL; + } + } + } + } + if (!(fontfamily || cidfontfamily)) + error(_("failed to find or load PDF font")); + } else { + if (isType1Font(family, PDFFonts, pd->defaultFont)) + num = 1 + face; + else + num = 1000 + face; + } + if(num < 100) pd->fontUsed[num] = TRUE; + return num; +} + +/* added for 2.9.0 (donated by Ei-ji Nakama) : */ +static void PDFWriteT1KerningString(FILE *fp, const char *str, + FontMetricInfo *metrics, + const pGEcontext gc) +{ + unsigned char p1, p2; + size_t i, n; + int j, ary_buf[128], *ary; + Rboolean haveKerning = FALSE; + + n = strlen(str); + if (n < 1) return; + if(n > sizeof(ary_buf)/sizeof(int)) + ary = Calloc(n, int); + else ary = ary_buf; + + for(i = 0; i < n-1; i++) { + ary[i] = 0.; + p1 = str[i]; + p2 = str[i+1]; +#ifdef USE_HYPHEN + if (p1 == '-' && !isdigit((int)p2)) + p1 = (unsigned char)PS_hyphen; +#endif + for (j = metrics->KPstart[p1]; j < metrics->KPend[p1]; j++) + if(metrics->KernPairs[j].c2 == p2 && + metrics->KernPairs[j].c1 == p1) { + ary[i] += metrics->KernPairs[j].kern; + haveKerning = TRUE; + break; + } + } + ary[i] = 0; + if(haveKerning) { + fputc('[', fp); fputc('(', fp); + for(i = 0; str[i]; i++) { + switch(str[i]) { + case '\n': + fprintf(fp, "\\n"); + break; + case '\\': + fprintf(fp, "\\\\"); + break; + case '-': +#ifdef USE_HYPHEN + if (!isdigit((int)str[i+1])) + fputc(PS_hyphen, fp); + else +#endif + fputc(str[i], fp); + break; + case '(': + case ')': + fprintf(fp, "\\%c", str[i]); + break; + default: + fputc(str[i], fp); + break; + } + if( ary[i] != 0 && str[i+1] ) fprintf(fp, ") %d (", -ary[i]); + } + fprintf(fp, ")] TJ\n"); + } else { + PostScriptWriteString(fp, str, strlen(str)); + fprintf(fp, " Tj\n"); + } + + if(ary != ary_buf) Free(ary); +} + +static FontMetricInfo *PDFmetricInfo(const char *, int, PDFDesc *); +static void PDFSimpleText(double x, double y, const char *str, + double rot, double hadj, + int font, + const pGEcontext gc, + pDevDesc dd) { + PDFDesc *pd = (PDFDesc *) dd->deviceSpecific; + int size = (int)floor(gc->cex * gc->ps + 0.5); + int face = gc->fontface; + double a, b, bm, rot1; + + if(!R_VIS(gc->col) || size <= 0) return; + + if(face < 1 || face > 5) { + warning(_("attempt to use invalid font %d replaced by font 1"), face); + face = 1; + } + rot1 = rot * DEG2RAD; + a = size * cos(rot1); + b = size * sin(rot1); + bm = -b; + /* avoid printing -0.00 on rotated text */ + if(fabs(a) < 0.01) a = 0.0; + if(fabs(b) < 0.01) {b = 0.0; bm = 0.0;} + if(!pd->inText) texton(pd); + PDF_SetFill(gc->col, dd); + fprintf(pd->pdffp, "/F%d 1 Tf %.2f %.2f %.2f %.2f %.2f %.2f Tm ", + font, + a, b, bm, a, x, y); + if (pd->useKern && + isType1Font(gc->fontfamily, PDFFonts, pd->defaultFont)) { + PDFWriteT1KerningString(pd->pdffp, str, + PDFmetricInfo(gc->fontfamily, face, pd), gc); + } else { + PostScriptWriteString(pd->pdffp, str, strlen(str)); + fprintf(pd->pdffp, " Tj\n"); + } + textoff(pd); /* added in 2.8.0 */ +} + +static char *PDFconvname(const char *family, PDFDesc *pd); + +static void PDF_Text0(double x, double y, const char *str, int enc, + double rot, double hadj, + const pGEcontext gc, + pDevDesc dd) +{ + PDFDesc *pd = (PDFDesc *) dd->deviceSpecific; + int size = (int) floor(gc->cex * gc->ps + 0.5); + int face = gc->fontface; + double a, b, bm, rot1; + char *buff; + const char *str1; + + PDF_checkOffline(); + + if(!R_VIS(gc->col) || size <= 0) return; + + if(face < 1 || face > 5) { + warning(_("attempt to use invalid font %d replaced by font 1"), face); + face = 1; + } + if (face == 5) { + PDFSimpleText(x, y, str, rot, hadj, + PDFfontNumber(gc->fontfamily, face, pd), + gc, dd); + return; + } + + rot1 = rot * DEG2RAD; + a = size * cos(rot1); + b = size * sin(rot1); + bm = -b; + /* avoid printing -0.00 on rotated text */ + if(fabs(a) < 0.01) a = 0.0; + if(fabs(b) < 0.01) {b = 0.0; bm = 0.0;} + if(!pd->inText) texton(pd); + + if(isCIDFont(gc->fontfamily, PDFFonts, pd->defaultCIDFont) && face != 5) { + /* NB we could be in a SBCS here */ + size_t ucslen; + unsigned char *p; + int fontIndex; + + /* + * CID convert optimize PDF encoding == locale encode case + */ + cidfontfamily cidfont = findDeviceCIDFont(gc->fontfamily, + pd->cidfonts, + &fontIndex); + if (!cidfont) { + int dontcare; + /* + * Try to load the font + */ + cidfont = addCIDFont(gc->fontfamily, 1); + if (cidfont) { + if (!addPDFDeviceCIDfont(cidfont, pd, &dontcare)) { + cidfont = NULL; + } + } + } + if (!cidfont) + error(_("failed to find or load PDF CID font")); + if(!dd->hasTextUTF8 && + !strcmp(locale2charset(NULL), cidfont->encoding)) { + PDF_SetFill(gc->col, dd); + fprintf(pd->pdffp, + "/F%d 1 Tf %.2f %.2f %.2f %.2f %.2f %.2f Tm ", + PDFfontNumber(gc->fontfamily, face, pd), + a, b, bm, a, x, y); + + fprintf(pd->pdffp, "<"); + p = (unsigned char *) str; + while(*p) + fprintf(pd->pdffp, "%02x", *p++); + fprintf(pd->pdffp, ">"); + fprintf(pd->pdffp, " Tj\n"); + return; + } + + /* + * CID convert PDF encoding != locale encode case + */ + ucslen = (dd->hasTextUTF8) ? Rf_utf8towcs(NULL, str, 0): mbstowcs(NULL, str, 0); + if (ucslen != (size_t)-1) { + void *cd; + const char *i_buf; char *o_buf; + size_t i, nb, i_len, o_len, buflen = ucslen*sizeof(ucs2_t); + size_t status; + + cd = (void*)Riconv_open(cidfont->encoding, + (enc == CE_UTF8) ? "UTF-8": ""); + if(cd == (void*)-1) return; + + R_CheckStack2(buflen); + unsigned char buf[buflen]; + + i_buf = (char *)str; + o_buf = (char *)buf; + i_len = strlen(str); /* no terminator, + as output a byte at a time */ + nb = o_len = buflen; + + status = Riconv(cd, &i_buf, (size_t *)&i_len, + (char **)&o_buf, (size_t *)&o_len); + + Riconv_close(cd); + if(status == (size_t)-1) + warning(_("failed in text conversion to encoding '%s'"), + cidfont->encoding); + else { + unsigned char *p; + PDF_SetFill(gc->col, dd); + fprintf(pd->pdffp, + "/F%d 1 Tf %.2f %.2f %.2f %.2f %.2f %.2f Tm <", + PDFfontNumber(gc->fontfamily, face, pd), + a, b, bm, a, x, y); + for(i = 0, p = buf; i < nb - o_len; i++) + fprintf(pd->pdffp, "%02x", *p++); + fprintf(pd->pdffp, "> Tj\n"); + } + return; + } else { + warning(_("invalid string in '%s'"), "PDF_Text"); + return; + } + } + + PDF_SetFill(gc->col, dd); + fprintf(pd->pdffp, "/F%d 1 Tf %.2f %.2f %.2f %.2f %.2f %.2f Tm ", + PDFfontNumber(gc->fontfamily, face, pd), + a, b, bm, a, x, y); + if((enc == CE_UTF8 || mbcslocale) && !strIsASCII(str) && face < 5) { + /* face 5 handled above */ + R_CheckStack2(strlen(str)+1); + buff = alloca(strlen(str)+1); /* Output string cannot be longer */ + mbcsToSbcs(str, buff, PDFconvname(gc->fontfamily, pd), enc); + str1 = buff; + } else str1 = str; + + if (pd->useKern && + isType1Font(gc->fontfamily, PDFFonts, pd->defaultFont)) { + PDFWriteT1KerningString(pd->pdffp, str1, + PDFmetricInfo(gc->fontfamily, face, pd), gc); + } else{ + PostScriptWriteString(pd->pdffp, str1, strlen(str1)); + fprintf(pd->pdffp, " Tj\n"); + } + textoff(pd); /* added in 2.8.0 */ +} + +static void PDF_Text(double x, double y, const char *str, + double rot, double hadj, + const pGEcontext gc, + pDevDesc dd) +{ + PDF_Text0(x, y, str, CE_NATIVE, rot, hadj, gc, dd); +} + +static void PDF_TextUTF8(double x, double y, const char *str, + double rot, double hadj, + const pGEcontext gc, + pDevDesc dd) +{ + PDF_Text0(x, y, str, CE_UTF8, rot, hadj, gc, dd); +} + +static FontMetricInfo +*PDFCIDsymbolmetricInfo(const char *family, PDFDesc *pd) +{ + FontMetricInfo *result = NULL; + if (strlen(family) > 0) { + int dontcare; + /* + * Find the family in pd->cidfonts + */ + cidfontfamily fontfamily = findDeviceCIDFont(family, + pd->cidfonts, + &dontcare); + if (fontfamily) + result = &(fontfamily->symfont->metrics); + else { + /* + * Try to load the font + */ + fontfamily = addCIDFont(family, 1); + if (fontfamily) { + if (addPDFDeviceCIDfont(fontfamily, pd, &dontcare)) { + result = &(fontfamily->symfont->metrics); + } else { + fontfamily = NULL; + } + } + } + if (!fontfamily) + error(_("failed to find or load PDF CID font")); + } else { + result = &(pd->cidfonts->cidfamily->symfont->metrics); + } + return result; +} + +static FontMetricInfo +*PDFmetricInfo(const char *family, int face, PDFDesc *pd) +{ + FontMetricInfo *result = NULL; + if (strlen(family) > 0) { + int dontcare; + /* + * Find the family in pd->fonts + */ + type1fontfamily fontfamily = findDeviceFont(family, pd->fonts, + &dontcare); + if (fontfamily) + result = &(fontfamily->fonts[face-1]->metrics); + else { + /* + * Check whether the font is loaded and, if not, + * load it. + */ + fontfamily = findLoadedFont(family, + pd->encodings->encoding->encpath, + TRUE); + if (!fontfamily) { + fontfamily = addFont(family, TRUE, pd->encodings); + } + /* + * Once the font is loaded, add it to the device's + * list of fonts. + */ + if (fontfamily) { + int dontcare; + if (addPDFDevicefont(fontfamily, pd, &dontcare)) { + result = &(fontfamily->fonts[face-1]->metrics); + } else { + fontfamily = NULL; + } + } + } + if (!fontfamily) + error(_("failed to find or load PDF font")); + } else { + result = &(pd->fonts->family->fonts[face-1]->metrics); + } + return result; +} + +static char +*PDFconvname(const char *family, PDFDesc *pd) +{ + char *result = (pd->fonts) ? pd->fonts->family->encoding->convname : "latin1"; + /* pd->fonts is NULL when CIDfonts are used */ + + if (strlen(family) > 0) { + int dontcare; + /* + * Find the family in pd->fonts + */ + type1fontfamily fontfamily = findDeviceFont(family, pd->fonts, + &dontcare); + if (fontfamily) + result = fontfamily->encoding->convname; + else { + /* + * Check whether the font is loaded and, if not, + * load it. + */ + fontfamily = findLoadedFont(family, + pd->encodings->encoding->encpath, + TRUE); + if (!fontfamily) { + fontfamily = addFont(family, TRUE, pd->encodings); + } + /* + * Once the font is loaded, add it to the device's + * list of fonts. + */ + if (fontfamily) { + int dontcare; + if (addPDFDevicefont(fontfamily, pd, &dontcare)) { + result = fontfamily->encoding->convname; + } else { + fontfamily = NULL; + } + } + } + if (!fontfamily) + error(_("failed to find or load PDF font")); + } + return result; +} + +double PDF_StrWidth(const char *str, + const pGEcontext gc, + pDevDesc dd) +{ + PDFDesc *pd = (PDFDesc *) dd->deviceSpecific; + + if(gc->fontface < 1 || gc->fontface > 5) gc->fontface = 1; + if (isType1Font(gc->fontfamily, PDFFonts, pd->defaultFont)) { + return floor(gc->cex * gc->ps + 0.5) * + PostScriptStringWidth((const unsigned char *)str, CE_NATIVE, + PDFmetricInfo(gc->fontfamily, + gc->fontface, pd), + pd->useKern, gc->fontface, + PDFconvname(gc->fontfamily, pd)); + } else { /* cidfont(gc->fontfamily) */ + if (gc->fontface < 5) { + return floor(gc->cex * gc->ps + 0.5) * + PostScriptStringWidth((const unsigned char *)str, CE_NATIVE, + NULL, FALSE, gc->fontface, NULL); + } else { + return floor(gc->cex * gc->ps + 0.5) * + PostScriptStringWidth((const unsigned char *)str, CE_NATIVE, + PDFCIDsymbolmetricInfo(gc->fontfamily, + pd), + FALSE, gc->fontface, NULL); + } + } +} + +static double PDF_StrWidthUTF8(const char *str, + const pGEcontext gc, + pDevDesc dd) +{ + PDFDesc *pd = (PDFDesc *) dd->deviceSpecific; + int face = gc->fontface; + + if(gc->fontface < 1 || gc->fontface > 5) gc->fontface = 1; + if (isType1Font(gc->fontfamily, PDFFonts, pd->defaultFont)) { + return floor(gc->cex * gc->ps + 0.5) * + PostScriptStringWidth((const unsigned char *)str, CE_UTF8, + PDFmetricInfo(gc->fontfamily, + gc->fontface, pd), + pd->useKern, gc->fontface, + PDFconvname(gc->fontfamily, pd)); + } else { /* cidfont(gc->fontfamily) */ + if (face < 5) { + return floor(gc->cex * gc->ps + 0.5) * + PostScriptStringWidth((const unsigned char *)str, CE_UTF8, + NULL, FALSE, gc->fontface, NULL); + } else { + return floor(gc->cex * gc->ps + 0.5) * + PostScriptStringWidth((const unsigned char *)str, CE_UTF8, + PDFCIDsymbolmetricInfo(gc->fontfamily, + pd), + FALSE, gc->fontface, NULL); + } + } +} + +void PDF_MetricInfo(int c, + const pGEcontext gc, + double* ascent, double* descent, + double* width, pDevDesc dd) +{ + PDFDesc *pd = (PDFDesc *) dd->deviceSpecific; + int face = gc->fontface; + + if(gc->fontface < 1 || gc->fontface > 5) gc->fontface = 1; + if (isType1Font(gc->fontfamily, PDFFonts, pd->defaultFont)) { + PostScriptMetricInfo(c, ascent, descent, width, + PDFmetricInfo(gc->fontfamily, + gc->fontface, pd), + face == 5, PDFconvname(gc->fontfamily, pd)); + } else { /* cidfont(gc->fontfamily) */ + if (face < 5) { + PostScriptCIDMetricInfo(c, ascent, descent, width); + } else { + PostScriptMetricInfo(c, ascent, descent, width, + PDFCIDsymbolmetricInfo(gc->fontfamily, pd), + TRUE, ""); + } + } + *ascent = floor(gc->cex * gc->ps + 0.5) * *ascent; + *descent = floor(gc->cex * gc->ps + 0.5) * *descent; + *width = floor(gc->cex * gc->ps + 0.5) * *width; +} + + +/* PostScript Device Driver Parameters: + * ------------------------ + * file = output filename + * paper = paper type + * family = typeface = "family" + * encoding = char encoding file name + * cidfamily = char encoding file name for CID fonts + * bg = background color + * fg = foreground color + * width = width in inches + * height = height in inches + * horizontal = {TRUE: landscape; FALSE: portrait} + * ps = pointsize + * onefile = {TRUE: normal; FALSE: single EPSF page} + * pagecentre = centre plot region on paper? + * printit = 'print' after closing device? + * command = 'print' command + * title = character string + * fonts + * colorModel + * useKerning + * fillOddEven + */ + +SEXP PostScript(SEXP args) +{ + pGEDevDesc gdd; + const void *vmax; + const char *file, *paper, *family=NULL, *bg, *fg, *cmd; + const char *afms[5]; + const char *encoding, *title, call[] = "postscript", *colormodel; + int i, horizontal, onefile, pagecentre, printit, useKern; + double height, width, ps; + SEXP fam, fonts; + Rboolean fillOddEven; + + vmax = vmaxget(); + args = CDR(args); /* skip entry point name */ + file = translateChar(asChar(CAR(args))); args = CDR(args); + paper = CHAR(asChar(CAR(args))); args = CDR(args); + + /* 'family' can be either one string or a 5-vector of afmpaths. */ + fam = CAR(args); args = CDR(args); + if(length(fam) == 1) + family = CHAR(asChar(fam)); + else if(length(fam) == 5) { + if(!isString(fam)) error(_("invalid 'family' parameter in %s"), call); + family = "User"; + for(i = 0; i < 5; i++) afms[i] = CHAR(STRING_ELT(fam, i)); + } else + error(_("invalid 'family' parameter in %s"), call); + + encoding = CHAR(asChar(CAR(args))); args = CDR(args); + bg = CHAR(asChar(CAR(args))); args = CDR(args); + fg = CHAR(asChar(CAR(args))); args = CDR(args); + width = asReal(CAR(args)); args = CDR(args); + height = asReal(CAR(args)); args = CDR(args); + horizontal = asLogical(CAR(args));args = CDR(args); + if(horizontal == NA_LOGICAL) + horizontal = 1; + ps = asReal(CAR(args)); args = CDR(args); + onefile = asLogical(CAR(args)); args = CDR(args); + pagecentre = asLogical(CAR(args));args = CDR(args); + printit = asLogical(CAR(args)); args = CDR(args); + cmd = CHAR(asChar(CAR(args))); args = CDR(args); + title = translateChar(asChar(CAR(args))); args = CDR(args); + fonts = CAR(args); args = CDR(args); + if (!isNull(fonts) && !isString(fonts)) + error(_("invalid 'fonts' parameter in %s"), call); + colormodel = CHAR(asChar(CAR(args))); args = CDR(args); + useKern = asLogical(CAR(args)); args = CDR(args); + if (useKern == NA_LOGICAL) useKern = 1; + fillOddEven = asLogical(CAR(args)); + if (fillOddEven == NA_LOGICAL) + error(_("invalid value of '%s'"), "fillOddEven"); + + R_GE_checkVersionOrDie(R_GE_version); + R_CheckDeviceAvailable(); + BEGIN_SUSPEND_INTERRUPTS { + pDevDesc dev; + if (!(dev = (pDevDesc) calloc(1, sizeof(DevDesc)))) + return 0; + if(!PSDeviceDriver(dev, file, paper, family, afms, encoding, bg, fg, + width, height, (double)horizontal, ps, onefile, + pagecentre, printit, cmd, title, fonts, + colormodel, useKern, fillOddEven)) { + /* we no longer get here: error is thrown in PSDeviceDriver */ + error(_("unable to start %s() device"), "postscript"); + } + gdd = GEcreateDevDesc(dev); + GEaddDevice2f(gdd, "postscript", file); + } END_SUSPEND_INTERRUPTS; + vmaxset(vmax); + return R_NilValue; +} + + + +/* XFig Device Driver Parameters: + * ------------------------ + * file = output filename + * paper = paper type + * family = typeface = "family" + * bg = background color + * fg = foreground color + * width = width in inches + * height = height in inches + * horizontal = {TRUE: landscape; FALSE: portrait} + * ps = pointsize + * onefile = {TRUE: normal; FALSE: single EPSF page} + * pagecentre = centre plot region on paper? + * defaultfont = {TRUE: use xfig default font; FALSE: use R font} + * textspecial = {TRUE: use textspecial; FALSE: use standard font} + * + * encoding + */ + +SEXP XFig(SEXP args) +{ + pGEDevDesc gdd; + const void *vmax; + const char *file, *paper, *family, *bg, *fg, *encoding; + int horizontal, onefile, pagecentre, defaultfont, textspecial; + double height, width, ps; + + vmax = vmaxget(); + args = CDR(args); /* skip entry point name */ + file = translateChar(asChar(CAR(args))); args = CDR(args); + paper = CHAR(asChar(CAR(args))); args = CDR(args); + family = CHAR(asChar(CAR(args))); args = CDR(args); + bg = CHAR(asChar(CAR(args))); args = CDR(args); + fg = CHAR(asChar(CAR(args))); args = CDR(args); + width = asReal(CAR(args)); args = CDR(args); + height = asReal(CAR(args)); args = CDR(args); + horizontal = asLogical(CAR(args));args = CDR(args); + if(horizontal == NA_LOGICAL) + horizontal = 1; + ps = asReal(CAR(args)); args = CDR(args); + onefile = asLogical(CAR(args)); args = CDR(args); + pagecentre = asLogical(CAR(args));args = CDR(args); + defaultfont = asLogical(CAR(args)); args = CDR(args); + textspecial = asLogical(CAR(args)); args = CDR(args); + encoding = CHAR(asChar(CAR(args))); + + R_GE_checkVersionOrDie(R_GE_version); + R_CheckDeviceAvailable(); + BEGIN_SUSPEND_INTERRUPTS { + pDevDesc dev; + if (!(dev = (pDevDesc) calloc(1, sizeof(DevDesc)))) + return 0; + if(!XFigDeviceDriver(dev, file, paper, family, bg, fg, width, height, + (double) horizontal, ps, onefile, pagecentre, defaultfont, textspecial, + encoding)) { + /* we no longer get here: error is thrown in XFigDeviceDriver */ + error(_("unable to start %s() device"), "xfig"); + } + gdd = GEcreateDevDesc(dev); + GEaddDevice2f(gdd, "xfig", file); + } END_SUSPEND_INTERRUPTS; + vmaxset(vmax); + return R_NilValue; +} + + +/* PDF Device Driver Parameters: + * ------------------------ + * file = output filename + * paper = paper type + * family = typeface = "family" + * encoding = char encoding file name + * cidfamily = char encoding file name for CID fonts + * bg = background color + * fg = foreground color + * width = width in inches + * height = height in inches + * ps = pointsize + * onefile = {TRUE: normal; FALSE: single page per file} + * title + * fonts + * versionMajor + * versionMinor + * colormodel + * useDingbats + * forceLetterSpacing + * fillOddEven + */ + +SEXP PDF(SEXP args) +{ + pGEDevDesc gdd; + const void *vmax; + const char *file, *paper, *encoding, *family = NULL /* -Wall */, + *bg, *fg, *title, call[] = "PDF", *colormodel; + const char *afms[5]; + double height, width, ps; + int i, onefile, pagecentre, major, minor, dingbats, useKern, useCompression; + SEXP fam, fonts; + Rboolean fillOddEven; + + vmax = vmaxget(); + args = CDR(args); /* skip entry point name */ + if (isNull(CAR(args))) + file = NULL; + else + file = translateChar(asChar(CAR(args))); + args = CDR(args); + paper = CHAR(asChar(CAR(args))); args = CDR(args); + fam = CAR(args); args = CDR(args); + if(length(fam) == 1) + family = CHAR(asChar(fam)); + else if(length(fam) == 5) { + if(!isString(fam)) error(_("invalid 'family' parameter in %s"), call); + family = "User"; + for(i = 0; i < 5; i++) afms[i] = CHAR(STRING_ELT(fam, i)); + } else + error(_("invalid 'family' parameter in %s"), call); + encoding = CHAR(asChar(CAR(args))); args = CDR(args); + bg = CHAR(asChar(CAR(args))); args = CDR(args); + fg = CHAR(asChar(CAR(args))); args = CDR(args); + width = asReal(CAR(args)); args = CDR(args); + height = asReal(CAR(args)); args = CDR(args); + ps = asReal(CAR(args)); args = CDR(args); + onefile = asLogical(CAR(args)); args = CDR(args); + pagecentre = asLogical(CAR(args));args = CDR(args); + title = translateChar(asChar(CAR(args))); args = CDR(args); + fonts = CAR(args); args = CDR(args); + if (!isNull(fonts) && !isString(fonts)) + error(_("invalid 'fonts' parameter in %s"), call); + major = asInteger(CAR(args)); args = CDR(args); + minor = asInteger(CAR(args)); args = CDR(args); + colormodel = CHAR(asChar(CAR(args))); args = CDR(args); + dingbats = asLogical(CAR(args)); args = CDR(args); + if (dingbats == NA_LOGICAL) dingbats = 1; + useKern = asLogical(CAR(args)); args = CDR(args); + if (useKern == NA_LOGICAL) useKern = 1; + fillOddEven = asLogical(CAR(args)); args = CDR(args); + if (fillOddEven == NA_LOGICAL) + error(_("invalid value of '%s'"), "fillOddEven"); + useCompression = asLogical(CAR(args)); args = CDR(args); + if (useCompression == NA_LOGICAL) + error(_("invalid value of '%s'"), "useCompression"); + + R_GE_checkVersionOrDie(R_GE_version); + R_CheckDeviceAvailable(); + BEGIN_SUSPEND_INTERRUPTS { + pDevDesc dev; + if (!(dev = (pDevDesc) calloc(1, sizeof(DevDesc)))) + return 0; + if(!PDFDeviceDriver(dev, file, paper, family, afms, encoding, bg, fg, + width, height, ps, onefile, pagecentre, + title, fonts, major, minor, colormodel, + dingbats, useKern, fillOddEven, + useCompression)) { + /* we no longer get here: error is thrown in PDFDeviceDriver */ + error(_("unable to start %s() device"), "pdf"); + } + gdd = GEcreateDevDesc(dev); + GEaddDevice2f(gdd, "pdf", file); + } END_SUSPEND_INTERRUPTS; + vmaxset(vmax); + return R_NilValue; +} diff --git a/com.oracle.truffle.r.native/gnur/patch/src/library/grDevices/src/devPicTeX.c b/com.oracle.truffle.r.native/gnur/patch/src/library/grDevices/src/devPicTeX.c new file mode 100644 index 0000000000000000000000000000000000000000..c7e9ebe380394dc7d0d901a105f0bf574458dee2 --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/library/grDevices/src/devPicTeX.c @@ -0,0 +1,747 @@ +/* + * A PicTeX device, (C) 1996 Valerio Aimale, for + * R : A Computer Language for Statistical Data Analysis + * Copyright (C) 1995, 1996 Robert Gentleman and Ross Ihaka + * Copyright (C) 2001-2013 The R Core Team + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version. + * + * This program 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 this program; if not, a copy is available at + * https://www.R-project.org/Licenses/ + */ + +#ifdef HAVE_CONFIG_H +# include <config.h> +#endif + +#include <Defn.h> + +# include <rlocale.h> /* includes wchar.h */ + +#define R_USE_PROTOTYPES 1 +#include <R_ext/GraphicsEngine.h> +#include "Fileio.h" +#include "grDevices.h" + + /* device-specific information per picTeX device */ + +#define DOTSperIN 72.27 +#define in2dots(x) (DOTSperIN * x) + +typedef struct { + FILE *texfp; + char filename[128]; + int pageno; + int landscape; + double width; + double height; + double pagewidth; + double pageheight; + double xlast; + double ylast; + double clipleft, clipright, cliptop, clipbottom; + double clippedx0, clippedy0, clippedx1, clippedy1; + int lty; + rcolor col; + rcolor fill; + int fontsize; + int fontface; + Rboolean debug; +} picTeXDesc; + + + /* Global device information */ + +static const double charwidth[4][128] = { +{ + 0.5416690, 0.8333360, 0.7777810, 0.6111145, 0.6666690, 0.7083380, 0.7222240, + 0.7777810, 0.7222240, 0.7777810, 0.7222240, 0.5833360, 0.5361130, 0.5361130, + 0.8138910, 0.8138910, 0.2388900, 0.2666680, 0.5000020, 0.5000020, 0.5000020, + 0.5000020, 0.5000020, 0.6666700, 0.4444460, 0.4805580, 0.7222240, 0.7777810, + 0.5000020, 0.8611145, 0.9722260, 0.7777810, 0.2388900, 0.3194460, 0.5000020, + 0.8333360, 0.5000020, 0.8333360, 0.7583360, 0.2777790, 0.3888900, 0.3888900, + 0.5000020, 0.7777810, 0.2777790, 0.3333340, 0.2777790, 0.5000020, 0.5000020, + 0.5000020, 0.5000020, 0.5000020, 0.5000020, 0.5000020, 0.5000020, 0.5000020, + 0.5000020, 0.5000020, 0.2777790, 0.2777790, 0.3194460, 0.7777810, 0.4722240, + 0.4722240, 0.6666690, 0.6666700, 0.6666700, 0.6388910, 0.7222260, 0.5972240, + 0.5694475, 0.6666690, 0.7083380, 0.2777810, 0.4722240, 0.6944480, 0.5416690, + 0.8750050, 0.7083380, 0.7361130, 0.6388910, 0.7361130, 0.6458360, 0.5555570, + 0.6805570, 0.6875050, 0.6666700, 0.9444480, 0.6666700, 0.6666700, 0.6111130, + 0.2888900, 0.5000020, 0.2888900, 0.5000020, 0.2777790, 0.2777790, 0.4805570, + 0.5166680, 0.4444460, 0.5166680, 0.4444460, 0.3055570, 0.5000020, 0.5166680, + 0.2388900, 0.2666680, 0.4888920, 0.2388900, 0.7944470, 0.5166680, 0.5000020, + 0.5166680, 0.5166680, 0.3416690, 0.3833340, 0.3611120, 0.5166680, 0.4611130, + 0.6833360, 0.4611130, 0.4611130, 0.4347230, 0.5000020, 1.0000030, 0.5000020, + 0.5000020, 0.5000020 +}, +{ + 0.5805590, 0.9166720, 0.8555600, 0.6722260, 0.7333370, 0.7944490, 0.7944490, + 0.8555600, 0.7944490, 0.8555600, 0.7944490, 0.6416700, 0.5861150, 0.5861150, + 0.8916720, 0.8916720, 0.2555570, 0.2861130, 0.5500030, 0.5500030, 0.5500030, + 0.5500030, 0.5500030, 0.7333370, 0.4888920, 0.5652800, 0.7944490, 0.8555600, + 0.5500030, 0.9472275, 1.0694500, 0.8555600, 0.2555570, 0.3666690, 0.5583360, + 0.9166720, 0.5500030, 1.0291190, 0.8305610, 0.3055570, 0.4277800, 0.4277800, + 0.5500030, 0.8555600, 0.3055570, 0.3666690, 0.3055570, 0.5500030, 0.5500030, + 0.5500030, 0.5500030, 0.5500030, 0.5500030, 0.5500030, 0.5500030, 0.5500030, + 0.5500030, 0.5500030, 0.3055570, 0.3055570, 0.3666690, 0.8555600, 0.5194470, + 0.5194470, 0.7333370, 0.7333370, 0.7333370, 0.7027820, 0.7944490, 0.6416700, + 0.6111145, 0.7333370, 0.7944490, 0.3305570, 0.5194470, 0.7638930, 0.5805590, + 0.9777830, 0.7944490, 0.7944490, 0.7027820, 0.7944490, 0.7027820, 0.6111145, + 0.7333370, 0.7638930, 0.7333370, 1.0388950, 0.7333370, 0.7333370, 0.6722260, + 0.3430580, 0.5583360, 0.3430580, 0.5500030, 0.3055570, 0.3055570, 0.5250030, + 0.5611140, 0.4888920, 0.5611140, 0.5111140, 0.3361130, 0.5500030, 0.5611140, + 0.2555570, 0.2861130, 0.5305590, 0.2555570, 0.8666720, 0.5611140, 0.5500030, + 0.5611140, 0.5611140, 0.3722250, 0.4216690, 0.4041690, 0.5611140, 0.5000030, + 0.7444490, 0.5000030, 0.5000030, 0.4763920, 0.5500030, 1.1000060, 0.5500030, + 0.5500030, 0.550003 }, +{ + 0.5416690, 0.8333360, 0.7777810, 0.6111145, 0.6666690, 0.7083380, 0.7222240, + 0.7777810, 0.7222240, 0.7777810, 0.7222240, 0.5833360, 0.5361130, 0.5361130, + 0.8138910, 0.8138910, 0.2388900, 0.2666680, 0.5000020, 0.5000020, 0.5000020, + 0.5000020, 0.5000020, 0.7375210, 0.4444460, 0.4805580, 0.7222240, 0.7777810, + 0.5000020, 0.8611145, 0.9722260, 0.7777810, 0.2388900, 0.3194460, 0.5000020, + 0.8333360, 0.5000020, 0.8333360, 0.7583360, 0.2777790, 0.3888900, 0.3888900, + 0.5000020, 0.7777810, 0.2777790, 0.3333340, 0.2777790, 0.5000020, 0.5000020, + 0.5000020, 0.5000020, 0.5000020, 0.5000020, 0.5000020, 0.5000020, 0.5000020, + 0.5000020, 0.5000020, 0.2777790, 0.2777790, 0.3194460, 0.7777810, 0.4722240, + 0.4722240, 0.6666690, 0.6666700, 0.6666700, 0.6388910, 0.7222260, 0.5972240, + 0.5694475, 0.6666690, 0.7083380, 0.2777810, 0.4722240, 0.6944480, 0.5416690, + 0.8750050, 0.7083380, 0.7361130, 0.6388910, 0.7361130, 0.6458360, 0.5555570, + 0.6805570, 0.6875050, 0.6666700, 0.9444480, 0.6666700, 0.6666700, 0.6111130, + 0.2888900, 0.5000020, 0.2888900, 0.5000020, 0.2777790, 0.2777790, 0.4805570, + 0.5166680, 0.4444460, 0.5166680, 0.4444460, 0.3055570, 0.5000020, 0.5166680, + 0.2388900, 0.2666680, 0.4888920, 0.2388900, 0.7944470, 0.5166680, 0.5000020, + 0.5166680, 0.5166680, 0.3416690, 0.3833340, 0.3611120, 0.5166680, 0.4611130, + 0.6833360, 0.4611130, 0.4611130, 0.4347230, 0.5000020, 1.0000030, 0.5000020, + 0.5000020, 0.5000020 }, +{ + 0.5805590, 0.9166720, 0.8555600, 0.6722260, 0.7333370, 0.7944490, 0.7944490, + 0.8555600, 0.7944490, 0.8555600, 0.7944490, 0.6416700, 0.5861150, 0.5861150, + 0.8916720, 0.8916720, 0.2555570, 0.2861130, 0.5500030, 0.5500030, 0.5500030, + 0.5500030, 0.5500030, 0.8002530, 0.4888920, 0.5652800, 0.7944490, 0.8555600, + 0.5500030, 0.9472275, 1.0694500, 0.8555600, 0.2555570, 0.3666690, 0.5583360, + 0.9166720, 0.5500030, 1.0291190, 0.8305610, 0.3055570, 0.4277800, 0.4277800, + 0.5500030, 0.8555600, 0.3055570, 0.3666690, 0.3055570, 0.5500030, 0.5500030, + 0.5500030, 0.5500030, 0.5500030, 0.5500030, 0.5500030, 0.5500030, 0.5500030, + 0.5500030, 0.5500030, 0.3055570, 0.3055570, 0.3666690, 0.8555600, 0.5194470, + 0.5194470, 0.7333370, 0.7333370, 0.7333370, 0.7027820, 0.7944490, 0.6416700, + 0.6111145, 0.7333370, 0.7944490, 0.3305570, 0.5194470, 0.7638930, 0.5805590, + 0.9777830, 0.7944490, 0.7944490, 0.7027820, 0.7944490, 0.7027820, 0.6111145, + 0.7333370, 0.7638930, 0.7333370, 1.0388950, 0.7333370, 0.7333370, 0.6722260, + 0.3430580, 0.5583360, 0.3430580, 0.5500030, 0.3055570, 0.3055570, 0.5250030, + 0.5611140, 0.4888920, 0.5611140, 0.5111140, 0.3361130, 0.5500030, 0.5611140, + 0.2555570, 0.2861130, 0.5305590, 0.2555570, 0.8666720, 0.5611140, 0.5500030, + 0.5611140, 0.5611140, 0.3722250, 0.4216690, 0.4041690, 0.5611140, 0.5000030, + 0.7444490, 0.5000030, 0.5000030, 0.4763920, 0.5500030, 1.1000060, 0.5500030, + 0.5500030, 0.550003 +} +}; + +static const char * const fontname[] = { + "cmss10", + "cmssbx10", + "cmssi10", + "cmssxi10" +}; + + + /* Device driver actions */ + +static void PicTeX_Circle(double x, double y, double r, + const pGEcontext gc, + pDevDesc dd); +static void PicTeX_Clip(double x0, double x1, double y0, double y1, + pDevDesc dd); +static void PicTeX_Close(pDevDesc dd); +static void PicTeX_Line(double x1, double y1, double x2, double y2, + const pGEcontext gc, + pDevDesc dd); +static void PicTeX_MetricInfo(int c, + const pGEcontext gc, + double* ascent, double* descent, + double* width, pDevDesc dd); +static void PicTeX_NewPage(const pGEcontext gc, pDevDesc dd); +static void PicTeX_Polygon(int n, double *x, double *y, + const pGEcontext gc, + pDevDesc dd); +static void PicTeX_Rect(double x0, double y0, double x1, double y1, + const pGEcontext gc, + pDevDesc dd); +static void PicTeX_Size(double *left, double *right, + double *bottom, double *top, + pDevDesc dd); +static double PicTeX_StrWidth(const char *str, + const pGEcontext gc, + pDevDesc dd); +static void PicTeX_Text(double x, double y, const char *str, + double rot, double hadj, + const pGEcontext gc, + pDevDesc dd); +static Rboolean PicTeX_Open(pDevDesc, picTeXDesc*); + + /* Support routines */ + +static void SetLinetype(int newlty, double newlwd, pDevDesc dd) +{ + picTeXDesc *ptd = (picTeXDesc *) dd->deviceSpecific; + + int i, templty; + ptd->lty = newlty; + if (ptd->lty) { + fprintf(ptd->texfp,"\\setdashpattern <"); + for(i=0 ; i<8 && newlty&15 ; i++) { + int lwd = (int)newlwd * newlty; + fprintf(ptd->texfp,"%dpt", lwd & 15); + templty = newlty>>4; + if ((i+1)<8 && templty&15) fprintf(ptd->texfp,", "); + newlty = newlty>>4; + } + fprintf(ptd->texfp,">\n"); + } else fprintf(ptd->texfp,"\\setsolid\n"); +} + + +static void SetFont(int face, int size, picTeXDesc *ptd) +{ + int lface=face, lsize= size; + if(lface < 1 || lface > 4 ) lface = 1; + if(lsize < 1 || lsize > 24) lsize = 10; + if(lsize != ptd->fontsize || lface != ptd->fontface) { + fprintf(ptd->texfp, "\\font\\picfont %s at %dpt\\picfont\n", + fontname[lface-1], lsize); + ptd->fontsize = lsize; + ptd->fontface = lface; + } +} + +static void PicTeX_MetricInfo(int c, + const pGEcontext gc, + double* ascent, double* descent, + double* width, pDevDesc dd) +{ + /* metric information not available => return 0,0,0 */ + *ascent = 0.0; + *descent = 0.0; + *width = 0.0; +} + + /* Initialize the device */ + +static Rboolean PicTeX_Open(pDevDesc dd, picTeXDesc *ptd) +{ + ptd->fontsize = 0; + ptd->fontface = 0; + ptd->debug = FALSE; + if (!(ptd->texfp = R_fopen(R_ExpandFileName(ptd->filename), "w"))) + return FALSE; + fprintf(ptd->texfp, "\\hbox{\\beginpicture\n"); + fprintf(ptd->texfp, "\\setcoordinatesystem units <1pt,1pt>\n"); + fprintf(ptd->texfp, + "\\setplotarea x from 0 to %.2f, y from 0 to %.2f\n", + in2dots(ptd->width), in2dots(ptd->height)); + fprintf(ptd->texfp,"\\setlinear\n"); + fprintf(ptd->texfp, "\\font\\picfont cmss10\\picfont\n"); + SetFont(1, 10, ptd); + ptd->pageno++; + return TRUE; +} + + + /* Interactive Resize */ + +static void PicTeX_Size(double *left, double *right, + double *bottom, double *top, + pDevDesc dd) +{ + *left = dd->left; /* left */ + *right = dd->right;/* right */ + *bottom = dd->bottom; /* bottom */ + *top = dd->top;/* top */ +} + +static void PicTeX_Clip(double x0, double x1, double y0, double y1, + pDevDesc dd) +{ + picTeXDesc *ptd = (picTeXDesc *) dd->deviceSpecific; + + if(ptd->debug) + fprintf(ptd->texfp, "%% Setting Clip Region to %.2f %.2f %.2f %.2f\n", + x0, y0, x1, y1); + ptd->clipleft = x0; + ptd->clipright = x1; + ptd->clipbottom = y0; + ptd->cliptop = y1; +} + + /* Start a new page */ + +static void PicTeX_NewPage(const pGEcontext gc, + pDevDesc dd) +{ + picTeXDesc *ptd = (picTeXDesc *) dd->deviceSpecific; + + int face, size; + if (ptd->pageno) { + fprintf(ptd->texfp, "\\endpicture\n}\n\n\n"); + fprintf(ptd->texfp, "\\hbox{\\beginpicture\n"); + fprintf(ptd->texfp, "\\setcoordinatesystem units <1pt,1pt>\n"); + fprintf(ptd->texfp, + "\\setplotarea x from 0 to %.2f, y from 0 to %.2f\n", + in2dots(ptd->width), in2dots(ptd->height)); + fprintf(ptd->texfp,"\\setlinear\n"); + fprintf(ptd->texfp, "\\font\\picfont cmss10\\picfont\n"); + } + ptd->pageno++; + face = ptd->fontface; + size = ptd->fontsize; + ptd->fontface = 0; + ptd->fontsize = 0; + SetFont(face, size, ptd); +} + + /* Close down the driver */ + +static void PicTeX_Close(pDevDesc dd) +{ + picTeXDesc *ptd = (picTeXDesc *) dd->deviceSpecific; + + fprintf(ptd->texfp, "\\endpicture\n}\n"); + fclose(ptd->texfp); + + free(ptd); +} + + /* Draw To */ + +static void PicTeX_ClipLine(double x0, double y0, double x1, double y1, + picTeXDesc *ptd) +{ + ptd->clippedx0 = x0; ptd->clippedx1 = x1; + ptd->clippedy0 = y0; ptd->clippedy1 = y1; + + if ((ptd->clippedx0 < ptd->clipleft && + ptd->clippedx1 < ptd->clipleft) || + (ptd->clippedx0 > ptd->clipright && + ptd->clippedx1 > ptd->clipright) || + (ptd->clippedy0 < ptd->clipbottom && + ptd->clippedy1 < ptd->clipbottom) || + (ptd->clippedy0 > ptd->cliptop && + ptd->clippedy1 > ptd->cliptop)) { + ptd->clippedx0 = ptd->clippedx1; + ptd->clippedy0 = ptd->clippedy1; + return; + } + + /*Clipping Left */ + if (ptd->clippedx1 >= ptd->clipleft && ptd->clippedx0 < ptd->clipleft) { + ptd->clippedy0 = ((ptd->clippedy1-ptd->clippedy0) / + (ptd->clippedx1-ptd->clippedx0) * + (ptd->clipleft-ptd->clippedx0)) + + ptd->clippedy0; + ptd->clippedx0 = ptd->clipleft; + } + if (ptd->clippedx1 <= ptd->clipleft && ptd->clippedx0 > ptd->clipleft) { + ptd->clippedy1 = ((ptd->clippedy1-ptd->clippedy0) / + (ptd->clippedx1-ptd->clippedx0) * + (ptd->clipleft-ptd->clippedx0)) + + ptd->clippedy0; + ptd->clippedx1 = ptd->clipleft; + } + /* Clipping Right */ + if (ptd->clippedx1 >= ptd->clipright && + ptd->clippedx0 < ptd->clipright) { + ptd->clippedy1 = ((ptd->clippedy1-ptd->clippedy0) / + (ptd->clippedx1-ptd->clippedx0) * + (ptd->clipright-ptd->clippedx0)) + + ptd->clippedy0; + ptd->clippedx1 = ptd->clipright; + } + if (ptd->clippedx1 <= ptd->clipright && + ptd->clippedx0 > ptd->clipright) { + ptd->clippedy0 = ((ptd->clippedy1-ptd->clippedy0) / + (ptd->clippedx1-ptd->clippedx0) * + (ptd->clipright-ptd->clippedx0)) + + ptd->clippedy0; + ptd->clippedx0 = ptd->clipright; + } + /*Clipping Bottom */ + if (ptd->clippedy1 >= ptd->clipbottom && + ptd->clippedy0 < ptd->clipbottom ) { + ptd->clippedx0 = ((ptd->clippedx1-ptd->clippedx0) / + (ptd->clippedy1-ptd->clippedy0) * + (ptd->clipbottom -ptd->clippedy0)) + + ptd->clippedx0; + ptd->clippedy0 = ptd->clipbottom ; + } + if (ptd->clippedy1 <= ptd->clipbottom && + ptd->clippedy0 > ptd->clipbottom ) { + ptd->clippedx1 = ((ptd->clippedx1-ptd->clippedx0) / + (ptd->clippedy1-ptd->clippedy0) * + (ptd->clipbottom -ptd->clippedy0)) + + ptd->clippedx0; + ptd->clippedy1 = ptd->clipbottom ; + } + /*Clipping Top */ + if (ptd->clippedy1 >= ptd->cliptop && ptd->clippedy0 < ptd->cliptop ) { + ptd->clippedx1 = ((ptd->clippedx1-ptd->clippedx0) / + (ptd->clippedy1-ptd->clippedy0) * + (ptd->cliptop -ptd->clippedy0)) + + ptd->clippedx0; + ptd->clippedy1 = ptd->cliptop ; + } + if (ptd->clippedy1 <= ptd->cliptop && ptd->clippedy0 > ptd->cliptop ) { + ptd->clippedx0 = ((ptd->clippedx1-ptd->clippedx0) / + (ptd->clippedy1-ptd->clippedy0) * + (ptd->cliptop -ptd->clippedy0)) + + ptd->clippedx0; + ptd->clippedy0 = ptd->cliptop ; + } +} + +static void PicTeX_Line(double x1, double y1, double x2, double y2, + const pGEcontext gc, + pDevDesc dd) +{ + picTeXDesc *ptd = (picTeXDesc *) dd->deviceSpecific; + + if (x1 != x2 || y1 != y2) { + SetLinetype(gc->lty, gc->lwd, dd); + if(ptd->debug) + fprintf(ptd->texfp, + "%% Drawing line from %.2f, %.2f to %.2f, %.2f\n", + x1, y1, x2, y2); + PicTeX_ClipLine(x1, y1, x2, y2, ptd); + if (ptd->debug) + fprintf(ptd->texfp, + "%% Drawing clipped line from %.2f, %.2f to %.2f, %.2f\n", + ptd->clippedx0, ptd->clippedy0, + ptd->clippedx1, ptd->clippedy1); + fprintf(ptd->texfp, "\\plot %.2f %.2f %.2f %.2f /\n", + ptd->clippedx0, ptd->clippedy0, + ptd->clippedx1, ptd->clippedy1); + } +} + +static void PicTeX_Polyline(int n, double *x, double *y, + const pGEcontext gc, + pDevDesc dd) +{ + double x1, y1, x2, y2; + int i; + picTeXDesc *ptd = (picTeXDesc *) dd->deviceSpecific; + + SetLinetype(gc->lty, gc->lwd, dd); + x1 = x[0]; + y1 = y[0]; + for (i = 1; i < n; i++) { + x2 = x[i]; + y2 = y[i]; + PicTeX_ClipLine(x1, y1, x2, y2, ptd); + fprintf(ptd->texfp, "\\plot %.2f %.2f %.2f %.2f /\n", + ptd->clippedx0, ptd->clippedy0, + ptd->clippedx1, ptd->clippedy1); + x1 = x2; + y1 = y2; + } +} + + /* String Width in Rasters */ + /* For the current font in pointsize fontsize */ + +static double PicTeX_StrWidth(const char *str, + const pGEcontext gc, + pDevDesc dd) +{ + picTeXDesc *ptd = (picTeXDesc *) dd->deviceSpecific; + + const char *p; + int size; + double sum; + + size = (int)(gc->cex * gc->ps + 0.5); + SetFont(gc->fontface, size, ptd); + sum = 0; + if(mbcslocale && ptd->fontface != 5) { + /* This version at least uses the state of the MBCS */ + size_t i, ucslen = mbcsToUcs2(str, NULL, 0, CE_NATIVE); + if (ucslen != (size_t)-1) { + ucs2_t ucs[ucslen]; + int status = (int) mbcsToUcs2(str, ucs, (int)ucslen, CE_NATIVE); + if (status >= 0) + for (i = 0; i < ucslen; i++) + if(ucs[i] < 128) sum += charwidth[ptd->fontface-1][ucs[i]]; + else sum += (double) Ri18n_wcwidth(ucs[i]) * 0.5; /* A guess */ + else + warning(_("invalid string in '%s'"), "PicTeX_StrWidth"); + } else + warning(_("invalid string in '%s'"), "PicTeX_StrWidth"); + } else + for(p = str; *p; p++) + sum += charwidth[ptd->fontface-1][(int)*p]; + + return sum * ptd->fontsize; +} + + +/* Possibly Filled Rectangle */ +static void PicTeX_Rect(double x0, double y0, double x1, double y1, + const pGEcontext gc, + pDevDesc dd) +{ + double x[4], y[4]; + + x[0] = x0; y[0] = y0; + x[1] = x0; y[1] = y1; + x[2] = x1; y[2] = y1; + x[3] = x1; y[3] = y0; + PicTeX_Polygon(4, x, y, gc, dd); +} + + +static void PicTeX_Circle(double x, double y, double r, + const pGEcontext gc, + pDevDesc dd) +{ + picTeXDesc *ptd = (picTeXDesc *) dd->deviceSpecific; + + fprintf(ptd->texfp, + "\\circulararc 360 degrees from %.2f %.2f center at %.2f %.2f\n", + x, (y + r), x, y); +} + +static void PicTeX_Polygon(int n, double *x, double *y, + const pGEcontext gc, + pDevDesc dd) +{ + double x1, y1, x2, y2; + int i; + picTeXDesc *ptd = (picTeXDesc *) dd->deviceSpecific; + + SetLinetype(gc->lty, gc->lwd, dd); + x1 = x[0]; + y1 = y[0]; + for (i=1; i<n; i++) { + x2 = x[i]; + y2 = y[i]; + PicTeX_ClipLine(x1, y1, x2, y2, ptd); + fprintf(ptd->texfp, "\\plot %.2f %.2f %.2f %.2f /\n", + ptd->clippedx0, ptd->clippedy0, + ptd->clippedx1, ptd->clippedy1); + x1 = x2; + y1 = y2; + } + x2 = x[0]; + y2 = y[0]; + PicTeX_ClipLine(x1, y1, x2, y2, ptd); + fprintf(ptd->texfp, "\\plot %.2f %.2f %.2f %.2f /\n", + ptd->clippedx0, ptd->clippedy0, + ptd->clippedx1, ptd->clippedy1); +} + +/* TeX Text Translations */ +static void textext(const char *str, picTeXDesc *ptd) +{ + fputc('{', ptd->texfp); + for( ; *str ; str++) + switch(*str) { + case '$': + fprintf(ptd->texfp, "\\$"); + break; + + case '%': + fprintf(ptd->texfp, "\\%%"); + break; + + case '{': + fprintf(ptd->texfp, "\\{"); + break; + + case '}': + fprintf(ptd->texfp, "\\}"); + break; + + case '^': + fprintf(ptd->texfp, "\\^{}"); + break; + + default: + fputc(*str, ptd->texfp); + break; + } + fprintf(ptd->texfp,"} "); +} + +/* Rotated Text */ + +static void PicTeX_Text(double x, double y, const char *str, + double rot, double hadj, + const pGEcontext gc, + pDevDesc dd) +{ + int size; + double xoff = 0.0, yoff = 0.0; + picTeXDesc *ptd = (picTeXDesc *) dd->deviceSpecific; + + size = (int)(gc->cex * gc->ps + 0.5); + SetFont(gc->fontface, size, ptd); + if(ptd->debug) + fprintf(ptd->texfp, + "%% Writing string of length %.2f, at %.2f %.2f, xc = %.2f yc = %.2f\n", + (double)PicTeX_StrWidth(str, gc, dd), + x, y, 0.0, 0.0); +#if 0 /* Original */ + fprintf(ptd->texfp,"\\put "); + textext(str, ptd); + if (rot == 90 ) + fprintf(ptd->texfp," [rB] <%.2fpt,%.2fpt>", xoff, yoff); + else fprintf(ptd->texfp," [lB] <%.2fpt,%.2fpt>", xoff, yoff); +#else /* use rotatebox */ + if (rot == 90 ){ + fprintf(ptd->texfp,"\\put {\\rotatebox{%d}",(int)rot); + textext(str, ptd); + fprintf(ptd->texfp,"} [rB] <%.2fpt,%.2fpt>", xoff, yoff); + } else { + fprintf(ptd->texfp,"\\put "); + textext(str, ptd); + fprintf(ptd->texfp," [lB] <%.2fpt,%.2fpt>", xoff, yoff); + } +#endif + fprintf(ptd->texfp," at %.2f %.2f\n", x, y); +} + +static +Rboolean PicTeXDeviceDriver(pDevDesc dd, const char *filename, + const char *bg, const char *fg, + double width, double height, + Rboolean debug) +{ + picTeXDesc *ptd; + + if (!(ptd = (picTeXDesc *) malloc(sizeof(picTeXDesc)))) + return FALSE; + + strcpy(ptd->filename, filename); + + dd->startfill = R_GE_str2col(bg); + dd->startcol = R_GE_str2col(fg); + dd->startps = 10; + dd->startlty = 0; + dd->startfont = 1; + dd->startgamma = 1; + + dd->close = PicTeX_Close; + dd->clip = PicTeX_Clip; + dd->size = PicTeX_Size; + dd->newPage = PicTeX_NewPage; + dd->line = PicTeX_Line; + dd->text = PicTeX_Text; + dd->strWidth = PicTeX_StrWidth; + dd->rect = PicTeX_Rect; + dd->circle = PicTeX_Circle; + /* dd->path = PicTeX_Path; not implemented */ + dd->polygon = PicTeX_Polygon; + dd->polyline = PicTeX_Polyline; + dd->metricInfo = PicTeX_MetricInfo; + dd->hasTextUTF8 = FALSE; + dd->useRotatedTextInContour = FALSE; + + /* Screen Dimensions in Pixels */ + + dd->left = 0; /* left */ + dd->right = in2dots(width);/* right */ + dd->bottom = 0; /* bottom */ + dd->top = in2dots(height);/* top */ + dd->clipLeft = dd->left; dd->clipRight = dd->right; + dd->clipBottom = dd->bottom; dd->clipTop = dd->top; + ptd->width = width; + ptd->height = height; + + if( ! PicTeX_Open(dd, ptd) ) + return FALSE; + + /* Base Pointsize */ + /* Nominal Character Sizes in Pixels */ + + dd->cra[0] = 9; + dd->cra[1] = 12; + + /* Character Addressing Offsets */ + /* These offsets should center a single */ + /* plotting character over the plotting point. */ + /* Pure guesswork and eyeballing ... */ + + dd->xCharOffset = 0; /*0.4900;*/ + dd->yCharOffset = 0; /*0.3333;*/ + dd->yLineBias = 0; /*0.1;*/ + + /* Inches per Raster Unit */ + /* We use printer points, i.e. 72.27 dots per inch : */ + dd->ipr[0] = dd->ipr[1] = 1./DOTSperIN; + + dd->canClip = TRUE; + dd->canHAdj = 0; + dd->canChangeGamma = FALSE; + + ptd->lty = 1; + ptd->pageno = 0; + ptd->debug = debug; + + dd->haveTransparency = 1; + dd->haveTransparentBg = 2; + + dd->deviceSpecific = (void *) ptd; + dd->displayListOn = FALSE; + return TRUE; +} + +/* PicTeX Device Driver Parameters + * -------------------- + * file = output filename + * bg = background color + * fg = foreground color + * width = width in inches + * height = height in inches + * debug = Rboolean; if TRUE, write TeX-Comments into output. + */ + +SEXP PicTeX(SEXP args) +{ + pGEDevDesc dd; + const char *file, *bg, *fg; + double height, width; + Rboolean debug; + + const void *vmax = vmaxget(); + args = CDR(args); /* skip entry point name */ + file = translateChar(asChar(CAR(args))); args = CDR(args); + bg = CHAR(asChar(CAR(args))); args = CDR(args); + fg = CHAR(asChar(CAR(args))); args = CDR(args); + width = asReal(CAR(args)); args = CDR(args); + height = asReal(CAR(args)); args = CDR(args); + debug = asLogical(CAR(args)); args = CDR(args); + if(debug == NA_LOGICAL) debug = FALSE; + + R_CheckDeviceAvailable(); + BEGIN_SUSPEND_INTERRUPTS { + pDevDesc dev; + if (!(dev = (pDevDesc) calloc(1, sizeof(DevDesc)))) + return 0; + if(!PicTeXDeviceDriver(dev, file, bg, fg, width, height, debug)) { + free(dev); + error(_("unable to start %s() device"), "pictex"); + } + dd = GEcreateDevDesc(dev); + GEaddDevice2f(dd, "pictex", file); + } END_SUSPEND_INTERRUPTS; + vmaxset(vmax); + return R_NilValue; +} diff --git a/com.oracle.truffle.r.native/gnur/patch/src/library/grDevices/src/devQuartz.c b/com.oracle.truffle.r.native/gnur/patch/src/library/grDevices/src/devQuartz.c new file mode 100644 index 0000000000000000000000000000000000000000..52f7abab882a61ed928fe6e37e960eaf8cc6e56c --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/library/grDevices/src/devQuartz.c @@ -0,0 +1,1629 @@ +/* + * R : A Computer Language for Statistical Data Analysis + * Copyright (C) 2007-11 The R Foundation + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version. + * + * This program 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 this program; if not, a copy is available at + * https://www.R-project.org/Licenses/ + * + * Modular Quartz device for macOS + * + * Partially based on code by Byron Ellis + */ + +#ifdef HAVE_CONFIG_H +#include <config.h> +#endif + +#if HAVE_AQUA + +#include <Defn.h> +#include <Rinternals.h> +#define R_USE_PROTOTYPES 1 +#include <R_ext/GraphicsEngine.h> +/* This sets ptr_QuartzBackend as a symbol in this file */ +#define IN_AQUA_C 1 +#include <R_ext/QuartzDevice.h> + +#include "grDevices.h" + +#include <CoreFoundation/CoreFoundation.h> + +#define DEVQUARTZ_VERSION 1 /* first public Quartz API version */ + +#define QBE_NATIVE 1 /* either Cocoa or Carbon depending on the macOS version */ +#define QBE_COCOA 2 /* internal Cocoa */ +#define QBE_CARBON 3 /* internal Carbon */ +#define QBE_BITMAP 4 /* bitmap file creating */ +#define QBE_PDF 5 /* PDF file creating */ + +typedef struct moduleTypes_s { + const char *type; + const char *subst; + int qbe; /* Quartz back-end */ +} quartz_module_t; + +/* list of internally supported output modules */ +const quartz_module_t quartz_modules[] = { + { "", 0, QBE_NATIVE }, + { "native", 0, QBE_NATIVE }, + { "cocoa", 0, QBE_COCOA }, + { "carbon", 0, QBE_CARBON }, + { "pdf", 0, QBE_PDF }, + { "png", "public.png", QBE_BITMAP }, + { "jpeg", "public.jpeg", QBE_BITMAP }, + { "jpg", "public.jpeg", QBE_BITMAP }, + { "jpeg2000","public.jpeg-2000", QBE_BITMAP }, + { "tiff", "public.tiff", QBE_BITMAP }, + { "tif", "public.tiff", QBE_BITMAP }, + { "gif", "com.compuserve.gif", QBE_BITMAP }, + { "psd", "com.adobe.photoshop-image", QBE_BITMAP }, + { "bmp", "com.microsoft.bmp", QBE_BITMAP }, + { "sgi", "com.sgi.sgi-image", QBE_BITMAP }, + { "pict", "com.apple.pict", QBE_BITMAP }, + { 0, 0, 0} }; + + + +/* for compatibility with macOS <10.5 */ +#ifndef CGFLOAT_DEFINED +typedef float CGFloat; +#define CGFLOAT_MIN FLT_MIN +#define CGFLOAT_MAX FLT_MAX +#define CGFLOAT_IS_DOUBLE 0 +#define CGFLOAT_DEFINED 1 +#endif + +typedef struct QuartzSpecific_s { + double ps; + double scalex, scaley; /* resolution correction: px/pt ratio */ + double width,height; /* size (in inches) */ + double tscale; /* text scale (resolution independent, + i.e. it constitutes a text zoom factor */ + int dirty; /* dirtly flag. Not acted upon by the Quartz + core, but QC sets it whenever a drawing + operation is performed (see detailed + description in R_ext/QuartzDevice.h) */ + int gstate; /* gstate counter */ + int async; /* asynchronous drawing (i.e. context was + not ready for an operation) */ + int bg; /* background color */ + int canvas; /* background color */ + int antialias,smooth;/* smoothing flags (only aa makes any sense) */ + int flags; /* additional QDFLAGs */ + int holdlevel; /* hold level */ + int redraw; /* redraw flag is set when replaying + and inhibits syncs on Mode */ + CGRect clipRect; /* clipping rectangle */ + pDevDesc dev; /* device structure holding this one */ + CGFontRef font; /* currently used font */ + + void* userInfo; /* pointer to a module-dependent space */ + + /* callbacks - except for getCGContext all others are optional */ + CGContextRef (*getCGContext)(QuartzDesc_t dev, void *userInfo); + int (*locatePoint)(QuartzDesc_t dev, void *userInfo, double *x, double *y); + void (*close)(QuartzDesc_t dev, void *userInfo); + void (*newPage)(QuartzDesc_t dev, void *userInfo, int flags); + void (*state)(QuartzDesc_t dev, void *userInfo, int state); + void* (*par)(QuartzDesc_t dev, void *userInfo, int set, const char *key, void *value); + void (*sync)(QuartzDesc_t dev, void *userInfo); + void* (*cap)(QuartzDesc_t dev, void*userInfo); +} QuartzDesc; + +/* coordinates: + - R graphics (positions etc., usually points) + - real size (e.g. inches) + - display view (usually pixels) + + bookkeeping: + - QuartzDevice.width/height: inches + - R GE size (.._Size): points + - physical (on-screen) coordinates : pixels + +the current implementation uses points as plotting units (i.e. this is what +Quartz tells R), but the canvas is specified in pixels. The scalex/y factors +specify the conversion factor between pixels and points. +We are *not* using R's scaling facilities, because R doesn't work with +non-square pixels (e.g. circles become ellipses). + +FIXME: yes it does -- ipr is a two-element array. + -- not entirely, because it uses text (e.g. "o") as symbols which is rendered + in 1:1 aspect ratio and thus is squished on displays with non-square pixels +(That being a bug in Quartz, then!) + +Actually, dp not points are used. +*/ + +#pragma mark QuartzDevice API (for modules) + +/* Update should be called when ps or tscale change. + Conservatively, it should be called on scale change, too, in case + we decide to abandon the CTM approach */ +static void QuartzDevice_Update(QuartzDesc_t desc); + +/* this function must be called after a new context is created. + it primes the context for drawing */ +void QuartzDevice_ResetContext(QuartzDesc_t desc) { + QuartzDesc *qd = ((QuartzDesc*) desc); + qd->gstate = 0; + qd->dirty = 0; + if (qd->getCGContext) { + CGContextRef ctx = qd->getCGContext(qd, qd->userInfo); + if (ctx) { + CGContextSetAllowsAntialiasing(ctx, qd->antialias); + CGContextSetShouldSmoothFonts(ctx, qd->smooth); + CGContextScaleCTM(ctx, qd->scalex, qd->scaley); + CGContextSaveGState(ctx); + qd->gstate = 1; + } + } +} + +/* Uses (e.g. in window title) seems to assume this is 1-based */ +int QuartzDevice_DevNumber(QuartzDesc_t desc) { + return 1 + ndevNumber((((QuartzDesc*) desc)->dev)); +} + +double QuartzDevice_GetWidth(QuartzDesc_t desc) { return ((QuartzDesc*) desc)->width; } +double QuartzDevice_GetHeight(QuartzDesc_t desc) { return ((QuartzDesc*) desc)->height; } +void QuartzDevice_SetSize(QuartzDesc_t desc, double width, double height) +{ + QuartzDesc *qd = ((QuartzDesc*) desc); + qd->width = width; + qd->height = height; + qd->dev->right = width*72.0; + qd->dev->bottom = height*72.0; +} + +double QuartzDevice_GetScaledWidth(QuartzDesc_t desc) { QuartzDesc *qd=((QuartzDesc*) desc); return qd->scalex*qd->width*72.0; } +double QuartzDevice_GetScaledHeight(QuartzDesc_t desc) { QuartzDesc *qd=((QuartzDesc*) desc); return qd->scaley*qd->height*72.0; } +void QuartzDevice_SetScaledSize(QuartzDesc_t desc, double width, double height) { + QuartzDesc *qd=((QuartzDesc*) desc); + QuartzDevice_SetSize(desc, width/qd->scalex/72.0, height/qd->scaley/72.0); +} + +double QuartzDevice_GetXScale(QuartzDesc_t desc) { return ((QuartzDesc*) desc)->scalex; } +double QuartzDevice_GetYScale(QuartzDesc_t desc) { return ((QuartzDesc*) desc)->scaley; } +void QuartzDevice_SetScale(QuartzDesc_t desc, double scalex, double scaley) { + ((QuartzDesc*) desc)->scalex = scalex; + ((QuartzDesc*) desc)->scaley = scaley; + QuartzDevice_Update(desc); +} + +double QuartzDevice_GetTextScale(QuartzDesc_t desc) { + return ((QuartzDesc*) desc)->tscale; +} + +void QuartzDevice_SetTextScale(QuartzDesc_t desc, double scale) { + ((QuartzDesc*) desc)->tscale = scale; + QuartzDevice_Update(desc); +} + +double QuartzDevice_GetPointSize(QuartzDesc_t desc) { + return ((QuartzDesc*) desc)->ps; +} + +void QuartzDevice_SetPointSize(QuartzDesc_t desc, double ps) { + ((QuartzDesc*) desc)->ps = ps; + QuartzDevice_Update(desc); +} + +int QuartzDevice_GetDirty(QuartzDesc_t desc) { return ((QuartzDesc*) desc)->dirty; } +void QuartzDevice_SetDirty(QuartzDesc_t desc,int dirty) { ((QuartzDesc*) desc)->dirty = dirty; } + +int QuartzDevice_GetAntialias(QuartzDesc_t desc) { return ((QuartzDesc*) desc)->antialias; } +void QuartzDevice_SetAntialias(QuartzDesc_t desc,int aa) { + QuartzDesc *qd = (QuartzDesc*) desc; + qd->antialias = aa; + if(NULL != qd->getCGContext) + CGContextSetAllowsAntialiasing( qd->getCGContext(qd, qd->userInfo), aa ); +} + +void QuartzDevice_Kill(QuartzDesc_t desc) { + pGEDevDesc dd = GEgetDevice(ndevNumber(((QuartzDesc*) desc)->dev)); + if (dd) GEkillDevice(dd); +} + +int QuartzDesc_GetFontSmooth(QuartzDesc_t desc) { return ((QuartzDesc*) desc)->smooth; } +void QuartzDesc_SetFontSmooth(QuartzDesc_t desc, int fs) { + QuartzDesc *qd = (QuartzDesc*) desc; + qd->smooth = fs; + if(qd->getCGContext) + CGContextSetShouldSmoothFonts( qd->getCGContext(qd, qd->userInfo), fs); +} + +int QuartzDevice_GetBackground(QuartzDesc_t desc) { return ((QuartzDesc*) desc)->bg; } + +static void QuartzDevice_Update(QuartzDesc_t desc) +{ + QuartzDesc *qd = (QuartzDesc*) desc; + pDevDesc dev= qd->dev; + + /* pre-scaling happens in Quartz (using CTM), so scales should not be + reflected in R measurements. We tell R to use 72dpi which corresponds + to plotting in pt coordinates */ + dev->cra[0] = 0.9*qd->ps*qd->tscale; + dev->cra[1] = 1.2*qd->ps*qd->tscale; + dev->ipr[0] = 1.0/72.0; + dev->ipr[1] = 1.0/72.0; +} + +void QuartzDevice_Activate(QuartzDesc_t desc) +{ + QuartzDesc *qd = (QuartzDesc*) desc; + if (qd) { + int n = ndevNumber(qd->dev); + selectDevice(n); + } +} + +void QuartzDevice_ReplayDisplayList(QuartzDesc_t desc) +{ + QuartzDesc *qd = (QuartzDesc*) desc; + int _dirty = qd->dirty; + pGEDevDesc gdd = desc2GEDesc(qd->dev); + qd->redraw = 1; + /* CHECK this */ + if(gdd->displayList != R_NilValue) GEplayDisplayList(gdd); + qd->redraw = 0; + qd->dirty = _dirty; /* we do NOT change the dirty flag */ +} + +void* QuartzDevice_GetSnapshot(QuartzDesc_t desc, int last) +{ + QuartzDesc *qd = (QuartzDesc*) desc; + pGEDevDesc gd = GEgetDevice(ndevNumber(qd->dev)); + SEXP snap; + if (last) + snap = desc2GEDesc(qd->dev)->savedSnapshot; + else + snap = GEcreateSnapshot(gd); + if (R_NilValue == VECTOR_ELT(snap, 0)) + snap = 0; + return (snap == R_NilValue) ? 0 : snap; +} + +void QuartzDevice_RestoreSnapshot(QuartzDesc_t desc, void* snap) +{ + QuartzDesc *qd = (QuartzDesc*) desc; + pGEDevDesc gd = GEgetDevice(ndevNumber(qd->dev)); + if(NULL == snap) return; /*Aw, hell no!*/ + PROTECT((SEXP)snap); + if(R_NilValue == VECTOR_ELT(snap,0)) + warning("Tried to restore an empty snapshot?"); + qd->redraw = 1; + GEplaySnapshot((SEXP)snap, gd); + qd->redraw = 0; + qd->dirty = 0; /* we reset the dirty flag */ + UNPROTECT(1); +} + +static int quartz_embedding = 0; + +static void* QuartzDevice_SetParameter(QuartzDesc_t desc, const char *key, void *value) +{ + if (desc) { /* backend-specific? pass it on */ + QuartzDesc *qd = (QuartzDesc*) desc; + return (qd->par) ? qd->par(qd, qd->userInfo, 1, key, value) : NULL; + } else { /* global? try to handle it */ + if (key) { + if (!streql(key, QuartzParam_EmbeddingFlags)) { + if (value) quartz_embedding = ((int*)value)[0]; + return &quartz_embedding; + } + } + } + return NULL; +} + +void setup_RdotApp(void) +{ + int eflags = QP_Flags_CFLoop | QP_Flags_Cocoa | QP_Flags_Front; + QuartzDevice_SetParameter(NULL, QuartzParam_EmbeddingFlags, &eflags); +} + +static void* QuartzDevice_GetParameter(QuartzDesc_t desc, const char *key) +{ + if (desc) { /* backend-specific? pass it on */ + QuartzDesc *qd = (QuartzDesc*) desc; + return (qd->par) ? qd->par(qd, qd->userInfo, 0, key, NULL) : NULL; + } else { /* global? try to handle it */ + if (key) { + if (!streql(key, QuartzParam_EmbeddingFlags)) return &quartz_embedding; + } + } + return NULL; +} + +#pragma mark RGD API Function Prototypes + +static void RQuartz_Close(pDevDesc); +static void RQuartz_Activate(pDevDesc); +static void RQuartz_Deactivate(pDevDesc); +static void RQuartz_Size(double*, double*, double*, double*, pDevDesc); +static void RQuartz_NewPage(const pGEcontext, pDevDesc); +static int RQuartz_HoldFlush(pDevDesc, int); +static void RQuartz_Clip(double, double, double, double, pDevDesc); +static double RQuartz_StrWidth(const char*, const pGEcontext, pDevDesc); +static void RQuartz_Text(double, double, const char*, double, double, const pGEcontext, pDevDesc); +static void RQuartz_Rect(double, double, double, double, const pGEcontext, pDevDesc); +static void RQuartz_Raster(unsigned int *raster, int w, int h, + double x, double y, double width, double height, + double rot, Rboolean interpolate, + const pGEcontext gc, pDevDesc dd); +static SEXP RQuartz_Cap(pDevDesc dd); +static void RQuartz_Circle(double, double, double, const pGEcontext, pDevDesc); +static void RQuartz_Line(double, double, double, double, const pGEcontext, pDevDesc); +static void RQuartz_Polyline(int, double*, double*, const pGEcontext, pDevDesc); +static void RQuartz_Polygon(int, double*, double*, const pGEcontext, pDevDesc); +static void RQuartz_Path(double*, double*, int, int*, Rboolean, const pGEcontext, pDevDesc); +static Rboolean RQuartz_Locator(double*, double*, pDevDesc); +static void RQuartz_Mode(int mode, pDevDesc); +static void RQuartz_MetricInfo(int, const pGEcontext , double*, double*, double*, pDevDesc); + +#pragma mark Quartz device implementation + +void* QuartzDevice_Create(void *_dev, QuartzBackend_t *def) +{ + pDevDesc dev = _dev; + + dev->startfill = def->bg; + dev->startcol = R_RGB(0, 0, 0); + dev->startps = def->pointsize; + dev->startfont = 1; + dev->startlty = LTY_SOLID; + dev->startgamma= 1; + + /* Set up some happy pointers */ + dev->close = RQuartz_Close; + dev->activate = RQuartz_Activate; + dev->deactivate = RQuartz_Deactivate; + dev->size = RQuartz_Size; + dev->newPage = RQuartz_NewPage; + dev->clip = RQuartz_Clip; + dev->strWidth = RQuartz_StrWidth; + dev->text = RQuartz_Text; + dev->rect = RQuartz_Rect; + dev->raster = RQuartz_Raster; + dev->cap = RQuartz_Cap; + dev->circle = RQuartz_Circle; + dev->line = RQuartz_Line; + dev->polyline = RQuartz_Polyline; + dev->polygon = RQuartz_Polygon; + dev->path = RQuartz_Path; + dev->locator = RQuartz_Locator; + dev->mode = RQuartz_Mode; + dev->metricInfo = RQuartz_MetricInfo; + dev->holdflush = RQuartz_HoldFlush; + dev->hasTextUTF8 = TRUE; + dev->textUTF8 = RQuartz_Text; + dev->strWidthUTF8 = RQuartz_StrWidth; + + dev->left = 0; + dev->top = 0; + + + /* Magic numbers from on high. */ + dev->xCharOffset = 0.4900; + dev->yCharOffset = 0.3333; + dev->yLineBias = 0.20; /* This is .2 for PS/PDF devices... */ + + dev->canClip = TRUE; + dev->canHAdj = 2; + dev->canChangeGamma= FALSE; + dev->displayListOn = (def->flags & QDFLAG_DISPLAY_LIST) ? TRUE : FALSE; + + dev->haveTransparency = 2; + dev->haveTransparentBg = 3; /* FIXME: depends on underlying device */ + dev->haveRaster = 2; + dev->haveCapture = (def->cap) ? 2 : 1; + dev->haveLocator = (def->locatePoint) ? 2 : 1; + + QuartzDesc *qd = calloc(1, sizeof(QuartzDesc)); + qd->width = def->width; + qd->height = def->height; + qd->userInfo = def->userInfo; + qd->getCGContext=def->getCGContext; + qd->locatePoint= def->locatePoint; + qd->close = def->close; + qd->newPage = def->newPage; + qd->state = def->state; + qd->sync = def->sync; + qd->cap = def->cap; + qd->scalex = def->scalex; + qd->scaley = def->scaley; + qd->tscale = 1.0; + qd->ps = def->pointsize; + qd->bg = def->bg; + qd->canvas = def->canvas; + qd->antialias = (def->flags & QPFLAG_ANTIALIAS) ? 1 : 0; + qd->flags = def->flags; + qd->gstate = 0; + qd->font = NULL; + + dev->deviceSpecific = qd; + qd->dev = dev; + + QuartzDevice_Update(qd); + + /* Re-set for bitmap devices later */ + dev->right = def->width*72.0; + dev->bottom= def->height*72.0; + + qd->clipRect = CGRectMake(0, 0, dev->right, dev->bottom); + + qd->dirty = 0; + qd->redraw= 0; + qd->async = 0; + qd->holdlevel = 0; + return (QuartzDesc_t)qd; +} + +static QuartzFunctions_t qfn = { + QuartzDevice_Create, + QuartzDevice_DevNumber, + QuartzDevice_Kill, + QuartzDevice_ResetContext, + QuartzDevice_GetWidth, + QuartzDevice_GetHeight, + QuartzDevice_SetSize, + QuartzDevice_GetScaledWidth, + QuartzDevice_GetScaledHeight, + QuartzDevice_SetScaledSize, + QuartzDevice_GetXScale, + QuartzDevice_GetYScale, + QuartzDevice_SetScale, + QuartzDevice_SetTextScale, + QuartzDevice_GetTextScale, + QuartzDevice_SetPointSize, + QuartzDevice_GetPointSize, + QuartzDevice_GetDirty, + QuartzDevice_SetDirty, + QuartzDevice_ReplayDisplayList, + QuartzDevice_GetSnapshot, + QuartzDevice_RestoreSnapshot, + QuartzDevice_GetAntialias, + QuartzDevice_SetAntialias, + QuartzDevice_GetBackground, + QuartzDevice_Activate, + QuartzDevice_SetParameter, + QuartzDevice_GetParameter +}; + +/* currrently unused: was used by R.app via aqua.c */ +QuartzFunctions_t *getQuartzAPI() { + return &qfn; +} + +/* old macOS versions has different names for some of the CGFont stuff */ +#if MAC_OS_X_VERSION_MAX_ALLOWED <= MAC_OS_X_VERSION_10_4 +#define CGFontCreateWithFontName CGFontCreateWithName +#define CGFontGetGlyphBBoxes CGFontGetGlyphBoundingBoxes +/* The following is a real pain. We have to work around bugs in CoreGraphics + and Apple's dyloader simultaneously so a 10.4 binary runs on 10.5 as well. */ +typedef void (*RQFontGetGlyphsForUnichars_t)(CGFontRef a, const UniChar b[], CGGlyph c[], size_t d); +static RQFontGetGlyphsForUnichars_t RQFontGetGlyphsForUnichars; +#include <dlfcn.h> /* dynamically find the right entry point on initialization */ +__attribute__((constructor)) static void RQ_init() { + void *r; + if ((r = dlsym(RTLD_NEXT, "CGFontGetGlyphsForUnichars")) || (r = dlsym(RTLD_NEXT, "CGFontGetGlyphsForUnicodes")) || + (r = dlsym(RTLD_DEFAULT, "CGFontGetGlyphsForUnichars")) || (r = dlsym(RTLD_DEFAULT, "CGFontGetGlyphsForUnicodes"))) + RQFontGetGlyphsForUnichars = (RQFontGetGlyphsForUnichars_t) r; + else + error("Cannot load CoreGraphics"); /* this should never be reached but I suppose it's better than a hidden segfault */ +} +#define CGFontGetGlyphsForUnichars RQFontGetGlyphsForUnichars +/* and some missing declarations */ +extern CGFontRef CGFontCreateWithName(CFStringRef); +extern bool CGFontGetGlyphAdvances(CGFontRef font, const CGGlyph glyphs[], size_t count, int advances[]); +extern int CGFontGetUnitsPerEm(CGFontRef font); +extern bool CGFontGetGlyphBBoxes(CGFontRef font, const CGGlyph glyphs[], size_t count, CGRect bboxes[]); +#else +extern void CGFontGetGlyphsForUnichars(CGFontRef, const UniChar[], CGGlyph[], size_t); +#endif + +extern CGFontRef CGContextGetFont(CGContextRef); + +#define DEVDESC pDevDesc dd +#define CTXDESC const pGEcontext gc, pDevDesc dd + +#define DEVSPEC QuartzDesc *xd = (QuartzDesc*) dd->deviceSpecific; CGContextRef ctx = xd->getCGContext(xd, xd->userInfo) +#define DRAWSPEC QuartzDesc *xd = (QuartzDesc*) dd->deviceSpecific; CGContextRef ctx = xd->getCGContext(xd, xd->userInfo); xd->dirty = 1 +#define XD QuartzDesc *xd = (QuartzDesc*) dd->deviceSpecific + +#pragma mark Quartz Font Cache + +/* Font lookup is expesive yet frequent. Therefore we cache all used ATS fonts (which are global to the app). */ + +typedef struct font_cache_entry_s { + ATSFontRef font; + char *family; + int face; +} font_cache_entry_t; + +#define max_fonts_per_block 32 + +typedef struct font_cache_s { + font_cache_entry_t e[max_fonts_per_block]; + int fonts; + struct font_cache_s *next; +} font_cache_t; + +font_cache_t font_cache, *font_cache_tail = &font_cache; + +static ATSFontRef RQuartz_CacheGetFont(const char *family, int face) { + font_cache_t *fc = &font_cache; + while (fc) { + int i = 0, j = fc->fonts; + while (i < j) { + if (face == fc->e[i].face && streql(family, fc->e[i].family)) + return fc->e[i].font; + i++; + } + fc = fc->next; + } + return 0; +} + +static void RQuartz_CacheAddFont(const char *family, int face, ATSFontRef font) { + if (font_cache_tail->fonts >= max_fonts_per_block) + font_cache_tail = font_cache_tail->next = (font_cache_t*) calloc(1, sizeof(font_cache_t)); + { + int i = font_cache_tail->fonts; + font_cache_tail->e[i].font = font; + font_cache_tail->e[i].family = strdup(family); + font_cache_tail->e[i].face = face; + font_cache_tail->fonts++; + } +} + +#ifdef UNUSED +static void RQuartz_CacheRelease() { + font_cache_t *fc = &font_cache; + while (fc) { + font_cache_t *next = fc->next; + int i = 0, j = fc->fonts; + while (i < j) free(fc->e[i++].family); + if (fc != &font_cache) free(fc); + fc = next; + } + font_cache.fonts = 0; +} +#endif + +#pragma mark Device Implementation + +/* mapping of virtual family names (e.g "serif") and face to real font names using .Quartzenv$.Quartz.Fonts list */ +const char *RQuartz_LookUpFontName(int fontface, const char *fontfamily) +{ + const char *mappedFont = 0; + SEXP ns, env, db, names; + PROTECT_INDEX index; + PROTECT(ns = R_FindNamespace(ScalarString(mkChar("grDevices")))); + PROTECT_WITH_INDEX(env = findVar(install(".Quartzenv"), ns), &index); + if(TYPEOF(env) == PROMSXP) + REPROTECT(env = eval(env,ns) ,index); + PROTECT(db = findVar(install(".Quartz.Fonts"), env)); + PROTECT(names = getAttrib(db, R_NamesSymbol)); + if (*fontfamily) { + int i; + for(i = 0; i < length(names); i++) + if(streql(fontfamily, CHAR(STRING_ELT(names, i)))) { + mappedFont = CHAR(STRING_ELT(VECTOR_ELT(db, i), fontface - 1)); + break; + } + } + UNPROTECT(4); + return mappedFont; +} + +/* get a font according to the current graphics context */ +CGFontRef RQuartz_Font(CTXDESC) +{ + const char *fontName = NULL, *fontFamily = gc->fontfamily; + ATSFontRef atsFont = 0; + int fontFace = gc->fontface; + if (fontFace < 1 || fontFace > 5) fontFace = 1; /* just being paranoid */ + if (fontFace == 5) + fontName = "Symbol"; + else + fontName = RQuartz_LookUpFontName(fontFace, fontFamily[0] ? fontFamily : "default"); + if (fontName) { + atsFont = RQuartz_CacheGetFont(fontName, 0); /* face is 0 because we are passing a true font name */ + if (!atsFont) { /* not in the cache, get it */ + CFStringRef cfFontName = CFStringCreateWithCString(NULL, fontName, kCFStringEncodingUTF8); + atsFont = ATSFontFindFromName(cfFontName, kATSOptionFlagsDefault); + if (!atsFont) + atsFont = ATSFontFindFromPostScriptName(cfFontName, kATSOptionFlagsDefault); + CFRelease(cfFontName); + if (!atsFont) { + warning(_("font \"%s\" could not be found for family \"%s\""), fontName, fontFamily); + return NULL; + } + RQuartz_CacheAddFont(fontName, 0, atsFont); + } + } else { /* the real font name could not be looked up. We must use cache and/or find the right font by family and face */ + if (!fontFamily[0]) fontFamily = "Arial"; + /* Arial is the default, because Helvetica doesn't have Oblique + on 10.4 - maybe change later? */ + atsFont = RQuartz_CacheGetFont(fontFamily, fontFace); + if (!atsFont) { /* not in the cache? Then we need to find the + proper font name from the family name and face */ + /* as it turns out kATSFontFilterSelectorFontFamily is not + implemented in macOS (!!) so there is no way to query for a + font from a specific family. Therefore we have to use + text-matching heuristics ... very nasty ... */ + char compositeFontName[256]; + /* CFStringRef cfFontName; */ + if (strlen(fontFamily) > 210) error(_("font family name is too long")); + while (!atsFont) { /* try different faces until exhausted or successful */ + strcpy(compositeFontName, fontFamily); + if (fontFace == 2 || fontFace == 4) strcat(compositeFontName, " Bold"); + if (fontFace == 3 || fontFace == 4) strcat(compositeFontName, " Italic"); + CFStringRef cfFontName = CFStringCreateWithCString(NULL, compositeFontName, kCFStringEncodingUTF8); + atsFont = ATSFontFindFromName(cfFontName, kATSOptionFlagsDefault); + if (!atsFont) atsFont = ATSFontFindFromPostScriptName(cfFontName, kATSOptionFlagsDefault); + CFRelease(cfFontName); + if (!atsFont) { + if (fontFace == 1) { /* more guessing - fontFace == 1 may need Regular or Roman */ + strcat(compositeFontName," Regular"); + cfFontName = CFStringCreateWithCString(NULL, compositeFontName, kCFStringEncodingUTF8); + atsFont = ATSFontFindFromName(cfFontName, kATSOptionFlagsDefault); + CFRelease(cfFontName); + if (!atsFont) { + strcpy(compositeFontName, fontFamily); + strcat(compositeFontName," Roman"); + cfFontName = CFStringCreateWithCString(NULL, compositeFontName, kCFStringEncodingUTF8); + atsFont = ATSFontFindFromName(cfFontName, kATSOptionFlagsDefault); + CFRelease(cfFontName); + } + } else if (fontFace == 3 || fontFace == 4) { /* Oblique is sometimes used instead of Italic (e.g. in Helvetica) */ + strcpy(compositeFontName, fontFamily); + if (fontFace == 4) strcat(compositeFontName, " Bold"); + strcat(compositeFontName," Oblique"); + cfFontName = CFStringCreateWithCString(NULL, compositeFontName, kCFStringEncodingUTF8); + atsFont = ATSFontFindFromName(cfFontName, kATSOptionFlagsDefault); + CFRelease(cfFontName); + } + } + if (!atsFont) { /* try to fall back to a more plain face */ + if (fontFace == 4) fontFace = 2; + else if (fontFace != 1) fontFace = 1; + else break; + atsFont = RQuartz_CacheGetFont(fontFamily, fontFace); + if (atsFont) break; + } + } + if (!atsFont) + warning(_("no font could be found for family \"%s\""), fontFamily); + else + RQuartz_CacheAddFont(fontFamily, fontFace, atsFont); + } + } + + return CGFontCreateWithPlatformFont(&atsFont); +} + +#define RQUARTZ_FILL (1) +#define RQUARTZ_STROKE (1<<1) +#define RQUARTZ_LINE (1<<2) + +static void RQuartz_SetFont(CGContextRef ctx, const pGEcontext gc, QuartzDesc *xd) { + CGFontRef font = RQuartz_Font(gc, NULL); + if (font) { + CGContextSetFont(ctx, font); + if (font != xd->font) { + if (xd->font) CGFontRelease(xd->font); + xd->font = font; + } + } + CGContextSetFontSize(ctx, gc->cex * gc->ps); +} + +/* pre-10.5 doesn't have kCGColorSpaceGenericRGB so fall back to kCGColorSpaceGenericRGB */ +#if MAC_OS_X_VERSION_10_4 >= MAC_OS_X_VERSION_MAX_ALLOWED +#define kCGColorSpaceSRGB kCGColorSpaceGenericRGB +#endif + +void RQuartz_Set(CGContextRef ctx,const pGEcontext gc,int flags) { + CGColorSpaceRef cs = CGColorSpaceCreateWithName(kCGColorSpaceSRGB); + if(flags & RQUARTZ_FILL) { + int fill = gc->fill; + CGFloat fillColor[] = { R_RED(fill)/255.0, + R_GREEN(fill)/255.0, + R_BLUE(fill)/255.0, + R_ALPHA(fill)/255.0 }; + CGColorRef fillColorRef = CGColorCreate(cs, fillColor); + CGContextSetFillColorWithColor(ctx, fillColorRef); + CGColorRelease(fillColorRef); + } + if(flags & RQUARTZ_STROKE) { + int stroke = gc->col; + CGFloat strokeColor[] = { R_RED(stroke)/255.0, + R_GREEN(stroke)/255.0, + R_BLUE(stroke)/255.0, + R_ALPHA(stroke)/255.0 }; + CGColorRef strokeColorRef = CGColorCreate(cs, strokeColor); + CGContextSetStrokeColorWithColor(ctx, strokeColorRef); + CGColorRelease(strokeColorRef); + } + if(flags & RQUARTZ_LINE) { + CGFloat dashlist[8]; + int i, ndash = 0; + int lty = gc->lty; + float lwd = (float)(gc->lwd * 0.75); + CGContextSetLineWidth(ctx, lwd); + + for(i = 0; i < 8 && lty; i++) { + dashlist[ndash++] = (lwd >= 1 ? lwd : 1) * (lty & 15); + lty >>= 4; + } + CGContextSetLineDash(ctx, 0, dashlist, ndash); + CGLineCap cap = kCGLineCapButt; + switch(gc->lend) { + case GE_ROUND_CAP: cap = kCGLineCapRound; break; + case GE_BUTT_CAP: cap = kCGLineCapButt; break; + case GE_SQUARE_CAP: cap = kCGLineCapSquare; break; + } + CGContextSetLineCap(ctx,cap); + CGLineJoin join = kCGLineJoinRound; + switch(gc->ljoin) { + case GE_ROUND_JOIN: join = kCGLineJoinRound; break; + case GE_MITRE_JOIN: join = kCGLineJoinMiter; break; + case GE_BEVEL_JOIN: join = kCGLineJoinBevel; break; + } + CGContextSetLineJoin(ctx, join); + CGContextSetMiterLimit(ctx, gc->lmitre); + } + CGColorSpaceRelease(cs); +} + +#define SET(X) RQuartz_Set(ctx, gc, (X)) +#define NOCTX { xd->async = 1; return; } +#define NOCTXR(V) { xd->async = 1; return(V); } + + +static void RQuartz_Close(DEVDESC) +{ + XD; + if (xd->close) xd->close(xd, xd->userInfo); +} + +static void RQuartz_Activate(DEVDESC) +{ + XD; + if (xd->state) xd->state(xd, xd->userInfo, 1); +} + +static void RQuartz_Deactivate(DEVDESC) +{ + XD; + if (xd->state) xd->state(xd, xd->userInfo, 0); +} + +static void RQuartz_Size(double *left, double *right, double *bottom, double *top, DEVDESC) +{ + XD; + *left = *top = 0; + *right = QuartzDevice_GetWidth(xd) * 72.0; + *bottom = QuartzDevice_GetHeight(xd) * 72.0; +} + +static void RQuartz_NewPage(CTXDESC) +{ + { + DRAWSPEC; + ctx = NULL; + if (xd->newPage) xd->newPage(xd, xd->userInfo, xd->redraw ? QNPF_REDRAW : 0); + } + { /* we have to re-fetch the status *after* newPage since it may have changed it */ + DRAWSPEC; + if (!ctx) NOCTX; + { + CGRect bounds = CGRectMake(0, 0, + QuartzDevice_GetScaledWidth(xd) * 72.0, + QuartzDevice_GetScaledHeight(xd) * 72.0); + /* reset the clipping region by restoring the base GC. + If there is no GC on the stack then the clipping region was never set. */ + if (xd->gstate > 0) { + CGContextRestoreGState(ctx); + CGContextSaveGState(ctx); + /* no need to modify gstate since we don't modify the stack */ + } + /* The logic is to paint the canvas then gc->fill. + (The canvas colour is set to 0 on non-screen devices.) + */ + if (R_ALPHA(xd->canvas) > 0 && !R_OPAQUE(gc->fill)) { + /* Paint the canvas colour. */ + int savefill = gc->fill; + CGContextClearRect(ctx, bounds); + gc->fill = xd->canvas; + SET(RQUARTZ_FILL); + CGContextFillRect(ctx, bounds); + gc->fill = savefill; + } + SET(RQUARTZ_FILL); /* this will fill with gc->fill */ + CGContextFillRect(ctx, bounds); + } + } +} + +static int RQuartz_HoldFlush(DEVDESC, int level) +{ + int ol; + XD; + /* FIXME: should we check for interactive? */ + ol = xd->holdlevel; + xd->holdlevel += level; + if (xd->holdlevel < 0) xd->holdlevel = 0; + if (xd->holdlevel == 0) { /* flush */ + /* trigger flush */ + if (xd->sync) + xd->sync(xd, xd->userInfo); + else { + CGContextRef ctx = xd->getCGContext(xd, xd->userInfo); + if (ctx) + CGContextSynchronize(ctx); + } + } else if (ol == 0) { /* first hold */ + /* could display a wait cursor or something ... */ + } + return xd->holdlevel; +} + +static void RQuartz_Clip(double x0, double x1, double y0, double y1, DEVDESC) +{ + DRAWSPEC; + if (!ctx) NOCTX; + if(xd->gstate > 0) { + --xd->gstate; + CGContextRestoreGState(ctx); + } + CGContextSaveGState(ctx); + xd->gstate++; + if(x1 > x0) { double t = x1; x1 = x0;x0 = t; } + if(y1 > y0) { double t = y1; y1 = y0;y0 = t; } + xd->clipRect = CGRectMake(x0, y0, x1 - x0, y1 - y0); + CGContextClipToRect(ctx, xd->clipRect); +} + +/* non-symbol text is sent in UTF-8 */ +static CFStringRef text2unichar(CTXDESC, const char *text, UniChar **buffer, int *free) +{ + CFStringRef str; + if(gc->fontface == 5) + str = CFStringCreateWithCString(NULL, text, kCFStringEncodingMacSymbol); + else { + str = CFStringCreateWithCString(NULL, text, kCFStringEncodingUTF8); + /* Try fallback Latin1 encoding if UTF8 doesn't work + -- should no longer be needed. */ + if(!str) + CFStringCreateWithCString(NULL, text, kCFStringEncodingISOLatin1); + } + if (!str) return NULL; + *buffer = (UniChar*) CFStringGetCharactersPtr(str); + if (*buffer == NULL) { + CFIndex length = CFStringGetLength(str); + /* FIXME: check allocation */ + *buffer = malloc(length * sizeof(UniChar)); + CFStringGetCharacters(str, CFRangeMake(0, length), *buffer); + *free = 1; + } + return str; +} + +static double RQuartz_StrWidth(const char *text, CTXDESC) +{ + DEVSPEC; + if (!ctx) NOCTXR(strlen(text) * 10.0); /* for sanity reasons */ + RQuartz_SetFont(ctx, gc, xd); + + CGFontRef font = CGContextGetFont(ctx); + float aScale = (float)((gc->cex * gc->ps * xd->tscale) / + CGFontGetUnitsPerEm(font)); + UniChar *buffer; + CGGlyph *glyphs; + int *advances; + int Free = 0, len; + CFStringRef str = text2unichar(gc, dd, text, &buffer, &Free); + if (!str) return 0.0; /* invalid text contents */ + len = (int) CFStringGetLength(str); + /* FIXME: check allocations */ + glyphs = malloc(sizeof(CGGlyph) * len); + advances = malloc(sizeof(int) * len); + CGFontGetGlyphsForUnichars(font, buffer, glyphs, len); + CGFontGetGlyphAdvances(font, glyphs, len, advances); + float width = 0.0; /* aScale*CGFontGetLeading(CGContextGetFont(ctx)); */ + for(int i = 0; i < len; i++) width += aScale * advances[i]; + free(advances); + free(glyphs); + if(Free) free(buffer); + CFRelease(str); + return width; +} + +static void RQuartz_Text(double x, double y, const char *text, double rot, double hadj, CTXDESC) +{ + DRAWSPEC; + if (!ctx) NOCTX; + /* A stupid hack because R isn't consistent. */ + int fill = gc->fill; + gc->fill = gc->col; + SET(RQUARTZ_FILL | RQUARTZ_STROKE); + RQuartz_SetFont(ctx, gc, xd); + gc->fill = fill; + CGFontRef font = CGContextGetFont(ctx); + float aScale = (float) ((gc->cex * gc->ps * xd->tscale) / + CGFontGetUnitsPerEm(font)); + UniChar *buffer; + CGGlyph *glyphs; + + int Free = 0, len, i; + float width = 0.0; + CFStringRef str = text2unichar(gc, dd, text, &buffer, &Free); + if (!str) return; /* invalid text contents */ + len = (int) CFStringGetLength(str); + /* FIXME: check allocations */ + glyphs = malloc(sizeof(CGGlyph) * len); + CGFontGetGlyphsForUnichars(font, buffer, glyphs, len); + int *advances = malloc(sizeof(int) * len); + CGSize *g_adv = malloc(sizeof(CGSize) * len); + + CGFontGetGlyphAdvances(font, glyphs, len, advances); + for(i =0 ; i < len; i++) { + width += advances[i] * aScale; + g_adv[i] = CGSizeMake(aScale * advances[i] * cos(-DEG2RAD*rot), aScale*advances[i]*sin(-DEG2RAD * rot)); + } + free(advances); + CGContextSetTextMatrix(ctx, + CGAffineTransformConcat(CGAffineTransformMakeScale(1.0, -1.0), + CGAffineTransformMakeRotation(-DEG2RAD * rot))); + double ax = (width * hadj) * cos(-DEG2RAD * rot); + double ay = (width * hadj) * sin(-DEG2RAD * rot); + /* double h = CGFontGetXHeight(CGContextGetFont(ctx))*aScale; */ + CGContextSetTextPosition(ctx, x - ax, y - ay); + /* Rprintf("%s,%.2f %.2f (%.2f,%.2f) (%d,%f)\n",text,hadj,width,ax,ay,CGFontGetUnitsPerEm(CGContextGetFont(ctx)),CGContextGetFontSize(ctx)); */ + CGContextShowGlyphsWithAdvances(ctx,glyphs, g_adv, len); + free(glyphs); + free(g_adv); + if(Free) free(buffer); + CFRelease(str); +} + +static void RQuartz_Rect(double x0, double y0, double x1, double y1, CTXDESC) +{ + DRAWSPEC; + if (!ctx) NOCTX; + SET(RQUARTZ_FILL | RQUARTZ_STROKE | RQUARTZ_LINE); + if (xd->flags & QDFLAG_RASTERIZED) { + /* in the case of borderless rectangles snap them to pixels. + this solves issues with image() without introducing other artifacts. + other approaches (disabling anti-aliasing, drawing background first, + snapping rect with borders) don't work as well, because they have + unwanted visual side-effects. */ + if (R_ALPHA(gc->fill) > 0 && R_ALPHA(gc->col) == 0) { + /* store original values in case we need to go back */ + double ox0 = x0, ox1 = x1, oy0 = y0, oy1 = y1; + x0 = (round(x0 * xd->scalex)) / xd->scalex; + x1 = (round(x1 * xd->scalex)) / xd->scalex; + y0 = (round(y0 * xd->scaley)) / xd->scaley; + y1 = (round(y1 * xd->scaley)) / xd->scaley; + /* work-around for PR#13744 - make sure the width or height + does not drop to 0 because of aligning. */ + if (x0 == x1 && (ox0 != ox1)) x1 += ox1 - ox0; + if (y0 == y1 && (oy0 != oy1)) y1 += oy1 - oy0; + } + } + CGContextBeginPath(ctx); + CGContextAddRect(ctx, CGRectMake(x0, y0, x1 - x0, y1 - y0)); + CGContextDrawPath(ctx, kCGPathFillStroke); +} + +static void RQuartz_Raster(unsigned int *raster, int w, int h, + double x, double y, + double width, double height, + double rot, + Rboolean interpolate, + const pGEcontext gc, pDevDesc dd) +{ + DRAWSPEC; + if (!ctx) NOCTX; + CGDataProviderRef dp; + CGColorSpaceRef cs; + CGImageRef img; + + /* Create a "data provider" containing the raster data */ + dp = CGDataProviderCreateWithData(NULL, (void *) raster, 4*w*h, NULL); + + cs = CGColorSpaceCreateWithName(kCGColorSpaceSRGB); + + /* Create a quartz image from the data provider */ + img = CGImageCreate(w, h, + 8, /* bits per channel */ + 32, /* bits per pixel */ + 4*w, /* bytes per row */ + cs, /* color space */ + /* R uses AGBR which is so unusual (inverted RGBA) that it corresponds to endinness inverse(!) to the host with alpha last (=RGBA). */ +#ifdef __BIG_ENDIAN__ + kCGImageAlphaLast | kCGBitmapByteOrder32Little, +#else + kCGImageAlphaLast | kCGBitmapByteOrder32Big, +#endif + dp, /* data provider */ + NULL,/* decode array */ + 1, /* interpolate (interpolation type below) */ + kCGRenderingIntentDefault); + + if (height < 0) { + y = y + height; + height = -height; + } + + CGContextSaveGState(ctx); + /* Translate by height of image */ + CGContextTranslateCTM(ctx, 0.0, height); + /* Flip vertical */ + CGContextScaleCTM(ctx, 1.0, -1.0); + /* Translate to position */ + CGContextTranslateCTM(ctx, x, -y); + /* Rotate */ + CGContextRotateCTM(ctx, rot*M_PI/180.0); + /* Determine interpolation method */ + if (interpolate) + CGContextSetInterpolationQuality(ctx, kCGInterpolationDefault); + else + CGContextSetInterpolationQuality(ctx, kCGInterpolationNone); + /* Draw the quartz image */ + CGContextDrawImage(ctx, CGRectMake(0, 0, width, height), img); + CGContextRestoreGState(ctx); + + /* Tidy up */ + CGColorSpaceRelease(cs); + CGDataProviderRelease(dp); + CGImageRelease(img); +} + +static SEXP RQuartz_Cap(pDevDesc dd) +{ + SEXP raster = R_NilValue; + DRAWSPEC; + if (!ctx) NOCTXR(raster); + + if (xd->cap) + raster = (SEXP) xd->cap(xd, xd->userInfo); + + return raster; +} + +static void RQuartz_Circle(double x, double y, double r, CTXDESC) +{ + DRAWSPEC; + if (!ctx) NOCTX; + SET(RQUARTZ_FILL | RQUARTZ_STROKE | RQUARTZ_LINE); + double r2 = 2.0*r; + CGContextBeginPath(ctx); + CGContextAddEllipseInRect(ctx,CGRectMake(x-r,y-r,r2,r2)); + CGContextDrawPath(ctx,kCGPathFillStroke); +} + +static void RQuartz_Line(double x1, double y1, double x2, double y2, CTXDESC) +{ + DRAWSPEC; + if (!ctx) NOCTX; + SET(RQUARTZ_STROKE | RQUARTZ_LINE); + CGContextBeginPath(ctx); + CGContextMoveToPoint(ctx, x1, y1); + CGContextAddLineToPoint(ctx, x2, y2); + CGContextStrokePath(ctx); +} + +#define max_segments 100 + +static void RQuartz_Polyline(int n, double *x, double *y, CTXDESC) +{ + if (n < 2) return; + int i = 0; + DRAWSPEC; + if (!ctx) NOCTX; + SET(RQUARTZ_STROKE | RQUARTZ_LINE); + + /* CGContextStrokeLineSegments turned out to be a bad idea due to + Leopard restarting dashes for each segment. + CGContextAddLineToPoint is fast enough. + The only remaining problem is that Quartz seems to restart + dashes at segment breakup points. We should make the segments + break-up an optional feature and possibly fix the underlying + problem (software rendering). + */ + + while (i < n) { + int j = i + max_segments; + if (j > n) j = n; + CGContextBeginPath(ctx); + if (i) i--; /* start at the last point of the preceding chunk */ + CGContextMoveToPoint(ctx, x[i], y[i]); + while(++i < j) + CGContextAddLineToPoint(ctx, x[i], y[i]); + CGContextStrokePath(ctx); + } +} + +static void RQuartz_Polygon(int n, double *x, double *y, CTXDESC) +{ + if (n < 2) return; + int i; + DRAWSPEC; + if (!ctx) NOCTX; + SET(RQUARTZ_FILL | RQUARTZ_STROKE | RQUARTZ_LINE); + CGContextBeginPath(ctx); + CGContextMoveToPoint(ctx, x[0], y[0]); + for(i = 1; i < n; i++) + CGContextAddLineToPoint(ctx, x[i], y[i]); + CGContextClosePath(ctx); + CGContextDrawPath(ctx, kCGPathFillStroke); +} + +static void RQuartz_Path(double *x, double *y, + int npoly, int* nper, + Rboolean winding, + CTXDESC) +{ + int i, j, index; + DRAWSPEC; + if (!ctx) NOCTX; + SET(RQUARTZ_FILL | RQUARTZ_STROKE | RQUARTZ_LINE); + index = 0; + CGContextBeginPath(ctx); + for (i=0; i < npoly; i++) { + CGContextMoveToPoint(ctx, x[index], y[index]); + index++; + for(j=1; j < nper[i]; j++) { + CGContextAddLineToPoint(ctx, x[index], y[index]); + index++; + } + CGContextClosePath(ctx); + } + if (winding) { + CGContextDrawPath(ctx, kCGPathFillStroke); + } else { + CGContextDrawPath(ctx, kCGPathEOFillStroke); + } +} + +static void RQuartz_Mode(int mode, DEVDESC) +{ + DEVSPEC; + if (!ctx) NOCTX; + /* don't do anything in redraw as we can signal the end */ + if (xd->redraw) return; + /* mode=0 -> drawing complete, signal sync */ + if (mode == 0 && xd->holdlevel == 0) { + if (xd->sync) + xd->sync(xd, xd->userInfo); + else + CGContextSynchronize(ctx); + } +} + +static void +RQuartz_MetricInfo(int c, const pGEcontext gc, + double *ascent, double *descent, double *width, + pDevDesc dd) +{ + DRAWSPEC; + if (!ctx) { /* dummy data if we have no context, for sanity reasons */ + *ascent = 10.0; + *descent= 2.0; + *width = 9.0; + NOCTX; + } + RQuartz_SetFont(ctx, gc, xd); + { + CGFontRef font = CGContextGetFont(ctx); + float aScale = (float)((gc->cex * gc->ps * xd->tscale) / + CGFontGetUnitsPerEm(font)); + UniChar *buffer, single; + CGGlyph glyphs[8]; + CFStringRef str = NULL; + int free_buffer = 0, len; + *width = *ascent = *descent = 0.0; /* data for bail-out cases */ + if (c >= 0 && c <= ((mbcslocale && gc->fontface != 5) ? 127 : 255)) { + char text[2] = { (char)c, 0 }; + str = text2unichar(gc, dd, text, &buffer, &free_buffer); + if(!str) return; + len = (int) CFStringGetLength(str); + if (len > 7) return; /* this is basically impossible, + but you never know */ + } else { + single = (UniChar) ((c < 0) ? -c : c); + buffer = &single; + len = 1; + } + *width = 0.0; + CGFontGetGlyphsForUnichars(font, buffer, glyphs, len); + { + int i; + int advances[8]; + CGRect bboxes[8]; + CGFontGetGlyphAdvances(font, glyphs, len, advances); + CGFontGetGlyphBBoxes(font, glyphs, len, bboxes); + for(i = 0; i < len; i++) + *width += advances[i] * aScale; + *ascent = aScale * (bboxes[0].size.height + bboxes[0].origin.y); + *descent = -aScale * bboxes[0].origin.y; + } + if (free_buffer) free(buffer); + if (str) CFRelease(str); + } +} + +static Rboolean RQuartz_Locator(double *x, double *y, DEVDESC) +{ + Rboolean res; + DEVSPEC; + ctx = NULL; + if (!xd->locatePoint) + return FALSE; + res = xd->locatePoint(xd, xd->userInfo, x, y); + *x/=xd->scalex; + *y/=xd->scaley; + return res; +} + +#pragma mark - +#pragma mark R Interface + +#include "qdCocoa.h" +#include "qdBitmap.h" +#include "qdPDF.h" +/* disabled for now until we get to test in on 10.3 #include "qdCarbon.h" */ + +/* current fake */ +QuartzDesc_t +QuartzCarbon_DeviceCreate(pDevDesc dd, QuartzFunctions_t *fn, QuartzParameters_t *par) +{ + return NULL; +} + +#define ARG(HOW,WHAT) HOW(CAR(WHAT));WHAT = CDR(WHAT) + +/* C version of the Quartz call (experimental) + Quartz descriptor on success, NULL on failure. + If errorCode is not NULL, it will contain the error code on exit */ +QuartzDesc_t +Quartz_C(QuartzParameters_t *par, quartz_create_fn_t q_create, int *errorCode) +{ + if (!q_create || !par) { + if (errorCode) errorCode[0] = -4; + return NULL; + } + { + const void *vmax = vmaxget(); + QuartzDesc_t qd = NULL; + R_GE_checkVersionOrDie(R_GE_version); + R_CheckDeviceAvailable(); + { + const char *devname = "quartz_off_screen"; + /* FIXME: check this allocation */ + pDevDesc dev = calloc(1, sizeof(DevDesc)); + + if (!dev) { + if (errorCode) errorCode[0] = -2; + return NULL; + } + if (!(qd = q_create(dev, &qfn, par))) { + vmaxset(vmax); + free(dev); + if (errorCode) errorCode[0] = -3; + return NULL; + } + if(streql(par->type, "") || streql(par->type, "native") + || streql(par->type, "cocoa") || streql(par->type, "carbon")) + devname = "quartz"; + gsetVar(R_DeviceSymbol, mkString(devname), R_BaseEnv); + pGEDevDesc dd = GEcreateDevDesc(dev); + GEaddDevice(dd); + GEinitDisplayList(dd); + vmaxset(vmax); + } + return qd; + } +} + +/* ARGS: type, file, width, height, ps, family, antialias, + title, bg, canvas, dpi */ +SEXP Quartz(SEXP args) +{ + SEXP tmps, bgs, canvass; + double width, height, ps; + Rboolean antialias; + int quartzpos, bg, canvas, module = 0; + double mydpi[2], *dpi = 0; + const char *type, *mtype = 0, *family, *title; + char *file = NULL; + QuartzDesc_t qd = NULL; + + const void *vmax = vmaxget(); + /* Get function arguments */ + args = CDR(args); /* Skip the call */ + if (TYPEOF(CAR(args)) != STRSXP || LENGTH(CAR(args)) < 1) + type = ""; + else + type = CHAR(STRING_ELT(CAR(args), 0)); + args = CDR(args); + /* we may want to support connections at some point, but not yet ... */ + tmps = CAR(args); args = CDR(args); + if (isNull(tmps)) + file = NULL; + else if (isString(tmps) && LENGTH(tmps) >= 1) { + const char *tmp = R_ExpandFileName(CHAR(STRING_ELT(tmps, 0))); + file = R_alloc(strlen(tmp) + 1, sizeof(char)); + strcpy(file, tmp); + } else + error(_("invalid 'file' argument")); + width = ARG(asReal,args); + height = ARG(asReal,args); + ps = ARG(asReal,args); + family = CHAR(STRING_ELT(CAR(args), 0)); args = CDR(args); + antialias = ARG(asLogical,args); + title = CHAR(STRING_ELT(CAR(args), 0)); args = CDR(args); + bgs = CAR(args); args = CDR(args); + bg = RGBpar(bgs, 0); + canvass = CAR(args); args = CDR(args); + canvas = RGBpar(canvass, 0) | 0xff000000; /* force opaque */ + tmps = CAR(args); args = CDR(args); + if (!isNull(tmps)) { + tmps = coerceVector(tmps, REALSXP); + if (LENGTH(tmps) > 0) { + dpi = mydpi; + mydpi[0] = REAL(tmps)[0]; + if (LENGTH(tmps) > 1) + mydpi[1] = REAL(tmps)[1]; + else + mydpi[1] = mydpi[0]; + } + } + /* just in case someone passed NAs/NaNs */ + if (dpi && (ISNAN(dpi[0]) || ISNAN(dpi[1]))) dpi=0; + + if (ISNAN(width) || ISNAN(height) || width <= 0.0 || height <= 0.0) + error(_("invalid quartz() device size")); + + if (type) { + const quartz_module_t *m = quartz_modules; + mtype = type; + while (m->type) { + if (!strcasecmp(type, m->type)) { + module = m->qbe; + if (m->subst) mtype = m->subst; + break; + } + m++; + } + + if (!strncasecmp(type, "bitmap:", 7)) { + module = QBE_BITMAP; + mtype = mtype + 7; + } + } + + quartzpos = 1; + + R_GE_checkVersionOrDie(R_GE_version); + R_CheckDeviceAvailable(); + BEGIN_SUSPEND_INTERRUPTS { + pDevDesc dev = calloc(1, sizeof(DevDesc)); + + if (!dev) + error(_("unable to create device description")); + + QuartzParameters_t qpar = { + sizeof(qpar), + mtype, file, title, + -1.0, -1.0, width, height, ps, + family, + antialias ? QPFLAG_ANTIALIAS: 0, + -1, /* connection */ + bg, canvas, + dpi + }; + + /* re-routed code has the first shot */ + if (ptr_QuartzBackend) + qd = ptr_QuartzBackend(dev, &qfn, &qpar); + + if (qd == NULL) { /* try internal modules next */ + switch (module) { + case QBE_COCOA: + qd = QuartzCocoa_DeviceCreate(dev, &qfn, &qpar); + break; + case QBE_NATIVE: + /* native is essentially cocoa with carbon fall-back */ + qd = QuartzCocoa_DeviceCreate(dev, &qfn, &qpar); + if (qd) break; + case QBE_CARBON: + qd = QuartzCarbon_DeviceCreate(dev, &qfn, &qpar); + break; + case QBE_PDF: + qpar.canvas = 0; /* so not used */ + qd = QuartzPDF_DeviceCreate(dev, &qfn, &qpar); + break; + case QBE_BITMAP: + /* we need to set up the default file name here, where we + know the original type name. */ + if (file == NULL) { + static char deffile[30]; + snprintf(deffile, 30, "%s.%s", "Rplot%03d", type); + qpar.file = deffile; + } + qpar.canvas = 0; /* so not used */ + qd = QuartzBitmap_DeviceCreate(dev, &qfn, &qpar); + break; + } + } + + if (qd == NULL) { + vmaxset(vmax); + free(dev); + error(_("unable to create quartz() device target, given type may not be supported")); + } + const char *devname = "quartz_off_screen"; + if(streql(type, "") || streql(type, "native") || streql(type, "cocoa") + || streql(type, "carbon")) devname = "quartz"; + SEXP f = PROTECT(mkString(devname)); + if(file) setAttrib(f, install("filepath"), mkString(file)); + gsetVar(R_DeviceSymbol, f, R_BaseEnv); + UNPROTECT(1); + pGEDevDesc dd = GEcreateDevDesc(dev); + GEaddDevice(dd); + GEinitDisplayList(dd); + } END_SUSPEND_INTERRUPTS; + vmaxset(vmax); + return R_NilValue; +} + +#include <sys/sysctl.h> + +static double cached_darwin_version = 0.0; + +/* Darwin version X.Y maps to macOS version 10.(X - 4).Y */ +static double darwin_version() { + char ver[32]; + size_t len = sizeof(ver) - 1; + int mib[2] = { CTL_KERN, KERN_OSRELEASE }; + if (cached_darwin_version > 0.0) + return cached_darwin_version; + sysctl(mib, 2, &ver, &len, 0, 0); + return (cached_darwin_version = atof(ver)); +} + +#include <mach/mach.h> +#include <servers/bootstrap.h> + +/* even as of Darwin 9 there is no entry for bootstrap_info in bootrap headers */ +extern kern_return_t bootstrap_info(mach_port_t , /* bootstrap port */ + name_array_t*, mach_msg_type_number_t*, /* service */ + name_array_t*, mach_msg_type_number_t*, /* server */ + bool_array_t*, mach_msg_type_number_t*); /* active */ + +/* returns 1 if window server session service + (com.apple.windowserver.session) is present in the boostrap + namespace (pre-Lion) or when a current session is present, active + and there is no SSH_CONNECTION (Lion and later). + returns 0 if an error occurred or the service is not + present. For all practical purposes this returns 1 only if run + interactively via LS. Although ssh to a machine that has a running + session for the same user will allow a WS connection, this function + will still return 0 in that case. + NOTE: on macOS 10.5 we are currently NOT searching the parent + namespaces. This is currently OK, because the session service will + be registered in the session namespace which is the last in the + chain. However, this could change in the future. + */ +static int has_wss() { + int res = 0; + + if (darwin_version() < 11.0) { /* before Lion we get reliable information from the bootstrap info */ + kern_return_t kr; + mach_port_t self = mach_task_self(); + mach_port_t bport = MACH_PORT_NULL; + kr = task_get_bootstrap_port(self, &bport); + if (kr == KERN_SUCCESS) { + kern_return_t kr; + name_array_t serviceNames; + mach_msg_type_number_t serviceNameCount; + name_array_t serverNames; + mach_msg_type_number_t serverNameCount; + bool_array_t active; + mach_msg_type_number_t activeCount; + + serviceNames = NULL; + serverNames = NULL; + active = NULL; + + kr = bootstrap_info(bport, + &serviceNames, &serviceNameCount, + &serverNames, &serverNameCount, + &active, &activeCount); + if (kr == KERN_SUCCESS) { + unsigned int i = 0; + while (i < serviceNameCount) { + if (!strcmp(serviceNames[i], "com.apple.windowserver.session")) { + res = 1; + break; + } + i++; + } + } + } + if (bport != MACH_PORT_NULL) + mach_port_deallocate(mach_task_self(), bport); + } else { + /* On macOS 10.7 (Lion) and higher two things changed: + a) there is no com.apple.windowserver.session anymore + so the above will fail + b) every process has now the full bootstrap info, + so in fact even remote connections will be able to + run on-screen tasks if the user is logged in + So we need to add some heuristics to decide when the user + actually wants Quartz ... */ + /* check user's session */ + CFDictionaryRef dict = CGSessionCopyCurrentDictionary(); + if (dict) { /* allright, let's see if the session is current */ + CFTypeRef obj = CFDictionaryGetValue(dict, CFSTR("kCGSSessionOnConsoleKey")); + if (obj && CFGetTypeID(obj) == CFBooleanGetTypeID()) { + /* even if this session is active, we don't use Quartz for SSH connections */ + if (CFBooleanGetValue(obj) && (!getenv("SSH_CONNECTION") || getenv("SSH_CONNECTION")[0] == 0)) + res = 1; + } + CFRelease(dict); + } + } + + return res; +} + +SEXP makeQuartzDefault() { + return ScalarLogical(has_wss()); +} + +#else +/* --- no AQUA support = no Quartz --- */ + +#include "grDevices.h" +#include <R_ext/QuartzDevice.h> + +SEXP Quartz(SEXP args) +{ + warning(_("Quartz device is not available on this platform")); + return R_NilValue; +} + +SEXP makeQuartzDefault() { + return ScalarLogical(FALSE); +} + +QuartzDesc_t +Quartz_C(QuartzParameters_t *par, quartz_create_fn_t q_create, int *errorCode) +{ + if (errorCode) errorCode[0] = -1; + return NULL; +} + +void *getQuartzAPI() +{ + return NULL; +} + +#endif diff --git a/com.oracle.truffle.r.native/gnur/patch/src/library/grDevices/src/devWindows.h b/com.oracle.truffle.r.native/gnur/patch/src/library/grDevices/src/devWindows.h new file mode 100644 index 0000000000000000000000000000000000000000..758aa9f5e3c8d913c969f21f8f5b6c6793cd2618 --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/library/grDevices/src/devWindows.h @@ -0,0 +1,104 @@ +/* + * R : A Computer Langage for Statistical Data Analysis + * Copyright (C) 1998--2003 Guido Masarotto and Brian Ripley + * Copyright (C) 2004 The R Foundation + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version. + * + * This program 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 this program; if not, a copy is available at + * https://www.R-project.org/Licenses/ + */ + +#include <R_ext/GraphicsEngine.h> +#include <R_ext/Boolean.h> + +enum DeviceKinds {SCREEN=0, PRINTER, METAFILE, PNG, JPEG, BMP, TIFF}; + +typedef struct { + /* R Graphics Parameters */ + /* local device copy so that we can detect when parameter changes */ + int col; /* Color */ + int bg; /* Background */ + int fontface; /* Typeface */ + int fontsize, basefontsize; /* Size in points. + fontsize has been adjusted + for dpi diffs, basefontsize has not */ + double fontangle; + char basefontfamily[500]; /* Initial font family */ + + /* devga Driver Specific */ + /* parameters with copy per devga device */ + + enum DeviceKinds kind; + int windowWidth; /* Window width (pixels) */ + int windowHeight; /* Window height (pixels) */ + int showWidth; /* device width (pixels) */ + int showHeight; /* device height (pixels) */ + int origWidth, origHeight, xshift, yshift; + Rboolean resize; /* Window resized */ + window gawin; /* Graphics window */ + /*FIXME: we should have union for this stuff and + maybe change gawin to canvas*/ + /* SCREEN section*/ + popup locpopup, grpopup; + button stoploc; + menubar mbar, mbarloc, mbarconfirm; + menu msubsave; + menuitem mpng, mbmp, mjpeg50, mjpeg75, mjpeg100, mtiff; + menuitem mps, mpdf, mwm, mclpbm, mclpwm, mprint, mclose; + menuitem mrec, madd, mreplace, mprev, mnext, mclear, msvar, mgvar; + menuitem mR, mfit, mfix, grmenustayontop, mnextplot; + Rboolean recording, replaying, needsave; + bitmap bm, bm2; + + /* PNG, JPEG, BMP, TIFF section */ + FILE *fp; + char filename[512]; + int quality; + int npage; + int res_dpi; /* Values >0 recorded in the file */ + + double w, h; + rgb fgcolor; /* Foreground color */ + rgb bgcolor; /* Background color */ + rgb canvascolor; /* Canvas color */ + rgb outcolor; /* Outside canvas color */ + rect clip; /* The clipping rectangle */ + font font; + char fontfamily[100]; + int fontquality; + + Rboolean locator; + Rboolean confirmation; + + int clicked; /* {0,1,2} */ + int px, py, lty, lwd; + int resizing; /* {1,2,3} */ + double rescale_factor; + int fast; /* Use fast fixed-width lines? */ + unsigned int pngtrans; /* what PNG_TRANS get mapped to */ + Rboolean buffered; + int timeafter, timesince; + SEXP psenv; + R_GE_lineend lend; + R_GE_linejoin ljoin; + float lmitre; + Rboolean enterkey; /* Set true when enter key is hit */ + double lwdscale; /* scale factor for lwd */ + void *cntxt; /* context for unwinding on error */ + Rboolean have_alpha; /* support for AlphaBlend */ + Rboolean warn_trans; /* Warn on use of translucency if not supported */ + char title[101]; + Rboolean clickToConfirm; /* for NewFrameConfirm */ + Rboolean doSetPolyFill, fillOddEven; /* polygon fill mode */ + int holdlevel; +} gadesc; diff --git a/com.oracle.truffle.r.native/gnur/patch/src/library/grDevices/src/devices.c b/com.oracle.truffle.r.native/gnur/patch/src/library/grDevices/src/devices.c new file mode 100644 index 0000000000000000000000000000000000000000..06dd9b35efdc4cba060337372392be0702034fdc --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/library/grDevices/src/devices.c @@ -0,0 +1,211 @@ +/* + * R : A Computer Language for Statistical Data Analysis + * Copyright (C) 1995, 1996 Robert Gentleman and Ross Ihaka + * Copyright (C) 1997--2013 The R Core Team + * Copyright (C) 2002--2005 The R Foundation + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version. + * + * This program 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 this program; if not, a copy is available at + * https://www.R-project.org/Licenses/ + + + * This is (a small part of) an extensive reworking by Paul Murrell + * of an original quick hack by Ross Ihaka designed to give a + * superset of the functionality in the AT&T Bell Laboratories GRZ + * library. + * + */ + + +#ifdef HAVE_CONFIG_H +#include <config.h> +#endif + +#include <Defn.h> +#include <Graphics.h> +#include <GraphicsBase.h> +#include <R_ext/GraphicsEngine.h> + +#ifdef ENABLE_NLS +#include <libintl.h> +#undef _ +#define _(String) dgettext ("grDevices", String) +#else +#define _(String) (String) +#endif + + +#define checkArity_length \ + args = CDR(args); \ + if(!LENGTH(CAR(args))) \ + error(_("argument must have positive length")) + +SEXP devcontrol(SEXP args) +{ + int listFlag; + pGEDevDesc gdd = GEcurrentDevice(); + + args = CDR(args); + listFlag = asLogical(CAR(args)); + if(listFlag == NA_LOGICAL) error(_("invalid argument")); + GEinitDisplayList(gdd); + gdd->displayListOn = listFlag ? TRUE: FALSE; + return ScalarLogical(listFlag); +} + +SEXP devdisplaylist(SEXP args) +{ + pGEDevDesc gdd = GEcurrentDevice(); + return ScalarLogical(gdd->displayListOn); +} + +SEXP devcopy(SEXP args) +{ + checkArity_length; + GEcopyDisplayList(INTEGER(CAR(args))[0] - 1); + return R_NilValue; +} + +SEXP devcur(SEXP args) +{ + args = CDR(args); + return ScalarInteger(curDevice() + 1); +} + +SEXP devnext(SEXP args) +{ + checkArity_length; + int nxt = INTEGER(CAR(args))[0]; + if (nxt == NA_INTEGER) error(_("NA argument is invalid")); + return ScalarInteger( nextDevice(nxt - 1) + 1 ); +} + +SEXP devprev(SEXP args) +{ + checkArity_length; + int prev = INTEGER(CAR(args))[0]; + if (prev == NA_INTEGER) error(_("NA argument is invalid")); + return ScalarInteger( prevDevice(prev - 1) + 1 ); +} + +SEXP devset(SEXP args) +{ + checkArity_length; + int devNum = INTEGER(CAR(args))[0]; + if (devNum == NA_INTEGER) error(_("NA argument is invalid")); + return ScalarInteger( selectDevice(devNum - 1) + 1 ); +} + +SEXP devoff(SEXP args) +{ + checkArity_length; + killDevice(INTEGER(CAR(args))[0] - 1); + return R_NilValue; +} + +SEXP devsize(SEXP args) +{ + SEXP ans; + pDevDesc dd = GEcurrentDevice()->dev; + double left, right, bottom, top; + + dd->size(&left, &right, &bottom, &top, dd); + ans = allocVector(REALSXP, 2); + REAL(ans)[0] = fabs(right - left); + REAL(ans)[1] = fabs(bottom - top); + return ans; +} + +SEXP devholdflush(SEXP args) +{ + pDevDesc dd = GEcurrentDevice()->dev; + + args = CDR(args); + int level = asInteger(CAR(args)); + if(dd->holdflush && level != NA_INTEGER) level = (dd->holdflush(dd, level)); + else level = 0; + return ScalarInteger(level); +} + +SEXP devcap(SEXP args) +{ + SEXP ans; + int i = 0; + pDevDesc dd = GEcurrentDevice()->dev; + + args = CDR(args); + + PROTECT(ans = allocVector(INTSXP, 9)); + INTEGER(ans)[i] = dd->haveTransparency; + INTEGER(ans)[++i] = dd->haveTransparentBg; + /* These will be NULL if the device does not define them */ + INTEGER(ans)[++i] = (dd->raster != NULL) ? dd->haveRaster : 1; + INTEGER(ans)[++i] = (dd->cap != NULL) ? dd->haveCapture : 1; + INTEGER(ans)[++i] = (dd->locator != NULL) ? dd->haveLocator : 1; + INTEGER(ans)[++i] = (int)(dd->canGenMouseDown); + INTEGER(ans)[++i] = (int)(dd->canGenMouseMove); + INTEGER(ans)[++i] = (int)(dd->canGenMouseUp); + INTEGER(ans)[++i] = (int)(dd->canGenKeybd); + /* FIXME: there should be a way for a device to declare its own + events, and return information on how to set them */ + + UNPROTECT(1); + return ans; +} + +SEXP devcapture(SEXP args) +{ + int i, col, row, nrow, ncol, size; + Rboolean native; + pGEDevDesc gdd = GEcurrentDevice(); + int *rint; + SEXP raster, image, idim; + + args = CDR(args); + + native = asLogical(CAR(args)); + if (native != TRUE) native = FALSE; + + raster = GECap(gdd); + if (isNull(raster)) /* NULL = unsupported */ + return raster; + + PROTECT(raster); + if (native) { + setAttrib(raster, R_ClassSymbol, mkString("nativeRaster")); + UNPROTECT(1); + return raster; + } + + /* non-native, covert to color strings (this is based on grid.cap) */ + size = LENGTH(raster); + nrow = INTEGER(getAttrib(raster, R_DimSymbol))[0]; + ncol = INTEGER(getAttrib(raster, R_DimSymbol))[1]; + + PROTECT(image = allocVector(STRSXP, size)); + rint = INTEGER(raster); + for (i = 0; i < size; i++) { + col = i % ncol + 1; + row = i / ncol + 1; + SET_STRING_ELT(image, (col - 1) * nrow + row - 1, + mkChar(col2name(rint[i]))); + } + + PROTECT(idim = allocVector(INTSXP, 2)); + INTEGER(idim)[0] = nrow; + INTEGER(idim)[1] = ncol; + setAttrib(image, R_DimSymbol, idim); + UNPROTECT(3); + + return image; +} diff --git a/com.oracle.truffle.r.native/gnur/patch/src/library/grDevices/src/grDevices.h b/com.oracle.truffle.r.native/gnur/patch/src/library/grDevices/src/grDevices.h new file mode 100644 index 0000000000000000000000000000000000000000..47c3a2cadd0455085a615b03914daa94d12c3726 --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/library/grDevices/src/grDevices.h @@ -0,0 +1,114 @@ +/* + * R : A Computer Language for Statistical Data Analysis + * Copyright (C) 2004-12 The R Core Team. + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version. + * + * This program 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 this program; if not, a copy is available at + * https://www.R-project.org/Licenses/ + */ + +#include <Rinternals.h> +#include <R_ext/Boolean.h> +#include <R_ext/GraphicsEngine.h> /* for DevDesc */ + +#ifdef ENABLE_NLS +#include <libintl.h> +#undef _ +#define _(String) dgettext ("grDevices", String) +#else +#define _(String) (String) +#endif + +SEXP R_CreateAtVector(SEXP axp, SEXP usr, SEXP nint, SEXP is_log); +SEXP R_GAxisPars(SEXP usr, SEXP is_log, SEXP nintLog); + +SEXP PicTeX(SEXP); + +SEXP PostScript(SEXP); +SEXP XFig(SEXP); +SEXP PDF(SEXP); +SEXP Type1FontInUse(SEXP, SEXP); +SEXP CIDFontInUse(SEXP, SEXP); + +#ifndef _WIN32 +SEXP Quartz(SEXP); +SEXP makeQuartzDefault(); + +SEXP X11(SEXP call, SEXP op, SEXP args, SEXP rho); +SEXP savePlot(SEXP call, SEXP op, SEXP args, SEXP rho); +#endif + +SEXP devCairo(SEXP); + +Rboolean +PSDeviceDriver(pDevDesc, const char*, const char*, const char*, + const char **, const char*, const char*, const char*, + double, double, Rboolean, double, Rboolean, Rboolean, + Rboolean, const char*, const char*, SEXP, const char*, int, + Rboolean); + +Rboolean +PDFDeviceDriver(pDevDesc, const char *, const char *, const char *, + const char **, const char *, const char *, const char *, + double, double, double, int, int, const char*, SEXP, + int, int, const char *, int, int, Rboolean, Rboolean); + +#ifdef _WIN32 +SEXP devga(SEXP); +SEXP savePlot(SEXP); +SEXP bringToTop(SEXP, SEXP); +SEXP msgWindow(SEXP, SEXP); +#endif + +SEXP devcap(SEXP args); +SEXP devcapture(SEXP args); +SEXP devcontrol(SEXP args); +SEXP devcopy(SEXP args); +SEXP devcur(SEXP args); +SEXP devdisplaylist(SEXP args); +SEXP devholdflush(SEXP args); +SEXP devnext(SEXP args); +SEXP devoff(SEXP args); +SEXP devprev(SEXP args); +SEXP devset(SEXP args); +SEXP devsize(SEXP args); + +SEXP chull(SEXP x); + +SEXP contourLines(SEXP call, SEXP op, SEXP args, SEXP rho); +SEXP getSnapshot(SEXP call, SEXP op, SEXP args, SEXP rho); +SEXP playSnapshot(SEXP call, SEXP op, SEXP args, SEXP rho); +SEXP getGraphicsEvent(SEXP call, SEXP op, SEXP args, SEXP rho); +SEXP getGraphicsEventEnv(SEXP call, SEXP op, SEXP args, SEXP rho); +SEXP setGraphicsEventEnv(SEXP call, SEXP op, SEXP args, SEXP rho); +SEXP devAskNewPage(SEXP call, SEXP op, SEXP args, SEXP env); + +#ifndef DEVWINDOWS +SEXP rgb(SEXP r, SEXP g, SEXP b, SEXP a, SEXP MCV, SEXP nam); +SEXP hsv(SEXP h, SEXP s, SEXP v, SEXP a); +SEXP hcl(SEXP h, SEXP c, SEXP l, SEXP a, SEXP sfixup); +SEXP gray(SEXP lev, SEXP a); +SEXP colors(void); +SEXP col2rgb(SEXP colors, SEXP alpha); +SEXP palette(SEXP value); +SEXP palette2(SEXP value); +SEXP RGB2hsv(SEXP rgb); +#endif + +unsigned int inRGBpar3(SEXP, int, unsigned int); +const char *incol2name(unsigned int col); +unsigned int inR_GE_str2col(const char *s); +void initPalette(void); + +SEXP cairoVersion(void); +SEXP bmVersion(void); diff --git a/com.oracle.truffle.r.native/gnur/patch/src/library/grDevices/src/init.c b/com.oracle.truffle.r.native/gnur/patch/src/library/grDevices/src/init.c new file mode 100644 index 0000000000000000000000000000000000000000..2caf0da84956c8475050d22b85e22d68193132ac --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/library/grDevices/src/init.c @@ -0,0 +1,143 @@ +/* + * R : A Computer Language for Statistical Data Analysis + * Copyright (C) 2004-2017 The R Core Team. + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version. + * + * This program 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 this program; if not, a copy is available at + * https://www.R-project.org/Licenses/ + */ + +#ifdef HAVE_CONFIG_H +#include <config.h> +#endif + +#include <R.h> +#include <Rinternals.h> +#include <R_ext/GraphicsEngine.h> + +#include "grDevices.h" +#include <R_ext/Rdynload.h> +#include <R_ext/Visibility.h> + +#ifndef _WIN32 +/* This really belongs with the X11 module, but it is about devices */ +static SEXP cairoProps(SEXP in) +{ + int which = asInteger(in); + if(which == 1) + return ScalarLogical( +#ifdef HAVE_WORKING_CAIRO + 1 +#else + 0 +#endif + ); + else if(which == 2) + return ScalarLogical( +#ifdef HAVE_PANGOCAIRO + 1 +#else + 0 +#endif + ); + return R_NilValue; +} +#endif + +#define CALLDEF(name, n) {#name, (DL_FUNC) &name, n} + +static const R_CallMethodDef CallEntries[] = { + CALLDEF(Type1FontInUse, 2), + CALLDEF(CIDFontInUse, 2), + CALLDEF(R_CreateAtVector, 4), + CALLDEF(R_GAxisPars, 3), + CALLDEF(chull, 1), + CALLDEF(gray, 2), + CALLDEF(RGB2hsv, 1), + CALLDEF(rgb, 6), + CALLDEF(hsv, 4), + CALLDEF(hcl, 5), + CALLDEF(col2rgb, 2), + CALLDEF(colors, 0), + CALLDEF(palette, 1), + CALLDEF(palette2, 1), + CALLDEF(cairoVersion, 0), + CALLDEF(bmVersion, 0), + +#ifndef _WIN32 + CALLDEF(makeQuartzDefault, 0), + CALLDEF(cairoProps, 1), +#else + CALLDEF(bringToTop, 2), + CALLDEF(msgWindow, 2), +#endif + {NULL, NULL, 0} +}; + +#define EXTDEF(name, n) {#name, (DL_FUNC) &name, n} + +static const R_ExternalMethodDef ExtEntries[] = { + EXTDEF(PicTeX, 6), + EXTDEF(PostScript, 19), + EXTDEF(XFig, 14), + EXTDEF(PDF, 20), + EXTDEF(devCairo, 11), + EXTDEF(devcap, 0), + EXTDEF(devcapture, 1), + EXTDEF(devcontrol, 1), + EXTDEF(devcopy, 1), + EXTDEF(devcur, 0), + EXTDEF(devdisplaylist, 0), + EXTDEF(devholdflush, 1), + EXTDEF(devnext, 1), + EXTDEF(devoff, 1), + EXTDEF(devprev, 1), + EXTDEF(devset, 1), + EXTDEF(devsize, 0), + EXTDEF(contourLines, 4), + EXTDEF(getSnapshot, 0), + EXTDEF(playSnapshot, 1), + EXTDEF(getGraphicsEvent, 1), + EXTDEF(getGraphicsEventEnv, 1), + EXTDEF(setGraphicsEventEnv, 2), + EXTDEF(devAskNewPage, 1), + +#ifdef _WIN32 + EXTDEF(savePlot, 4), + EXTDEF(devga, 21), +#else + EXTDEF(savePlot, 3), + EXTDEF(Quartz, 11), + EXTDEF(X11, 17), +#endif + {NULL, NULL, 0} +}; + +#ifdef HAVE_AQUA +extern void setup_RdotApp(void); +extern Rboolean useaqua; +#endif + +void attribute_visible R_init_grDevices(DllInfo *dll) +{ + initPalette(); + R_registerRoutines(dll, NULL, CallEntries, NULL, ExtEntries); + R_useDynamicSymbols(dll, FALSE); + R_forceSymbols(dll, TRUE); + +#ifdef HAVE_AQUA +/* R.app will run event loop, so if we are running under that we don't + need to run one here */ + if(useaqua) setup_RdotApp(); +#endif +} diff --git a/com.oracle.truffle.r.native/gnur/patch/src/library/grDevices/src/qdBitmap.h b/com.oracle.truffle.r.native/gnur/patch/src/library/grDevices/src/qdBitmap.h new file mode 100644 index 0000000000000000000000000000000000000000..53170e6f3214f658b2f690db8ae43f35cd5bd30a --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/library/grDevices/src/qdBitmap.h @@ -0,0 +1,27 @@ +/* + * R : A Computer Language for Statistical Data Analysis + * Copyright (C) 2007 The R Foundation + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version. + * + * This program 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 this program; if not, a copy is available at + * https://www.R-project.org/Licenses/ + * + * Quartz Quartz device module header file + * + */ + +#include <R.h> +#include <R_ext/QuartzDevice.h> + +QuartzDesc_t QuartzBitmap_DeviceCreate(void *dd, QuartzFunctions_t *fn, QuartzParameters_t *par); + diff --git a/com.oracle.truffle.r.native/gnur/patch/src/library/grDevices/src/qdCocoa.h b/com.oracle.truffle.r.native/gnur/patch/src/library/grDevices/src/qdCocoa.h new file mode 100644 index 0000000000000000000000000000000000000000..816ac1d80ca23f776a11c20cc9e2a0dedfd8e68a --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/library/grDevices/src/qdCocoa.h @@ -0,0 +1,54 @@ +/* + * R : A Computer Language for Statistical Data Analysis + * Copyright (C) 2007 The R Foundation + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version. + * + * This program 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 this program; if not, a copy is available at + * https://www.R-project.org/Licenses/ + * + * Quartz Quartz device module header file + * + */ + +#include <R.h> +#include <R_ext/QuartzDevice.h> + +/* inofficial API that can be used by other applications */ + +#define QCF_SET_PEPTR 1 /* set ProcessEvents function pointer */ +#define QCF_SET_FRONT 2 /* set application mode to front */ + +void QuartzCocoa_SetupEventLoop(int flags, unsigned long latency); +int QuartzCocoa_SetLatency(unsigned long latency); + +/* this is the designated creator, used by the Quartz dispatcher */ +QuartzDesc_t QuartzCocoa_DeviceCreate(void *dd, QuartzFunctions_t *fn, QuartzParameters_t *par); + +#ifdef __OBJC__ + +#import <Cocoa/Cocoa.h> + +typedef struct sQuartzCocoaDevice QuartzCocoaDevice; + +@interface QuartzCocoaView : NSView +{ + QuartzCocoaDevice *ci; +} + ++ (QuartzCocoaView*) quartzWindowWithRect: (NSRect) rect andInfo: (void*) info; + +- (id) initWithFrame: (NSRect) fram andInfo: (void*) info; + +@end + +#endif diff --git a/com.oracle.truffle.r.native/gnur/patch/src/library/grDevices/src/qdPDF.h b/com.oracle.truffle.r.native/gnur/patch/src/library/grDevices/src/qdPDF.h new file mode 100644 index 0000000000000000000000000000000000000000..24aa7573b6ed148bab1901fb17db8b3dff6afdd2 --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/library/grDevices/src/qdPDF.h @@ -0,0 +1,5 @@ +#include <R.h> +#include <R_ext/QuartzDevice.h> + +QuartzDesc_t QuartzPDF_DeviceCreate(void *dd, QuartzFunctions_t *fn, QuartzParameters_t *par); + diff --git a/com.oracle.truffle.r.native/gnur/patch/src/library/grDevices/src/stubs.c b/com.oracle.truffle.r.native/gnur/patch/src/library/grDevices/src/stubs.c new file mode 100644 index 0000000000000000000000000000000000000000..c5024370a2b6e4da37cd4a07bcabd24aa989be39 --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/library/grDevices/src/stubs.c @@ -0,0 +1,112 @@ +/* + * R : A Computer Language for Statistical Data Analysis + * Copyright (C) 2012-2014 the R Core Team + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version. + * + * This program 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 this program; if not, a copy is available at + * https://www.R-project.org/Licenses/ + */ + +#include <config.h> +#include <Defn.h> +#include <Internal.h> +#include "grDevices.h" + +#ifndef _WIN32 +SEXP do_X11(SEXP call, SEXP op, SEXP args, SEXP env); +SEXP do_saveplot(SEXP call, SEXP op, SEXP args, SEXP env); +SEXP do_bmVersion(void); + +SEXP X11(SEXP call, SEXP op, SEXP args, SEXP env) +{ + return do_X11(call, op, CDR(args), env); +} + +SEXP savePlot(SEXP call, SEXP op, SEXP args, SEXP env) +{ + return do_saveplot(call, op, CDR(args), env); +} +SEXP bmVersion(void) +{ + return do_bmVersion(); +} +#endif + +SEXP contourLines(SEXP call, SEXP op, SEXP args, SEXP env) +{ + return do_contourLines(call, op, CDR(args), env); +} + +SEXP getSnapshot(SEXP call, SEXP op, SEXP args, SEXP env) +{ + return do_getSnapshot(call, op, CDR(args), env); +} + +SEXP playSnapshot(SEXP call, SEXP op, SEXP args, SEXP env) +{ + return do_playSnapshot(call, op, CDR(args), env); +} + +SEXP getGraphicsEvent(SEXP call, SEXP op, SEXP args, SEXP env) +{ + return do_getGraphicsEvent(call, op, CDR(args), env); +} + +SEXP getGraphicsEventEnv(SEXP call, SEXP op, SEXP args, SEXP env) +{ + return do_getGraphicsEventEnv(call, op, CDR(args), env); +} + +SEXP setGraphicsEventEnv(SEXP call, SEXP op, SEXP args, SEXP env) +{ + return do_setGraphicsEventEnv(call, op, CDR(args), env); +} + +#ifdef _WIN32 +SEXP bringtotop(SEXP sdev, SEXP sstay); +SEXP msgwindow(SEXP sdev, SEXP stype); + + +SEXP bringToTop(SEXP sdev, SEXP sstay) +{ + return bringtotop(sdev, sstay); +} + +SEXP msgWindow(SEXP sdev, SEXP stype) +{ + return msgwindow(sdev, stype); +} + +#endif + + +#include <R_ext/GraphicsEngine.h> + +SEXP devAskNewPage(SEXP call, SEXP op, SEXP args, SEXP env) +{ + int ask; + pGEDevDesc gdd = GEcurrentDevice(); + Rboolean oldask = gdd->ask; + + args = CDR(args); + if (!isNull(CAR(args))) { + ask = asLogical(CAR(args)); + if (ask == NA_LOGICAL) error(_("invalid '%s' argument"), "ask"); + gdd->ask = ask; + R_Visible = FALSE; + } else R_Visible = TRUE; + + return ScalarLogical(oldask); +} + + diff --git a/com.oracle.truffle.r.native/gnur/patch/src/library/grDevices/src/winbitmap.h b/com.oracle.truffle.r.native/gnur/patch/src/library/grDevices/src/winbitmap.h new file mode 100644 index 0000000000000000000000000000000000000000..1dad7f8a190d3bf6d330a348d796807caf89a838 --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/library/grDevices/src/winbitmap.h @@ -0,0 +1,36 @@ +/* + * R : A Computer Langage for Statistical Data Analysis + * Copyright (C) 2014 The R Core Team + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version. + * + * This program 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 this program; if not, a copy is available at + * https://www.R-project.org/Licenses/ + */ +extern int +R_SaveAsPng(void *d, int width, int height, + unsigned int (*gp)(void *, int, int), + int bgr, FILE *fp, unsigned int transparent, int res); +extern int +R_SaveAsJpeg(void *d, int width, int height, + unsigned int (*gp)(void *, int, int), + int bgr, int quality, FILE *outfile, int res); +extern int +R_SaveAsTIFF(void *d, int width, int height, + unsigned int (*gp)(void *, int, int), + int bgr, const char *outfile, int res, int compression); +extern int +R_SaveAsBmp(void *d, int width, int height, + unsigned int (*gp)(void *, int, int), int bgr, FILE *fp, int res); +const char * R_pngVersion(void); +const char * R_jpegVersion(void); +const char * R_tiffVersion(void); diff --git a/com.oracle.truffle.r.native/gnur/patch/src/library/graphics/src/base.c b/com.oracle.truffle.r.native/gnur/patch/src/library/graphics/src/base.c new file mode 100644 index 0000000000000000000000000000000000000000..1e6dfcbe7d2548e991479685bff5ffc5197f3b4a --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/library/graphics/src/base.c @@ -0,0 +1,403 @@ +/* + * R : A Computer Language for Statistical Data Analysis + * Copyright (C) 2001-12 The R Core Team. + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version. + * + * This program 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 this program; if not, a copy is available at + * https://www.R-project.org/Licenses/ + */ + +/* The beginning of code which represents an R base graphics system + * separate from an R graphics engine (separate from R devices) + */ + +#ifdef HAVE_CONFIG_H +#include <config.h> +#endif + +#include <Defn.h> +#include <Graphics.h> +#include <GraphicsBase.h> + +#ifdef ENABLE_NLS +#include <libintl.h> +#undef _ +#define _(String) dgettext ("graphics", String) +#else +#define _(String) (String) +#endif + + +static R_INLINE GPar* dpSavedptr(pGEDevDesc dd) { + if (baseRegisterIndex == -1) + error(_("no base graphics system is registered")); + baseSystemState *bss = dd->gesd[baseRegisterIndex]->systemSpecific; + return &(bss->dpSaved); +} + +static void restoredpSaved(pGEDevDesc dd) +{ + /* NOTE that not all params should be restored before playing */ + /* the display list (e.g., don't restore the device size) */ + + /* This could probably now just do a memcpy */ + int i, j, nr, nc; + + dpptr(dd)->state = dpSavedptr(dd)->state; + /* does not restore 'valid' */ + dpptr(dd)->adj = dpSavedptr(dd)->adj; + dpptr(dd)->ann = dpSavedptr(dd)->ann; + dpptr(dd)->bg = dpSavedptr(dd)->bg; + dpptr(dd)->bty = dpSavedptr(dd)->bty; + dpptr(dd)->cex = dpSavedptr(dd)->cex; + gpptr(dd)->lheight = dpSavedptr(dd)->lheight; + dpptr(dd)->col = dpSavedptr(dd)->col; + dpptr(dd)->crt = dpSavedptr(dd)->crt; + dpptr(dd)->err = dpSavedptr(dd)->err; + dpptr(dd)->fg = dpSavedptr(dd)->fg; + strncpy(dpptr(dd)->family, dpSavedptr(dd)->family, 201); + dpptr(dd)->font = dpSavedptr(dd)->font; + dpptr(dd)->gamma = dpSavedptr(dd)->gamma; + dpptr(dd)->lab[0] = dpSavedptr(dd)->lab[0]; + dpptr(dd)->lab[1] = dpSavedptr(dd)->lab[1]; + dpptr(dd)->lab[2] = dpSavedptr(dd)->lab[2]; + dpptr(dd)->las = dpSavedptr(dd)->las; + dpptr(dd)->lty = dpSavedptr(dd)->lty; + dpptr(dd)->lwd = dpSavedptr(dd)->lwd; + dpptr(dd)->lend = dpSavedptr(dd)->lend; + dpptr(dd)->ljoin = dpSavedptr(dd)->ljoin; + dpptr(dd)->lmitre = dpSavedptr(dd)->lmitre; + dpptr(dd)->mgp[0] = dpSavedptr(dd)->mgp[0]; + dpptr(dd)->mgp[1] = dpSavedptr(dd)->mgp[1]; + dpptr(dd)->mgp[2] = dpSavedptr(dd)->mgp[2]; + dpptr(dd)->mkh = dpSavedptr(dd)->mkh; + dpptr(dd)->pch = dpSavedptr(dd)->pch; + dpptr(dd)->ps = dpSavedptr(dd)->ps; /*was commented out --why? Well, it never changes */ + dpptr(dd)->smo = dpSavedptr(dd)->smo; + dpptr(dd)->srt = dpSavedptr(dd)->srt; + dpptr(dd)->tck = dpSavedptr(dd)->tck; + dpptr(dd)->tcl = dpSavedptr(dd)->tcl; + dpptr(dd)->xaxp[0] = dpSavedptr(dd)->xaxp[0]; + dpptr(dd)->xaxp[1] = dpSavedptr(dd)->xaxp[1]; + dpptr(dd)->xaxp[2] = dpSavedptr(dd)->xaxp[2]; + dpptr(dd)->xaxs = dpSavedptr(dd)->xaxs; + dpptr(dd)->xaxt = dpSavedptr(dd)->xaxt; + dpptr(dd)->xpd = dpSavedptr(dd)->xpd; + /* not oldxpd, which is a gpptr concept */ + dpptr(dd)->xlog = dpSavedptr(dd)->xlog; + dpptr(dd)->yaxp[0] = dpSavedptr(dd)->yaxp[0]; + dpptr(dd)->yaxp[1] = dpSavedptr(dd)->yaxp[1]; + dpptr(dd)->yaxp[2] = dpSavedptr(dd)->yaxp[2]; + dpptr(dd)->yaxs = dpSavedptr(dd)->yaxs; + dpptr(dd)->yaxt = dpSavedptr(dd)->yaxt; + dpptr(dd)->ylog = dpSavedptr(dd)->ylog; + dpptr(dd)->cexbase = dpSavedptr(dd)->cexbase; + dpptr(dd)->cexmain = dpSavedptr(dd)->cexmain; + dpptr(dd)->cexlab = dpSavedptr(dd)->cexlab; + dpptr(dd)->cexsub = dpSavedptr(dd)->cexsub; + dpptr(dd)->cexaxis = dpSavedptr(dd)->cexaxis; + dpptr(dd)->fontmain = dpSavedptr(dd)->fontmain; + dpptr(dd)->fontlab = dpSavedptr(dd)->fontlab; + dpptr(dd)->fontsub = dpSavedptr(dd)->fontsub; + dpptr(dd)->fontaxis = dpSavedptr(dd)->fontaxis; + dpptr(dd)->colmain = dpSavedptr(dd)->colmain; + dpptr(dd)->collab = dpSavedptr(dd)->collab; + dpptr(dd)->colsub = dpSavedptr(dd)->colsub; + dpptr(dd)->colaxis = dpSavedptr(dd)->colaxis; + + /* must restore layout parameters; the different graphics */ + /* regions and coordinate transformations will be recalculated */ + /* but they need all of the layout information restored for this */ + /* to happen correctly */ + + dpptr(dd)->devmode = dpSavedptr(dd)->devmode; + dpptr(dd)->fig[0] = dpSavedptr(dd)->fig[0]; + dpptr(dd)->fig[1] = dpSavedptr(dd)->fig[1]; + dpptr(dd)->fig[2] = dpSavedptr(dd)->fig[2]; + dpptr(dd)->fig[3] = dpSavedptr(dd)->fig[3]; + dpptr(dd)->fin[0] = dpSavedptr(dd)->fin[0]; + dpptr(dd)->fin[1] = dpSavedptr(dd)->fin[1]; + dpptr(dd)->fUnits = dpSavedptr(dd)->fUnits; + dpptr(dd)->defaultFigure = dpSavedptr(dd)->defaultFigure; + dpptr(dd)->mar[0] = dpSavedptr(dd)->mar[0]; + dpptr(dd)->mar[1] = dpSavedptr(dd)->mar[1]; + dpptr(dd)->mar[2] = dpSavedptr(dd)->mar[2]; + dpptr(dd)->mar[3] = dpSavedptr(dd)->mar[3]; + dpptr(dd)->mai[0] = dpSavedptr(dd)->mai[0]; + dpptr(dd)->mai[1] = dpSavedptr(dd)->mai[1]; + dpptr(dd)->mai[2] = dpSavedptr(dd)->mai[2]; + dpptr(dd)->mai[3] = dpSavedptr(dd)->mai[3]; + dpptr(dd)->mUnits = dpSavedptr(dd)->mUnits; + dpptr(dd)->mex = dpSavedptr(dd)->mex; + nr = dpptr(dd)->numrows = dpSavedptr(dd)->numrows; + nc = dpptr(dd)->numcols = dpSavedptr(dd)->numcols; + dpptr(dd)->currentFigure = dpSavedptr(dd)->currentFigure; + dpptr(dd)->lastFigure = dpSavedptr(dd)->lastFigure; + for (i = 0; i < nr && i < MAX_LAYOUT_ROWS; i++) { + dpptr(dd)->heights[i] = dpSavedptr(dd)->heights[i]; + dpptr(dd)->cmHeights[i] = dpSavedptr(dd)->cmHeights[i]; + } + for (j = 0; j < nc && j < MAX_LAYOUT_COLS; j++) { + dpptr(dd)->widths[j] = dpSavedptr(dd)->widths[j]; + dpptr(dd)->cmWidths[j] = dpSavedptr(dd)->cmWidths[j]; + } + for (i = 0; i < nr*nc && i < MAX_LAYOUT_CELLS; i++) { + dpptr(dd)->order[i] = dpSavedptr(dd)->order[i]; + dpptr(dd)->respect[i] = dpSavedptr(dd)->respect[i]; + } + dpptr(dd)->rspct = dpSavedptr(dd)->rspct; + dpptr(dd)->layout = dpSavedptr(dd)->layout; + dpptr(dd)->mfind = dpSavedptr(dd)->mfind; + dpptr(dd)->new = dpSavedptr(dd)->new; + dpptr(dd)->oma[0] = dpSavedptr(dd)->oma[0]; + dpptr(dd)->oma[1] = dpSavedptr(dd)->oma[1]; + dpptr(dd)->oma[2] = dpSavedptr(dd)->oma[2]; + dpptr(dd)->oma[3] = dpSavedptr(dd)->oma[3]; + dpptr(dd)->omi[0] = dpSavedptr(dd)->omi[0]; + dpptr(dd)->omi[1] = dpSavedptr(dd)->omi[1]; + dpptr(dd)->omi[2] = dpSavedptr(dd)->omi[2]; + dpptr(dd)->omi[3] = dpSavedptr(dd)->omi[3]; + dpptr(dd)->omd[0] = dpSavedptr(dd)->omd[0]; + dpptr(dd)->omd[1] = dpSavedptr(dd)->omd[1]; + dpptr(dd)->omd[2] = dpSavedptr(dd)->omd[2]; + dpptr(dd)->omd[3] = dpSavedptr(dd)->omd[3]; + dpptr(dd)->oUnits = dpSavedptr(dd)->oUnits; + dpptr(dd)->plt[0] = dpSavedptr(dd)->plt[0]; + dpptr(dd)->plt[1] = dpSavedptr(dd)->plt[1]; + dpptr(dd)->plt[2] = dpSavedptr(dd)->plt[2]; + dpptr(dd)->plt[3] = dpSavedptr(dd)->plt[3]; + dpptr(dd)->pin[0] = dpSavedptr(dd)->pin[0]; + dpptr(dd)->pin[1] = dpSavedptr(dd)->pin[1]; + dpptr(dd)->pUnits = dpSavedptr(dd)->pUnits; + dpptr(dd)->defaultPlot = dpSavedptr(dd)->defaultPlot; + dpptr(dd)->pty = dpSavedptr(dd)->pty; + dpptr(dd)->usr[0] = dpSavedptr(dd)->usr[0]; + dpptr(dd)->usr[1] = dpSavedptr(dd)->usr[1]; + dpptr(dd)->usr[2] = dpSavedptr(dd)->usr[2]; + dpptr(dd)->usr[3] = dpSavedptr(dd)->usr[3]; + dpptr(dd)->logusr[0] = dpSavedptr(dd)->logusr[0]; + dpptr(dd)->logusr[1] = dpSavedptr(dd)->logusr[1]; + dpptr(dd)->logusr[2] = dpSavedptr(dd)->logusr[2]; + dpptr(dd)->logusr[3] = dpSavedptr(dd)->logusr[3]; +} + +static SEXP baseCallback(GEevent task, pGEDevDesc dd, SEXP data) +{ + GESystemDesc *sd; + baseSystemState *bss, *bss2; + SEXP result = R_NilValue; + + switch (task) { + case GE_FinaliseState: + /* called from unregisterOne */ + sd = dd->gesd[baseRegisterIndex]; + free(sd->systemSpecific); + sd->systemSpecific = NULL; + break; + case GE_InitState: + { + /* called from registerOne */ + pDevDesc dev; + GPar *ddp; + sd = dd->gesd[baseRegisterIndex]; + dev = dd->dev; + bss = sd->systemSpecific = malloc(sizeof(baseSystemState)); + /* Bail out if necessary */ + if (!bss) return result; + /* Make sure initialized, or valgrind may complain. */ + memset(bss, 0, sizeof(baseSystemState)); + ddp = &(bss->dp); + GInit(ddp); + /* For some things, the device sets the starting value at least. */ + ddp->ps = dev->startps; + ddp->col = ddp->fg = dev->startcol; + ddp->bg = dev->startfill; + ddp->font = dev->startfont; + ddp->lty = dev->startlty; + ddp->gamma = dev->startgamma; + /* Initialise the gp settings too: formerly in addDevice. */ + copyGPar(ddp, &(bss->gp)); + GReset(dd); + /* + * The device has not yet received any base output + */ + bss->baseDevice = FALSE; + /* Indicate success */ + result = R_BlankString; + break; + } + case GE_CopyState: + { + /* called from GEcopyDisplayList */ + pGEDevDesc curdd = GEcurrentDevice(); + bss = dd->gesd[baseRegisterIndex]->systemSpecific; + bss2 = curdd->gesd[baseRegisterIndex]->systemSpecific; + copyGPar(&(bss->dpSaved), &(bss2->dpSaved)); + restoredpSaved(curdd); + copyGPar(&(bss2->dp), &(bss2->gp)); + GReset(curdd); + break; + } + case GE_SaveState: + /* called from GEinitDisplayList */ + bss = dd->gesd[baseRegisterIndex]->systemSpecific; + copyGPar(&(bss->dp), &(bss->dpSaved)); + break; + case GE_RestoreState: + /* called from GEplayDisplayList */ + bss = dd->gesd[baseRegisterIndex]->systemSpecific; + restoredpSaved(dd); + copyGPar(&(bss->dp), &(bss->gp)); + GReset(dd); + break; + case GE_SaveSnapshotState: + /* called from GEcreateSnapshot */ + { + SEXP pkgName; + bss = dd->gesd[baseRegisterIndex]->systemSpecific; + /* Changed from INTSXP in 2.7.0: but saved graphics lists + are protected by an R version number */ + PROTECT(result = allocVector(RAWSXP, sizeof(GPar))); + copyGPar(&(bss->dpSaved), (GPar*) RAW(result)); + PROTECT(pkgName = mkString("graphics")); + setAttrib(result, install("pkgName"), pkgName); + UNPROTECT(2); + } + break; + case GE_RestoreSnapshotState: + /* called from GEplaySnapshot */ + { + int i, nState = LENGTH(data) - 1; + SEXP graphicsState, snapshotEngineVersion; + PROTECT(graphicsState = R_NilValue); + /* Prior to engine version 11, "pkgName" was not stored. + * (can tell because "engineVersion" was not stored either.) + * Assume 'graphics' is first state in snapshot + * (though this could be fatal). + */ + PROTECT(snapshotEngineVersion = + getAttrib(data, install("engineVersion"))); + if (isNull(snapshotEngineVersion)) { + graphicsState = VECTOR_ELT(data, 1); + } else { + for (i=0; i<nState; i++) { + SEXP state = VECTOR_ELT(data, i + 1); + if (!strcmp(CHAR(STRING_ELT(getAttrib(state, + install("pkgName")), + 0)), + "graphics")) { + graphicsState = state; + } + } + } + if (!isNull(graphicsState)) { + /* Check that RAW blob being restored is same size + * as GPar struct in current R version. + * Any version difference will have been warned about, + * but a difference here means STOP. + */ + if (LENGTH(graphicsState) != sizeof(GPar)) { + error(_("Incompatible graphics state")); + } + bss = dd->gesd[baseRegisterIndex]->systemSpecific; + copyGPar((GPar*) RAW(graphicsState), &(bss->dpSaved)); + /* These are probably redundant because GE_RestoreState + * will follow from GEplayDisplayList(), but no harm + * is done + * AND there is at least one place that + * depends on this ('gridGraphics' package replays + * an empty DL to do restoredpSaved() on new page) + */ + restoredpSaved(dd); + copyGPar(&(bss->dp), &(bss->gp)); + GReset(dd); + /* Make the device "clean" with respect to 'graphics' + * so that the display list replay starts from scratch + */ + bss->baseDevice = FALSE; + } + UNPROTECT(2); + } + break; + case GE_CheckPlot: + /* called from GEcheckState: + Check that the current plotting state is "valid" + */ + bss = dd->gesd[baseRegisterIndex]->systemSpecific; + result = ScalarLogical(bss->baseDevice ? + (bss->gp.state == 1) && bss->gp.valid : + TRUE); + break; + case GE_ScalePS: + { + /* called from GEhandleEvent in devWindows.c */ + GPar *ddp, *ddpSaved; + bss = dd->gesd[baseRegisterIndex]->systemSpecific; + ddp = &(bss->dp); + ddpSaved = &(bss->dpSaved); + if (isReal(data) && LENGTH(data) == 1) { + double rf = REAL(data)[0]; + ddp->scale *= rf; + /* Modify the saved settings so this effects display list too */ + ddpSaved->scale *= rf; + } else + error("event 'GE_ScalePS' requires a single numeric value"); + break; + } + } + return result; +} + +/* (un)Register the base graphics system with the graphics engine + */ +void +registerBase(void) { + GEregisterSystem(baseCallback, &baseRegisterIndex); +} + +void +unregisterBase(void) { + GEunregisterSystem(baseRegisterIndex); + baseRegisterIndex = -1; +} + +SEXP RunregisterBase(void) +{ + unregisterBase(); + return R_NilValue; +} + +/* FIXME: Make this a macro to avoid function call overhead? + Inline it if you really think it matters. + */ +GPar* gpptr(pGEDevDesc dd) { + if (baseRegisterIndex == -1) + error(_("the base graphics system is not registered")); + baseSystemState *bss = dd->gesd[baseRegisterIndex]->systemSpecific; + return &(bss->gp); +} + +GPar* dpptr(pGEDevDesc dd) { + if (baseRegisterIndex == -1) + error(_("the base graphics system is not registered")); + baseSystemState *bss = dd->gesd[baseRegisterIndex]->systemSpecific; + return &(bss->dp); +} + +/* called in GNewPlot to mark device as 'dirty' */ +void Rf_setBaseDevice(Rboolean val, pGEDevDesc dd) { + if (baseRegisterIndex == -1) + error(_("the base graphics system is not registered")); + baseSystemState *bss = dd->gesd[baseRegisterIndex]->systemSpecific; + bss->baseDevice = val; +} diff --git a/com.oracle.truffle.r.native/gnur/patch/src/library/graphics/src/graphics.c b/com.oracle.truffle.r.native/gnur/patch/src/library/graphics/src/graphics.c new file mode 100644 index 0000000000000000000000000000000000000000..47dd3799aad8bb3bfca982d50e991c32f9517574 --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/library/graphics/src/graphics.c @@ -0,0 +1,3498 @@ +/* + * R : A Computer Language for Statistical Data Analysis + * Copyright (C) 1995, 1996 Robert Gentleman and Ross Ihaka + * Copyright (C) 1997--2016 The R Core Team + * Copyright (C) 2002--2011 The R Foundation + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version. + * + * This program 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 this program; if not, a copy is available at + * https://www.R-project.org/Licenses/ + + + * This is an extensive reworking by Paul Murrell of an original + * quick hack by Ross Ihaka designed to give a superset of the + * functionality in the AT&T Bell Laboratories GRZ library. + */ + +#ifdef HAVE_CONFIG_H +#include <config.h> +#endif + +#include <Defn.h> +#include <float.h> /* for DBL_EPSILON etc */ +#include <Graphics.h> +// --> R_ext/GraphicsEngine.h + Rgraphics.h +#include <GraphicsBase.h> /* setBaseDevice */ +#include <Rmath.h> /* eg. fmax2() */ + +#ifdef ENABLE_NLS +#include <libintl.h> +#undef _ +#define _(String) dgettext ("grDevices", String) +#else +#define _(String) (String) +#endif + +/*--->> Documentation now in ../include/Rgraphics.h "API" ----- */ + +double R_Log10(double x) +{ + return (R_FINITE(x) && x > 0.0) ? log10(x) : NA_REAL; +} + +/*------------------------------------------------------------------- + * + * TRANSFORMATIONS + * + * There are five major regions on a device, for any + * particular figure: the outer margins, which "stick" + * to the edges of the device; the inner region, which + * is defined as the total device less the outer margins; + * the figure region, which defaults from the current + * layout (mfrow, mfcol, layout) unless the user specifies + * it directly (fig, fin); the figure margins, which + * "stick" to the edges of the plot region; and thed + * plot region, which is the figure region less the figure + * margins by default unless the user specifies it directly + * (plt, pin) + * + * COORDINATE SYSTEMS + * + * DEVICE = devices natural coordinate system + * (e.g., pixels, 1/72", ...) + * NDC = normalised device coordinates (0..1 on device) + * INCHES = inches + * OMA1..4 = outer margin coordinates + * NIC = normalised inner region coordinates + * (0..1 on inner region) + * NFC = normalised figure coordinates + * (0..1 on figure region) + * MAR1..4 = figure margin coordinates + * NPC = normalised plot coordinates + * (0..1 on plot region) + * USER = world or data coordinates + * + * + * UNITS + * + * All of the above, except OMA1..4 and MAR1..4, plus ... + * + * LINES = line coordinates (lines of margin; based on mex) + * CHARS = char coordinates (lines of text; based on cex) + * + * The function Convert(value, from, to) is provided + * to transform between any pair of coordinate systems + * (for transforming locations) + * + * The functions ConvertXUnits(value, from, to) and + * ConvertYUnits(value, from, to) are provided to transform + * between any pair of units (for transforming dimensions) + * + * IMPORTANT: if user coordinates are logged, then the + * conversion to/from USER units will not work. in this + * case it is necessary to use convert(x1) - convert(x2) + * rather than convert(x1 - x2) + * + */ + + +/* In interpreted R, units are as follows: + * 1 = "user" + * 2 = "figure" + * 3 = "inches" + * the function GMapUnits provides a mapping + * between interpreted units and internal units. + */ +GUnit GMapUnits(int Runits) +{ + switch (Runits) { + case 1: return USER; + case 2: return NFC; + case 3: return INCHES; + default: return 0; + } +} + + /* Conversions Between Units*/ + +/* Used to be global (non-static) -- but are nowhere declared. + * The public interface is through G[XY]ConvertUnits() */ + +static double xNDCtoDevUnits(double x, pGEDevDesc dd) +{ + return x*fabs(gpptr(dd)->ndc2dev.bx); +} + +static double yNDCtoDevUnits(double y, pGEDevDesc dd) +{ + return y*fabs(gpptr(dd)->ndc2dev.by); +} + +static double xNICtoDevUnits(double x, pGEDevDesc dd) +{ + return x*fabs(gpptr(dd)->inner2dev.bx); +} + +static double yNICtoDevUnits(double y, pGEDevDesc dd) +{ + return y*fabs(gpptr(dd)->inner2dev.by); +} + +static double xNFCtoDevUnits(double x, pGEDevDesc dd) +{ + return x*fabs(gpptr(dd)->fig2dev.bx); +} + +static double yNFCtoDevUnits(double y, pGEDevDesc dd) +{ + return y*fabs(gpptr(dd)->fig2dev.by); +} + +static double xNPCtoDevUnits(double x, pGEDevDesc dd) +{ + return xNFCtoDevUnits(x*(gpptr(dd)->plt[1] - gpptr(dd)->plt[0]), dd); +} + +static double yNPCtoDevUnits(double y, pGEDevDesc dd) +{ + return yNFCtoDevUnits(y*(gpptr(dd)->plt[3] - gpptr(dd)->plt[2]), dd); +} + +static double xUsrtoDevUnits(double x, pGEDevDesc dd) +{ + return xNFCtoDevUnits(x*gpptr(dd)->win2fig.bx, dd); +} + +static double yUsrtoDevUnits(double y, pGEDevDesc dd) +{ + return yNFCtoDevUnits(y*gpptr(dd)->win2fig.by, dd); +} + +static double xInchtoDevUnits(double x, pGEDevDesc dd) +{ + return xNDCtoDevUnits(x*gpptr(dd)->xNDCPerInch, dd); +} + +static double yInchtoDevUnits(double y, pGEDevDesc dd) +{ + return yNDCtoDevUnits(y*gpptr(dd)->yNDCPerInch, dd); +} + +static double xLinetoDevUnits(double x, pGEDevDesc dd) +{ + return xNDCtoDevUnits(x*gpptr(dd)->xNDCPerLine, dd); +} + +static double yLinetoDevUnits(double y, pGEDevDesc dd) +{ + return yNDCtoDevUnits(y*gpptr(dd)->yNDCPerLine, dd); +} + +static double xChartoDevUnits(double x, pGEDevDesc dd) +{ + return xNDCtoDevUnits(x*gpptr(dd)->cex*gpptr(dd)->xNDCPerChar, dd); +} + +static double yChartoDevUnits(double y, pGEDevDesc dd) +{ + return yNDCtoDevUnits(y*gpptr(dd)->cex*gpptr(dd)->yNDCPerChar, dd); +} + +static double xDevtoNDCUnits(double x, pGEDevDesc dd) +{ + return x/fabs(gpptr(dd)->ndc2dev.bx); +} + +static double yDevtoNDCUnits(double y, pGEDevDesc dd) +{ + return y/fabs(gpptr(dd)->ndc2dev.by); +} + +static double xDevtoNICUnits(double x, pGEDevDesc dd) +{ + return x/fabs(gpptr(dd)->inner2dev.bx); +} + +static double yDevtoNICUnits(double y, pGEDevDesc dd) +{ + return y/fabs(gpptr(dd)->inner2dev.by); +} + +static double xDevtoNFCUnits(double x, pGEDevDesc dd) +{ + return x/fabs(gpptr(dd)->fig2dev.bx); +} + +static double yDevtoNFCUnits(double y, pGEDevDesc dd) +{ + return y/fabs(gpptr(dd)->fig2dev.by); +} + +static double xDevtoNPCUnits(double x, pGEDevDesc dd) +{ + return xDevtoNFCUnits(x, dd)/(gpptr(dd)->plt[1] - gpptr(dd)->plt[0]); +} + +static double yDevtoNPCUnits(double y, pGEDevDesc dd) +{ + return yDevtoNFCUnits(y, dd)/(gpptr(dd)->plt[3] - gpptr(dd)->plt[2]); +} + +static double xDevtoUsrUnits(double x, pGEDevDesc dd) +{ + return xDevtoNFCUnits(x, dd)/gpptr(dd)->win2fig.bx; +} + +static double yDevtoUsrUnits(double y, pGEDevDesc dd) +{ + return yDevtoNFCUnits(y, dd)/gpptr(dd)->win2fig.by; +} + +static double xDevtoInchUnits(double x, pGEDevDesc dd) +{ + return xDevtoNDCUnits(x, dd)/gpptr(dd)->xNDCPerInch; +} + +static double yDevtoInchUnits(double y, pGEDevDesc dd) +{ + return yDevtoNDCUnits(y, dd)/gpptr(dd)->yNDCPerInch; +} + +static double xDevtoLineUnits(double x, pGEDevDesc dd) +{ + return xDevtoNDCUnits(x, dd)/gpptr(dd)->xNDCPerLine; +} + +static double yDevtoLineUnits(double y, pGEDevDesc dd) +{ + return yDevtoNDCUnits(y, dd)/gpptr(dd)->yNDCPerLine; +} + +/* NOTE that use the _current_ gpptr(dd)->cex here */ +/* the conversion for lines doesn't have to worry about */ +/* this because gpptr(dd)->mex can only be set once per plot */ + +static double xDevtoCharUnits(double x, pGEDevDesc dd) +{ + return xDevtoNDCUnits(x, dd)/(gpptr(dd)->cex * gpptr(dd)->xNDCPerChar); +} + +static double yDevtoCharUnits(double y, pGEDevDesc dd) +{ + return yDevtoNDCUnits(y, dd)/(gpptr(dd)->cex * gpptr(dd)->yNDCPerChar); +} + +static void NORET BadUnitsError(const char *where) +{ + error(_("bad units specified in '%s'"), where); +} + +/* GConvertXUnits() and GConvertYUnits() convert + a single value fromUnits toUnits : */ + +double GConvertXUnits(double x, GUnit fromUnits, GUnit toUnits, pGEDevDesc dd) +{ + double dev, final; + switch (fromUnits) { + case DEVICE: dev = x; break; + case NDC: dev = xNDCtoDevUnits(x, dd); break; + case NIC: dev = xNICtoDevUnits(x, dd); break; + case NFC: dev = xNFCtoDevUnits(x, dd); break; + case NPC: dev = xNPCtoDevUnits(x, dd); break; + case USER: dev = xUsrtoDevUnits(x, dd); break; + case INCHES: dev = xInchtoDevUnits(x, dd); break; + case LINES: dev = xLinetoDevUnits(x, dd); break; + case CHARS: dev = xChartoDevUnits(x, dd); break; + default: dev = 0; BadUnitsError("GConvertXUnits"); + + } + switch (toUnits) { + case DEVICE: final = dev; break; + case NDC: final = xDevtoNDCUnits(dev, dd); break; + case NIC: final = xDevtoNICUnits(dev, dd); break; + case NFC: final = xDevtoNFCUnits(dev, dd); break; + case NPC: final = xDevtoNPCUnits(dev, dd); break; + case USER: final = xDevtoUsrUnits(dev, dd); break; + case INCHES: final = xDevtoInchUnits(dev, dd); break; + case LINES: final = xDevtoLineUnits(dev, dd); break; + case CHARS: final = xDevtoCharUnits(dev, dd); break; + default: final = 0; BadUnitsError("GConvertXUnits"); + } + return final; +} + +double GConvertYUnits(double y, GUnit fromUnits, GUnit toUnits, pGEDevDesc dd) +{ + double dev, final; + switch (fromUnits) { + case DEVICE: dev = y; break; + case NDC: dev = yNDCtoDevUnits(y, dd); break; + case NIC: dev = yNICtoDevUnits(y, dd); break; + case NFC: dev = yNFCtoDevUnits(y, dd); break; + case NPC: dev = yNPCtoDevUnits(y, dd); break; + case USER: dev = yUsrtoDevUnits(y, dd); break; + case INCHES: dev = yInchtoDevUnits(y, dd); break; + case LINES: dev = yLinetoDevUnits(y, dd); break; + case CHARS: dev = yChartoDevUnits(y, dd); break; + default: dev = 0; BadUnitsError("GConvertYUnits"); + } + switch (toUnits) { + case DEVICE: final = dev; break; + case NDC: final = yDevtoNDCUnits(dev, dd); break; + case NIC: final = yDevtoNICUnits(dev, dd); break; + case NFC: final = yDevtoNFCUnits(dev, dd); break; + case NPC: final = yDevtoNPCUnits(dev, dd); break; + case USER: final = yDevtoUsrUnits(dev, dd); break; + case INCHES: final = yDevtoInchUnits(dev, dd); break; + case LINES: final = yDevtoLineUnits(dev, dd); break; + case CHARS: final = yDevtoCharUnits(dev, dd); break; + default: final = 0; BadUnitsError("GConvertYUnits"); + } + return final; +} + +/* Functions to convert locations from one coordinate system to another */ + +/* OTHER coordinate systems to DEVICE */ + +/* Used to be global (non-static) -- but are nowhere declared. + * The public interface is GConvert(), GConvertX(), GConvertY() */ +static double xNDCtoDev(double x, pGEDevDesc dd) +{ + return gpptr(dd)->ndc2dev.ax + x*gpptr(dd)->ndc2dev.bx; +} + +static double yNDCtoDev(double y, pGEDevDesc dd) +{ + return gpptr(dd)->ndc2dev.ay + y*gpptr(dd)->ndc2dev.by; +} + +static double xInchtoDev(double x, pGEDevDesc dd) +{ + return xNDCtoDev(x*gpptr(dd)->xNDCPerInch, dd); +} + +static double yInchtoDev(double y, pGEDevDesc dd) +{ + return yNDCtoDev(y*gpptr(dd)->yNDCPerInch, dd); +} + +static double xLinetoDev(double x, pGEDevDesc dd) +{ + return xNDCtoDev(x*gpptr(dd)->xNDCPerLine, dd); +} + +static double yLinetoDev(double y, pGEDevDesc dd) +{ + return yNDCtoDev(y*gpptr(dd)->yNDCPerLine, dd); +} + +static double xNICtoDev(double x, pGEDevDesc dd) +{ + return gpptr(dd)->inner2dev.ax + x*gpptr(dd)->inner2dev.bx; +} + +static double yNICtoDev(double y, pGEDevDesc dd) +{ + return gpptr(dd)->inner2dev.ay + y*gpptr(dd)->inner2dev.by; +} +/* NOTE that an x-coordinate in OMA2 or OMA4 converts to a */ +/* y-coordinate in Dev and a y-coordinate in OMA2 or OMA4 */ +/* converts to an x-coordinate in Dev */ + +static double xOMA1toDev(double x, pGEDevDesc dd) +{ + return xNICtoDev(x, dd); +} + +static double yOMA1toDev(double y, pGEDevDesc dd) +{ + return yLinetoDev((gpptr(dd)->oma[0] - y), dd); +} + +static double xOMA2toyDev(double x, pGEDevDesc dd) +{ + return yNICtoDev(x, dd); +} + +static double yOMA2toxDev(double y, pGEDevDesc dd) +{ + return xLinetoDev((gpptr(dd)->oma[1] - y), dd); +} + +static double xOMA3toDev(double x, pGEDevDesc dd) +{ + return xNICtoDev(x, dd); +} + +static double yOMA3toDev(double y, pGEDevDesc dd) +{ + double ndc = 1.0-yDevtoNDC(yLinetoDev((gpptr(dd)->oma[2] - y), dd), dd); + return yNDCtoDev(ndc, dd); +} + +static double xOMA4toyDev(double x, pGEDevDesc dd) +{ + return yNICtoDev(x, dd); +} + +static double yOMA4toxDev(double y, pGEDevDesc dd) +{ + double ndc = 1.0-xDevtoNDC(xLinetoDev(gpptr(dd)->oma[3]-y, dd), dd); + return xNDCtoDev(ndc, dd); +} + +static double xNFCtoDev(double x, pGEDevDesc dd) +{ + return gpptr(dd)->fig2dev.ax + x*gpptr(dd)->fig2dev.bx; +} + +static double yNFCtoDev(double y, pGEDevDesc dd) +{ + return gpptr(dd)->fig2dev.ay + y*gpptr(dd)->fig2dev.by; +} + +static double xNPCtoDev(double x, pGEDevDesc dd) +{ + return xNFCtoDev(gpptr(dd)->plt[0] + + x*(gpptr(dd)->plt[1] - gpptr(dd)->plt[0]), dd); +} + +static double yNPCtoDev(double y, pGEDevDesc dd) +{ + return yNFCtoDev(gpptr(dd)->plt[2] + + y*(gpptr(dd)->plt[3] - gpptr(dd)->plt[2]), dd); +} + +static double xUsrtoDev(double x, pGEDevDesc dd) +{ + if (gpptr(dd)->xlog) + x = R_Log10(x); + return xNFCtoDev(gpptr(dd)->win2fig.ax + x*gpptr(dd)->win2fig.bx, dd); +} + +static double yUsrtoDev(double y, pGEDevDesc dd) +{ + if (gpptr(dd)->ylog) + y = R_Log10(y); + return yNFCtoDev(gpptr(dd)->win2fig.ay + y*gpptr(dd)->win2fig.by, dd); +} + +/* NOTE that an x-coordinate in MAR2 or MAR4 converts to a */ +/* y-coordinate in Dev and a y-coordinate in MAR2 or MAR4 */ +/* converts to an x-coordinate in Dev */ + +static double xMAR1toDev(double x, pGEDevDesc dd) +{ + return xUsrtoDev(x, dd); +} + +static double yMAR1toDev(double y, pGEDevDesc dd) +{ + double nfc = GConvertYUnits(y, LINES, NFC, dd); + return yNFCtoDev(gpptr(dd)->plt[2] - nfc, dd); +} + +static double xMAR2toyDev(double x, pGEDevDesc dd) +{ + return yUsrtoDev(x, dd); +} + +static double yMAR2toxDev(double y, pGEDevDesc dd) +{ + double nfc = GConvertXUnits(y, LINES, NFC, dd); + return xNFCtoDev(gpptr(dd)->plt[0] - nfc, dd); +} + +static double xMAR3toDev(double x, pGEDevDesc dd) +{ + return xUsrtoDev(x, dd); +} + +static double yMAR3toDev(double y, pGEDevDesc dd) +{ + double nfc = GConvertYUnits(y, LINES, NFC, dd); + return yNFCtoDev(gpptr(dd)->plt[3] + nfc, dd); +} + +static double xMAR4toyDev(double x, pGEDevDesc dd) +{ + return yUsrtoDev(x, dd); +} + +static double yMAR4toxDev(double y, pGEDevDesc dd) +{ + double nfc = GConvertXUnits(y, LINES, NFC, dd); + return xNFCtoDev(gpptr(dd)->plt[1] + nfc, dd); +} + +/* DEVICE coordinates to OTHER */ + +double xDevtoNDC(double x, pGEDevDesc dd) +{ + return (x - gpptr(dd)->ndc2dev.ax)/gpptr(dd)->ndc2dev.bx; +} + +double yDevtoNDC(double y, pGEDevDesc dd) +{ + return (y - gpptr(dd)->ndc2dev.ay)/gpptr(dd)->ndc2dev.by; +} + +static double xDevtoInch(double x, pGEDevDesc dd) +{ + return xDevtoNDC(x, dd)/gpptr(dd)->xNDCPerInch; +} + +static double yDevtoInch(double y, pGEDevDesc dd) +{ + return yDevtoNDC(y, dd)/gpptr(dd)->yNDCPerInch; +} + +static double xDevtoLine(double x, pGEDevDesc dd) +{ + return xDevtoNDC(x, dd)/gpptr(dd)->xNDCPerLine; +} + +static double yDevtoLine(double y, pGEDevDesc dd) +{ + return yDevtoNDC(y, dd)/gpptr(dd)->yNDCPerLine; +} + +static double xDevtoNIC(double x, pGEDevDesc dd) +{ + return (x - gpptr(dd)->inner2dev.ax)/gpptr(dd)->inner2dev.bx; +} + +static double yDevtoNIC(double y, pGEDevDesc dd) +{ + return (y - gpptr(dd)->inner2dev.ay)/gpptr(dd)->inner2dev.by; +} + +static double xDevtoOMA1(double x, pGEDevDesc dd) +{ + return xDevtoNIC(x, dd); +} + +static double yDevtoOMA1(double y, pGEDevDesc dd) +{ + return gpptr(dd)->oma[0] - yDevtoLine(y, dd); +} + +static double xDevtoyOMA2(double x, pGEDevDesc dd) +{ + return gpptr(dd)->oma[1] - xDevtoLine(x, dd); +} + +static double yDevtoxOMA2(double y, pGEDevDesc dd) +{ + return yDevtoNIC(y, dd); +} + +static double xDevtoOMA3(double x, pGEDevDesc dd) +{ + return xDevtoNIC(x, dd); +} + +static double yDevtoOMA3(double y, pGEDevDesc dd) +{ + double line = (1.0 - yDevtoNDC(y, dd))/gpptr(dd)->yNDCPerLine; + return gpptr(dd)->oma[2] - line; +} + +static double xDevtoyOMA4(double x, pGEDevDesc dd) +{ + double line = (1.0 - xDevtoNDC(x, dd))/gpptr(dd)->xNDCPerLine; + return gpptr(dd)->oma[3] - line; +} + +static double yDevtoxOMA4(double y, pGEDevDesc dd) +{ + return yDevtoNIC(y, dd); +} + +double xDevtoNFC(double x, pGEDevDesc dd) +{ + return (x - gpptr(dd)->fig2dev.ax)/gpptr(dd)->fig2dev.bx; +} + +double yDevtoNFC(double y, pGEDevDesc dd) +{ + return (y - gpptr(dd)->fig2dev.ay)/gpptr(dd)->fig2dev.by; +} + +double xDevtoNPC(double x, pGEDevDesc dd) +{ + return (xDevtoNFC(x, dd) - gpptr(dd)->plt[0])/ + (gpptr(dd)->plt[1] - gpptr(dd)->plt[0]); +} + +double yDevtoNPC(double y, pGEDevDesc dd) +{ + return (yDevtoNFC(y, dd) - gpptr(dd)->plt[2])/ + (gpptr(dd)->plt[3] - gpptr(dd)->plt[2]); +} + +/* a special case (NPC = normalised plot region coordinates) */ + +double xNPCtoUsr(double x, pGEDevDesc dd) +{ + if (gpptr(dd)->xlog) + return Rexp10(gpptr(dd)->logusr[0] + + x*(gpptr(dd)->logusr[1] - gpptr(dd)->logusr[0])); + else + return gpptr(dd)->usr[0] + x*(gpptr(dd)->usr[1] - gpptr(dd)->usr[0]); +} + +double yNPCtoUsr(double y, pGEDevDesc dd) +{ + if (gpptr(dd)->ylog) + return Rexp10(gpptr(dd)->logusr[2] + + y*(gpptr(dd)->logusr[3]-gpptr(dd)->logusr[2])); + else + return gpptr(dd)->usr[2] + y*(gpptr(dd)->usr[3] - gpptr(dd)->usr[2]); +} + +double xDevtoUsr(double x, pGEDevDesc dd) +{ + double nfc = xDevtoNFC(x, dd); + if (gpptr(dd)->xlog) + return Rexp10((nfc - gpptr(dd)->win2fig.ax)/gpptr(dd)->win2fig.bx); + else + return (nfc - gpptr(dd)->win2fig.ax)/gpptr(dd)->win2fig.bx; +} + +double yDevtoUsr(double y, pGEDevDesc dd) +{ + double nfc = yDevtoNFC(y, dd); + if (gpptr(dd)->ylog) + return Rexp10((nfc - gpptr(dd)->win2fig.ay)/gpptr(dd)->win2fig.by); + else + return (nfc - gpptr(dd)->win2fig.ay)/gpptr(dd)->win2fig.by; +} + +static double xDevtoMAR1(double x, pGEDevDesc dd) +{ + return xDevtoUsr(x, dd); +} + +static double yDevtoMAR1(double y, pGEDevDesc dd) +{ + return gpptr(dd)->oma[0] + gpptr(dd)->mar[0] - yDevtoLine(y, dd); +} + +static double xDevtoyMAR2(double x, pGEDevDesc dd) +{ + return gpptr(dd)->oma[1] + gpptr(dd)->mar[1] - xDevtoLine(x, dd); +} + +static double yDevtoxMAR2(double y, pGEDevDesc dd) +{ + return yDevtoUsr(y, dd); +} + +static double xDevtoMAR3(double x, pGEDevDesc dd) +{ + return xDevtoUsr(x, dd); +} + +static double yDevtoMAR3(double y, pGEDevDesc dd) +{ + double line = GConvertYUnits(1.0 - yDevtoNFC(y, dd), NFC, LINES, dd); + return gpptr(dd)->mar[2] - line; +} + +static double xDevtoyMAR4(double x, pGEDevDesc dd) +{ + double line = GConvertXUnits(1.0 - xDevtoNFC(x, dd), NFC, LINES, dd); + return gpptr(dd)->mar[3] - line; +} + +static double yDevtoxMAR4(double y, pGEDevDesc dd) +{ + return yDevtoUsr(y, dd); +} + +/* the Convert function converts a LOCATION in the FROM coordinate */ +/* system to a LOCATION in the TO coordinate system */ + +void GConvert(double *x, double *y, GUnit from, GUnit to, pGEDevDesc dd) +{ + double devx, devy; + + switch (from) { + case DEVICE: + devx = *x; + devy = *y; + break; + case NDC: + devx = xNDCtoDev(*x, dd); + devy = yNDCtoDev(*y, dd); + break; + case INCHES: + devx = xInchtoDev(*x, dd); + devy = yInchtoDev(*y, dd); + break; + case OMA1: + devx = xOMA1toDev(*x, dd); + devy = yOMA1toDev(*y, dd); + break; + case OMA2: + devx = yOMA2toxDev(*y, dd); + devy = xOMA2toyDev(*x, dd); + break; + case OMA3: + devx = xOMA3toDev(*x, dd); + devy = yOMA3toDev(*y, dd); + break; + case OMA4: + devx = yOMA4toxDev(*y, dd); + devy = xOMA4toyDev(*x, dd); + break; + case NIC: + devx = xNICtoDev(*x, dd); + devy = yNICtoDev(*y, dd); + break; + case NFC: + devx = xNFCtoDev(*x, dd); + devy = yNFCtoDev(*y, dd); + break; + case MAR1: + devx = xMAR1toDev(*x, dd); + devy = yMAR1toDev(*y, dd); + break; + case MAR2: + devx = yMAR2toxDev(*y, dd); + devy = xMAR2toyDev(*x, dd); + break; + case MAR3: + devx = xMAR3toDev(*x, dd); + devy = yMAR3toDev(*y, dd); + break; + case MAR4: + devx = yMAR4toxDev(*y, dd); + devy = xMAR4toyDev(*x, dd); + break; + case NPC: + devx = xNPCtoDev(*x, dd); + devy = yNPCtoDev(*y, dd); + break; + case USER: + devx = xUsrtoDev(*x, dd); + devy = yUsrtoDev(*y, dd); + break; + default: + devx = 0; /* for -Wall */ + devy = 0; + BadUnitsError("GConvert"); + } + + switch (to) { + case DEVICE: + *x = devx; + *y = devy; + break; + case NDC: + *x = xDevtoNDC(devx, dd); + *y = yDevtoNDC(devy, dd); + break; + case INCHES: + *x = xDevtoInch(devx, dd); + *y = yDevtoInch(devy, dd); + break; + case LINES: + *x = xDevtoLine(devx, dd); + *y = yDevtoLine(devy, dd); + break; + case NIC: + *x = xDevtoNIC(devx, dd); + *y = yDevtoNIC(devy, dd); + break; + case OMA1: + *x = xDevtoOMA1(devx, dd); + *y = yDevtoOMA1(devy, dd); + break; + case OMA2: + *x = yDevtoxOMA2(devy, dd); + *y = xDevtoyOMA2(devx, dd); + break; + case OMA3: + *x = xDevtoOMA3(devx, dd); + *y = yDevtoOMA3(devy, dd); + break; + case OMA4: + *x = yDevtoxOMA4(devy, dd); + *y = xDevtoyOMA4(devx, dd); + break; + case NFC: + *x = xDevtoNFC(devx, dd); + *y = yDevtoNFC(devy, dd); + break; + case NPC: + *x = xDevtoNPC(devx, dd); + *y = yDevtoNPC(devy, dd); + break; + case USER: + *x = xDevtoUsr(devx, dd); + *y = yDevtoUsr(devy, dd); + break; + case MAR1: + *x = xDevtoMAR1(devx, dd); + *y = yDevtoMAR1(devy, dd); + break; + case MAR2: + *x = yDevtoxMAR2(devy, dd); + *y = xDevtoyMAR2(devx, dd); + break; + case MAR3: + *x = xDevtoMAR3(devx, dd); + *y = yDevtoMAR3(devy, dd); + break; + case MAR4: + *x = yDevtoxMAR4(devy, dd); + *y = xDevtoyMAR4(devx, dd); + break; + default: + BadUnitsError("GConvert"); + } +} + +double GConvertX(double x, GUnit from, GUnit to, pGEDevDesc dd) +{ + double devx; + switch (from) { + case DEVICE:devx = x; break; + case NDC: devx = xNDCtoDev(x, dd); break; + case INCHES:devx = xInchtoDev(x, dd); break; + case LINES: devx = xLinetoDev(x, dd); break; + case OMA1: devx = xOMA1toDev(x, dd); break; + /*case OMA2: x <--> y */ + case OMA3: devx = xOMA3toDev(x, dd); break; + /*case OMA4: x <--> y */ + case NIC: devx = xNICtoDev(x, dd); break; + case NFC: devx = xNFCtoDev(x, dd); break; + case MAR1: devx = xMAR1toDev(x, dd); break; + /*case MAR2: x <--> y */ + case MAR3: devx = xMAR3toDev(x, dd); break; + /*case MAR4: x <--> y */ + case NPC: devx = xNPCtoDev(x, dd); break; + case USER: devx = xUsrtoDev(x, dd); break; + default: devx = 0;/* for -Wall */ BadUnitsError("GConvertX"); + } + + switch (to) { + case DEVICE:x = devx; break; + case NDC: x = xDevtoNDC(devx, dd); break; + case INCHES:x = xDevtoInch(devx, dd); break; + case LINES: x = xDevtoLine(devx, dd); break; + case NIC: x = xDevtoNIC(devx, dd); break; + case OMA1: x = xDevtoOMA1(devx, dd); break; + /*case OMA2: x <--> y */ + case OMA3: x = xDevtoOMA3(devx, dd); break; + /*case OMA4: x <--> y */ + case NFC: x = xDevtoNFC(devx, dd); break; + case USER: x = xDevtoUsr(devx, dd); break; + case MAR1: x = xDevtoMAR1(devx, dd); break; + /*case MAR2: x <--> y */ + case MAR3: x = xDevtoMAR3(devx, dd); break; + /*case MAR4: x <--> y */ + case NPC: x = xDevtoNPC(devx, dd); break; + default: BadUnitsError("GConvertX"); + } + return x; +} + +double GConvertY(double y, GUnit from, GUnit to, pGEDevDesc dd) +{ + double devy; + switch (from) { + case DEVICE:devy = y; break; + case NDC: devy = yNDCtoDev(y, dd); break; + case INCHES:devy = yInchtoDev(y, dd); break; + case LINES: devy = yLinetoDev(y, dd); break; + case OMA1: devy = yOMA1toDev(y, dd); break; + /*case OMA2: x <--> y */ + case OMA3: devy = yOMA3toDev(y, dd); break; + /*case OMA4: x <--> y */ + case NIC: devy = yNICtoDev(y, dd); break; + case NFC: devy = yNFCtoDev(y, dd); break; + case MAR1: devy = yMAR1toDev(y, dd); break; + /*case MAR2: x <--> y */ + case MAR3: devy = yMAR3toDev(y, dd); break; + /*case MAR4: x <--> y */ + case NPC: devy = yNPCtoDev(y, dd); break; + case USER: devy = yUsrtoDev(y, dd); break; + default: devy = 0;/* for -Wall */ BadUnitsError("GConvertY"); + } + + switch (to) { + case DEVICE:y = devy; break; + case NDC: y = yDevtoNDC(devy, dd); break; + case INCHES:y = yDevtoInch(devy, dd); break; + case LINES: y = yDevtoLine(devy, dd); break; + case NIC: y = yDevtoNIC(devy, dd); break; + case OMA1: y = yDevtoOMA1(devy, dd); break; + /*case OMA2: x <--> y */ + case OMA3: y = yDevtoOMA3(devy, dd); break; + /*case OMA4: x <--> y */ + case NFC: y = yDevtoNFC(devy, dd); break; + case USER: y = yDevtoUsr(devy, dd); break; + case MAR1: y = yDevtoMAR1(devy, dd); break; + /*case MAR2: x <--> y */ + case MAR3: y = yDevtoMAR3(devy, dd); break; + /*case MAR4: x <--> y */ + case NPC: y = yDevtoNPC(devy, dd); break; + default: BadUnitsError("GConvertY"); + } + return y; +} + +/* Code for layouts */ + +static double sum(double values[], int n, int cmValues[], int cmSum) +{ + int i; + double s = 0; + for (i = 0; i < n; i++) + if ((cmSum && cmValues[i]) || (!cmSum && !cmValues[i])) + s = s + values[i]; + return s; +} + +static double sumWidths(pGEDevDesc dd) +{ + return sum(gpptr(dd)->widths, gpptr(dd)->numcols, gpptr(dd)->cmWidths, 0); +} + +static double sumCmWidths(pGEDevDesc dd) +{ + return sum(gpptr(dd)->widths, gpptr(dd)->numcols, gpptr(dd)->cmWidths, 1); +} + +static double sumHeights(pGEDevDesc dd) +{ + return sum(gpptr(dd)->heights, gpptr(dd)->numrows, gpptr(dd)->cmHeights, 0); +} + +static double sumCmHeights(pGEDevDesc dd) +{ + return sum(gpptr(dd)->heights, gpptr(dd)->numrows, gpptr(dd)->cmHeights, 1); +} + +static int tallLayout(double cmWidth, double cmHeight, pGEDevDesc dd) +{ + return (cmHeight/sumHeights(dd)) > (cmWidth/sumWidths(dd)); +} + +static void figureExtent(int *minCol, int *maxCol, int *minRow, int *maxRow, + int figureNum, pGEDevDesc dd) +{ + int minc = -1; + int maxc = -1; + int minr = -1; + int maxr = -1; + int i, j; + int nr = gpptr(dd)->numrows; + for (i = 0; i < nr; i++) + for (j = 0; j < gpptr(dd)->numcols; j++) + if (gpptr(dd)->order[i + j*nr] == figureNum) { + if ((minc == -1) || (j < minc)) + minc = j; + if ((maxc == -1) || (j > maxc)) + maxc = j; + if ((minr == -1) || (i < minr)) + minr = i; + if ((maxr == -1) || (i > maxr)) + maxr = i; + } + *minCol = minc; + *maxCol = maxc; + *minRow = minr; + *maxRow = maxr; +} + +static double sumRegions(double regions[], int from, int to) +{ + int i; + double s = 0; + for (i = from; i < to + 1; i++) + s = s + regions[i]; + return s; +} + +static void largestRegion(double *width, double *height, + double layoutAspectRatio, double innerAspectRatio) +{ + if (layoutAspectRatio < innerAspectRatio) { + *width = 1.0; + *height = layoutAspectRatio/innerAspectRatio; + } + else { + *width = innerAspectRatio/layoutAspectRatio; + *height = 1.0; + } +} + +static void layoutRegion(double *width, double *height, + double widths[], double heights[], + double cmWidth, double cmHeight, pGEDevDesc dd) +{ + largestRegion(width, height, + sum(heights, gpptr(dd)->numrows, gpptr(dd)->cmHeights, 0)/ + sum(widths, gpptr(dd)->numcols, gpptr(dd)->cmWidths, 0), + cmHeight/cmWidth); +} + + + /* allocate one dimension (width or height) for either */ + /* relative or cm units */ + +static void allocDimension(double dimensions[], double sumDimensions, int n, + int cmDimensions[], int cmDimension) +{ + int i; + for (i = 0; i < n; i++) + if ((cmDimension && cmDimensions[i]) || + (!cmDimension && !cmDimensions[i])) + dimensions[i] = dimensions[i]/sumDimensions; +} + +static void allCmRegions(double widths[], double heights[], + double cmWidth, double cmHeight, pGEDevDesc dd) +{ + allocDimension(widths, cmWidth, gpptr(dd)->numcols, gpptr(dd)->cmWidths, 1); + allocDimension(heights, cmHeight, gpptr(dd)->numrows, gpptr(dd)->cmHeights, 1); +} + +static void modifyDimension(double dimension[], double multiplier, double n, + int cmDimensions[]) +{ + int i; + for (i = 0; i < n; i++) + if (!cmDimensions[i]) + dimension[i] = dimension[i] * multiplier; +} + +static void modifyRegions(double widths[], double heights[], + double colMultiplier, double rowMultiplier, + pGEDevDesc dd) +{ + modifyDimension(widths, colMultiplier, gpptr(dd)->numcols, gpptr(dd)->cmWidths); + modifyDimension(heights, rowMultiplier, gpptr(dd)->numrows, gpptr(dd)->cmHeights); +} + +static void regionsWithoutRespect(double widths[], double heights[], pGEDevDesc dd) +{ + allocDimension(widths, + sum(widths, gpptr(dd)->numcols, gpptr(dd)->cmWidths, 0), + gpptr(dd)->numcols, gpptr(dd)->cmWidths, 0); + allocDimension(heights, + sum(heights, gpptr(dd)->numrows, gpptr(dd)->cmHeights, 0), + gpptr(dd)->numrows, gpptr(dd)->cmHeights, 0); +} + +static void regionsWithRespect(double widths[], double heights[], + double cmWidth, double cmHeight, pGEDevDesc dd) +{ + double cm, rm; + layoutRegion(&cm, &rm, widths, heights, cmWidth, cmHeight, dd); + regionsWithoutRespect(widths, heights, dd); + modifyRegions(widths, heights, cm, rm, dd); +} + +static void widthsRespectingHeights(double widths[], + double cmWidth, double cmHeight, + pGEDevDesc dd) +{ + int i, j; + int respectedCols[MAX_LAYOUT_COLS]; + double widthLeft; + double disrespectedWidth = 0; + int nr = gpptr(dd)->numrows; + for (j = 0; j < gpptr(dd)->numcols; j++) { + respectedCols[j] = 0; + widths[j] = gpptr(dd)->widths[j]; + } + for (i = 0; i < nr; i++) + for (j = 0; j < gpptr(dd)->numcols; j++) + if (gpptr(dd)->respect[i + j * nr] && + !gpptr(dd)->cmWidths[j]) respectedCols[j] = 1; + for (j = 0; j < gpptr(dd)->numcols; j++) + if (!respectedCols[j]) + disrespectedWidth += gpptr(dd)->widths[j]; + widthLeft = sumHeights(dd) * cmWidth/cmHeight - + sumWidths(dd) + disrespectedWidth; + for (j = 0; j < gpptr(dd)->numcols; j++) + if (!respectedCols[j]) + widths[j] = widthLeft * widths[j]/disrespectedWidth; +} + +static void regionsRespectingHeight(double widths[], double heights[], + double cmWidth, double cmHeight, + pGEDevDesc dd) +{ + widthsRespectingHeights(widths, cmWidth, cmHeight, dd); + regionsWithRespect(widths, heights, cmWidth, cmHeight, dd); +} + +static void heightsRespectingWidths(double heights[], + double cmWidth, double cmHeight, + pGEDevDesc dd) +{ + int i, j; + int respectedRows[MAX_LAYOUT_ROWS]; + double heightLeft; + double disrespectedHeight = 0; + int nr = gpptr(dd)->numrows; + for (i = 0; i < nr; i++) { + respectedRows[i] = 0; + heights[i] = gpptr(dd)->heights[i]; + } + for (i = 0; i < nr; i++) + for (j = 0; j < gpptr(dd)->numcols; j++) + if (gpptr(dd)->respect[i + j*nr] && + !gpptr(dd)->cmHeights[i]) respectedRows[i] = 1; + for (i = 0; i < gpptr(dd)->numrows; i++) + if (!respectedRows[i]) + disrespectedHeight += gpptr(dd)->heights[i]; + heightLeft = sumWidths(dd) * cmHeight/cmWidth - + sumHeights(dd) + disrespectedHeight; + for (i = 0; i < gpptr(dd)->numrows; i++) + if (!respectedRows[i]) + heights[i] = heightLeft * heights[i]/disrespectedHeight; +} + +static void regionsRespectingWidth(double widths[], double heights[], + double cmWidth, double cmHeight, + pGEDevDesc dd) +{ + heightsRespectingWidths(heights, cmWidth, cmHeight, dd); + regionsWithRespect(widths, heights, cmWidth, cmHeight, dd); +} + +static void noCmRegions(double widths[], double heights[], + double cmWidth, double cmHeight, pGEDevDesc dd) +{ + switch (gpptr(dd)->rspct) { + case 0: + regionsWithoutRespect(widths, heights, dd); + break; + case 1: + regionsWithRespect(widths, heights, cmWidth, cmHeight, dd); + break; + case 2: + if (tallLayout(cmWidth, cmHeight, dd)) + regionsRespectingWidth(widths, heights, cmWidth, cmHeight, dd); + else + regionsRespectingHeight(widths, heights, cmWidth, cmHeight, dd); + } +} + +static void notAllCmRegions(double widths[], double heights[], + double cmWidth, double cmHeight, pGEDevDesc dd) +{ + double newCmWidth, newCmHeight; + newCmWidth = cmWidth - sumCmWidths(dd); + newCmHeight = cmHeight - sumCmHeights(dd); + noCmRegions(widths, heights, newCmWidth, newCmHeight, dd); + allocDimension(widths, cmWidth, gpptr(dd)->numcols, gpptr(dd)->cmWidths, 1); + allocDimension(heights, cmHeight, gpptr(dd)->numrows, gpptr(dd)->cmHeights, 1); + modifyDimension(widths, newCmWidth/cmWidth, gpptr(dd)->numcols, + gpptr(dd)->cmWidths); + modifyDimension(heights, newCmHeight/cmHeight, gpptr(dd)->numrows, + gpptr(dd)->cmHeights); +} + +static void widthCmRegions(double widths[], double heights[], + double cmWidth, double cmHeight, pGEDevDesc dd) +{ + allocDimension(widths, cmWidth, gpptr(dd)->numcols, gpptr(dd)->cmWidths, 1); + allocDimension(heights, sumHeights(dd), gpptr(dd)->numrows, + gpptr(dd)->cmHeights, 0); + modifyDimension(heights, (cmHeight - sumCmHeights(dd))/cmHeight, + gpptr(dd)->numrows, gpptr(dd)->cmHeights); + allocDimension(heights, cmHeight, gpptr(dd)->numrows, + gpptr(dd)->cmHeights, 1); +} + +static void heightCmRegions(double widths[], double heights[], + double cmWidth, double cmHeight, pGEDevDesc dd) +{ + allocDimension(heights, cmHeight, gpptr(dd)->numrows, gpptr(dd)->cmHeights, 1); + allocDimension(widths, sumWidths(dd), gpptr(dd)->numcols, + gpptr(dd)->cmWidths, 0); + modifyDimension(widths, (cmWidth - sumCmWidths(dd))/cmWidth, + gpptr(dd)->numcols, gpptr(dd)->cmWidths); + allocDimension(widths, cmWidth, gpptr(dd)->numcols, + gpptr(dd)->cmWidths, 1); +} + +static Rboolean allCmWidths(pGEDevDesc dd) +{ + int j; + for (j = 0; j < gpptr(dd)->numcols; j++) + if (!gpptr(dd)->cmWidths[j]) + return FALSE; + return TRUE; +} + +static Rboolean allCmHeights(pGEDevDesc dd) +{ + int i; + for (i = 0; i < gpptr(dd)->numrows; i++) + if (!gpptr(dd)->cmHeights[i]) + return FALSE; + return TRUE; +} + +static Rboolean noCmWidths(pGEDevDesc dd) +{ + int j; + for (j = 0; j < gpptr(dd)->numcols; j++) + if (gpptr(dd)->cmWidths[j]) + return FALSE; + return TRUE; +} + +static Rboolean noCmHeights(pGEDevDesc dd) +{ + int i; + for (i = 0; i < gpptr(dd)->numrows; i++) + if (gpptr(dd)->cmHeights[i]) + return FALSE; + return TRUE; +} + +static void someCmRegions(double widths[], double heights[], + double cmWidth, double cmHeight, pGEDevDesc dd) +{ + if (allCmWidths(dd)) + widthCmRegions(widths, heights, cmWidth, cmHeight, dd); + else if (allCmHeights(dd)) + heightCmRegions(widths, heights, cmWidth, cmHeight, dd); + else + notAllCmRegions(widths, heights, cmWidth, cmHeight, dd); +} + +static Rboolean allCm(pGEDevDesc dd) +{ + return allCmWidths(dd) && allCmHeights(dd); +} + +static Rboolean noCm(pGEDevDesc dd) +{ + return noCmWidths(dd) && noCmHeights(dd); +} + +static void layoutRegions(double widths[], double heights[], + double cmWidth, double cmHeight, pGEDevDesc dd) +{ + int i, j; + for (j = 0; j < gpptr(dd)->numcols; j++) + widths[j] = gpptr(dd)->widths[j]; + for (i = 0; i < gpptr(dd)->numrows; i++) + heights[i] = gpptr(dd)->heights[i]; + + if (allCm(dd)) + allCmRegions(widths, heights, cmWidth, cmHeight, dd); + else if (noCm(dd)) + noCmRegions(widths, heights, cmWidth, cmHeight, dd); + else + someCmRegions(widths, heights, cmWidth, cmHeight, dd); +} + +static void subRegion(double *left, double *right, double *bottom, double *top, + int mincol, int maxcol, + int minrow, int maxrow, + double widths[], double heights[], pGEDevDesc dd) +{ + double totalWidth = sumRegions(widths, 0, gpptr(dd)->numcols-1); + double totalHeight = sumRegions(heights, 0, gpptr(dd)->numrows-1); + *left = (0.5 - totalWidth/2) + sumRegions(widths, 0, mincol-1); + *right = (0.5 - totalWidth/2) + sumRegions(widths, 0, maxcol); + *bottom = (0.5 - totalHeight/2) + totalHeight + - sumRegions(heights, 0, maxrow); + *top = (0.5 - totalHeight/2) + totalHeight + - sumRegions(heights, 0, minrow-1); +} + +/* a fudge for backwards compatibility (of sorts) with par(mfg) */ +/* return the top-left-most row/col that the current figure */ +/* occupies in the current layout */ + +void currentFigureLocation(int *row, int *col, pGEDevDesc dd) +{ + int maxcol, maxrow; + if (gpptr(dd)->layout) + figureExtent(col, &maxcol, row, &maxrow, gpptr(dd)->currentFigure, dd); + else if (gpptr(dd)->mfind) { /* mfcol */ + *row = (gpptr(dd)->currentFigure - 1)%gpptr(dd)->numrows; + *col = (gpptr(dd)->currentFigure - 1)/gpptr(dd)->numrows; + } + else { /* mfrow */ + *row = (gpptr(dd)->currentFigure - 1)/gpptr(dd)->numcols; + *col = (gpptr(dd)->currentFigure - 1)%gpptr(dd)->numcols; + } +} + +/* mapNDC2Dev -- transformation from NDC to Dev */ +/* Use this coordinate system for outer margin coordinates */ +/* This must be called if the device is resized */ + +static void mapNDC2Dev(pGEDevDesc dd) +{ + /* For new devices, have to check the device's idea of its size + * in case there has been a resize. + */ + double asp = dd->dev->ipr[1] / dd->dev->ipr[0]; + + gpptr(dd)->ndc2dev.bx = dpptr(dd)->ndc2dev.bx = + dd->dev->right - dd->dev->left; + gpptr(dd)->ndc2dev.ax = dpptr(dd)->ndc2dev.ax = dd->dev->left; + gpptr(dd)->ndc2dev.by = dpptr(dd)->ndc2dev.by = + dd->dev->top - dd->dev->bottom; + gpptr(dd)->ndc2dev.ay = dpptr(dd)->ndc2dev.ay = dd->dev->bottom; + /* Units Conversion */ + + gpptr(dd)->xNDCPerInch = dpptr(dd)->xNDCPerInch = + 1.0/fabs(gpptr(dd)->ndc2dev.bx * dd->dev->ipr[0]); + gpptr(dd)->yNDCPerInch = dpptr(dd)->yNDCPerInch = + 1.0/fabs(gpptr(dd)->ndc2dev.by * dd->dev->ipr[1]); + gpptr(dd)->xNDCPerChar = dpptr(dd)->xNDCPerChar = + fabs(gpptr(dd)->cexbase * gpptr(dd)->scale * + dd->dev->cra[1] * asp / gpptr(dd)->ndc2dev.bx); + gpptr(dd)->yNDCPerChar = dpptr(dd)->yNDCPerChar = + fabs(gpptr(dd)->cexbase * gpptr(dd)->scale * + dd->dev->cra[1] / gpptr(dd)->ndc2dev.by); + gpptr(dd)->xNDCPerLine = dpptr(dd)->xNDCPerLine = + fabs(gpptr(dd)->mex * gpptr(dd)->cexbase * gpptr(dd)->scale * + dd->dev->cra[1] * asp / gpptr(dd)->ndc2dev.bx); + gpptr(dd)->yNDCPerLine = dpptr(dd)->yNDCPerLine = + fabs(gpptr(dd)->mex * gpptr(dd)->cexbase * gpptr(dd)->scale * + dd->dev->cra[1] / gpptr(dd)->ndc2dev.by); +} + +static void updateOuterMargins(pGEDevDesc dd) +{ + switch (gpptr(dd)->oUnits) { + case LINES: + gpptr(dd)->omi[0] = dpptr(dd)->omi[0] = + GConvertYUnits(gpptr(dd)->oma[0], LINES, INCHES, dd); + gpptr(dd)->omi[1] = dpptr(dd)->omi[1] = + GConvertXUnits(gpptr(dd)->oma[1], LINES, INCHES, dd); + gpptr(dd)->omi[2] = dpptr(dd)->omi[2] = + GConvertYUnits(gpptr(dd)->oma[2], LINES, INCHES, dd); + gpptr(dd)->omi[3] = dpptr(dd)->omi[3] = + GConvertXUnits(gpptr(dd)->oma[3], LINES, INCHES, dd); + gpptr(dd)->omd[0] = dpptr(dd)->omd[0] = + GConvertXUnits(gpptr(dd)->oma[1], LINES, NDC, dd); + gpptr(dd)->omd[1] = dpptr(dd)->omd[1] = + 1 - GConvertXUnits(gpptr(dd)->oma[3], LINES, NDC, dd); + gpptr(dd)->omd[2] = dpptr(dd)->omd[2] = + GConvertYUnits(gpptr(dd)->oma[0], LINES, NDC, dd); + gpptr(dd)->omd[3] = dpptr(dd)->omd[3] = + 1 - GConvertYUnits(gpptr(dd)->oma[2], LINES, NDC, dd); + break; + case INCHES: + gpptr(dd)->oma[0] = dpptr(dd)->oma[0] = + GConvertYUnits(gpptr(dd)->omi[0], INCHES, LINES, dd); + gpptr(dd)->oma[1] = dpptr(dd)->oma[1] = + GConvertXUnits(gpptr(dd)->omi[1], INCHES, LINES, dd); + gpptr(dd)->oma[2] = dpptr(dd)->oma[2] = + GConvertYUnits(gpptr(dd)->omi[2], INCHES, LINES, dd); + gpptr(dd)->oma[3] = dpptr(dd)->oma[3] = + GConvertXUnits(gpptr(dd)->omi[3], INCHES, LINES, dd); + gpptr(dd)->omd[0] = dpptr(dd)->omd[0] = + GConvertXUnits(gpptr(dd)->omi[1], INCHES, NDC, dd); + gpptr(dd)->omd[1] = dpptr(dd)->omd[1] = + 1 - GConvertXUnits(gpptr(dd)->omi[3], INCHES, NDC, dd); + gpptr(dd)->omd[2] = dpptr(dd)->omd[2] = + GConvertYUnits(gpptr(dd)->omi[0], INCHES, NDC, dd); + gpptr(dd)->omd[3] = dpptr(dd)->omd[3] = + 1 - GConvertYUnits(gpptr(dd)->omi[2], INCHES, NDC, dd); + break; + case NDC: + gpptr(dd)->oma[0] = dpptr(dd)->oma[0] = + GConvertYUnits(gpptr(dd)->omd[2], NDC, LINES, dd); + gpptr(dd)->oma[1] = dpptr(dd)->oma[1] = + GConvertXUnits(gpptr(dd)->omd[0], NDC, LINES, dd); + gpptr(dd)->oma[2] = dpptr(dd)->oma[2] = + GConvertYUnits(1 - gpptr(dd)->omd[3], NDC, LINES, dd); + gpptr(dd)->oma[3] = dpptr(dd)->oma[3] = + GConvertXUnits(1 - gpptr(dd)->omd[1], NDC, LINES, dd); + gpptr(dd)->omi[0] = dpptr(dd)->omi[0] = + GConvertYUnits(gpptr(dd)->omd[2], NDC, INCHES, dd); + gpptr(dd)->omi[1] = dpptr(dd)->omi[1] = + GConvertXUnits(gpptr(dd)->omd[0], NDC, INCHES, dd); + gpptr(dd)->omi[2] = dpptr(dd)->omi[2] = + GConvertYUnits(1 - gpptr(dd)->omd[3], NDC, INCHES, dd); + gpptr(dd)->omi[3] = dpptr(dd)->omi[3] = + GConvertXUnits(1 - gpptr(dd)->omd[1], NDC, INCHES, dd); + break; + default: break; /*nothing (-Wall) */ + } +} + +/* mapInner2Dev -- transformation from NIC to Dev */ +/* Use this coordinate system for setting up multiple figures */ +/* This is also used when specifying the figure region directly */ +/* Note that this is incompatible with S which uses then entire */ +/* device surface for such a plot */ +/* This must be called per DevNewPlot, if the NDCtoDev transformation */ +/* changes, and if oma changes */ + +static void mapInner2Dev(pGEDevDesc dd) +{ + double x0, x1, y0, y1; + x0 = xLinetoDev(gpptr(dd)->oma[1], dd); + y0 = yLinetoDev(gpptr(dd)->oma[0], dd); + x1 = GConvertXUnits(gpptr(dd)->oma[3], LINES, NDC, dd); + x1 = xNDCtoDev(1.0 - x1, dd); + y1 = GConvertYUnits(gpptr(dd)->oma[2], LINES, NDC, dd); + y1 = yNDCtoDev(1.0 - y1, dd); + gpptr(dd)->inner2dev.bx = dpptr(dd)->inner2dev.bx = x1 - x0; + gpptr(dd)->inner2dev.ax = dpptr(dd)->inner2dev.ax = x0; + gpptr(dd)->inner2dev.by = dpptr(dd)->inner2dev.by = y1 - y0; + gpptr(dd)->inner2dev.ay = dpptr(dd)->inner2dev.ay = y0; +} + +/* mapFigureRegion -- calculate figure region in NIC */ + +static void mapFigureRegion(pGEDevDesc dd) +{ + int mincol, maxcol, minrow, maxrow; + double x0, x1, y0, y1; + double widths[MAX_LAYOUT_COLS], heights[MAX_LAYOUT_ROWS]; + if (gpptr(dd)->layout) { + layoutRegions(widths, heights, + GConvertXUnits(1.0, NIC, INCHES, dd)*2.54, + GConvertYUnits(1.0, NIC, INCHES, dd)*2.54, dd); + figureExtent(&mincol, &maxcol, &minrow, &maxrow, + gpptr(dd)->currentFigure, dd); + subRegion(&x0, &x1, &y0, &y1, + mincol, maxcol, minrow, maxrow, + widths, heights, dd); + } + else { + int row, col; + if (gpptr(dd)->mfind) { + col = (gpptr(dd)->currentFigure-1) / gpptr(dd)->numrows + 1; + row = gpptr(dd)->currentFigure - (col-1)*gpptr(dd)->numrows; + } + else { + row = (gpptr(dd)->currentFigure-1) / gpptr(dd)->numcols + 1; + col = gpptr(dd)->currentFigure - (row-1)*gpptr(dd)->numcols; + } + x0 = (double) (col-1) / gpptr(dd)->numcols; + x1 = (double) col / gpptr(dd)->numcols; + y0 = (double) (gpptr(dd)->numrows - row) / gpptr(dd)->numrows; + y1 = (double) (gpptr(dd)->numrows - row + 1) / gpptr(dd)->numrows; + } + gpptr(dd)->fig[0] = dpptr(dd)->fig[0] = x0; + gpptr(dd)->fig[1] = dpptr(dd)->fig[1] = x1; + gpptr(dd)->fig[2] = dpptr(dd)->fig[2] = y0; + gpptr(dd)->fig[3] = dpptr(dd)->fig[3] = y1; + gpptr(dd)->fUnits = dpptr(dd)->fUnits = NIC; +} + +static void updateFigureRegion(pGEDevDesc dd) +{ + double nicWidth, nicHeight; + switch (gpptr(dd)->fUnits) { + case NIC: + gpptr(dd)->fin[0] = dpptr(dd)->fin[0] = + GConvertXUnits(gpptr(dd)->fig[1] - gpptr(dd)->fig[0], NIC, INCHES, dd); + gpptr(dd)->fin[1] = dpptr(dd)->fin[1] = + GConvertYUnits(gpptr(dd)->fig[3] - gpptr(dd)->fig[2], NIC, INCHES, dd); + break; + case INCHES: + nicWidth = GConvertXUnits(gpptr(dd)->fin[0], INCHES, NIC, dd); + nicHeight = GConvertYUnits(gpptr(dd)->fin[1], INCHES, NIC, dd); + gpptr(dd)->fig[0] = dpptr(dd)->fig[0] = 0.5 - nicWidth/2; + gpptr(dd)->fig[1] = dpptr(dd)->fig[1] = gpptr(dd)->fig[0] + nicWidth; + gpptr(dd)->fig[2] = dpptr(dd)->fig[2] = 0.5 - nicHeight/2; + gpptr(dd)->fig[3] = dpptr(dd)->fig[3] = gpptr(dd)->fig[2] + nicHeight; + break; + default: /*nothing*/ break; + } +} + +/* mapFig2Dev -- Transformation from NFC to Dev */ +/* This must be called per plot.new and if the NICtoDev transformation */ +/* changes */ + +static void mapFig2Dev(pGEDevDesc dd) +{ + double x0, x1, y0, y1; + y0 = yNICtoDev(gpptr(dd)->fig[2], dd); + y1 = yNICtoDev(gpptr(dd)->fig[3], dd); + x0 = xNICtoDev(gpptr(dd)->fig[0], dd); + x1 = xNICtoDev(gpptr(dd)->fig[1], dd); + gpptr(dd)->fig2dev.bx = dpptr(dd)->fig2dev.bx = x1 - x0; + gpptr(dd)->fig2dev.ax = dpptr(dd)->fig2dev.ax = x0; + gpptr(dd)->fig2dev.by = dpptr(dd)->fig2dev.by = y1 - y0; + gpptr(dd)->fig2dev.ay = dpptr(dd)->fig2dev.ay = y0; +} + +static void updateFigureMargins(pGEDevDesc dd) +{ + switch (gpptr(dd)->mUnits) { + case LINES: + gpptr(dd)->mai[0] = dpptr(dd)->mai[0] = + GConvertYUnits(gpptr(dd)->mar[0], LINES, INCHES, dd); + gpptr(dd)->mai[1] = dpptr(dd)->mai[1] = + GConvertXUnits(gpptr(dd)->mar[1], LINES, INCHES, dd); + gpptr(dd)->mai[2] = dpptr(dd)->mai[2] = + GConvertYUnits(gpptr(dd)->mar[2], LINES, INCHES, dd); + gpptr(dd)->mai[3] = dpptr(dd)->mai[3] = + GConvertXUnits(gpptr(dd)->mar[3], LINES, INCHES, dd); + break; + case INCHES: + gpptr(dd)->mar[0] = dpptr(dd)->mar[0] = + GConvertYUnits(gpptr(dd)->mai[0], INCHES, LINES, dd); + gpptr(dd)->mar[1] = dpptr(dd)->mar[1] = + GConvertXUnits(gpptr(dd)->mai[1], INCHES, LINES, dd); + gpptr(dd)->mar[2] = dpptr(dd)->mar[2] = + GConvertYUnits(gpptr(dd)->mai[2], INCHES, LINES, dd); + gpptr(dd)->mar[3] = dpptr(dd)->mar[3] = + GConvertXUnits(gpptr(dd)->mai[3], INCHES, LINES, dd); + break; + default: /*nothing*/ break; + } +} + +/* mapPlotRegion -- plot region in NFC */ + +static void mapPlotRegion(pGEDevDesc dd) +{ + double x0, x1, y0, y1; + x0 = GConvertXUnits(gpptr(dd)->mar[1], LINES, NFC, dd); + y0 = GConvertYUnits(gpptr(dd)->mar[0], LINES, NFC, dd); + x1 = 1.0 - GConvertXUnits(gpptr(dd)->mar[3], LINES, NFC, dd); + y1 = 1.0 - GConvertYUnits(gpptr(dd)->mar[2], LINES, NFC, dd); + if(gpptr(dd)->pty == 's') { + /* maximal plot size in inches */ + double center, width, height; + double inchWidth = GConvertXUnits(x1 - x0, NFC, INCHES, dd); + double inchHeight = GConvertYUnits(y1 - y0, NFC, INCHES, dd); + /* shrink the longer side */ + if (inchWidth > inchHeight) { + width = 0.5*GConvertXUnits(inchHeight, INCHES, NFC, dd); + center = 0.5*(x1 + x0); + x0 = center-width; + x1 = center+width; + } + else { + height = 0.5*GConvertYUnits(inchWidth, INCHES, NFC, dd); + center = 0.5*(y1 + y0); + y0 = center-height; + y1 = center+height; + } + } + gpptr(dd)->plt[0] = dpptr(dd)->plt[0] = x0; + gpptr(dd)->plt[1] = dpptr(dd)->plt[1] = x1; + gpptr(dd)->plt[2] = dpptr(dd)->plt[2] = y0; + gpptr(dd)->plt[3] = dpptr(dd)->plt[3] = y1; + gpptr(dd)->pUnits = dpptr(dd)->pUnits = NFC; +} + +static void updatePlotRegion(pGEDevDesc dd) +{ + double nfcWidth, nfcHeight; + switch (gpptr(dd)->pUnits) { + case NFC: + gpptr(dd)->pin[0] = dpptr(dd)->pin[0] = + GConvertXUnits(gpptr(dd)->plt[1] - gpptr(dd)->plt[0], NFC, INCHES, dd); + gpptr(dd)->pin[1] = dpptr(dd)->pin[1] = + GConvertYUnits(gpptr(dd)->plt[3] - gpptr(dd)->plt[2], NFC, INCHES, dd); + break; + case INCHES: + nfcWidth = GConvertXUnits(gpptr(dd)->pin[0], INCHES, NFC, dd); + nfcHeight = GConvertYUnits(gpptr(dd)->pin[1], INCHES, NFC, dd); + gpptr(dd)->plt[0] = dpptr(dd)->plt[0] = 0.5 - nfcWidth/2; + gpptr(dd)->plt[1] = dpptr(dd)->plt[1] = gpptr(dd)->plt[0] + nfcWidth; + gpptr(dd)->plt[2] = dpptr(dd)->plt[2] = 0.5 - nfcHeight/2; + gpptr(dd)->plt[3] = dpptr(dd)->plt[3] = gpptr(dd)->plt[2] + nfcHeight; + break; + default: /*nothing*/ break; + } +} + +/* GMapWin2Fig -- transformation from Usr to NFC */ + +void GMapWin2Fig(pGEDevDesc dd) +{ + if (gpptr(dd)->xlog) { + gpptr(dd)->win2fig.bx = dpptr(dd)->win2fig.bx = + (gpptr(dd)->plt[1] - gpptr(dd)->plt[0])/ + (gpptr(dd)->logusr[1] - gpptr(dd)->logusr[0]); + gpptr(dd)->win2fig.ax = dpptr(dd)->win2fig.ax = + gpptr(dd)->plt[0] - gpptr(dd)->win2fig.bx * gpptr(dd)->logusr[0]; + } + else { + gpptr(dd)->win2fig.bx = dpptr(dd)->win2fig.bx = + (gpptr(dd)->plt[1] - gpptr(dd)->plt[0])/ + (gpptr(dd)->usr[1] - gpptr(dd)->usr[0]); + gpptr(dd)->win2fig.ax = dpptr(dd)->win2fig.ax = + gpptr(dd)->plt[0] - gpptr(dd)->win2fig.bx * gpptr(dd)->usr[0]; + } + if (gpptr(dd)->ylog) { + gpptr(dd)->win2fig.by = dpptr(dd)->win2fig.by = + (gpptr(dd)->plt[3] - gpptr(dd)->plt[2])/ + (gpptr(dd)->logusr[3] - gpptr(dd)->logusr[2]); + gpptr(dd)->win2fig.ay = dpptr(dd)->win2fig.ay = + gpptr(dd)->plt[2] - gpptr(dd)->win2fig.by * gpptr(dd)->logusr[2]; + } + else { + gpptr(dd)->win2fig.by = dpptr(dd)->win2fig.by = + (gpptr(dd)->plt[3] - gpptr(dd)->plt[2])/ + (gpptr(dd)->usr[3] - gpptr(dd)->usr[2]); + gpptr(dd)->win2fig.ay = dpptr(dd)->win2fig.ay = + gpptr(dd)->plt[2] - gpptr(dd)->win2fig.by * gpptr(dd)->usr[2]; + } +} + +/* mapping -- Set up mappings between coordinate systems */ +/* This is the user's interface to the mapping routines above */ + +static +void mapping(pGEDevDesc dd, int which) +{ + switch(which) { + case 0: + mapNDC2Dev(dd); + case 1: + updateOuterMargins(dd); + mapInner2Dev(dd); + case 2: + if (gpptr(dd)->defaultFigure) + mapFigureRegion(dd); + updateFigureRegion(dd); + mapFig2Dev(dd); + case 3: + updateFigureMargins(dd); + if (gpptr(dd)->defaultPlot) + mapPlotRegion(dd); + updatePlotRegion(dd); + } +} + +/* GReset -- Reset coordinate systems mappings and unit yardsticks */ + +void GReset(pGEDevDesc dd) +{ + /* Character extents are based on the raster size */ + gpptr(dd)->mkh = gpptr(dd)->scale * dd->dev->cra[0] + * dd->dev->ipr[0]; + + /* Recompute Mappings */ + mapping(dd, 0); +} + +/* Is the figure region too big ? */ + +/* Why is this FLT_EPSILON? */ +static Rboolean validFigureRegion(pGEDevDesc dd) +{ + return ((gpptr(dd)->fig[0] > 0-FLT_EPSILON) && + (gpptr(dd)->fig[1] < 1+FLT_EPSILON) && + (gpptr(dd)->fig[2] > 0-FLT_EPSILON) && + (gpptr(dd)->fig[3] < 1+FLT_EPSILON)); +} + +/* Is the figure region too small ? */ + +static Rboolean validOuterMargins(pGEDevDesc dd) +{ + return ((gpptr(dd)->fig[0] < gpptr(dd)->fig[1]) && + (gpptr(dd)->fig[2] < gpptr(dd)->fig[3])); +} + +/* Is the plot region too big ? */ + +static Rboolean validPlotRegion(pGEDevDesc dd) +{ + return ((gpptr(dd)->plt[0] > 0-FLT_EPSILON) && + (gpptr(dd)->plt[1] < 1+FLT_EPSILON) && + (gpptr(dd)->plt[2] > 0-FLT_EPSILON) && + (gpptr(dd)->plt[3] < 1+FLT_EPSILON)); +} + +/* Is the plot region too small ? */ + +static Rboolean validFigureMargins(pGEDevDesc dd) +{ + return ((gpptr(dd)->plt[0] < gpptr(dd)->plt[1]) && + (gpptr(dd)->plt[2] < gpptr(dd)->plt[3])); +} + +static void NORET invalidError(const char *message, pGEDevDesc dd) +{ + dpptr(dd)->currentFigure -= 1; + if (dpptr(dd)->currentFigure < 1) + dpptr(dd)->currentFigure = dpptr(dd)->lastFigure; + gpptr(dd)->currentFigure = dpptr(dd)->currentFigure; + error(message); +} + +Rboolean GRecording(SEXP call, pGEDevDesc dd) +{ + return GErecording(call, dd); +} + +/* GNewPlot -- Begin a new plot (advance to new frame if needed) */ +pGEDevDesc GNewPlot(Rboolean recording) +{ + pGEDevDesc dd; + + /* Restore Default Parameters */ + + dd = GEcurrentDevice(); + GRestore(dd); + + /* GNewPlot always starts a new plot UNLESS the user has set + * gpptr(dd)->new to TRUE by par(new=TRUE) + * If gpptr(dd)->new is FALSE, we leave it that way (further GNewPlot's + * will move on to subsequent plots) + * If gpptr(dd)->new is TRUE, any subsequent drawing will dirty the plot + * and reset gpptr(dd)->new to FALSE + */ + + /* we can call par(mfg) before any plotting. + That sets new = TRUE and also sets currentFigure <= lastFigure + so treat separately. */ + + /* The logic for when to start a new page is mimiced in the + * read-only par("page") in par.c, SO if you make changes + * to the logic here, you will need to change that as well + */ + if (!gpptr(dd)->new) { + R_GE_gcontext gc; + gcontextFromGP(&gc, dd); + dpptr(dd)->currentFigure += 1; + gpptr(dd)->currentFigure = dpptr(dd)->currentFigure; + if (gpptr(dd)->currentFigure > gpptr(dd)->lastFigure) { + if (recording) { + if (dd->ask) { + NewFrameConfirm(dd->dev); + /* + * User may have killed device during pause for prompt + */ + if (NoDevices()) + error(_("attempt to plot on null device")); + else + dd = GEcurrentDevice(); + } + GEinitDisplayList(dd); + } + GENewPage(&gc, dd); + dpptr(dd)->currentFigure = gpptr(dd)->currentFigure = 1; + } + + GReset(dd); + GForceClip(dd); + } else if(!gpptr(dd)->state) { /* device is unused */ + R_GE_gcontext gc; + gcontextFromGP(&gc, dd); + if (recording) { + if (dd->ask) { + NewFrameConfirm(dd->dev); + /* + * User may have killed device during pause for prompt + */ + if (NoDevices()) + error(_("attempt to plot on null device")); + else + dd = GEcurrentDevice(); + } + GEinitDisplayList(dd); + } + GENewPage(&gc, dd); + dpptr(dd)->currentFigure = gpptr(dd)->currentFigure = 1; + GReset(dd); + GForceClip(dd); + } + + /* IF the division of the device into separate regions */ + /* has resulted in any invalid regions ... */ + /* IF this was a user command (i.e., we are recording) */ + /* send an error message to the command line */ + /* IF we are replaying then draw a message in the output */ + +#define G_ERR_MSG(msg) \ + if (recording) \ + invalidError(msg, dd); \ + else { \ + int xpdsaved = gpptr(dd)->xpd; \ + gpptr(dd)->xpd = 2; \ + GText(0.5,0.5, NFC, msg, -1, 0.5,0.5, 0, dd); \ + gpptr(dd)->xpd = xpdsaved; \ + } + + dpptr(dd)->valid = gpptr(dd)->valid = FALSE; + if (!validOuterMargins(dd)) { + G_ERR_MSG(_("outer margins too large (figure region too small)")); + } else if (!validFigureRegion(dd)) { + G_ERR_MSG(_("figure region too large")); + } else if (!validFigureMargins(dd)) { + G_ERR_MSG(_("figure margins too large")); + } else if (!validPlotRegion(dd)) { + G_ERR_MSG(_("plot region too large")); + } else { + dpptr(dd)->valid = gpptr(dd)->valid = TRUE; + /* + * At this point, base output has been successfully + * produced on the device, so mark the device "dirty" + * with respect to base graphics. + * This is used when checking whether the device is + * "valid" with respect to base graphics + */ + Rf_setBaseDevice(TRUE, dd); + GEdirtyDevice(dd); + } + + return dd; +} +#undef G_ERR_MSG + +#if 0 +/* in src/main/graphics.c */ +// (usr, log, n_inp) |--> (axp, n_out) : +void GAxisPars(double *min, double *max, int *n, Rboolean log, int axis) +{ +#define EPS_FAC_2 100 + Rboolean swap = *min > *max; + double t_, min_o, max_o; + + if(swap) { /* Feature: in R, something like xlim = c(100,0) just works */ + t_ = *min; *min = *max; *max = t_; + } + /* save only for the extreme case (EPS_FAC_2): */ + min_o = *min; max_o = *max; + + if(log) { + /* Avoid infinities */ + if(*max > 308) *max = 308; + if(*min < -307) *min = -307; + *min = Rexp10(*min); + *max = Rexp10(*max); + GLPretty(min, max, n); + } + else GEPretty(min, max, n); + + double tmp2 = EPS_FAC_2 * DBL_EPSILON;/* << prevent overflow in product below */ + if(fabs(*max - *min) < (t_ = fmax2(fabs(*max), fabs(*min)))* tmp2) { + /* Treat this case somewhat similar to the (min ~= max) case above */ + /* Too much accuracy here just shows machine differences */ + warning(_("relative range of values (%4.0f * EPS) is small (axis %d)") + /*"to compute accurately"*/, + fabs(*max - *min) / (t_*DBL_EPSILON), axis); + + /* No pretty()ing anymore */ + *min = min_o; + *max = max_o; + double eps = .005 * fabs(*max - *min);/* .005: not to go to DBL_MIN/MAX */ + *min += eps; + *max -= eps; + if(log) { + *min = Rexp10(*min); + *max = Rexp10(*max); + } + *n = 1; + } + if(swap) { + t_ = *min; *min = *max; *max = t_; + } +} +#endif + +void GScale(double min, double max, int axis, pGEDevDesc dd) +{ +/* GScale: used to default axis information + * i.e., if user has NOT specified par(usr=...) + * NB: can have min > max ! + */ +#define EPS_FAC_1 16 + + Rboolean is_xaxis = (axis == 1 || axis == 3); + int log, n, style; + double temp, min_o = 0., max_o = 0., tmp2 = 0.;/*-Wall*/ + + if(is_xaxis) { + n = gpptr(dd)->lab[0]; + style = gpptr(dd)->xaxs; + log = gpptr(dd)->xlog; + } + else { + n = gpptr(dd)->lab[1]; + style = gpptr(dd)->yaxs; + log = gpptr(dd)->ylog; + } + + if (log) { + /* keep original min, max - to use in extremis */ + min_o = min; max_o = max; + min = log10(min); + max = log10(max); + } + if(!R_FINITE(min) || !R_FINITE(max)) { + warning(_("nonfinite axis limits [GScale(%g,%g,%d, .); log=%d]"), + min, max, axis, log); + if(!R_FINITE(min)) min = - .45 * DBL_MAX; + if(!R_FINITE(max)) max = + .45 * DBL_MAX; + /* max - min is now finite */ + } + /* Version <= 1.2.0 had + if (min == max) -- exact equality for real numbers */ + temp = fmax2(fabs(max), fabs(min)); + if(temp == 0) {/* min = max = 0 */ + min = -1; + max = 1; + } + else if(fabs(max - min) < temp * EPS_FAC_1 * DBL_EPSILON) { + temp *= (min == max) ? .4 : 1e-2; + min -= temp; + max += temp; + } + + switch(style) { + case 'r': + temp = 0.04 * (max-min); + min -= temp; + max += temp; + break; + case 'i': + break; + case 's':/* FIXME --- implement 's' and 'e' axis styles ! */ + case 'e': + default: + error(_("axis style \"%c\" unimplemented"), style); + } + + if (log) { /* 10^max may have gotten +Inf ; or 10^min has become 0 */ + if((temp = Rexp10(min)) == 0.) {/* or < 1.01*DBL_MIN */ + temp = fmin2(min_o, 1.01* DBL_MIN); /* allow smaller non 0 */ + min = log10(temp); + } + if(max >= 308.25) { /* overflows */ + tmp2 = fmax2(max_o, .99 * DBL_MAX); + max = log10(tmp2); + } else tmp2 = Rexp10(max); + } + if(is_xaxis) { + if (log) { + gpptr(dd)->usr[0] = dpptr(dd)->usr[0] = temp; + gpptr(dd)->usr[1] = dpptr(dd)->usr[1] = tmp2; + gpptr(dd)->logusr[0] = dpptr(dd)->logusr[0] = min; + gpptr(dd)->logusr[1] = dpptr(dd)->logusr[1] = max; + } else { + gpptr(dd)->usr[0] = dpptr(dd)->usr[0] = min; + gpptr(dd)->usr[1] = dpptr(dd)->usr[1] = max; + } + } else { + if (log) { + gpptr(dd)->usr[2] = dpptr(dd)->usr[2] = temp; + gpptr(dd)->usr[3] = dpptr(dd)->usr[3] = tmp2; + gpptr(dd)->logusr[2] = dpptr(dd)->logusr[2] = min; + gpptr(dd)->logusr[3] = dpptr(dd)->logusr[3] = max; + } else { + gpptr(dd)->usr[2] = dpptr(dd)->usr[2] = min; + gpptr(dd)->usr[3] = dpptr(dd)->usr[3] = max; + } + } + + /* This is not directly needed when [xy]axt = "n", + * but may later be different in another call to axis(), e.g.: + > plot(1, xaxt = "n"); axis(1) + * In that case, do_axis() should do the following: + */ + + // Computation of [xy]axp[0:2] == (min,max,n) : + GAxisPars(&min, &max, &n, log, axis); + +#define G_Store_AXP(is_X) \ + if(is_X) { \ + gpptr(dd)->xaxp[0] = dpptr(dd)->xaxp[0] = min; \ + gpptr(dd)->xaxp[1] = dpptr(dd)->xaxp[1] = max; \ + gpptr(dd)->xaxp[2] = dpptr(dd)->xaxp[2] = n; \ + } \ + else { \ + gpptr(dd)->yaxp[0] = dpptr(dd)->yaxp[0] = min; \ + gpptr(dd)->yaxp[1] = dpptr(dd)->yaxp[1] = max; \ + gpptr(dd)->yaxp[2] = dpptr(dd)->yaxp[2] = n; \ + } + + G_Store_AXP(is_xaxis); +} +#undef EPS_FAC_1 +#undef EPS_FAC_2 + +void GSetupAxis(int axis, pGEDevDesc dd) +{ +/* GSetupAxis -- Set up the default axis information + * called when user specifies par(usr =...) */ +/* What should happen if ------------ + * xlog or ylog = TRUE ? */ + double min, max; + int n; + Rboolean is_xaxis = (axis == 1 || axis == 3); + + if(is_xaxis) { + n = gpptr(dd)->lab[0]; + min = gpptr(dd)->usr[0]; + max = gpptr(dd)->usr[1]; + } + else { + n = gpptr(dd)->lab[1]; + min = gpptr(dd)->usr[2]; + max = gpptr(dd)->usr[3]; + } + + GPretty(&min, &max, &n); + + G_Store_AXP(is_xaxis); +} +#undef G_Store_AXP + +/*------------------------------------------------------------------- + * + * GPAR FUNCTIONS + * + */ + + +/* Set default graphics parameter values in a GPar. + * This initialises the plot state, plus the graphical + * parameters that are not the responsibility of the device initialisation. + + * Called from baseCallback. + */ + +void GInit(GPar *dp) +{ + dp->state = 0; + dp->valid = FALSE; + + dp->ann = TRUE; + dp->err = 0; + dp->bty = 'o'; + + dp->mkh = .001;/* dummy value > 0 --- set in GReset : unused in R */ + dp->cex = 1.0; + dp->lheight = 1.0; + dp->cexbase = 1.0; + dp->cexmain = 1.2; + dp->cexlab = 1.0; + dp->cexsub = 1.0; + dp->cexaxis = 1.0; + + dp->col = R_RGB(0, 0, 0); + dp->colmain = R_RGB(0, 0, 0); + dp->collab = R_RGB(0, 0, 0); + dp->colsub = R_RGB(0, 0, 0); + dp->colaxis = R_RGB(0, 0, 0); + dp->gamma = 1; + + dp->scale = 1.0; + strcpy(dp->family, ""); + dp->font = 1; + dp->fontmain = 2; + dp->fontlab = 1; + dp->fontsub = 1; + dp->fontaxis = 1; + + dp->pch = 1; + dp->lty = LTY_SOLID; + dp->lend = GE_ROUND_CAP; + dp->ljoin = GE_ROUND_JOIN; + dp->lmitre = 10.0; + dp->smo = 1; + + /* String Adjustment and rotation */ + dp->adj = 0.5; + dp->crt = 0.0; + dp->srt = 0.0; + + /* Positioning of margin text */ + dp->mgp[0] = 3; + dp->mgp[1] = 1; + dp->mgp[2] = 0; + + /* Axis annotation parameters */ + dp->lab[0] = 5; + dp->lab[1] = 5; + dp->lab[2] = 7; + dp->las = 0; + dp->tck = NA_REAL; + dp->tcl = -0.5; + dp->xaxp[0] = 0.0; + dp->xaxp[1] = 1.0; + dp->xaxp[2] = 5.0; + dp->xaxs = 'r'; + dp->xaxt = 's'; + dp->xlog = FALSE; + dp->xpd = 0; + dp->oldxpd = -99; + dp->yaxp[0] = 0.0; + dp->yaxp[1] = 1.0; + dp->yaxp[2] = 5.0; + dp->yaxs = 'r'; + dp->yaxt = 's'; + dp->ylog = FALSE; + + /* Outer Margins */ + dp->mex = 1.0; + dp->oma[0] = 0.0; + dp->oma[1] = 0.0; + dp->oma[2] = 0.0; + dp->oma[3] = 0.0; + dp->oUnits = LINES; + dp->fig[0] = 0.0; + dp->fig[1] = 1.0; + dp->fig[2] = 0.0; + dp->fig[3] = 1.0; + dp->fUnits = NIC; + dp->defaultFigure = TRUE; /* the figure region is calculated from */ + /* the layout by default */ + dp->pUnits = NFC; + dp->defaultPlot = TRUE; /* the plot region is calculated as */ + /* figure-margin by default */ + + /* Inner Margins */ + dp->mar[0] = 5.1; + dp->mar[1] = 4.1; + dp->mar[2] = 4.1; + dp->mar[3] = 2.1; + dp->mUnits = LINES; + + /* Multi-figure parameters */ + dp->layout = FALSE; + dp->mfind = 0; + + dp->numrows = 1; + dp->numcols = 1; + dp->currentFigure = 1; + dp->lastFigure = 1; + dp->heights[0] = 1; + dp->widths[0] = 1; + dp->cmHeights[0] = 0; + dp->cmWidths[0] = 0; + dp->order[0] = 1; + dp->rspct = 0; + dp->respect[0] = 0; + + /* Misc plotting parameters */ + dp->new = FALSE; + dp->devmode = -99; + dp->pty = 'm'; + dp->lwd = 1; + + /* Data window */ + dp->usr[0] = 0.0; + dp->usr[1] = 1.0; + dp->usr[2] = 0.0; + dp->usr[3] = 1.0; +} + +/* Copy a GPar structure from source to dest. */ +void copyGPar(GPar *source, GPar *dest) +{ + memcpy(dest, source, sizeof(GPar)); +} + + +/* Restore the graphics parameters from the device copy. */ +void GRestore(pGEDevDesc dd) +{ + if (NoDevices()) error(_("no graphics device is active")); + copyGPar(dpptr(dd), gpptr(dd)); +} + + +/* FIXME: reorganize this as a memcpy */ + +/* Saving and restoring of "inline" graphical */ +/* parameters. These are the ones which can be */ +/* specified as a arguments to high-level */ +/* graphics functions. */ + +static double adjsave; /* adj */ +static int annsave; /* ann */ +static char btysave; /* bty */ +static double cexsave; /* cex */ +static double lheightsave; +static double cexbasesave; /* cexbase */ +static double cexmainsave; /* cex.main */ +static double cexlabsave; /* cex.lab */ +static double cexsubsave; /* cex.sub */ +static double cexaxissave; /* cex.axis */ +static int colsave; /* col */ +static int fgsave; /* fg */ +static int bgsave; /* bg */ +static int colmainsave; /* col.main */ +static int collabsave; /* col.lab */ +static int colsubsave; /* col.sub */ +static int colaxissave; /* col.axis */ +static double crtsave; /* character rotation */ +static char familysave[201]; +static int fontsave; /* font */ +static int fontmainsave; /* font.main */ +static int fontlabsave; /* font.lab */ +static int fontsubsave; /* font.sub */ +static int fontaxissave; /* font.axis */ +static int errsave; /* error mode */ +static int labsave[3]; /* axis labelling parameters */ +static int lassave; /* label style */ +static int ltysave; /* line type */ +static double lwdsave; /* line width */ +static R_GE_lineend lendsave; +static R_GE_linejoin ljoinsave; +static double lmitresave; +static double mgpsave[3]; /* margin position for annotation */ +static double mkhsave; /* mark height */ +static int pchsave; /* plotting character */ +static double srtsave; /* string rotation */ +static double tcksave; /* tick mark length */ +static double tclsave; /* tick mark length in LINES */ +static double xaxpsave[3]; /* x axis parameters */ +static char xaxssave; /* x axis calculation style */ +static char xaxtsave; /* x axis type */ +static int xpdsave; /* clipping control */ +static double yaxpsave[3]; /* y axis parameters */ +static char yaxssave; /* y axis calculation style */ +static char yaxtsave; /* y axis type */ + + +/* Make a temporary copy of the inline parameter values. */ +void GSavePars(pGEDevDesc dd) +{ + adjsave = gpptr(dd)->adj; + annsave = gpptr(dd)->ann; + btysave = gpptr(dd)->bty; + cexsave = gpptr(dd)->cex; + lheightsave = gpptr(dd)->lheight; + cexbasesave = gpptr(dd)->cexbase; + cexlabsave = gpptr(dd)->cexlab; + cexmainsave = gpptr(dd)->cexmain; + cexsubsave = gpptr(dd)->cexsub; + cexaxissave = gpptr(dd)->cexaxis; + colsave = gpptr(dd)->col; + fgsave = gpptr(dd)->fg; + bgsave = gpptr(dd)->bg; + collabsave = gpptr(dd)->collab; + colmainsave = gpptr(dd)->colmain; + colsubsave = gpptr(dd)->colsub; + colaxissave = gpptr(dd)->colaxis; + crtsave = gpptr(dd)->crt; + errsave = gpptr(dd)->err; + strncpy(familysave, gpptr(dd)->family, 201); + fontsave = gpptr(dd)->font; + fontmainsave = gpptr(dd)->fontmain; + fontlabsave = gpptr(dd)->fontlab; + fontsubsave = gpptr(dd)->fontsub; + fontaxissave = gpptr(dd)->fontaxis; + labsave[0] = gpptr(dd)->lab[0]; + labsave[1] = gpptr(dd)->lab[1]; + labsave[2] = gpptr(dd)->lab[2]; + lassave = gpptr(dd)->las; + ltysave = gpptr(dd)->lty; + lwdsave = gpptr(dd)->lwd; + lendsave = gpptr(dd)->lend; + ljoinsave = gpptr(dd)->ljoin; + lmitresave = gpptr(dd)->lmitre; + mgpsave[0] = gpptr(dd)->mgp[0]; + mgpsave[1] = gpptr(dd)->mgp[1]; + mgpsave[2] = gpptr(dd)->mgp[2]; + mkhsave = gpptr(dd)->mkh; + pchsave = gpptr(dd)->pch; + srtsave = gpptr(dd)->srt; + tcksave = gpptr(dd)->tck; + tclsave = gpptr(dd)->tcl; + xaxpsave[0] = gpptr(dd)->xaxp[0]; + xaxpsave[1] = gpptr(dd)->xaxp[1]; + xaxpsave[2] = gpptr(dd)->xaxp[2]; + xaxssave = gpptr(dd)->xaxs; + xaxtsave = gpptr(dd)->xaxt; + xpdsave = gpptr(dd)->xpd; + yaxpsave[0] = gpptr(dd)->yaxp[0]; + yaxpsave[1] = gpptr(dd)->yaxp[1]; + yaxpsave[2] = gpptr(dd)->yaxp[2]; + yaxssave = gpptr(dd)->yaxs; + yaxtsave = gpptr(dd)->yaxt; +} + + +/* Restore temporarily saved inline parameter values */ +void GRestorePars(pGEDevDesc dd) +{ + gpptr(dd)->adj = adjsave; + gpptr(dd)->ann = annsave; + gpptr(dd)->bty = btysave; + gpptr(dd)->cex = cexsave; + gpptr(dd)->lheight = lheightsave; + gpptr(dd)->cexbase = cexbasesave; + gpptr(dd)->cexlab = cexlabsave; + gpptr(dd)->cexmain = cexmainsave; + gpptr(dd)->cexsub = cexsubsave; + gpptr(dd)->cexaxis = cexaxissave; + gpptr(dd)->col = colsave; + gpptr(dd)->fg = fgsave; + gpptr(dd)->bg = bgsave; + gpptr(dd)->collab = collabsave; + gpptr(dd)->colmain = colmainsave; + gpptr(dd)->colsub = colsubsave; + gpptr(dd)->colaxis = colaxissave; + gpptr(dd)->crt = crtsave; + gpptr(dd)->err = errsave; + strncpy(gpptr(dd)->family, familysave, 201); + gpptr(dd)->font = fontsave; + gpptr(dd)->fontmain = fontmainsave; + gpptr(dd)->fontlab = fontlabsave; + gpptr(dd)->fontsub = fontsubsave; + gpptr(dd)->fontaxis = fontaxissave; + gpptr(dd)->lab[0] = labsave[0]; + gpptr(dd)->lab[1] = labsave[1]; + gpptr(dd)->lab[2] = labsave[2]; + gpptr(dd)->las = lassave; + gpptr(dd)->lty = ltysave; + gpptr(dd)->lwd = lwdsave; + gpptr(dd)->lend = lendsave; + gpptr(dd)->ljoin = ljoinsave; + gpptr(dd)->lmitre = lmitresave; + gpptr(dd)->mgp[0] = mgpsave[0]; + gpptr(dd)->mgp[1] = mgpsave[1]; + gpptr(dd)->mgp[2] = mgpsave[2]; + gpptr(dd)->mkh = mkhsave; + gpptr(dd)->pch = pchsave; + gpptr(dd)->srt = srtsave; + gpptr(dd)->tck = tcksave; + gpptr(dd)->tcl = tclsave; + gpptr(dd)->xaxp[0] = xaxpsave[0]; + gpptr(dd)->xaxp[1] = xaxpsave[1]; + gpptr(dd)->xaxp[2] = xaxpsave[2]; + gpptr(dd)->xaxs = xaxssave; + gpptr(dd)->xaxt = xaxtsave; + gpptr(dd)->xpd = xpdsave; + gpptr(dd)->yaxp[0] = yaxpsave[0]; + gpptr(dd)->yaxp[1] = yaxpsave[1]; + gpptr(dd)->yaxp[2] = yaxpsave[2]; + gpptr(dd)->yaxs = yaxssave; + gpptr(dd)->yaxt = yaxtsave; +} + +/*------------------------------------------------------------------- + * + * DEVICE STATE FUNCTIONS + * + */ + + +/* This records whether GNewPlot has been called. */ +void GSetState(int newstate, pGEDevDesc dd) +{ + dpptr(dd)->state = gpptr(dd)->state = newstate; +} + + + +/* Enquire whether GNewPlot has been called. */ +void GCheckState(pGEDevDesc dd) +{ + if(gpptr(dd)->state == 0) + error(_("plot.new has not been called yet")); + if (!gpptr(dd)->valid) + error(_("invalid graphics state")); +} + +/*------------------------------------------------------------------- + * GRAPHICAL PRIMITIVES + * + */ + +/* CLIPPING paradigm: + + R uses both the clipping capabilities of the device (if present) + and its own internal clipping algorithms. + If the device has no clipping capabilities (canClip = FALSE) then R + does all of the clipping internally. + If the device has clipping capabilities, R still does some internal + clipping (to the device extent). This is to avoid "silly" values + being sent to the device (e.g., X11 and Ghostview will barf if you + send a ridiculously large number to them). Call this silly-clipping. + + The problem with getting R to do some of the clipping is that it is + not necessarily as good as the device at clipping (e.g., R's text + clipping is very crude). This is the motivation for leaving as much + of the clipping as possible to the device. + R does different amounts of silly-clipping for different primitives. + See the individual routines for more info. +*/ + + +static void setClipRect(double *x1, double *y1, double *x2, double *y2, + int coords, pGEDevDesc dd) +{ + /* + * xpd = 0 means clip to current plot region + * xpd = 1 means clip to current figure region + * xpd = 2 means clip to device region + */ + *x1 = 0.0; + *y1 = 0.0; + *x2 = 1.0; + *y2 = 1.0; + switch (gpptr(dd)->xpd) { + case 0: + GConvert(x1, y1, NPC, coords, dd); + GConvert(x2, y2, NPC, coords, dd); + break; + case 1: + GConvert(x1, y1, NFC, coords, dd); + GConvert(x2, y2, NFC, coords, dd); + break; + case 2: + GConvert(x1, y1, NDC, coords, dd); + GConvert(x2, y2, NDC, coords, dd); + break; + } +} + +/* Update the device clipping region (depends on GP->xpd). */ +void GClip(pGEDevDesc dd) +{ + if (gpptr(dd)->xpd != gpptr(dd)->oldxpd) { + double x1, y1, x2, y2; + setClipRect(&x1, &y1, &x2, &y2, DEVICE, dd); + GESetClip(x1, y1, x2, y2, dd); + gpptr(dd)->oldxpd = gpptr(dd)->xpd; + } +} + + +/* Forced update of the device clipping region. */ +void GForceClip(pGEDevDesc dd) +{ + double x1, y1, x2, y2; + if (gpptr(dd)->state == 0) return; + setClipRect(&x1, &y1, &x2, &y2, DEVICE, dd); + GESetClip(x1, y1, x2, y2, dd); +} + +/* + * Function to generate an R_GE_gcontext from gpptr info + * + * In some cases, the settings made here will need to be overridden + * (eps. the fill setting) + */ +/* Used here and in do_xspline */ +void gcontextFromGP(pGEcontext gc, pGEDevDesc dd) +{ + gc->col = gpptr(dd)->col; + gc->fill = gpptr(dd)->bg; /* This may need manual adjusting */ + gc->gamma = gpptr(dd)->gamma; + /* + * Scale by "zoom" factor to allow for fit-to-window resizing in Windows + */ + gc->lwd = gpptr(dd)->lwd * gpptr(dd)->scale; + gc->lty = gpptr(dd)->lty; + gc->lend = gpptr(dd)->lend; + gc->ljoin = gpptr(dd)->ljoin; + gc->lmitre = gpptr(dd)->lmitre; + gc->cex = gpptr(dd)->cex; + /* + * Scale by "zoom" factor to allow for fit-to-window resizing in Windows + */ + gc->ps = (double) gpptr(dd)->ps * gpptr(dd)->scale; + gc->lineheight = gpptr(dd)->lheight; + gc->fontface = gpptr(dd)->font; + strncpy(gc->fontfamily, gpptr(dd)->family, 201); +} + +/* Draw a line. */ +/* If the device canClip, R clips line to device extent and + device does all other clipping. */ +void GLine(double x1, double y1, double x2, double y2, int coords, pGEDevDesc dd) +{ + R_GE_gcontext gc; gcontextFromGP(&gc, dd); + if (gpptr(dd)->lty == LTY_BLANK) return; + /* + * Work in device coordinates because that is what the + * graphics engine needs. + */ + GConvert(&x1, &y1, coords, DEVICE, dd); + GConvert(&x2, &y2, coords, DEVICE, dd); + /* + * Ensure that the base clipping region is set on the device + */ + GClip(dd); + if(R_FINITE(x1) && R_FINITE(y1) && R_FINITE(x2) && R_FINITE(y2)) + GELine(x1, y1, x2, y2, &gc, dd); +} + +/* We need extra graphics device closure handling + when inside a call to locator (it should raise + an error and return). PR#15253 + + This assume that locator is running on only one device at a time, + which is currently safe. +*/ +static void (*old_close)(pDevDesc) = NULL; + +static void +#ifndef WIN32 +NORET +#endif +locator_close(pDevDesc dd) +{ + if(old_close) old_close(dd); + dd->close = old_close; + old_close = NULL; + /* It's not safe to call error() in a Windows event handler, so + the GA_Close method records the close event separately. + */ +#ifndef WIN32 + error(_("graphics device closed during call to locator or identify")); +#endif +} + + +/* Read the current "pen" position. */ +Rboolean GLocator(double *x, double *y, int coords, pGEDevDesc dd) +{ + Rboolean ret; + /* store original close handler (it will still be called on + closure) and assign new handler that throws an error + */ + old_close = (dd->dev)->close; + dd->dev->close = &locator_close; + + if(dd->dev->locator && dd->dev->locator(x, y, dd->dev)) { + GConvert(x, y, DEVICE, coords, dd); + ret = TRUE; + } else ret = FALSE; + /* restore original close handler */ + dd->dev->close = old_close; + old_close = NULL; + return ret; + +} + +/* Access character font metric information. */ +void GMetricInfo(int c, double *ascent, double *descent, double *width, + GUnit units, pGEDevDesc dd) +{ + R_GE_gcontext gc; + gcontextFromGP(&gc, dd); + dd->dev->metricInfo(c & 0xFF, &gc, ascent, descent, width, dd->dev); + if (units != DEVICE) { + *ascent = GConvertYUnits(*ascent, DEVICE, units, dd); + *descent = GConvertYUnits(*descent, DEVICE, units, dd); + *width = GConvertXUnits(*width, DEVICE, units, dd); + } +} + + +/* Check that everything is initialized : + Interpretation : + mode = 0, graphics off + mode = 1, graphics on + mode = 2, graphical input on (ignored by most drivers) +*/ +void GMode(int mode, pGEDevDesc dd) +{ + if (NoDevices()) + error(_("No graphics device is active")); + if(mode != gpptr(dd)->devmode) GEMode(mode, dd); /* dd->dev->mode(mode, dd->dev); */ + gpptr(dd)->new = dpptr(dd)->new = FALSE; + gpptr(dd)->devmode = dpptr(dd)->devmode = mode; +} + + +/* +*********************************** +* START GClipPolygon code +* +* Everything up to END GClipPolygon code +* is just here to support GClipPolygon +* which only exists to satisfy the +* Rgraphics.h API (which should be +* superceded by the API provided by +* GraphicsDevice.h and GraphicsEngine.h) +*********************************** +*/ +/* + * If device can't clip we should use something like Sutherland-Hodgman here + * + * NOTE: most of this code (up to GPolygon) is only now used by + * GClipPolygon -- GPolygon runs the new GEPolygon in engine.c + */ +typedef enum { + Left = 0, + Right = 1, + Bottom = 2, + Top = 3 +} Edge; + +/* Clipper State Variables */ +typedef struct { + int first; /* true if we have seen the first point */ + double fx; /* x coord of the first point */ + double fy; /* y coord of the first point */ + double sx; /* x coord of the most recent point */ + double sy; /* y coord of the most recent point */ +} +GClipState; + +/* The Clipping Rectangle */ +typedef struct { + double xmin; + double xmax; + double ymin; + double ymax; +} +GClipRect; + +static +int inside (Edge b, double px, double py, GClipRect *clip) +{ + switch (b) { + case Left: if (px < clip->xmin) return 0; break; + case Right: if (px > clip->xmax) return 0; break; + case Bottom: if (py < clip->ymin) return 0; break; + case Top: if (py > clip->ymax) return 0; break; + } + return 1; +} + +static +int cross (Edge b, double x1, double y1, double x2, double y2, + GClipRect *clip) +{ + if (inside (b, x1, y1, clip) == inside (b, x2, y2, clip)) + return 0; + else return 1; +} + +static +void intersect (Edge b, double x1, double y1, double x2, double y2, + double *ix, double *iy, GClipRect *clip) +{ + double m = 0; + + if (x1 != x2) m = (y1 - y2) / (x1 - x2); + switch (b) { + case Left: + *ix = clip->xmin; + *iy = y2 + (clip->xmin - x2) * m; + break; + case Right: + *ix = clip->xmax; + *iy = y2 + (clip->xmax - x2) * m; + break; + case Bottom: + *iy = clip->ymin; + if (x1 != x2) *ix = x2 + (clip->ymin - y2) / m; + else *ix = x2; + break; + case Top: + *iy = clip->ymax; + if (x1 != x2) *ix = x2 + (clip->ymax - y2) / m; + else *ix = x2; + break; + } +} + +static +void clipPoint (Edge b, double x, double y, + double *xout, double *yout, int *cnt, int store, + GClipRect *clip, GClipState *cs) +{ + double ix = 0.0, iy = 0.0 /* -Wall */; + + if (!cs[b].first) { + /* No previous point exists for this edge. */ + /* Save this point. */ + cs[b].first = 1; + cs[b].fx = x; + cs[b].fy = y; + } + else + /* A previous point exists. */ + /* If 'p' and previous point cross edge, find intersection. */ + /* Clip against next boundary, if any. */ + /* If no more edges, add intersection to output list. */ + if (cross (b, x, y, cs[b].sx, cs[b].sy, clip)) { + intersect (b, x, y, cs[b].sx, cs[b].sy, &ix, &iy, clip); + if (b < Top) + clipPoint (b + 1, ix, iy, xout, yout, cnt, store, + clip, cs); + else { + if (store) { + xout[*cnt] = ix; + yout[*cnt] = iy; + } + (*cnt)++; + } + } + + /* Save as most recent point for this edge */ + cs[b].sx = x; + cs[b].sy = y; + + /* For all, if point is 'inside' */ + /* proceed to next clip edge, if any */ + if (inside (b, x, y, clip)) { + if (b < Top) + clipPoint (b + 1, x, y, xout, yout, cnt, store, clip, cs); + else { + if (store) { + xout[*cnt] = x; + yout[*cnt] = y; + } + (*cnt)++; + } + } +} + +static +void closeClip (double *xout, double *yout, int *cnt, int store, + GClipRect *clip, GClipState *cs) +{ + double ix = 0.0, iy = 0.0 /* -Wall */; + Edge b; + + for (b = Left; b <= Top; b++) { + if (cross (b, cs[b].sx, cs[b].sy, cs[b].fx, cs[b].fy, clip)) { + intersect (b, cs[b].sx, cs[b].sy, + cs[b].fx, cs[b].fy, &ix, &iy, clip); + if (b < Top) + clipPoint (b + 1, ix, iy, xout, yout, cnt, store, clip, cs); + else { + if (store) { + xout[*cnt] = ix; + yout[*cnt] = iy; + } + (*cnt)++; + } + } + } +} + +int GClipPolygon(double *x, double *y, int n, int coords, int store, + double *xout, double *yout, pGEDevDesc dd) +{ + int i, cnt = 0; + GClipState cs[4]; + GClipRect clip; + for (i = 0; i < 4; i++) + cs[i].first = 0; + /* Set up the cliprect here for R. */ + setClipRect(&clip.xmin, &clip.ymin, &clip.xmax, &clip.ymax, coords, dd); + /* If necessary, swap the clip region extremes */ + if (clip.xmax < clip.xmin) { + double swap = clip.xmax; + clip.xmax = clip.xmin; + clip.xmin = swap; + } + if (clip.ymax < clip.ymin) { + double swap = clip.ymax; + clip.ymax = clip.ymin; + clip.ymin = swap; + } + for (i = 0; i < n; i++) + clipPoint (Left, x[i], y[i], xout, yout, &cnt, store, &clip, cs); + closeClip (xout, yout, &cnt, store, &clip, cs); + return (cnt); +} +/* +*********************************** +* END GClipPolygon code +*********************************** +*/ + +/* + * This is just here to satisfy the Rgraphics.h API. + * This allows new graphics API (GraphicsDevice.h, GraphicsEngine.h) + * to be developed alongside. + * Could be removed if Rgraphics.h ever gets REPLACED by new API + * NOTE that base graphics code (in plot.c) still calls this. + */ +/* GPolygon -- Draw a polygon + * Filled with color bg and outlined with color fg + * These may both be NA_INTEGER + */ +void GPolygon(int n, double *x, double *y, int coords, + int bg, int fg, pGEDevDesc dd) +{ + int i; + double *xx; + double *yy; + const void *vmaxsave = vmaxget(); + R_GE_gcontext gc; gcontextFromGP(&gc, dd); + + if (gpptr(dd)->lty == LTY_BLANK) + fg = R_TRANWHITE; /* transparent for the border */ + + /* + * Work in device coordinates because that is what the + * graphics engine needs. + */ + xx = (double*) R_alloc(n, sizeof(double)); + yy = (double*) R_alloc(n, sizeof(double)); + if (!xx || !yy) + error("unable to allocate memory (in GPolygon)"); + for (i=0; i<n; i++) { + xx[i] = x[i]; + yy[i] = y[i]; + GConvert(&(xx[i]), &(yy[i]), coords, DEVICE, dd); + } + /* + * Ensure that the base clipping region is set on the device + */ + GClip(dd); + gc.col = fg; + gc.fill = bg; + GEPolygon(n, xx, yy, &gc, dd); + vmaxset(vmaxsave); +} + +#include <stdio.h> + +/* Draw a series of line segments. */ +/* If the device canClip, R clips to the device extent and the device + does all other clipping */ +void GPolyline(int n, double *x, double *y, int coords, pGEDevDesc dd) +{ + int i; + double *xx; + double *yy; + const void *vmaxsave = vmaxget(); + R_GE_gcontext gc; gcontextFromGP(&gc, dd); + + /* + * Work in device coordinates because that is what the + * graphics engine needs. + */ + xx = (double*) R_alloc(n, sizeof(double)); + yy = (double*) R_alloc(n, sizeof(double)); + if (!xx || !yy) + error("unable to allocate memory (in GPolyline)"); + for (i=0; i<n; i++) { + xx[i] = x[i]; + yy[i] = y[i]; + GConvert(&(xx[i]), &(yy[i]), coords, DEVICE, dd); + } + /* + * Ensure that the base clipping region is set on the device + */ + GClip(dd); + GEPolyline(n, xx, yy, &gc, dd); + vmaxset(vmaxsave); +} + + +/* + * This is just here to satisfy the Rgraphics.h API. + * This allows new graphics API (GraphicsDevice.h, GraphicsEngine.h) + * to be developed alongside. + * Could be removed if Rgraphics.h ever gets REPLACED by new API + * NOTE that base graphics code (do_symbol in plot.c) still calls this. + * + * NB: this fiddles with radius = 0. + */ +void GCircle(double x, double y, int coords, + double radius, int bg, int fg, pGEDevDesc dd) +{ + double ir; + R_GE_gcontext gc; gcontextFromGP(&gc, dd); + + ir = radius/dd->dev->ipr[0]; + ir = (ir > 0) ? ir : 1; + + if (gpptr(dd)->lty == LTY_BLANK) + fg = R_TRANWHITE; /* transparent for the border */ + + /* + * Work in device coordinates because that is what the + * graphics engine needs. + */ + GConvert(&x, &y, coords, DEVICE, dd); + /* + * Ensure that the base clipping region is set on the device + */ + GClip(dd); + gc.col = fg; + gc.fill = bg; + GECircle(x, y, ir, &gc, dd); +} + +/* Draw a rectangle */ +/* Filled with color bg and outlined with color fg */ +/* These may both be NA_INTEGER */ +void GRect(double x0, double y0, double x1, double y1, int coords, + int bg, int fg, pGEDevDesc dd) +{ + R_GE_gcontext gc; gcontextFromGP(&gc, dd); + + if (gpptr(dd)->lty == LTY_BLANK) + fg = R_TRANWHITE; /* transparent for the border */ + + /* + * Work in device coordinates because that is what the + * graphics engine needs. + */ + GConvert(&x0, &y0, coords, DEVICE, dd); + GConvert(&x1, &y1, coords, DEVICE, dd); + /* + * Ensure that the base clipping region is set on the device + */ + GClip(dd); + gc.col = fg; + gc.fill = bg; + GERect(x0, y0, x1, y1, &gc, dd); +} + +void GPath(double *x, double *y, + int npoly, int *nper, + Rboolean winding, + int bg, int fg, pGEDevDesc dd) +{ + R_GE_gcontext gc; gcontextFromGP(&gc, dd); + + if (gpptr(dd)->lty == LTY_BLANK) + fg = R_TRANWHITE; /* transparent for the border */ + + /* + * Ensure that the base clipping region is set on the device + */ + GClip(dd); + gc.col = fg; + gc.fill = bg; + GEPath(x, y, npoly, nper, winding, &gc, dd); +} + +void GRaster(unsigned int* image, int w, int h, + double x0, double y0, double x1, double y1, + double angle, Rboolean interpolate, + pGEDevDesc dd) +{ + R_GE_gcontext gc; gcontextFromGP(&gc, dd); + + /* + * Ensure that the base clipping region is set on the device + */ + GClip(dd); + + GERaster(image, w, h, x0, y0, x1, y1, angle, interpolate, + &gc, dd); +} + +/* Compute string width. */ +double GStrWidth(const char *str, cetype_t enc, GUnit units, pGEDevDesc dd) +{ + double w; + R_GE_gcontext gc; gcontextFromGP(&gc, dd); + w = GEStrWidth(str, (gc.fontface == 5) ? CE_SYMBOL:enc, &gc, dd); + if (units != DEVICE) + w = GConvertXUnits(w, DEVICE, units, dd); + return w; +} + + +/* Compute string height. */ + +double GStrHeight(const char *str, cetype_t enc, GUnit units, pGEDevDesc dd) +{ + double h; + R_GE_gcontext gc; gcontextFromGP(&gc, dd); + h = GEStrHeight(str, (gc.fontface == 5) ? CE_SYMBOL:enc, &gc, dd); + if (units != DEVICE) + h = GConvertYUnits(h, DEVICE, units, dd); + return h; +} + +/* Draw text in a plot. */ +/* If you want EXACT centering of text (e.g., like in GSymbol) */ +/* then pass NA_REAL for xc and yc */ +void GText(double x, double y, int coords, const char *str, cetype_t enc, + double xc, double yc, double rot, pGEDevDesc dd) +{ + R_GE_gcontext gc; gcontextFromGP(&gc, dd); + /* + * Work in device coordinates because that is what the + * graphics engine needs. + */ + GConvert(&x, &y, coords, DEVICE, dd); + /* + * Ensure that the base clipping region is set on the device + */ + GClip(dd); + GEText(x, y, str, (gc.fontface == 5) ? CE_SYMBOL:enc, xc, yc, rot, &gc, dd); +} + +/*------------------------------------------------------------------- + * + * GRAPHICAL UTILITIES + * + */ + + +/* GArrow -- Draw an arrow. */ +/* NOTE that the length parameter is in inches. */ +void GArrow(double xfrom, double yfrom, double xto, double yto, int coords, + double length, double angle, int code, pGEDevDesc dd) +{ + + double xfromInch = xfrom; + double yfromInch = yfrom; + double xtoInch = xto; + double ytoInch = yto; + double rot, xc, yc; + double x[3], y[3]; + double eps = 1.e-3; + + GLine(xfrom, yfrom, xto, yto, coords, dd); + + GConvert(&xfromInch, &yfromInch, coords, INCHES, dd); + GConvert(&xtoInch, &ytoInch, coords, INCHES, dd); + if((code & 3) == 0) return; /* no arrows specified */ + if(length == 0) return; /* zero-length arrow heads */ + + if(hypot(xfromInch - xtoInch, yfromInch - ytoInch) < eps) { + /* effectively 0-length arrow */ + warning(_("zero-length arrow is of indeterminate angle and so skipped")); + return; + } + angle *= DEG2RAD; + if(code & 1) { + xc = xtoInch - xfromInch; + yc = ytoInch - yfromInch; + rot= atan2(yc, xc); + x[0] = xfromInch + length * cos(rot+angle); + y[0] = yfromInch + length * sin(rot+angle); + x[1] = xfromInch; + y[1] = yfromInch; + x[2] = xfromInch + length * cos(rot-angle); + y[2] = yfromInch + length * sin(rot-angle); + GPolyline(3, x, y, INCHES, dd); + } + if(code & 2) { + xc = xfromInch - xtoInch; + yc = yfromInch - ytoInch; + rot= atan2(yc, xc); + x[0] = xtoInch + length * cos(rot+angle); + y[0] = ytoInch + length * sin(rot+angle); + x[1] = xtoInch; + y[1] = ytoInch; + x[2] = xtoInch + length * cos(rot-angle); + y[2] = ytoInch + length * sin(rot-angle); + GPolyline(3, x, y, INCHES, dd); + } +} + + +/* Draw a box about one of several regions: box(which) */ +void GBox(int which, pGEDevDesc dd) +{ + double x[7], y[7]; + if (which == 1) {/* plot */ + x[0] = gpptr(dd)->plt[0]; y[0] = gpptr(dd)->plt[2];/* <- , __ */ + x[1] = gpptr(dd)->plt[1]; y[1] = gpptr(dd)->plt[2];/* -> , __ */ + x[2] = gpptr(dd)->plt[1]; y[2] = gpptr(dd)->plt[3];/* -> , ^ */ + x[3] = gpptr(dd)->plt[0]; y[3] = gpptr(dd)->plt[3];/* <- , ^ */ + x[4] = x[0]; y[4] = y[0]; /* <- , __ */ + x[5] = x[1]; y[5] = y[1]; /* -> , __ */ + x[6] = x[2]; y[6] = y[2]; /* -> , __ */ + } + else {/* "figure", "inner", or "outer" */ + x[0] = 0.; y[0] = 0.; + x[1] = 1.; y[1] = 0.; + x[2] = 1.; y[2] = 1.; + x[3] = 0.; y[3] = 1.; + } + switch(which) { + case 1: /* Plot */ + switch(gpptr(dd)->bty) { + case 'o': + case 'O': + GPolygon(4, x, y, NFC, + R_TRANWHITE, gpptr(dd)->col, dd); + break; + case 'l': + case 'L': + GPolyline(3, x+3, y+3, NFC, dd); + break; + case '7': + GPolyline(3, x+1, y+1, NFC, dd); + break; + case 'c': + case 'C': + case '[': + GPolyline(4, x+2, y+2, NFC, dd); + break; + case ']':/* new */ + GPolyline(4, x, y, NFC, dd); + break; + case 'u': + case 'U': + GPolyline(4, x+3, y+3, NFC, dd); + break; + case 'n': + case 'N': /* nothing */ + break; + default: + warning(_("invalid par(\"bty\") = '%c'; no box() drawn"), + gpptr(dd)->bty); + } + break; + case 2: /* Figure */ + GPolygon(4, x, y, NFC, + R_TRANWHITE, gpptr(dd)->col, dd); + break; + case 3: /* Inner Region */ + GPolygon(4, x, y, NIC, + R_TRANWHITE, gpptr(dd)->col, dd); + break; + case 4: /* "outer": Device border */ + GPolygon(4, x, y, NDC, + R_TRANWHITE, gpptr(dd)->col, dd); + break; + default: + error(_("invalid argument to GBox")); + } +} + +#if 0 +/* in src/main/graphics.c */ +#define LPR_SMALL 2 +#define LPR_MEDIUM 3 + +void GLPretty(double *ul, double *uh, int *n) +{ +/* Generate pretty tick values -- LOGARITHMIC scale + * __ ul < uh __ + * This only does a very simple setup. + * The real work happens when the axis is drawn. */ + int p1, p2; + double dl = *ul, dh = *uh; + p1 = (int) ceil(log10(dl)); + p2 = (int) floor(log10(dh)); + if(p2 <= p1 && dh/dl > 10.0) { + p1 = (int) ceil(log10(dl) - 0.5); + p2 = (int) floor(log10(dh) + 0.5); + } + + if (p2 <= p1) { /* floor(log10(uh)) <= ceil(log10(ul)) + * <==> log10(uh) - log10(ul) < 2 + * <==> uh / ul < 100 */ + /* Very small range : Use tickmarks from a LINEAR scale + * Splus uses n = 9 here, but that is dumb */ + GPretty(ul, uh, n); + *n = -*n; + } + else { /* extra tickmarks --> CreateAtVector() in ./plot.c */ + /* round to nice "1e<N>" */ + *ul = Rexp10((double)p1); + *uh = Rexp10((double)p2); + if (p2 - p1 <= LPR_SMALL) + *n = 3; /* Small range : Use 1,2,5,10 times 10^k tickmarks */ + else if (p2 - p1 <= LPR_MEDIUM) + *n = 2; /* Medium range : Use 1,5 times 10^k tickmarks */ + else + *n = 1; /* Large range : Use 10^k tickmarks + * But decimate, when there are too many*/ + } +} + +void GPretty(double *lo, double *up, int *ndiv) +{ + GEPretty(lo, up, ndiv); +} +#endif + +#define SMALL 0.25 +#define RADIUS 0.375 +#define SQRC 0.88622692545275801364 /* sqrt(pi / 4) */ +#define DMDC 1.25331413731550025119 /* sqrt(pi / 4) * sqrt(2) */ +#define TRC0 1.55512030155621416073 /* sqrt(4 * pi/(3 * sqrt(3))) */ +#define TRC1 1.34677368708859836060 /* TRC0 * sqrt(3) / 2 */ +#define TRC2 0.77756015077810708036 /* TRC0 / 2 */ +#define CMAG 1.0 /* Circle magnifier, now defunct */ +#define GSTR_0 dpptr(dd)->scale * dd->dev->cra[1] * 0.5 * dd->dev->ipr[1] * gpptr(dd)->cex +/* NOTE: This cex is already multiplied with cexbase */ + +/* Draw one of the R special symbols. */ +void GSymbol(double x, double y, int coords, int pch, pGEDevDesc dd) +{ + double size = GConvertYUnits(GSTR_0, INCHES, DEVICE, dd); + R_GE_gcontext gc; gcontextFromGP(&gc, dd); + /* + * Work in device coordinates because that is what the + * graphics engine needs. + */ + GConvert(&x, &y, coords, DEVICE, dd); + /* + * Ensure that the base clipping region is set on the device + */ + GClip(dd); + /* + * Force line type LTY_SOLID + * i.e., current par(lty) is ignored when drawing symbols + */ + gc.lty = LTY_SOLID; + /* + * special case for pch = "." + */ + if(pch == 46) size = gpptr(dd)->cex; + GESymbol(x, y, pch, size, &gc, dd); +} + + +/* Draw text in plot margins. */ +void GMtext(const char *str, cetype_t enc, int side, double line, int outer, + double at, int las, double yadj, pGEDevDesc dd) +{ +/* "las" gives the style of axis labels: + 0 = always parallel to the axis [= default], + 1 = always horizontal, + 2 = always perpendicular to the axis. + 3 = always vertical. +*/ + double angle, xadj; + int coords; + + /* Init to keep -Wall happy: */ + angle = 0.; + coords = 0; + + xadj = gpptr(dd)->adj; /* ALL cases */ + if(outer) { + switch(side) { + case 1: coords = OMA1; break; + case 2: coords = OMA2; break; + case 3: coords = OMA3; break; + case 4: coords = OMA4; break; + } + } + else { + switch(side) { + case 1: coords = MAR1; break; + case 2: coords = MAR2; break; + case 3: coords = MAR3; break; + case 4: coords = MAR4; break; + } + } + /* Note: I changed gpptr(dd)->yLineBias to 0.3 here. */ + /* Purely visual tuning. RI */ + /* This has been replaced by a new argument padj (=yadj here) to axis() + and mtext() and that can either be set manually or is determined in + a somehow fuzzy manner with respect to current side and las settings. + Uwe L. + */ + /* Note from PR#14532: + yLineBias is the proportion of line height that is white + space. The manipulation of "line" below is pure visual tuning + such that when we plot horizontal text on side 1 (or vertical + text on side 4) with padj=0 (i.e. text written *above* the + specified y-value), it is symmetric w.r.t text written on sides + 1 and 2 with padj=0. + */ + switch(side) { + case 1: + if(las == 2 || las == 3) { + angle = 90; + } + else { + line += (1/gpptr(dd)->mex)*(1 - dd->dev->yLineBias); + angle = 0; + } + break; + case 2: + if(las == 1 || las == 2) { + angle = 0; + } + else { + line += (1/gpptr(dd)->mex)*dd->dev->yLineBias; + angle = 90; + } + break; + case 3: + if(las == 2 || las == 3) { + angle = 90; + } + else { + line += (1/gpptr(dd)->mex)*dd->dev->yLineBias; + angle = 0; + } + break; + case 4: + if(las == 1 || las == 2) { + angle = 0; + } + else { + line += (1/gpptr(dd)->mex)*(1 - dd->dev->yLineBias); + angle = 90; + } + break; + } + GText(at, line, coords, str, enc, xadj, yadj, angle, dd); +}/* GMtext */ + +/* ------------------------------------------------------------ + code below here moved from plotmath.c, which said + + * This source code module: + * Copyright (C) 1997, 1998 Paul Murrell and Ross Ihaka + * Copyright (C) 1998-2008 The R Core Team + + */ + +double GExpressionWidth(SEXP expr, GUnit units, pGEDevDesc dd) +{ + R_GE_gcontext gc; + double width; + gcontextFromGP(&gc, dd); + width = GEExpressionWidth(expr, &gc, dd); + if (units == DEVICE) + return width; + else + return GConvertXUnits(width, DEVICE, units, dd); +} + +double GExpressionHeight(SEXP expr, GUnit units, pGEDevDesc dd) +{ + R_GE_gcontext gc; + double height; + gcontextFromGP(&gc, dd); + height = GEExpressionHeight(expr, &gc, dd); + if (units == DEVICE) + return height; + else + return GConvertYUnits(height, DEVICE, units, dd); +} + +/* Comment is NOT true: used in plot.c for strwidth and strheight. + * + * This is just here to satisfy the Rgraphics.h API. + * This allows new graphics API (GraphicsDevice.h, GraphicsEngine.h) + * to be developed alongside. + * Could be removed if Rgraphics.h ever gets REPLACED by new API + * NOTE that base graphics code no longer calls this -- the base + * graphics system directly calls the graphics engine for mathematical + * annotation (GEMathText in ../../../main/plotmath.c ) + */ +void GMathText(double x, double y, int coords, SEXP expr, + double xc, double yc, double rot, + pGEDevDesc dd) +{ + R_GE_gcontext gc; + gcontextFromGP(&gc, dd); + GConvert(&x, &y, coords, DEVICE, dd); + GClip(dd); + GEMathText(x, y, expr, xc, yc, rot, &gc, dd); +} + +void GMMathText(SEXP str, int side, double line, int outer, + double at, int las, double yadj, pGEDevDesc dd) +{ + int coords = 0; + double xadj, angle = 0; + + /* IF font metric information is not available for device */ + /* then bail out */ + double ascent, descent, width; + GMetricInfo('M', &ascent, &descent, &width, DEVICE, dd); + if ((ascent == 0) && (descent == 0) && (width == 0)) + error(_("metric information not available for this device")); + + xadj = gpptr(dd)->adj; + + /* This is MOSTLY the same as the same section of GMtext + * BUT it differs because it sets different values for yadj for + * different situations. + * Paul + */ + /* changed to unify behaviour with changes in GMText. Uwe */ + if(outer) { + switch(side) { + case 1: coords = OMA1; break; + case 2: coords = OMA2; break; + case 3: coords = OMA3; break; + case 4: coords = OMA4; break; + } + } + else { + switch(side) { + case 1: coords = MAR1; break; + case 2: coords = MAR2; break; + case 3: coords = MAR3; break; + case 4: coords = MAR4; break; + } + } + switch(side) { + case 1: + if(las == 2 || las == 3) { + angle = 90; + } + else { + /* line = line + 1 - gpptr(dd)->yLineBias; + angle = 0; + yadj = NA_REAL; */ + line += (1/gpptr(dd)->mex)*(1 - dd->dev->yLineBias); + angle = 0; + } + break; + case 2: + if(las == 1 || las == 2) { + angle = 0; + } + else { + /* line = line + gpptr(dd)->yLineBias; + angle = 90; + yadj = NA_REAL; */ + /* The following line is needed for symmetry with plain text + but changes existing output */ + line += (1/gpptr(dd)->mex)*dd->dev->yLineBias; + angle = 90; + } + break; + case 3: + if(las == 2 || las == 3) { + angle = 90; + } + else { + /* line = line + gpptr(dd)->yLineBias; + angle = 0; + yadj = NA_REAL; */ + /* The following line is needed for symmetry with plain text + but changes existing output */ + line += (1/gpptr(dd)->mex)*dd->dev->yLineBias; + angle = 0; + } + break; + case 4: + if(las == 1 || las == 2) { + angle = 0; + } + else { + /* line = line + 1 - gpptr(dd)->yLineBias; + angle = 90; + yadj = NA_REAL; */ + line += (1/gpptr(dd)->mex)*(1 - dd->dev->yLineBias); + angle = 90; + } + break; + } + GMathText(at, line, coords, str, xadj, yadj, angle, dd); +}/* GMMathText */ + +/* -------------------- end of code from plotmath ------------- */ diff --git a/com.oracle.truffle.r.native/gnur/patch/src/library/graphics/src/graphics.h b/com.oracle.truffle.r.native/gnur/patch/src/library/graphics/src/graphics.h new file mode 100644 index 0000000000000000000000000000000000000000..166f412b5243d226fb4e1f0ee7654fd10ecb5ccd --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/library/graphics/src/graphics.h @@ -0,0 +1,73 @@ +/* + * R : A Computer Language for Statistical Data Analysis + * Copyright (C) 2012 The R Core Team. + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version. + * + * This program 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 this program; if not, a copy is available at + * https://www.R-project.org/Licenses/ + */ + +#ifdef ENABLE_NLS +#include <libintl.h> +#undef _ +#define _(String) dgettext ("graphics", String) +#else +#define _(String) (String) +#endif + +SEXP C_contour(SEXP); +SEXP C_contourDef(void); +SEXP C_filledcontour(SEXP); +SEXP C_image(SEXP); +SEXP C_persp(SEXP); + +SEXP C_abline(SEXP args); +SEXP C_arrows(SEXP args); +SEXP C_axis(SEXP args); +SEXP C_box(SEXP args); +SEXP C_clip(SEXP args); +SEXP C_convertX(SEXP args); +SEXP C_convertY(SEXP args); +SEXP C_dend(SEXP args); +SEXP C_dendwindow(SEXP args); +SEXP C_erase(SEXP args); +SEXP C_layout(SEXP args); +SEXP C_mtext(SEXP args); +SEXP C_path(SEXP args); +SEXP C_plotXY(SEXP args); +SEXP C_plot_window(SEXP args); +SEXP C_polygon(SEXP args); +SEXP C_raster(SEXP args); +SEXP C_rect(SEXP args); +SEXP C_segments(SEXP args); +SEXP C_strHeight(SEXP args); +SEXP C_strWidth (SEXP args); +SEXP C_symbols(SEXP args); +SEXP C_text(SEXP args); +SEXP C_title(SEXP args); +SEXP C_xspline(SEXP args); + + +SEXP C_par(SEXP call, SEXP op, SEXP args, SEXP rho); +SEXP C_plot_new(SEXP call, SEXP op, SEXP args, SEXP rho); +SEXP C_locator(SEXP call, SEXP op, SEXP args, SEXP rho); +SEXP C_identify(SEXP call, SEXP op, SEXP args, SEXP rho); + +void registerBase(void); +void unregisterBase(void); +SEXP RunregisterBase(void); + +SEXP C_StemLeaf(SEXP x, SEXP scale, SEXP swidth, SEXP atom); +SEXP C_BinCount(SEXP x, SEXP breaks, SEXP right, SEXP lowest); + +Rboolean isNAcol(SEXP col, int index, int ncol); diff --git a/com.oracle.truffle.r.native/gnur/patch/src/library/graphics/src/init.c b/com.oracle.truffle.r.native/gnur/patch/src/library/graphics/src/init.c new file mode 100644 index 0000000000000000000000000000000000000000..a5d1f7a4fe6ca6c8fb2c47fb5d89d9e7d2a22378 --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/library/graphics/src/init.c @@ -0,0 +1,91 @@ +/* + * R : A Computer Language for Statistical Data Analysis + * Copyright (C) 2012-2017 The R Core Team. + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version. + * + * This program 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 this program; if not, a copy is available at + * https://www.R-project.org/Licenses/ + */ + +#ifdef HAVE_CONFIG_H +#include <config.h> +#endif + +#include <R.h> +#include <Rinternals.h> + +#include "graphics.h" +#include <R_ext/Rdynload.h> +#include <R_ext/Visibility.h> + +#define CALLDEF(name, n) {#name, (DL_FUNC) &name, n} + +static const R_CallMethodDef CallEntries[] = { + CALLDEF(C_contourDef, 0), + CALLDEF(C_StemLeaf, 4), + CALLDEF(C_BinCount, 4), + CALLDEF(RunregisterBase, 0), + {NULL, NULL, 0} +}; + + +#define EXTDEF(name, n) {#name, (DL_FUNC) &name, n} + +static const R_ExternalMethodDef ExtEntries[] = { + EXTDEF(C_contour, -1), + EXTDEF(C_filledcontour, 5), + EXTDEF(C_image, 4), + EXTDEF(C_persp, -1), + + EXTDEF(C_abline, -1), + EXTDEF(C_axis, -1), + EXTDEF(C_arrows, -1), + EXTDEF(C_box, -1), + EXTDEF(C_clip, -1), + EXTDEF(C_convertX, 3), + EXTDEF(C_convertY, 3), + EXTDEF(C_dend, -1), + EXTDEF(C_dendwindow, -1), + EXTDEF(C_erase, -1), + EXTDEF(C_layout, -1), + EXTDEF(C_mtext, -1), + EXTDEF(C_par, -1), + EXTDEF(C_path, -1), + EXTDEF(C_plotXY, -1), + EXTDEF(C_plot_window, -1), + EXTDEF(C_polygon, -1), + EXTDEF(C_raster, -1), + EXTDEF(C_rect, -1), + EXTDEF(C_segments, -1), + EXTDEF(C_strHeight, -1), + EXTDEF(C_strWidth, -1), + EXTDEF(C_symbols, -1), + EXTDEF(C_text, -1), + EXTDEF(C_title, -1), + EXTDEF(C_xspline, -1), + + EXTDEF(C_plot_new, 0), + EXTDEF(C_locator, -1), + EXTDEF(C_identify, -1), + {NULL, NULL, 0} +}; + + +void attribute_visible +R_init_graphics(DllInfo *dll) +{ + R_registerRoutines(dll, NULL, CallEntries, NULL, ExtEntries); + R_useDynamicSymbols(dll, FALSE); + R_forceSymbols(dll, TRUE); + registerBase(); +} diff --git a/com.oracle.truffle.r.native/gnur/patch/src/library/graphics/src/par-common.c b/com.oracle.truffle.r.native/gnur/patch/src/library/graphics/src/par-common.c new file mode 100644 index 0000000000000000000000000000000000000000..ec5c830c68204c29603042d241a81d7a46bdc272 --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/library/graphics/src/par-common.c @@ -0,0 +1,367 @@ +/* + * R : A Computer Language for Statistical Data Analysis + * Copyright (C) 1997-2012 The R Core Team + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version. + * + * This program 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 this program; if not, a copy is available at + * https://www.R-project.org/Licenses/ + */ + +/* Graphical parameters which are treated identically by + * par( <nam> = <value> ) and highlevel plotfun (..., <nam> = <value> ). + * + * This is #included both from Specify() and Specify2() into ./par.c +*/ + if (streql(what, "adj")) { + lengthCheck(what, value, 1); x = asReal(value); + BoundsCheck(x, 0.0, 1.0, what); + R_DEV__(adj) = x; + } + else if (streql(what, "ann")) { + lengthCheck(what, value, 1); ix = asLogical(value); + R_DEV__(ann) = (ix != 0);/* NA |-> TRUE */ + } + else if (streql(what, "bg")) { + /* in par() this means the plot region, inline it means filled points */ +#ifdef FOR_PAR + lengthCheck(what, value, 1); +#else + if (!isVector(value) || LENGTH(value) < 1) par_error(what); +#endif + R_DEV__(bg) = RGBpar3(value, 0, dpptr(dd)->bg); +#ifdef FOR_PAR + R_DEV__(new) = FALSE; +#endif + } + else if (streql(what, "bty")) { + lengthCheck(what, value, 1); + if (!isString(value)) + par_error(what); + cx = CHAR(STRING_ELT(value, 0))[0]; + switch (cx) { + case 'o': case 'O': + case 'l': case 'L': + case '7': + case 'c': case 'C': case '[': + case ']': + case 'u': case 'U': + case 'n': + R_DEV__(bty) = cx; + break; + default: + par_error(what); + } + } + + else if (streql(what, "cex")) { +#ifdef FOR_PAR + lengthCheck(what, value, 1); +/* else: cex can be a vector of length > 1, so pick off first value + (as e.g. pch always did) */ +#endif + x = asReal(value); + posRealCheck(x, what); +#ifdef FOR_PAR + R_DEV__(cex) = 1.0; + R_DEV__(cexbase) = x; +#else + R_DEV__(cex) = x; // not setting cexbase here +#endif + } + else if (streql(what, "cex.main")) { + lengthCheck(what, value, 1); x = asReal(value); + posRealCheck(x, what); + R_DEV__(cexmain) = x; + } + else if (streql(what, "cex.lab")) { + lengthCheck(what, value, 1); x = asReal(value); + posRealCheck(x, what); + R_DEV__(cexlab) = x; + } + else if (streql(what, "cex.sub")) { + lengthCheck(what, value, 1); x = asReal(value); + posRealCheck(x, what); + R_DEV__(cexsub) = x; + } + else if (streql(what, "cex.axis")) { + lengthCheck(what, value, 1); x = asReal(value); + posRealCheck(x, what); + R_DEV__(cexaxis) = x; + } + else if (streql(what, "col")) { +#ifdef FOR_PAR + lengthCheck(what, value, 1); +#else + if (!isVector(value) || LENGTH(value) < 1) par_error(what); +#endif + R_DEV__(col) = RGBpar3(value, 0, dpptr(dd)->bg); + } + else if (streql(what, "col.main")) { + lengthCheck(what, value, 1); + R_DEV__(colmain) = RGBpar3(value, 0, dpptr(dd)->bg); + } + else if (streql(what, "col.lab")) { + lengthCheck(what, value, 1); + R_DEV__(collab) = RGBpar3(value, 0, dpptr(dd)->bg); + } + else if (streql(what, "col.sub")) { + lengthCheck(what, value, 1); + R_DEV__(colsub) = RGBpar3(value, 0, dpptr(dd)->bg); + } + else if (streql(what, "col.axis")) { + lengthCheck(what, value, 1); + R_DEV__(colaxis) = RGBpar3(value, 0, dpptr(dd)->bg); + } + else if (streql(what, "crt")) { + lengthCheck(what, value, 1); x = asReal(value); + naRealCheck(x, what); + R_DEV__(crt) = x; + } + else if (streql(what, "err")) { + lengthCheck(what, value, 1); ix = asInteger(value); + if (ix == 0 || ix == -1) + R_DEV__(err) = ix; + else par_error(what); + } + else if (streql(what, "family")) { + const char *ss; + value = coerceVector(value, STRSXP); + if (STRING_ELT(value, 0) == NA_STRING) { + SET_STRING_ELT(value, 0, R_BlankString); + } + lengthCheck(what, value, 1); + const void *vmax = vmaxget(); + ss = translateChar(STRING_ELT(value, 0)); + if(strlen(ss) > 200) + error(_("graphical parameter 'family' has a maximum length of 200 bytes")); +#ifdef FOR_PAR + strncpy(dpptr(dd)->family, ss, 201); +#endif + strncpy(gpptr(dd)->family, ss, 201); + vmaxset(vmax); + } + else if (streql(what, "fg")) { + lengthCheck(what, value, 1); + ix = RGBpar3(value, 0, dpptr(dd)->bg); +#ifdef FOR_PAR + /* par(fg=) sets BOTH "fg" and "col" */ + R_DEV__(col) = ix; +#endif + R_DEV__(fg) = ix; + } + else if (streql(what, "font")) { + lengthCheck(what, value, 1); ix = asInteger(value); + posIntCheck(ix, what); + R_DEV__(font) = ix; + } + else if (streql(what, "font.main")) { + lengthCheck(what, value, 1); ix = asInteger(value); + posIntCheck(ix, what); + R_DEV__(fontmain) = ix; + } + else if (streql(what, "font.lab")) { + lengthCheck(what, value, 1); ix = asInteger(value); + posIntCheck(ix, what); + R_DEV__(fontlab) = ix; + } + else if (streql(what, "font.sub")) { + lengthCheck(what, value, 1); ix = asInteger(value); + posIntCheck(ix, what); + R_DEV__(fontsub) = ix; + } + else if (streql(what, "font.axis")) { + lengthCheck(what, value, 1); ix = asInteger(value); + posIntCheck(ix, what); + R_DEV__(fontaxis) = ix; + } + else if (streql(what, "lab")) { + value = coerceVector(value, INTSXP); + lengthCheck(what, value, 3); + posIntCheck (INTEGER(value)[0], what); + posIntCheck (INTEGER(value)[1], what); + nonnegIntCheck(INTEGER(value)[2], what); + R_DEV__(lab[0]) = INTEGER(value)[0]; + R_DEV__(lab[1]) = INTEGER(value)[1]; + R_DEV__(lab[2]) = INTEGER(value)[2]; + } + else if (streql(what, "las")) { + lengthCheck(what, value, 1); ix = asInteger(value); + if (0 <= ix && ix <= 3) + R_DEV__(las) = ix; + else par_error(what); + } + else if (streql(what, "lend")) { + lengthCheck(what, value, 1); + R_DEV__(lend) = GE_LENDpar(value, 0); + } + else if (streql(what, "ljoin")) { + lengthCheck(what, value, 1); + R_DEV__(ljoin) = GE_LJOINpar(value, 0); + } + else if (streql(what, "lmitre")) { + lengthCheck(what, value, 1); + x = asReal(value); + posRealCheck(x, what); + if (x < 1) + par_error(what); + R_DEV__(lmitre) = x; + } + else if (streql(what, "lty")) { +#ifdef FOR_PAR + lengthCheck(what, value, 1); +#else + if (!isVector(value) || LENGTH(value) < 1) par_error(what); +#endif + R_DEV__(lty) = GE_LTYpar(value, 0); + } + else if (streql(what, "lwd")) { +#ifdef FOR_PAR + lengthCheck(what, value, 1); +#else + if (!isVector(value) || LENGTH(value) < 1) par_error(what); +#endif + x = asReal(value); + posRealCheck(x, what); + R_DEV__(lwd) = x; + } + else if (streql(what, "mgp")) { + PROTECT(value = coerceVector(value, REALSXP)); + lengthCheck(what, value, 3); + /* Since 1.6.x: Allow negative (S-compatibly): */ + naRealCheck(REAL(value)[0], what); + naRealCheck(REAL(value)[1], what); + naRealCheck(REAL(value)[2], what); + if(REAL(value)[0] * REAL(value)[1] < 0 || + REAL(value)[0] * REAL(value)[2] < 0) + warning("`mgp[1:3]' are of differing sign"); + R_DEV__(mgp[0]) = REAL(value)[0]; + R_DEV__(mgp[1]) = REAL(value)[1]; + R_DEV__(mgp[2]) = REAL(value)[2]; + UNPROTECT(1); + } + else if (streql(what, "mkh")) { + lengthCheck(what, value, 1); x = asReal(value); + posRealCheck(x, what); + R_DEV__(mkh) = x; + } + else if (streql(what, "pch")) { +#ifdef FOR_PAR + lengthCheck(what, value, 1); +#else + if (!isVector(value) || LENGTH(value) < 1) par_error(what); +#endif + if (isString(value)) { + ix = GEstring_to_pch(STRING_ELT(value, 0)); + } else if (isNumeric(value)) { + ix = asInteger(value); + } else par_error(what); + if(ix == NA_INTEGER) par_error(what); + R_DEV__(pch) = ix; + } + else if (streql(what, "smo")) { + /* FIXME: not real */ + lengthCheck(what, value, 1); x = asReal(value); + nonnegRealCheck(x, what); + R_DEV__(smo) = (int) x; + } + else if (streql(what, "srt")) { + lengthCheck(what, value, 1); x = asReal(value); + naRealCheck(x, what); + R_DEV__(srt) = x; + } + + /* NOTE: tck and tcl must be treated in parallel; if one is NA, + * the other must be non-NA. If tcl is NA, then setting tck to NA + * will reset tck to its initial default value. See also graphics.c. */ + else if (streql(what, "tck")) { + lengthCheck(what, value, 1); x = asReal(value); + R_DEV__(tck) = x; + if (R_FINITE(x)) + R_DEV__(tcl) = NA_REAL; + else if(!R_FINITE(dpptr(dd)->tcl)) + R_DEV__(tcl) = -0.5; + } + else if (streql(what, "tcl")) { + lengthCheck(what, value, 1); x = asReal(value); + R_DEV__(tcl) = x; + if (R_FINITE(x)) + R_DEV__(tck) = NA_REAL; + else if (!R_FINITE(dpptr(dd)->tck)) + R_DEV__(tck) = -0.01; /* S Default -- was 0.02 till R 1.5.x */ + } + else if (streql(what, "xaxp")) { + value = coerceVector(value, REALSXP); + lengthCheck(what, value, 3); + naRealCheck(REAL(value)[0], what); + naRealCheck(REAL(value)[1], what); + if ((R_DEV__(xlog))) + logAxpCheck((int) (REAL(value)[2]), what); + else + posIntCheck((int) (REAL(value)[2]), what); + R_DEV__(xaxp[0]) = REAL(value)[0]; + R_DEV__(xaxp[1]) = REAL(value)[1]; + R_DEV__(xaxp[2]) = (int)(REAL(value)[2]); + } + else if (streql(what, "xaxs")) { + if (!isString(value) || LENGTH(value) < 1) + par_error(what); + cx = CHAR(STRING_ELT(value, 0))[0]; + if (cx == 's' || cx == 'e' || cx == 'i' || cx == 'r' || cx == 'd') + R_DEV__(xaxs) = cx; + else par_error(what); + } + else if (streql(what, "xaxt")) { + if (!isString(value) || LENGTH(value) < 1) + par_error(what); + cx = CHAR(STRING_ELT(value, 0))[0]; + if (cx == 's' || cx == 'l' || cx == 't' || cx == 'n') + R_DEV__(xaxt) = cx; + else par_error(what); + } + else if (streql(what, "xpd")) { + lengthCheck(what, value, 1); + ix = asInteger(value); + if (ix == NA_INTEGER) + R_DEV__(xpd) = 2; + else + R_DEV__(xpd) = (ix != 0); + } + else if (streql(what, "yaxp")) { + value = coerceVector(value, REALSXP); + lengthCheck(what, value, 3); + naRealCheck(REAL(value)[0], what); + naRealCheck(REAL(value)[1], what); + if ((R_DEV__(ylog))) + logAxpCheck((int) (REAL(value)[2]), what); + else + posIntCheck((int) (REAL(value)[2]), what); + R_DEV__(yaxp[0]) = REAL(value)[0]; + R_DEV__(yaxp[1]) = REAL(value)[1]; + R_DEV__(yaxp[2]) = (int) (REAL(value)[2]); + } + else if (streql(what, "yaxs")) { + if (!isString(value) || LENGTH(value) < 1) + par_error(what); + cx = CHAR(STRING_ELT(value, 0))[0]; + if (cx == 's' || cx == 'e' || cx == 'i' || cx == 'r' || cx == 'd') + R_DEV__(yaxs) = cx; + else par_error(what); + } + else if (streql(what, "yaxt")) { + if (!isString(value) || LENGTH(value) < 1) + par_error(what); + cx = CHAR(STRING_ELT(value, 0))[0]; + if (cx == 's' || cx == 'l' || cx == 't' || cx == 'n') + R_DEV__(yaxt) = cx; + else par_error(what); + } diff --git a/com.oracle.truffle.r.native/gnur/patch/src/library/graphics/src/par.c b/com.oracle.truffle.r.native/gnur/patch/src/library/graphics/src/par.c new file mode 100644 index 0000000000000000000000000000000000000000..997ad8027deff045061dc014479c1572b01191ea --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/library/graphics/src/par.c @@ -0,0 +1,1269 @@ +/* + * R : A Computer Language for Statistical Data Analysis + * Copyright (C) 1995, 1996 Robert Gentleman and Ross Ihaka + * Copyright (C) 1997--2014 The R Core Team. + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version. + * + * This program 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 this program; if not, a copy is available at + * https://www.R-project.org/Licenses/ + * + * + * + * GRZ-like state information. + * + * This is a quick knock-off of the GRZ library to provide a basic + * S-like graphics capability for R. Basically this bit of code + * provides the functionality of the "par" function in S. + * + * "The horror, the horror ..." + * Marlon Brando in Apocalypse Now. + * + * Main functions: + * do_par(.) and + * do_layout(.) implement R's par(.), layout()rely on + * + * Specify(.) [ par(what = value) ] + * Specify2(.) [ <highlevelplot>(what = value) ] + * Query(.) [ par(what) ] + */ + + +#ifdef HAVE_CONFIG_H +#include <config.h> +#endif + +#include <Defn.h> +#include <Rmath.h> +#include <Graphics.h> /* "GPar" structure + COMMENTS */ + +#include "graphics.h" + +typedef struct { + char *name; + int code; /* 0 normal, 1 not inline, 2 read-only + -1 unknown, -2 obselete, -3 graphical args + */ +} ParTab; + +static const ParTab +ParTable [] = { + { "adj", 0 }, + { "ann", 0 }, + { "ask", 1 }, + { "bg", 0 }, + { "bty", 0 }, + { "cex", 0 }, + { "cex.axis", 0 }, + { "cex.lab", 0 }, + { "cex.main", 0 }, + { "cex.sub", 0 }, + { "cin", 2 }, + { "col", 0 }, + { "col.axis", 0 }, + { "col.lab", 0 }, + { "col.main", 0 }, + { "col.sub", 0 }, + { "cra", 2 }, + { "crt", 0 }, + { "csi", 2 }, + { "csy", 0 }, + { "cxy", 2 }, + { "din", 2 }, + { "err", 0 }, + { "family", 0 }, + { "fg", 0 }, + { "fig", 1 }, + { "fin", 1 }, + { "font", 0 }, + { "font.axis", 0 }, + { "font.lab", 0 }, + { "font.main", 0 }, + { "font.sub", 0 }, + { "lab", 0 }, + { "las", 0 }, + { "lend", 0 }, + { "lheight", 1 }, + { "ljoin", 0 }, + { "lmitre", 0 }, + { "lty", 0 }, + { "lwd", 0 }, + { "mai", 1 }, + { "mar", 1 }, + { "mex", 1 }, + { "mfcol", 1 }, + { "mfg", 1 }, + { "mfrow", 1 }, + { "mgp", 0 }, + { "mkh", 0 }, + { "new", 1 }, + { "oma", 1 }, + { "omd", 1 }, + { "omi", 1 }, + { "page", 2 }, + { "pch", 0 }, + { "pin", 1 }, + { "plt", 1 }, + { "ps", 1 }, + { "pty", 1 }, + { "smo", 0 }, + { "srt", 0 }, + { "tck", 0 }, + { "tcl", 0 }, + { "usr", 1 }, + { "xaxp", 0 }, + { "xaxs", 0 }, + { "xaxt", 0 }, + { "xlog", 1 }, + { "xpd", 0 }, + { "yaxp", 0 }, + { "yaxs", 0 }, + { "yaxt", 0 }, + { "ylbias", 1 }, + { "ylog", 1 }, + /* Obsolete pars */ + { "gamma", -2}, + { "type", -2}, + { "tmag", -2}, + /* Non-pars that might get passed to Specify2 */ + { "asp", -3}, + { "main", -3}, + { "sub", -3}, + { "xlab", -3}, + { "ylab", -3}, + { "xlim", -3}, + { "ylim", -3}, + { NULL, -1} +}; + + +static int ParCode(const char *what) +{ + int i; + for (i = 0; ParTable[i].name; i++) + if (!strcmp(what, ParTable[i].name)) return ParTable[i].code; + return -1; +} + + +static void NORET par_error(const char *what) +{ + error(_("invalid value specified for graphical parameter \"%s\""), what); +} + + +static void lengthCheck(const char *what, SEXP v, int n) +{ + if (length(v) != n) + error(_("graphical parameter \"%s\" has the wrong length"), what); +} + + +static void nonnegIntCheck(int x, const char *s) +{ + if (x == NA_INTEGER || x < 0) + par_error(s); +} + +static void posIntCheck(int x, const char *s) +{ + if (x == NA_INTEGER || x <= 0) + par_error(s); +} + +static void posRealCheck(double x, const char *s) +{ + if (!R_FINITE(x) || x <= 0) + par_error(s); +} + +static void nonnegRealCheck(double x, const char *s) +{ + if (!R_FINITE(x) || x < 0) + par_error(s); +} + +static void naRealCheck(double x, const char *s) +{ + if (!R_FINITE(x)) + par_error(s); +} + +static void logAxpCheck(int x, const char *s) +{ + if (x == NA_INTEGER || x == 0 || x > 4) + par_error(s); +} + + +static void BoundsCheck(double x, double a, double b, const char *s) +{ +/* Check if a <= x <= b */ + if (!R_FINITE(x) || (R_FINITE(a) && x < a) || (R_FINITE(b) && x > b)) + par_error(s); +} + + +/* When any one of the layout parameters (which can only be set via */ +/* par(...)) is modified, must call GReset() to update the layout and */ +/* the transformations between coordinate systems */ + +/* These will be defined differently for Specify() and Specify2() : */ +/* <FIXME> do not need separate macros for a = b = c and b = a = c */ +#define R_DEV__(_P_) dpptr(dd)->_P_ = gpptr(dd)->_P_ +#define R_DEV_2(_P_) gpptr(dd)->_P_ = dpptr(dd)->_P_ +/* In Emacs : -- only inside Specify() : + * (query-replace-regexp + "dpptr(dd)->\\([][A-Za-z0-9]+\\) = gpptr(dd)->\\(\\1\\)" + "R_DEV__(\\1)" nil nil nil) + + (query-replace-regexp + "gpptr(dd)->\\([][A-Za-z0-9]+\\) = dpptr(dd)->\\(\\1\\)" + "R_DEV_2(\\1)" nil nil nil) +*/ + +static void Specify(const char *what, SEXP value, pGEDevDesc dd) +{ +/* If you ADD a NEW par, then do NOT forget to update the code in + * ../library/base/R/par.R + + * Parameters in Specify(), + * which can*not* be specified in high-level functions, + * i.e., by Specify2() [below]: + * this list is in \details{.} of ../library/base/man/par.Rd + * ------------------------ + * "ask", + * "family", "fig", "fin", + * "lheight", + * "mai", "mar", "mex", "mfrow", "mfcol", "mfg", + * "new", + * "oma", "omd", "omi", + * "pin", "plt", "ps", "pty" + * "usr", + * "xlog", "ylog" + * "ylbias", + */ + double x; + int ix = 0; + char cx = '\0'; + + /* If we get here, Query has already checked that 'what' is valid */ + + if (ParCode(what) == 2) { + warning(_("graphical parameter \"%s\" cannot be set"), what); + return; + } +#define FOR_PAR +#include "par-common.c" +#undef FOR_PAR +/* ------------ */ + else if (streql(what, "bg")) { + lengthCheck(what, value, 1); + ix = RGBpar3(value, 0, dpptr(dd)->bg); + /* naIntCheck(ix, what); */ + R_DEV__(bg) = ix; + R_DEV__(new) = FALSE; + } +/*--- and these are "Specify() only" {i.e. par(nam = val)} : */ + else if (streql(what, "ask")) { + lengthCheck(what, value, 1); ix = asLogical(value); + dd->ask = (ix == 1);/* NA |-> FALSE */ + } + else if (streql(what, "fig")) { + value = coerceVector(value, REALSXP); + lengthCheck(what, value, 4); + if (0.0 <= REAL(value)[0] && REAL(value)[0] < REAL(value)[1] && + REAL(value)[1] <= 1.0 && + 0.0 <= REAL(value)[2] && REAL(value)[2] < REAL(value)[3] && + REAL(value)[3] <= 1.0) { + R_DEV_2(defaultFigure) = 0; + R_DEV_2(fUnits) = NIC; + R_DEV_2(numrows) = 1; + R_DEV_2(numcols) = 1; + R_DEV_2(heights[0]) = 1; + R_DEV_2(widths[0]) = 1; + R_DEV_2(cmHeights[0]) = 0; + R_DEV_2(cmWidths[0]) = 0; + R_DEV_2(order[0]) = 1; + R_DEV_2(currentFigure) = 1; + R_DEV_2(lastFigure) = 1; + R_DEV__(rspct) = 0; + + R_DEV_2(fig[0]) = REAL(value)[0]; + R_DEV_2(fig[1]) = REAL(value)[1]; + R_DEV_2(fig[2]) = REAL(value)[2]; + R_DEV_2(fig[3]) = REAL(value)[3]; + GReset(dd); + } + else par_error(what); + } + else if (streql(what, "fin")) { + value = coerceVector(value, REALSXP); + lengthCheck(what, value, 2); + R_DEV_2(defaultFigure) = 0; + R_DEV_2(fUnits) = INCHES; + R_DEV_2(numrows) = 1; + R_DEV_2(numcols) = 1; + R_DEV_2(heights[0]) = 1; + R_DEV_2(widths[0]) = 1; + R_DEV_2(cmHeights[0]) = 0; + R_DEV_2(cmWidths[0]) = 0; + R_DEV_2(order[0]) = 1; + R_DEV_2(currentFigure) = 1; + R_DEV_2(lastFigure) = 1; + R_DEV__(rspct) = 0; + R_DEV_2(fin[0]) = REAL(value)[0]; + R_DEV_2(fin[1]) = REAL(value)[1]; + GReset(dd); + } + /* -- */ + else if (streql(what, "lheight")) { + lengthCheck(what, value, 1); + x = asReal(value); + posRealCheck(x, what); + R_DEV__(lheight) = x; + } + else if (streql(what, "mai")) { + value = coerceVector(value, REALSXP); + lengthCheck(what, value, 4); + nonnegRealCheck(REAL(value)[0], what); + nonnegRealCheck(REAL(value)[1], what); + nonnegRealCheck(REAL(value)[2], what); + nonnegRealCheck(REAL(value)[3], what); + R_DEV__(mai[0]) = REAL(value)[0]; + R_DEV__(mai[1]) = REAL(value)[1]; + R_DEV__(mai[2]) = REAL(value)[2]; + R_DEV__(mai[3]) = REAL(value)[3]; + R_DEV__(mUnits) = INCHES; + R_DEV__(defaultPlot) = TRUE; + GReset(dd); + } + else if (streql(what, "mar")) { + value = coerceVector(value, REALSXP); + lengthCheck(what, value, 4); + nonnegRealCheck(REAL(value)[0], what); + nonnegRealCheck(REAL(value)[1], what); + nonnegRealCheck(REAL(value)[2], what); + nonnegRealCheck(REAL(value)[3], what); + R_DEV__(mar[0]) = REAL(value)[0]; + R_DEV__(mar[1]) = REAL(value)[1]; + R_DEV__(mar[2]) = REAL(value)[2]; + R_DEV__(mar[3]) = REAL(value)[3]; + R_DEV__(mUnits) = LINES; + R_DEV__(defaultPlot) = TRUE; + GReset(dd); + } + else if (streql(what, "mex")) { + lengthCheck(what, value, 1); x = asReal(value); + posRealCheck(x, what); + R_DEV__(mex) = x; + GReset(dd); + } + else if (streql(what, "mfrow")) { + int nrow, ncol; + value = coerceVector(value, INTSXP); + lengthCheck(what, value, 2); + posIntCheck(INTEGER(value)[0], what); + posIntCheck(INTEGER(value)[1], what); + nrow = INTEGER(value)[0]; + ncol = INTEGER(value)[1]; + R_DEV_2(numrows) = nrow; + R_DEV_2(numcols) = ncol; + R_DEV_2(currentFigure) = nrow*ncol; + R_DEV_2(lastFigure) = nrow*ncol; + R_DEV_2(defaultFigure) = TRUE; + R_DEV_2(layout) = FALSE; + if (nrow > 2 || ncol > 2) { + R_DEV_2(cexbase) = 0.66; + R_DEV_2(mex) = 1.0; + } + else if (nrow == 2 && ncol == 2) { + R_DEV_2(cexbase) = 0.83; + R_DEV_2(mex) = 1.0; + } + else { + R_DEV_2(cexbase) = 1.0; + R_DEV_2(mex) = 1.0; + } + R_DEV__(mfind) = 0; + GReset(dd); + } + else if (streql(what, "mfcol")) { + int nrow, ncol; + value = coerceVector(value, INTSXP); + lengthCheck(what, value, 2); + posIntCheck(INTEGER(value)[0], what); + posIntCheck(INTEGER(value)[1], what); + nrow = INTEGER(value)[0]; + ncol = INTEGER(value)[1]; + R_DEV_2(numrows) = nrow; + R_DEV_2(numcols) = ncol; + R_DEV_2(currentFigure) = nrow*ncol; + R_DEV_2(lastFigure) = nrow*ncol; + R_DEV_2(defaultFigure) = TRUE; + R_DEV_2(layout) = FALSE; + if (nrow > 2 || ncol > 2) { + R_DEV_2(cexbase) = 0.66; + R_DEV_2(mex) = 1.0; + } + else if (nrow == 2 && ncol == 2) { + R_DEV_2(cexbase) = 0.83; + R_DEV_2(mex) = 1.0; + } + else { + R_DEV__(cexbase) = 1.0; + R_DEV__(mex) = 1.0; + } + R_DEV__(mfind) = 1; + GReset(dd); + } + else if (streql(what, "mfg")) { + int row, col, nrow, ncol, np; + PROTECT(value = coerceVector(value, INTSXP)); + np = length(value); + if(np != 2 && np != 4) + error(_("parameter \"mfg\" has the wrong length")); + posIntCheck(INTEGER(value)[0], what); + posIntCheck(INTEGER(value)[1], what); + row = INTEGER(value)[0]; + col = INTEGER(value)[1]; + nrow = dpptr(dd)->numrows; + ncol = dpptr(dd)->numcols; + if(row <= 0 || row > nrow) + error(_("parameter \"i\" in \"mfg\" is out of range")); + if(col <= 0 || col > ncol) + error(_("parameter \"j\" in \"mfg\" is out of range")); + if(np == 4) { + posIntCheck(INTEGER(value)[2], what); + posIntCheck(INTEGER(value)[3], what); + if(nrow != INTEGER(value)[2]) + warning(_("value of 'nr' in \"mfg\" is wrong and will be ignored")); + if(ncol != INTEGER(value)[3]) + warning(_("value of 'nc' in \"mfg\" is wrong and will be ignored")); + } + UNPROTECT(1); + R_DEV_2(lastFigure) = nrow*ncol; + /*R_DEV__(mfind) = 1;*/ + /* currentFigure is 1-based */ + if(gpptr(dd)->mfind) + dpptr(dd)->currentFigure = (col-1)*nrow + row; + else dpptr(dd)->currentFigure = (row-1)*ncol + col; + /* + if (dpptr(dd)->currentFigure == 0) + dpptr(dd)->currentFigure = dpptr(dd)->lastFigure; + */ + R_DEV_2(currentFigure); + /* R_DEV_2(defaultFigure) = TRUE; + R_DEV_2(layout) = FALSE; */ + R_DEV_2(new) = TRUE; + GReset(dd); + /* Force a device clip */ + if (dd->dev->canClip) GForceClip(dd); + } /* mfg */ + + else if (streql(what, "new")) { + lengthCheck(what, value, 1); + ix = asLogical(value); + if(!gpptr(dd)->state) { + /* no need to warn with new=FALSE and no plot */ + if(ix != 0) warning(_("calling par(new=TRUE) with no plot")); + } else R_DEV__(new) = (ix != 0); + } + /* -- */ + + else if (streql(what, "oma")) { + value = coerceVector(value, REALSXP); + lengthCheck(what, value, 4); + nonnegRealCheck(REAL(value)[0], what); + nonnegRealCheck(REAL(value)[1], what); + nonnegRealCheck(REAL(value)[2], what); + nonnegRealCheck(REAL(value)[3], what); + R_DEV__(oma[0]) = REAL(value)[0]; + R_DEV__(oma[1]) = REAL(value)[1]; + R_DEV__(oma[2]) = REAL(value)[2]; + R_DEV__(oma[3]) = REAL(value)[3]; + R_DEV__(oUnits) = LINES; + /* !!! Force eject of multiple figures !!! */ + R_DEV__(currentFigure) = gpptr(dd)->lastFigure; + GReset(dd); + } + else if (streql(what, "omd")) { + value = coerceVector(value, REALSXP); + lengthCheck(what, value, 4); + BoundsCheck(REAL(value)[0], 0.0, 1.0, what); + BoundsCheck(REAL(value)[1], 0.0, 1.0, what); + BoundsCheck(REAL(value)[2], 0.0, 1.0, what); + BoundsCheck(REAL(value)[3], 0.0, 1.0, what); + R_DEV__(omd[0]) = REAL(value)[0]; + R_DEV__(omd[1]) = REAL(value)[1]; + R_DEV__(omd[2]) = REAL(value)[2]; + R_DEV__(omd[3]) = REAL(value)[3]; + R_DEV__(oUnits) = NDC; + /* Force eject of multiple figures */ + R_DEV__(currentFigure) = gpptr(dd)->lastFigure; + GReset(dd); + } + else if (streql(what, "omi")) { + value = coerceVector(value, REALSXP); + lengthCheck(what, value, 4); + nonnegRealCheck(REAL(value)[0], what); + nonnegRealCheck(REAL(value)[1], what); + nonnegRealCheck(REAL(value)[2], what); + nonnegRealCheck(REAL(value)[3], what); + R_DEV__(omi[0]) = REAL(value)[0]; + R_DEV__(omi[1]) = REAL(value)[1]; + R_DEV__(omi[2]) = REAL(value)[2]; + R_DEV__(omi[3]) = REAL(value)[3]; + R_DEV__(oUnits) = INCHES; + /* Force eject of multiple figures */ + R_DEV__(currentFigure) = gpptr(dd)->lastFigure; + GReset(dd); + } + /* -- */ + + else if (streql(what, "pin")) { + value = coerceVector(value, REALSXP); + lengthCheck(what, value, 2); + nonnegRealCheck(REAL(value)[0], what); + nonnegRealCheck(REAL(value)[1], what); + R_DEV__(pin[0]) = REAL(value)[0]; + R_DEV__(pin[1]) = REAL(value)[1]; + R_DEV__(pUnits) = INCHES; + R_DEV__(defaultPlot) = FALSE; + GReset(dd); + } + else if (streql(what, "plt")) { + value = coerceVector(value, REALSXP); + lengthCheck(what, value, 4); + nonnegRealCheck(REAL(value)[0], what); + nonnegRealCheck(REAL(value)[1], what); + nonnegRealCheck(REAL(value)[2], what); + nonnegRealCheck(REAL(value)[3], what); + R_DEV__(plt[0]) = REAL(value)[0]; + R_DEV__(plt[1]) = REAL(value)[1]; + R_DEV__(plt[2]) = REAL(value)[2]; + R_DEV__(plt[3]) = REAL(value)[3]; + R_DEV__(pUnits) = NFC; + R_DEV__(defaultPlot) = FALSE; + GReset(dd); + } + else if (streql(what, "ps")) { + lengthCheck(what, value, 1); ix = asInteger(value); + nonnegIntCheck(ix, what); + R_DEV__(ps) = ix; + } + else if (streql(what, "pty")) { + if (!isString(value) || LENGTH(value) < 1) + par_error(what); + cx = CHAR(STRING_ELT(value, 0))[0]; + if (cx == 'm' || cx == 's') { + R_DEV__(pty) = cx; + R_DEV__(defaultPlot) = TRUE; + } + else par_error(what); + } + /* -- */ + else if (streql(what, "usr")) { + value = coerceVector(value, REALSXP); + lengthCheck(what, value, 4); + naRealCheck(REAL(value)[0], what); + naRealCheck(REAL(value)[1], what); + naRealCheck(REAL(value)[2], what); + naRealCheck(REAL(value)[3], what); + if (REAL(value)[0] == REAL(value)[1] || + REAL(value)[2] == REAL(value)[3]) + par_error(what); + if (gpptr(dd)->xlog) { + R_DEV_2(logusr[0]) = REAL(value)[0]; + R_DEV_2(logusr[1]) = REAL(value)[1]; + R_DEV_2(usr[0]) = Rexp10(REAL(value)[0]); + R_DEV_2(usr[1]) = Rexp10(REAL(value)[1]); + } + else { + R_DEV_2(usr[0]) = REAL(value)[0]; + R_DEV_2(usr[1]) = REAL(value)[1]; + R_DEV_2(logusr[0]) = R_Log10(REAL(value)[0]); + R_DEV_2(logusr[1]) = R_Log10(REAL(value)[1]); + } + if (gpptr(dd)->ylog) { + R_DEV_2(logusr[2]) = REAL(value)[2]; + R_DEV_2(logusr[3]) = REAL(value)[3]; + R_DEV_2(usr[2]) = Rexp10(REAL(value)[2]); + R_DEV_2(usr[3]) = Rexp10(REAL(value)[3]); + } + else { + R_DEV_2(usr[2]) = REAL(value)[2]; + R_DEV_2(usr[3]) = REAL(value)[3]; + R_DEV_2(logusr[2]) = R_Log10(REAL(value)[2]); + R_DEV_2(logusr[3]) = R_Log10(REAL(value)[3]); + } + /* Reset Mapping and Axis Parameters */ + GMapWin2Fig(dd); + GSetupAxis(1, dd); + GSetupAxis(2, dd); + }/* usr */ + + else if (streql(what, "xlog")) { + lengthCheck(what, value, 1); ix = asLogical(value); + if (ix == NA_LOGICAL) + par_error(what); + R_DEV__(xlog) = (ix != 0); + } + else if (streql(what, "ylog")) { + lengthCheck(what, value, 1); ix = asLogical(value); + if (ix == NA_LOGICAL) + par_error(what); + R_DEV__(ylog) = (ix != 0); + } + else if (streql(what, "ylbias")) { + lengthCheck(what, value, 1); + dd->dev->yLineBias = asReal(value); + } + /* We do not need these as Query will already have warned. + else if (streql(what, "type")) { + warning(_("graphical parameter \"%s\" is obsolete"), what); + } + else warning(_("unknown graphical parameter \"%s\""), what); + */ + + return; +} /* Specify */ + + +/* Specify2 -- parameters as arguments from higher-level graphics functions + * -------- + * Many things in PARALLEL to Specify(.) + * for par()s not valid here, see comment there. + */ +#undef R_DEV_2 +#undef R_DEV__ +/* Now defined differently in Specify2() : */ +#define R_DEV__(_P_) gpptr(dd)->_P_ + +static void Specify2(const char *what, SEXP value, pGEDevDesc dd) +{ + double x; + int ix = 0, ptype = ParCode(what); + char cx = '\0'; + + if (ptype == 1 || ptype == -3) { + /* 1: these are valid, but not settable inline + 3: arguments, not pars + */ + return; + } + if (ptype == -2) { + warning(_("graphical parameter \"%s\" is obsolete"), what); + return; + } + if (ptype < 0) { + warning(_("\"%s\" is not a graphical parameter"), what); + return; + } + if (ptype == 2) { + warning(_("graphical parameter \"%s\" cannot be set"), what); + return; + } + +#include "par-common.c" +} /* Specify2 */ + + +/* Do NOT forget to update ../library/base/R/par.R */ +/* if you ADD a NEW par !! */ + +static SEXP Query(const char *what, pGEDevDesc dd) +{ + SEXP value; + + if (streql(what, "adj")) { + value = allocVector(REALSXP, 1); + REAL(value)[0] = dpptr(dd)->adj; + } + else if (streql(what, "ann")) { + value = allocVector(LGLSXP, 1); + LOGICAL(value)[0] = (dpptr(dd)->ann != 0); + } + else if (streql(what, "ask")) { + value = allocVector(LGLSXP, 1); + LOGICAL(value)[0] = dd->ask; + } + else if (streql(what, "bg")) { + value = mkString(col2name(dpptr(dd)->bg)); + } + else if (streql(what, "bty")) { + char buf[2]; + buf[0] = dpptr(dd)->bty; + buf[1] = '\0'; + value = mkString(buf); + } + else if (streql(what, "cex")) { + value = allocVector(REALSXP, 1); + REAL(value)[0] = dpptr(dd)->cexbase; + } + else if (streql(what, "cex.main")) { + value = allocVector(REALSXP, 1); + REAL(value)[0] = dpptr(dd)->cexmain; + } + else if (streql(what, "cex.lab")) { + value = allocVector(REALSXP, 1); + REAL(value)[0] = dpptr(dd)->cexlab; + } + else if (streql(what, "cex.sub")) { + value = allocVector(REALSXP, 1); + REAL(value)[0] = dpptr(dd)->cexsub; + } + else if (streql(what, "cex.axis")) { + value = allocVector(REALSXP, 1); + REAL(value)[0] = dpptr(dd)->cexaxis; + } + else if (streql(what, "cin")) { + value = allocVector(REALSXP, 2); + REAL(value)[0] = dpptr(dd)->scale * dd->dev->cra[0] * dd->dev->ipr[0]; + REAL(value)[1] = dpptr(dd)->scale * dd->dev->cra[1] * dd->dev->ipr[1]; + } + else if (streql(what, "col")) { + value = mkString(col2name(dpptr(dd)->col)); + } + else if (streql(what, "col.main")) { + value = mkString(col2name(dpptr(dd)->colmain)); + } + else if (streql(what, "col.lab")) { + value = mkString(col2name(dpptr(dd)->collab)); + } + else if (streql(what, "col.sub")) { + value = mkString(col2name(dpptr(dd)->colsub)); + } + else if (streql(what, "col.axis")) { + value = mkString(col2name(dpptr(dd)->colaxis)); + } + else if (streql(what, "cra")) { + value = allocVector(REALSXP, 2); + REAL(value)[0] = dpptr(dd)->scale * dd->dev->cra[0]; + REAL(value)[1] = dpptr(dd)->scale * dd->dev->cra[1]; + } + else if (streql(what, "crt")) { + value = allocVector(REALSXP, 1); + REAL(value)[0] = dpptr(dd)->crt; + } + else if (streql(what, "csi")) { + value = allocVector(REALSXP, 1); + REAL(value)[0] = GConvertYUnits(1.0, CHARS, INCHES, dd); + } + else if (streql(what, "cxy")) { + value = allocVector(REALSXP, 2); + /* == par("cin") / par("pin") : */ + REAL(value)[0] = dpptr(dd)->scale * dd->dev->cra[0] + * dd->dev->ipr[0] / dpptr(dd)->pin[0] + * (dpptr(dd)->usr[1] - dpptr(dd)->usr[0]); + REAL(value)[1] = dpptr(dd)->scale * dd->dev->cra[1] + * dd->dev->ipr[1] / dpptr(dd)->pin[1] + * (dpptr(dd)->usr[3] - dpptr(dd)->usr[2]); + } + else if (streql(what, "din")) { + value = allocVector(REALSXP, 2); + REAL(value)[0] = GConvertXUnits(1.0, NDC, INCHES, dd); + REAL(value)[1] = GConvertYUnits(1.0, NDC, INCHES, dd); + } + else if (streql(what, "err")) { + value = allocVector(INTSXP, 1); + INTEGER(value)[0] = dpptr(dd)->err; + } + else if (streql(what, "family")) { + value = mkString(dpptr(dd)->family); + } + else if (streql(what, "fg")) { + value = mkString(col2name(dpptr(dd)->fg)); + } + else if (streql(what, "fig")) { + value = allocVector(REALSXP, 4); + REAL(value)[0] = dpptr(dd)->fig[0]; + REAL(value)[1] = dpptr(dd)->fig[1]; + REAL(value)[2] = dpptr(dd)->fig[2]; + REAL(value)[3] = dpptr(dd)->fig[3]; + } + else if (streql(what, "fin")) { + value = allocVector(REALSXP, 2); + REAL(value)[0] = dpptr(dd)->fin[0]; + REAL(value)[1] = dpptr(dd)->fin[1]; + } + else if (streql(what, "font")) { + value = allocVector(INTSXP, 1); + INTEGER(value)[0] = dpptr(dd)->font; + } + else if (streql(what, "font.main")) { + value = allocVector(INTSXP, 1); + INTEGER(value)[0] = dpptr(dd)->fontmain; + } + else if (streql(what, "font.lab")) { + value = allocVector(INTSXP, 1); + INTEGER(value)[0] = dpptr(dd)->fontlab; + } + else if (streql(what, "font.sub")) { + value = allocVector(INTSXP, 1); + INTEGER(value)[0] = dpptr(dd)->fontsub; + } + else if (streql(what, "font.axis")) { + value = allocVector(INTSXP, 1); + INTEGER(value)[0] = dpptr(dd)->fontaxis; + } + else if (streql(what, "lab")) { + value = allocVector(INTSXP, 3); + INTEGER(value)[0] = dpptr(dd)->lab[0]; + INTEGER(value)[1] = dpptr(dd)->lab[1]; + INTEGER(value)[2] = dpptr(dd)->lab[2]; + } + else if (streql(what, "las")) { + value = allocVector(INTSXP, 1); + INTEGER(value)[0] = dpptr(dd)->las; + } + else if (streql(what, "lend")) { + value = GE_LENDget(dpptr(dd)->lend); + } + else if (streql(what, "lheight")) { + value = allocVector(REALSXP, 1); + REAL(value)[0] = dpptr(dd)->lheight; + } + else if (streql(what, "ljoin")) { + value = GE_LJOINget(dpptr(dd)->ljoin); + } + else if (streql(what, "lmitre")) { + value = allocVector(REALSXP, 1); + REAL(value)[0] = dpptr(dd)->lmitre; + } + else if (streql(what, "lty")) { + value = GE_LTYget(dpptr(dd)->lty); + } + else if (streql(what, "lwd")) { + value = allocVector(REALSXP, 1); + REAL(value)[0] = dpptr(dd)->lwd; + } + else if (streql(what, "mai")) { + value = allocVector(REALSXP, 4); + REAL(value)[0] = dpptr(dd)->mai[0]; + REAL(value)[1] = dpptr(dd)->mai[1]; + REAL(value)[2] = dpptr(dd)->mai[2]; + REAL(value)[3] = dpptr(dd)->mai[3]; + } + else if (streql(what, "mar")) { + value = allocVector(REALSXP, 4); + REAL(value)[0] = dpptr(dd)->mar[0]; + REAL(value)[1] = dpptr(dd)->mar[1]; + REAL(value)[2] = dpptr(dd)->mar[2]; + REAL(value)[3] = dpptr(dd)->mar[3]; + } + else if (streql(what, "mex")) { + value = allocVector(REALSXP, 1); + REAL(value)[0] = dpptr(dd)->mex; + } + /* NOTE that if a complex layout has been specified */ + /* then this simple information may not be very useful. */ + else if (streql(what, "mfrow") || streql(what, "mfcol")) { + value = allocVector(INTSXP, 2); + INTEGER(value)[0] = dpptr(dd)->numrows; + INTEGER(value)[1] = dpptr(dd)->numcols; + } + else if (streql(what, "mfg")) { + int row, col; + value = allocVector(INTSXP, 4); + currentFigureLocation(&row, &col, dd); + INTEGER(value)[0] = row+1; + INTEGER(value)[1] = col+1; + INTEGER(value)[2] = dpptr(dd)->numrows; + INTEGER(value)[3] = dpptr(dd)->numcols; + } + else if (streql(what, "mgp")) { + value = allocVector(REALSXP, 3); + REAL(value)[0] = dpptr(dd)->mgp[0]; + REAL(value)[1] = dpptr(dd)->mgp[1]; + REAL(value)[2] = dpptr(dd)->mgp[2]; + } + else if (streql(what, "mkh")) { + /* Unused in R, but settable */ + value = allocVector(REALSXP, 1); + REAL(value)[0] = dpptr(dd)->mkh; + } + else if (streql(what, "new")) { + value = allocVector(LGLSXP, 1); + LOGICAL(value)[0] = dpptr(dd)->new; + } + else if (streql(what, "oma")) { + value = allocVector(REALSXP, 4); + REAL(value)[0] = dpptr(dd)->oma[0]; + REAL(value)[1] = dpptr(dd)->oma[1]; + REAL(value)[2] = dpptr(dd)->oma[2]; + REAL(value)[3] = dpptr(dd)->oma[3]; + } + else if (streql(what, "omd")) { + value = allocVector(REALSXP, 4); + REAL(value)[0] = dpptr(dd)->omd[0]; + REAL(value)[1] = dpptr(dd)->omd[1]; + REAL(value)[2] = dpptr(dd)->omd[2]; + REAL(value)[3] = dpptr(dd)->omd[3]; + } + else if (streql(what, "omi")) { + value = allocVector(REALSXP, 4); + REAL(value)[0] = dpptr(dd)->omi[0]; + REAL(value)[1] = dpptr(dd)->omi[1]; + REAL(value)[2] = dpptr(dd)->omi[2]; + REAL(value)[3] = dpptr(dd)->omi[3]; + } + else if (streql(what, "page")) { + /* This calculation mimics the decision-making in GNewPlot() + * in graphics.c SO it MUST be kept in synch with the logic there + */ + value = allocVector(LGLSXP, 1); + LOGICAL(value)[0] = 0; + if (dpptr(dd)->new) { + if (!dpptr(dd)->state) + LOGICAL(value)[0] = 1; + } else { + if (dpptr(dd)->currentFigure + 1 > dpptr(dd)->lastFigure) + LOGICAL(value)[0] = 1; + } + } + else if (streql(what, "pch")) { + int val = dpptr(dd)->pch; + /* we need to be careful that par("pch") is converted back + to the same value */ + if (known_to_be_latin1 && val <= -32 && val >= -255) val = -val; + if(val >= ' ' && val <= (mbcslocale ? 127 : 255)) { + char buf[2]; + buf[0] = (char) val; + buf[1] = '\0'; + value = mkString(buf); + } else { + /* Could return as UTF-8 string */ + value = ScalarInteger(val); + } + } + else if (streql(what, "pin")) { + value = allocVector(REALSXP, 2); + REAL(value)[0] = dpptr(dd)->pin[0]; + REAL(value)[1] = dpptr(dd)->pin[1]; + } + else if (streql(what, "plt")) { + value = allocVector(REALSXP, 4); + REAL(value)[0] = dpptr(dd)->plt[0]; + REAL(value)[1] = dpptr(dd)->plt[1]; + REAL(value)[2] = dpptr(dd)->plt[2]; + REAL(value)[3] = dpptr(dd)->plt[3]; + } + else if (streql(what, "ps")) { + value = allocVector(INTSXP, 1); + /* was reporting unscaled prior to 2.7.0 */ + INTEGER(value)[0] = (int)(dpptr(dd)->ps * dpptr(dd)->scale); + } + else if (streql(what, "pty")) { + char buf[2]; + buf[0] = dpptr(dd)->pty; + buf[1] = '\0'; + value = mkString(buf); + } + else if (streql(what, "smo")) { + value = allocVector(REALSXP, 1); + REAL(value)[0] = dpptr(dd)->smo; + } + else if (streql(what, "srt")) { + value = allocVector(REALSXP, 1); + REAL(value)[0] = dpptr(dd)->srt; + } + else if (streql(what, "tck")) { + value = allocVector(REALSXP, 1); + REAL(value)[0] = dpptr(dd)->tck; + } + else if (streql(what, "tcl")) { + value = allocVector(REALSXP, 1); + REAL(value)[0] = dpptr(dd)->tcl; + } + else if (streql(what, "usr")) { + value = allocVector(REALSXP, 4); + if (gpptr(dd)->xlog) { + REAL(value)[0] = gpptr(dd)->logusr[0]; + REAL(value)[1] = gpptr(dd)->logusr[1]; + } + else { + REAL(value)[0] = dpptr(dd)->usr[0]; + REAL(value)[1] = dpptr(dd)->usr[1]; + } + if (gpptr(dd)->ylog) { + REAL(value)[2] = gpptr(dd)->logusr[2]; + REAL(value)[3] = gpptr(dd)->logusr[3]; + } + else { + REAL(value)[2] = dpptr(dd)->usr[2]; + REAL(value)[3] = dpptr(dd)->usr[3]; + } + } + else if (streql(what, "xaxp")) { + value = allocVector(REALSXP, 3); + REAL(value)[0] = dpptr(dd)->xaxp[0]; + REAL(value)[1] = dpptr(dd)->xaxp[1]; + REAL(value)[2] = dpptr(dd)->xaxp[2]; + } + else if (streql(what, "xaxs")) { + char buf[2]; + buf[0] = dpptr(dd)->xaxs; + buf[1] = '\0'; + value = mkString(buf); + } + else if (streql(what, "xaxt")) { + char buf[2]; + buf[0] = dpptr(dd)->xaxt; + buf[1] = '\0'; + value = mkString(buf); + } + else if (streql(what, "xlog")) { + value = allocVector(LGLSXP, 1); + LOGICAL(value)[0] = dpptr(dd)->xlog; + } + else if (streql(what, "xpd")) { + value = allocVector(LGLSXP, 1); + if (dpptr(dd)->xpd == 2) + LOGICAL(value)[0] = NA_LOGICAL; + else + LOGICAL(value)[0] = dpptr(dd)->xpd; + } + else if (streql(what, "yaxp")) { + value = allocVector(REALSXP, 3); + REAL(value)[0] = dpptr(dd)->yaxp[0]; + REAL(value)[1] = dpptr(dd)->yaxp[1]; + REAL(value)[2] = dpptr(dd)->yaxp[2]; + } + else if (streql(what, "yaxs")) { + char buf[2]; + buf[0] = dpptr(dd)->yaxs; + buf[1] = '\0'; + value = mkString(buf); + } + else if (streql(what, "yaxt")) { + char buf[2]; + buf[0] = dpptr(dd)->yaxt; + buf[1] = '\0'; + value = mkString(buf); + } + else if (streql(what, "ylbias")) { + value = allocVector(REALSXP, 1); + REAL(value)[0] = dd->dev->yLineBias; + } + else if (streql(what, "ylog")) { + value = allocVector(LGLSXP, 1); + LOGICAL(value)[0] = dpptr(dd)->ylog; + } + else if (ParCode(what) == -2) { + warning(_("graphical parameter \"%s\" is obsolete"), what); + value = R_NilValue; + } + else { + warning(_("\"%s\" is not a graphical parameter"), what); + value = R_NilValue; + } + return value; +} + +SEXP C_par(SEXP call, SEXP op, SEXP args, SEXP rho) +{ + SEXP value; + SEXP originalArgs = args; + pGEDevDesc dd; + int new_spec, nargs; + + args = CDR(args); + + dd = GEcurrentDevice(); + new_spec = 0; + args = CAR(args); + nargs = length(args); + if (isNewList(args)) { + SEXP oldnames, newnames, tag, val; + int i; + PROTECT(newnames = allocVector(STRSXP, nargs)); + PROTECT(value = allocVector(VECSXP, nargs)); + oldnames = getAttrib(args, R_NamesSymbol); + for (i = 0 ; i < nargs ; i++) { + if (oldnames != R_NilValue) + tag = STRING_ELT(oldnames, i); + else + tag = R_NilValue; + val = VECTOR_ELT(args, i); + /* tags are all ASCII */ + if (tag != R_NilValue && CHAR(tag)[0]) { + new_spec = 1; + SET_VECTOR_ELT(value, i, Query(CHAR(tag), dd)); + SET_STRING_ELT(newnames, i, tag); + Specify(CHAR(tag), val, dd); + } + else if (isString(val) && length(val) > 0) { + tag = STRING_ELT(val, 0); + if (tag != R_NilValue && CHAR(tag)[0]) { + SET_VECTOR_ELT(value, i, Query(CHAR(tag), dd)); + SET_STRING_ELT(newnames, i, tag); + } + } + else { + SET_VECTOR_ELT(value, i, R_NilValue); + SET_STRING_ELT(newnames, i, R_BlankString); + } + } + setAttrib(value, R_NamesSymbol, newnames); + } + else { + error(_("invalid argument passed to par()")); + return R_NilValue/* -Wall */; + } + /* should really only do this if specifying new pars ? yes! [MM] */ + + if (new_spec && GRecording(call, dd)) + GErecordGraphicOperation(op, originalArgs, dd); + + UNPROTECT(2); + return value; +} + +/* + * Layout was written by Paul Murrell during 1997-1998 as a partial + * implementation of ideas in his PhD thesis. The orginal was + * written in common lisp provides rather more general capabilities. + * + * layout( + * num.rows, + * num.cols, + * mat, + * num.figures, + * col.widths, + * row.heights, + * cm.widths, + * cm.heights, + * respect, + * respect.mat + * ) + */ + +SEXP C_layout(SEXP args) +{ + int i, j, nrow, ncol, ncmrow, ncmcol; + pGEDevDesc dd; + + args = CDR(args); + + dd = GEcurrentDevice(); + + /* num.rows: */ + nrow = dpptr(dd)->numrows = gpptr(dd)->numrows = + INTEGER(CAR(args))[0]; + if (nrow > MAX_LAYOUT_ROWS) + error(_("too many rows in layout, limit %d"), MAX_LAYOUT_ROWS); + args = CDR(args); + /* num.cols: */ + ncol = dpptr(dd)->numcols = gpptr(dd)->numcols = + INTEGER(CAR(args))[0]; + if (ncol > MAX_LAYOUT_COLS) + error(_("too many columns in layout, limit %d"), MAX_LAYOUT_COLS); + if (nrow * ncol > MAX_LAYOUT_CELLS) + error(_("too many cells in layout, limit %d"), MAX_LAYOUT_CELLS); + args = CDR(args); + /* mat[i,j] == order[i+j*nrow] : */ + for (i = 0; i < nrow * ncol; i++) + dpptr(dd)->order[i] = gpptr(dd)->order[i] = + (unsigned short) INTEGER(CAR(args))[i]; + args = CDR(args); + + /* num.figures: */ + dpptr(dd)->currentFigure = gpptr(dd)->currentFigure = + dpptr(dd)->lastFigure = gpptr(dd)->lastFigure = + INTEGER(CAR(args))[0]; + args = CDR(args); + /* col.widths: */ + for (j = 0; j < ncol; j++) + dpptr(dd)->widths[j] = gpptr(dd)->widths[j] = + REAL(CAR(args))[j]; + args = CDR(args); + /* row.heights: */ + for (i = 0; i < nrow; i++) + dpptr(dd)->heights[i] = gpptr(dd)->heights[i] = + REAL(CAR(args))[i]; + args = CDR(args); + /* cm.widths: */ + ncmcol = length(CAR(args)); + for (j = 0; j < ncol; j++) + dpptr(dd)->cmWidths[j] = gpptr(dd)->cmWidths[j] = 0; + for (j = 0; j < ncmcol; j++) { + dpptr(dd)->cmWidths[INTEGER(CAR(args))[j] - 1] + = gpptr(dd)->cmWidths[INTEGER(CAR(args))[j] - 1] + = 1; + } + args = CDR(args); + /* cm.heights: */ + ncmrow = length(CAR(args)); + for (i = 0; i < nrow; i++) + dpptr(dd)->cmHeights[i] = gpptr(dd)->cmHeights[i] = 0; + for (i = 0; i < ncmrow; i++) { + dpptr(dd)->cmHeights[INTEGER(CAR(args))[i] - 1] + = gpptr(dd)->cmHeights[INTEGER(CAR(args))[i]-1] + = 1; + } + args = CDR(args); + /* respect = 0 (FALSE), 1 (TRUE), or 2 (matrix) : */ + dpptr(dd)->rspct = gpptr(dd)->rspct = INTEGER(CAR(args))[0]; + args = CDR(args); + /* respect.mat */ + for (i = 0; i < nrow * ncol; i++) + dpptr(dd)->respect[i] = gpptr(dd)->respect[i] + = (unsigned char)INTEGER(CAR(args))[i]; + + /*------------------------------------------------------*/ + + if (nrow > 2 || ncol > 2) { + gpptr(dd)->cexbase = dpptr(dd)->cexbase = 0.66; + gpptr(dd)->mex = dpptr(dd)->mex = 1.0; + } + else if (nrow == 2 && ncol == 2) { + gpptr(dd)->cexbase = dpptr(dd)->cexbase = 0.83; + gpptr(dd)->mex = dpptr(dd)->mex = 1.0; + } + else { + gpptr(dd)->cexbase = dpptr(dd)->cexbase = 1.0; + gpptr(dd)->mex = dpptr(dd)->mex = 1.0; + } + + dpptr(dd)->defaultFigure = gpptr(dd)->defaultFigure = TRUE; + dpptr(dd)->layout = gpptr(dd)->layout = TRUE; + + GReset(dd); + + return R_NilValue; +} + + +/* ProcessInLinePars handles inline par specifications + in graphics functions. */ + +void ProcessInlinePars(SEXP s, pGEDevDesc dd) +{ + if (isList(s)) { + while (s != R_NilValue) { + if (isList(CAR(s))) + ProcessInlinePars(CAR(s), dd); + else if (TAG(s) != R_NilValue) + Specify2(CHAR(PRINTNAME(TAG(s))), CAR(s), dd); + s = CDR(s); + } + } +} + + + +/*= Local Variables: **/ +/*= mode: C **/ +/*= kept-old-versions: 12 **/ +/*= kept-new-versions: 30 **/ +/*= End: **/ diff --git a/com.oracle.truffle.r.native/gnur/patch/src/library/graphics/src/plot.c b/com.oracle.truffle.r.native/gnur/patch/src/library/graphics/src/plot.c new file mode 100644 index 0000000000000000000000000000000000000000..d2327dd426b2f212bd52344d8281ca7d75621868 --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/library/graphics/src/plot.c @@ -0,0 +1,4094 @@ +/* + * R : A Computer Language for Statistical Data Analysis + * Copyright (C) 1995, 1996 Robert Gentleman and Ross Ihaka + * Copyright (C) 1997--2014 The R Core Team + * Copyright (C) 2002--2009 The R Foundation + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version. + * + * This program 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 this program; if not, a copy is available at + * https://www.R-project.org/Licenses/ + */ + +#ifdef HAVE_CONFIG_H +# include <config.h> +#endif + +#include <Defn.h> +#include <float.h> /* for DBL_MAX */ +#include <Graphics.h> +#include <Print.h> +#include <Rmath.h> // Rexp10, fmin2, fmax2, imax2 + +#include "graphics.h" + +static R_INLINE void TypeCheck(SEXP s, SEXPTYPE type) +{ + if (TYPEOF(s) != type) + error("invalid type passed to graphics function"); +} + + +/* + * Is element i of a colour object NA (or NULL)? + */ +Rboolean isNAcol(SEXP col, int index, int ncol) +{ + Rboolean result = TRUE; /* -Wall */ + + if (isNull(col)) + result = TRUE; + else { + if (isLogical(col)) + result = LOGICAL(col)[index % ncol] == NA_LOGICAL; + else if (isString(col)) + result = strcmp(CHAR(STRING_ELT(col, index % ncol)), "NA") == 0; + else if (isInteger(col)) + result = INTEGER(col)[index % ncol] == NA_INTEGER; + else if (isReal(col)) + result = !R_FINITE(REAL(col)[index % ncol]); + else + error(_("invalid color specification")); + } + return result; +} + + +/* P A R A M E T E R U T I L I T I E S */ + +/* + * Extract specified par from list of inline pars + */ +static SEXP getInlinePar(SEXP s, char *name) +{ + SEXP result = R_NilValue; + int found = 0; + if (isList(s) && !found) { + while (s != R_NilValue) { + if (isList(CAR(s))) { + result = getInlinePar(CAR(s), name); + if (result) + found = 1; + } else + if (TAG(s) != R_NilValue) + if (!strcmp(CHAR(PRINTNAME(TAG(s))), name)) { + result = CAR(s); + found = 1; + } + s = CDR(s); + } + } + return result; +} + +/* dflt used to be used for < 0 values in R < 2.7.0, + now just used for NULL */ +static SEXP FixupPch(SEXP pch, int dflt) +{ + int i, n; + SEXP ans = R_NilValue;/* -Wall*/ + + n = length(pch); + if (n == 0) return ans = ScalarInteger(dflt); + + PROTECT(ans = allocVector(INTSXP, n)); + if (isList(pch)) { + for (i = 0; pch != R_NilValue; pch = CDR(pch)) + INTEGER(ans)[i++] = asInteger(CAR(pch)); + } + else if (isInteger(pch)) { + for (i = 0; i < n; i++) + INTEGER(ans)[i] = INTEGER(pch)[i]; + } + else if (isReal(pch)) { + for (i = 0; i < n; i++) + INTEGER(ans)[i] = R_FINITE(REAL(pch)[i]) ? + (int) REAL(pch)[i] : NA_INTEGER; + } + else if (isString(pch)) { + for (i = 0; i < n; i++) { + /* New in 2.7.0: negative values indicate Unicode points. */ + INTEGER(ans)[i] = GEstring_to_pch(STRING_ELT(pch, i)); + } + } + else if (isLogical(pch)) {/* NA, but not TRUE/FALSE */ + for (i = 0; i < n; i++) + if(LOGICAL(pch)[i] == NA_LOGICAL) INTEGER(ans)[i] = NA_INTEGER; + else error(_("only NA allowed in logical plotting symbol")); + } + else error(_("invalid plotting symbol")); + UNPROTECT(1); + return ans; +} + +SEXP FixupLty(SEXP lty, int dflt) +{ + int i, n; + SEXP ans; + n = length(lty); + if (n == 0) { + ans = ScalarInteger(dflt); + } + else { + ans = allocVector(INTSXP, n); + for (i = 0; i < n; i++) + INTEGER(ans)[i] = GE_LTYpar(lty, i); + } + return ans; +} + +SEXP FixupLwd(SEXP lwd, double dflt) +{ + int i, n; + double w; + SEXP ans = NULL; + + n = length(lwd); + if (n == 0) + ans = ScalarReal(dflt); + else { + PROTECT(lwd = coerceVector(lwd, REALSXP)); + n = length(lwd); + ans = allocVector(REALSXP, n); + for (i = 0; i < n; i++) { + w = REAL(lwd)[i]; + if (w < 0) w = NA_REAL; + REAL(ans)[i] = w; + + } + UNPROTECT(1); + } + return ans; +} + +static SEXP FixupFont(SEXP font, int dflt) +{ + int i, k, n; + SEXP ans = R_NilValue;/* -Wall*/ + n = length(font); + if (n == 0) { + ans = ScalarInteger(dflt); + } + else if (isLogical(font)) { + ans = allocVector(INTSXP, n); + for (i = 0; i < n; i++) { + k = LOGICAL(font)[i]; +#ifndef Win32 + if (k < 1 || k > 5) k = NA_INTEGER; +#else + if (k < 1 || k > 32) k = NA_INTEGER; +#endif + INTEGER(ans)[i] = k; + } + } + else if (isInteger(font)) { + ans = allocVector(INTSXP, n); + for (i = 0; i < n; i++) { + k = INTEGER(font)[i]; +#ifndef Win32 + if (k < 1 || k > 5) k = NA_INTEGER; +#else + if (k < 1 || k > 32) k = NA_INTEGER; +#endif + INTEGER(ans)[i] = k; + } + } + else if (isReal(font)) { + ans = allocVector(INTSXP, n); + for (i = 0; i < n; i++) { + k = (int) REAL(font)[i]; +#ifndef Win32 + if (k < 1 || k > 5) k = NA_INTEGER; +#else + if (k < 1 || k > 32) k = NA_INTEGER; +#endif + INTEGER(ans)[i] = k; + } + } + else error(_("invalid font specification")); + return ans; +} + +SEXP FixupCol(SEXP col, unsigned int dflt) +{ + int i, n; + SEXP ans; + unsigned int bg = dpptr(GEcurrentDevice())->bg; /* col = 0 */ + + n = length(col); + if (n == 0) { + PROTECT(ans = ScalarInteger(dflt)); + } else { + ans = PROTECT(allocVector(INTSXP, n)); + if (isList(col)) + for (i = 0; i < n; i++) { + INTEGER(ans)[i] = RGBpar3(CAR(col), 0, bg); + col = CDR(col); + } + else + for (i = 0; i < n; i++) + INTEGER(ans)[i] = RGBpar3(col, i, bg); + } + UNPROTECT(1); + return ans; +} + +static SEXP FixupCex(SEXP cex, double dflt) +{ + SEXP ans; + int i, n; + n = length(cex); + if (n == 0) { + ans = allocVector(REALSXP, 1); + if (R_FINITE(dflt) && dflt > 0) + REAL(ans)[0] = dflt; + else + REAL(ans)[0] = NA_REAL; + } + else { + double c; + ans = allocVector(REALSXP, n); + if (isReal(cex)) + for (i = 0; i < n; i++) { + c = REAL(cex)[i]; + if (R_FINITE(c) && c > 0) + REAL(ans)[i] = c; + else + REAL(ans)[i] = NA_REAL; + } + else if (isInteger(cex) || isLogical(cex)) + for (i = 0; i < n; i++) { + c = INTEGER(cex)[i]; + if (c == NA_INTEGER || c <= 0) + c = NA_REAL; + REAL(ans)[i] = c; + } + else + error(_("invalid '%s' value"), "cex"); + } + return ans; +} + +SEXP FixupVFont(SEXP vfont) { + SEXP ans = R_NilValue; + if (!isNull(vfont)) { + SEXP vf; + int typeface, fontindex; + int minindex, maxindex=0;/* -Wall*/ + int i; + PROTECT(vf = coerceVector(vfont, INTSXP)); + if (length(vf) != 2) + error(_("invalid '%s' value"), "vfont"); + typeface = INTEGER(vf)[0]; + if (typeface < 1 || typeface > 8) + error(_("invalid 'vfont' value [typeface %d]"), typeface); + /* For each of the typefaces {1..8}, there are several fontindices + available; how many depends on the typeface. + The possible combinations are "given" in ./g_fontdb.c + and also listed in help(Hershey). + */ + minindex = 1; + switch (typeface) { + case 1: /* serif */ + maxindex = 7; break; + case 2: /* sans serif */ + case 7: /* serif symbol */ + maxindex = 4; break; + case 3: /* script */ + maxindex = 3; break; + case 4: /* gothic english */ + case 5: /* gothic german */ + case 6: /* gothic italian */ + maxindex = 1; break; + case 8: /* sans serif symbol */ + maxindex = 2; + } + fontindex = INTEGER(vf)[1]; + if (fontindex < minindex || fontindex > maxindex) + error(_("invalid 'vfont' value [typeface = %d, fontindex = %d]"), + typeface, fontindex); + ans = allocVector(INTSXP, 2); + for (i = 0; i < 2; i++) INTEGER(ans)[i] = INTEGER(vf)[i]; + UNPROTECT(1); + } + return ans; +} + + +/* GetTextArg() : extract and possibly set text arguments + * ("label", col=, cex=, font=) + * + * Main purpose: Treat things like title(main = list("This Title", font= 4)) + * + * Called from Title() [only, currently] + */ +static void +GetTextArg(SEXP spec, SEXP *ptxt, rcolor *pcol, double *pcex, int *pfont) +{ + int i, n, font, colspecd; + rcolor col; + double cex; + SEXP txt, nms; + PROTECT_INDEX pi; + + txt = R_NilValue; + cex = NA_REAL; + col = R_TRANWHITE; + colspecd = 0; + font = NA_INTEGER; + /* It doesn't look as if this protection is needed */ + PROTECT_WITH_INDEX(txt, &pi); + + switch (TYPEOF(spec)) { + case LANGSXP: + case SYMSXP: + REPROTECT(txt = coerceVector(spec, EXPRSXP), pi); + break; + case VECSXP: + if (length(spec) == 0) { + *ptxt = R_NilValue; + } + else { + nms = getAttrib(spec, R_NamesSymbol); + if (nms == R_NilValue){ /* PR#1939 */ + txt = VECTOR_ELT(spec, 0); + if (TYPEOF(txt) == LANGSXP || TYPEOF(txt) == SYMSXP ) + REPROTECT(txt = coerceVector(txt, EXPRSXP), pi); + else if (!isExpression(txt)) + REPROTECT(txt = coerceVector(txt, STRSXP), pi); + } else { + n = length(nms); + for (i = 0; i < n; i++) { + if (!strcmp(CHAR(STRING_ELT(nms, i)), "cex")) { + cex = asReal(VECTOR_ELT(spec, i)); + } + else if (!strcmp(CHAR(STRING_ELT(nms, i)), "col")) { + SEXP colsxp = VECTOR_ELT(spec, i); + if (!isNAcol(colsxp, 0, LENGTH(colsxp))) { + col = asInteger(FixupCol(colsxp, R_TRANWHITE)); + colspecd = 1; + } + } + else if (!strcmp(CHAR(STRING_ELT(nms, i)), "font")) { + font = asInteger(FixupFont(VECTOR_ELT(spec, i), NA_INTEGER)); + } + else if (!strcmp(CHAR(STRING_ELT(nms, i)), "")) { + txt = VECTOR_ELT(spec, i); + if (TYPEOF(txt) == LANGSXP || TYPEOF(txt) == SYMSXP) + REPROTECT(txt = coerceVector(txt, EXPRSXP), pi); + else if (!isExpression(txt)) + REPROTECT(txt = coerceVector(txt, STRSXP), pi); + } + else error(_("invalid graphics parameter")); + } + } + } + break; + case STRSXP: + case EXPRSXP: + txt = spec; + break; + default: + REPROTECT(txt = coerceVector(spec, STRSXP), pi); + break; + } + UNPROTECT(1); + if (txt != R_NilValue) { + *ptxt = txt; + if (R_FINITE(cex)) *pcex = cex; + if (colspecd) *pcol = col; + if (font != NA_INTEGER) *pfont = font; + } +}/* GetTextArg */ + + + /* GRAPHICS FUNCTION ENTRY POINTS */ + +SEXP C_plot_new(SEXP call, SEXP op, SEXP args, SEXP rho) +{ + /* plot.new() - create a new plot "frame" */ + + pGEDevDesc dd; + + dd = GEcurrentDevice(); + /* + * If user is prompted before new page, user has opportunity + * to kill current device. GNewPlot returns (potentially new) + * current device. + */ + dd = GNewPlot(GRecording(call, dd)); + + dpptr(dd)->xlog = gpptr(dd)->xlog = FALSE; + dpptr(dd)->ylog = gpptr(dd)->ylog = FALSE; + + GScale(0.0, 1.0, 1, dd); + GScale(0.0, 1.0, 2, dd); + GMapWin2Fig(dd); + GSetState(1, dd); + + if (GRecording(call, dd)) + GErecordGraphicOperation(op, args, dd); + return R_NilValue; +} + + +/* + * SYNOPSIS + * + * plot.window(xlim, ylim, log="", asp=NA) + * + * DESCRIPTION + * + * This function sets up the world coordinates for a graphics + * window. Note that if asp is a finite positive value then + * the window is set up so that one data unit in the y direction + * is equal in length to one data unit in the x direction divided + * by asp. + * + * The special case asp == 1 produces plots where distances + * between points are represented accurately on screen. + * + * NOTE + * + * The use of asp can have weird effects when axis is an + * interpreted function. It has to be internal so that the + * full computation is captured in the display list. + */ + +SEXP C_plot_window(SEXP args) +{ + SEXP xlim, ylim, logarg; + double asp, xmin, xmax, ymin, ymax; + Rboolean logscale; + const char *p; + pGEDevDesc dd = GEcurrentDevice(); + + args = CDR(args); + if (length(args) < 3) + error(_("at least 3 arguments required")); + + xlim = CAR(args); + if (!isNumeric(xlim) || LENGTH(xlim) != 2) + error(_("invalid '%s' value"), "xlim"); + args = CDR(args); + + ylim = CAR(args); + if (!isNumeric(ylim) || LENGTH(ylim) != 2) + error(_("invalid '%s' value"), "ylim"); + args = CDR(args); + + logscale = FALSE; + logarg = CAR(args); + if (!isString(logarg)) + error(_("\"log=\" specification must be character")); + p = CHAR(STRING_ELT(logarg, 0)); + while (*p) { + switch (*p) { + case 'x': + dpptr(dd)->xlog = gpptr(dd)->xlog = logscale = TRUE; + break; + case 'y': + dpptr(dd)->ylog = gpptr(dd)->ylog = logscale = TRUE; + break; + default: + error(_("invalid \"log=%s\" specification"), p); + } + p++; + } + args = CDR(args); + + asp = (logscale) ? NA_REAL : asReal(CAR(args));; + args = CDR(args); + + /* This reads [xy]axs and lab, used in GScale */ + GSavePars(dd); + ProcessInlinePars(args, dd); + + if (isInteger(xlim)) { + if (INTEGER(xlim)[0] == NA_INTEGER || INTEGER(xlim)[1] == NA_INTEGER) + error(_("NAs not allowed in 'xlim'")); + xmin = INTEGER(xlim)[0]; + xmax = INTEGER(xlim)[1]; + } + else { + if (!R_FINITE(REAL(xlim)[0]) || !R_FINITE(REAL(xlim)[1])) + error(_("need finite 'xlim' values")); + xmin = REAL(xlim)[0]; + xmax = REAL(xlim)[1]; + } + if (isInteger(ylim)) { + if (INTEGER(ylim)[0] == NA_INTEGER || INTEGER(ylim)[1] == NA_INTEGER) + error(_("NAs not allowed in 'ylim'")); + ymin = INTEGER(ylim)[0]; + ymax = INTEGER(ylim)[1]; + } + else { + if (!R_FINITE(REAL(ylim)[0]) || !R_FINITE(REAL(ylim)[1])) + error(_("need finite 'ylim' values")); + ymin = REAL(ylim)[0]; + ymax = REAL(ylim)[1]; + } + if ((dpptr(dd)->xlog && (xmin < 0 || xmax < 0)) || + (dpptr(dd)->ylog && (ymin < 0 || ymax < 0))) + error(_("Logarithmic axis must have positive limits")); + + if (R_FINITE(asp) && asp > 0) { + double pin1, pin2, scale, xdelta, ydelta, xscale, yscale, xadd, yadd; + pin1 = GConvertXUnits(1.0, NPC, INCHES, dd); + pin2 = GConvertYUnits(1.0, NPC, INCHES, dd); + xdelta = fabs(xmax - xmin) / asp; + ydelta = fabs(ymax - ymin); + if(xdelta == 0.0 && ydelta == 0.0) { + /* We really do mean zero: small non-zero values work. + Mimic the behaviour of GScale for the x axis. */ + xadd = yadd = ((xmin == 0.0) ? 1 : 0.4) * asp; + xadd *= asp; + } else { + xscale = pin1 / xdelta; + yscale = pin2 / ydelta; + scale = (xscale < yscale) ? xscale : yscale; + xadd = .5 * (pin1 / scale - xdelta) * asp; + yadd = .5 * (pin2 / scale - ydelta); + } + if(xmax < xmin) xadd *= -1; + if(ymax < ymin) yadd *= -1; + GScale(xmin - xadd, xmax + xadd, 1, dd); + GScale(ymin - yadd, ymax + yadd, 2, dd); + } + else { /* asp <= 0 or not finite -- includes logscale ! */ + GScale(xmin, xmax, 1, dd); + GScale(ymin, ymax, 2, dd); + } + /* GScale set the [xy]axp parameters */ + GMapWin2Fig(dd); + GRestorePars(dd); + /* This has now clobbered the Rf_ggptr settings for coord system */ + return R_NilValue; +} + +static void GetAxisLimits(double left, double right, Rboolean logflag, double *low, double *high) +{ +/* Called from Axis() such as + * GetAxisLimits(gpptr(dd)->usr[0], gpptr(dd)->usr[1], &low, &high) + * + * Computes *low < left, right < *high (even if left=right) + */ + double eps; + if (logflag) { + left = log(left); + right = log(right); + } + if (left > right) {/* swap */ + eps = left; left = right; right = eps; + } + eps = right - left; + if (eps == 0.) + eps = 0.5 * FLT_EPSILON; + else + eps *= FLT_EPSILON; + *low = left - eps; + *high = right + eps; + + if (logflag) { + *low = exp(*low); + *high = exp(*high); + } +} + + +/* axis(side, at, labels, ...) */ + +SEXP labelformat(SEXP labels) +{ + /* format(labels): i.e. from numbers to strings */ + SEXP ans = R_NilValue;/* -Wall*/ + int i, n, w, d, e, wi, di, ei; + const char *strp; + n = length(labels); + R_print.digits = 7;/* maximally 7 digits -- ``burnt in''; + S-PLUS <= 5.x has about 6 + (but really uses single precision..) */ + switch(TYPEOF(labels)) { + case LGLSXP: + PROTECT(ans = allocVector(STRSXP, n)); + for (i = 0; i < n; i++) { + strp = EncodeLogical(LOGICAL(labels)[i], 0); + SET_STRING_ELT(ans, i, mkChar(strp)); + } + UNPROTECT(1); + break; + case INTSXP: + PROTECT(ans = allocVector(STRSXP, n)); + for (i = 0; i < n; i++) { + strp = EncodeInteger(INTEGER(labels)[i], 0); + SET_STRING_ELT(ans, i, mkChar(strp)); + } + UNPROTECT(1); + break; + case REALSXP: + formatReal(REAL(labels), n, &w, &d, &e, 0); + PROTECT(ans = allocVector(STRSXP, n)); + for (i = 0; i < n; i++) { + strp = EncodeReal0(REAL(labels)[i], 0, d, e, OutDec); + SET_STRING_ELT(ans, i, mkChar(strp)); + } + UNPROTECT(1); + break; + case CPLXSXP: + formatComplex(COMPLEX(labels), n, &w, &d, &e, &wi, &di, &ei, 0); + PROTECT(ans = allocVector(STRSXP, n)); + for (i = 0; i < n; i++) { + strp = EncodeComplex(COMPLEX(labels)[i], 0, d, e, 0, di, ei, + OutDec); + SET_STRING_ELT(ans, i, mkChar(strp)); + } + UNPROTECT(1); + break; + case STRSXP: + PROTECT(ans = allocVector(STRSXP, n)); + for (i = 0; i < n; i++) { + SET_STRING_ELT(ans, i, STRING_ELT(labels, i)); + } + UNPROTECT(1); + break; + default: + error(_("invalid type for axis labels")); + } + return ans; +} + + +static double ComputePAdjValue(double padj, int side, int las) +{ + if (!R_FINITE(padj)) { + switch(las) { + case 0:/* parallel to axis */ + padj = 0.0; break; + case 1:/* horizontal */ + switch(side) { + case 1: + case 3: padj = 0.0; break; + case 2: + case 4: padj = 0.5; break; + } + break; + case 2:/* perpendicular to axis */ + padj = 0.5; break; + case 3:/* vertical */ + switch(side) { + case 1: + case 3: padj = 0.5; break; + case 2: + case 4: padj = 0.0; break; + } + break; + } + } + return padj; +} + +static void getxlimits(double *x, pGEDevDesc dd) { + /* + * xpd = 0 means clip to current plot region + * xpd = 1 means clip to current figure region + * xpd = 2 means clip to device region + */ + switch (gpptr(dd)->xpd) { + case 0: + x[0] = gpptr(dd)->usr[0]; + x[1] = gpptr(dd)->usr[1]; + break; + case 1: + x[0] = GConvertX(0, NFC, USER, dd); + x[1] = GConvertX(1, NFC, USER, dd); + break; + case 2: + x[0] = GConvertX(0, NDC, USER, dd); + x[1] = GConvertX(1, NDC, USER, dd); + break; + } +} + +static void getylimits(double *y, pGEDevDesc dd) { + switch (gpptr(dd)->xpd) { + case 0: + y[0] = gpptr(dd)->usr[2]; + y[1] = gpptr(dd)->usr[3]; + break; + case 1: + y[0] = GConvertY(0, NFC, USER, dd); + y[1] = GConvertY(1, NFC, USER, dd); + break; + case 2: + y[0] = GConvertY(0, NDC, USER, dd); + y[1] = GConvertY(1, NDC, USER, dd); + break; + } +} + +SEXP C_axis(SEXP args) +{ + /* axis(side, at, labels, tick, line, pos, + outer, font, lty, lwd, lwd.ticks, col, col.ticks, + hadj, padj, ...) + */ + + SEXP at, lab, padj, label; + int font, lty, npadj; + rcolor col, colticks; + int i, n, nint = 0, ntmp, side, *ind, outer, lineoff = 0; + int istart, iend, incr; + Rboolean dolabels, doticks, logflag = FALSE; + Rboolean create_at; + double x, y, temp, tnew, tlast; + double axp[3], usr[2], limits[2]; + double gap, labw, low, high, line, pos, lwd, lwdticks, hadj; + double axis_base, axis_tick, axis_lab, axis_low, axis_high; + + pGEDevDesc dd = GEcurrentDevice(); + + /* Arity Check */ + /* This is a builtin function, so it should always have */ + /* the correct arity, but it doesn't hurt to be defensive. */ + + args = CDR(args); + if (length(args) < 15) + error(_("too few arguments")); + GCheckState(dd); + + PrintDefaults(); /* prepare for labelformat */ + + /* Required argument: "side" */ + /* Which side of the plot the axis is to appear on. */ + /* side = 1 | 2 | 3 | 4. */ + + side = asInteger(CAR(args)); + if (side < 1 || side > 4) + error(_("invalid axis number %d"), side); + args = CDR(args); + + /* Required argument: "at" */ + /* This gives the tick-label locations. */ + /* Note that these are coerced to the correct type below. */ + + at = CAR(args); args = CDR(args); + + /* Required argument: "labels" */ + /* Labels can be a logical, indicating whether or not */ + /* to label the axis; or it can be a vector of character */ + /* strings or expressions which give the labels explicitly. */ + /* The expressions are used to set mathematical labelling. */ + + dolabels = TRUE; + lab = CAR(args); + if (isLogical(lab) && length(lab) > 0) { + i = asLogical(lab); + if (i == 0 || i == NA_LOGICAL) + dolabels = FALSE; + PROTECT(lab = R_NilValue); + } else if (TYPEOF(lab) == LANGSXP || TYPEOF(lab) == SYMSXP) { + PROTECT(lab = coerceVector(lab, EXPRSXP)); + } else if (isExpression(lab)) { + PROTECT(lab); + } else { + PROTECT(lab = coerceVector(lab, STRSXP)); + } + args = CDR(args); + + /* Required argument: "tick" */ + /* This indicates whether or not ticks and the axis line */ + /* should be plotted: TRUE => show, FALSE => don't show. */ + + doticks = asLogical(CAR(args)); + doticks = (doticks == NA_LOGICAL) ? TRUE : (Rboolean) doticks; + args = CDR(args); + + /* Optional argument: "line" */ + + /* Specifies an offset outward from the plot for the axis. + * The values in the par value "mgp" are interpreted + * relative to this value. */ + line = asReal(CAR(args)); + /* defer processing until after in-line pars */ + args = CDR(args); + + /* Optional argument: "pos" */ + /* Specifies a user coordinate at which the axis should be drawn. */ + /* This overrides the value of "line". Again the "mgp" par values */ + /* are interpreted relative to this value. */ + + pos = asReal(CAR(args)); + /* defer processing until after in-line pars */ + args = CDR(args); + + /* Optional argument: "outer" */ + /* Should the axis be drawn in the outer margin. */ + /* This only affects the computation of axis_base. */ + + outer = asLogical(CAR(args)); + if (outer == NA_LOGICAL || outer == 0) + outer = NPC; + else + outer = NIC; + args = CDR(args); + + /* Optional argument: "font" */ + font = asInteger(FixupFont(CAR(args), NA_INTEGER)); + args = CDR(args); + + /* Optional argument: "lty" */ + lty = asInteger(FixupLty(CAR(args), 0)); + args = CDR(args); + + /* Optional argument: "lwd" */ + lwd = asReal(FixupLwd(CAR(args), 1)); + args = CDR(args); + lwdticks = asReal(FixupLwd(CAR(args), 1)); + args = CDR(args); + + /* Optional argument: "col" */ + col = asInteger(FixupCol(CAR(args), gpptr(dd)->fg)); + args = CDR(args); + colticks = asInteger(FixupCol(CAR(args), col)); + args = CDR(args); + + /* Optional argument: "hadj" */ + if (length(CAR(args)) != 1) + error(_("'hadj' must be of length one")); + hadj = asReal(CAR(args)); + args = CDR(args); + + /* Optional argument: "padj" */ + PROTECT(padj = coerceVector(CAR(args), REALSXP)); + npadj = length(padj); + if (npadj <= 0) error(_("zero-length '%s' specified"), "padj"); + + /* Now we process all the remaining inline par values: + we need to do it now as x/yaxp are retrieved next. + That will set gpptr, so we update that first - do_plotwindow + clobbered the gpptr settings. */ + GSavePars(dd); + gpptr(dd)->xaxp[0] = dpptr(dd)->xaxp[0]; + gpptr(dd)->xaxp[1] = dpptr(dd)->xaxp[1]; + gpptr(dd)->xaxp[2] = dpptr(dd)->xaxp[2]; + gpptr(dd)->yaxp[0] = dpptr(dd)->yaxp[0]; + gpptr(dd)->yaxp[1] = dpptr(dd)->yaxp[1]; + gpptr(dd)->yaxp[2] = dpptr(dd)->yaxp[2]; + ProcessInlinePars(args, dd); + + /* Retrieve relevant "par" values. */ + + switch(side) { + case 1: + case 3: + axp[0] = gpptr(dd)->xaxp[0]; + axp[1] = gpptr(dd)->xaxp[1]; + axp[2] = gpptr(dd)->xaxp[2]; + usr[0] = dpptr(dd)->usr[0]; + usr[1] = dpptr(dd)->usr[1]; + logflag = dpptr(dd)->xlog; + nint = dpptr(dd)->lab[0]; + break; + case 2: + case 4: + axp[0] = gpptr(dd)->yaxp[0]; + axp[1] = gpptr(dd)->yaxp[1]; + axp[2] = gpptr(dd)->yaxp[2]; + usr[0] = dpptr(dd)->usr[2]; + usr[1] = dpptr(dd)->usr[3]; + logflag = dpptr(dd)->ylog; + nint = dpptr(dd)->lab[1]; + break; + } + + /* Deferred processing */ + if (!R_FINITE(line)) { + /* Except that here mgp values are not relative to themselves */ + line = gpptr(dd)->mgp[2]; + lineoff = (int) line; + } + if (!R_FINITE(pos)) pos = NA_REAL; else lineoff = 0; + + /* Determine the tickmark positions. Note that these may fall */ + /* outside the plot window. We will clip them in the code below. */ + + create_at = isNull(at); + if (create_at) { + PROTECT(at = CreateAtVector(axp, usr, nint, logflag)); + } + else { + if (isReal(at)) PROTECT(at = duplicate(at)); + else PROTECT(at = coerceVector(at, REALSXP)); + } + n = length(at); + + /* Check/setup the tick labels. This can mean using user-specified */ + /* labels, or encoding the "at" positions as strings. */ + + if (dolabels) { + if (length(lab) == 0) + lab = labelformat(at); + else { + if (create_at) + error(_("'labels' is supplied and not 'at'")); + if (!isExpression(lab)) lab = labelformat(lab); + } + if (length(at) != length(lab)) + error(_("'at' and 'labels' lengths differ, %d != %d"), + length(at), length(lab)); + } + PROTECT(lab); + + /* Check there are no NA, Inf or -Inf values for tick positions. */ + /* The code here is long-winded. Couldn't we just inline things */ + /* below. Hmmm - we need the min and max of the finite values ... */ + + ind = (int *) R_alloc(n, sizeof(int)); + for(i = 0; i < n; i++) ind[i] = i; + rsort_with_index(REAL(at), ind, n); + ntmp = 0; + for(i = 0; i < n; i++) { + if(R_FINITE(REAL(at)[i])) ntmp = i+1; + } + if (n > 0 && ntmp == 0) + error(_("no locations are finite")); + n = ntmp; + + /* Ok, all systems are "GO". Let's get to it. */ + + /* At this point we know the value of "xaxt" and "yaxt", + * so we test to see whether the relevant one is "n". + * If it is, we just bail out at this point. */ + + if ((n == 0) || + ((side == 1 || side == 3) && gpptr(dd)->xaxt == 'n') || + ((side == 2 || side == 4) && gpptr(dd)->yaxt == 'n')) { + GRestorePars(dd); + UNPROTECT(4); + return R_NilValue; + } + + + gpptr(dd)->lty = lty; + gpptr(dd)->lwd = lwd; + gpptr(dd)->adj = R_FINITE(hadj) ? hadj : 0.5; + gpptr(dd)->font = (font == NA_INTEGER)? gpptr(dd)->fontaxis : font; + gpptr(dd)->cex = gpptr(dd)->cexbase * gpptr(dd)->cexaxis; + + /* Draw the axis */ + GMode(1, dd); + switch (side) { + case 1: /*--- x-axis -- horizontal --- */ + case 3: + /* First set the clipping limits */ + getxlimits(limits, dd); + /* Now override par("xpd") and force clipping to device region. */ + gpptr(dd)->xpd = 2; + GetAxisLimits(limits[0], limits[1], logflag, &low, &high); + axis_low = GConvertX(fmin2(high, fmax2(low, REAL(at)[0])), USER, NFC, dd); + axis_high = GConvertX(fmin2(high, fmax2(low, REAL(at)[n-1])), USER, NFC, dd); + if (side == 1) { + if (R_FINITE(pos)) + axis_base = GConvertY(pos, USER, NFC, dd); + else + axis_base = GConvertY(0.0, outer, NFC, dd) + - GConvertYUnits(line, LINES, NFC, dd); + if (R_FINITE(gpptr(dd)->tck)) { + double len, xu, yu; + if(gpptr(dd)->tck > 0.5) + len = GConvertYUnits(gpptr(dd)->tck, NPC, NFC, dd); + else { + xu = GConvertXUnits(gpptr(dd)->tck, NPC, INCHES, dd); + yu = GConvertYUnits(gpptr(dd)->tck, NPC, INCHES, dd); + xu = (fabs(xu) < fabs(yu)) ? xu : yu; + len = GConvertYUnits(xu, INCHES, NFC, dd); + } + axis_tick = axis_base + len; + + } else + axis_tick = axis_base + + GConvertYUnits(gpptr(dd)->tcl, LINES, NFC, dd); + } + else { + if (R_FINITE(pos)) + axis_base = GConvertY(pos, USER, NFC, dd); + else + axis_base = GConvertY(1.0, outer, NFC, dd) + + GConvertYUnits(line, LINES, NFC, dd); + if (R_FINITE(gpptr(dd)->tck)) { + double len, xu, yu; + if(gpptr(dd)->tck > 0.5) + len = GConvertYUnits(gpptr(dd)->tck, NPC, NFC, dd); + else { + xu = GConvertXUnits(gpptr(dd)->tck, NPC, INCHES, dd); + yu = GConvertYUnits(gpptr(dd)->tck, NPC, INCHES, dd); + xu = (fabs(xu) < fabs(yu)) ? xu : yu; + len = GConvertYUnits(xu, INCHES, NFC, dd); + } + axis_tick = axis_base - len; + } else + axis_tick = axis_base - + GConvertYUnits(gpptr(dd)->tcl, LINES, NFC, dd); + } + if (doticks) { + gpptr(dd)->col = col; + if (lwd > 0.0) + GLine(axis_low, axis_base, axis_high, axis_base, NFC, dd); + gpptr(dd)->col = colticks; + gpptr(dd)->lwd = lwdticks; + if (lwdticks > 0) { + for (i = 0; i < n; i++) { + x = REAL(at)[i]; + if (low <= x && x <= high) { + x = GConvertX(x, USER, NFC, dd); + GLine(x, axis_base, x, axis_tick, NFC, dd); + } + } + } + } + /* Tickmark labels. */ + gpptr(dd)->col = gpptr(dd)->colaxis; + gap = GStrWidth("m", -1, NFC, dd); /* FIXUP x/y distance */ + tlast = -1.0; + if (!R_FINITE(hadj)) { + if (gpptr(dd)->las == 2 || gpptr(dd)->las == 3) { + gpptr(dd)->adj = (side == 1) ? 1 : 0; + } + else gpptr(dd)->adj = 0.5; + } + if (side == 1) { + axis_lab = - axis_base + + GConvertYUnits(gpptr(dd)->mgp[1]-lineoff, LINES, NFC, dd) + + GConvertY(0.0, NPC, NFC, dd); + } + else { /* side == 3 */ + axis_lab = axis_base + + GConvertYUnits(gpptr(dd)->mgp[1]-lineoff, LINES, NFC, dd) + - GConvertY(1.0, NPC, NFC, dd); + } + axis_lab = GConvertYUnits(axis_lab, NFC, LINES, dd); + + /* The order of processing is important here. */ + /* We must ensure that the labels are drawn left-to-right. */ + /* The logic here is getting way too convoluted. */ + /* This needs a serious rewrite. */ + + if (gpptr(dd)->usr[0] > gpptr(dd)->usr[1]) { + istart = n - 1; + iend = -1; + incr = -1; + } + else { + istart = 0; + iend = n; + incr = 1; + } + for (i = istart; i != iend; i += incr) { + double padjval = REAL(padj)[i % npadj]; + padjval = ComputePAdjValue(padjval, side, gpptr(dd)->las); + x = REAL(at)[i]; + if (!R_FINITE(x)) continue; + temp = GConvertX(x, USER, NFC, dd); + if (dolabels) { + /* Clip tick labels to user coordinates. */ + if (x > low && x < high) { + if (isExpression(lab)) { + GMMathText(VECTOR_ELT(lab, ind[i]), side, + axis_lab, 0, x, gpptr(dd)->las, + padjval, dd); + } + else { + label = STRING_ELT(lab, ind[i]); + if(label != NA_STRING) { + const char *ss = CHAR(label); + labw = GStrWidth(ss, 0, NFC, dd); + tnew = temp - 0.5 * labw; + /* Check room for perpendicular labels. */ + if (gpptr(dd)->las == 2 || + gpptr(dd)->las == 3 || + tnew - tlast >= gap) { + GMtext(ss, getCharCE(label), + side, axis_lab, 0, x, + gpptr(dd)->las, padjval, dd); + tlast = temp + 0.5 *labw; + } + } + } + } + } + } + break; + + case 2: /*--- y-axis -- vertical --- */ + case 4: + /* First set the clipping limits */ + getylimits(limits, dd); + /* Now override par("xpd") and force clipping to device region. */ + gpptr(dd)->xpd = 2; + GetAxisLimits(limits[0], limits[1], logflag, &low, &high); + axis_low = GConvertY(fmin2(high, fmax2(low, REAL(at)[0])), USER, NFC, dd); + axis_high = GConvertY(fmin2(high, fmax2(low, REAL(at)[n-1])), USER, NFC, dd); + if (side == 2) { + if (R_FINITE(pos)) + axis_base = GConvertX(pos, USER, NFC, dd); + else + axis_base = GConvertX(0.0, outer, NFC, dd) + - GConvertXUnits(line, LINES, NFC, dd); + if (R_FINITE(gpptr(dd)->tck)) { + double len, xu, yu; + if(gpptr(dd)->tck > 0.5) + len = GConvertXUnits(gpptr(dd)->tck, NPC, NFC, dd); + else { + xu = GConvertXUnits(gpptr(dd)->tck, NPC, INCHES, dd); + yu = GConvertYUnits(gpptr(dd)->tck, NPC, INCHES, dd); + xu = (fabs(xu) < fabs(yu)) ? xu : yu; + len = GConvertXUnits(xu, INCHES, NFC, dd); + } + axis_tick = axis_base + len; + } else + axis_tick = axis_base + + GConvertXUnits(gpptr(dd)->tcl, LINES, NFC, dd); + } + else { + if (R_FINITE(pos)) + axis_base = GConvertX(pos, USER, NFC, dd); + else + axis_base = GConvertX(1.0, outer, NFC, dd) + + GConvertXUnits(line, LINES, NFC, dd); + if (R_FINITE(gpptr(dd)->tck)) { + double len, xu, yu; + if(gpptr(dd)->tck > 0.5) + len = GConvertXUnits(gpptr(dd)->tck, NPC, NFC, dd); + else { + xu = GConvertXUnits(gpptr(dd)->tck, NPC, INCHES, dd); + yu = GConvertYUnits(gpptr(dd)->tck, NPC, INCHES, dd); + xu = (fabs(xu) < fabs(yu)) ? xu : yu; + len = GConvertXUnits(xu, INCHES, NFC, dd); + } + axis_tick = axis_base - len; + } else + axis_tick = axis_base - + GConvertXUnits(gpptr(dd)->tcl, LINES, NFC, dd); + } + if (doticks) { + gpptr(dd)->col = col; + if (lwd > 0.0) + GLine(axis_base, axis_low, axis_base, axis_high, NFC, dd); + gpptr(dd)->col = colticks; + gpptr(dd)->lwd = lwdticks; + if (lwdticks > 0) { + for (i = 0; i < n; i++) { + y = REAL(at)[i]; + if (low <= y && y <= high) { + y = GConvertY(y, USER, NFC, dd); + GLine(axis_base, y, axis_tick, y, NFC, dd); + } + } + } + } + /* Tickmark labels. */ + gpptr(dd)->col = gpptr(dd)->colaxis; + gap = GStrWidth("m", CE_ANY, INCHES, dd); + gap = GConvertYUnits(gap, INCHES, NFC, dd); + tlast = -1.0; + if (!R_FINITE(hadj)) { + if (gpptr(dd)->las == 1 || gpptr(dd)->las == 2) { + gpptr(dd)->adj = (side == 2) ? 1 : 0; + } + else gpptr(dd)->adj = 0.5; + } + if (side == 2) { + axis_lab = - axis_base + + GConvertXUnits(gpptr(dd)->mgp[1]-lineoff, LINES, NFC, dd) + + GConvertX(0.0, NPC, NFC, dd); + } + else { /* side == 4 */ + axis_lab = axis_base + + GConvertXUnits(gpptr(dd)->mgp[1]-lineoff, LINES, NFC, dd) + - GConvertX(1.0, NPC, NFC, dd); + } + axis_lab = GConvertXUnits(axis_lab, NFC, LINES, dd); + + /* The order of processing is important here. */ + /* We must ensure that the labels are drawn left-to-right. */ + /* The logic here is getting way too convoluted. */ + /* This needs a serious rewrite. */ + + if (gpptr(dd)->usr[2] > gpptr(dd)->usr[3]) { + istart = n - 1; + iend = -1; + incr = -1; + } + else { + istart = 0; + iend = n; + incr = 1; + } + for (i = istart; i != iend; i += incr) { + double padjval = REAL(padj)[i % npadj]; + padjval = ComputePAdjValue(padjval, side, gpptr(dd)->las); + y = REAL(at)[i]; + if (!R_FINITE(y)) continue; + temp = GConvertY(y, USER, NFC, dd); + if (dolabels) { + /* Clip tick labels to user coordinates. */ + if (y > low && y < high) { + if (isExpression(lab)) { + GMMathText(VECTOR_ELT(lab, ind[i]), side, + axis_lab, 0, y, gpptr(dd)->las, + padjval, dd); + } + else { + label = STRING_ELT(lab, ind[i]); + if(label != NA_STRING) { + const char *ss = CHAR(label); + labw = GStrWidth(ss, getCharCE(label), INCHES, dd); + labw = GConvertYUnits(labw, INCHES, NFC, dd); + tnew = temp - 0.5 * labw; + /* Check room for perpendicular labels. */ + if (gpptr(dd)->las == 1 || + gpptr(dd)->las == 2 || + tnew - tlast >= gap) { + GMtext(ss, getCharCE(label), + side, axis_lab, 0, y, + gpptr(dd)->las, padjval, dd); + tlast = temp + 0.5 *labw; + } + } + } + } + } + } + break; + } /* end switch(side, ..) */ + GMode(0, dd); + GRestorePars(dd); + UNPROTECT(4); /* lab, at, lab, padj again */ + return at; +} /* Axis */ + + +SEXP C_plotXY(SEXP args) +{ +/* plot.xy(xy, type, pch, lty, col, bg, cex, lwd, ...) + + * plot points or lines of various types + */ + SEXP sxy, sx, sy, pch, cex, col, bg, lty, lwd; + double *x, *y, xold, yold, xx, yy, thiscex, thislwd; + int i, n, npch, ncex, ncol, nbg, nlwd, type=0, start=0, thispch; + rcolor thiscol, thisbg; + const void *vmax = NULL /* -Wall */; + + pGEDevDesc dd = GEcurrentDevice(); + + /* Basic Checks */ + GCheckState(dd); + args = CDR(args); + if (length(args) < 7) + error(_("too few arguments")); + + /* Required Arguments */ +#define PLOT_XY_DEALING(subname) \ + sx = R_NilValue; /* -Wall */ \ + sy = R_NilValue; /* -Wall */ \ + sxy = CAR(args); \ + if (isNewList(sxy) && length(sxy) >= 2) { \ + TypeCheck(sx = VECTOR_ELT(sxy, 0), REALSXP); \ + TypeCheck(sy = VECTOR_ELT(sxy, 1), REALSXP); \ + } \ + else if (isList(sxy) && length(sxy) >= 2) { \ + TypeCheck(sx = CAR(sxy), REALSXP); \ + TypeCheck(sy = CADR(sxy), REALSXP); \ + } \ + else \ + error(_("invalid plotting structure")); \ + if (LENGTH(sx) != LENGTH(sy)) \ + error(_("'x' and 'y' lengths differ in %s()"), subname);\ + n = LENGTH(sx); \ + args = CDR(args) + + PLOT_XY_DEALING("plot.xy"); + + if (isNull(CAR(args))) type = 'p'; + else { + if (isString(CAR(args)) && LENGTH(CAR(args)) == 1 && + LENGTH(pch = STRING_ELT(CAR(args), 0)) >= 1) { + if(LENGTH(pch) > 1) + warning(_("plot type '%s' will be truncated to first character"), + CHAR(pch)); + type = CHAR(pch)[0]; + } + else error(_("invalid plot type")); + } + args = CDR(args); + + PROTECT(pch = FixupPch(CAR(args), gpptr(dd)->pch)); + npch = length(pch); + args = CDR(args); + + PROTECT(lty = FixupLty(CAR(args), gpptr(dd)->lty)); + args = CDR(args); + + /* Default col was NA_INTEGER (0x80000000) which was interpreted + as zero (black) or "don't draw" depending on line/rect/circle + situation. Now we set the default to zero and don't plot at all + if col==NA. + + FIXME: bg needs similar change, but that requires changes to + the specific drivers. */ + + PROTECT(col = FixupCol(CAR(args), 0)); args = CDR(args); + ncol = LENGTH(col); + + PROTECT(bg = FixupCol(CAR(args), R_TRANWHITE)); args = CDR(args); + nbg = LENGTH(bg); + + PROTECT(cex = FixupCex(CAR(args), 1.0)); args = CDR(args); + ncex = LENGTH(cex); + + PROTECT(lwd = FixupLwd(CAR(args), gpptr(dd)->lwd)); args = CDR(args); + nlwd = LENGTH(lwd); + + /* Miscellaneous Graphical Parameters */ + GSavePars(dd); + ProcessInlinePars(args, dd); + + x = REAL(sx); + y = REAL(sy); + + if (INTEGER(lty)[0] != NA_INTEGER) + gpptr(dd)->lty = INTEGER(lty)[0]; + if (R_FINITE( (thislwd = REAL(lwd)[0]) )) + gpptr(dd)->lwd = thislwd; /* but do recycle for "p" etc */ + + GMode(1, dd); + + /* Line drawing :*/ + switch(type) { + case 'l': + case 'o': + /* lines and overplotted lines and points */ + gpptr(dd)->col = INTEGER(col)[0]; + xold = NA_REAL; + yold = NA_REAL; + for (i = 0; i < n; i++) { + xx = x[i]; + yy = y[i]; + /* do the conversion now to check for non-finite */ + GConvert(&xx, &yy, USER, DEVICE, dd); + if ((R_FINITE(xx) && R_FINITE(yy)) && + !(R_FINITE(xold) && R_FINITE(yold))) + start = i; + else if ((R_FINITE(xold) && R_FINITE(yold)) && + !(R_FINITE(xx) && R_FINITE(yy))) { + if (i-start > 1) + GPolyline(i-start, x+start, y+start, USER, dd); + } + else if ((R_FINITE(xold) && R_FINITE(yold)) && (i == n-1)) + GPolyline(n-start, x+start, y+start, USER, dd); + xold = xx; + yold = yy; + } + break; + + case 'b': + case 'c': /* broken lines (with points in between if 'b') */ + { + double d, f; + d = GConvertYUnits(0.5, CHARS, INCHES, dd); + gpptr(dd)->col = INTEGER(col)[0]; + xold = NA_REAL; + yold = NA_REAL; + for (i = 0; i < n; i++) { + xx = x[i]; + yy = y[i]; + GConvert(&xx, &yy, USER, INCHES, dd); + if (R_FINITE(xold) && R_FINITE(yold) && + R_FINITE(xx) && R_FINITE(yy)) { + // might divide by zero + if (d < 0.5 * hypot(xx-xold, yy-yold)) { + f = d/hypot(xx-xold, yy-yold); + GLine(xold + f * (xx - xold), + yold + f * (yy - yold), + xx + f * (xold - xx), + yy + f * (yold - yy), + INCHES, dd); + } + } + xold = xx; + yold = yy; + } + } + break; + + case 's': /* step function I */ + { + double *xtemp, *ytemp; + int n0 = 0; + if(n <= 1000) { + R_CheckStack2(4*n*sizeof(double)); + xtemp = (double *) alloca(2*n*sizeof(double)); + ytemp = (double *) alloca(2*n*sizeof(double)); + } else { + vmax = vmaxget(); + xtemp = (double *) R_alloc(2*n, sizeof(double)); + ytemp = (double *) R_alloc(2*n, sizeof(double)); + } + gpptr(dd)->col = INTEGER(col)[0]; + xold = NA_REAL; + yold = NA_REAL; + for (i = 0; i < n; i++) { + xx = x[i]; + yy = y[i]; + GConvert(&xx, &yy, USER, DEVICE, dd); + if ((R_FINITE(xx) && R_FINITE(yy)) && + (R_FINITE(xold) && R_FINITE(yold))) { + if(n0 == 0) { xtemp[n0] = xold; ytemp[n0++] = yold; } + xtemp[n0] = xx; ytemp[n0++] = yold;/* <-only diff 's' <-> 'S' */ + xtemp[n0] = xx; ytemp[n0++] = yy; + } else if( (R_FINITE(xold) && R_FINITE(yold)) && + !(R_FINITE(xx) && R_FINITE(yy)) && n0 > 0) { + GPolyline(n0, xtemp, ytemp, DEVICE, dd); + n0 = 0; + } + xold = xx; + yold = yy; + } + if(n0 > 0) GPolyline(n0, xtemp, ytemp, DEVICE, dd); + if(n > 1000) vmaxset(vmax); + } + break; + + case 'S': /* step function II */ + { + double *xtemp, *ytemp; + int n0 = 0; + if(n < 1000) { + R_CheckStack2(4*n*sizeof(double)); + xtemp = (double *) alloca(2*n*sizeof(double)); + ytemp = (double *) alloca(2*n*sizeof(double)); + } else { + vmax = vmaxget(); + xtemp = (double *) R_alloc(2*n, sizeof(double)); + ytemp = (double *) R_alloc(2*n, sizeof(double)); + } + gpptr(dd)->col = INTEGER(col)[0]; + xold = NA_REAL; + yold = NA_REAL; + for (i = 0; i < n; i++) { + xx = x[i]; + yy = y[i]; + GConvert(&xx, &yy, USER, DEVICE, dd); + if ((R_FINITE(xx) && R_FINITE(yy)) && + (R_FINITE(xold) && R_FINITE(yold))) { + if(n0 == 0) {xtemp[n0] = xold; ytemp[n0++] = yold;} + xtemp[n0] = xold; ytemp[n0++] = yy; + xtemp[n0] = xx; ytemp[n0++] = yy; + } else if( (R_FINITE(xold) && R_FINITE(yold)) && + !(R_FINITE(xx) && R_FINITE(yy)) && n0 > 0) { + GPolyline(n0, xtemp, ytemp, DEVICE, dd); + n0 = 0; + } + xold = xx; + yold = yy; + } + if(n0 > 0) GPolyline(n0, xtemp, ytemp, DEVICE, dd); + if(n > 1000) vmaxset(vmax); + } + break; + + case 'h': /* h[istogram] (bar plot) */ + if (gpptr(dd)->ylog) + yold = gpptr(dd)->usr[2];/* DBL_MIN fails.. why ???? */ + else + yold = 0.0; + yold = GConvertY(yold, USER, DEVICE, dd); + for (i = 0; i < n; i++) { + xx = x[i]; + yy = y[i]; + GConvert(&xx, &yy, USER, DEVICE, dd); + if (R_FINITE(xx) && R_FINITE(yy) + && !R_TRANSPARENT(thiscol = INTEGER(col)[i % ncol])) { + gpptr(dd)->col = thiscol; + GLine(xx, yold, xx, yy, DEVICE, dd); + } + } + break; + + case 'p': + case 'n': /* nothing here */ + break; + + default:/* OTHERWISE */ + error(_("invalid plot type '%c'"), type); + + } /* End {switch(type)} - for lines */ + + /* Points : */ + if (type == 'p' || type == 'b' || type == 'o') { + for (i = 0; i < n; i++) { + xx = x[i]; + yy = y[i]; + GConvert(&xx, &yy, USER, DEVICE, dd); + if (R_FINITE(xx) && R_FINITE(yy)) { + if (R_FINITE( (thiscex = REAL(cex)[i % ncex]) ) && + (thispch = INTEGER(pch)[i % npch]) != NA_INTEGER) { + /* FIXME: should this skip 0-sized symbols? */ + thiscol = INTEGER(col)[i % ncol]; + thisbg = INTEGER(bg)[i % nbg]; + if (!(R_TRANSPARENT(thiscol) && + R_TRANSPARENT(thisbg))) { + gpptr(dd)->cex = thiscex * gpptr(dd)->cexbase; + gpptr(dd)->col = thiscol; + if(nlwd > 1 && + R_FINITE((thislwd = REAL(lwd)[i % nlwd]))) + gpptr(dd)->lwd = thislwd; + gpptr(dd)->bg = thisbg; + GSymbol(xx, yy, DEVICE, thispch, dd); + } + } + } + } + } + GMode(0, dd); + GRestorePars(dd); + UNPROTECT(6); + return R_NilValue; +} /* PlotXY */ + +/* Checks for ... , x0, y0, x1, y1 ... */ + +static void xypoints(SEXP args, int *n) +{ + int k=0,/* -Wall */ kmin; + + if (!isNumeric(CAR(args))) + error(_("invalid first argument")); + SETCAR(args, coerceVector(CAR(args), REALSXP)); + k = LENGTH(CAR(args)); + *n = k; kmin = k; + args = CDR(args); + + if (!isNumeric(CAR(args))) + error(_("invalid second argument")); + k = LENGTH(CAR(args)); + SETCAR(args, coerceVector(CAR(args), REALSXP)); + if (k > *n) *n = k; + if (k < kmin) kmin = k; + args = CDR(args); + + if (!isNumeric(CAR(args))) + error(_("invalid third argument")); + SETCAR(args, coerceVector(CAR(args), REALSXP)); + k = LENGTH(CAR(args)); + if (k > *n) *n = k; + if (k < kmin) kmin = k; + args = CDR(args); + + if (!isNumeric(CAR(args))) + error(_("invalid fourth argument")); + SETCAR(args, coerceVector(CAR(args), REALSXP)); + k = LENGTH(CAR(args)); + if (k > *n) *n = k; + if (k < kmin) kmin = k; + args = CDR(args); + + if (*n > 0 && kmin == 0) + error(_("cannot mix zero-length and non-zero-length coordinates")); +} + + +SEXP C_segments(SEXP args) +{ + /* segments(x0, y0, x1, y1, col, lty, lwd, ...) */ + SEXP sx0, sx1, sy0, sy1, col, lty, lwd; + double *x0, *x1, *y0, *y1; + double xx[2], yy[2]; + int nx0, nx1, ny0, ny1, i, n, ncol, nlty, nlwd; + pGEDevDesc dd = GEcurrentDevice(); + + args = CDR(args); + if (length(args) < 4) error(_("too few arguments")); + GCheckState(dd); + + xypoints(args, &n); + if(n == 0) return R_NilValue; + + sx0 = CAR(args); nx0 = length(sx0); args = CDR(args); + sy0 = CAR(args); ny0 = length(sy0); args = CDR(args); + sx1 = CAR(args); nx1 = length(sx1); args = CDR(args); + sy1 = CAR(args); ny1 = length(sy1); args = CDR(args); + + PROTECT(col = FixupCol(CAR(args), R_TRANWHITE)); + ncol = LENGTH(col); args = CDR(args); + + PROTECT(lty = FixupLty(CAR(args), gpptr(dd)->lty)); + nlty = length(lty); args = CDR(args); + + PROTECT(lwd = FixupLwd(CAR(args), gpptr(dd)->lwd)); + nlwd = length(lwd); args = CDR(args); + + GSavePars(dd); + ProcessInlinePars(args, dd); + + x0 = REAL(sx0); + y0 = REAL(sy0); + x1 = REAL(sx1); + y1 = REAL(sy1); + + GMode(1, dd); + for (i = 0; i < n; i++) { + xx[0] = x0[i % nx0]; + yy[0] = y0[i % ny0]; + xx[1] = x1[i % nx1]; + yy[1] = y1[i % ny1]; + GConvert(xx, yy, USER, DEVICE, dd); + GConvert(xx+1, yy+1, USER, DEVICE, dd); + if (R_FINITE(xx[0]) && R_FINITE(yy[0]) && + R_FINITE(xx[1]) && R_FINITE(yy[1])) + { + int thiscol = INTEGER(col)[i % ncol]; + if(!R_TRANSPARENT(thiscol)) { + gpptr(dd)->col = thiscol; + gpptr(dd)->lty = INTEGER(lty)[i % nlty]; + gpptr(dd)->lwd = REAL(lwd)[i % nlwd]; + GLine(xx[0], yy[0], xx[1], yy[1], DEVICE, dd); + } + } + } + GMode(0, dd); + GRestorePars(dd); + + UNPROTECT(3); + return R_NilValue; +} + + +SEXP C_rect(SEXP args) +{ + /* rect(xl, yb, xr, yt, col, border, lty, ...) */ + SEXP sxl, sxr, syb, syt, col, lty, lwd, border; + double *xl, *xr, *yb, *yt, x0, y0, x1, y1; + int i, n, nxl, nxr, nyb, nyt, ncol, nlty, nlwd, nborder; + pGEDevDesc dd = GEcurrentDevice(); + + args = CDR(args); + if (length(args) < 4) error(_("too few arguments")); + GCheckState(dd); + + xypoints(args, &n); + if(n == 0) return R_NilValue; + + sxl = CAR(args); nxl = length(sxl); args = CDR(args);/* x_left */ + syb = CAR(args); nyb = length(syb); args = CDR(args);/* y_bottom */ + sxr = CAR(args); nxr = length(sxr); args = CDR(args);/* x_right */ + syt = CAR(args); nyt = length(syt); args = CDR(args);/* y_top */ + + PROTECT(col = FixupCol(CAR(args), R_TRANWHITE)); + ncol = LENGTH(col); + args = CDR(args); + + PROTECT(border = FixupCol(CAR(args), gpptr(dd)->fg)); + nborder = LENGTH(border); + args = CDR(args); + + PROTECT(lty = FixupLty(CAR(args), gpptr(dd)->lty)); + nlty = length(lty); + args = CDR(args); + + PROTECT(lwd = FixupLwd(CAR(args), gpptr(dd)->lwd)); + nlwd = length(lwd); + args = CDR(args); + + GSavePars(dd); + ProcessInlinePars(args, dd); + + xl = REAL(sxl); + xr = REAL(sxr); + yb = REAL(syb); + yt = REAL(syt); + + GMode(1, dd); + for (i = 0; i < n; i++) { + if (nlty && INTEGER(lty)[i % nlty] != NA_INTEGER) + gpptr(dd)->lty = INTEGER(lty)[i % nlty]; + else + gpptr(dd)->lty = dpptr(dd)->lty; + if (nlwd && REAL(lwd)[i % nlwd] != NA_REAL) + gpptr(dd)->lwd = REAL(lwd)[i % nlwd]; + else + gpptr(dd)->lwd = dpptr(dd)->lwd; + x0 = xl[i % nxl]; + y0 = yb[i % nyb]; + x1 = xr[i % nxr]; + y1 = yt[i % nyt]; + GConvert(&x0, &y0, USER, DEVICE, dd); + GConvert(&x1, &y1, USER, DEVICE, dd); + if (R_FINITE(x0) && R_FINITE(y0) && R_FINITE(x1) && R_FINITE(y1)) + GRect(x0, y0, x1, y1, DEVICE, INTEGER(col)[i % ncol], + INTEGER(border)[i % nborder], dd); + } + GMode(0, dd); + + GRestorePars(dd); + UNPROTECT(4); + return R_NilValue; +} + +SEXP C_path(SEXP args) +{ + /* path(x, y, col, border, lty, ...) */ + SEXP sx, sy, nper, rule, col, border, lty; + int i, nx, npoly; + double *xx, *yy; + const void *vmax = NULL /* -Wall */; + + pGEDevDesc dd = GEcurrentDevice(); + + GCheckState(dd); + + args = CDR(args); + if (length(args) < 2) error(_("too few arguments")); + /* (x,y) is checked in R via xy.coords() ; no need here : */ + sx = SETCAR(args, coerceVector(CAR(args), REALSXP)); args = CDR(args); + sy = SETCAR(args, coerceVector(CAR(args), REALSXP)); args = CDR(args); + nx = LENGTH(sx); + + PROTECT(nper = CAR(args)); args = CDR(args); + npoly = LENGTH(nper); + + PROTECT(rule = CAR(args)); args = CDR(args); + + PROTECT(col = FixupCol(CAR(args), R_TRANWHITE)); args = CDR(args); + PROTECT(border = FixupCol(CAR(args), gpptr(dd)->fg)); args = CDR(args); + PROTECT(lty = FixupLty(CAR(args), gpptr(dd)->lty)); args = CDR(args); + + GSavePars(dd); + ProcessInlinePars(args, dd); + + GMode(1, dd); + + vmax = vmaxget(); + + /* + * Work in device coordinates because that is what the + * graphics engine needs. + */ + xx = (double*) R_alloc(nx, sizeof(double)); + yy = (double*) R_alloc(nx, sizeof(double)); + if (!xx || !yy) + error("unable to allocate memory (in GPath)"); + for (i=0; i<nx; i++) { + xx[i] = REAL(sx)[i]; + yy[i] = REAL(sy)[i]; + GConvert(&(xx[i]), &(yy[i]), USER, DEVICE, dd); + if (!(R_FINITE(xx[i]) && R_FINITE(yy[i]))) + error("invalid 'x' or 'y' (in 'GPath')"); + } + + if (INTEGER(lty)[0] == NA_INTEGER) + gpptr(dd)->lty = dpptr(dd)->lty; + else + gpptr(dd)->lty = INTEGER(lty)[0]; + + GPath(xx, yy, npoly, INTEGER(nper), INTEGER(rule)[0] == 1, + INTEGER(col)[0], INTEGER(border)[0], dd); + + GMode(0, dd); + + GRestorePars(dd); + UNPROTECT(5); + + vmaxset(vmax); + return R_NilValue; +} + +SEXP C_raster(SEXP args) +{ + /* raster(image, xl, yb, xr, yt, angle, interpolate, ...) */ + const void *vmax; + unsigned int *image; + SEXP raster, dim, sxl, sxr, syb, syt, angle, interpolate; + double *xl, *xr, *yb, *yt, x0, y0, x1, y1; + int i, n, nxl, nxr, nyb, nyt; + pGEDevDesc dd = GEcurrentDevice(); + + args = CDR(args); + if (length(args) < 7) error(_("too few arguments")); + GCheckState(dd); + + raster = CAR(args); args = CDR(args); + n = LENGTH(raster); + if (n <= 0) error(_("Empty raster")); + dim = getAttrib(raster, R_DimSymbol); + + vmax = vmaxget(); + /* raster is rather inefficient so allow a native representation as + an integer array which requires no conversion */ + if (inherits(raster, "nativeRaster") && isInteger(raster)) + image = (unsigned int *) INTEGER(raster); + else { + image = (unsigned int *) R_alloc(n, sizeof(unsigned int)); + for (i = 0; i < n; i++) + image[i] = RGBpar3(raster, i, R_TRANWHITE); + } + + xypoints(args, &n); + if(n == 0) return R_NilValue; + + sxl = CAR(args); nxl = length(sxl); args = CDR(args);/* x_left */ + syb = CAR(args); nyb = length(syb); args = CDR(args);/* y_bottom */ + sxr = CAR(args); nxr = length(sxr); args = CDR(args);/* x_right */ + syt = CAR(args); nyt = length(syt); args = CDR(args);/* y_top */ + + angle = CAR(args); args = CDR(args); + interpolate = CAR(args); args = CDR(args); + + GSavePars(dd); + ProcessInlinePars(args, dd); + + xl = REAL(sxl); + xr = REAL(sxr); + yb = REAL(syb); + yt = REAL(syt); + + GMode(1, dd); + for (i = 0; i < n; i++) { + x0 = xl[i % nxl]; + y0 = yb[i % nyb]; + x1 = xr[i % nxr]; + y1 = yt[i % nyt]; + GConvert(&x0, &y0, USER, DEVICE, dd); + GConvert(&x1, &y1, USER, DEVICE, dd); + if (R_FINITE(x0) && R_FINITE(y0) && R_FINITE(x1) && R_FINITE(y1)) + GRaster(image, INTEGER(dim)[1], INTEGER(dim)[0], + x0, y0, x1 - x0, y1 - y0, + REAL(angle)[i % LENGTH(angle)], + LOGICAL(interpolate)[i % LENGTH(interpolate)], dd); + } + GMode(0, dd); + + GRestorePars(dd); + + vmaxset(vmax); + return R_NilValue; +} + + +SEXP C_arrows(SEXP args) +{ + /* arrows(x0, y0, x1, y1, length, angle, code, col, lty, lwd, ...) */ + SEXP sx0, sx1, sy0, sy1, col, lty, lwd; + double *x0, *x1, *y0, *y1; + double xx0, yy0, xx1, yy1; + double hlength, angle; + int code; + int nx0, nx1, ny0, ny1, i, n, ncol, nlty, nlwd; + rcolor thiscol; + pGEDevDesc dd = GEcurrentDevice(); + + args = CDR(args); + if (length(args) < 4) error(_("too few arguments")); + GCheckState(dd); + + xypoints(args, &n); + if(n == 0) return R_NilValue; + + sx0 = CAR(args); nx0 = length(sx0); args = CDR(args); + sy0 = CAR(args); ny0 = length(sy0); args = CDR(args); + sx1 = CAR(args); nx1 = length(sx1); args = CDR(args); + sy1 = CAR(args); ny1 = length(sy1); args = CDR(args); + + hlength = asReal(CAR(args)); + if (!R_FINITE(hlength) || hlength < 0) + error(_("invalid arrow head length")); + args = CDR(args); + + angle = asReal(CAR(args)); + if (!R_FINITE(angle)) + error(_("invalid arrow head angle")); + args = CDR(args); + + code = asInteger(CAR(args)); + if (code == NA_INTEGER || code < 0 || code > 3) + error(_("invalid arrow head specification")); + args = CDR(args); + + PROTECT(col = FixupCol(CAR(args), R_TRANWHITE)); + ncol = LENGTH(col); + args = CDR(args); + + PROTECT(lty = FixupLty(CAR(args), gpptr(dd)->lty)); + nlty = length(lty); + args = CDR(args); + + PROTECT(lwd = FixupLwd(CAR(args), gpptr(dd)->lwd)); + nlwd = length(lwd); + args = CDR(args); + + GSavePars(dd); + ProcessInlinePars(args, dd); + + x0 = REAL(sx0); + y0 = REAL(sy0); + x1 = REAL(sx1); + y1 = REAL(sy1); + + GMode(1, dd); + for (i = 0; i < n; i++) { + xx0 = x0[i % nx0]; + yy0 = y0[i % ny0]; + xx1 = x1[i % nx1]; + yy1 = y1[i % ny1]; + GConvert(&xx0, &yy0, USER, DEVICE, dd); + GConvert(&xx1, &yy1, USER, DEVICE, dd); + if (R_FINITE(xx0) && R_FINITE(yy0) && R_FINITE(xx1) && R_FINITE(yy1) + && !R_TRANSPARENT(thiscol = INTEGER(col)[i % ncol])) { + gpptr(dd)->col = thiscol; + gpptr(dd)->lty = INTEGER(lty)[i % nlty]; + gpptr(dd)->lwd = REAL(lwd)[i % nlwd]; + GArrow(xx0, yy0, xx1, yy1, DEVICE, + hlength, angle, code, dd); + } + } + GMode(0, dd); + GRestorePars(dd); + + UNPROTECT(3); + return R_NilValue; +} + + +static void drawPolygon(int n, double *x, double *y, + int lty, int fill, int border, pGEDevDesc dd) +{ + if (lty == NA_INTEGER) + gpptr(dd)->lty = dpptr(dd)->lty; + else + gpptr(dd)->lty = lty; + GPolygon(n, x, y, USER, fill, border, dd); +} + +SEXP C_polygon(SEXP args) +{ + /* polygon(x, y, col, border, lty, ...) */ + SEXP sx, sy, col, border, lty; + int nx; + int ncol, nborder, nlty, i, start=0; + int num = 0; + double *x, *y, xx, yy, xold, yold; + + pGEDevDesc dd = GEcurrentDevice(); + + GCheckState(dd); + + args = CDR(args); + if (length(args) < 2) error(_("too few arguments")); + /* (x,y) is checked in R via xy.coords() ; no need here : */ + sx = SETCAR(args, coerceVector(CAR(args), REALSXP)); args = CDR(args); + sy = SETCAR(args, coerceVector(CAR(args), REALSXP)); args = CDR(args); + nx = LENGTH(sx); + + PROTECT(col = FixupCol(CAR(args), R_TRANWHITE)); args = CDR(args); + ncol = LENGTH(col); + + PROTECT(border = FixupCol(CAR(args), gpptr(dd)->fg)); args = CDR(args); + nborder = LENGTH(border); + + PROTECT(lty = FixupLty(CAR(args), gpptr(dd)->lty)); args = CDR(args); + nlty = length(lty); + + GSavePars(dd); + ProcessInlinePars(args, dd); + + GMode(1, dd); + + x = REAL(sx); + y = REAL(sy); + xold = NA_REAL; + yold = NA_REAL; + for (i = 0; i < nx; i++) { + xx = x[i]; + yy = y[i]; + GConvert(&xx, &yy, USER, DEVICE, dd); + if ((R_FINITE(xx) && R_FINITE(yy)) && + !(R_FINITE(xold) && R_FINITE(yold))) + start = i; /* first point of current segment */ + else if ((R_FINITE(xold) && R_FINITE(yold)) && + !(R_FINITE(xx) && R_FINITE(yy))) { + if (i-start > 1) { + drawPolygon(i-start, x+start, y+start, + INTEGER(lty)[num%nlty], + INTEGER(col)[num%ncol], + INTEGER(border)[num%nborder], dd); + num++; + } + } + else if ((R_FINITE(xold) && R_FINITE(yold)) && (i == nx-1)) { /* last */ + drawPolygon(nx-start, x+start, y+start, + INTEGER(lty)[num%nlty], + INTEGER(col)[num%ncol], + INTEGER(border)[num%nborder], dd); + num++; + } + xold = xx; + yold = yy; + } + + GMode(0, dd); + + GRestorePars(dd); + UNPROTECT(3); + return R_NilValue; +} + +SEXP C_text(SEXP args) +{ +/* text(xy, labels, adj, pos, offset, + * vfont, cex, col, font, ...) + */ + SEXP sx, sy, sxy, txt, adj, pos, cex, col, rawcol, font, vfont; + int i, n, npos, ncex, ncol, nfont, ntxt; + double adjx = 0, adjy = 0, offset = 0.5; + double *x, *y; + double xx, yy; + Rboolean vectorFonts = FALSE; + SEXP string; + pGEDevDesc dd = GEcurrentDevice(); + + GCheckState(dd); + + args = CDR(args); + if (length(args) < 3) error(_("too few arguments")); + + PLOT_XY_DEALING("text"); + + /* labels */ + txt = CAR(args); + if (isSymbol(txt) || isLanguage(txt)) + txt = coerceVector(txt, EXPRSXP); + else if (!isExpression(txt)) + txt = coerceVector(txt, STRSXP); + PROTECT(txt); + if (length(txt) <= 0) + error(_("zero-length '%s' specified"), "labels"); + args = CDR(args); + + PROTECT(adj = CAR(args)); + if (isNull(adj) || (isNumeric(adj) && length(adj) == 0)) { + adjx = gpptr(dd)->adj; + adjy = NA_REAL; + } + else if (isReal(adj)) { + if (LENGTH(adj) == 1) { + adjx = REAL(adj)[0]; + adjy = NA_REAL; + } + else { + adjx = REAL(adj)[0]; + adjy = REAL(adj)[1]; + } + } + else if (isInteger(adj)) { + if (LENGTH(adj) == 1) { + adjx = INTEGER(adj)[0]; + adjy = NA_REAL; + } + else { + adjx = INTEGER(adj)[0]; + adjy = INTEGER(adj)[1]; + } + } + else error(_("invalid '%s' value"), "adj"); + args = CDR(args); + + PROTECT(pos = coerceVector(CAR(args), INTSXP)); + npos = length(pos); + for (i = 0; i < npos; i++) + if (INTEGER(pos)[i] < 1 || INTEGER(pos)[i] > 4) + error(_("invalid '%s' value"), "pos"); + args = CDR(args); + + offset = GConvertXUnits(asReal(CAR(args)), CHARS, INCHES, dd); + args = CDR(args); + + PROTECT(vfont = FixupVFont(CAR(args))); + args = CDR(args); + + PROTECT(cex = FixupCex(CAR(args), 1.0)); + ncex = LENGTH(cex); + args = CDR(args); + + rawcol = CAR(args); + PROTECT(col = FixupCol(rawcol, R_TRANWHITE)); + ncol = LENGTH(col); + args = CDR(args); + + PROTECT(font = FixupFont(CAR(args), NA_INTEGER)); + nfont = LENGTH(font); + args = CDR(args); + + x = REAL(sx); + y = REAL(sy); + /* n = LENGTH(sx) = LENGTH(sy) */ + ntxt = LENGTH(txt); + + GSavePars(dd); + ProcessInlinePars(args, dd); + + /* Done here so 'vfont' trumps inline 'family' */ + if (!isNull(vfont) && !isExpression(txt)) { + strncpy(gpptr(dd)->family, "Hershey ", 201); + gpptr(dd)->family[7] = (char) INTEGER(vfont)[0]; + vectorFonts = TRUE; + } + + GMode(1, dd); + if (n == 0 && ntxt > 0) + error(_("no coordinates were supplied")); + for (i = 0; i < imax2(n,ntxt); i++) { + xx = x[i % n]; + yy = y[i % n]; + GConvert(&xx, &yy, USER, INCHES, dd); + if (R_FINITE(xx) && R_FINITE(yy)) { + if (ncol && !isNAcol(rawcol, i, ncol)) + gpptr(dd)->col = INTEGER(col)[i % ncol]; + else + gpptr(dd)->col = dpptr(dd)->col; + if (ncex && R_FINITE(REAL(cex)[i % ncex])) + gpptr(dd)->cex = gpptr(dd)->cexbase * REAL(cex)[i % ncex]; + else + gpptr(dd)->cex = gpptr(dd)->cexbase; + + if (vectorFonts) gpptr(dd)->font = INTEGER(vfont)[1]; + else if (nfont && INTEGER(font)[i % nfont] != NA_INTEGER) + gpptr(dd)->font = INTEGER(font)[i % nfont]; + else + gpptr(dd)->font = dpptr(dd)->font; + + if (npos > 0) { + switch(INTEGER(pos)[i % npos]) { + case 1: + yy = yy - offset; + adjx = 0.5; + adjy = 1 - (0.5 - dd->dev->yCharOffset); + break; + case 2: + xx = xx - offset; + adjx = 1; + adjy = dd->dev->yCharOffset; + break; + case 3: + yy = yy + offset; + adjx = 0.5; + adjy = 0; + break; + case 4: + xx = xx + offset; + adjx = 0; + adjy = dd->dev->yCharOffset; + break; + } + } + if (isExpression(txt)) { + GMathText(xx, yy, INCHES, VECTOR_ELT(txt, i % ntxt), + adjx, adjy, gpptr(dd)->srt, dd); + } else { + string = STRING_ELT(txt, i % ntxt); + if(string != NA_STRING) + GText(xx, yy, INCHES, CHAR(string), getCharCE(string), + adjx, adjy, gpptr(dd)->srt, dd); + } + } + } + GMode(0, dd); + + GRestorePars(dd); + UNPROTECT(7); + return R_NilValue; +} + +static double ComputeAdjValue(double adj, int side, int las) +{ + if (!R_FINITE(adj)) { + switch(las) { + case 0:/* parallel to axis */ + adj = 0.5; break; + case 1:/* horizontal */ + switch(side) { + case 1: + case 3: adj = 0.5; break; + case 2: adj = 1.0; break; + case 4: adj = 0.0; break; + } + break; + case 2:/* perpendicular to axis */ + switch(side) { + case 1: + case 2: adj = 1.0; break; + case 3: + case 4: adj = 0.0; break; + } + break; + case 3:/* vertical */ + switch(side) { + case 1: adj = 1.0; break; + case 3: adj = 0.0; break; + case 2: + case 4: adj = 0.5; break; + } + break; + } + } + return adj; +} + +static double ComputeAtValueFromAdj(double adj, int side, int outer, + pGEDevDesc dd) +{ + double at = 0; /* -Wall */ + switch(side % 2) { + case 0: + at = outer ? adj : yNPCtoUsr(adj, dd); + break; + case 1: + at = outer ? adj : xNPCtoUsr(adj, dd); + break; + } + return at; +} + +static double ComputeAtValue(double at, double adj, + int side, int las, int outer, + pGEDevDesc dd) +{ + if (!R_FINITE(at)) { + /* If the text is parallel to the axis, use "adj" for "at" + * Otherwise, centre the text + */ + switch(las) { + case 0:/* parallel to axis */ + at = ComputeAtValueFromAdj(adj, side, outer, dd); + break; + case 1:/* horizontal */ + switch(side) { + case 1: + case 3: + at = ComputeAtValueFromAdj(adj, side, outer, dd); + break; + case 2: + case 4: + at = outer ? 0.5 : yNPCtoUsr(0.5, dd); + break; + } + break; + case 2:/* perpendicular to axis */ + switch(side) { + case 1: + case 3: + at = outer ? 0.5 : xNPCtoUsr(0.5, dd); + break; + case 2: + case 4: + at = outer ? 0.5 : yNPCtoUsr(0.5, dd); + break; + } + break; + case 3:/* vertical */ + switch(side) { + case 1: + case 3: + at = outer ? 0.5 : xNPCtoUsr(0.5, dd); + break; + case 2: + case 4: + at = ComputeAtValueFromAdj(adj, side, outer, dd); + break; + } + break; + } + } + return at; +} + +/* mtext(text, + side = 3, + line = 0, + outer = TRUE, + at = NA, + adj = NA, + padj = NA, + cex = NA, + col = NA, + font = NA, + ...) */ + +SEXP C_mtext(SEXP args) +{ + SEXP text, side, line, outer, at, adj, padj, cex, col, font, string; + SEXP rawcol; + int ntext, nside, nline, nouter, nat, nadj, npadj, ncex, ncol, nfont; + Rboolean dirtyplot = FALSE, gpnewsave = FALSE, dpnewsave = FALSE; + int i, n, fontsave, colsave; + double cexsave; + pGEDevDesc dd = GEcurrentDevice(); + + GCheckState(dd); + + args = CDR(args); + if (length(args) < 9) + error(_("too few arguments")); + + /* Arg1 : text= */ + text = CAR(args); + if (isSymbol(text) || isLanguage(text)) + text = coerceVector(text, EXPRSXP); + else if (!isExpression(text)) + text = coerceVector(text, STRSXP); + PROTECT(text); + n = ntext = length(text); + if (ntext <= 0) + error(_("zero-length '%s' specified"), "text"); + args = CDR(args); + + /* Arg2 : side= */ + PROTECT(side = coerceVector(CAR(args), INTSXP)); + nside = length(side); + if (nside <= 0) error(_("zero-length '%s' specified"), "side"); + if (n < nside) n = nside; + args = CDR(args); + + /* Arg3 : line= */ + PROTECT(line = coerceVector(CAR(args), REALSXP)); + nline = length(line); + if (nline <= 0) error(_("zero-length '%s' specified"), "line"); + if (n < nline) n = nline; + args = CDR(args); + + /* Arg4 : outer= */ + /* outer == NA => outer <- 0 */ + PROTECT(outer = coerceVector(CAR(args), INTSXP)); + nouter = length(outer); + if (nouter <= 0) error(_("zero-length '%s' specified"), "outer"); + if (n < nouter) n = nouter; + args = CDR(args); + + /* Arg5 : at= */ + PROTECT(at = coerceVector(CAR(args), REALSXP)); + nat = length(at); + if (nat <= 0) error(_("zero-length '%s' specified"), "at"); + if (n < nat) n = nat; + args = CDR(args); + + /* Arg6 : adj= */ + PROTECT(adj = coerceVector(CAR(args), REALSXP)); + nadj = length(adj); + if (nadj <= 0) error(_("zero-length '%s' specified"), "adj"); + if (n < nadj) n = nadj; + args = CDR(args); + + /* Arg7 : padj= */ + PROTECT(padj = coerceVector(CAR(args), REALSXP)); + npadj = length(padj); + if (npadj <= 0) error(_("zero-length '%s' specified"), "padj"); + if (n < npadj) n = npadj; + args = CDR(args); + + /* Arg8 : cex */ + PROTECT(cex = FixupCex(CAR(args), 1.0)); + ncex = length(cex); + if (ncex <= 0) error(_("zero-length '%s' specified"), "cex"); + if (n < ncex) n = ncex; + args = CDR(args); + + /* Arg9 : col */ + rawcol = CAR(args); + PROTECT(col = FixupCol(rawcol, R_TRANWHITE)); + ncol = length(col); + if (ncol <= 0) error(_("zero-length '%s' specified"), "col"); + if (n < ncol) n = ncol; + args = CDR(args); + + /* Arg10 : font */ + PROTECT(font = FixupFont(CAR(args), NA_INTEGER)); + nfont = length(font); + if (nfont <= 0) error(_("zero-length '%s' specified"), "font"); + if (n < nfont) n = nfont; + args = CDR(args); + + GSavePars(dd); + ProcessInlinePars(args, dd); + + /* If we only scribble in the outer margins, */ + /* we don't want to mark the plot as dirty. */ + + dirtyplot = FALSE; + gpnewsave = gpptr(dd)->new; + dpnewsave = dpptr(dd)->new; + cexsave = gpptr(dd)->cex; + fontsave = gpptr(dd)->font; + colsave = gpptr(dd)->col; + + /* override par("xpd") and force clipping to figure region + NOTE: don't override to _reduce_ clipping region */ + if (gpptr(dd)->xpd < 1) + gpptr(dd)->xpd = 1; + + if (outer) { + gpnewsave = gpptr(dd)->new; + dpnewsave = dpptr(dd)->new; + /* override par("xpd") and force clipping to device region */ + gpptr(dd)->xpd = 2; + } + GMode(1, dd); + + for (i = 0; i < n; i++) { + double atval = REAL(at)[i % nat]; + double adjval = REAL(adj)[i % nadj]; + double padjval = REAL(padj)[i % npadj]; + double cexval = REAL(cex)[i % ncex]; + double lineval = REAL(line)[i % nline]; + int outerval = INTEGER(outer)[i % nouter]; + int sideval = INTEGER(side)[i % nside]; + int fontval = INTEGER(font)[i % nfont]; + int colval = INTEGER(col)[i % ncol]; + + if (outerval == NA_INTEGER) outerval = 0; + /* Note : we ignore any shrinking produced */ + /* by mfrow / mfcol specs here. I.e. don't */ + /* gpptr(dd)->cexbase. */ + if (R_FINITE(cexval)) gpptr(dd)->cex = cexval; + else cexval = cexsave; + gpptr(dd)->font = (fontval == NA_INTEGER) ? fontsave : fontval; + if (isNAcol(rawcol, i, ncol)) + gpptr(dd)->col = colsave; + else + gpptr(dd)->col = colval; + gpptr(dd)->adj = ComputeAdjValue(adjval, sideval, gpptr(dd)->las); + padjval = ComputePAdjValue(padjval, sideval, gpptr(dd)->las); + atval = ComputeAtValue(atval, gpptr(dd)->adj, sideval, gpptr(dd)->las, + outerval, dd); + + if (isExpression(text)) + GMMathText(VECTOR_ELT(text, i % ntext), + sideval, lineval, outerval, atval, gpptr(dd)->las, + padjval, dd); + else { + string = STRING_ELT(text, i % ntext); + if(string != NA_STRING) + GMtext(CHAR(string), getCharCE(string), sideval, lineval, + outerval, atval, gpptr(dd)->las, padjval, dd); + } + + if (outerval == 0) dirtyplot = TRUE; + } + GMode(0, dd); + + GRestorePars(dd); + if (!dirtyplot) { + gpptr(dd)->new = gpnewsave; + dpptr(dd)->new = dpnewsave; + } + UNPROTECT(10); + return R_NilValue; +} /* Mtext */ + + +SEXP C_title(SEXP args) +{ +/* Annotation for plots : + + title(main, sub, xlab, ylab, + line, outer, + ...) */ + + SEXP Main, xlab, ylab, sub, string; + double adj, adjy, cex, offset, line, hpos, vpos; + int i, n, font, outer, where; + rcolor col; + pGEDevDesc dd = GEcurrentDevice(); + + GCheckState(dd); + + args = CDR(args); + if (length(args) < 6) error(_("too few arguments")); + + Main = sub = xlab = ylab = R_NilValue; + + if (CAR(args) != R_NilValue && length(CAR(args)) > 0) + Main = CAR(args); + args = CDR(args); + + if (CAR(args) != R_NilValue && length(CAR(args)) > 0) + sub = CAR(args); + args = CDR(args); + + if (CAR(args) != R_NilValue && length(CAR(args)) > 0) + xlab = CAR(args); + args = CDR(args); + + if (CAR(args) != R_NilValue && length(CAR(args)) > 0) + ylab = CAR(args); + args = CDR(args); + + line = asReal(CAR(args)); + args = CDR(args); + + outer = asLogical(CAR(args)); + if (outer == NA_LOGICAL) outer = 0; + args = CDR(args); + + GSavePars(dd); + ProcessInlinePars(args, dd); + + /* override par("xpd") and force clipping to figure region + NOTE: don't override to _reduce_ clipping region */ + if (gpptr(dd)->xpd < 1) + gpptr(dd)->xpd = 1; + if (outer) + gpptr(dd)->xpd = 2; + adj = gpptr(dd)->adj; + + GMode(1, dd); + if (Main != R_NilValue) { + cex = gpptr(dd)->cexmain; + col = gpptr(dd)->colmain; + font = gpptr(dd)->fontmain; + /* GetTextArg may coerce, so protect the result */ + GetTextArg(Main, &Main, &col, &cex, &font); + PROTECT(Main); + gpptr(dd)->col = col; + gpptr(dd)->cex = gpptr(dd)->cexbase * cex; + gpptr(dd)->font = font; + if (outer) { + if (R_FINITE(line)) { + vpos = line; + adjy = 0; + } + else { + vpos = 0.5 * gpptr(dd)->oma[2]; + adjy = 0.5; + } + hpos = adj; + where = OMA3; + } + else { + if (R_FINITE(line)) { + vpos = line; + adjy = 0; + } + else { + vpos = 0.5 * gpptr(dd)->mar[2]; + adjy = 0.5; + } + hpos = GConvertX(adj, NPC, USER, dd); + where = MAR3; + } + if (isExpression(Main)) { + GMathText(hpos, vpos, where, VECTOR_ELT(Main, 0), + adj, 0.5, 0.0, dd); + } + else { + n = length(Main); + offset = 0.5 * (n - 1) + vpos; + for (i = 0; i < n; i++) { + string = STRING_ELT(Main, i); + if(string != NA_STRING) + GText(hpos, offset - i, where, CHAR(string), getCharCE(string), + adj, adjy, 0.0, dd); + } + } + UNPROTECT(1); + } + if (sub != R_NilValue) { + cex = gpptr(dd)->cexsub; + col = gpptr(dd)->colsub; + font = gpptr(dd)->fontsub; + /* GetTextArg may coerce, so protect the result */ + GetTextArg(sub, &sub, &col, &cex, &font); + PROTECT(sub); + gpptr(dd)->col = col; + gpptr(dd)->cex = gpptr(dd)->cexbase * cex; + gpptr(dd)->font = font; + if (R_FINITE(line)) + vpos = line; + else + vpos = gpptr(dd)->mgp[0] + 1; + if (outer) { + hpos = adj; + where = 1; + } + else { + hpos = GConvertX(adj, NPC, USER, dd); + where = 0; + } + if (isExpression(sub)) + GMMathText(VECTOR_ELT(sub, 0), 1, vpos, where, + hpos, 0, 0.0, dd); + else { + n = length(sub); + for (i = 0; i < n; i++) { + string = STRING_ELT(sub, i); + if(string != NA_STRING) + GMtext(CHAR(string), getCharCE(string), 1, vpos, where, + hpos, 0, 0.0, dd); + } + } + UNPROTECT(1); + } + if (xlab != R_NilValue) { + cex = gpptr(dd)->cexlab; + col = gpptr(dd)->collab; + font = gpptr(dd)->fontlab; + /* GetTextArg may coerce, so protect the result */ + GetTextArg(xlab, &xlab, &col, &cex, &font); + PROTECT(xlab); + gpptr(dd)->cex = gpptr(dd)->cexbase * cex; + gpptr(dd)->col = col; + gpptr(dd)->font = font; + if (R_FINITE(line)) + vpos = line; + else + vpos = gpptr(dd)->mgp[0]; + if (outer) { + hpos = adj; + where = 1; + } + else { + hpos = GConvertX(adj, NPC, USER, dd); + where = 0; + } + if (isExpression(xlab)) + GMMathText(VECTOR_ELT(xlab, 0), 1, vpos, where, + hpos, 0, 0.0, dd); + else { + n = length(xlab); + for (i = 0; i < n; i++) { + string = STRING_ELT(xlab, i); + if(string != NA_STRING) + GMtext(CHAR(string), getCharCE(string), 1, vpos + i, + where, hpos, 0, 0.0, dd); + } + } + UNPROTECT(1); + } + if (ylab != R_NilValue) { + cex = gpptr(dd)->cexlab; + col = gpptr(dd)->collab; + font = gpptr(dd)->fontlab; + /* GetTextArg may coerce, so protect the result */ + GetTextArg(ylab, &ylab, &col, &cex, &font); + PROTECT(ylab); + gpptr(dd)->cex = gpptr(dd)->cexbase * cex; + gpptr(dd)->col = col; + gpptr(dd)->font = font; + if (R_FINITE(line)) + vpos = line; + else + vpos = gpptr(dd)->mgp[0]; + if (outer) { + hpos = adj; + where = 1; + } + else { + hpos = GConvertY(adj, NPC, USER, dd); + where = 0; + } + if (isExpression(ylab)) + GMMathText(VECTOR_ELT(ylab, 0), 2, vpos, where, + hpos, 0, 0.0, dd); + else { + n = length(ylab); + for (i = 0; i < n; i++) { + string = STRING_ELT(ylab, i); + if(string != NA_STRING) + GMtext(CHAR(string), getCharCE(string), 2, vpos - i, + where, hpos, 0, 0.0, dd); + } + } + UNPROTECT(1); + } + GMode(0, dd); + GRestorePars(dd); + return R_NilValue; +} /* Title */ + + +/* abline(a, b, h, v, col, lty, lwd, ...) + draw lines in intercept/slope form. */ + +SEXP C_abline(SEXP args) +{ + SEXP a, b, h, v, untf, col, lty, lwd; + int i, ncol, nlines, nlty, nlwd, lstart, lstop; + double aa, bb, x[2], y[2]={0.,0.} /* -Wall */; + pGEDevDesc dd = GEcurrentDevice(); + + GCheckState(dd); + + args = CDR(args); + if (length(args) < 5) error(_("too few arguments")); + + if ((a = CAR(args)) != R_NilValue) + SETCAR(args, a = coerceVector(a, REALSXP)); + args = CDR(args); + + if ((b = CAR(args)) != R_NilValue) + SETCAR(args, b = coerceVector(b, REALSXP)); + args = CDR(args); + + if ((h = CAR(args)) != R_NilValue) + SETCAR(args, h = coerceVector(h, REALSXP)); + args = CDR(args); + + if ((v = CAR(args)) != R_NilValue) + SETCAR(args, v = coerceVector(v, REALSXP)); + args = CDR(args); + + if ((untf = CAR(args)) != R_NilValue) + SETCAR(args, untf = coerceVector(untf, LGLSXP)); + args = CDR(args); + + + PROTECT(col = FixupCol(CAR(args), R_TRANWHITE)); args = CDR(args); + ncol = LENGTH(col); + + PROTECT(lty = FixupLty(CAR(args), gpptr(dd)->lty)); args = CDR(args); + nlty = length(lty); + + PROTECT(lwd = FixupLwd(CAR(args), gpptr(dd)->lwd)); args = CDR(args); + nlwd = length(lwd); + + GSavePars(dd); + + ProcessInlinePars(args, dd); + + nlines = 0; + + if (a != R_NilValue) { /* case where a ans b are supplied */ + if (b == R_NilValue) { + if (LENGTH(a) != 2) + error(_("invalid a=, b= specification")); + aa = REAL(a)[0]; + bb = REAL(a)[1]; + } + else { + aa = asReal(a); + bb = asReal(b); + } + if (!R_FINITE(aa) || !R_FINITE(bb)) + error(_("'a' and 'b' must be finite")); + gpptr(dd)->col = INTEGER(col)[0]; + gpptr(dd)->lwd = REAL(lwd)[0]; + if (nlty && INTEGER(lty)[0] != NA_INTEGER) + gpptr(dd)->lty = INTEGER(lty)[0]; + else + gpptr(dd)->lty = dpptr(dd)->lty; + GMode(1, dd); + + /* FIXME? + * Seems like the logic here is just draw from xmin to xmax + * and you're guaranteed to draw at least from ymin to ymax + * This MAY cause a problem at some stage when the line being + * drawn is VERY steep -- and the problem is worse now that + * abline will potentially draw to the extents of the device + * (when xpd = NA). NOTE that R's internal clipping protects the + * device drivers from stupidly large numbers, BUT there is + * still a risk that we could produce a number which is too + * big for the computer's brain. + * Paul. + * + * The problem is worse -- you could get NaN, which at least the + * X11 device coerces to -2^31 <TSL> + */ + getxlimits(x, dd);/* -> (x[0], x[1]) */ + if (R_FINITE(gpptr(dd)->lwd)) { + Rboolean xlog = gpptr(dd)->xlog, ylog = gpptr(dd)->ylog; + if (LOGICAL(untf)[0] && (xlog || ylog)) { +#define NS 100 + /* Plot curve, linear on original scales */ + double xx[NS+1], yy[NS+1]; + if(xlog) { + /* x_i should be equidistant in log-scale, i.e., equi-ratio */ + double x_f = x[1] / DBL_MAX; + xx[0] = x[0] = fmax2(x[0], 1.01 *x_f); /* > 0 */ + x_f = pow(x[1]/x[0], 1./NS); + for (i = 1; i < NS; i++) + xx[i] = xx[i-1] * x_f; + } else { + double xstep = (x[1] - x[0])/NS; + for (i = 0; i < NS; i++) + xx[i] = x[0] + i*xstep; + } + xx[NS] = x[1]; + for (i = 0; i <= NS; i++) + yy[i] = aa + xx[i] * bb; + + /* now get rid of -ve values */ + lstart = 0;lstop = NS; + if (xlog) { + for(; lstart < NS+1 && xx[lstart] <= 0 ; lstart++); + for(; lstop > 0 && xx[lstop] <= 0 ; lstop--); + } + if (ylog) { + for(; lstart < NS+1 && yy[lstart] <= 0 ; lstart++); + for(; lstop > 0 && yy[lstop] <= 0 ; lstop--); + } + + GPolyline(lstop-lstart+1, xx+lstart, yy+lstart, USER, dd); +#undef NS + } else { /* non-log plots, possibly with log scales */ + + y[0] = aa + (xlog ? log10(x[0]) : x[0]) * bb; + y[1] = aa + (xlog ? log10(x[1]) : x[1]) * bb; + if (ylog) { + y[0] = Rexp10(y[0]); + y[1] = Rexp10(y[1]); + } + + GLine(x[0], y[0], x[1], y[1], USER, dd); + } + } + GMode(0, dd); + nlines++; + } + if (h != R_NilValue) { /* horizontal liee */ + GMode(1, dd); + for (i = 0; i < LENGTH(h); i++) { + gpptr(dd)->col = INTEGER(col)[nlines % ncol]; + if (nlty && INTEGER(lty)[nlines % nlty] != NA_INTEGER) + gpptr(dd)->lty = INTEGER(lty)[nlines % nlty]; + else + gpptr(dd)->lty = dpptr(dd)->lty; + gpptr(dd)->lwd = REAL(lwd)[nlines % nlwd]; + aa = REAL(h)[i]; + if (R_FINITE(aa) && R_FINITE(gpptr(dd)->lwd)) { + getxlimits(x, dd); + y[0] = aa; + y[1] = aa; + GLine(x[0], y[0], x[1], y[1], USER, dd); + } + nlines++; + } + GMode(0, dd); + } + if (v != R_NilValue) { /* vertical line */ + GMode(1, dd); + for (i = 0; i < LENGTH(v); i++) { + gpptr(dd)->col = INTEGER(col)[nlines % ncol]; + if (nlty && INTEGER(lty)[nlines % nlty] != NA_INTEGER) + gpptr(dd)->lty = INTEGER(lty)[nlines % nlty]; + else + gpptr(dd)->lty = dpptr(dd)->lty; + gpptr(dd)->lwd = REAL(lwd)[nlines % nlwd]; + aa = REAL(v)[i]; + if (R_FINITE(aa) && R_FINITE(gpptr(dd)->lwd)) { + getylimits(y, dd); + x[0] = aa; + x[1] = aa; + GLine(x[0], y[0], x[1], y[1], USER, dd); + } + nlines++; + } + GMode(0, dd); + } + UNPROTECT(3); + GRestorePars(dd); + return R_NilValue; +} /* Abline */ + + +SEXP C_box(SEXP args) +{ +/* box(which="plot", lty="solid", ...) + --- which is coded, 1 = plot, 2 = figure, 3 = inner, 4 = outer. +*/ + int which, col; + SEXP colsxp, fgsxp; + pGEDevDesc dd = GEcurrentDevice(); + + GCheckState(dd); + GSavePars(dd); + args = CDR(args); + which = asInteger(CAR(args)); args = CDR(args); + if (which < 1 || which > 4) + error(_("invalid '%s' argument"), "which"); + /* + * If specified non-NA col then use that, else ... + * + * if specified non-NA fg then use that, else ... + * + * else use par("col") + */ + col= gpptr(dd)->col; + ProcessInlinePars(args, dd); + colsxp = getInlinePar(args, "col"); + if (isNAcol(colsxp, 0, 1)) { + fgsxp = getInlinePar(args, "fg"); + if (isNAcol(fgsxp, 0, 1)) + gpptr(dd)->col = col; + else + gpptr(dd)->col = gpptr(dd)->fg; + } + /* override par("xpd") and force clipping to device region */ + gpptr(dd)->xpd = 2; + GMode(1, dd); + GBox(which, dd); + GMode(0, dd); + GRestorePars(dd); + return R_NilValue; +} + +static void drawPointsLines(double xp, double yp, double xold, double yold, + char type, int first, pGEDevDesc dd) +{ + if (type == 'p' || type == 'o') + GSymbol(xp, yp, DEVICE, gpptr(dd)->pch, dd); + if ((type == 'l' || type == 'o') && !first) + GLine(xold, yold, xp, yp, DEVICE, dd); +} + +SEXP C_locator(SEXP call, SEXP op, SEXP args, SEXP rho) +{ + SEXP x, y, nobs, ans, saveans, stype = R_NilValue; + int i, n; + char type = 'p'; + double xp, yp, xold=0, yold=0; + pGEDevDesc dd = GEcurrentDevice(); + SEXP name = CAR(args); + + args = CDR(args); + /* If replaying, just draw the points and lines that were recorded */ + if (call == R_NilValue) { + x = CAR(args); args = CDR(args); + y = CAR(args); args = CDR(args); + nobs = CAR(args); args = CDR(args); + n = INTEGER(nobs)[0]; + stype = CAR(args); args = CDR(args); + type = CHAR(STRING_ELT(stype, 0))[0]; + if (type != 'n') { + GMode(1, dd); + for (i = 0; i < n; i++) { + xp = REAL(x)[i]; + yp = REAL(y)[i]; + GConvert(&xp, &yp, USER, DEVICE, dd); + drawPointsLines(xp, yp, xold, yold, type, i==0, dd); + xold = xp; + yold = yp; + } + GMode(0, dd); + } + return R_NilValue; + } else { + GCheckState(dd); + + n = asInteger(CAR(args)); + if (n <= 0 || n == NA_INTEGER) + error(_("invalid number of points in %s"), "locator()"); + args = CDR(args); + if (isString(CAR(args)) && LENGTH(CAR(args)) == 1) + stype = CAR(args); + else + error(_("invalid plot type")); + type = CHAR(STRING_ELT(stype, 0))[0]; + PROTECT(x = allocVector(REALSXP, n)); + PROTECT(y = allocVector(REALSXP, n)); + PROTECT(nobs=allocVector(INTSXP,1)); + + GMode(2, dd); + for (i = 0; i < n; i++) { + if (!GLocator(&(REAL(x)[i]), &(REAL(y)[i]), USER, dd)) break; + if (type != 'n') { + GMode(1, dd); + xp = REAL(x)[i]; + yp = REAL(y)[i]; + GConvert(&xp, &yp, USER, DEVICE, dd); + drawPointsLines(xp, yp, xold, yold, type, i==0, dd); + GMode(0, dd); + GMode(2, dd); + xold = xp; yold = yp; + } + } + GMode(0, dd); + INTEGER(nobs)[0] = i; + for (; i < n; i++) { + REAL(x)[i] = NA_REAL; + REAL(y)[i] = NA_REAL; + } + PROTECT(ans = allocList(3)); + SETCAR(ans, x); + SETCADR(ans, y); + SETCADDR(ans, nobs); + if (GRecording(call, dd)) { + PROTECT(saveans = allocList(5)); + SETCAR(saveans, name); + SETCADR(saveans, x); + SETCADDR(saveans, y); + SETCADDDR(saveans, nobs); + SETCAD4R(saveans, CAR(args)); + /* Record the points and lines that were drawn in the display list */ + GErecordGraphicOperation(op, saveans, dd); + UNPROTECT(1); + } + UNPROTECT(4); + return ans; + } +} + +static void drawLabel(double xi, double yi, int pos, double offset, + const char *l, cetype_t enc, pGEDevDesc dd) +{ + switch (pos) { + case 4: + xi = xi+offset; + GText(xi, yi, INCHES, l, enc, 0.0, + dd->dev->yCharOffset, 0.0, dd); + break; + case 2: + xi = xi-offset; + GText(xi, yi, INCHES, l, enc, 1.0, + dd->dev->yCharOffset, 0.0, dd); + break; + case 3: + yi = yi+offset; + GText(xi, yi, INCHES, l, enc, 0.5, + 0.0, 0.0, dd); + break; + case 1: + yi = yi-offset; + GText(xi, yi, INCHES, l, enc, 0.5, + 1-(0.5-dd->dev->yCharOffset), + 0.0, dd); + break; + case 0: + GText(xi, yi, INCHES, l, enc, 0.0, 0.0, 0.0, dd); + break; + } +} + +SEXP C_identify(SEXP call, SEXP op, SEXP args, SEXP rho) +{ + SEXP ans, x, y, l, ind, pos, Offset, draw, saveans; + double xi, yi, xp, yp, d, dmin, offset, tol; + int atpen, i, imin, k, n, nl, npts, plot, posi, warn; + pGEDevDesc dd = GEcurrentDevice(); + SEXP name = CAR(args); + + args = CDR(args); + /* If we are replaying the display list, then just redraw the + labels beside the identified points */ + if (call == R_NilValue) { + ind = CAR(args); args = CDR(args); + pos = CAR(args); args = CDR(args); + x = CAR(args); args = CDR(args); + y = CAR(args); args = CDR(args); + Offset = CAR(args); args = CDR(args); + l = CAR(args); args = CDR(args); + draw = CAR(args); + n = LENGTH(x); + nl = LENGTH(l); + /* + * Most of the appropriate settings have been set up in + * R code by par(...) + * Hence no GSavePars() or ProcessInlinePars() here + * (also because this function is unusual in that it does + * different things when run by a user compared to when + * run from the display list) + * BUT par(cex) only sets cexbase, so here we set cex from cexbase + */ + gpptr(dd)->cex = gpptr(dd)->cexbase; + offset = GConvertXUnits(asReal(Offset), CHARS, INCHES, dd); + for (i = 0; i < n; i++) { + plot = LOGICAL(ind)[i]; + if (LOGICAL(draw)[0] && plot) { + xi = REAL(x)[i]; + yi = REAL(y)[i]; + GConvert(&xi, &yi, USER, INCHES, dd); + posi = INTEGER(pos)[i]; + drawLabel(xi, yi, posi, offset, + CHAR(STRING_ELT(l, i % nl)), + getCharCE(STRING_ELT(l, i % nl)), dd); + } + } + return R_NilValue; + } + else { + GCheckState(dd); + + x = CAR(args); args = CDR(args); + y = CAR(args); args = CDR(args); + l = CAR(args); args = CDR(args); + npts = asInteger(CAR(args)); args = CDR(args); + plot = asLogical(CAR(args)); args = CDR(args); + Offset = CAR(args); args = CDR(args); + tol = asReal(CAR(args)); args = CDR(args); + atpen = asLogical(CAR(args)); + if (npts <= 0 || npts == NA_INTEGER) + error(_("invalid number of points in %s"), "identify()"); + if (!isReal(x) || !isReal(y) || !isString(l) || !isReal(Offset)) + error(_("incorrect argument type")); + if (tol <= 0 || ISNAN(tol)) + error(_("invalid '%s' value"), "tolerance"); + if (plot == NA_LOGICAL) + error(_("invalid '%s' value"), "plot"); + if (atpen == NA_LOGICAL) + error(_("invalid '%s' value"), "atpen"); + nl = LENGTH(l); + if (nl <= 0) + error(_("zero-length '%s' specified"), "labels"); + n = LENGTH(x); + if (n != LENGTH(y)) + error(_("different argument lengths")); + if (nl > n) + warning(_("more 'labels' than points")); + + /* + * Most of the appropriate settings have been set up in + * R code by par(...) + * Hence no GSavePars() or ProcessInlinePars() here + * (also because this function is unusual in that it does + * different things when run by a user compared to when + * run from the display list) + * BUT par(cex) only sets cexbase, so here we set cex from cexbase + */ + gpptr(dd)->cex = gpptr(dd)->cexbase; + offset = GConvertXUnits(asReal(Offset), CHARS, INCHES, dd); + PROTECT(ind = allocVector(LGLSXP, n)); + PROTECT(pos = allocVector(INTSXP, n)); + for (i = 0; i < n; i++) LOGICAL(ind)[i] = 0; + + k = 0; + GMode(2, dd); + PROTECT(x = duplicate(x)); + PROTECT(y = duplicate(y)); + while (k < npts) { + if (!GLocator(&xp, &yp, INCHES, dd)) break; + /* + * Repeat cex setting from cexbase within loop + * so that if window is redrawn + * (e.g., conver/uncover window) + * during identifying (i.e., between clicks) + * we reset cex properly. + */ + gpptr(dd)->cex = gpptr(dd)->cexbase; + dmin = DBL_MAX; + imin = -1; + for (i = 0; i < n; i++) { + xi = REAL(x)[i]; + yi = REAL(y)[i]; + GConvert(&xi, &yi, USER, INCHES, dd); + if (!R_FINITE(xi) || !R_FINITE(yi)) continue; + d = hypot(xp-xi, yp-yi); + if (d < dmin) { + imin = i; + dmin = d; + } + } + /* can't use warning because we want to print immediately */ + /* might want to handle warn=2? */ + warn = asInteger(GetOption1(install("warn"))); + if (dmin > tol) { + if(warn >= 0) { + REprintf(_("warning: no point within %.2f inches\n"), tol); + R_FlushConsole(); + } + } + else if (LOGICAL(ind)[imin]) { + if(warn >= 0 ) { + REprintf(_("warning: nearest point already identified\n")); + R_FlushConsole(); + } + } + else { + k++; + LOGICAL(ind)[imin] = 1; + + if (atpen) { + xi = xp; + yi = yp; + INTEGER(pos)[imin] = 0; + /* now record where to replot if necessary */ + GConvert(&xp, &yp, INCHES, USER, dd); + REAL(x)[imin] = xp; REAL(y)[imin] = yp; + } else { + xi = REAL(x)[imin]; + yi = REAL(y)[imin]; + GConvert(&xi, &yi, USER, INCHES, dd); + if (fabs(xp-xi) >= fabs(yp-yi)) { + if (xp >= xi) + INTEGER(pos)[imin] = 4; + else + INTEGER(pos)[imin] = 2; + } else { + if (yp >= yi) + INTEGER(pos)[imin] = 3; + else + INTEGER(pos)[imin] = 1; + } + } + if (plot) { + drawLabel(xi, yi, INTEGER(pos)[imin], offset, + CHAR(STRING_ELT(l, imin % nl)), + getCharCE(STRING_ELT(l, imin % nl)), dd); + GMode(0, dd); + GMode(2, dd); + } + } + } + GMode(0, dd); + PROTECT(ans = allocList(2)); + SETCAR(ans, ind); + SETCADR(ans, pos); + if (GRecording(call, dd)) { + /* If we are recording, save enough information to be able to + redraw the text labels beside identified points */ + PROTECT(saveans = allocList(8)); + SETCAR(saveans, name); + SETCADR(saveans, ind); + SETCADDR(saveans, pos); + SETCADDDR(saveans, x); + SETCAD4R(saveans, y); + SETCAR(nthcdr(saveans,5), Offset); + SETCAR(nthcdr(saveans,6), l); + SETCAR(nthcdr(saveans,7), ScalarLogical(plot)); + + GErecordGraphicOperation(op, saveans, dd); + UNPROTECT(1); + } + UNPROTECT(5); + + return ans; + } +} + +/* strheight(str, units, cex, font, vfont, ...) || strwidth() */ +#define DO_STR_DIM(KIND) \ +{ \ + SEXP ans, str, ch, font, vfont; \ + int i, n, units; \ + double cex, cexsave; \ + pGEDevDesc dd = GEcurrentDevice(); \ + args = CDR(args); \ + if (length(args) < 5) error(_("too few arguments")); \ + \ + str = CAR(args); \ + if (isSymbol(str) || isLanguage(str)) \ + str = coerceVector(str, EXPRSXP); \ + else if (!isExpression(str)) \ + str = coerceVector(str, STRSXP); \ + PROTECT(str); \ + args = CDR(args); \ + \ + if ((units = asInteger(CAR(args))) == NA_INTEGER || units < 0) \ + error(_("invalid units")); \ + if(units == 1) GCheckState(dd); \ + args = CDR(args); \ + \ + if (isNull(CAR(args))) \ + cex = gpptr(dd)->cex; \ + else if (!R_FINITE((cex = asReal(CAR(args)))) || cex <= 0.0) \ + error(_("invalid '%s' value"), "cex"); \ + args = CDR(args); \ + PROTECT(font = FixupFont(CAR(args), NA_INTEGER)); args = CDR(args); \ + PROTECT(vfont = FixupVFont(CAR(args))); args = CDR(args); \ + GSavePars(dd); \ + ProcessInlinePars(args, dd); \ + \ + /* 'vfont' trumps inline 'family' */ \ + if (!isNull(vfont) && !isExpression(str)) { \ + strncpy(gpptr(dd)->family, "Hershey ", 201); \ + gpptr(dd)->family[7] = (char)INTEGER(vfont)[0]; \ + gpptr(dd)->font = INTEGER(vfont)[1]; \ + } else gpptr(dd)->font = INTEGER(font)[0]; \ + \ + n = LENGTH(str); \ + PROTECT(ans = allocVector(REALSXP, n)); \ + cexsave = gpptr(dd)->cex; \ + gpptr(dd)->cex = cex * gpptr(dd)->cexbase; \ + for (i = 0; i < n; i++) \ + if (isExpression(str)) \ + REAL(ans)[i] = GExpression ## KIND(VECTOR_ELT(str, i), \ + GMapUnits(units), dd); \ + else { \ + ch = STRING_ELT(str, i); \ + REAL(ans)[i] = (ch == NA_STRING) ? 0.0 : \ + GStr ## KIND(CHAR(ch), getCharCE(ch), GMapUnits(units), dd); \ + } \ + gpptr(dd)->cex = cexsave; \ + GRestorePars(dd); \ + UNPROTECT(4); \ + return ans; \ +} + +SEXP C_strHeight(SEXP args) +DO_STR_DIM(Height) + +SEXP C_strWidth (SEXP args) +DO_STR_DIM(Width) + +#undef DO_STR_DIM + + +static int *dnd_lptr; +static int *dnd_rptr; +static double *dnd_hght; +static double *dnd_xpos; +static double dnd_hang; +static double dnd_offset; + +static void drawdend(int node, double *x, double *y, SEXP dnd_llabels, + pGEDevDesc dd) +{ +/* Recursive function for 'hclust' dendrogram drawing: + * Do left + Do right + Do myself + * "do" : 1) label leafs (if there are) and __ + * 2) find coordinates to draw the | | + * 3) return (*x,*y) of "my anchor" + */ + double xl, xr, yl, yr; + double xx[4], yy[4]; + int k; + + *y = dnd_hght[node-1]; + /* left part */ + k = dnd_lptr[node-1]; + if (k > 0) drawdend(k, &xl, &yl, dnd_llabels, dd); + else { + xl = dnd_xpos[-k-1]; + yl = (dnd_hang >= 0) ? *y - dnd_hang : 0; + if(STRING_ELT(dnd_llabels, -k-1) != NA_STRING) + GText(xl, yl-dnd_offset, USER, + CHAR(STRING_ELT(dnd_llabels, -k-1)), + getCharCE(STRING_ELT(dnd_llabels, -k-1)), + 1.0, 0.3, 90.0, dd); + } + /* right part */ + k = dnd_rptr[node-1]; + if (k > 0) drawdend(k, &xr, &yr, dnd_llabels, dd); + else { + xr = dnd_xpos[-k-1]; + yr = (dnd_hang >= 0) ? *y - dnd_hang : 0; + if(STRING_ELT(dnd_llabels, -k-1) != NA_STRING) + GText(xr, yr-dnd_offset, USER, + CHAR(STRING_ELT(dnd_llabels, -k-1)), + getCharCE(STRING_ELT(dnd_llabels, -k-1)), + 1.0, 0.3, 90.0, dd); + } + xx[0] = xl; yy[0] = yl; + xx[1] = xl; yy[1] = *y; + xx[2] = xr; yy[2] = *y; + xx[3] = xr; yy[3] = yr; + GPolyline(4, xx, yy, USER, dd); + *x = 0.5 * (xl + xr); +} + + +SEXP C_dend(SEXP args) +{ + double x, y; + int n; + + SEXP dnd_llabels, xpos; + pGEDevDesc dd; + + dd = GEcurrentDevice(); + GCheckState(dd); + + args = CDR(args); + if (length(args) < 6) + error(_("too few arguments")); + + /* n */ + n = asInteger(CAR(args)); + if (n == NA_INTEGER || n < 2) + goto badargs; + args = CDR(args); + + /* merge */ + if (TYPEOF(CAR(args)) != INTSXP || length(CAR(args)) != 2*n) + goto badargs; + dnd_lptr = &(INTEGER(CAR(args))[0]); + dnd_rptr = &(INTEGER(CAR(args))[n]); + args = CDR(args); + + /* height */ + if (TYPEOF(CAR(args)) != REALSXP || length(CAR(args)) != n) + goto badargs; + dnd_hght = REAL(CAR(args)); + args = CDR(args); + + /* ord = order(x$order) */ + if (length(CAR(args)) != n+1) + goto badargs; + PROTECT(xpos = coerceVector(CAR(args), REALSXP)); + dnd_xpos = REAL(xpos); + args = CDR(args); + + /* hang */ + dnd_hang = asReal(CAR(args)); + if (!R_FINITE(dnd_hang)) + goto badargs; + dnd_hang = dnd_hang * (dnd_hght[n-1] - dnd_hght[0]); + args = CDR(args); + + /* labels */ + if (TYPEOF(CAR(args)) != STRSXP || length(CAR(args)) != n+1) + goto badargs; + dnd_llabels = CAR(args); + args = CDR(args); + + GSavePars(dd); + ProcessInlinePars(args, dd); + gpptr(dd)->cex = gpptr(dd)->cexbase * gpptr(dd)->cex; + dnd_offset = GConvertYUnits(GStrWidth("m", CE_ANY, INCHES, dd), INCHES, + USER, dd); + + /* override par("xpd") and force clipping to figure region + NOTE: don't override to _reduce_ clipping region */ + if (gpptr(dd)->xpd < 1) + gpptr(dd)->xpd = 1; + + GMode(1, dd); + drawdend(n, &x, &y, dnd_llabels, dd); + GMode(0, dd); + GRestorePars(dd); + UNPROTECT(1); + return R_NilValue; + + badargs: + error(_("invalid dendrogram input")); + return R_NilValue;/* never used; to keep -Wall happy */ +} + +SEXP C_dendwindow(SEXP args) +{ + int i, imax, n; + double pin, *ll, tmp, yval, *y, ymin, ymax, yrange, m; + SEXP merge, height, llabels, str; + const void *vmax; + pGEDevDesc dd; + + dd = GEcurrentDevice(); + GCheckState(dd); + args = CDR(args); + if (length(args) < 5) + error(_("too few arguments")); + n = asInteger(CAR(args)); + if (n == NA_INTEGER || n < 2) + goto badargs; + args = CDR(args); + if (TYPEOF(CAR(args)) != INTSXP || length(CAR(args)) != 2 * n) + goto badargs; + merge = CAR(args); + + args = CDR(args); + if (TYPEOF(CAR(args)) != REALSXP || length(CAR(args)) != n) + goto badargs; + height = CAR(args); + + args = CDR(args); + dnd_hang = asReal(CAR(args)); + if (!R_FINITE(dnd_hang)) + goto badargs; + + args = CDR(args); + if (TYPEOF(CAR(args)) != STRSXP || length(CAR(args)) != n + 1) + goto badargs; + llabels = CAR(args); + + args = CDR(args); + GSavePars(dd); + ProcessInlinePars(args, dd); + gpptr(dd)->cex = gpptr(dd)->cexbase * gpptr(dd)->cex; + dnd_offset = GStrWidth("m", CE_ANY, INCHES, dd); + vmax = vmaxget(); + /* n is the number of merges, so the points are labelled 1 ... n+1 */ + y = (double*)R_alloc(n+1, sizeof(double)); + ll = (double*)R_alloc(n+1, sizeof(double)); + dnd_lptr = &(INTEGER(merge)[0]); + dnd_rptr = &(INTEGER(merge)[n]); + ymax = ymin = REAL(height)[0]; + for (i = 1; i < n; i++) { + m = REAL(height)[i]; + if (m > ymax) + ymax = m; + else if (m < ymin) + ymin = m; + } + pin = gpptr(dd)->pin[1]; + for (i = 0; i <= n; i++) { + str = STRING_ELT(llabels, i); + ll[i] = (str == NA_STRING) ? 0.0 : + GStrWidth(CHAR(str), getCharCE(str), INCHES, dd) + dnd_offset; + } + + imax = -1; yval = -DBL_MAX; + if (dnd_hang >= 0) { + ymin = ymax - (1 + dnd_hang) * (ymax - ymin); + yrange = ymax - ymin; + /* determine leaf heights */ + for (i = 0; i < n; i++) { + if (dnd_lptr[i] < 0) + y[-dnd_lptr[i] - 1] = REAL(height)[i]; + if (dnd_rptr[i] < 0) + y[-dnd_rptr[i] - 1] = REAL(height)[i]; + } + /* determine the most extreme label depth */ + /* assuming that we are using the full plot */ + /* window for the tree itself */ + for (i = 0; i <= n; i++) { + tmp = ((ymax - y[i]) / yrange) * pin + ll[i]; + if (tmp > yval) { + yval = tmp; + imax = i; + } + } + } + else { + yrange = ymax; + for (i = 0; i <= n; i++) { + tmp = pin + ll[i]; + if (tmp > yval) { + yval = tmp; + imax = i; + } + } + } + /* now determine how much to scale */ + ymin = ymax - (pin/(pin - ll[imax])) * yrange; + GScale(1.0, n+1.0, 1 /* x */, dd); + GScale(ymin, ymax, 2 /* y */, dd); + GMapWin2Fig(dd); + GRestorePars(dd); + vmaxset(vmax); + return R_NilValue; + badargs: + error(_("invalid dendrogram input")); + return R_NilValue;/* never used; to keep -Wall happy */ +} + + +SEXP C_erase(SEXP args) +{ + SEXP col; + pGEDevDesc dd = GEcurrentDevice(); + args = CDR(args); + PROTECT(col = FixupCol(CAR(args), R_TRANWHITE)); + GSavePars(dd); + GMode(1, dd); + GRect(0.0, 0.0, 1.0, 1.0, NDC, INTEGER(col)[0], R_TRANWHITE, dd); + GMode(0, dd); + GRestorePars(dd); + UNPROTECT(1); + return R_NilValue; +} + +/* symbols(..) in ../library/base/R/symbols.R : */ + +/* utility just computing range() */ +static Rboolean SymbolRange(double *x, int n, double *xmax, double *xmin) +{ + int i; + *xmax = -DBL_MAX; + *xmin = DBL_MAX; + for(i = 0; i < n; i++) + if (R_FINITE(x[i])) { + if (*xmax < x[i]) *xmax = x[i]; + if (*xmin > x[i]) *xmin = x[i]; + } + return(*xmax >= *xmin && *xmin >= 0); +} + +static void CheckSymbolPar(SEXP p, int *nr, int *nc) +{ + SEXP dim = getAttrib(p, R_DimSymbol); + switch(length(dim)) { + case 0: + *nr = LENGTH(p); + *nc = 1; + break; + case 1: + *nr = INTEGER(dim)[0]; + *nc = 1; + break; + case 2: + *nr = INTEGER(dim)[0]; + *nc = INTEGER(dim)[1]; + break; + default: + *nr = 0; + *nc = 0; + } + if (*nr == 0 || *nc == 0) + error(_("invalid symbol parameter vector")); +} + +/* Internal symbols(x, y, type, data, inches, bg, fg, ...) */ +SEXP C_symbols(SEXP args) +{ + SEXP x, y, p, fg, bg; + int i, j, nr, nc, nbg, nfg, type; + double pmax, pmin, inches, rx, ry; + double xx, yy, p0, p1, p2, p3, p4; + double *pp, *xp, *yp; + const void *vmax; + + pGEDevDesc dd = GEcurrentDevice(); + GCheckState(dd); + args = CDR(args); + + if (length(args) < 7) + error(_("too few arguments")); + + PROTECT(x = coerceVector(CAR(args), REALSXP)); args = CDR(args); + PROTECT(y = coerceVector(CAR(args), REALSXP)); args = CDR(args); + if (!isNumeric(x) || !isNumeric(y) || length(x) <= 0 || LENGTH(x) <= 0) + error(_("invalid symbol coordinates")); + + type = asInteger(CAR(args)); args = CDR(args); + + /* data: */ + p = PROTECT(coerceVector(CAR(args), REALSXP)); args = CDR(args); + CheckSymbolPar(p, &nr, &nc); + if (LENGTH(x) != nr || LENGTH(y) != nr) + error(_("x/y/parameter length mismatch")); + + inches = asReal(CAR(args)); args = CDR(args); + if (!R_FINITE(inches) || inches < 0) + inches = 0; + + PROTECT(bg = FixupCol(CAR(args), R_TRANWHITE)); args = CDR(args); + nbg = LENGTH(bg); + + PROTECT(fg = FixupCol(CAR(args), R_TRANWHITE)); args = CDR(args); + nfg = LENGTH(fg); + + GSavePars(dd); + ProcessInlinePars(args, dd); + + GMode(1, dd); + switch (type) { + case 1: /* circles */ + if (nc != 1) + error(_("invalid circles data")); + if (!SymbolRange(REAL(p), nr, &pmax, &pmin)) + error(_("invalid symbol parameter")); + for (i = 0; i < nr; i++) { + if (R_FINITE(REAL(x)[i]) && R_FINITE(REAL(y)[i]) && + R_FINITE(REAL(p)[i])) { + rx = REAL(p)[i]; + /* For GCircle the radius is always in INCHES */ + if (inches > 0) + rx *= inches / pmax; + else + rx = GConvertXUnits(rx, USER, INCHES, dd); + /* GCircle sets radius zero to one pixel, but does + not change very small non-zero radii */ + GCircle(REAL(x)[i], REAL(y)[i], USER, rx, + INTEGER(bg)[i % nbg], INTEGER(fg)[i % nfg], dd); + } + } + break; + case 2: /* squares */ + if(nc != 1) + error(_("invalid squares data")); + if(!SymbolRange(REAL(p), nr, &pmax, &pmin)) + error(_("invalid symbol parameter")); + for (i = 0; i < nr; i++) { + if (R_FINITE(REAL(x)[i]) && R_FINITE(REAL(y)[i]) && + R_FINITE(REAL(p)[i])) { + p0 = REAL(p)[i]; + xx = REAL(x)[i]; + yy = REAL(y)[i]; + GConvert(&xx, &yy, USER, DEVICE, dd); + if (inches > 0) { + p0 *= inches / pmax; + rx = GConvertXUnits(0.5 * p0, INCHES, DEVICE, dd); + } + else { + rx = GConvertXUnits(0.5 * p0, USER, DEVICE, dd); + } + /* FIXME: should this skip 0-sized symbols? */ + GRect(xx - rx, yy - rx, xx + rx, yy + rx, DEVICE, + INTEGER(bg)[i % nbg], INTEGER(fg)[i % nfg], dd); + } + } + break; + case 3: /* rectangles */ + if (nc != 2) + error(_("invalid rectangles data (need 2 columns)")); + if (!SymbolRange(REAL(p), 2 * nr, &pmax, &pmin)) + error(_("invalid symbol parameter")); + for (i = 0; i < nr; i++) { + if (R_FINITE(REAL(x)[i]) && R_FINITE(REAL(y)[i]) && + R_FINITE(REAL(p)[i]) && R_FINITE(REAL(p)[i+nr])) { + xx = REAL(x)[i]; + yy = REAL(y)[i]; + GConvert(&xx, &yy, USER, DEVICE, dd); + p0 = REAL(p)[i]; + p1 = REAL(p)[i+nr]; + if (inches > 0) { + p0 *= inches / pmax; + p1 *= inches / pmax; + rx = GConvertXUnits(0.5 * p0, INCHES, DEVICE, dd); + ry = GConvertYUnits(0.5 * p1, INCHES, DEVICE, dd); + } + else { + rx = GConvertXUnits(0.5 * p0, USER, DEVICE, dd); + ry = GConvertYUnits(0.5 * p1, USER, DEVICE, dd); + } + /* FIXME: should this skip 0-sized symbols? */ + GRect(xx - rx, yy - ry, xx + rx, yy + ry, DEVICE, + INTEGER(bg)[i % nbg], INTEGER(fg)[i % nfg], dd); + + } + } + break; + case 4: /* stars */ + if (nc < 3) + error(_("invalid stars data")); + if (!SymbolRange(REAL(p), nc * nr, &pmax, &pmin)) + error(_("invalid symbol parameter")); + vmax = vmaxget(); + pp = (double*)R_alloc(nc, sizeof(double)); + xp = (double*)R_alloc(nc, sizeof(double)); + yp = (double*)R_alloc(nc, sizeof(double)); + p1 = 2.0 * M_PI / nc; + for (i = 0; i < nr; i++) { + xx = REAL(x)[i]; + yy = REAL(y)[i]; + if (R_FINITE(xx) && R_FINITE(yy)) { + GConvert(&xx, &yy, USER, NDC, dd); + if (inches > 0) { + for(j = 0; j < nc; j++) { + p0 = REAL(p)[i + j * nr]; + if (!R_FINITE(p0)) p0 = 0; + pp[j] = (p0 / pmax) * inches; + } + } + else { + for(j = 0; j < nc; j++) { + p0 = REAL(p)[i + j * nr]; + if (!R_FINITE(p0)) p0 = 0; + pp[j] = GConvertXUnits(p0, USER, INCHES, dd); + } + } + /* FIXME: should this skip 0-sized symbols? */ + for(j = 0; j < nc; j++) { + xp[j] = GConvertXUnits(pp[j] * cos(j * p1), + INCHES, NDC, dd) + xx; + yp[j] = GConvertYUnits(pp[j] * sin(j * p1), + INCHES, NDC, dd) + yy; + } + GPolygon(nc, xp, yp, NDC, + INTEGER(bg)[i % nbg], INTEGER(fg)[i % nfg], dd); + } + } + vmaxset(vmax); + break; + case 5: /* thermometers */ + if (nc != 3 && nc != 4) + error(_("invalid thermometers data (need 3 or 4 columns)")); + SymbolRange(REAL(p)+2*nr/* <-- pointer arith*/, nr, &pmax, &pmin); + if (pmax < pmin) + error(_("invalid 'thermometers[, %s]'"), + (nc == 4)? "3:4" : "3"); + if (pmin < 0. || pmax > 1.) /* S-PLUS has an error here */ + warning(_("'thermometers[, %s]' not in [0,1] -- may look funny"), + (nc == 4)? "3:4" : "3"); + if (!SymbolRange(REAL(p), 2 * nr, &pmax, &pmin)) + error(_("invalid 'thermometers[, 1:2]'")); + for (i = 0; i < nr; i++) { + xx = REAL(x)[i]; + yy = REAL(y)[i]; + if (R_FINITE(xx) && R_FINITE(yy)) { + p0 = REAL(p)[i]; + p1 = REAL(p)[i + nr]; + p2 = REAL(p)[i + 2 * nr]; + p3 = (nc == 4)? REAL(p)[i + 3 * nr] : 0.; + if (R_FINITE(p0) && R_FINITE(p1) && + R_FINITE(p2) && R_FINITE(p3)) { + if (p2 < 0) p2 = 0; else if (p2 > 1) p2 = 1; + if (p3 < 0) p3 = 0; else if (p3 > 1) p3 = 1; + GConvert(&xx, &yy, USER, NDC, dd); + if (inches > 0) { + p0 *= inches / pmax; + p1 *= inches / pmax; + rx = GConvertXUnits(0.5 * p0, INCHES, NDC, dd); + ry = GConvertYUnits(0.5 * p1, INCHES, NDC, dd); + } + else { + rx = GConvertXUnits(0.5 * p0, USER, NDC, dd); + ry = GConvertYUnits(0.5 * p1, USER, NDC, dd); + } + GRect(xx - rx, yy - ry, xx + rx, yy + ry, NDC, + INTEGER(bg)[i % nbg], INTEGER(fg)[i % nfg], dd); + GRect(xx - rx, yy - (1 - 2 * p2) * ry, + xx + rx, yy - (1 - 2 * p3) * ry, + NDC, + INTEGER(fg)[i % nfg], INTEGER(fg)[i % nfg], dd); + GLine(xx - rx, yy, xx - 1.5 * rx, yy, NDC, dd); + GLine(xx + rx, yy, xx + 1.5 * rx, yy, NDC, dd); + + } + } + } + break; + case 6: /* boxplots (wid, hei, loWhsk, upWhsk, medProp) */ + if (nc != 5) + error(_("invalid 'boxplots' data (need 5 columns)")); + pmax = -DBL_MAX; + pmin = DBL_MAX; + for(i = 0; i < nr; i++) { + p4 = REAL(p)[i + 4 * nr]; /* median proport. in [0,1] */ + if (pmax < p4) pmax = p4; + if (pmin > p4) pmin = p4; + } + if (pmin < 0. || pmax > 1.) /* S-PLUS has an error here */ + warning(_("'boxplots[, 5]' outside [0,1] -- may look funny")); + if (!SymbolRange(REAL(p), 4 * nr, &pmax, &pmin)) + error(_("invalid 'boxplots[, 1:4]'")); + for (i = 0; i < nr; i++) { + xx = REAL(x)[i]; + yy = REAL(y)[i]; + if (R_FINITE(xx) && R_FINITE(yy)) { + p0 = REAL(p)[i]; /* width */ + p1 = REAL(p)[i + nr]; /* height */ + p2 = REAL(p)[i + 2 * nr];/* lower whisker */ + p3 = REAL(p)[i + 3 * nr];/* upper whisker */ + p4 = REAL(p)[i + 4 * nr];/* median proport. in [0,1] */ + if (R_FINITE(p0) && R_FINITE(p1) && + R_FINITE(p2) && R_FINITE(p3) && R_FINITE(p4)) { + GConvert(&xx, &yy, USER, NDC, dd); + if (inches > 0) { + p0 *= inches / pmax; + p1 *= inches / pmax; + p2 *= inches / pmax; + p3 *= inches / pmax; + p0 = GConvertXUnits(p0, INCHES, NDC, dd); + p1 = GConvertYUnits(p1, INCHES, NDC, dd); + p2 = GConvertYUnits(p2, INCHES, NDC, dd); + p3 = GConvertYUnits(p3, INCHES, NDC, dd); + } + else { + p0 = GConvertXUnits(p0, USER, NDC, dd); + p1 = GConvertYUnits(p1, USER, NDC, dd); + p2 = GConvertYUnits(p2, USER, NDC, dd); + p3 = GConvertYUnits(p3, USER, NDC, dd); + } + rx = 0.5 * p0; + ry = 0.5 * p1; + p4 = (1 - p4) * (yy - ry) + p4 * (yy + ry); + /* Box */ + GRect(xx - rx, yy - ry, xx + rx, yy + ry, NDC, + INTEGER(bg)[i % nbg], INTEGER(fg)[i % nfg], dd); + /* Median */ + GLine(xx - rx, p4, xx + rx, p4, NDC, dd); + /* Lower Whisker */ + GLine(xx, yy - ry, xx, yy - ry - p2, NDC, dd); + /* Upper Whisker */ + GLine(xx, yy + ry, xx, yy + ry + p3, NDC, dd); + } + } + } + break; + default: + error(_("invalid symbol type")); + } + GMode(0, dd); + GRestorePars(dd); + UNPROTECT(5); + return R_NilValue; +} + +SEXP C_xspline(SEXP args) +{ + SEXP sx, sy, ss, col, border, res, ans = R_NilValue; + int i, nx; + int ncol, nborder; + double *x, *y; + Rboolean open, repEnds, draw; + double *xx; + double *yy; + const void *vmaxsave; + R_GE_gcontext gc; + + pGEDevDesc dd = GEcurrentDevice(); + + GCheckState(dd); + args = CDR(args); + + if (length(args) < 6) error(_("too few arguments")); + /* (x,y) is checked in R via xy.coords() ; no need here : */ + sx = SETCAR(args, coerceVector(CAR(args), REALSXP)); args = CDR(args); + sy = SETCAR(args, coerceVector(CAR(args), REALSXP)); args = CDR(args); + nx = LENGTH(sx); + ss = SETCAR(args, coerceVector(CAR(args), REALSXP)); args = CDR(args); + open = asLogical(CAR(args)); args = CDR(args); + repEnds = asLogical(CAR(args)); args = CDR(args); + draw = asLogical(CAR(args)); args = CDR(args); + + PROTECT(col = FixupCol(CAR(args), R_TRANWHITE)); args = CDR(args); + ncol = LENGTH(col); + if(ncol < 1) + error(_("incorrect length for '%s' argument"), "col"); + if(ncol > 1) + warning(_("incorrect length for '%s' argument"), "col"); + + PROTECT(border = FixupCol(CAR(args), gpptr(dd)->fg)); args = CDR(args); + nborder = LENGTH(border); + if(nborder < 1) + error(_("incorrect length for '%s' argument"), "border"); + if(nborder > 1) + warning(_("incorrect length for '%s' argument"), "border"); + + GSavePars(dd); + ProcessInlinePars(args, dd); + /* Paul 2008-12-05 + * Convert GP to gcontext AFTER ProcessInlinePars + */ + gcontextFromGP(&gc, dd); + + GMode(1, dd); + + x = REAL(sx); + y = REAL(sy); + vmaxsave = vmaxget(); + xx = (double *) R_alloc(nx, sizeof(double)); + yy = (double *) R_alloc(nx, sizeof(double)); + if (!xx || !yy) + error("unable to allocate memory (in xspline)"); + for (i = 0; i < nx; i++) { + xx[i] = x[i]; + yy[i] = y[i]; + GConvert(&(xx[i]), &(yy[i]), USER, DEVICE, dd); + } + GClip(dd); + gc.col = INTEGER(border)[0]; + gc.fill = INTEGER(col)[0]; + res = GEXspline(nx, xx, yy, REAL(ss), open, repEnds, draw, &gc, dd); + vmaxset(vmaxsave); + UNPROTECT(2); + + if(!draw) { + SEXP nm, tmpx, tmpy; + double *xx, *yy, *x0, *y0; + PROTECT(ans = res); + PROTECT(nm = allocVector(STRSXP, 2)); + SET_STRING_ELT(nm, 0, mkChar("x")); + SET_STRING_ELT(nm, 1, mkChar("y")); + setAttrib(ans, R_NamesSymbol, nm); + nx = LENGTH(VECTOR_ELT(ans, 0)); + x0 = REAL(VECTOR_ELT(ans, 0)); + y0 = REAL(VECTOR_ELT(ans, 1)); + PROTECT(tmpx = allocVector(REALSXP, nx)); + PROTECT(tmpy = allocVector(REALSXP, nx)); + xx = REAL(tmpx); + yy = REAL(tmpy); + for (i = 0; i < nx; i++) { + xx[i] = x0[i]; + yy[i] = y0[i]; + GConvert(&(xx[i]), &(yy[i]), DEVICE, USER, dd); + } + SET_VECTOR_ELT(ans, 0, tmpx); + SET_VECTOR_ELT(ans, 1, tmpy); + UNPROTECT(4); + } + + GMode(0, dd); + GRestorePars(dd); + return ans; +} + +/* clip(x1, x2, y1, y2) */ +SEXP C_clip(SEXP args) +{ + SEXP ans = R_NilValue; + double x1, x2, y1, y2; + pGEDevDesc dd = GEcurrentDevice(); + + args = CDR(args); + x1 = asReal(CAR(args)); + if(!R_FINITE(x1)) error("invalid '%s' argument", "x1"); + args = CDR(args); + x2 = asReal(CAR(args)); + if(!R_FINITE(x2)) error("invalid '%s' argument", "x2"); + args = CDR(args); + y1 = asReal(CAR(args)); + if(!R_FINITE(y1)) error("invalid '%s' argument", "y1"); + args = CDR(args); + y2 = asReal(CAR(args)); + if(!R_FINITE(y2)) error("invalid '%s' argument", "y2"); + + GConvert(&x1, &y1, USER, DEVICE, dd); + GConvert(&x2, &y2, USER, DEVICE, dd); + GESetClip(x1, y1, x2, y2, dd); + /* avoid GClip resetting this */ + gpptr(dd)->oldxpd = gpptr(dd)->xpd; + return ans; +} + +/* convert[XY](x, from to) */ +SEXP C_convertX(SEXP args) +{ + SEXP ans = R_NilValue, x; + int from, to, i, n; + double *rx; + pGEDevDesc gdd = GEcurrentDevice(); + + args = CDR(args); + x = CAR(args); + if (TYPEOF(x) != REALSXP) error(_("invalid '%s' argument"), "x"); + n = LENGTH(x); + from = asInteger(CADR(args)); + if (from == NA_INTEGER || from <= 0 || from > 17 ) + error(_("invalid '%s' argument"), "from"); + to = asInteger(CADDR(args)); + if (to == NA_INTEGER || to <= 0 || to > 17 ) + error(_("invalid '%s' argument"), "to"); + from--; to--; + + PROTECT(ans = duplicate(x)); + rx = REAL(ans); + for (i = 0; i < n; i++) rx[i] = GConvertX(rx[i], from, to, gdd); + UNPROTECT(1); + + return ans; +} + +SEXP C_convertY(SEXP args) +{ + SEXP ans = R_NilValue, x; + int from, to, i, n; + double *rx; + pGEDevDesc gdd = GEcurrentDevice(); + + args = CDR(args); + x = CAR(args); + if (TYPEOF(x) != REALSXP) error(_("invalid '%s' argument"), "x"); + n = LENGTH(x); + from = asInteger(CADR(args)); + if (from == NA_INTEGER || from <= 0 || from > 17 ) + error(_("invalid '%s' argument"), "from"); + to = asInteger(CADDR(args)); + if (to == NA_INTEGER || to <= 0 || to > 17 ) + error(_("invalid '%s' argument"), "to"); + from--; to--; + + PROTECT(ans = duplicate(x)); + rx = REAL(ans); + for (i = 0; i < n; i++) rx[i] = GConvertY(rx[i], from, to, gdd); + UNPROTECT(1); + + return ans; +} diff --git a/com.oracle.truffle.r.native/gnur/patch/src/library/graphics/src/plot3d.c b/com.oracle.truffle.r.native/gnur/patch/src/library/graphics/src/plot3d.c new file mode 100644 index 0000000000000000000000000000000000000000..1904faa0b26dd000eab169f1f46913ea915679f1 --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/library/graphics/src/plot3d.c @@ -0,0 +1,2031 @@ +/* + * R : A Computer Language for Statistical Data Analysis + * Copyright (C) 1998--2014 The R Core Team + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version. + * + * This program 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 this program; if not, a copy is available at + * https://www.R-project.org/Licenses/ + */ + + +#ifdef HAVE_CONFIG_H +#include <config.h> +#endif + +#include <Defn.h> +#include <float.h> /* for DBL_MAX */ +#include <Rmath.h> +#include <Graphics.h> +#include <Print.h> +#include <R_ext/Boolean.h> + +#include "graphics.h" + +static void TypeCheck(SEXP s, SEXPTYPE type) +{ + if (TYPEOF(s) != type) + error("invalid type passed to graphics function"); +} + + + /* F i l l e d C o n t o u r P l o t s */ + + /* R o s s I h a k a, M a r c h 1 9 9 9 */ + +static void +FindCutPoints(double low, double high, + double x1, double y1, double z1, + double x2, double y2, double z2, + double *x, double *y, double *z, + int *npt) +{ + double c; + + if (z1 > z2 ) { + if (z2 > high || z1 < low) return; + if (z1 < high) { + x[*npt] = x1; + y[*npt] = y1; + z[*npt] = z1; + ++*npt; + } else if (z1 == R_PosInf) { + x[*npt] = x2; + y[*npt] = y1; + z[*npt] = z2; + ++*npt; + } else { /* z1 >= high, z2 in range */ + c = (z1 - high) / (z1 - z2); + x[*npt] = x1 + c * (x2 - x1); + y[*npt] = y1; + z[*npt] = z1 + c * (z2 - z1); + ++*npt; + } + if (z2 == R_NegInf) { + x[*npt] = x1; + y[*npt] = y1; + z[*npt] = z1; + ++*npt; + } else if (z2 <= low) { /* and z1 in range */ + c = (z2 -low) / (z2 - z1); + x[*npt] = x2 - c * (x2 - x1); + y[*npt] = y1; + z[*npt] = z2 - c * (z2 - z1); + ++*npt; + } + } else if (z1 < z2) { + if (z2 < low || z1 > high) return; + if (z1 > low) { + x[*npt] = x1; + y[*npt] = y1; + z[*npt] = z1; + ++*npt; + } else if (z1 == R_NegInf) { + x[*npt] = x2; + y[*npt] = y1; + z[*npt] = z2;; + ++*npt; + } else { /* and z2 in range */ + c = (z1 - low) / (z1 - z2); + x[*npt] = x1 + c * (x2 - x1); + y[*npt] = y1; + z[*npt] = z1 + c * (z2 - z1); + ++*npt; + } + if (z2 < high) { +#ifdef OMIT + /* Don't repeat corner vertices */ + x[*npt] = x2; + y[*npt] = y2; + z[*npt] = z2; + ++*npt; +#endif + } else if (z2 == R_PosInf) { + x[*npt] = x1; + y[*npt] = y1; + z[*npt] = z1; + ++*npt; + } else { /* z2 high, z1 in range */ + c = (z2 - high) / (z2 - z1); + x[*npt] = x2 - c * (x2 - x1); + y[*npt] = y1; + z[*npt] = z2 - c * (z2 - z1); + ++*npt; + } + } else { + if(low <= z1 && z1 <= high) { + x[*npt] = x1; + y[*npt] = y1; + z[*npt] = z1; + ++*npt; +#ifdef OMIT + /* Don't repeat corner vertices */ + x[*npt] = x2; + y[*npt] = y2; + z[*npt] = z2; + ++*npt; +#endif + } + } +} + +/* FIXME - This could pretty easily be adapted to handle NA */ +/* values on the grid. Just search the diagonals for cutpoints */ +/* instead of the cell sides. Use the same switch idea as in */ +/* contour above. There are 5 cases to handle. */ + +static void +FindPolygonVertices(double low, double high, + double x1, double x2, double y1, double y2, + double z11, double z21, double z12, double z22, + double *x, double *y, double *z, int *npt) +{ + *npt = 0; + FindCutPoints(low, high, x1, y1, z11, x2, y1, z21, x, y, z, npt); + FindCutPoints(low, high, y1, x2, z21, y2, x2, z22, y, x, z, npt); + FindCutPoints(low, high, x2, y2, z22, x1, y2, z12, x, y, z, npt); + FindCutPoints(low, high, y2, x1, z12, y1, x1, z11, y, x, z, npt); +} + +/* filledcontour(x, y, z, levels, col) */ +SEXP C_filledcontour(SEXP args) +{ + SEXP sx, sy, sz, sc, scol; + double *x, *y, *z, *c; + rcolor *col; + int i, j, k, npt, nx, ny, nc, ncol, colsave, xpdsave; + double px[8], py[8], pz[8]; + pGEDevDesc dd = GEcurrentDevice(); + + GCheckState(dd); + + PrintDefaults(); /* prepare for labelformat */ + + args = CDR(args); + sx = PROTECT(coerceVector(CAR(args), REALSXP)); + nx = LENGTH(sx); + args = CDR(args); + + sy = PROTECT(coerceVector(CAR(args), REALSXP)); + ny = LENGTH(sy); + args = CDR(args); + if (nx < 2 || ny < 2) error(_("insufficient 'x' or 'y' values")); + + // do it this way as coerceVector can lose dims, e.g. for a list matrix + sz = CAR(args); + if (nrows(sz) != nx || ncols(sz) != ny) error(_("dimension mismatch")); + sz = PROTECT(coerceVector(sz, REALSXP)); + args = CDR(args); + + sc = PROTECT(coerceVector(CAR(args), REALSXP)); /* levels */ + nc = length(sc); + args = CDR(args); + + if (nc < 1) error(_("no contour values")); + + PROTECT(scol = FixupCol(CAR(args), R_TRANWHITE)); + ncol = length(scol); + + /* Shorthand Pointers */ + + x = REAL(sx); + y = REAL(sy); + z = REAL(sz); + c = REAL(sc); + col = (rcolor *) INTEGER(scol); + + /* Check of grid coordinates */ + /* We want them to all be finite */ + /* and in strictly ascending order */ + + if (nx < 1 || ny < 1) goto badxy; + if (!R_FINITE(x[0])) goto badxy; + if (!R_FINITE(y[0])) goto badxy; + for (i = 1; i < nx; i++) + if (!R_FINITE(x[i]) || x[i] <= x[i - 1]) goto badxy; + for (j = 1; j < ny; j++) + if (!R_FINITE(y[j]) || y[j] <= y[j - 1]) goto badxy; + + /* Check of the contour levels */ + + if (!R_FINITE(c[0])) goto badlev; + for (k = 1; k < nc; k++) + if (!R_FINITE(c[k]) || c[k] <= c[k - 1]) goto badlev; + + colsave = gpptr(dd)->col; + xpdsave = gpptr(dd)->xpd; + /* override par("xpd") and force clipping to plot region */ + gpptr(dd)->xpd = 0; + + GMode(1, dd); + + for (i = 1; i < nx; i++) { + for (j = 1; j < ny; j++) { + for (k = 1; k < nc ; k++) { + FindPolygonVertices(c[k - 1], c[k], + x[i - 1], x[i], + y[j - 1], y[j], + z[i - 1 + (j - 1) * nx], + z[i + (j - 1) * nx], + z[i - 1 + j * nx], + z[i + j * nx], + px, py, pz, &npt); + if (npt > 2) + GPolygon(npt, px, py, USER, col[(k-1) % ncol], + R_TRANWHITE, dd); + } + } + } + GMode(0, dd); + gpptr(dd)->col = colsave; + gpptr(dd)->xpd = xpdsave; + UNPROTECT(5); + return R_NilValue; + + badxy: + error(_("invalid x / y values or limits")); + badlev: + error(_("invalid contour levels: must be strictly increasing")); + return R_NilValue; /* never used; to keep -Wall happy */ +} + + + + /* I m a g e R e n d e r i n g */ + + +/* image(x, y, z, col, breaks) */ +SEXP C_image(SEXP args) +{ + SEXP sx, sy, sz, sc; + double *x, *y; + int *z, tmp; + unsigned *c; + int i, j, nx, ny, nc, xpdsave; + rcolor colsave; + pGEDevDesc dd = GEcurrentDevice(); + + GCheckState(dd); + + args = CDR(args); + + sx = PROTECT(coerceVector(CAR(args), REALSXP)); + nx = LENGTH(sx); + args = CDR(args); + + sy = PROTECT(coerceVector(CAR(args), REALSXP)); + ny = LENGTH(sy); + args = CDR(args); + + sz = PROTECT(coerceVector(CAR(args), INTSXP)); + args = CDR(args); + + PROTECT(sc = FixupCol(CAR(args), R_TRANWHITE)); + nc = LENGTH(sc); + + /* Shorthand Pointers */ + + x = REAL(sx); + y = REAL(sy); + z = INTEGER(sz); + c = (unsigned*)INTEGER(sc); + + /* Check of grid coordinates now done in C code */ + + colsave = gpptr(dd)->col; + xpdsave = gpptr(dd)->xpd; + /* override par("xpd") and force clipping to plot region */ + gpptr(dd)->xpd = 0; + + GMode(1, dd); + + for (i = 0; i < nx - 1 ; i++) { + for (j = 0; j < ny - 1; j++) { + tmp = z[i + j * (nx - 1)]; + if (tmp >= 0 && tmp < nc && tmp != NA_INTEGER) + GRect(x[i], y[j], x[i+1], y[j+1], USER, c[tmp], + R_TRANWHITE, dd); + } + } + GMode(0, dd); + gpptr(dd)->col = colsave; + gpptr(dd)->xpd = xpdsave; + UNPROTECT(4); + return R_NilValue; +} + + /* P e r s p e c t i v e S u r f a c e P l o t s */ + +/* Conversion of degrees to radians */ + +#define DegToRad(x) (DEG2RAD * x) + +/* Definitions of data structures for vectors and */ +/* transformations in homogeneous 3d coordinates */ + +typedef double Vector3d[4]; +typedef double Trans3d[4][4]; + +/* The viewing transformation matrix. */ + +static Trans3d VT; + +static void TransVector (Vector3d u, Trans3d T, Vector3d v) +{ + double sum; + int i, j; + + for (i = 0; i < 4; i++) { + sum = 0; + for (j = 0; j < 4; j++) + sum = sum + u[j] * T[j][i]; + v[i] = sum; + } +} + +static void Accumulate (Trans3d T) +{ + Trans3d U; + double sum; + int i, j, k; + + for (i = 0; i < 4; i++) { + for (j = 0; j < 4; j++) { + sum = 0; + for (k = 0; k < 4; k++) + sum = sum + VT[i][k] * T[k][j]; + U[i][j] = sum; + } + } + for (i = 0; i < 4; i++) + for (j = 0; j < 4; j++) + VT[i][j] = U[i][j]; +} + +static void SetToIdentity (Trans3d T) +{ + int i, j; + for (i = 0; i < 4; i++) { + for (j = 0; j < 4; j++) + T[i][j] = 0; + T[i][i] = 1; + } +} + +static void Translate (double x, double y, double z) +{ + Trans3d T; + SetToIdentity(T); + T[3][0] = x; + T[3][1] = y; + T[3][2] = z; + Accumulate(T); +} + +static void Scale (double x, double y, double z) +{ + Trans3d T; + SetToIdentity(T); + T[0][0] = x; + T[1][1] = y; + T[2][2] = z; + Accumulate(T); +} + +static void XRotate (double angle) +{ + double c, s; + Trans3d T; + SetToIdentity(T); + c = cos(DegToRad(angle)); + s = sin(DegToRad(angle)); + T[1][1] = c; + T[2][1] = -s; + T[2][2] = c; + T[1][2] = s; + Accumulate(T); +} + +static void YRotate (double angle) +{ + double c, s; + Trans3d T; + SetToIdentity(T); + c = cos(DegToRad(angle)); + s = sin(DegToRad(angle)); + T[0][0] = c; + T[2][0] = s; + T[2][2] = c; + T[0][2] = -s; + Accumulate(T); +} + +static void ZRotate (double angle) +{ + double c, s; + Trans3d T; + SetToIdentity(T); + c = cos(DegToRad(angle)); + s = sin(DegToRad(angle)); + T[0][0] = c; + T[1][0] = -s; + T[1][1] = c; + T[0][1] = s; + Accumulate(T); +} + +static void Perspective (double d) +{ + Trans3d T; + + SetToIdentity(T); + T[2][3] = -1 / d; + Accumulate(T); +} + + +/* Set up the light source */ +static double Light[4]; +static double Shade; +static Rboolean DoLighting; + +static void SetUpLight(double theta, double phi) +{ + double u[4]; + u[0] = 0; u[1] = -1; u[2] = 0; u[3] = 1; + SetToIdentity(VT); /* Initialization */ + XRotate(-phi); /* colatitude rotation */ + ZRotate(theta); /* azimuthal rotation */ + TransVector(u, VT, Light); /* transform */ +} + +static double FacetShade(double *u, double *v) +{ + double nx, ny, nz, sum; + nx = u[1] * v[2] - u[2] * v[1]; + ny = u[2] * v[0] - u[0] * v[2]; + nz = u[0] * v[1] - u[1] * v[0]; + sum = sqrt(nx * nx + ny * ny + nz * nz); + if (sum == 0) sum = 1; + nx /= sum; + ny /= sum; + nz /= sum; + sum = 0.5 * (nx * Light[0] + ny * Light[1] + nz * Light[2] + 1); + return pow(sum, Shade); +} + + +/* For each facet, determine the farthest point from the eye. */ +/* Sorting the facets so that these depths are decreasing */ +/* yields an occlusion compatible ordering. */ +/* Note that we ignore z values when doing this. */ + +static void DepthOrder(double *z, double *x, double *y, int nx, int ny, + double *depth, int *indx) +{ + int i, ii, j, jj, nx1, ny1; + Vector3d u, v; + double d; + nx1 = nx - 1; + ny1 = ny - 1; + for (i = 0; i < nx1 * ny1; i++) + indx[i] = i; + for (i = 0; i < nx1; i++) + for (j = 0; j < ny1; j++) { + d = -DBL_MAX; + for (ii = 0; ii <= 1; ii++) + for (jj = 0; jj <= 1; jj++) { + u[0] = x[i + ii]; + u[1] = y[j + jj]; + /* Originally I had the following line here: */ + /* u[2] = z[i+ii+(j+jj)*nx]; */ + /* But this leads to artifacts. */ + /* It has been replaced by the following line: */ + u[2] = 0; + u[3] = 1; + if (R_FINITE(u[0]) && R_FINITE(u[1]) && R_FINITE(u[2])) { + TransVector(u, VT, v); + if (v[3] > d) d = v[3]; + } + } + depth[i+j*nx1] = -d; + + } + /* Determine the depth ordering of the facets to ensure + that they are drawn in an occlusion compatible order. */ + rsort_with_index(depth, indx, nx1 * ny1); +} + + +static void DrawFacets(double *z, double *x, double *y, int nx, int ny, + int *indx, double xs, double ys, double zs, + int *col, int ncol, int border) +{ + double xx[4], yy[4], shade = 0; + Vector3d u, v; + int i, j, k, n, nx1, ny1, icol, nv; + unsigned int newcol, r, g, b; + pGEDevDesc dd; + dd = GEcurrentDevice(); + nx1 = nx - 1; + ny1 = ny - 1; + n = nx1 * ny1; + for (k = 0; k < n; k++) { + nv = 0; + i = indx[k] % nx1; + j = indx[k] / nx1; + icol = (i + j * nx1) % ncol; + if (DoLighting) { + /* Note we must scale here */ + u[0] = xs * (x[i+1] - x[i]); + u[1] = ys * (y[j] - y[j+1]); + u[2] = zs * (z[(i+1)+j*nx] - z[i+(j+1)*nx]); + v[0] = xs * (x[i+1] - x[i]); + v[1] = ys * (y[j+1] - y[j]); + v[2] = zs * (z[(i+1)+(j+1)*nx] - z[i+j*nx]); + shade = FacetShade(u, v); + } + u[0] = x[i]; u[1] = y[j]; + u[2] = z[i + j * nx]; u[3] = 1; + if (R_FINITE(u[0]) && R_FINITE(u[1]) && R_FINITE(u[2])) { + TransVector(u, VT, v); + xx[nv] = v[0] / v[3]; + yy[nv] = v[1] / v[3]; + nv++; + } + + u[0] = x[i + 1]; u[1] = y[j]; + u[2] = z[i + 1 + j * nx]; u[3] = 1; + if (R_FINITE(u[0]) && R_FINITE(u[1]) && R_FINITE(u[2])) { + TransVector(u, VT, v); + xx[nv] = v[0] / v[3]; + yy[nv] = v[1] / v[3]; + nv++; + } + + u[0] = x[i + 1]; u[1] = y[j + 1]; + u[2] = z[i + 1 + (j + 1) * nx]; u[3] = 1; + if (R_FINITE(u[0]) && R_FINITE(u[1]) && R_FINITE(u[2])) { + TransVector(u, VT, v); + xx[nv] = v[0] / v[3]; + yy[nv] = v[1] / v[3]; + nv++; + } + + u[0] = x[i]; u[1] = y[j + 1]; + u[2] = z[i + (j + 1) * nx]; u[3] = 1; + if (R_FINITE(u[0]) && R_FINITE(u[1]) && R_FINITE(u[2])) { + TransVector(u, VT, v); + xx[nv] = v[0] / v[3]; + yy[nv] = v[1] / v[3]; + nv++; + } + + if (nv > 2) { + newcol = col[icol]; + if (DoLighting) { + // shade can degenerate to NaN + if(R_FINITE(shade)) { + r = (int)(shade * R_RED(newcol)); + g = (int)(shade * R_GREEN(newcol)); + b = (int)(shade * R_BLUE(newcol)); + newcol = R_RGB(r, g, b); + GPolygon(nv, xx, yy, USER, newcol, border, dd); + } + } else + GPolygon(nv, xx, yy, USER, newcol, border, dd); + } + } +} + + +static void PerspWindow(double *xlim, double *ylim, double *zlim, pGEDevDesc dd) +{ + double pin1, pin2, scale, xdelta, ydelta, xscale, yscale, xadd, yadd; + double xmax, xmin, ymax, ymin, xx, yy; + Vector3d u, v; + int i, j, k; + + xmax = xmin = ymax = ymin = 0; + u[3] = 1; + for (i = 0; i < 2; i++) { + u[0] = xlim[i]; + for (j = 0; j < 2; j++) { + u[1] = ylim[j]; + for (k = 0; k < 2; k++) { + u[2] = zlim[k]; + TransVector(u, VT, v); + xx = v[0] / v[3]; + yy = v[1] / v[3]; + if (xx > xmax) xmax = xx; + if (xx < xmin) xmin = xx; + if (yy > ymax) ymax = yy; + if (yy < ymin) ymin = yy; + } + } + } + pin1 = GConvertXUnits(1.0, NPC, INCHES, dd); + pin2 = GConvertYUnits(1.0, NPC, INCHES, dd); + xdelta = fabs(xmax - xmin); + ydelta = fabs(ymax - ymin); + xscale = pin1 / xdelta; + yscale = pin2 / ydelta; + scale = (xscale < yscale) ? xscale : yscale; + xadd = .5 * (pin1 / scale - xdelta); + yadd = .5 * (pin2 / scale - ydelta); + GScale(xmin - xadd, xmax + xadd, 1, dd); + GScale(ymin - yadd, ymax + yadd, 2, dd); + GMapWin2Fig(dd); +} + +static int LimitCheck(double *lim, double *c, double *s) +{ + if (!R_FINITE(lim[0]) || !R_FINITE(lim[1]) || lim[0] >= lim[1]) + return 0; + *s = 0.5 * fabs(lim[1] - lim[0]); + *c = 0.5 * (lim[1] + lim[0]); + return 1; +} + +/* PerspBox: The following code carries out a visibility test + on the surfaces of the xlim/ylim/zlim box around the plot. + If front = 0, only the faces with their inside toward the + eyepoint are drawn. If front = 1, only the faces with + their outside toward the eye are drawn. This lets us carry + out hidden line removal by drawing any faces which will be + obscured before the surface, and those which will not be + obscured after the surface. + + Unfortunately as PR#202 showed, this is simplistic as the surface + can go outside the box. +*/ + +/* The vertices of the box */ +static short int Vertex[8][3] = { + {0, 0, 0}, + {0, 0, 1}, + {0, 1, 0}, + {0, 1, 1}, + {1, 0, 0}, + {1, 0, 1}, + {1, 1, 0}, + {1, 1, 1}, +}; + +/* The vertices visited when tracing a face */ +static short int Face[6][4] = { + {0, 1, 5, 4}, + {2, 6, 7, 3}, + {0, 2, 3, 1}, + {4, 5, 7, 6}, + {0, 4, 6, 2}, + {1, 3, 7, 5}, +}; + +/* The edges drawn when tracing a face */ +static short int Edge[6][4] = { + { 0, 1, 2, 3}, + { 4, 5, 6, 7}, + { 8, 7, 9, 0}, + { 2,10, 5,11}, + { 3,11, 4, 8}, + { 9, 6,10, 1}, +}; + + +static void PerspBox(int front, double *x, double *y, double *z, + char *EdgeDone, pGEDevDesc dd) +{ + Vector3d u0, v0, u1, v1, u2, v2, u3, v3; + double d[3], e[3]; + int f, i, p0, p1, p2, p3, nearby; + int ltysave = gpptr(dd)->lty; + + gpptr(dd)->lty = front ? LTY_DOTTED : LTY_SOLID; + + for (f = 0; f < 6; f++) { + p0 = Face[f][0]; + p1 = Face[f][1]; + p2 = Face[f][2]; + p3 = Face[f][3]; + + u0[0] = x[Vertex[p0][0]]; + u0[1] = y[Vertex[p0][1]]; + u0[2] = z[Vertex[p0][2]]; + u0[3] = 1; + u1[0] = x[Vertex[p1][0]]; + u1[1] = y[Vertex[p1][1]]; + u1[2] = z[Vertex[p1][2]]; + u1[3] = 1; + u2[0] = x[Vertex[p2][0]]; + u2[1] = y[Vertex[p2][1]]; + u2[2] = z[Vertex[p2][2]]; + u2[3] = 1; + u3[0] = x[Vertex[p3][0]]; + u3[1] = y[Vertex[p3][1]]; + u3[2] = z[Vertex[p3][2]]; + u3[3] = 1; + + TransVector(u0, VT, v0); + TransVector(u1, VT, v1); + TransVector(u2, VT, v2); + TransVector(u3, VT, v3); + + /* Visibility test. */ + /* Determine whether the surface normal is toward the eye. */ + /* Note that we only draw lines once. */ + + for (i = 0; i < 3; i++) { + d[i] = v1[i]/v1[3] - v0[i]/v0[3]; + e[i] = v2[i]/v2[3] - v1[i]/v1[3]; + } + nearby = (d[0]*e[1] - d[1]*e[0]) < 0; + + if ((front && nearby) || (!front && !nearby)) { + if (!EdgeDone[Edge[f][0]]++) + GLine(v0[0]/v0[3], v0[1]/v0[3], + v1[0]/v1[3], v1[1]/v1[3], USER, dd); + if (!EdgeDone[Edge[f][1]]++) + GLine(v1[0]/v1[3], v1[1]/v1[3], + v2[0]/v2[3], v2[1]/v2[3], USER, dd); + if (!EdgeDone[Edge[f][2]]++) + GLine(v2[0]/v2[3], v2[1]/v2[3], + v3[0]/v3[3], v3[1]/v3[3], USER, dd); + if (!EdgeDone[Edge[f][3]]++) + GLine(v3[0]/v3[3], v3[1]/v3[3], + v0[0]/v0[3], v0[1]/v0[3], USER, dd); + } + } + gpptr(dd)->lty = ltysave; +} + +/* PerspAxes: + */ + +/* Starting vertex for possible axes */ +static short int AxisStart[8] = { 0, 0, 2, 4, 0, 4, 2, 6 }; + +/* Tick vector for possible axes */ +static short int TickVector[8][3] = { + {0, -1, -1}, + {-1, 0, -1}, + {0, 1, -1}, + {1, 0, -1}, + {-1, -1, 0}, + {1, -1, 0}, + {-1, 1, 0}, + {1, 1, 0}}; + +static int lowest(double y1, double y2, double y3, double y4) { + return ((y1 <= y2) && (y1 <= y3) && (y1 <= y4)); +} + +static double labelAngle(double x1, double y1, double x2, double y2) { + double dx, dy; + double angle; + dx = fabs(x2 - x1); + if (x2 > x1) + dy = y2 - y1; + else + dy = y1 - y2; + if (dx == 0) { + if (dy > 0) + angle = 90.; + else + angle = 270.; + } else { +#ifdef HAVE_ATAN2PI + angle = 180. * atan2(dy, dx); +#else + angle = (180. / M_PI) * atan2(dy, dx); +#endif + } + return angle; +} + +static void PerspAxis(double *x, double *y, double *z, + int axis, int axisType, int nTicks, int tickType, + const char *label, cetype_t enc, pGEDevDesc dd) +{ + Vector3d u1={0.,0.,0.,0.}, u2={0.,0.,0.,0.}, u3={0.,0.,0.,0.}, v1, v2, v3; + double tickLength = .03; /* proportion of axis length */ + double min, max, d_frac; + double *range = NULL; /* -Wall */ + double axp[3]; + int nint, i; + SEXP at, lab; + double cexsave = gpptr(dd)->cex; + int fontsave = gpptr(dd)->font; + + + switch (axisType) { + case 0: + min = x[0]; max = x[1]; range = x; break; + case 1: + min = y[0]; max = y[1]; range = y; break; + case 2: + min = z[0]; max = z[1]; range = z; break; + } + d_frac = 0.1*(max - min); + nint = nTicks - 1; if(!nint) nint++; + i = nint; + GPretty(&min, &max, &nint); + /* GPretty() rarely gives values too much outside range .. + 2D axis() clip these, we play cheaper */ + while((min < range[0] - d_frac || range[1] + d_frac < max) && i < 20) { + nint = ++i; + min = range[0]; + max = range[1]; + GPretty(&min, &max, &nint); + } + axp[0] = min; + axp[1] = max; + axp[2] = nint; + /* Do the following calculations for both ticktypes */ + switch (axisType) { + case 0: + u1[0] = min; + u1[1] = y[Vertex[AxisStart[axis]][1]]; + u1[2] = z[Vertex[AxisStart[axis]][2]]; + break; + case 1: + u1[0] = x[Vertex[AxisStart[axis]][0]]; + u1[1] = min; + u1[2] = z[Vertex[AxisStart[axis]][2]]; + break; + case 2: + u1[0] = x[Vertex[AxisStart[axis]][0]]; + u1[1] = y[Vertex[AxisStart[axis]][1]]; + u1[2] = min; + break; + } + u1[0] = u1[0] + tickLength*(x[1]-x[0])*TickVector[axis][0]; + u1[1] = u1[1] + tickLength*(y[1]-y[0])*TickVector[axis][1]; + u1[2] = u1[2] + tickLength*(z[1]-z[0])*TickVector[axis][2]; + u1[3] = 1; + switch (axisType) { + case 0: + u2[0] = max; + u2[1] = u1[1]; + u2[2] = u1[2]; + break; + case 1: + u2[0] = u1[0]; + u2[1] = max; + u2[2] = u1[2]; + break; + case 2: + u2[0] = u1[0]; + u2[1] = u1[1]; + u2[2] = max; + break; + } + u2[3] = 1; + /* The axis label has to be further out for "detailed" ticks + in order to leave room for the tick labels */ + switch (tickType) { + case 1: /* "simple": just an arrow parallel to axis, indicating direction + of increase */ + u3[0] = u1[0] + tickLength*(x[1]-x[0])*TickVector[axis][0]; + u3[1] = u1[1] + tickLength*(y[1]-y[0])*TickVector[axis][1]; + u3[2] = u1[2] + tickLength*(z[1]-z[0])*TickVector[axis][2]; + break; + case 2: + u3[0] = u1[0] + 2.5*tickLength*(x[1]-x[0])*TickVector[axis][0]; + u3[1] = u1[1] + 2.5*tickLength*(y[1]-y[0])*TickVector[axis][1]; + u3[2] = u1[2] + 2.5*tickLength*(z[1]-z[0])*TickVector[axis][2]; + break; + } + switch (axisType) { + case 0: + u3[0] = (min + max)/2; + break; + case 1: + u3[1] = (min + max)/2; + break; + case 2: + u3[2] = (min + max)/2; + break; + } + u3[3] = 1; + TransVector(u1, VT, v1); + TransVector(u2, VT, v2); + TransVector(u3, VT, v3); + /* Draw axis label */ + /* change in 2.5.0 to use cex.lab and font.lab */ + gpptr(dd)->cex = gpptr(dd)->cexbase * gpptr(dd)->cexlab; + gpptr(dd)->font = gpptr(dd)->fontlab; + GText(v3[0]/v3[3], v3[1]/v3[3], USER, label, enc, .5, .5, + labelAngle(v1[0]/v1[3], v1[1]/v1[3], v2[0]/v2[3], v2[1]/v2[3]), + dd); + /* Draw axis ticks */ + /* change in 2.5.0 to use cex.axis and font.axis */ + gpptr(dd)->cex = gpptr(dd)->cexbase * gpptr(dd)->cexaxis; + gpptr(dd)->font = gpptr(dd)->fontaxis; + switch (tickType) { + case 1: /* "simple": just an arrow parallel to axis, indicating direction + of increase */ + /* arrow head is 0.25 inches long, with angle 30 degrees, + and drawn at v2 end of line */ + GArrow(v1[0]/v1[3], v1[1]/v1[3], + v2[0]/v2[3], v2[1]/v2[3], USER, + 0.1, 10, 2, dd); + break; + case 2: /* "detailed": normal ticks as per 2D plots */ + PROTECT(at = CreateAtVector(axp, range, 7, FALSE)); + PROTECT(lab = labelformat(at)); + for (i=0; i<length(at); i++) { + switch (axisType) { + case 0: + u1[0] = REAL(at)[i]; + u1[1] = y[Vertex[AxisStart[axis]][1]]; + u1[2] = z[Vertex[AxisStart[axis]][2]]; + break; + case 1: + u1[0] = x[Vertex[AxisStart[axis]][0]]; + u1[1] = REAL(at)[i]; + u1[2] = z[Vertex[AxisStart[axis]][2]]; + break; + case 2: + u1[0] = x[Vertex[AxisStart[axis]][0]]; + u1[1] = y[Vertex[AxisStart[axis]][1]]; + u1[2] = REAL(at)[i]; + break; + } + u1[3] = 1; + u2[0] = u1[0] + tickLength*(x[1]-x[0])*TickVector[axis][0]; + u2[1] = u1[1] + tickLength*(y[1]-y[0])*TickVector[axis][1]; + u2[2] = u1[2] + tickLength*(z[1]-z[0])*TickVector[axis][2]; + u2[3] = 1; + u3[0] = u2[0] + tickLength*(x[1]-x[0])*TickVector[axis][0]; + u3[1] = u2[1] + tickLength*(y[1]-y[0])*TickVector[axis][1]; + u3[2] = u2[2] + tickLength*(z[1]-z[0])*TickVector[axis][2]; + u3[3] = 1; + TransVector(u1, VT, v1); + TransVector(u2, VT, v2); + TransVector(u3, VT, v3); + /* Draw tick line */ + GLine(v1[0]/v1[3], v1[1]/v1[3], + v2[0]/v2[3], v2[1]/v2[3], USER, dd); + /* Draw tick label */ + GText(v3[0]/v3[3], v3[1]/v3[3], USER, + CHAR(STRING_ELT(lab, i)), + getCharCE(STRING_ELT(lab, i)), + .5, .5, 0, dd); + } + UNPROTECT(2); + break; + } + gpptr(dd)->cex = cexsave; + gpptr(dd)->font = fontsave; +} + +/* Determine the transformed (x, y) coordinates (in USER space) + * for the four corners of the x-y plane of the persp plot + * These will be used to determine which sides of the persp + * plot to label with axes + * The strategy is to determine which corner has the lowest y-value + * to decide which of the x- and y-axes to label AND which corner + * has the lowest x-value to decide which of the z-axes to label + */ +static void PerspAxes(double *x, double *y, double *z, + const char *xlab, cetype_t xenc, + const char *ylab, cetype_t yenc, + const char *zlab, cetype_t zenc, + int nTicks, int tickType, pGEDevDesc dd) +{ + int xAxis=0, yAxis=0, zAxis=0; /* -Wall */ + int xpdsave; + Vector3d u0, u1, u2, u3; + Vector3d v0, v1, v2, v3; + u0[0] = x[0]; + u0[1] = y[0]; + u0[2] = z[0]; + u0[3] = 1; + u1[0] = x[1]; + u1[1] = y[0]; + u1[2] = z[0]; + u1[3] = 1; + u2[0] = x[0]; + u2[1] = y[1]; + u2[2] = z[0]; + u2[3] = 1; + u3[0] = x[1]; + u3[1] = y[1]; + u3[2] = z[0]; + u3[3] = 1; + TransVector(u0, VT, v0); + TransVector(u1, VT, v1); + TransVector(u2, VT, v2); + TransVector(u3, VT, v3); + + /* to fit in the axis labels */ + xpdsave = gpptr(dd)->xpd; + gpptr(dd)->xpd = 1; + + /* Figure out which X and Y axis to draw */ + if (lowest(v0[1]/v0[3], v1[1]/v1[3], v2[1]/v2[3], v3[1]/v3[3])) { + xAxis = 0; + yAxis = 1; + } else if (lowest(v1[1]/v1[3], v0[1]/v0[3], v2[1]/v2[3], v3[1]/v3[3])) { + xAxis = 0; + yAxis = 3; + } else if (lowest(v2[1]/v2[3], v1[1]/v1[3], v0[1]/v0[3], v3[1]/v3[3])) { + xAxis = 2; + yAxis = 1; + } else if (lowest(v3[1]/v3[3], v1[1]/v1[3], v2[1]/v2[3], v0[1]/v0[3])) { + xAxis = 2; + yAxis = 3; + } else + warning(_("Axis orientation not calculated")); + PerspAxis(x, y, z, xAxis, 0, nTicks, tickType, xlab, xenc, dd); + PerspAxis(x, y, z, yAxis, 1, nTicks, tickType, ylab, yenc, dd); + /* Figure out which Z axis to draw */ + if (lowest(v0[0]/v0[3], v1[0]/v1[3], v2[0]/v2[3], v3[0]/v3[3])) { + zAxis = 4; + } else if (lowest(v1[0]/v1[3], v0[0]/v0[3], v2[0]/v2[3], v3[0]/v3[3])) { + zAxis = 5; + } else if (lowest(v2[0]/v2[3], v1[0]/v1[3], v0[0]/v0[3], v3[0]/v3[3])) { + zAxis = 6; + } else if (lowest(v3[0]/v3[3], v1[0]/v1[3], v2[0]/v2[3], v0[0]/v0[3])) { + zAxis = 7; + } else + warning(_("Axis orientation not calculated")); + PerspAxis(x, y, z, zAxis, 2, nTicks, tickType, zlab, zenc, dd); + + gpptr(dd)->xpd = xpdsave; +} + +SEXP C_persp(SEXP args) +{ + SEXP x, y, z, xlim, ylim, zlim; + SEXP depth, indx; + SEXP col, border, xlab, ylab, zlab; + double theta, phi, r, d; + double ltheta, lphi; + double expand, xc = 0.0, yc = 0.0, zc = 0.0, xs = 0.0, ys = 0.0, zs = 0.0; + int i, j, scale, ncol, dobox, doaxes, nTicks, tickType; + char EdgeDone[12]; /* Which edges have been drawn previously */ + pGEDevDesc dd; + + args = CDR(args); + if (length(args) < 24) /* 24 plus any inline par()s */ + error(_("too few parameters")); + + PROTECT(x = coerceVector(CAR(args), REALSXP)); + if (length(x) < 2) error(_("invalid '%s' argument"), "x"); + args = CDR(args); + + PROTECT(y = coerceVector(CAR(args), REALSXP)); + if (length(y) < 2) error(_("invalid '%s' argument"), "y"); + args = CDR(args); + + PROTECT(z = coerceVector(CAR(args), REALSXP)); + if (!isMatrix(z) || nrows(z) != length(x) || ncols(z) != length(y)) + error(_("invalid '%s' argument"), "z"); + args = CDR(args); + + PROTECT(xlim = coerceVector(CAR(args), REALSXP)); + if (length(xlim) != 2) error(_("invalid '%s' argument"), "xlim"); + args = CDR(args); + + PROTECT(ylim = coerceVector(CAR(args), REALSXP)); + if (length(ylim) != 2) error(_("invalid '%s' argument"), "ylim"); + args = CDR(args); + + PROTECT(zlim = coerceVector(CAR(args), REALSXP)); + if (length(zlim) != 2) error(_("invalid '%s' argument"), "zlim"); + args = CDR(args); + + /* Checks on x/y/z Limits */ + + if (!LimitCheck(REAL(xlim), &xc, &xs)) + error(_("invalid 'x' limits")); + if (!LimitCheck(REAL(ylim), &yc, &ys)) + error(_("invalid 'y' limits")); + if (!LimitCheck(REAL(zlim), &zc, &zs)) + error(_("invalid 'z' limits")); + + theta = asReal(CAR(args)); args = CDR(args); + phi = asReal(CAR(args)); args = CDR(args); + r = asReal(CAR(args)); args = CDR(args); + d = asReal(CAR(args)); args = CDR(args); + scale = asLogical(CAR(args)); args = CDR(args); + expand = asReal(CAR(args)); args = CDR(args); + col = CAR(args); args = CDR(args); + border = CAR(args); args = CDR(args); + ltheta = asReal(CAR(args)); args = CDR(args); + lphi = asReal(CAR(args)); args = CDR(args); + Shade = asReal(CAR(args)); args = CDR(args); + dobox = asLogical(CAR(args)); args = CDR(args); + doaxes = asLogical(CAR(args)); args = CDR(args); + nTicks = asInteger(CAR(args)); args = CDR(args); + tickType = asInteger(CAR(args)); args = CDR(args); + xlab = CAR(args); args = CDR(args); + ylab = CAR(args); args = CDR(args); + zlab = CAR(args); args = CDR(args); + if (!isString(xlab) || length(xlab) < 1) + error(_("'xlab' must be a character vector of length 1")); + if (!isString(ylab) || length(ylab) < 1) + error(_("'ylab' must be a character vector of length 1")); + if (!isString(zlab) || length(zlab) < 1) + error(_("'zlab' must be a character vector of length 1")); + + if (R_FINITE(Shade) && Shade <= 0) Shade = 1; + if (R_FINITE(ltheta) && R_FINITE(lphi) && R_FINITE(Shade)) + DoLighting = TRUE; + else + DoLighting = FALSE; + + if (!scale) { + double s; + s = xs; + if (s < ys) s = ys; + if (s < zs) s = zs; + xs = s; ys = s; zs = s; + } + + /* Parameter Checks */ + + if (!R_FINITE(theta) || !R_FINITE(phi) || !R_FINITE(r) || !R_FINITE(d) || + d < 0 || r < 0) + error(_("invalid viewing parameters")); + if (!R_FINITE(expand) || expand < 0) + error(_("invalid '%s' value"), "expand"); + if (scale == NA_LOGICAL) + scale = 0; + if ((nTicks == NA_INTEGER) || (nTicks < 0)) + error(_("invalid '%s' value"), "nticks"); + if ((tickType == NA_INTEGER) || (tickType < 1) || (tickType > 2)) + error(_("invalid '%s' value"), "ticktype"); + + dd = GEcurrentDevice(); + +#if 0 + GNewPlot(GRecording(call, dd)); +#endif + + PROTECT(col = FixupCol(col, gpptr(dd)->bg)); + ncol = LENGTH(col); + if (ncol < 1) error(_("invalid '%s' specification"), "col"); + if(!R_OPAQUE(INTEGER(col)[0])) DoLighting = FALSE; + PROTECT(border = FixupCol(border, gpptr(dd)->fg)); + if (length(border) < 1) + error(_("invalid '%s' specification"), "border"); + + GSetState(1, dd); + GSavePars(dd); + ProcessInlinePars(args, dd); + if (length(border) > 1) + gpptr(dd)->fg = INTEGER(border)[0]; + gpptr(dd)->xlog = gpptr(dd)->ylog = FALSE; + + /* Set up the light vector (if any) */ + if (DoLighting) + SetUpLight(ltheta, lphi); + + /* Mark box edges as undrawn */ + for (i = 0; i< 12; i++) + EdgeDone[i] = 0; + + /* Specify the viewing transformation. */ + + SetToIdentity(VT); /* Initialization */ + Translate(-xc, -yc, -zc); /* center at the origin */ + Scale(1/xs, 1/ys, expand/zs); /* scale extents to [-1,1] */ + XRotate(-90.0); /* rotate x-y plane to horizontal */ + YRotate(-theta); /* azimuthal rotation */ + XRotate(phi); /* elevation rotation */ + Translate(0.0, 0.0, -r - d); /* translate the eyepoint to the origin */ + Perspective(d); /* perspective */ + + /* Specify the plotting window. */ + /* Here we map the vertices of the cube */ + /* [xmin,xmax]*[ymin,ymax]*[zmin,zmax] */ + /* to the screen and then chose a window */ + /* which is symmetric about (0,0). */ + + PerspWindow(REAL(xlim), REAL(ylim), REAL(zlim), dd); + + /* Compute facet order: + We order the facets by depth and then draw them back to front. + This is the "painters" algorithm. */ + + PROTECT(depth = allocVector(REALSXP, (nrows(z) - 1)*(ncols(z) - 1))); + PROTECT(indx = allocVector(INTSXP, (nrows(z) - 1)*(ncols(z) - 1))); + DepthOrder(REAL(z), REAL(x), REAL(y), nrows(z), ncols(z), + REAL(depth), INTEGER(indx)); + + GMode(1, dd); + + if (dobox) { + /* Draw (solid) faces which face away from the viewer */ + PerspBox(0, REAL(xlim), REAL(ylim), REAL(zlim), EdgeDone, dd); + if (doaxes) { + SEXP xl = STRING_ELT(xlab, 0), yl = STRING_ELT(ylab, 0), + zl = STRING_ELT(zlab, 0); + PerspAxes(REAL(xlim), REAL(ylim), REAL(zlim), + (xl == NA_STRING) ? "" : CHAR(xl), getCharCE(xl), + (yl == NA_STRING) ? "" : CHAR(yl), getCharCE(yl), + (zl == NA_STRING) ? "" : CHAR(zl), getCharCE(zl), + nTicks, tickType, dd); + } + } + + DrawFacets(REAL(z), REAL(x), REAL(y), nrows(z), ncols(z), INTEGER(indx), + 1/xs, 1/ys, expand/zs, + INTEGER(col), ncol, INTEGER(border)[0]); + + /* Draw (dotted) not-already-plotted edges of faces which face + towards from the viewer */ + if (dobox) + PerspBox(1, REAL(xlim), REAL(ylim), REAL(zlim), EdgeDone, dd); + GMode(0, dd); + + GRestorePars(dd); + UNPROTECT(10); + + PROTECT(x = allocVector(REALSXP, 16)); + PROTECT(y = allocVector(INTSXP, 2)); + for (i = 0; i < 4; i++) + for (j = 0; j < 4; j++) + REAL(x)[i + j * 4] = VT[i][j]; + INTEGER(y)[0] = 4; + INTEGER(y)[1] = 4; + setAttrib(x, R_DimSymbol, y); + UNPROTECT(2); + return x; +} + +/* in src/main */ +#include "contour-common.h" + +static +void FindCorners(double width, double height, SEXP label, + double x0, double y0, double x1, double y1, + pGEDevDesc dd) { + double delta = height / width; + double dx = GConvertXUnits(x1 - x0, USER, INCHES, dd) * delta; + double dy = GConvertYUnits(y1 - y0, USER, INCHES, dd) * delta; + dx = GConvertYUnits(dx, INCHES, USER, dd); + dy = GConvertXUnits(dy, INCHES, USER, dd); + + REAL(label)[0] = x0 + dy; + REAL(label)[4] = y0 - dx; + REAL(label)[1] = x0 - dy; + REAL(label)[5] = y0 + dx; + REAL(label)[3] = x1 + dy; + REAL(label)[7] = y1 - dx; + REAL(label)[2] = x1 - dy; + REAL(label)[6] = y1 + dx; +} +static +int TestLabelIntersection(SEXP label1, SEXP label2) { + + int i, j, l1, l2; + double Ax, Bx, Ay, By, ax, ay, bx, by; + double dom; + double result1, result2; + + for (i = 0; i < 4; i++) { + Ax = REAL(label1)[i]; + Ay = REAL(label1)[i+4]; + Bx = REAL(label1)[(i+1)%4]; + By = REAL(label1)[(i+1)%4+4]; + for (j = 0; j < 4; j++) { + ax = REAL(label2)[j]; + ay = REAL(label2)[j+4]; + bx = REAL(label2)[(j+1)%4]; + by = REAL(label2)[(j+1)%4+4]; + + dom = Bx*by - Bx*ay - Ax*by + Ax*ay - bx*By + bx*Ay + ax*By - ax*Ay; + if (dom == 0.0) { + result1 = -1; + result2 = -1; + } + else { + result1 = (bx*Ay - ax*Ay - ay*bx - Ax*by + Ax*ay + by*ax) / dom; + + if (bx - ax == 0.0) { + if (by - ay == 0.0) + result2 = -1; + else + result2 = (Ay + (By - Ay) * result1 - ay) / (by - ay); + } + else + result2 = (Ax + (Bx - Ax) * result1 - ax) / (bx - ax); + + } + l1 = (result1 >= 0.0) && (result1 <= 1.0); + l2 = (result2 >= 0.0) && (result2 <= 1.0); + if (l1 && l2) return 1; + } + } + + return 0; +} + +/*** Checks whether a label window is inside view region ***/ +static int LabelInsideWindow(SEXP label, pGEDevDesc dd) { + int i = 0; + double x, y; + + while (i < 4) { + x = REAL(label)[i]; + y = REAL(label)[i+4]; + GConvert(&x, &y, USER, NDC, dd); + /* x = GConvertXUnits(REAL(label)[i], USER, NDC, dd); + y = GConvertYUnits(REAL(label)[i+4], USER, NDC, dd); */ + + if ((x < 0) || (x > 1) || + (y < 0) || (y > 1)) + return 1; + i += 1; + } + return 0; +} + +static +int findGapUp(double *xxx, double *yyy, int ns, double labelDistance, + pGEDevDesc dd) { + double dX, dY; + double dXC, dYC; + double distanceSum = 0; + int n = 0; + int jjj = 1; + while ((jjj < ns) && (distanceSum < labelDistance)) { + /* Find a gap big enough for the label + use several segments if necessary + */ + dX = xxx[jjj] - xxx[jjj - n - 1]; /* jjj - n - 1 == 0 */ + dY = yyy[jjj] - yyy[jjj - n - 1]; + dXC = GConvertXUnits(dX, USER, INCHES, dd); + dYC = GConvertYUnits(dY, USER, INCHES, dd); + distanceSum = hypot(dXC, dYC); + jjj++; + n++; + } + if (distanceSum < labelDistance) + return 0; + else + return n; +} + +static +int findGapDown(double *xxx, double *yyy, int ns, double labelDistance, + pGEDevDesc dd) { + double dX, dY; + double dXC, dYC; + double distanceSum = 0; + int n = 0; + int jjj = ns - 2; + while ((jjj > -1) && (distanceSum < labelDistance)) { + /* Find a gap big enough for the label + use several segments if necessary + */ + dX = xxx[jjj] - xxx[jjj + n + 1]; /*jjj + n + 1 == ns -1 */ + dY = yyy[jjj] - yyy[jjj + n + 1]; + dXC = GConvertXUnits(dX, USER, INCHES, dd); + dYC = GConvertYUnits(dY, USER, INCHES, dd); + distanceSum = hypot(dXC, dYC); + jjj--; + n++; + } + if (distanceSum < labelDistance) + return 0; + else + return n; +} + +/* labelList, label1, and label2 are all SEXPs rather than being allocated + using R_alloc because they need to persist across calls to contour(). + In do_contour() there is a vmaxget() ... vmaxset() around each call to + contour() to release all of the memory used in the drawing of the + contour _lines_ at each contour level. We need to keep track of the + contour _labels_ for _all_ contour levels, hence we have to use a + different memory allocation mechanism. +*/ + +static +double distFromEdge(double *xxx, double *yyy, int iii, pGEDevDesc dd) { + return fmin2(fmin2(xxx[iii]-gpptr(dd)->usr[0], gpptr(dd)->usr[1]-xxx[iii]), + fmin2(yyy[iii]-gpptr(dd)->usr[2], gpptr(dd)->usr[3]-yyy[iii])); +} + +static SEXP labelList; +static SEGP *ctr_SegDB; + +static +Rboolean useStart(double *xxx, double *yyy, int ns, pGEDevDesc dd) { + if (distFromEdge(xxx, yyy, 0, dd) < distFromEdge(xxx, yyy, ns-1, dd)) + return TRUE; + else + return FALSE; +} + + +static void contour(SEXP x, int nx, SEXP y, int ny, SEXP z, + double zc, + SEXP labels, int cnum, + Rboolean drawLabels, int method, + double atom, pGEDevDesc dd) +{ +/* draw a contour for one given contour level 'zc' */ + + const void *vmax; + + double xend, yend; + int i, ii, j, jj, ns, dir; + SEGP seglist, seg, s, start, end; + double *xxx, *yyy; + + double variance, dX, dY, deltaX, deltaY; + double dXC, dYC; + int range=0, indx=0, n; /* -Wall */ + double lowestVariance; + double squareSum; + int iii, jjj; + double distanceSum, labelDistance, avgGradient; + char buffer[255]; + int result; + double ux, uy, vx, vy; + double xStart, yStart; + double dx, dy, dxy; + double labelHeight; + SEXP label1 = PROTECT(allocVector(REALSXP, 8)); + SEXP label2; + SEXP lab; + Rboolean gotLabel = FALSE; + Rboolean ddl;/* Don't draw label -- currently unused, i.e. always FALSE*/ + +#ifdef DEBUG_contour + Rprintf("contour(lev = %g):\n", zc); +#endif + + vmax = vmaxget(); + /* This R-allocs ctr_SegDB */ + ctr_SegDB = contourLines(REAL(x), nx, REAL(y), ny, REAL(z), zc, atom); + + /* The segment database is now assembled. */ + /* Begin following contours. */ + /* 1. Grab a segment */ + /* 2. Follow its tail */ + /* 3. Follow its head */ + /* 4. Draw the contour */ + + for (i = 0; i < nx - 1; i++) + for (j = 0; j < ny - 1; j++) { + while ((seglist = ctr_SegDB[i + j * nx])) { + ii = i; jj = j; + start = end = seglist; + ctr_SegDB[i + j * nx] = seglist->next; + xend = seglist->x1; + yend = seglist->y1; + while ((dir = ctr_segdir(xend, yend, REAL(x), REAL(y), + &ii, &jj, nx, ny))) { + ctr_SegDB[ii + jj * nx] + = ctr_segupdate(xend, yend, dir, TRUE,/* = tail */ + ctr_SegDB[ii + jj * nx], &seg); + if (!seg) break; + end->next = seg; + end = seg; + xend = end->x1; + yend = end->y1; + } + end->next = NULL; /* <<< new for 1.2.3 */ + ii = i; jj = j; + xend = seglist->x0; + yend = seglist->y0; + while ((dir = ctr_segdir(xend, yend, REAL(x), REAL(y), + &ii, &jj, nx, ny))) { + ctr_SegDB[ii + jj * nx] + = ctr_segupdate(xend, yend, dir, FALSE,/* ie. head */ + ctr_SegDB[ii+jj*nx], &seg); + if (!seg) break; + seg->next = start; + start = seg; + xend = start->x0; + yend = start->y0; + } + + /* ns := #{segments of polyline} -- need to allocate */ + s = start; + ns = 0; + /* max_contour_segments: prevent inf.loop (shouldn't be needed) */ + while (s && ns < max_contour_segments) { + ns++; + s = s->next; + } + if(ns == max_contour_segments) + warning(_("contour(): circular/long seglist -- set %s > %d?"), + "options(\"max.contour.segments\")", max_contour_segments); + + /* contour midpoint : use for labelling sometime (not yet!) + int ns2; + if (ns > 3) ns2 = ns/2; else ns2 = -1; + */ + + vmax = vmaxget(); + xxx = (double *) R_alloc(ns + 1, sizeof(double)); + yyy = (double *) R_alloc(ns + 1, sizeof(double)); + /* now have the space, go through again: */ + s = start; + ns = 0; + xxx[ns] = s->x0; + yyy[ns++] = s->y0; + while (s->next && ns < max_contour_segments) { + s = s->next; + xxx[ns] = s->x0; + yyy[ns++] = s->y0; + } + xxx[ns] = s->x1; + yyy[ns++] = s->y1; +#ifdef DEBUG_contour + Rprintf(" [%2d,%2d]: (x,y)[1:%d] = ", i,j, ns); + if(ns >= 5) + Rprintf(" (%g,%g), (%g,%g), ..., (%g,%g)\n", + xxx[0],yyy[0], xxx[1],yyy[1], xxx[ns-1],yyy[ns-1]); + else + for(iii = 0; iii < ns; iii++) + Rprintf(" (%g,%g)%s", xxx[iii],yyy[iii], + (iii < ns-1) ? "," : "\n"); +#endif + + if (drawLabels) { + /* If user supplied labels, use i'th one of them + Otherwise stringify the z-value of the contour */ + cetype_t enc = CE_NATIVE; + buffer[0] = ' '; + if (!isNull(labels)) { + int numl = length(labels); + strcpy(&buffer[1], CHAR(STRING_ELT(labels, cnum % numl))); + enc = getCharCE(STRING_ELT(labels, cnum % numl)); + } + else { + PROTECT(lab = allocVector(REALSXP, 1)); + REAL(lab)[0] = zc; + lab = labelformat(lab); + strcpy(&buffer[1], CHAR(STRING_ELT(lab, 0))); /* ASCII */ + UNPROTECT(1); + } + buffer[strlen(buffer)+1] = '\0'; + buffer[strlen(buffer)] = ' '; + + labelDistance = GStrWidth(buffer, enc, INCHES, dd); + labelHeight = GStrHeight(buffer, enc, INCHES, dd); + + if (labelDistance > 0) { + /* Try to find somewhere to draw the label */ + switch (method) { + case 0: /* draw label at one end of contour + overwriting contour line + */ + if (useStart(xxx, yyy, ns, dd) ) + indx = 0; + else + indx = ns - 1; + break; + case 1: /* draw label at one end of contour + embedded in contour + no overlapping labels + */ + indx = 0; + range = 0; + gotLabel = FALSE; + if (useStart(xxx, yyy, ns, dd)) { + iii = 0; + n = findGapUp(xxx, yyy, ns, labelDistance, dd); + } + else { + n = findGapDown(xxx, yyy, ns, labelDistance, dd); + iii = ns - n - 1; + } + if (n > 0) { + /** Find 4 corners of label extents **/ + FindCorners(labelDistance, labelHeight, label1, + xxx[iii], yyy[iii], + xxx[iii+n], yyy[iii+n], dd); + + /** Test corners for intersection with previous labels **/ + label2 = labelList; + result = 0; + while ((result == 0) && (label2 != R_NilValue)) { + result = TestLabelIntersection(label1, CAR(label2)); + label2 = CDR(label2); + } + if (result == 0) { + result = LabelInsideWindow(label1, dd); + if (result == 0) { + indx = iii; + range = n; + gotLabel = TRUE; + } + } + } + break; + case 2: /* draw label on flattest portion of contour + embedded in contour line + no overlapping labels + */ + /* Look for flatest sequence of contour gradients */ + lowestVariance = 9999999; /* A large number */ + indx = 0; + range = 0; + gotLabel = FALSE; + for (iii = 0; iii < ns; iii++) { + distanceSum = 0; + avgGradient = 0; + squareSum = 0; + n = 0; + jjj = (iii + 1); + while ((jjj < ns-1) && + (distanceSum < labelDistance)) { + + /* Find a gap big enough for the label + use several segments if necessary + */ + dX = xxx[jjj] - xxx[jjj - n - 1]; + dY = yyy[jjj] - yyy[jjj - n - 1]; + dXC = GConvertXUnits(dX, USER, INCHES, dd); + dYC = GConvertYUnits(dY, USER, INCHES, dd); + distanceSum = hypot(dXC, dYC); + + /* Calculate the variance of the gradients + of the segments that will make way for the + label + */ + deltaX = xxx[jjj] - xxx[jjj - 1]; + deltaY = yyy[jjj] - yyy[jjj - 1]; + if (deltaX == 0) {deltaX = 1;} + avgGradient += (deltaY/deltaX); + squareSum += avgGradient * avgGradient; + jjj = (jjj + 1); + n += 1; + } + if (distanceSum < labelDistance) + break; + + /** Find 4 corners of label extents **/ + FindCorners(labelDistance, labelHeight, label1, + xxx[iii], yyy[iii], + xxx[iii+n], yyy[iii+n], dd); + + /** Test corners for intersection with previous labels **/ + label2 = labelList; + result = 0; + while ((result == 0) && (label2 != R_NilValue)) { + result = TestLabelIntersection(label1, CAR(label2)); + label2 = CDR(label2); + } + if (result == 0) + result = LabelInsideWindow(label1, dd); + if (result == 0) { + variance = (squareSum - (avgGradient * avgGradient) / n) / n; + avgGradient /= n; + if (variance < lowestVariance) { + lowestVariance = variance; + indx = iii; + range = n; + } + } + if (lowestVariance < 9999999) + gotLabel = TRUE; + } + } /* switch (method) */ + + if (method == 0) { + GPolyline(ns, xxx, yyy, USER, dd); + GText(xxx[indx], yyy[indx], USER, buffer, + CE_NATIVE/*FIX*/, + .5, .5, 0, dd); + } + else { + if (indx > 0) + GPolyline(indx+1, xxx, yyy, USER, dd); + if (ns-1-indx-range > 0) + GPolyline(ns-indx-range, xxx+indx+range, yyy+indx+range, + USER, dd); + if (gotLabel) { + /* find which plot edge we are closest to */ + int closest; /* 0 = indx, 1 = indx+range */ + double dx1, dx2, dy1, dy2, dmin; + dx1 = fmin2((xxx[indx] - gpptr(dd)->usr[0]), + (gpptr(dd)->usr[1] - xxx[indx])); + dx2 = fmin2((gpptr(dd)->usr[1] - xxx[indx+range]), + (xxx[indx+range] - gpptr(dd)->usr[0])); + if (dx1 < dx2) { + closest = 0; + dmin = dx1; + } else { + closest = 1; + dmin = dx2; + } + dy1 = fmin2((yyy[indx] - gpptr(dd)->usr[2]), + (gpptr(dd)->usr[3] - yyy[indx])); + if (closest && (dy1 < dmin)) { + closest = 0; + dmin = dy1; + } else if (dy1 < dmin) + dmin = dy1; + dy2 = fmin2((gpptr(dd)->usr[3] - yyy[indx+range]), + (yyy[indx+range] - gpptr(dd)->usr[2])); + if (!closest && (dy2 < dmin)) + closest = 1; + + dx = GConvertXUnits(xxx[indx+range] - xxx[indx], + USER, INCHES, dd); + dy = GConvertYUnits(yyy[indx+range] - yyy[indx], + USER, INCHES, dd); + dxy = hypot(dx, dy); + + /* save the current label for checking overlap */ + label2 = allocVector(REALSXP, 8); + + FindCorners(labelDistance, labelHeight, label2, + xxx[indx], yyy[indx], + xxx[indx+range], yyy[indx+range], dd); + UNPROTECT_PTR(labelList); + labelList = PROTECT(CONS(label2, labelList)); + + ddl = FALSE; + /* draw an extra bit of segment if the label + doesn't fill the gap */ + if (closest) { + xStart = xxx[indx+range] - + (xxx[indx+range] - xxx[indx]) * + labelDistance / dxy; + yStart = yyy[indx+range] - + (yyy[indx+range] - yyy[indx]) * + labelDistance / dxy; + if (labelDistance / dxy < 1) + GLine(xxx[indx], yyy[indx], + xStart, yStart, + USER, dd); + } else { + xStart = xxx[indx] + + (xxx[indx+range] - xxx[indx]) * + labelDistance / dxy; + yStart = yyy[indx] + + (yyy[indx+range] - yyy[indx]) * + labelDistance / dxy; + if (labelDistance / dxy < 1) + GLine(xStart, yStart, + xxx[indx+range], yyy[indx+range], + USER, dd); + } + + /*** Draw contour labels ***/ + if (xxx[indx] < xxx[indx+range]) { + if (closest) { + ux = xStart; + uy = yStart; + vx = xxx[indx+range]; + vy = yyy[indx+range]; + } else { + ux = xxx[indx]; + uy = yyy[indx]; + vx = xStart; + vy = yStart; + } + } + else { + if (closest) { + ux = xxx[indx+range]; + uy = yyy[indx+range]; + vx = xStart; + vy = yStart; + } else { + ux = xStart; + uy = yStart; + vx = xxx[indx]; + vy = yyy[indx]; + } + } + + if (!ddl) { + /* convert to INCHES for calculation of + angle to draw text + */ + GConvert(&ux, &uy, USER, INCHES, dd); + GConvert(&vx, &vy, USER, INCHES, dd); + /* 0, .5 => left, centre justified */ + GText (ux, uy, INCHES, buffer, + CE_NATIVE/*FIX*/,0, .5, + (180 / 3.14) * atan2(vy - uy, vx - ux), + dd); + } + } /* if (gotLabel) */ + } /* if (method == 0) else ... */ + } /* if (labelDistance > 0) */ + + } /* if (drawLabels) */ + else { + GPolyline(ns, xxx, yyy, USER, dd); + } + + vmaxset(vmax); + } /* while */ + } /* for(i .. ) for(j ..) */ + vmaxset(vmax); /* now we are done with ctr_SegDB */ + UNPROTECT_PTR(label1); /* pwwwargh! This is messy, but last thing + protected is likely labelList, and that needs + to be preserved across calls */ +} + + +SEXP C_contourDef(void) +{ + return ScalarLogical(GEcurrentDevice()->dev->useRotatedTextInContour); +} + +/* contour(x, y, z, levels, labels, labcex, drawlabels, + * method, vfont, col = col, lty = lty, lwd = lwd) + */ +SEXP C_contour(SEXP args) +{ + SEXP c, x, y, z, vfont, col, rawcol, lty, lwd, labels; + int i, j, nx, ny, nc, ncol, nlty, nlwd; + int ltysave, fontsave = 1 /* -Wall */; + rcolor colsave; + double cexsave, lwdsave; + double atom, zmin, zmax; + const void *vmax, *vmax0; + char familysave[201]; + int method; + Rboolean drawLabels; + double labcex; + pGEDevDesc dd = GEcurrentDevice(); + SEXP result = R_NilValue; + + GCheckState(dd); + + args = CDR(args); + if (length(args) < 12) error(_("too few arguments")); + PrintDefaults(); /* prepare for labelformat */ + + x = PROTECT(coerceVector(CAR(args), REALSXP)); + nx = LENGTH(x); + args = CDR(args); + + y = PROTECT(coerceVector(CAR(args), REALSXP)); + ny = LENGTH(y); + args = CDR(args); + + z = PROTECT(coerceVector(CAR(args), REALSXP)); + args = CDR(args); + + /* levels */ + c = PROTECT(coerceVector(CAR(args), REALSXP)); + nc = LENGTH(c); + args = CDR(args); + + labels = CAR(args); + if (!isNull(labels)) TypeCheck(labels, STRSXP); + args = CDR(args); + + labcex = asReal(CAR(args)); + args = CDR(args); + + drawLabels = (Rboolean)asLogical(CAR(args)); + args = CDR(args); + + method = asInteger(CAR(args)); args = CDR(args); + if (method < 1 || method > 3) + error(_("invalid '%s' value"), "method"); + + PROTECT(vfont = FixupVFont(CAR(args))); + if (!isNull(vfont)) { + strncpy(familysave, gpptr(dd)->family, 201); + strncpy(gpptr(dd)->family, "Hershey ", 201); + gpptr(dd)->family[7] = (char) INTEGER(vfont)[0]; + fontsave = gpptr(dd)->font; + gpptr(dd)->font = INTEGER(vfont)[1]; + } + args = CDR(args); + + rawcol = CAR(args); + PROTECT(col = FixupCol(rawcol, R_TRANWHITE)); + ncol = length(col); + args = CDR(args); + + PROTECT(lty = FixupLty(CAR(args), gpptr(dd)->lty)); + nlty = length(lty); + args = CDR(args); + + PROTECT(lwd = FixupLwd(CAR(args), gpptr(dd)->lwd)); + nlwd = length(lwd); + args = CDR(args); + + if (nx < 2 || ny < 2) + error(_("insufficient 'x' or 'y' values")); + + if (nrows(z) != nx || ncols(z) != ny) + error(_("dimension mismatch")); + + if (nc < 1) + error(_("no contour values")); + + for (i = 0; i < nx; i++) { + if (!R_FINITE(REAL(x)[i])) + error(_("missing 'x' values")); + if (i > 0 && REAL(x)[i] < REAL(x)[i - 1]) + error(_("increasing 'x' values expected")); + } + + for (i = 0; i < ny; i++) { + if (!R_FINITE(REAL(y)[i])) + error(_("missing 'y' values")); + if (i > 0 && REAL(y)[i] < REAL(y)[i - 1]) + error(_("increasing 'y' values expected")); + } + + for (i = 0; i < nc; i++) + if (!R_FINITE(REAL(c)[i])) + error(_("invalid NA contour values")); + + zmin = DBL_MAX; + zmax = DBL_MIN; + for (i = 0; i < nx * ny; i++) + if (R_FINITE(REAL(z)[i])) { + if (zmax < REAL(z)[i]) zmax = REAL(z)[i]; + if (zmin > REAL(z)[i]) zmin = REAL(z)[i]; + } + + if (zmin >= zmax) { + if (zmin == zmax) + warning(_("all z values are equal")); + else + warning(_("all z values are NA")); + UNPROTECT(8); + return R_NilValue; + } + + /* change to 1e-3, reconsidered because of PR#897 + * but 1e-7, and even 2*DBL_EPSILON do not prevent inf.loop in contour(). + * maybe something like 16 * DBL_EPSILON * (..). + * see also max_contour_segments above */ + atom = 1e-3 * (zmax - zmin); + + /* Initialize the segment data base */ + + /* Note we must be careful about resetting */ + /* the top of the stack, otherwise we run out of */ + /* memory after a sequence of displaylist replays */ + + vmax0 = vmaxget(); + ctr_SegDB = (SEGP*)R_alloc(nx*ny, sizeof(SEGP)); + + for (i = 0; i < nx; i++) + for (j = 0; j < ny; j++) + ctr_SegDB[i + j * nx] = NULL; + + /* Draw the contours -- note the heap release */ + + ltysave = gpptr(dd)->lty; + colsave = gpptr(dd)->col; + lwdsave = gpptr(dd)->lwd; + cexsave = gpptr(dd)->cex; + labelList = PROTECT(R_NilValue); + + + /* draw contour for levels[i] */ + GMode(1, dd); + for (i = 0; i < nc; i++) { + vmax = vmaxget(); + gpptr(dd)->lty = INTEGER(lty)[i % nlty]; + if (gpptr(dd)->lty == NA_INTEGER) + gpptr(dd)->lty = ltysave; + if (isNAcol(rawcol, i, ncol)) + gpptr(dd)->col = colsave; + else + gpptr(dd)->col = INTEGER(col)[i % ncol]; + gpptr(dd)->lwd = REAL(lwd)[i % nlwd]; + if (!R_FINITE(gpptr(dd)->lwd)) + gpptr(dd)->lwd = lwdsave; + gpptr(dd)->cex = labcex; + contour(x, nx, y, ny, z, REAL(c)[i], labels, i, + drawLabels, method - 1, atom, dd); + vmaxset(vmax); + } + GMode(0, dd); + vmaxset(vmax0); + gpptr(dd)->lty = ltysave; + gpptr(dd)->col = colsave; + gpptr(dd)->lwd = lwdsave; + gpptr(dd)->cex = cexsave; + if(!isNull(vfont)) { + strncpy(gpptr(dd)->family, familysave, 201); + gpptr(dd)->font = fontsave; + } + UNPROTECT(9); /* x y z c vfont col lty lwd labellist */ + return result; +} diff --git a/com.oracle.truffle.r.native/gnur/patch/src/library/graphics/src/stem.c b/com.oracle.truffle.r.native/gnur/patch/src/library/graphics/src/stem.c new file mode 100644 index 0000000000000000000000000000000000000000..6e6b7f35424fea5e384979f8a26b9b350bca7d81 --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/library/graphics/src/stem.c @@ -0,0 +1,214 @@ +/* + * R : A Computer Language for Statistical Data Analysis + * Copyright (C) 1995, 1996 Robert Gentleman and Ross Ihaka + * Copyright (C) 1997-2014 R Core Team + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version. + * + * This program 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 this program; if not, a copy is available at + * https://www.R-project.org/Licenses/ + */ + +#ifdef HAVE_CONFIG_H +#include <config.h> +#endif + +#include <Rinternals.h> +#include <math.h> +#include <limits.h> /* INT_MAX */ +#include <stdlib.h> /* abs */ +#include <Rmath.h> /* for imin2 and imax2 */ +#include <R_ext/Print.h> /* for Rprintf */ +#include <R_ext/Utils.h> /* for R_rsort */ +#include <R_ext/Error.h> +#include <R_ext/Arith.h> /* for R_FINITE */ + +#ifdef ENABLE_NLS +#include <libintl.h> +#define _(String) dgettext ("graphics", String) +#else +#define _(String) (String) +#endif + +static void stem_print(int close, int dist, int ndigits) +{ + if((close/10 == 0) && (dist < 0)) + Rprintf(" %*s | ", ndigits, "-0"); + else + Rprintf(" %*d | ", ndigits, close/10); +} + +static Rboolean +stem_leaf(double *x, int n, double scale, int width, double atom) +{ + double r, c, x1, x2; + double mu, lo, hi; + int mm, k, i, j, xi; + int ldigits, hdigits, ndigits, pdigits; + + R_rsort(x,n); + + if(n <= 1) + return FALSE; + + Rprintf("\n"); + if(x[n-1] > x[0]) { + r = atom + (x[n-1] - x[0])/scale; + // this needs to be exact: exp10 in glibc is not accurate + c = R_pow_di(10.0, (int)(1.0 - floor(log10(r)))); + mm = imin2(2, imax2(0, (int)(r*c/25))); + k = 3*mm + 2 - 150/(n + 50); + if ((k-1)*(k-2)*(k-5) == 0) + c *= 10.; + /* need to ensure that x[i]*c does not integer overflow */ + x1 = fabs(x[0]); x2 = fabs(x[n-1]); + if(x2 > x1) x1 = x2; + while(x1*c > INT_MAX) c /= 10; + if (k*(k-4)*(k-8) == 0) mu = 5; + if ((k-1)*(k-5)*(k-6) == 0) mu = 20; + } else { + r = atom + fabs(x[0])/scale; + c = R_pow_di(10.0, (int)(1.0 - floor(log10(r)))); + k = 2; // not important what + } + + mu = 10; + if (k*(k-4)*(k-8) == 0) mu = 5; + if ((k-1)*(k-5)*(k-6) == 0) mu = 20; + + + /* Find the print width of the stem. */ + + lo = floor(x[0]*c/mu)*mu; + hi = floor(x[n-1]*c/mu)*mu; + ldigits = (lo < 0) ? (int) floor(log10(-(double)lo)) + 1 : 0; + hdigits = (hi > 0) ? (int) floor(log10((double)hi)): 0; + ndigits = (ldigits < hdigits) ? hdigits : ldigits; + + /* Starting cell */ + + if(lo < 0 && floor(x[0]*c) == lo) lo = lo - mu; + hi = lo + mu; + if(floor(x[0]*c+0.5) > hi) { + lo = hi; + hi = lo + mu; + } + + /* Print out the info about the decimal place */ + + pdigits = 1 - (int) floor(log10(c) + 0.5); + + Rprintf(" The decimal point is "); + if(pdigits == 0) + Rprintf("at the |\n\n"); + else + Rprintf("%d digit(s) to the %s of the |\n\n",abs(pdigits), + (pdigits > 0) ? "right" : "left"); + i = 0; + do { + if(lo < 0) + stem_print((int)hi, (int)lo, ndigits); + else + stem_print((int)lo, (int)hi, ndigits); + j = 0; + do { + if(x[i] < 0)xi = (int) (x[i]*c - .5); + else xi = (int) (x[i]*c + .5); + + if( (hi == 0 && x[i] >= 0)|| + (lo < 0 && xi > hi) || + (lo >= 0 && xi >= hi) ) + break; + + j++; + if(j <= width-12) + Rprintf("%1d", abs(xi) % 10); + i++; + } while(i < n); + if(j > width) + Rprintf("+%d", j - width); + Rprintf("\n"); + if(i >= n) + break; + hi += mu; + lo += mu; + } while(1); + Rprintf("\n"); + return TRUE; +} + +/* The R wrapper has removed NAs from x */ +SEXP C_StemLeaf(SEXP x, SEXP scale, SEXP swidth, SEXP atom) +{ + if(TYPEOF(x) != REALSXP || TYPEOF(scale) != REALSXP) error("invalid input"); +#ifdef LONG_VECTOR_SUPPORT + if (IS_LONG_VEC(x)) + error(_("long vector '%s' is not supported"), "x"); +#endif + int width = asInteger(swidth), n = LENGTH(x); + if (n == NA_INTEGER) error(_("invalid '%s' argument"), "x"); + if (width == NA_INTEGER) error(_("invalid '%s' argument"), "width"); + double sc = asReal(scale), sa = asReal(atom); + if (!R_FINITE(sc)) error(_("invalid '%s' argument"), "scale"); + if (!R_FINITE(sa)) error(_("invalid '%s' argument"), "atom"); + stem_leaf(REAL(x), n, sc, width, sa); + return R_NilValue; +} + +/* Formerly a version in src/appl/binning.c */ +#include <string.h> // for memset + +static void +C_bincount(double *x, R_xlen_t n, double *breaks, R_xlen_t nb, int *count, + int right, int include_border) +{ + R_xlen_t i, lo, hi, nb1 = nb - 1, new; + + // for(i = 0; i < nb1; i++) count[i] = 0; + memset(count, 0, nb1 * sizeof(int)); + + for(i = 0 ; i < n ; i++) + if(R_FINITE(x[i])) { // left in as a precaution + lo = 0; + hi = nb1; + if(breaks[lo] <= x[i] && + (x[i] < breaks[hi] || (x[i] == breaks[hi] && include_border))) { + while(hi-lo >= 2) { + new = (hi+lo)/2; + if(x[i] > breaks[new] || (!right && x[i] == breaks[new])) + lo = new; + else + hi = new; + } +#ifdef LONG_VECTOR_SUPPORT + if(count[lo] >= INT_MAX) + error("count for a bin exceeds INT_MAX"); +#endif + count[lo]++; + } + } +} + +/* The R wrapper removed non-finite values */ +SEXP C_BinCount(SEXP x, SEXP breaks, SEXP right, SEXP lowest) +{ + x = PROTECT(coerceVector(x, REALSXP)); + breaks = PROTECT(coerceVector(breaks, REALSXP)); + R_xlen_t n = XLENGTH(x), nB = XLENGTH(breaks); + int sr = asLogical(right), sl = asLogical(lowest); + if (sr == NA_INTEGER) error(_("invalid '%s' argument"), "right"); + if (sl == NA_INTEGER) error(_("invalid '%s' argument"), "include.lowest"); + SEXP counts = PROTECT(allocVector(INTSXP, nB - 1)); + C_bincount(REAL(x), n, REAL(breaks), nB, INTEGER(counts), sr, sl); + UNPROTECT(3); + return counts; +} diff --git a/com.oracle.truffle.r.native/gnur/patch/src/library/grid/src/gpar.c b/com.oracle.truffle.r.native/gnur/patch/src/library/grid/src/gpar.c new file mode 100644 index 0000000000000000000000000000000000000000..f415a2544cab52513d25f95925bc1e6a7da5bb41 --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/library/grid/src/gpar.c @@ -0,0 +1,346 @@ +/* + * R : A Computer Language for Statistical Data Analysis + * Copyright (C) 2001-3 Paul Murrell + * 2003-2014 The R Core Team + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version. + * + * This program 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 this program; if not, a copy is available at + * https://www.R-project.org/Licenses/ + */ + +#include "grid.h" +#include <string.h> + + +/* Some access methods for gpars */ +SEXP gpFontSizeSXP(SEXP gp) { + return VECTOR_ELT(gp, GP_FONTSIZE); +} + +double gpFontSize(SEXP gp, int i) { + SEXP fontsize = gpFontSizeSXP(gp); + return REAL(fontsize)[i % LENGTH(fontsize)]; +} + +SEXP gpLineHeightSXP(SEXP gp) { + return VECTOR_ELT(gp, GP_LINEHEIGHT); +} + +double gpLineHeight(SEXP gp, int i) { + SEXP lineheight = gpLineHeightSXP(gp); + return REAL(lineheight)[i % LENGTH(lineheight)]; +} + +/* grid has no concept of 'colour 0' (bg in base) */ +int gpCol(SEXP gp, int i) { + SEXP col = VECTOR_ELT(gp, GP_COL); + int result; + if (isNull(col)) + result = R_TRANWHITE; + else + result = RGBpar3(col, i % LENGTH(col), R_TRANWHITE); + return result; +} + +SEXP gpFillSXP(SEXP gp) { + return VECTOR_ELT(gp, GP_FILL); +} + +int gpFill(SEXP gp, int i) { + SEXP fill = gpFillSXP(gp); + int result; + if (isNull(fill)) + result = R_TRANWHITE; + else + result = RGBpar3(fill, i % LENGTH(fill), R_TRANWHITE); + return result; +} + +SEXP gpGammaSXP(SEXP gp) { + return VECTOR_ELT(gp, GP_GAMMA); +} + +double gpGamma(SEXP gp, int i) { + SEXP gamma = gpGammaSXP(gp); + return REAL(gamma)[i % LENGTH(gamma)]; +} + +SEXP gpLineTypeSXP(SEXP gp) { + return VECTOR_ELT(gp, GP_LTY); +} + +int gpLineType(SEXP gp, int i) { + SEXP linetype = gpLineTypeSXP(gp); + return GE_LTYpar(linetype, i % LENGTH(linetype)); +} + +SEXP gpLineWidthSXP(SEXP gp) { + return VECTOR_ELT(gp, GP_LWD); +} + +double gpLineWidth(SEXP gp, int i) { + SEXP linewidth = gpLineWidthSXP(gp); + return REAL(linewidth)[i % LENGTH(linewidth)]; +} + +SEXP gpCexSXP(SEXP gp) { + return VECTOR_ELT(gp, GP_CEX); +} + +double gpCex(SEXP gp, int i) { + SEXP cex = gpCexSXP(gp); + return REAL(cex)[i % LENGTH(cex)]; +} + +SEXP gpFontSXP(SEXP gp) { + return VECTOR_ELT(gp, GP_FONT); +} + +int gpFont(SEXP gp, int i) { + SEXP font = gpFontSXP(gp); + return INTEGER(font)[i % LENGTH(font)]; +} + +SEXP gpFontFamilySXP(SEXP gp) { + return VECTOR_ELT(gp, GP_FONTFAMILY); +} + +const char* gpFontFamily(SEXP gp, int i) { + SEXP fontfamily = gpFontFamilySXP(gp); + return CHAR(STRING_ELT(fontfamily, i % LENGTH(fontfamily))); +} + +SEXP gpAlphaSXP(SEXP gp) { + return VECTOR_ELT(gp, GP_ALPHA); +} + +double gpAlpha(SEXP gp, int i) { + SEXP alpha = gpAlphaSXP(gp); + return REAL(alpha)[i % LENGTH(alpha)]; +} + +SEXP gpLineEndSXP(SEXP gp) { + return VECTOR_ELT(gp, GP_LINEEND); +} + +R_GE_lineend gpLineEnd(SEXP gp, int i) { + SEXP lineend = gpLineEndSXP(gp); + return GE_LENDpar(lineend, i % LENGTH(lineend)); +} + +SEXP gpLineJoinSXP(SEXP gp) { + return VECTOR_ELT(gp, GP_LINEJOIN); +} + +R_GE_linejoin gpLineJoin(SEXP gp, int i) { + SEXP linejoin = gpLineJoinSXP(gp); + return GE_LJOINpar(linejoin, i % LENGTH(linejoin)); +} + +SEXP gpLineMitreSXP(SEXP gp) { + return VECTOR_ELT(gp, GP_LINEMITRE); +} + +double gpLineMitre(SEXP gp, int i) { + SEXP linemitre = gpLineMitreSXP(gp); + return REAL(linemitre)[i % LENGTH(linemitre)]; +} + +SEXP gpLexSXP(SEXP gp) { + return VECTOR_ELT(gp, GP_LEX); +} + +double gpLex(SEXP gp, int i) { + SEXP lex = gpLexSXP(gp); + return REAL(lex)[i % LENGTH(lex)]; +} + +/* + * Never access fontface because fontface values are stored in font + * Historical reasons ... + */ + +/* + * Combine gpar alpha with alpha level stored in colour + * + * finalAlpha = gpAlpha*(R_ALPHA(col)/255) + * + * Based on my reading of how group alpha and individual + * object alphas are combined in the SVG 1.0 docs + * + * Also has nice properties: + * (i) range of finalAlpha is 0 to 1. + * (ii) if either of gpAlpha or R_ALPHA(col) are 0 then finalAlpha = 0 + * (i.e., can never make fully transparent colour less transparent). + * (iii) in order to get finalAlpha = 1, both gpAlpha and R_ALPHA(col) + * must be 1 (i.e., only way to get fully opaque is if both + * alpha levels are fully opaque). + */ +static unsigned int combineAlpha(double alpha, int col) +{ + unsigned int newAlpha = (unsigned int)((alpha*(R_ALPHA(col)/255.0))*255); + return R_RGBA(R_RED(col), R_GREEN(col), R_BLUE(col), newAlpha); +} + +/* + * Generate an R_GE_gcontext from a gpar + */ +void gcontextFromgpar(SEXP gp, int i, const pGEcontext gc, pGEDevDesc dd) +{ + /* + * Combine gpAlpha with col and fill + */ + gc->col = combineAlpha(gpAlpha(gp, i), gpCol(gp, i)); + gc->fill = combineAlpha(gpAlpha(gp, i), gpFill(gp, i)); + gc->gamma = gpGamma(gp, i); + /* + * Combine gpLex with lwd + * Also scale by GSS_SCALE (a "zoom" factor) + */ + gc->lwd = gpLineWidth(gp, i) * gpLex(gp, i) * + REAL(gridStateElement(dd, GSS_SCALE))[0]; + gc->lty = gpLineType(gp, i); + gc->lend = gpLineEnd(gp, i); + gc->ljoin = gpLineJoin(gp, i); + gc->lmitre = gpLineMitre(gp, i); + gc->cex = gpCex(gp, i); + /* + * Scale by GSS_SCALE (a "zoom" factor) + */ + gc->ps = gpFontSize(gp, i) * REAL(gridStateElement(dd, GSS_SCALE))[0]; + gc->lineheight = gpLineHeight(gp, i); + gc->fontface = gpFont(gp, i); + strcpy(gc->fontfamily, gpFontFamily(gp, i)); +} + +SEXP L_setGPar(SEXP gpars) +{ + /* Set the value of the current gpars on the current device + * Need to do this in here so that redrawing via R BASE display + * list works + */ + /* Get the current device + */ + pGEDevDesc dd = getDevice(); + setGridStateElement(dd, GSS_GPAR, gpars); + return R_NilValue; +} + +SEXP L_getGPar(void) +{ + /* Get the value of the current gpars on the current device + * Need to do this in here so that redrawing via R BASE display + * list works + */ + /* Get the current device + */ + pGEDevDesc dd = getDevice(); + return gridStateElement(dd, GSS_GPAR); +} + +SEXP L_getGPsaved() +{ + /* Get the current device + */ + pGEDevDesc dd = getDevice(); + return gridStateElement(dd, GSS_GPSAVED); +} + +SEXP L_setGPsaved(SEXP gpars) +{ + /* Get the current device + */ + pGEDevDesc dd = getDevice(); + setGridStateElement(dd, GSS_GPSAVED, gpars); + return R_NilValue; +} + +void initGPar(pGEDevDesc dd) +{ + pDevDesc dev = dd->dev; + SEXP gpar, gparnames, class; + SEXP gpfill, gpcol, gpgamma, gplty, gplwd, gpcex, gpfs, gplh, gpfont; + SEXP gpfontfamily, gpalpha, gplineend, gplinejoin, gplinemitre, gplex; + SEXP gsd = (SEXP) dd->gesd[gridRegisterIndex]->systemSpecific; + PROTECT(gpar = allocVector(VECSXP, 15)); + PROTECT(gparnames = allocVector(STRSXP, 15)); + SET_STRING_ELT(gparnames, GP_FILL, mkChar("fill")); + SET_STRING_ELT(gparnames, GP_COL, mkChar("col")); + SET_STRING_ELT(gparnames, GP_GAMMA, mkChar("gamma")); + SET_STRING_ELT(gparnames, GP_LTY, mkChar("lty")); + SET_STRING_ELT(gparnames, GP_LWD, mkChar("lwd")); + SET_STRING_ELT(gparnames, GP_CEX, mkChar("cex")); + SET_STRING_ELT(gparnames, GP_FONTSIZE, mkChar("fontsize")); + SET_STRING_ELT(gparnames, GP_LINEHEIGHT, mkChar("lineheight")); + SET_STRING_ELT(gparnames, GP_FONT, mkChar("font")); + SET_STRING_ELT(gparnames, GP_FONTFAMILY, mkChar("fontfamily")); + SET_STRING_ELT(gparnames, GP_ALPHA, mkChar("alpha")); + SET_STRING_ELT(gparnames, GP_LINEEND, mkChar("lineend")); + SET_STRING_ELT(gparnames, GP_LINEJOIN, mkChar("linejoin")); + SET_STRING_ELT(gparnames, GP_LINEMITRE, mkChar("linemitre")); + SET_STRING_ELT(gparnames, GP_LEX, mkChar("lex")); + setAttrib(gpar, R_NamesSymbol, gparnames); + PROTECT(gpfill = allocVector(STRSXP, 1)); + SET_STRING_ELT(gpfill, 0, mkChar(col2name(dev->startfill))); + SET_VECTOR_ELT(gpar, GP_FILL, gpfill); + PROTECT(gpcol = allocVector(STRSXP, 1)); + SET_STRING_ELT(gpcol, 0, mkChar(col2name(dev->startcol))); + SET_VECTOR_ELT(gpar, GP_COL, gpcol); + PROTECT(gpgamma = allocVector(REALSXP, 1)); + REAL(gpgamma)[0] = dev->startgamma; + SET_VECTOR_ELT(gpar, GP_GAMMA, gpgamma); + PROTECT(gplty = GE_LTYget(dev->startlty)); + SET_VECTOR_ELT(gpar, GP_LTY, gplty); + PROTECT(gplwd = allocVector(REALSXP, 1)); + REAL(gplwd)[0] = 1; + SET_VECTOR_ELT(gpar, GP_LWD, gplwd); + PROTECT(gpcex = allocVector(REALSXP, 1)); + REAL(gpcex)[0] = 1; + SET_VECTOR_ELT(gpar, GP_CEX, gpcex); + PROTECT(gpfs = allocVector(REALSXP, 1)); + REAL(gpfs)[0] = dev->startps; + SET_VECTOR_ELT(gpar, GP_FONTSIZE, gpfs); + PROTECT(gplh = allocVector(REALSXP, 1)); + REAL(gplh)[0] = 1.2; + SET_VECTOR_ELT(gpar, GP_LINEHEIGHT, gplh); + PROTECT(gpfont = allocVector(INTSXP, 1)); + INTEGER(gpfont)[0] = dev->startfont; + SET_VECTOR_ELT(gpar, GP_FONT, gpfont); + PROTECT(gpfontfamily = allocVector(STRSXP, 1)); + /* + * A font family of "" means that the default font + * set up by the device will be used. + */ + SET_STRING_ELT(gpfontfamily, 0, mkChar("")); + SET_VECTOR_ELT(gpar, GP_FONTFAMILY, gpfontfamily); + PROTECT(gpalpha = allocVector(REALSXP, 1)); + REAL(gpalpha)[0] = 1; + SET_VECTOR_ELT(gpar, GP_ALPHA, gpalpha); + PROTECT(gplineend = allocVector(STRSXP, 1)); + SET_STRING_ELT(gplineend, 0, mkChar("round")); + SET_VECTOR_ELT(gpar, GP_LINEEND, gplineend); + PROTECT(gplinejoin = allocVector(STRSXP, 1)); + SET_STRING_ELT(gplinejoin, 0, mkChar("round")); + SET_VECTOR_ELT(gpar, GP_LINEJOIN, gplinejoin); + PROTECT(gplinemitre = allocVector(REALSXP, 1)); + REAL(gplinemitre)[0] = 10; + SET_VECTOR_ELT(gpar, GP_LINEMITRE, gplinemitre); + PROTECT(gplex = allocVector(REALSXP, 1)); + REAL(gplex)[0] = 1; + SET_VECTOR_ELT(gpar, GP_LEX, gplex); + PROTECT(class = allocVector(STRSXP, 1)); + SET_STRING_ELT(class, 0, mkChar("gpar")); + classgets(gpar, class); + SET_VECTOR_ELT(gsd, GSS_GPAR, gpar); + UNPROTECT(18); +} diff --git a/com.oracle.truffle.r.native/gnur/patch/src/library/grid/src/grid.c b/com.oracle.truffle.r.native/gnur/patch/src/library/grid/src/grid.c new file mode 100644 index 0000000000000000000000000000000000000000..d2d3060033824c9d71bdb54bad1c5f7f0f7f7cb9 --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/library/grid/src/grid.c @@ -0,0 +1,3703 @@ +/* + * R : A Computer Language for Statistical Data Analysis + * Copyright (C) 2001-3 Paul Murrell + * 2003-2013 The R Core Team + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version. + * + * This program 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 this program; if not, a copy is available at + * https://www.R-project.org/Licenses/ + */ + + +#define GRID_MAIN +#include "grid.h" +#include <math.h> +#include <float.h> +#include <string.h> + +/* NOTE: + * The extensive use of L or L_ prefixes dates back to when this + * package used to be called "lattice" + */ + +void getDeviceSize(pGEDevDesc dd, double *devWidthCM, double *devHeightCM) +{ + double left, right, bottom, top; + dd->dev->size(&left, &right, &bottom, &top, dd->dev); + *devWidthCM = fabs(right - left) * dd->dev->ipr[0] * 2.54; + *devHeightCM = fabs(top - bottom) * dd->dev->ipr[1] * 2.54; +} + +static Rboolean deviceChanged(double devWidthCM, double devHeightCM, + SEXP currentvp) +{ + Rboolean result = FALSE; + SEXP pvpDevWidthCM, pvpDevHeightCM; + PROTECT(pvpDevWidthCM = VECTOR_ELT(currentvp, PVP_DEVWIDTHCM)); + PROTECT(pvpDevHeightCM = VECTOR_ELT(currentvp, PVP_DEVHEIGHTCM)); + if (fabs(REAL(pvpDevWidthCM)[0] - devWidthCM) > 1e-6) { + result = TRUE; + REAL(pvpDevWidthCM)[0] = devWidthCM; + SET_VECTOR_ELT(currentvp, PVP_DEVWIDTHCM, pvpDevWidthCM); + } + if (fabs(REAL(pvpDevHeightCM)[0] - devHeightCM) > 1e-6) { + result = TRUE; + REAL(pvpDevHeightCM)[0] = devHeightCM; + SET_VECTOR_ELT(currentvp, PVP_DEVHEIGHTCM, pvpDevHeightCM); + } + UNPROTECT(2); + return result; +} + +/* Register grid with R's graphics engine + */ +SEXP L_initGrid(SEXP GridEvalEnv) +{ + R_gridEvalEnv = GridEvalEnv; + GEregisterSystem(gridCallback, &gridRegisterIndex); + return R_NilValue; +} + +SEXP L_killGrid() +{ + GEunregisterSystem(gridRegisterIndex); + return R_NilValue; +} + +/* Get the current device (the graphics engine creates one if nec.) + */ +pGEDevDesc getDevice() +{ + return GEcurrentDevice(); +} + +/* If this is the first time that a grid operation has occurred for + * this device, do some initialisation. + */ +void dirtyGridDevice(pGEDevDesc dd) { + if (!LOGICAL(gridStateElement(dd, GSS_GRIDDEVICE))[0]) { + SEXP gsd, griddev; + /* Record the fact that this device has now received grid output + */ + gsd = (SEXP) dd->gesd[gridRegisterIndex]->systemSpecific; + PROTECT(griddev = allocVector(LGLSXP, 1)); + LOGICAL(griddev)[0] = TRUE; + SET_VECTOR_ELT(gsd, GSS_GRIDDEVICE, griddev); + UNPROTECT(1); + /* + * Start the first page on the device + * (But only if no other graphics system has not already done so) + */ + if (!GEdeviceDirty(dd)) { + R_GE_gcontext gc; + SEXP currentgp = gridStateElement(dd, GSS_GPAR); + gcontextFromgpar(currentgp, 0, &gc, dd); + GENewPage(&gc, dd); + GEdirtyDevice(dd); + } + /* + * Only initialise viewport once new page has started + * (required for postscript output [at least]) + */ + initVP(dd); + initDL(dd); + } +} + +SEXP L_gridDirty() +{ + /* Get the current device + */ + pGEDevDesc dd = getDevice(); + dirtyGridDevice(dd); + return R_NilValue; +} + +void getViewportContext(SEXP vp, LViewportContext *vpc) +{ + fillViewportContextFromViewport(vp, vpc); +} + +SEXP L_currentViewport() +{ + /* Get the current device + */ + pGEDevDesc dd = getDevice(); + return gridStateElement(dd, GSS_VP); +} + +SEXP doSetViewport(SEXP vp, + /* + * Are we setting the top-level viewport? + */ + Rboolean topLevelVP, + /* + * Are we pushing a new viewport? + * (or just revisiting an already-pushed viewport?) + */ + Rboolean pushing, + pGEDevDesc dd) +{ + int i, j; + double devWidthCM, devHeightCM; + double xx1, yy1, xx2, yy2; + SEXP currentClip, widthCM, heightCM; + /* Get the current device size + */ + getDeviceSize((dd), &devWidthCM, &devHeightCM); + if (!topLevelVP && pushing) { + SEXP parent = gridStateElement(dd, GSS_VP); + /* Set the viewport's parent + * Need to do this in here so that redrawing via R BASE display + * list works + */ + SET_VECTOR_ELT(vp, PVP_PARENT, parent); + /* + * Make this viewport a child of its parent + * This involves assigning a value in the parent's + * children slot (which is an environment), using + * the viewport's name as the symbol name. + * NOTE that we are deliberately using defineVar to + * assign the vp SEXP itself, NOT a copy. + */ + defineVar(installChar(STRING_ELT(VECTOR_ELT(vp, VP_NAME), 0)), + vp, + VECTOR_ELT(parent, PVP_CHILDREN)); + } + /* Calculate the transformation for the viewport. + * This will hopefully only involve updating the transformation + * from the previous viewport. + * However, if the device has changed size, we will need to + * recalculate the transformation from the top-level viewport + * all the way down. + * NEVER incremental for top-level viewport + */ + calcViewportTransform(vp, viewportParent(vp), + !topLevelVP && + !deviceChanged(devWidthCM, devHeightCM, + viewportParent(vp)), dd); + /* + * We must "turn off" clipping + * We set the clip region to be the entire device + * (actually, as for the top-level viewport, we set it + * to be slightly larger than the device to avoid + * "edge effects") + */ + if (viewportClip(vp) == NA_LOGICAL) { + xx1 = toDeviceX(-0.5*devWidthCM/2.54, GE_INCHES, dd); + yy1 = toDeviceY(-0.5*devHeightCM/2.54, GE_INCHES, dd); + xx2 = toDeviceX(1.5*devWidthCM/2.54, GE_INCHES, dd); + yy2 = toDeviceY(1.5*devHeightCM/2.54, GE_INCHES, dd); + GESetClip(xx1, yy1, xx2, yy2, dd); + } + /* If we are supposed to clip to this viewport ... + * NOTE that we will only clip if there is no rotation + */ + else if (viewportClip(vp)) { + double rotationAngle = REAL(viewportRotation(vp))[0]; + if (rotationAngle != 0 && + rotationAngle != 90 && + rotationAngle != 270 && + rotationAngle != 360) { + warning(_("cannot clip to rotated viewport")); + /* Still need to set clip region for this viewport. + So "inherit" parent clip region. + In other words, 'clip=TRUE' + 'rot=15' = 'clip=FALSE' + */ + SEXP parentClip; + PROTECT(parentClip = viewportClipRect(viewportParent(vp))); + xx1 = REAL(parentClip)[0]; + yy1 = REAL(parentClip)[1]; + xx2 = REAL(parentClip)[2]; + yy2 = REAL(parentClip)[3]; + UNPROTECT(1); + } else { + /* Calculate a clipping region and set it + */ + SEXP x1, y1, x2, y2; + LViewportContext vpc; + double vpWidthCM = REAL(viewportWidthCM(vp))[0]; + double vpHeightCM = REAL(viewportHeightCM(vp))[0]; + R_GE_gcontext gc; + LTransform transform; + for (i=0; i<3; i++) + for (j=0; j<3; j++) + transform[i][j] = + REAL(viewportTransform(vp))[i + 3*j]; + if (!topLevelVP) { + PROTECT(x1 = unit(0, L_NPC)); + PROTECT(y1 = unit(0, L_NPC)); + PROTECT(x2 = unit(1, L_NPC)); + PROTECT(y2 = unit(1, L_NPC)); + } else { + /* Special case for top-level viewport. + * Set clipping region outside device boundaries. + * This means that we have set the clipping region to + * something, but avoids problems if the nominal device + * limits are actually within its physical limits + * (e.g., PostScript) + */ + PROTECT(x1 = unit(-.5, L_NPC)); + PROTECT(y1 = unit(-.5, L_NPC)); + PROTECT(x2 = unit(1.5, L_NPC)); + PROTECT(y2 = unit(1.5, L_NPC)); + } + getViewportContext(vp, &vpc); + gcontextFromViewport(vp, &gc, dd); + transformLocn(x1, y1, 0, vpc, &gc, + vpWidthCM, vpHeightCM, + dd, + transform, + &xx1, &yy1); + transformLocn(x2, y2, 0, vpc, &gc, + vpWidthCM, vpHeightCM, + dd, + transform, + &xx2, &yy2); + UNPROTECT(4); /* unprotect x1, y1, x2, y2 */ + /* The graphics engine only takes device coordinates + */ + xx1 = toDeviceX(xx1, GE_INCHES, dd); + yy1 = toDeviceY(yy1, GE_INCHES, dd); + xx2 = toDeviceX(xx2, GE_INCHES, dd); + yy2 = toDeviceY(yy2, GE_INCHES, dd); + GESetClip(xx1, yy1, xx2, yy2, dd); + } + } else { + /* If we haven't set the clipping region for this viewport + * we need to save the clipping region from its parent + * so that when we pop this viewport we can restore that. + */ + /* NOTE that we are relying on grid.R setting clip=TRUE + * for the top-level viewport, else *BOOM*! + */ + SEXP parentClip; + PROTECT(parentClip = viewportClipRect(viewportParent(vp))); + xx1 = REAL(parentClip)[0]; + yy1 = REAL(parentClip)[1]; + xx2 = REAL(parentClip)[2]; + yy2 = REAL(parentClip)[3]; + UNPROTECT(1); + /* If we are revisiting a viewport that inherits a clip + * region from a parent viewport, we may need to reset + * the clip region (at worst, we generate a redundant clip) + */ + if (!pushing) { + GESetClip(xx1, yy1, xx2, yy2, dd); + } + } + PROTECT(currentClip = allocVector(REALSXP, 4)); + REAL(currentClip)[0] = xx1; + REAL(currentClip)[1] = yy1; + REAL(currentClip)[2] = xx2; + REAL(currentClip)[3] = yy2; + SET_VECTOR_ELT(vp, PVP_CLIPRECT, currentClip); + /* + * Save the current device size + */ + PROTECT(widthCM = allocVector(REALSXP, 1)); + REAL(widthCM)[0] = devWidthCM; + SET_VECTOR_ELT(vp, PVP_DEVWIDTHCM, widthCM); + PROTECT(heightCM = allocVector(REALSXP, 1)); + REAL(heightCM)[0] = devHeightCM; + SET_VECTOR_ELT(vp, PVP_DEVHEIGHTCM, heightCM); + UNPROTECT(3); + return vp; +} + +SEXP L_setviewport(SEXP invp, SEXP hasParent) +{ + SEXP vp; + SEXP pushedvp, fcall; + /* Get the current device + */ + pGEDevDesc dd = getDevice(); + /* + * Duplicate the viewport passed in because we are going + * to modify it to hell and gone. + */ + PROTECT(vp = duplicate(invp)); + /* + * Call R function pushedvp() + */ + PROTECT(fcall = lang2(install("pushedvp"), + vp)); + PROTECT(pushedvp = eval(fcall, R_gridEvalEnv)); + pushedvp = doSetViewport(pushedvp, !LOGICAL(hasParent)[0], TRUE, dd); + /* Set the value of the current viewport for the current device + * Need to do this in here so that redrawing via R BASE display + * list works + */ + setGridStateElement(dd, GSS_VP, pushedvp); + UNPROTECT(3); + return R_NilValue; +} + +/* + * Find a viewport in the current viewport tree by name + * + * Have to do this in C code so that we get THE SEXP in + * the tree, NOT a copy of it. + */ + +/* + * Some helper functions to call R code because I have no idea + * how to do this in C code + */ +static Rboolean noChildren(SEXP children) +{ + SEXP result, fcall; + PROTECT(fcall = lang2(install("no.children"), + children)); + PROTECT(result = eval(fcall, R_gridEvalEnv)); + UNPROTECT(2); + return LOGICAL(result)[0]; +} + +static Rboolean childExists(SEXP name, SEXP children) +{ + SEXP result, fcall; + PROTECT(fcall = lang3(install("child.exists"), + name, children)); + PROTECT(result = eval(fcall, R_gridEvalEnv)); + UNPROTECT(2); + return LOGICAL(result)[0]; +} + +static SEXP childList(SEXP children) +{ + SEXP result, fcall; + PROTECT(fcall = lang2(install("child.list"), + children)); + PROTECT(result = eval(fcall, R_gridEvalEnv)); + UNPROTECT(2); + return result; +} + +/* +find.in.children <- function(name, children) { + cpvps <- ls(env=children) + ncpvp <- length(cpvps) + count <- 0 + found <- FALSE + while (count < ncpvp && !found) { + result <- find.viewport(name, get(cpvps[count+1], env=children)) + found <- result$found + count <- count + 1 + } + if (!found) + result <- list(found=FALSE, pvp=NULL) + return(result) +} +*/ +static SEXP findViewport(SEXP name, SEXP strict, SEXP vp, int depth); +static SEXP findInChildren(SEXP name, SEXP strict, SEXP children, int depth) +{ + SEXP childnames = childList(children); + int n = LENGTH(childnames); + int count = 0; + Rboolean found = FALSE; + SEXP result = R_NilValue; + PROTECT(childnames); + PROTECT(result); + while (count < n && !found) { + result = findViewport(name, strict, + PROTECT(findVar(installChar(STRING_ELT(childnames, count)), + children)), + depth); + found = INTEGER(VECTOR_ELT(result, 0))[0] > 0; + UNPROTECT(1); + count = count + 1; + } + if (!found) { + SEXP temp, zeroDepth; + PROTECT(temp = allocVector(VECSXP, 2)); + PROTECT(zeroDepth = allocVector(INTSXP, 1)); + INTEGER(zeroDepth)[0] = 0; + SET_VECTOR_ELT(temp, 0, zeroDepth); + SET_VECTOR_ELT(temp, 1, R_NilValue); + UNPROTECT(2); + result = temp; + } + UNPROTECT(2); + return result; +} + +/* +find.viewport <- function(name, pvp) { + found <- FALSE + if (length(ls(env=pvp$children)) == 0) + return(list(found=FALSE, pvp=NULL)) + else + if (exists(name, env=pvp$children, inherits=FALSE)) + return(list(found=TRUE, + pvp=get(name, env=pvp$children, inherits=FALSE))) + else + find.in.children(name, pvp$children) +} +*/ +static SEXP findViewport(SEXP name, SEXP strict, SEXP vp, int depth) +{ + SEXP result, zeroDepth, curDepth; + PROTECT(result = allocVector(VECSXP, 2)); + PROTECT(zeroDepth = allocVector(INTSXP, 1)); + INTEGER(zeroDepth)[0] = 0; + PROTECT(curDepth = allocVector(INTSXP, 1)); + INTEGER(curDepth)[0] = depth; + /* + * If there are no children, we fail + */ + if (noChildren(viewportChildren(vp))) { + SET_VECTOR_ELT(result, 0, zeroDepth); + SET_VECTOR_ELT(result, 1, R_NilValue); + } else if (childExists(name, viewportChildren(vp))) { + SET_VECTOR_ELT(result, 0, curDepth); + SET_VECTOR_ELT(result, 1, + /* + * Does this do inherits=FALSE? + */ + findVar(installChar(STRING_ELT(name, 0)), + viewportChildren(vp))); + } else { + /* + * If this is a strict match, fail + * Otherwise recurse into children + */ + if (LOGICAL(strict)[0]) { + SET_VECTOR_ELT(result, 0, zeroDepth); + SET_VECTOR_ELT(result, 1, R_NilValue); + } else { + result = findInChildren(name, strict, viewportChildren(vp), + depth + 1); + } + } + UNPROTECT(3); + return result; +} + +SEXP L_downviewport(SEXP name, SEXP strict) +{ + /* Get the current device + */ + pGEDevDesc dd = getDevice(); + /* Get the value of the current viewport for the current device + * Need to do this in here so that redrawing via R BASE display + * list works + */ + SEXP gvp = gridStateElement(dd, GSS_VP); + /* + * Try to find the named viewport + */ + SEXP found, vp; + int depth = 1; + PROTECT(found = findViewport(name, strict, gvp, depth)); + if (INTEGER(VECTOR_ELT(found, 0))[0]) { + vp = doSetViewport(VECTOR_ELT(found, 1), FALSE, FALSE, dd); + /* Set the value of the current viewport for the current device + * Need to do this in here so that redrawing via R BASE display + * list works + */ + setGridStateElement(dd, GSS_VP, vp); + UNPROTECT(1); + } else { + /* Important to have an error here, rather than back in + * R code AFTER this point. Otherwise, an unsuccessful + * downViewport() will be recorded on the engine DL! + */ + char msg[1024]; + snprintf(msg, 1024, "Viewport '%s' was not found", + CHAR(STRING_ELT(name, 0))); + UNPROTECT(1); + error(_(msg)); + } + return VECTOR_ELT(found, 0); +} + +/* + * Find a viewport PATH in the current viewport tree by name + * + * Similar to L_downviewport + */ + +static Rboolean pathMatch(SEXP path, SEXP pathsofar, SEXP strict) +{ + SEXP result, fcall; + PROTECT(fcall = lang4(install("pathMatch"), + path, pathsofar, strict)); + PROTECT(result = eval(fcall, R_gridEvalEnv)); + UNPROTECT(2); + return LOGICAL(result)[0]; +} + +static SEXP growPath(SEXP pathsofar, SEXP name) +{ + SEXP result, fcall; + if (isNull(pathsofar)) + result = name; + else { + PROTECT(fcall = lang3(install("growPath"), + pathsofar, name)); + PROTECT(result = eval(fcall, R_gridEvalEnv)); + UNPROTECT(2); + } + return result; +} + +static SEXP findvppath(SEXP path, SEXP name, SEXP strict, + SEXP pathsofar, SEXP vp, int depth); +static SEXP findvppathInChildren(SEXP path, SEXP name, + SEXP strict, SEXP pathsofar, + SEXP children, int depth) +{ + SEXP childnames = childList(children); + int n = LENGTH(childnames); + int count = 0; + Rboolean found = FALSE; + SEXP result = R_NilValue; + PROTECT(childnames); + PROTECT(result); + while (count < n && !found) { + SEXP vp, newpathsofar; + PROTECT(vp = findVar(installChar(STRING_ELT(childnames, count)), + children)); + PROTECT(newpathsofar = growPath(pathsofar, + VECTOR_ELT(vp, VP_NAME))); + result = findvppath(path, name, strict, newpathsofar, vp, depth); + found = INTEGER(VECTOR_ELT(result, 0))[0] > 0; + count = count + 1; + UNPROTECT(2); + } + if (!found) { + SEXP temp, zeroDepth; + PROTECT(temp = allocVector(VECSXP, 2)); + PROTECT(zeroDepth = allocVector(INTSXP, 1)); + INTEGER(zeroDepth)[0] = 0; + SET_VECTOR_ELT(temp, 0, zeroDepth); + SET_VECTOR_ELT(temp, 1, R_NilValue); + UNPROTECT(2); + result = temp; + } + UNPROTECT(2); + return result; +} + +static SEXP findvppath(SEXP path, SEXP name, SEXP strict, + SEXP pathsofar, SEXP vp, int depth) +{ + SEXP result, zeroDepth, curDepth; + PROTECT(result = allocVector(VECSXP, 2)); + PROTECT(zeroDepth = allocVector(INTSXP, 1)); + INTEGER(zeroDepth)[0] = 0; + PROTECT(curDepth = allocVector(INTSXP, 1)); + INTEGER(curDepth)[0] = depth; + /* + * If there are no children, we fail + */ + if (noChildren(viewportChildren(vp))) { + SET_VECTOR_ELT(result, 0, zeroDepth); + SET_VECTOR_ELT(result, 1, R_NilValue); + + } + /* + * Check for the viewport name AND whether the rest + * of the path matches (possibly strictly) + */ + else if (childExists(name, viewportChildren(vp)) && + pathMatch(path, pathsofar, strict)) { + SET_VECTOR_ELT(result, 0, curDepth); + SET_VECTOR_ELT(result, 1, + /* + * Does this do inherits=FALSE? + */ + findVar(installChar(STRING_ELT(name, 0)), + viewportChildren(vp))); + } else { + result = findvppathInChildren(path, name, strict, pathsofar, + viewportChildren(vp), depth + 1); + } + UNPROTECT(3); + return result; +} + +SEXP L_downvppath(SEXP path, SEXP name, SEXP strict) +{ + /* Get the current device + */ + pGEDevDesc dd = getDevice(); + /* Get the value of the current viewport for the current device + * Need to do this in here so that redrawing via R BASE display + * list works + */ + SEXP gvp = gridStateElement(dd, GSS_VP); + /* + * Try to find the named viewport + */ + SEXP found, vp; + int depth = 1; + PROTECT(found = findvppath(path, name, strict, R_NilValue, gvp, depth)); + if (INTEGER(VECTOR_ELT(found, 0))[0]) { + vp = doSetViewport(VECTOR_ELT(found, 1), FALSE, FALSE, dd); + /* Set the value of the current viewport for the current device + * Need to do this in here so that redrawing via R BASE display + * list works + */ + setGridStateElement(dd, GSS_VP, vp); + UNPROTECT(1); + } else { + /* Important to have an error here, rather than back in + * R code AFTER this point. Otherwise, an unsuccessful + * downViewport() will be recorded on the engine DL! + */ + char msg[1024]; + snprintf(msg, 1024, "Viewport '%s' was not found", + CHAR(STRING_ELT(name, 0))); + UNPROTECT(1); + error(_(msg)); + } + return VECTOR_ELT(found, 0); +} + +/* This is similar to L_setviewport, except that it will NOT + * recalculate the viewport transform if the device has not changed size + */ +SEXP L_unsetviewport(SEXP n) +{ + int i; + double xx1, yy1, xx2, yy2; + double devWidthCM, devHeightCM; + SEXP parentClip; + /* Get the current device + */ + pGEDevDesc dd = getDevice(); + /* Get the value of the current viewport for the current device + * Need to do this in here so that redrawing via R BASE display + * list works + */ + SEXP gvp = gridStateElement(dd, GSS_VP); + /* NOTE that the R code has already checked that .grid.viewport$parent + * is non-NULL + * + * BUT this may not be called from R code !! + * (e.g., when the graphics engine display list is replayed; + * problems can occur when grid output is mixed with base output; + * for example, plot.new() is called between a viewport push and pop) + */ + SEXP newvp = VECTOR_ELT(gvp, PVP_PARENT); + if (isNull(newvp)) + error(_("cannot pop the top-level viewport ('grid' and 'graphics' output mixed?)")); + for (i = 1; i < INTEGER(n)[0]; i++) { + gvp = newvp; + newvp = VECTOR_ELT(gvp, PVP_PARENT); + if (isNull(newvp)) + error(_("cannot pop the top-level viewport ('grid' and 'graphics' output mixed?)")); + } + /* + * Remove the child (gvp) from the parent's (newvp) "list" of + * children + */ + /* + * This has to be done via a call to R-level ... + * remove(gvp$name, envir=newvp$children, inherits=FALSE) + * ... because RemoveVariable in envir.c is not exported (why not?) + * + * I tried to model this on the example in the section + * "System and foreign language interfaces ... Evaluating R expressions" + * in the "Writing R Extensions" manual, but the compiler didn't + * like CAR(t) as an lvalue. + */ + PROTECT(gvp); PROTECT(newvp); + { + SEXP fcall, false, t; + PROTECT(false = allocVector(LGLSXP, 1)); + LOGICAL(false)[0] = FALSE; + PROTECT(fcall = lang4(install("remove"), + VECTOR_ELT(gvp, VP_NAME), + VECTOR_ELT(newvp, PVP_CHILDREN), + false)); + t = fcall; + t = CDR(CDR(t)); + SET_TAG(t, install("envir")); + t = CDR(t); + SET_TAG(t, install("inherits")); + eval(fcall, R_gridEvalEnv); + UNPROTECT(2); /* false, fcall */ + } + /* Get the current device size + */ + getDeviceSize(dd, &devWidthCM, &devHeightCM); + if (deviceChanged(devWidthCM, devHeightCM, newvp)) + calcViewportTransform(newvp, viewportParent(newvp), 1, dd); + /* + * Enforce the current viewport settings + */ + setGridStateElement(dd, GSS_GPAR, viewportgpar(newvp)); + /* Set the clipping region to the parent's cur.clip + */ + parentClip = viewportClipRect(newvp); + xx1 = REAL(parentClip)[0]; + yy1 = REAL(parentClip)[1]; + xx2 = REAL(parentClip)[2]; + yy2 = REAL(parentClip)[3]; + GESetClip(xx1, yy1, xx2, yy2, dd); + /* Set the value of the current viewport for the current device + * Need to do this in here so that redrawing via R BASE display + * list works + */ + setGridStateElement(dd, GSS_VP, newvp); + /* + * Remove the parent from the child + * This is not strictly necessary, but it is conceptually + * more complete and makes it more likely that we will + * detect incorrect code elsewhere (because it is likely to + * trigger a segfault if other code is incorrect) + * + * NOTE: Do NOT do this any earlier or you will + * remove the PROTECTive benefit of newvp pointing + * to part of the (global) grid state + */ + SET_VECTOR_ELT(gvp, PVP_PARENT, R_NilValue); + UNPROTECT(2); /* gvp, newvp */ + return R_NilValue; +} + +/* This is similar to L_unsetviewport, except that it will NOT + * modify parent-child relations + */ +SEXP L_upviewport(SEXP n) +{ + int i; + double xx1, yy1, xx2, yy2; + double devWidthCM, devHeightCM; + SEXP parentClip; + /* Get the current device + */ + pGEDevDesc dd = getDevice(); + /* Get the value of the current viewport for the current device + * Need to do this in here so that redrawing via R BASE display + * list works + */ + SEXP gvp = gridStateElement(dd, GSS_VP); + SEXP newvp = VECTOR_ELT(gvp, PVP_PARENT); + if (isNull(newvp)) + error(_("cannot pop the top-level viewport ('grid' and 'graphics' output mixed?)")); + for (i = 1; i < INTEGER(n)[0]; i++) { + gvp = newvp; + newvp = VECTOR_ELT(gvp, PVP_PARENT); + if (isNull(newvp)) + error(_("cannot pop the top-level viewport ('grid' and 'graphics' output mixed?)")); + } + /* Get the current device size + */ + getDeviceSize(dd, &devWidthCM, &devHeightCM); + if (deviceChanged(devWidthCM, devHeightCM, newvp)) + calcViewportTransform(newvp, viewportParent(newvp), 1, dd); + /* + * Enforce the current viewport settings + */ + setGridStateElement(dd, GSS_GPAR, viewportgpar(newvp)); + /* Set the clipping region to the parent's cur.clip + */ + parentClip = viewportClipRect(newvp); + xx1 = REAL(parentClip)[0]; + yy1 = REAL(parentClip)[1]; + xx2 = REAL(parentClip)[2]; + yy2 = REAL(parentClip)[3]; + GESetClip(xx1, yy1, xx2, yy2, dd); +#if 0 + /* This is a VERY short term fix to avoid mucking + * with the core graphics during feature freeze + * It should be removed post R 1.4 release + */ + dd->dev->clipLeft = fmin2(xx1, xx2); + dd->dev->clipRight = fmax2(xx1, xx2); + dd->dev->clipTop = fmax2(yy1, yy2); + dd->dev->clipBottom = fmin2(yy1, yy2); +#endif + /* Set the value of the current viewport for the current device + * Need to do this in here so that redrawing via R BASE display + * list works + */ + setGridStateElement(dd, GSS_VP, newvp); + return R_NilValue; +} + +SEXP L_getDisplayList() +{ + /* Get the current device + */ + pGEDevDesc dd = getDevice(); + return gridStateElement(dd, GSS_DL); +} + +SEXP L_setDisplayList(SEXP dl) +{ + /* Get the current device + */ + pGEDevDesc dd = getDevice(); + setGridStateElement(dd, GSS_DL, dl); + return R_NilValue; +} + +/* + * Get the element at index on the DL + */ +SEXP L_getDLelt(SEXP index) +{ + /* Get the current device + */ + pGEDevDesc dd = getDevice(); + SEXP dl, result; + PROTECT(dl = gridStateElement(dd, GSS_DL)); + result = VECTOR_ELT(dl, INTEGER(index)[0]); + UNPROTECT(1); + return result; +} + +/* Add an element to the display list at the current location + * Location is maintained in R code + */ +SEXP L_setDLelt(SEXP value) +{ + /* Get the current device + */ + pGEDevDesc dd = getDevice(); + SEXP dl; + PROTECT(dl = gridStateElement(dd, GSS_DL)); + SET_VECTOR_ELT(dl, INTEGER(gridStateElement(dd, GSS_DLINDEX))[0], value); + UNPROTECT(1); + return R_NilValue; +} + +SEXP L_getDLindex() +{ + /* Get the current device + */ + pGEDevDesc dd = getDevice(); + return gridStateElement(dd, GSS_DLINDEX); +} + +SEXP L_setDLindex(SEXP index) +{ + /* Get the current device + */ + pGEDevDesc dd = getDevice(); + setGridStateElement(dd, GSS_DLINDEX, index); + return R_NilValue; +} + +SEXP L_getDLon() +{ + /* Get the current device + */ + pGEDevDesc dd = getDevice(); + return gridStateElement(dd, GSS_DLON); +} + +SEXP L_setDLon(SEXP value) +{ + /* Get the current device + */ + pGEDevDesc dd = getDevice(); + SEXP prev; + prev = gridStateElement(dd, GSS_DLON); + setGridStateElement(dd, GSS_DLON, value); + return prev; +} + +SEXP L_getEngineDLon() +{ + /* Get the current device + */ + pGEDevDesc dd = getDevice(); + return gridStateElement(dd, GSS_ENGINEDLON); +} + +SEXP L_setEngineDLon(SEXP value) +{ + /* Get the current device + */ + pGEDevDesc dd = getDevice(); + setGridStateElement(dd, GSS_ENGINEDLON, value); + return R_NilValue; +} + +SEXP L_getCurrentGrob() +{ + pGEDevDesc dd = getDevice(); + return gridStateElement(dd, GSS_CURRGROB); +} + +SEXP L_setCurrentGrob(SEXP value) +{ + pGEDevDesc dd = getDevice(); + setGridStateElement(dd, GSS_CURRGROB, value); + return R_NilValue; +} + +SEXP L_getEngineRecording() +{ + pGEDevDesc dd = getDevice(); + return gridStateElement(dd, GSS_ENGINERECORDING); +} + +SEXP L_setEngineRecording(SEXP value) +{ + pGEDevDesc dd = getDevice(); + setGridStateElement(dd, GSS_ENGINERECORDING, value); + return R_NilValue; +} + +SEXP L_currentGPar() +{ + /* Get the current device + */ + pGEDevDesc dd = getDevice(); + return gridStateElement(dd, GSS_GPAR); +} + +SEXP L_newpagerecording() +{ + pGEDevDesc dd = getDevice(); + if (dd->ask) { + NewFrameConfirm(dd->dev); + /* + * User may have killed device during pause for prompt + */ + if (NoDevices()) + error(_("attempt to plot on null device")); + else + /* + * Should throw an error if dd != GECurrentDevice ? + */ + dd = GEcurrentDevice(); + } + GEinitDisplayList(dd); + return R_NilValue; +} + +SEXP L_newpage() +{ + pGEDevDesc dd = getDevice(); + R_GE_gcontext gc; + /* + * Has the device been drawn on yet? + */ + Rboolean deviceDirty = GEdeviceDirty(dd); + /* + * Has the device been drawn on BY GRID yet? + */ + Rboolean deviceGridDirty = LOGICAL(gridStateElement(dd, + GSS_GRIDDEVICE))[0]; + /* + * Initialise grid on device + * If no drawing on device yet, does a new page + */ + if (!deviceGridDirty) { + dirtyGridDevice(dd); + } + /* + * If device has previously been drawn on (by grid or other system) + * do a new page + */ + if (deviceGridDirty || deviceDirty) { + SEXP currentgp = gridStateElement(dd, GSS_GPAR); + gcontextFromgpar(currentgp, 0, &gc, dd); + GENewPage(&gc, dd); + } + return R_NilValue; +} + +SEXP L_initGPar() +{ + pGEDevDesc dd = getDevice(); + initGPar(dd); + return R_NilValue; +} + +SEXP L_initViewportStack() +{ + pGEDevDesc dd = getDevice(); + initVP(dd); + return R_NilValue; +} + +SEXP L_initDisplayList() +{ + pGEDevDesc dd = getDevice(); + initDL(dd); + return R_NilValue; +} + +void getViewportTransform(SEXP currentvp, + pGEDevDesc dd, + double *vpWidthCM, double *vpHeightCM, + LTransform transform, double *rotationAngle) +{ + int i, j; + double devWidthCM, devHeightCM; + getDeviceSize((dd), &devWidthCM, &devHeightCM) ; + if (deviceChanged(devWidthCM, devHeightCM, currentvp)) { + /* IF the device has changed, recalculate the viewport transform + */ + calcViewportTransform(currentvp, viewportParent(currentvp), 1, dd); + } + for (i=0; i<3; i++) + for (j=0; j<3; j++) + transform[i][j] = + REAL(viewportTransform(currentvp))[i + 3*j]; + *rotationAngle = REAL(viewportRotation(currentvp))[0]; + *vpWidthCM = REAL(viewportWidthCM(currentvp))[0]; + *vpHeightCM = REAL(viewportHeightCM(currentvp))[0]; +} + + +/*************************** + * CONVERSION FUNCTIONS + *************************** + */ + +/* + * WITHIN THE CURRENT VIEWPORT ... + * + * Given a unit object and whether it is a location/dimension, + * convert to location/dimension in unit B + * + * NOTE: When this is used to convert a mouse click on a device to + * a location/dimension, the conversion of the mouse click to + * a unit within the current viewport has to be done elsewhere. + * e.g., in interactive.R, this is done by applying the inverse + * of the current viewport transformation to get a location in + * inches within the current viewport. + * + * This should ideally create a unit object to ensure that the + * values it returns are treated as values in the correct + * coordinate system. For now, this is MUCH easier to do in + * R code, so it is the responsibility of the R code calling this + * to create the unit object correctly/honestly. + * + * NOTE also that the unitto supplied should be a "valid" integer + * (the best way to get that is to use the valid.units() + * function in unit.R) + * + * what = 0 means x, 1 means y, 2 means width, 3 means height + */ +SEXP L_convert(SEXP x, SEXP whatfrom, + SEXP whatto, SEXP unitto) { + int i, nx; + SEXP answer; + double vpWidthCM, vpHeightCM; + double rotationAngle; + LViewportContext vpc; + R_GE_gcontext gc; + LTransform transform; + SEXP currentvp, currentgp; + int TOunit, FROMaxis, TOaxis; + Rboolean relConvert; + /* + * Get the current device + */ + pGEDevDesc dd = getDevice(); + currentvp = gridStateElement(dd, GSS_VP); + currentgp = gridStateElement(dd, GSS_GPAR); + /* + * We do not need the current transformation, but + * we need the side effects of calculating it in + * case the device has been resized (or only just created) + */ + getViewportTransform(currentvp, dd, + &vpWidthCM, &vpHeightCM, + transform, &rotationAngle); + getViewportContext(currentvp, &vpc); + nx = unitLength(x); + PROTECT(answer = allocVector(REALSXP, nx)); + for (i=0; i<nx; i++) { + gcontextFromgpar(currentgp, i, &gc, dd); + TOunit = INTEGER(unitto)[i % LENGTH(unitto)]; + FROMaxis = INTEGER(whatfrom)[0]; + TOaxis = INTEGER(whatto)[0]; + /* + * Special case: FROM unit is just a plain, relative unit AND + * TO unit is relative AND + * NOT converting from 'x' to 'y' (or vice versa) ... + * + * ... AND relevant widthCM or heightCM is zero + * + * In these cases do NOT transform thru INCHES + * (to avoid divide-by-zero, but still do something useful) + */ + relConvert = (!isUnitArithmetic(x) && !isUnitList(x) && + (unitUnit(x, i) == L_NATIVE || unitUnit(x, i) == L_NPC) && + (TOunit == L_NATIVE || TOunit == L_NPC) && + ((FROMaxis == TOaxis) || + (FROMaxis == 0 && TOaxis == 2) || + (FROMaxis == 2 && TOaxis == 0) || + (FROMaxis == 1 && TOaxis == 3) || + (FROMaxis == 3 && TOaxis == 1))); + /* + * First, convert the unit object passed in to a value in INCHES + * (within the current viewport) + */ + switch (FROMaxis) { + case 0: + if (relConvert && vpWidthCM < 1e-6) { + REAL(answer)[i] = + transformXYtoNPC(unitValue(x, i), unitUnit(x, i), + vpc.xscalemin, vpc.xscalemax); + } else { + relConvert = FALSE; + REAL(answer)[i] = + transformXtoINCHES(x, i, vpc, &gc, + vpWidthCM, vpHeightCM, + dd); + } + break; + case 1: + if (relConvert && vpHeightCM < 1e-6) { + REAL(answer)[i] = + transformXYtoNPC(unitValue(x, i), unitUnit(x, i), + vpc.yscalemin, vpc.yscalemax); + } else { + relConvert = FALSE; + REAL(answer)[i] = + transformYtoINCHES(x, i, vpc, &gc, + vpWidthCM, vpHeightCM, + dd); + } + break; + case 2: + if (relConvert && vpWidthCM < 1e-6) { + REAL(answer)[i] = + transformWHtoNPC(unitValue(x, i), unitUnit(x, i), + vpc.xscalemin, vpc.xscalemax); + } else { + relConvert = FALSE; + REAL(answer)[i] = + transformWidthtoINCHES(x, i, vpc, &gc, + vpWidthCM, vpHeightCM, + dd); + } + break; + case 3: + if (relConvert && vpHeightCM < 1e-6) { + REAL(answer)[i] = + transformWHtoNPC(unitValue(x, i), unitUnit(x, i), + vpc.yscalemin, vpc.yscalemax); + } else { + relConvert = FALSE; + REAL(answer)[i] = + transformHeighttoINCHES(x, i, vpc, &gc, + vpWidthCM, vpHeightCM, + dd); + } + break; + } + /* + * Now, convert the values in INCHES to a value in the specified + * coordinate system + * (within the current viewport) + * + * BUT do NOT do this step for the special "relConvert" case + */ + switch (TOaxis) { + case 0: + if (relConvert) { + REAL(answer)[i] = transformXYfromNPC(REAL(answer)[i], TOunit, + vpc.xscalemin, + vpc.xscalemax); + } else { + REAL(answer)[i] = + transformXYFromINCHES(REAL(answer)[i], TOunit, + vpc.xscalemin, + vpc.xscalemax, + &gc, + vpWidthCM, vpHeightCM, + dd); + } + break; + case 1: + if (relConvert) { + REAL(answer)[i] = transformXYfromNPC(REAL(answer)[i], TOunit, + vpc.yscalemin, + vpc.yscalemax); + } else { + REAL(answer)[i] = + transformXYFromINCHES(REAL(answer)[i], TOunit, + vpc.yscalemin, + vpc.yscalemax, + &gc, + vpHeightCM, vpWidthCM, + dd); + } + break; + case 2: + if (relConvert) { + REAL(answer)[i] = transformWHfromNPC(REAL(answer)[i], TOunit, + vpc.xscalemin, + vpc.xscalemax); + } else { + REAL(answer)[i] = + transformWidthHeightFromINCHES(REAL(answer)[i], TOunit, + vpc.xscalemin, + vpc.xscalemax, + &gc, + vpWidthCM, vpHeightCM, + dd); + } + break; + case 3: + if (relConvert) { + REAL(answer)[i] = transformWHfromNPC(REAL(answer)[i], TOunit, + vpc.yscalemin, + vpc.yscalemax); + } else { + REAL(answer)[i] = + transformWidthHeightFromINCHES(REAL(answer)[i], TOunit, + vpc.yscalemin, + vpc.yscalemax, + &gc, + vpHeightCM, vpWidthCM, + dd); + break; + } + } + } + UNPROTECT(1); + return answer; +} + +/* + * Given a layout.pos.row and a layout.pos.col, calculate + * the region allocated by the layout of the current viewport + * + * Not a conversion as such, but similarly vulnerable to device resizing + */ +SEXP L_layoutRegion(SEXP layoutPosRow, SEXP layoutPosCol) { + LViewportLocation vpl; + SEXP answer; + double vpWidthCM, vpHeightCM; + double rotationAngle; + LTransform transform; + SEXP currentvp; + /* + * Get the current device + */ + pGEDevDesc dd = getDevice(); + currentvp = gridStateElement(dd, GSS_VP); + //currentgp = gridStateElement(dd, GSS_GPAR); + /* + * We do not need the current transformation, but + * we need the side effects of calculating it in + * case the device has been resized (or only just created) + */ + getViewportTransform(currentvp, dd, + &vpWidthCM, &vpHeightCM, + transform, &rotationAngle); + /* + * Only proceed if there is a layout currently defined + */ + if (isNull(viewportLayout(currentvp))) + error(_("there is no layout defined")); + /* + * The result is a numeric containing left, bottom, width, and height + */ + PROTECT(answer = allocVector(REALSXP, 4)); + /* + * NOTE: We are assuming here that calcViewportLocationFromLayout + * returns the allocated region with a ("left", "bottom") + * justification. This is CURRENTLY true, but ... + */ + calcViewportLocationFromLayout(layoutPosRow, + layoutPosCol, + currentvp, + &vpl); + /* + * I am not returning the units created in C code + * because they do not have the units attribute set + * so they do not behave nicely back in R code. + * Instead, I take the values and my knowledge that they + * are NPC units and construct real unit objects back in + * R code. + */ + REAL(answer)[0] = unitValue(vpl.x, 0); + REAL(answer)[1] = unitValue(vpl.y, 0); + REAL(answer)[2] = unitValue(vpl.width, 0); + REAL(answer)[3] = unitValue(vpl.height, 0); + UNPROTECT(1); + return answer; +} + +/*************************** + * EDGE DETECTION + *************************** + */ + +/* + * Calculate the point on the edge of a rectangle at angle theta + * 0 = East, 180 = West, etc ... + * Assumes that x- and y-values are in INCHES + * Assumes that theta is within [0, 360) + */ +static void rectEdge(double xmin, double ymin, double xmax, double ymax, + double theta, + double *edgex, double *edgey) +{ + double xm = (xmin + xmax)/2; + double ym = (ymin + ymax)/2; + double dx = (xmax - xmin)/2; + double dy = (ymax - ymin)/2; + /* + * FIXME: Special case 0 width or 0 height + */ + /* + * Special case angles + */ + if (theta == 0) { + *edgex = xmax; + *edgey = ym; + } else if (theta == 270) { + *edgex = xm; + *edgey = ymin; + } else if (theta == 180) { + *edgex = xmin; + *edgey = ym; + } else if (theta == 90) { + *edgex = xm; + *edgey = ymax; + } else { + double cutoff = dy/dx; + double angle = theta/180*M_PI; + double tanTheta = tan(angle); + double cosTheta = cos(angle); + double sinTheta = sin(angle); + if (fabs(tanTheta) < cutoff) { /* Intersect with side */ + if (cosTheta > 0) { /* Right side */ + *edgex = xmax; + *edgey = ym + tanTheta*dx; + } else { /* Left side */ + *edgex = xmin; + *edgey = ym - tanTheta*dx; + } + } else { /* Intersect with top/bottom */ + if (sinTheta > 0) { /* Top */ + *edgey = ymax; + *edgex = xm + dy/tanTheta; + } else { /* Bottom */ + *edgey = ymin; + *edgex = xm - dy/tanTheta; + } + } + } +} + +/* + * Calculate the point on the edge of a rectangle at angle theta + * 0 = East, 180 = West, etc ... + * Assumes that x- and y-values are in INCHES + * Assumes that theta is within [0, 360) + */ +static void circleEdge(double x, double y, double r, + double theta, + double *edgex, double *edgey) +{ + double angle = theta/180*M_PI; + *edgex = x + r*cos(angle); + *edgey = y + r*sin(angle); +} + +/* + * Calculate the point on the edge of a *convex* polygon at angle theta + * 0 = East, 180 = West, etc ... + * Assumes that x- and y-values are in INCHES + * Assumes that vertices are in clock-wise order + * Assumes that theta is within [0, 360) + */ +static void polygonEdge(double *x, double *y, int n, + double theta, + double *edgex, double *edgey) { + int i, v1, v2; + double xm, ym; + double xmin = DOUBLE_XMAX; + double xmax = -DOUBLE_XMAX; + double ymin = DOUBLE_XMAX; + double ymax = -DOUBLE_XMAX; + int found = 0; + double angle = theta/180*M_PI; + double vangle1, vangle2; + /* + * Find "centre" of polygon + */ + for (i=0; i<n; i++) { + if (x[i] < xmin) + xmin = x[i]; + if (x[i] > xmax) + xmax = x[i]; + if (y[i] < ymin) + ymin = y[i]; + if (y[i] > ymax) + ymax = y[i]; + } + xm = (xmin + xmax)/2; + ym = (ymin + ymax)/2; + /* + * Special case zero-width or zero-height + */ + if (fabs(xmin - xmax) < 1e-6) { + *edgex = xmin; + if (theta == 90) + *edgey = ymax; + else if (theta == 270) + *edgey = ymin; + else + *edgey = ym; + return; + } + if (fabs(ymin - ymax) < 1e-6) { + *edgey = ymin; + if (theta == 0) + *edgex = xmax; + else if (theta == 180) + *edgex = xmin; + else + *edgex = xm; + return; + } + /* + * Find edge that intersects line from centre at angle theta + */ + for (i=0; i<n; i++) { + v1 = i; + v2 = v1 + 1; + if (v2 == n) + v2 = 0; + /* + * Result of atan2 is in range -PI, PI so convert to + * 0, 360 to correspond to angle + */ + vangle1 = atan2(y[v1] - ym, x[v1] - xm); + if (vangle1 < 0) + vangle1 = vangle1 + 2*M_PI; + vangle2 = atan2(y[v2] - ym, x[v2] - xm); + if (vangle2 < 0) + vangle2 = vangle2 + 2*M_PI; + /* + * If vangle1 < vangle2 then angles are either side of 0 + * so check is more complicated + */ + if ((vangle1 >= vangle2 && + vangle1 >= angle && vangle2 < angle) || + (vangle1 < vangle2 && + ((vangle1 >= angle && 0 <= angle) || + (vangle2 < angle && 2*M_PI >= angle)))) { + found = 1; + break; + } + } + /* + * Find intersection point of "line from centre to bounding rect" + * and edge + */ + if (found) { + double x1 = xm; + double y1 = ym; + double x2, y2; + double x3 = x[v1]; + double y3 = y[v1]; + double x4 = x[v2]; + double y4 = y[v2]; + double numa, denom, ua; + rectEdge(xmin, ymin, xmax, ymax, theta, + &x2, &y2); + numa = ((x4 - x3)*(y1 - y3) - (y4 - y3)*(x1 - x3)); + denom = ((y4 - y3)*(x2 - x1) - (x4 - x3)*(y2 - y1)); + ua = numa/denom; + if (!R_FINITE(ua)) { + /* + * Should only happen if lines are parallel, which + * shouldn't happen! Unless, perhaps the polygon has + * zero extent vertically or horizontally ... ? + */ + error(_("polygon edge not found (zero-width or zero-height?)")); + } + /* + * numb = ((x2 - x1)*(y1 - y3) - (y2 - y1)*(x1 - x3)); + * ub = numb/denom; + */ + *edgex = x1 + ua*(x2 - x1); + *edgey = y1 + ua*(y2 - y1); + } else { + error(_("polygon edge not found")); + } +} + +/* + * Given a set of points, calculate the convex hull then + * find the edge of that hull + * + * NOTE: assumes that 'grDevices' package has been loaded + * so that chull() is available (grid depends on grDevices) + */ +static void hullEdge(double *x, double *y, int n, + double theta, + double *edgex, double *edgey) +{ + const void *vmax; + int i, nh; + double *hx, *hy; + SEXP xin, yin, chullFn, R_fcall, hull; + int adjust = 0; + double *xkeep, *ykeep; + vmax = vmaxget(); + /* Remove any NA's because chull() can't cope with them */ + xkeep = (double *) R_alloc(n, sizeof(double)); + ykeep = (double *) R_alloc(n, sizeof(double)); + for (i=0; i<n; i++) { + if (!R_FINITE(x[i]) || !R_FINITE(y[i])) { + adjust--; + } else { + xkeep[i + adjust] = x[i]; + ykeep[i + adjust] = y[i]; + } + } + n = n + adjust; + PROTECT(xin = allocVector(REALSXP, n)); + PROTECT(yin = allocVector(REALSXP, n)); + for (i=0; i<n; i++) { + REAL(xin)[i] = xkeep[i]; + REAL(yin)[i] = ykeep[i]; + } + /* + * Determine convex hull + */ + PROTECT(chullFn = findFun(install("chull"), R_gridEvalEnv)); + PROTECT(R_fcall = lang3(chullFn, xin, yin)); + PROTECT(hull = eval(R_fcall, R_gridEvalEnv)); + nh = LENGTH(hull); + hx = (double *) R_alloc(nh, sizeof(double)); + hy = (double *) R_alloc(nh, sizeof(double)); + for (i=0; i<nh; i++) { + hx[i] = x[INTEGER(hull)[i] - 1]; + hy[i] = y[INTEGER(hull)[i] - 1]; + } + /* + * Find edge of that hull + */ + polygonEdge(hx, hy, nh, theta, + edgex, edgey); + vmaxset(vmax); + UNPROTECT(5); +} + +/*************************** + * DRAWING PRIMITIVES + *************************** + */ + +/* + * Draw an arrow head, given the vertices of the arrow head. + * Assume vertices are in DEVICE coordinates. + */ +static void drawArrow(double *x, double *y, SEXP type, int i, + const pGEcontext gc, pGEDevDesc dd) +{ + int nt = LENGTH(type); + switch (INTEGER(type)[i % nt]) { + case 1: + GEPolyline(3, x, y, gc, dd); + break; + case 2: + GEPolygon(3, x, y, gc, dd); + break; + } +} + +/* + * Calculate vertices for drawing an arrow head. + * Assumes that x and y locations are in INCHES. + * Returns vertices in DEVICE coordinates. + */ +static void calcArrow(double x1, double y1, + double x2, double y2, + SEXP angle, SEXP length, int i, + LViewportContext vpc, + double vpWidthCM, double vpHeightCM, + double *vertx, double *verty, + const pGEcontext gc, pGEDevDesc dd) +{ + int na = LENGTH(angle); + int nl = LENGTH(length); + double xc, yc, rot; + double l1, l2, l, a; + l1 = transformWidthtoINCHES(length, i % nl, vpc, gc, + vpWidthCM, vpHeightCM, + dd); + l2 = transformHeighttoINCHES(length, i % nl, vpc, gc, + vpWidthCM, vpHeightCM, + dd); + l = fmin2(l1, l2); + a = DEG2RAD * REAL(angle)[i % na]; + xc = x2 - x1; + yc = y2 - y1; + rot= atan2(yc, xc); + vertx[0] = toDeviceX(x1 + l * cos(rot+a), + GE_INCHES, dd); + verty[0] = toDeviceY(y1 + l * sin(rot+a), + GE_INCHES, dd); + vertx[1] = toDeviceX(x1, + GE_INCHES, dd); + verty[1] = toDeviceY(y1, + GE_INCHES, dd); + vertx[2] = toDeviceX(x1 + l * cos(rot-a), + GE_INCHES, dd); + verty[2] = toDeviceY(y1 + l * sin(rot-a), + GE_INCHES, dd); +} + +/* + * Assumes x and y are at least length 2 + * Also assumes x and y are in DEVICE coordinates + */ +static void arrows(double *x, double *y, int n, + SEXP arrow, int i, + /* + * Which ends we are allowed to draw arrow heads on + * (we may be drawing a line segment that has been + * broken by NAs) + */ + Rboolean start, Rboolean end, + LViewportContext vpc, + double vpWidthCM, double vpHeightCM, + const pGEcontext gc, pGEDevDesc dd) +{ + /* + * Write a checkArrow() function to make + * sure 'a' is a valid arrow description ? + * If someone manages to sneak in a + * corrupt arrow description ... BOOM! + */ + SEXP ends = VECTOR_ELT(arrow, GRID_ARROWENDS); + int ne = LENGTH(ends); + double vertx[3], verty[3]; + Rboolean first, last; + if (n < 2) + error(_("require at least two points to draw arrow")); + first = TRUE; + last = TRUE; + switch (INTEGER(ends)[i % ne]) { + case 2: + first = FALSE; + break; + case 1: + last = FALSE; + break; + } + if (first && start) { + calcArrow(fromDeviceX(x[0], GE_INCHES, dd), + fromDeviceY(y[0], GE_INCHES, dd), + fromDeviceX(x[1], GE_INCHES, dd), + fromDeviceY(y[1], GE_INCHES, dd), + VECTOR_ELT(arrow, GRID_ARROWANGLE), + VECTOR_ELT(arrow, GRID_ARROWLENGTH), + i, vpc, vpWidthCM, vpHeightCM, vertx, verty, gc, dd); + drawArrow(vertx, verty, + VECTOR_ELT(arrow, GRID_ARROWTYPE), i, + gc, dd); + } + if (last && end) { + calcArrow(fromDeviceX(x[n - 1], GE_INCHES, dd), + fromDeviceY(y[n - 1], GE_INCHES, dd), + fromDeviceX(x[n - 2], GE_INCHES, dd), + fromDeviceY(y[n - 2], GE_INCHES, dd), + VECTOR_ELT(arrow, GRID_ARROWANGLE), + VECTOR_ELT(arrow, GRID_ARROWLENGTH), + i, vpc, vpWidthCM, vpHeightCM, vertx, verty, gc, dd); + drawArrow(vertx, verty, + VECTOR_ELT(arrow, GRID_ARROWTYPE), i, + gc, dd); + } +} + +SEXP L_moveTo(SEXP x, SEXP y) +{ + double xx, yy; + double vpWidthCM, vpHeightCM; + double rotationAngle; + LViewportContext vpc; + R_GE_gcontext gc; + LTransform transform; + SEXP devloc, prevloc; + SEXP currentvp, currentgp; + /* Get the current device + */ + pGEDevDesc dd = getDevice(); + currentvp = gridStateElement(dd, GSS_VP); + currentgp = gridStateElement(dd, GSS_GPAR); + PROTECT(prevloc = gridStateElement(dd, GSS_PREVLOC)); + PROTECT(devloc = gridStateElement(dd, GSS_CURRLOC)); + getViewportTransform(currentvp, dd, + &vpWidthCM, &vpHeightCM, + transform, &rotationAngle); + getViewportContext(currentvp, &vpc); + gcontextFromgpar(currentgp, 0, &gc, dd); + /* Convert the x and y values to CM locations */ + transformLocn(x, y, 0, vpc, &gc, + vpWidthCM, vpHeightCM, + dd, + transform, + &xx, &yy); + /* + * Non-finite values are ok here + * L_lineTo figures out what to draw + * when values are non-finite + */ + REAL(prevloc)[0] = REAL(devloc)[0]; + REAL(prevloc)[1] = REAL(devloc)[1]; + REAL(devloc)[0] = xx; + REAL(devloc)[1] = yy; + UNPROTECT(2); + return R_NilValue; +} + +SEXP L_lineTo(SEXP x, SEXP y, SEXP arrow) +{ + double xx0, yy0, xx1, yy1; + double xx, yy; + double vpWidthCM, vpHeightCM; + double rotationAngle; + LViewportContext vpc; + R_GE_gcontext gc; + LTransform transform; + SEXP devloc, prevloc; + SEXP currentvp, currentgp; + /* Get the current device + */ + pGEDevDesc dd = getDevice(); + currentvp = gridStateElement(dd, GSS_VP); + currentgp = gridStateElement(dd, GSS_GPAR); + PROTECT(prevloc = gridStateElement(dd, GSS_PREVLOC)); + PROTECT(devloc = gridStateElement(dd, GSS_CURRLOC)); + getViewportTransform(currentvp, dd, + &vpWidthCM, &vpHeightCM, + transform, &rotationAngle); + getViewportContext(currentvp, &vpc); + gcontextFromgpar(currentgp, 0, &gc, dd); + /* Convert the x and y values to CM locations */ + transformLocn(x, y, 0, vpc, &gc, + vpWidthCM, vpHeightCM, + dd, + transform, + &xx, &yy); + REAL(prevloc)[0] = REAL(devloc)[0]; + REAL(prevloc)[1] = REAL(devloc)[1]; + REAL(devloc)[0] = xx; + REAL(devloc)[1] = yy; + /* The graphics engine only takes device coordinates + */ + xx0 = toDeviceX(REAL(prevloc)[0], GE_INCHES, dd); + yy0 = toDeviceY(REAL(prevloc)[1], GE_INCHES, dd), + xx1 = toDeviceX(xx, GE_INCHES, dd); + yy1 = toDeviceY(yy, GE_INCHES, dd); + if (R_FINITE(xx0) && R_FINITE(yy0) && + R_FINITE(xx1) && R_FINITE(yy1)) { + GEMode(1, dd); + GELine(xx0, yy0, xx1, yy1, &gc, dd); + if (!isNull(arrow)) { + double ax[2], ay[2]; + ax[0] = xx0; + ax[1] = xx1; + ay[0] = yy0; + ay[1] = yy1; + arrows(ax, ay, 2, + arrow, 0, TRUE, TRUE, + vpc, vpWidthCM, vpHeightCM, &gc, dd); + } + GEMode(0, dd); + } + UNPROTECT(2); + return R_NilValue; +} + +/* We are assuming here that the R code has checked that x and y + * are unit objects and that vp is a viewport + */ +SEXP L_lines(SEXP x, SEXP y, SEXP index, SEXP arrow) +{ + int i, j, nx, nl, start=0; + double *xx, *yy; + double xold, yold; + double vpWidthCM, vpHeightCM; + double rotationAngle; + const void *vmax; + LViewportContext vpc; + R_GE_gcontext gc; + LTransform transform; + SEXP currentvp, currentgp; + /* Get the current device + */ + pGEDevDesc dd = getDevice(); + currentvp = gridStateElement(dd, GSS_VP); + currentgp = gridStateElement(dd, GSS_GPAR); + getViewportTransform(currentvp, dd, + &vpWidthCM, &vpHeightCM, + transform, &rotationAngle); + getViewportContext(currentvp, &vpc); + GEMode(1, dd); + /* + * Number of lines + */ + nl = LENGTH(index); + for (j=0; j<nl; j++) { + SEXP indices = VECTOR_ELT(index, j); + gcontextFromgpar(currentgp, j, &gc, dd); + /* + * Number of vertices + * + * x and y same length forced in R code + */ + nx = LENGTH(indices); + /* Convert the x and y values to CM locations */ + vmax = vmaxget(); + xx = (double *) R_alloc(nx, sizeof(double)); + yy = (double *) R_alloc(nx, sizeof(double)); + xold = NA_REAL; + yold = NA_REAL; + for (i=0; i<nx; i++) { + transformLocn(x, y, INTEGER(indices)[i] - 1, vpc, &gc, + vpWidthCM, vpHeightCM, + dd, + transform, + &(xx[i]), &(yy[i])); + /* The graphics engine only takes device coordinates + */ + xx[i] = toDeviceX(xx[i], GE_INCHES, dd); + yy[i] = toDeviceY(yy[i], GE_INCHES, dd); + if ((R_FINITE(xx[i]) && R_FINITE(yy[i])) && + !(R_FINITE(xold) && R_FINITE(yold))) + start = i; + else if ((R_FINITE(xold) && R_FINITE(yold)) && + !(R_FINITE(xx[i]) && R_FINITE(yy[i]))) { + if (i-start > 1) { + GEPolyline(i-start, xx+start, yy+start, &gc, dd); + if (!isNull(arrow)) { + /* + * Can draw an arrow at the start if the points + * include the first point. + * CANNOT draw an arrow at the end point + * because we have just broken the line for an NA. + */ + arrows(xx+start, yy+start, i-start, + arrow, j, start == 0, FALSE, + vpc, vpWidthCM, vpHeightCM, &gc, dd); + } + } + } + else if ((R_FINITE(xold) && R_FINITE(yold)) && + (i == nx-1)) { + GEPolyline(nx-start, xx+start, yy+start, &gc, dd); + if (!isNull(arrow)) { + /* + * Can draw an arrow at the start if the points + * include the first point. + * Can draw an arrow at the end point. + */ + arrows(xx+start, yy+start, nx-start, + arrow, j, start == 0, TRUE, + vpc, vpWidthCM, vpHeightCM, &gc, dd); + } + } + xold = xx[i]; + yold = yy[i]; + } + vmaxset(vmax); + } + GEMode(0, dd); + return R_NilValue; +} + +/* We are assuming here that the R code has checked that x and y + * are unit objects + */ +SEXP gridXspline(SEXP x, SEXP y, SEXP s, SEXP o, SEXP a, SEXP rep, SEXP index, + double theta, Rboolean draw, Rboolean trace) +{ + int i, j, nx, np, nloc; + double *xx, *yy, *ss; + double vpWidthCM, vpHeightCM; + double rotationAngle; + LViewportContext vpc; + R_GE_gcontext gc; + LTransform transform; + SEXP currentvp, currentgp; + SEXP tracePts = R_NilValue; + SEXP result = R_NilValue; + double edgex, edgey; + double xmin = DOUBLE_XMAX; + double xmax = -DOUBLE_XMAX; + double ymin = DOUBLE_XMAX; + double ymax = -DOUBLE_XMAX; + /* Get the current device + */ + pGEDevDesc dd = getDevice(); + currentvp = gridStateElement(dd, GSS_VP); + currentgp = gridStateElement(dd, GSS_GPAR); + getViewportTransform(currentvp, dd, + &vpWidthCM, &vpHeightCM, + transform, &rotationAngle); + getViewportContext(currentvp, &vpc); + gcontextFromgpar(currentgp, 0, &gc, dd); + /* + * Number of xsplines + */ + np = LENGTH(index); + PROTECT(tracePts = allocVector(VECSXP, np)); + nloc = 0; + for (i=0; i<np; i++) { + const void *vmax; + SEXP indices = VECTOR_ELT(index, i); + SEXP points; + gcontextFromgpar(currentgp, i, &gc, dd); + /* + * Number of vertices + * + * Check in R code that x and y same length + */ + nx = LENGTH(indices); + /* Convert the x and y values to CM locations */ + vmax = vmaxget(); + if (draw) + GEMode(1, dd); + xx = (double *) R_alloc(nx, sizeof(double)); + yy = (double *) R_alloc(nx, sizeof(double)); + ss = (double *) R_alloc(nx, sizeof(double)); + for (j=0; j<nx; j++) { + ss[j] = REAL(s)[(INTEGER(indices)[j] - 1) % LENGTH(s)]; + /* + * If drawing, convert to INCHES on device + * If just calculating bounds, convert to INCHES within current vp + */ + if (draw) { + transformLocn(x, y, INTEGER(indices)[j] - 1, vpc, &gc, + vpWidthCM, vpHeightCM, + dd, + transform, + &(xx[j]), &(yy[j])); + } else { + xx[j] = transformXtoINCHES(x, INTEGER(indices)[j] - 1, + vpc, &gc, + vpWidthCM, vpHeightCM, + dd); + yy[j] = transformYtoINCHES(y, INTEGER(indices)[j] - 1, + vpc, &gc, + vpWidthCM, vpHeightCM, + dd); + } + /* The graphics engine only takes device coordinates + */ + xx[j] = toDeviceX(xx[j], GE_INCHES, dd); + yy[j] = toDeviceY(yy[j], GE_INCHES, dd); + if (!(R_FINITE(xx[j]) && R_FINITE(yy[j]))) { + error(_("non-finite control point in Xspline")); + } + } + PROTECT(points = GEXspline(nx, xx, yy, ss, + LOGICAL(o)[0], LOGICAL(rep)[0], + draw, &gc, dd)); + { + /* + * In some cases, GEXspline seems to produce identical points + * (at least observed at end of spline) + * so trim identical points from the ends + * (so arrow heads are drawn at correct angle) + */ + int np = LENGTH(VECTOR_ELT(points, 0)); + double *px = REAL(VECTOR_ELT(points, 0)); + double *py = REAL(VECTOR_ELT(points, 1)); + int start = 0; + int end = np - 1; + /* + * DEBUGGING ... + int k; + for (k=0; k<np; k++) { + GESymbol(px[k], py[k], 16, 3, &gc, dd); + } + * ... DEBUGGING + */ + while (np > 1 && + (px[start] == px[start + 1]) && + (py[start] == py[start + 1])) { + start++; + np--; + } + while (np > 1 && + (px[end] == px[end - 1]) && + (py[end] == py[end - 1])) { + end--; + np--; + } + if (trace) { + int k; + int count = end - start + 1; + double *keepXptr, *keepYptr; + SEXP keepPoints, keepX, keepY; + PROTECT(keepPoints = allocVector(VECSXP, 2)); + PROTECT(keepX = allocVector(REALSXP, count)); + PROTECT(keepY = allocVector(REALSXP, count)); + keepXptr = REAL(keepX); + keepYptr = REAL(keepY); + for (k=start; k<(end + 1); k++) { + keepXptr[k - start] = fromDeviceX(px[k], GE_INCHES, dd); + keepYptr[k - start] = fromDeviceY(py[k], GE_INCHES, dd); + } + SET_VECTOR_ELT(keepPoints, 0, keepX); + SET_VECTOR_ELT(keepPoints, 1, keepY); + SET_VECTOR_ELT(tracePts, i, keepPoints); + UNPROTECT(3); /* keepPoints & keepX & keepY */ + } + if (draw && !isNull(a) && !isNull(points)) { + /* + * Can draw an arrow at the either end. + */ + arrows(&(px[start]), &(py[start]), np, + a, i, TRUE, TRUE, + vpc, vpWidthCM, vpHeightCM, &gc, dd); + } + if (!draw && !trace && !isNull(points)) { + /* + * Update bounds + */ + int j, n = LENGTH(VECTOR_ELT(points, 0)); + double *pxx = (double *) R_alloc(n, sizeof(double)); + double *pyy = (double *) R_alloc(n, sizeof(double)); + for (j=0; j<n; j++) { + pxx[j] = fromDeviceX(px[j], GE_INCHES, dd); + pyy[j] = fromDeviceY(py[j], GE_INCHES, dd); + if (R_FINITE(pxx[j]) && R_FINITE(pyy[j])) { + if (pxx[j] < xmin) + xmin = pxx[j]; + if (pxx[j] > xmax) + xmax = pxx[j]; + if (pyy[j] < ymin) + ymin = pyy[j]; + if (pyy[j] > ymax) + ymax = pyy[j]; + nloc++; + } + } + /* + * Calculate edgex and edgey for case where this is + * the only xspline + */ + hullEdge(pxx, pyy, n, theta, &edgex, &edgey); + } + } /* End of trimming-redundant-points code */ + UNPROTECT(1); /* points */ + if (draw) + GEMode(0, dd); + vmaxset(vmax); + } + if (!draw && !trace && nloc > 0) { + PROTECT(result = allocVector(REALSXP, 4)); + /* + * If there is more than one xspline, just produce edge + * based on bounding rect of all xsplines + */ + if (np > 1) { + rectEdge(xmin, ymin, xmax, ymax, theta, + &edgex, &edgey); + } + /* + * Reverse the scale adjustment (zoom factor) + * when calculating physical value to return to user-level + */ + REAL(result)[0] = edgex / + REAL(gridStateElement(dd, GSS_SCALE))[0]; + REAL(result)[1] = edgey / + REAL(gridStateElement(dd, GSS_SCALE))[0]; + REAL(result)[2] = (xmax - xmin) / + REAL(gridStateElement(dd, GSS_SCALE))[0]; + REAL(result)[3] = (ymax - ymin) / + REAL(gridStateElement(dd, GSS_SCALE))[0]; + UNPROTECT(1); /* result */ + } else if (trace) { + result = tracePts; + } + UNPROTECT(1); /* tracePts */ + return result; +} + +SEXP L_xspline(SEXP x, SEXP y, SEXP s, SEXP o, SEXP a, SEXP rep, SEXP index) +{ + gridXspline(x, y, s, o, a, rep, index, 0, TRUE, FALSE); + return R_NilValue; +} + +SEXP L_xsplineBounds(SEXP x, SEXP y, SEXP s, SEXP o, SEXP a, SEXP rep, + SEXP index, SEXP theta) +{ + return gridXspline(x, y, s, o, a, rep, index, REAL(theta)[0], + FALSE, FALSE); +} + +SEXP L_xsplinePoints(SEXP x, SEXP y, SEXP s, SEXP o, SEXP a, SEXP rep, + SEXP index, SEXP theta) +{ + return gridXspline(x, y, s, o, a, rep, index, REAL(theta)[0], + FALSE, TRUE); +} + +SEXP L_segments(SEXP x0, SEXP y0, SEXP x1, SEXP y1, SEXP arrow) +{ + int i, nx0, ny0, nx1, ny1, maxn; + double vpWidthCM, vpHeightCM; + double rotationAngle; + LViewportContext vpc; + R_GE_gcontext gc; + LTransform transform; + SEXP currentvp, currentgp; + /* Get the current device + */ + pGEDevDesc dd = getDevice(); + currentvp = gridStateElement(dd, GSS_VP); + currentgp = gridStateElement(dd, GSS_GPAR); + getViewportTransform(currentvp, dd, + &vpWidthCM, &vpHeightCM, + transform, &rotationAngle); + getViewportContext(currentvp, &vpc); + maxn = nx0 = unitLength(x0); + ny0 = unitLength(y0); + nx1 = unitLength(x1); + ny1 = unitLength(y1); + if (ny0 > maxn) + maxn = ny0; + if (nx1 > maxn) + maxn = nx1; + if (ny1 > maxn) + maxn = ny1; + /* Convert the x and y values to INCHES locations */ + /* FIXME: Need to check for NaN's and NA's + */ + GEMode(1, dd); + for (i=0; i<maxn; i++) { + double xx0, yy0, xx1, yy1; + gcontextFromgpar(currentgp, i, &gc, dd); + transformLocn(x0, y0, i, vpc, &gc, + vpWidthCM, vpHeightCM, + dd, transform, &xx0, &yy0); + transformLocn(x1, y1, i, vpc, &gc, + vpWidthCM, vpHeightCM, + dd, transform, &xx1, &yy1); + /* The graphics engine only takes device coordinates + */ + xx0 = toDeviceX(xx0, GE_INCHES, dd); + yy0 = toDeviceY(yy0, GE_INCHES, dd); + xx1 = toDeviceX(xx1, GE_INCHES, dd); + yy1 = toDeviceY(yy1, GE_INCHES, dd); + if (R_FINITE(xx0) && R_FINITE(yy0) && + R_FINITE(xx1) && R_FINITE(yy1)) { + GELine(xx0, yy0, xx1, yy1, &gc, dd); + if (!isNull(arrow)) { + double ax[2], ay[2]; + ax[0] = xx0; + ax[1] = xx1; + ay[0] = yy0; + ay[1] = yy1; + arrows(ax, ay, 2, + arrow, i, TRUE, TRUE, + vpc, vpWidthCM, vpHeightCM, &gc, dd); + } + } + } + GEMode(0, dd); + return R_NilValue; +} + +static int getArrowN(SEXP x1, SEXP x2, SEXP xnm1, SEXP xn, + SEXP y1, SEXP y2, SEXP ynm1, SEXP yn) +{ + int nx2, nxnm1, nxn, ny1, ny2, nynm1, nyn, maxn; + maxn = 0; + /* + * x1, y1, xnm1, and ynm1 could be NULL if this is adding + * arrows to a line.to + */ + if (isNull(y1)) + ny1 = 0; + else + ny1 = unitLength(y1); + nx2 = unitLength(x2); + ny2 = unitLength(y2); + if (isNull(xnm1)) + nxnm1 = 0; + else + nxnm1 = unitLength(xnm1); + if (isNull(ynm1)) + nynm1 = 0; + else + nynm1 = unitLength(ynm1); + nxn = unitLength(xn); + nyn = unitLength(yn); + if (ny1 > maxn) + maxn = ny1; + if (nx2 > maxn) + maxn = nx2; + if (ny2 > maxn) + maxn = ny2; + if (nxnm1 > maxn) + maxn = nxnm1; + if (nynm1 > maxn) + maxn = nynm1; + if (nxn > maxn) + maxn = nxn; + if (nyn > maxn) + maxn = nyn; + return maxn; +} + +SEXP L_arrows(SEXP x1, SEXP x2, SEXP xnm1, SEXP xn, + SEXP y1, SEXP y2, SEXP ynm1, SEXP yn, + SEXP angle, SEXP length, SEXP ends, SEXP type) +{ + int i, maxn; + int ne; + double vpWidthCM, vpHeightCM; + double rotationAngle; + Rboolean first, last; + LViewportContext vpc; + R_GE_gcontext gc; + LTransform transform; + SEXP currentvp, currentgp; + SEXP devloc = R_NilValue; /* -Wall */ + /* Get the current device + */ + pGEDevDesc dd = getDevice(); + currentvp = gridStateElement(dd, GSS_VP); + currentgp = gridStateElement(dd, GSS_GPAR); + getViewportTransform(currentvp, dd, + &vpWidthCM, &vpHeightCM, + transform, &rotationAngle); + getViewportContext(currentvp, &vpc); + maxn = getArrowN(x1, x2, xnm1, xn, + y1, y2, ynm1, yn); + ne = LENGTH(ends); + /* Convert the x and y values to INCHES locations */ + /* FIXME: Need to check for NaN's and NA's + */ + GEMode(1, dd); + for (i=0; i<maxn; i++) { + double xx1, xx2, xxnm1, xxn, yy1, yy2, yynm1, yyn; + double vertx[3]; + double verty[3]; + first = TRUE; + last = TRUE; + switch (INTEGER(ends)[i % ne]) { + case 2: + first = FALSE; + break; + case 1: + last = FALSE; + break; + } + gcontextFromgpar(currentgp, i, &gc, dd); + /* + * If we're adding arrows to a line.to + * x1 will be NULL + */ + if (isNull(x1)) + PROTECT(devloc = gridStateElement(dd, GSS_CURRLOC)); + if (first) { + if (isNull(x1)) { + xx1 = REAL(devloc)[0]; + yy1 = REAL(devloc)[1]; + } else + transformLocn(x1, y1, i, vpc, &gc, + vpWidthCM, vpHeightCM, + dd, transform, &xx1, &yy1); + transformLocn(x2, y2, i, vpc, &gc, + vpWidthCM, vpHeightCM, + dd, transform, &xx2, &yy2); + calcArrow(xx1, yy1, xx2, yy2, angle, length, i, + vpc, vpWidthCM, vpHeightCM, + vertx, verty, &gc, dd); + /* + * Only draw arrow if both ends of first segment + * are not non-finite + */ + if (R_FINITE(toDeviceX(xx2, GE_INCHES, dd)) && + R_FINITE(toDeviceY(yy2, GE_INCHES, dd)) && + R_FINITE(vertx[1]) && R_FINITE(verty[1])) + drawArrow(vertx, verty, type, i, &gc, dd); + } + if (last) { + if (isNull(xnm1)) { + xxnm1 = REAL(devloc)[0]; + yynm1 = REAL(devloc)[1]; + } else + transformLocn(xnm1, ynm1, i, vpc, &gc, + vpWidthCM, vpHeightCM, + dd, transform, &xxnm1, &yynm1); + transformLocn(xn, yn, i, vpc, &gc, + vpWidthCM, vpHeightCM, + dd, transform, &xxn, &yyn); + calcArrow(xxn, yyn, xxnm1, yynm1, angle, length, i, + vpc, vpWidthCM, vpHeightCM, + vertx, verty, &gc, dd); + /* + * Only draw arrow if both ends of laste segment are + * not non-finite + */ + if (R_FINITE(toDeviceX(xxnm1, GE_INCHES, dd)) && + R_FINITE(toDeviceY(yynm1, GE_INCHES, dd)) && + R_FINITE(vertx[1]) && R_FINITE(verty[1])) + drawArrow(vertx, verty, type, i, &gc, dd); + } + if (isNull(x1)) + UNPROTECT(1); + } + GEMode(0, dd); + return R_NilValue; +} + +SEXP L_polygon(SEXP x, SEXP y, SEXP index) +{ + int i, j, nx, np, start=0; + double *xx, *yy; + double xold, yold; + double vpWidthCM, vpHeightCM; + double rotationAngle; + LViewportContext vpc; + R_GE_gcontext gc; + LTransform transform; + SEXP currentvp, currentgp; + /* Get the current device + */ + pGEDevDesc dd = getDevice(); + currentvp = gridStateElement(dd, GSS_VP); + currentgp = gridStateElement(dd, GSS_GPAR); + getViewportTransform(currentvp, dd, + &vpWidthCM, &vpHeightCM, + transform, &rotationAngle); + getViewportContext(currentvp, &vpc); + GEMode(1, dd); + /* + * Number of polygons + */ + np = LENGTH(index); + for (i=0; i<np; i++) { + const void *vmax; + SEXP indices = VECTOR_ELT(index, i); + gcontextFromgpar(currentgp, i, &gc, dd); + /* + * Number of vertices + * + * Check in R code that x and y same length + */ + nx = LENGTH(indices); + /* Convert the x and y values to CM locations */ + vmax = vmaxget(); + xx = (double *) R_alloc(nx + 1, sizeof(double)); + yy = (double *) R_alloc(nx + 1, sizeof(double)); + xold = NA_REAL; + yold = NA_REAL; + for (j=0; j<nx; j++) { + transformLocn(x, y, INTEGER(indices)[j] - 1, vpc, &gc, + vpWidthCM, vpHeightCM, + dd, + transform, + &(xx[j]), &(yy[j])); + /* The graphics engine only takes device coordinates + */ + xx[j] = toDeviceX(xx[j], GE_INCHES, dd); + yy[j] = toDeviceY(yy[j], GE_INCHES, dd); + if ((R_FINITE(xx[j]) && R_FINITE(yy[j])) && + !(R_FINITE(xold) && R_FINITE(yold))) + start = j; /* first point of current segment */ + else if ((R_FINITE(xold) && R_FINITE(yold)) && + !(R_FINITE(xx[j]) && R_FINITE(yy[j]))) { + if (j-start > 1) { + GEPolygon(j-start, xx+start, yy+start, &gc, dd); + } + } + else if ((R_FINITE(xold) && R_FINITE(yold)) && (j == nx-1)) { + /* last */ + GEPolygon(nx-start, xx+start, yy+start, &gc, dd); + } + xold = xx[j]; + yold = yy[j]; + } + vmaxset(vmax); + } + GEMode(0, dd); + return R_NilValue; +} + +static SEXP gridCircle(SEXP x, SEXP y, SEXP r, + double theta, Rboolean draw) +{ + int i, nx, ny, nr, ncirc; + double xx, yy, rr1, rr2, rr = 0.0 /* -Wall */; + double vpWidthCM, vpHeightCM; + double rotationAngle; + LViewportContext vpc; + R_GE_gcontext gc; + LTransform transform; + SEXP currentvp, currentgp; + SEXP result = R_NilValue; + double xmin = DOUBLE_XMAX; + double xmax = -DOUBLE_XMAX; + double ymin = DOUBLE_XMAX; + double ymax = -DOUBLE_XMAX; + double edgex, edgey; + /* Get the current device + */ + pGEDevDesc dd = getDevice(); + currentvp = gridStateElement(dd, GSS_VP); + currentgp = gridStateElement(dd, GSS_GPAR); + getViewportTransform(currentvp, dd, + &vpWidthCM, &vpHeightCM, + transform, &rotationAngle); + getViewportContext(currentvp, &vpc); + nx = unitLength(x); + ny = unitLength(y); + nr = unitLength(r); + if (ny > nx) + nx = ny; + if (nr > nx) + nx = nr; + if (draw) { + GEMode(1, dd); + } + ncirc = 0; + for (i=0; i<nx; i++) { + gcontextFromgpar(currentgp, i, &gc, dd); + /* + * If drawing, convert to INCHES on device + * If just calculating bounds, convert to INCHES within current vp + */ + if (draw) { + transformLocn(x, y, i, vpc, &gc, + vpWidthCM, vpHeightCM, + dd, + transform, + &xx, &yy); + } else { + xx = transformXtoINCHES(x, i, vpc, &gc, + vpWidthCM, vpHeightCM, + dd); + yy = transformYtoINCHES(y, i, vpc, &gc, + vpWidthCM, vpHeightCM, + dd); + } + /* These two will give the same answer unless r is in "native", + * "npc", or some other relative units; in those cases, just + * take the smaller of the two values. + */ + rr1 = transformWidthtoINCHES(r, i % nr, vpc, &gc, + vpWidthCM, vpHeightCM, + dd); + rr2 = transformHeighttoINCHES(r, i % nr, vpc, &gc, + vpWidthCM, vpHeightCM, + dd); + /* + * A negative radius is silently converted to absolute value + */ + rr = fmin2(fabs(rr1), fabs(rr2)); + if (R_FINITE(xx) && R_FINITE(yy) && R_FINITE(rr)) { + if (draw) { + /* The graphics engine only takes device coordinates + */ + xx = toDeviceX(xx, GE_INCHES, dd); + yy = toDeviceY(yy, GE_INCHES, dd); + rr = toDeviceWidth(rr, GE_INCHES, dd); + GECircle(xx, yy, rr, &gc, dd); + } else { + if (xx + rr < xmin) + xmin = xx + rr; + if (xx + rr > xmax) + xmax = xx + rr; + if (xx - rr < xmin) + xmin = xx - rr; + if (xx - rr > xmax) + xmax = xx - rr; + if (yy + rr < ymin) + ymin = yy + rr; + if (yy + rr > ymax) + ymax = yy + rr; + if (yy - rr < ymin) + ymin = yy - rr; + if (yy - rr > ymax) + ymax = yy - rr; + ncirc++; + } + } + } + if (draw) { + GEMode(0, dd); + } else if (ncirc > 0) { + result = allocVector(REALSXP, 4); + if (ncirc == 1) { + /* + * Produce edge of actual circle + */ + circleEdge(xx, yy, rr, theta, &edgex, &edgey); + } else { + /* + * Produce edge of rect bounding all circles + */ + rectEdge(xmin, ymin, xmax, ymax, theta, + &edgex, &edgey); + } + /* + * Reverse the scale adjustment (zoom factor) + * when calculating physical value to return to user-level + */ + REAL(result)[0] = edgex / + REAL(gridStateElement(dd, GSS_SCALE))[0]; + REAL(result)[1] = edgey / + REAL(gridStateElement(dd, GSS_SCALE))[0]; + REAL(result)[2] = (xmax - xmin) / + REAL(gridStateElement(dd, GSS_SCALE))[0]; + REAL(result)[3] = (ymax - ymin) / + REAL(gridStateElement(dd, GSS_SCALE))[0]; + } + return result; +} + +SEXP L_circle(SEXP x, SEXP y, SEXP r) +{ + gridCircle(x, y, r, 0, TRUE); + return R_NilValue; +} + +SEXP L_circleBounds(SEXP x, SEXP y, SEXP r, SEXP theta) +{ + return gridCircle(x, y, r, REAL(theta)[0], FALSE); +} + +/* We are assuming here that the R code has checked that + * x, y, w, and h are all unit objects and that vp is a viewport + */ +static SEXP gridRect(SEXP x, SEXP y, SEXP w, SEXP h, + SEXP hjust, SEXP vjust, double theta, Rboolean draw) +{ + double xx, yy, ww, hh; + double vpWidthCM, vpHeightCM; + double rotationAngle; + int i, ny, nw, nh, maxn, nrect; + LViewportContext vpc; + R_GE_gcontext gc; + LTransform transform; + SEXP currentvp, currentgp; + SEXP result = R_NilValue; + double edgex, edgey; + double xmin = DOUBLE_XMAX; + double xmax = -DOUBLE_XMAX; + double ymin = DOUBLE_XMAX; + double ymax = -DOUBLE_XMAX; + /* Get the current device + */ + pGEDevDesc dd = getDevice(); + currentvp = gridStateElement(dd, GSS_VP); + currentgp = gridStateElement(dd, GSS_GPAR); + getViewportTransform(currentvp, dd, + &vpWidthCM, &vpHeightCM, + transform, &rotationAngle); + getViewportContext(currentvp, &vpc); + maxn = unitLength(x); + ny = unitLength(y); + nw = unitLength(w); + nh = unitLength(h); + if (ny > maxn) + maxn = ny; + if (nw > maxn) + maxn = nw; + if (nh > maxn) + maxn = nh; + if (draw) { + GEMode(1, dd); + } + nrect = 0; + for (i=0; i<maxn; i++) { + gcontextFromgpar(currentgp, i, &gc, dd); + /* + * If drawing, convert to INCHES on device + * If just calculating bounds, convert to INCHES within current vp + */ + if (draw) { + transformLocn(x, y, i, vpc, &gc, + vpWidthCM, vpHeightCM, + dd, + transform, + &xx, &yy); + } else { + xx = transformXtoINCHES(x, i, vpc, &gc, + vpWidthCM, vpHeightCM, + dd); + yy = transformYtoINCHES(y, i, vpc, &gc, + vpWidthCM, vpHeightCM, + dd); + } + ww = transformWidthtoINCHES(w, i, vpc, &gc, + vpWidthCM, vpHeightCM, + dd); + hh = transformHeighttoINCHES(h, i, vpc, &gc, + vpWidthCM, vpHeightCM, + dd); + /* If the total rotation angle is zero then we can draw a + * rectangle as the devices understand rectangles + * Otherwise we have to draw a polygon equivalent. + */ + if (draw) { + if (rotationAngle == 0) { + xx = justifyX(xx, ww, REAL(hjust)[i % LENGTH(hjust)]); + yy = justifyY(yy, hh, REAL(vjust)[i % LENGTH(vjust)]); + /* The graphics engine only takes device coordinates + */ + xx = toDeviceX(xx, GE_INCHES, dd); + yy = toDeviceY(yy, GE_INCHES, dd); + ww = toDeviceWidth(ww, GE_INCHES, dd); + hh = toDeviceHeight(hh, GE_INCHES, dd); + if (R_FINITE(xx) && R_FINITE(yy) && + R_FINITE(ww) && R_FINITE(hh)) + GERect(xx, yy, xx + ww, yy + hh, &gc, dd); + } else { + /* We have to do a little bit of work to figure out where the + * corners of the rectangle are. + */ + double xxx[5], yyy[5], xadj, yadj; + double dw, dh; + SEXP zeroInches, xadjInches, yadjInches, wwInches, hhInches; + int tmpcol; + PROTECT(zeroInches = unit(0, L_INCHES)); + /* Find bottom-left location */ + justification(ww, hh, + REAL(hjust)[i % LENGTH(hjust)], + REAL(vjust)[i % LENGTH(vjust)], + &xadj, &yadj); + PROTECT(xadjInches = unit(xadj, L_INCHES)); + PROTECT(yadjInches = unit(yadj, L_INCHES)); + transformDimn(xadjInches, yadjInches, 0, vpc, &gc, + vpWidthCM, vpHeightCM, + dd, rotationAngle, + &dw, &dh); + xxx[0] = xx + dw; + yyy[0] = yy + dh; + /* Find top-left location */ + PROTECT(hhInches = unit(hh, L_INCHES)); + transformDimn(zeroInches, hhInches, 0, vpc, &gc, + vpWidthCM, vpHeightCM, + dd, rotationAngle, + &dw, &dh); + xxx[1] = xxx[0] + dw; + yyy[1] = yyy[0] + dh; + /* Find top-right location */ + PROTECT(wwInches = unit(ww, L_INCHES)); + transformDimn(wwInches, hhInches, 0, vpc, &gc, + vpWidthCM, vpHeightCM, + dd, rotationAngle, + &dw, &dh); + xxx[2] = xxx[0] + dw; + yyy[2] = yyy[0] + dh; + /* Find bottom-right location */ + transformDimn(wwInches, zeroInches, 0, vpc, &gc, + vpWidthCM, vpHeightCM, + dd, rotationAngle, + &dw, &dh); + xxx[3] = xxx[0] + dw; + yyy[3] = yyy[0] + dh; + if (R_FINITE(xxx[0]) && R_FINITE(yyy[0]) && + R_FINITE(xxx[1]) && R_FINITE(yyy[1]) && + R_FINITE(xxx[2]) && R_FINITE(yyy[2]) && + R_FINITE(xxx[3]) && R_FINITE(yyy[3])) { + /* The graphics engine only takes device coordinates + */ + xxx[0] = toDeviceX(xxx[0], GE_INCHES, dd); + yyy[0] = toDeviceY(yyy[0], GE_INCHES, dd); + xxx[1] = toDeviceX(xxx[1], GE_INCHES, dd); + yyy[1] = toDeviceY(yyy[1], GE_INCHES, dd); + xxx[2] = toDeviceX(xxx[2], GE_INCHES, dd); + yyy[2] = toDeviceY(yyy[2], GE_INCHES, dd); + xxx[3] = toDeviceX(xxx[3], GE_INCHES, dd); + yyy[3] = toDeviceY(yyy[3], GE_INCHES, dd); + /* Close the polygon */ + xxx[4] = xxx[0]; + yyy[4] = yyy[0]; + /* Do separate fill and border to avoid border being + * drawn on clipping boundary when there is a fill + */ + tmpcol = gc.col; + gc.col = R_TRANWHITE; + GEPolygon(5, xxx, yyy, &gc, dd); + gc.col = tmpcol; + gc.fill = R_TRANWHITE; + GEPolygon(5, xxx, yyy, &gc, dd); + } + UNPROTECT(5); + } + } else { /* Just calculating boundary */ + xx = justifyX(xx, ww, REAL(hjust)[i % LENGTH(hjust)]); + yy = justifyY(yy, hh, REAL(vjust)[i % LENGTH(vjust)]); + if (R_FINITE(xx) && R_FINITE(yy) && + R_FINITE(ww) && R_FINITE(hh)) { + if (xx < xmin) + xmin = xx; + if (xx > xmax) + xmax = xx; + if (xx + ww < xmin) + xmin = xx + ww; + if (xx + ww > xmax) + xmax = xx + ww; + if (yy < ymin) + ymin = yy; + if (yy > ymax) + ymax = yy; + if (yy + hh < ymin) + ymin = yy + hh; + if (yy + hh > ymax) + ymax = yy + hh; + /* + * Calculate edgex and edgey for case where this is + * the only rect + */ + rectEdge(xx, yy, xx + ww, yy + hh, theta, + &edgex, &edgey); + nrect++; + } + } + } + if (draw) { + GEMode(0, dd); + } + if (nrect > 0) { + result = allocVector(REALSXP, 4); + /* + * If there is more than one rect, just produce edge + * based on bounding rect of all rects + */ + if (nrect > 1) { + rectEdge(xmin, ymin, xmax, ymax, theta, + &edgex, &edgey); + } + /* + * Reverse the scale adjustment (zoom factor) + * when calculating physical value to return to user-level + */ + REAL(result)[0] = edgex / + REAL(gridStateElement(dd, GSS_SCALE))[0]; + REAL(result)[1] = edgey / + REAL(gridStateElement(dd, GSS_SCALE))[0]; + REAL(result)[2] = (xmax - xmin) / + REAL(gridStateElement(dd, GSS_SCALE))[0]; + REAL(result)[3] = (ymax - ymin) / + REAL(gridStateElement(dd, GSS_SCALE))[0]; + } + return result; +} + +SEXP L_rect(SEXP x, SEXP y, SEXP w, SEXP h, SEXP hjust, SEXP vjust) +{ + gridRect(x, y, w, h, hjust, vjust, 0, TRUE); + return R_NilValue; +} + +SEXP L_rectBounds(SEXP x, SEXP y, SEXP w, SEXP h, SEXP hjust, SEXP vjust, + SEXP theta) +{ + return gridRect(x, y, w, h, hjust, vjust, REAL(theta)[0], FALSE); +} + +/* FIXME: need to add L_pathBounds ? */ + +SEXP L_path(SEXP x, SEXP y, SEXP index, SEXP rule) +{ + int i, j, k, npoly, *nper, ntot; + double *xx, *yy; + const void *vmax; + double vpWidthCM, vpHeightCM; + double rotationAngle; + LViewportContext vpc; + R_GE_gcontext gc; + LTransform transform; + SEXP currentvp, currentgp; + /* Get the current device + */ + pGEDevDesc dd = getDevice(); + currentvp = gridStateElement(dd, GSS_VP); + currentgp = gridStateElement(dd, GSS_GPAR); + getViewportTransform(currentvp, dd, + &vpWidthCM, &vpHeightCM, + transform, &rotationAngle); + getViewportContext(currentvp, &vpc); + GEMode(1, dd); + vmax = vmaxget(); + /* + * Number of polygons + */ + npoly = LENGTH(index); + /* + * Total number of points and + * Number of points per polygon + */ + ntot = 0; + nper = (int *) R_alloc(npoly, sizeof(int)); + for (i=0; i < npoly; i++) { + nper[i] = LENGTH(VECTOR_ELT(index, i)); + ntot = ntot + nper[i]; + } + xx = (double *) R_alloc(ntot, sizeof(double)); + yy = (double *) R_alloc(ntot, sizeof(double)); + k = 0; + for (i=0; i < npoly; i++) { + SEXP indices = VECTOR_ELT(index, i); + for (j=0; j < nper[i]; j++) { + transformLocn(x, y, INTEGER(indices)[j] - 1, vpc, &gc, + vpWidthCM, vpHeightCM, + dd, + transform, + &(xx[k]), &(yy[k])); + /* The graphics engine only takes device coordinates + */ + xx[k] = toDeviceX(xx[k], GE_INCHES, dd); + yy[k] = toDeviceY(yy[k], GE_INCHES, dd); + /* NO NA values allowed in 'x' or 'y' + */ + if (!R_FINITE(xx[k]) || !R_FINITE(yy[k])) + error(_("non-finite x or y in graphics path")); + k++; + } + } + gcontextFromgpar(currentgp, 0, &gc, dd); + GEPath(xx, yy, npoly, nper, INTEGER(rule)[0], &gc, dd); + vmaxset(vmax); + GEMode(0, dd); + return R_NilValue; +} + +/* FIXME: need to add L_rasterBounds */ + +/* FIXME: Add more checks on correct inputs, + e.g., Raster should be a matrix of R colors */ +SEXP L_raster(SEXP raster, SEXP x, SEXP y, SEXP w, SEXP h, + SEXP hjust, SEXP vjust, SEXP interpolate) +{ + const void *vmax; + int i, n, ny, nw, nh, maxn; + double xx, yy, ww, hh; + double vpWidthCM, vpHeightCM; + double rotationAngle; + LViewportContext vpc; + R_GE_gcontext gc; + LTransform transform; + SEXP currentvp, currentgp; + SEXP dim; + /* Get the current device + */ + pGEDevDesc dd = getDevice(); + unsigned int *image; + currentvp = gridStateElement(dd, GSS_VP); + currentgp = gridStateElement(dd, GSS_GPAR); + getViewportTransform(currentvp, dd, + &vpWidthCM, &vpHeightCM, + transform, &rotationAngle); + getViewportContext(currentvp, &vpc); + /* Convert the raster matrix to R internal colours */ + n = LENGTH(raster); + if (n <= 0) { + error(_("Empty raster")); + } + vmax = vmaxget(); + /* raster is rather inefficient so allow a native representation as + an integer array which requires no conversion */ + if (inherits(raster, "nativeRaster") && isInteger(raster)) { + image = (unsigned int*) INTEGER(raster); + } else { + image = (unsigned int*) R_alloc(n, sizeof(unsigned int)); + for (i=0; i<n; i++) { + image[i] = RGBpar3(raster, i, R_TRANWHITE); + } + } + dim = getAttrib(raster, R_DimSymbol); + maxn = unitLength(x); + ny = unitLength(y); + nw = unitLength(w); + nh = unitLength(h); + if (ny > maxn) + maxn = ny; + if (nw > maxn) + maxn = nw; + if (nh > maxn) + maxn = nh; + GEMode(1, dd); + for (i=0; i<maxn; i++) { + gcontextFromgpar(currentgp, i, &gc, dd); + transformLocn(x, y, i, vpc, &gc, + vpWidthCM, vpHeightCM, + dd, + transform, + &xx, &yy); + ww = transformWidthtoINCHES(w, i, vpc, &gc, + vpWidthCM, vpHeightCM, + dd); + hh = transformHeighttoINCHES(h, i, vpc, &gc, + vpWidthCM, vpHeightCM, + dd); + if (rotationAngle == 0) { + xx = justifyX(xx, ww, REAL(hjust)[i % LENGTH(hjust)]); + yy = justifyY(yy, hh, REAL(vjust)[i % LENGTH(vjust)]); + /* The graphics engine only takes device coordinates + */ + xx = toDeviceX(xx, GE_INCHES, dd); + yy = toDeviceY(yy, GE_INCHES, dd); + ww = toDeviceWidth(ww, GE_INCHES, dd); + hh = toDeviceHeight(hh, GE_INCHES, dd); + if (R_FINITE(xx) && R_FINITE(yy) && + R_FINITE(ww) && R_FINITE(hh)) + GERaster(image, INTEGER(dim)[1], INTEGER(dim)[0], + xx, yy, ww, hh, rotationAngle, + LOGICAL(interpolate)[i % LENGTH(interpolate)], + &gc, dd); + } else { + /* We have to do a little bit of work to figure out where the + * bottom-left corner of the image is. + */ + double xbl, ybl, xadj, yadj; + double dw, dh; + SEXP xadjInches, yadjInches; + /* Find bottom-left location */ + justification(ww, hh, + REAL(hjust)[i % LENGTH(hjust)], + REAL(vjust)[i % LENGTH(vjust)], + &xadj, &yadj); + PROTECT(xadjInches = unit(xadj, L_INCHES)); + PROTECT(yadjInches = unit(yadj, L_INCHES)); + transformDimn(xadjInches, yadjInches, 0, vpc, &gc, + vpWidthCM, vpHeightCM, + dd, rotationAngle, + &dw, &dh); + xbl = xx + dw; + ybl = yy + dh; + xbl = toDeviceX(xbl, GE_INCHES, dd); + ybl = toDeviceY(ybl, GE_INCHES, dd); + ww = toDeviceWidth(ww, GE_INCHES, dd); + hh = toDeviceHeight(hh, GE_INCHES, dd); + if (R_FINITE(xbl) && R_FINITE(ybl) && + R_FINITE(ww) && R_FINITE(hh)) { + /* The graphics engine only takes device coordinates + */ + GERaster(image, INTEGER(dim)[1], INTEGER(dim)[0], + xbl, ybl, ww, hh, rotationAngle, + LOGICAL(interpolate)[i % LENGTH(interpolate)], + &gc, dd); + } + UNPROTECT(2); + } + } + GEMode(0, dd); + vmaxset(vmax); + return R_NilValue; +} + +SEXP L_cap() +{ + int i, col, row, nrow, ncol, size; + /* Get the current device + */ + pGEDevDesc dd = getDevice(); + int *rint; + SEXP raster; + /* The raster is R internal colours, so convert to + * R external colours (strings) + * AND the raster is BY ROW so need to rearrange it + * to be BY COLUMN (though the dimensions are correct) */ + SEXP image, idim; + + PROTECT(raster = GECap(dd)); + /* Non-complying devices will return NULL */ + if (isNull(raster)) { + image = raster; + } else { + size = LENGTH(raster); + nrow = INTEGER(getAttrib(raster, R_DimSymbol))[0]; + ncol = INTEGER(getAttrib(raster, R_DimSymbol))[1]; + + PROTECT(image = allocVector(STRSXP, size)); + rint = INTEGER(raster); + for (i=0; i<size; i++) { + col = i % ncol + 1; + row = i / ncol + 1; + SET_STRING_ELT(image, (col - 1)*nrow + row - 1, + mkChar(col2name(rint[i]))); + } + + PROTECT(idim = allocVector(INTSXP, 2)); + INTEGER(idim)[0] = nrow; + INTEGER(idim)[1] = ncol; + setAttrib(image, R_DimSymbol, idim); + + UNPROTECT(2); + } + UNPROTECT(1); + return image; +} + +/* + * Code to draw OR size text + * Combined to avoid code replication + */ +static SEXP gridText(SEXP label, SEXP x, SEXP y, SEXP hjust, SEXP vjust, + SEXP rot, SEXP checkOverlap, double theta, Rboolean draw) +{ + int i, nx, ny; + double *xx, *yy; + double vpWidthCM, vpHeightCM; + double rotationAngle; + LViewportContext vpc; + R_GE_gcontext gc; + LTransform transform; + SEXP txt, result = R_NilValue; + double edgex, edgey; + double xmin = DOUBLE_XMAX; + double xmax = -DOUBLE_XMAX; + double ymin = DOUBLE_XMAX; + double ymax = -DOUBLE_XMAX; + /* + * Bounding rectangles for checking overlapping + * Initialised to shut up compiler + */ + LRect *bounds = NULL; + LRect trect; + int numBounds = 0; + int overlapChecking = LOGICAL(checkOverlap)[0]; + const void *vmax; + SEXP currentvp, currentgp; + /* Get the current device + */ + pGEDevDesc dd = getDevice(); + currentvp = gridStateElement(dd, GSS_VP); + currentgp = gridStateElement(dd, GSS_GPAR); + getViewportTransform(currentvp, dd, + &vpWidthCM, &vpHeightCM, + transform, &rotationAngle); + getViewportContext(currentvp, &vpc); + nx = unitLength(x); + ny = unitLength(y); + if (ny > nx) + nx = ny; + vmax = vmaxget(); + xx = (double *) R_alloc(nx, sizeof(double)); + yy = (double *) R_alloc(nx, sizeof(double)); + for (i=0; i<nx; i++) { + gcontextFromgpar(currentgp, i, &gc, dd); + /* + * If drawing, convert to INCHES on device + * If just calculating bounds, convert to INCHES within current vp + */ + if (draw) { + transformLocn(x, y, i, vpc, &gc, + vpWidthCM, vpHeightCM, + dd, + transform, + &(xx[i]), &(yy[i])); + } else { + xx[i] = transformXtoINCHES(x, i, vpc, &gc, + vpWidthCM, vpHeightCM, + dd); + yy[i] = transformYtoINCHES(y, i, vpc, &gc, + vpWidthCM, vpHeightCM, + dd); + } + } + /* The label can be a string or an expression + */ + PROTECT(txt = label); + if (isSymbol(txt) || isLanguage(txt)) + txt = coerceVector(txt, EXPRSXP); + else if (!isExpression(txt)) + txt = coerceVector(txt, STRSXP); + UNPROTECT(1); + PROTECT(txt); + if (overlapChecking || !draw) { + bounds = (LRect *) R_alloc(nx, sizeof(LRect)); + } + /* + * Check we have any text to draw + */ + if (LENGTH(txt) > 0) { + int ntxt = 0; + if (draw) { + /* + * Drawing text + */ + GEMode(1, dd); + } + for (i=0; i<nx; i++) { + int doDrawing = 1; + gcontextFromgpar(currentgp, i, &gc, dd); + /* + * Generate bounding boxes when checking for overlap + * or sizing text + */ + if (overlapChecking || !draw) { + int j = 0; + textRect(xx[i], yy[i], txt, i, &gc, + REAL(hjust)[i % LENGTH(hjust)], + REAL(vjust)[i % LENGTH(vjust)], + /* + * When calculating bounding rect for text + * only consider rotation of text within + * local context, not relative to device + * (so don't add rotationAngle) + */ + numeric(rot, i % LENGTH(rot)), + dd, &trect); + while (doDrawing && (j < numBounds)) + if (intersect(trect, bounds[j++])) + doDrawing = 0; + if (doDrawing) { + copyRect(trect, &(bounds[numBounds])); + numBounds++; + } + } + if (draw && doDrawing) { + /* The graphics engine only takes device coordinates + */ + xx[i] = toDeviceX(xx[i], GE_INCHES, dd); + yy[i] = toDeviceY(yy[i], GE_INCHES, dd); + if (R_FINITE(xx[i]) && R_FINITE(yy[i])) { + gcontextFromgpar(currentgp, i, &gc, dd); + if (isExpression(txt)) + GEMathText(xx[i], yy[i], + VECTOR_ELT(txt, i % LENGTH(txt)), + REAL(hjust)[i % LENGTH(hjust)], + REAL(vjust)[i % LENGTH(vjust)], + numeric(rot, i % LENGTH(rot)) + + rotationAngle, + &gc, dd); + else + GEText(xx[i], yy[i], + CHAR(STRING_ELT(txt, i % LENGTH(txt))), + (gc.fontface == 5) ? CE_SYMBOL : + getCharCE(STRING_ELT(txt, i % LENGTH(txt))), + REAL(hjust)[i % LENGTH(hjust)], + REAL(vjust)[i % LENGTH(vjust)], + numeric(rot, i % LENGTH(rot)) + + rotationAngle, + &gc, dd); + } + } + if (!draw) { + double minx, maxx, miny, maxy; + /* + * Sizing text + */ + if (R_FINITE(xx[i]) && R_FINITE(yy[i])) { + minx = fmin2(trect.x1, + fmin2(trect.x2, + fmin2(trect.x3, trect.x4))); + if (minx < xmin) + xmin = minx; + maxx = fmax2(trect.x1, + fmax2(trect.x2, + fmax2(trect.x3, trect.x4))); + if (maxx > xmax) + xmax = maxx; + miny = fmin2(trect.y1, + fmin2(trect.y2, + fmin2(trect.y3, trect.y4))); + if (miny < ymin) + ymin = miny; + maxy = fmax2(trect.y1, + fmax2(trect.y2, + fmax2(trect.y3, trect.y4))); + if (maxy > ymax) + ymax = maxy; + /* + * Calculate edgex and edgey for case where this is + * the only rect + */ + { + double xxx[4], yyy[4]; + /* + * Must be in clock-wise order for polygonEdge + */ + xxx[0] = trect.x4; yyy[0] = trect.y4; + xxx[1] = trect.x3; yyy[1] = trect.y3; + xxx[2] = trect.x2; yyy[2] = trect.y2; + xxx[3] = trect.x1; yyy[3] = trect.y1; + polygonEdge(xxx, yyy, 4, theta, + &edgex, &edgey); + } + ntxt++; + } + } + } + if (draw) { + GEMode(0, dd); + } + if (ntxt > 0) { + result = allocVector(REALSXP, 4); + /* + * If there is more than one text, just produce edge + * based on bounding rect of all text + */ + if (ntxt > 1) { + /* + * Produce edge of rect bounding all text + */ + rectEdge(xmin, ymin, xmax, ymax, theta, + &edgex, &edgey); + } + /* + * Reverse the scale adjustment (zoom factor) + * when calculating physical value to return to user-level + */ + REAL(result)[0] = edgex / + REAL(gridStateElement(dd, GSS_SCALE))[0]; + REAL(result)[1] = edgey / + REAL(gridStateElement(dd, GSS_SCALE))[0]; + REAL(result)[2] = (xmax - xmin) / + REAL(gridStateElement(dd, GSS_SCALE))[0]; + REAL(result)[3] = (ymax - ymin) / + REAL(gridStateElement(dd, GSS_SCALE))[0]; + } + } + vmaxset(vmax); + UNPROTECT(1); + return result; +} + +SEXP L_text(SEXP label, SEXP x, SEXP y, SEXP hjust, SEXP vjust, + SEXP rot, SEXP checkOverlap) +{ + gridText(label, x, y, hjust, vjust, rot, checkOverlap, 0, TRUE); + return R_NilValue; +} + +/* + * Return four values representing boundary of text (which may consist + * of multiple pieces of text, unaligned, and/or rotated) + * in INCHES. + * + * Result is (xmin, xmax, ymin, ymax) + * + * Return NULL if no text to draw; R code will generate unit from that + */ +SEXP L_textBounds(SEXP label, SEXP x, SEXP y, + SEXP hjust, SEXP vjust, SEXP rot, SEXP theta) +{ + SEXP checkOverlap = allocVector(LGLSXP, 1); + LOGICAL(checkOverlap)[0] = FALSE; + return gridText(label, x, y, hjust, vjust, rot, checkOverlap, + REAL(theta)[0], FALSE); +} + +SEXP L_points(SEXP x, SEXP y, SEXP pch, SEXP size) +{ + int i, nx, npch; + /* double *xx, *yy;*/ + double *xx, *yy; + double vpWidthCM, vpHeightCM; + double rotationAngle; + double symbolSize; + const void *vmax; + LViewportContext vpc; + R_GE_gcontext gc; + LTransform transform; + SEXP currentvp, currentgp; + /* Get the current device + */ + pGEDevDesc dd = getDevice(); + currentvp = gridStateElement(dd, GSS_VP); + currentgp = gridStateElement(dd, GSS_GPAR); + getViewportTransform(currentvp, dd, + &vpWidthCM, &vpHeightCM, + transform, &rotationAngle); + getViewportContext(currentvp, &vpc); + nx = unitLength(x); + npch = LENGTH(pch); + /* Convert the x and y values to CM locations */ + vmax = vmaxget(); + xx = (double *) R_alloc(nx, sizeof(double)); + yy = (double *) R_alloc(nx, sizeof(double)); + for (i=0; i<nx; i++) { + gcontextFromgpar(currentgp, i, &gc, dd); + transformLocn(x, y, i, vpc, &gc, + vpWidthCM, vpHeightCM, + dd, + transform, + &(xx[i]), &(yy[i])); + /* The graphics engine only takes device coordinates + */ + xx[i] = toDeviceX(xx[i], GE_INCHES, dd); + yy[i] = toDeviceY(yy[i], GE_INCHES, dd); + } + GEMode(1, dd); + for (i=0; i<nx; i++) + if (R_FINITE(xx[i]) && R_FINITE(yy[i])) { + /* FIXME: The symbols will not respond to viewport + * rotations !!! + */ + int ipch = NA_INTEGER /* -Wall */; + gcontextFromgpar(currentgp, i, &gc, dd); + symbolSize = transformWidthtoINCHES(size, i, vpc, &gc, + vpWidthCM, vpHeightCM, dd); + /* The graphics engine only takes device coordinates + */ + symbolSize = toDeviceWidth(symbolSize, GE_INCHES, dd); + if (R_FINITE(symbolSize)) { + /* + * FIXME: + * Resolve any differences between this and FixupPch() + * in plot.c ? + */ + if (isString(pch)) { + ipch = GEstring_to_pch(STRING_ELT(pch, i % npch)); + } else if (isInteger(pch)) { + ipch = INTEGER(pch)[i % npch]; + } else if (isReal(pch)) { + ipch = R_FINITE(REAL(pch)[i % npch]) ? + (int) REAL(pch)[i % npch] : NA_INTEGER; + } else error(_("invalid plotting symbol")); + /* + * special case for pch = "." + */ + if (ipch == 46) symbolSize = gpCex(currentgp, i); + /* + * FIXME: + * For character-based symbols, we need to modify + * gc->cex so that the FONT size corresponds to + * the specified symbolSize. + */ + GESymbol(xx[i], yy[i], ipch, symbolSize, &gc, dd); + } + } + GEMode(0, dd); + vmaxset(vmax); + return R_NilValue; +} + +SEXP L_clip(SEXP x, SEXP y, SEXP w, SEXP h, SEXP hjust, SEXP vjust) +{ + double xx, yy, ww, hh; + double vpWidthCM, vpHeightCM; + double rotationAngle; + LViewportContext vpc; + R_GE_gcontext gc; + LTransform transform; + SEXP currentvp, currentgp, currentClip; + /* Get the current device + */ + pGEDevDesc dd = getDevice(); + currentvp = gridStateElement(dd, GSS_VP); + currentgp = gridStateElement(dd, GSS_GPAR); + getViewportTransform(currentvp, dd, + &vpWidthCM, &vpHeightCM, + transform, &rotationAngle); + getViewportContext(currentvp, &vpc); + GEMode(1, dd); + /* + * Only set ONE clip rectangle (i.e., NOT vectorised) + */ + gcontextFromgpar(currentgp, 0, &gc, dd); + transformLocn(x, y, 0, vpc, &gc, + vpWidthCM, vpHeightCM, + dd, + transform, + &xx, &yy); + ww = transformWidthtoINCHES(w, 0, vpc, &gc, + vpWidthCM, vpHeightCM, + dd); + hh = transformHeighttoINCHES(h, 0, vpc, &gc, + vpWidthCM, vpHeightCM, + dd); + /* + * We can ONLY clip if the total rotation angle is zero. + */ + if (rotationAngle == 0) { + xx = justifyX(xx, ww, REAL(hjust)[0]); + yy = justifyY(yy, hh, REAL(vjust)[0]); + /* The graphics engine only takes device coordinates + */ + xx = toDeviceX(xx, GE_INCHES, dd); + yy = toDeviceY(yy, GE_INCHES, dd); + ww = toDeviceWidth(ww, GE_INCHES, dd); + hh = toDeviceHeight(hh, GE_INCHES, dd); + if (R_FINITE(xx) && R_FINITE(yy) && + R_FINITE(ww) && R_FINITE(hh)) { + GESetClip(xx, yy, xx + ww, yy + hh, dd); + /* + * ALSO set the current clip region for the + * current viewport so that, if a viewport + * is pushed within the current viewport, + * when that viewport gets popped again, + * the clip region returns to what was set + * by THIS clipGrob (NOT to the current + * viewport's previous setting) + */ + PROTECT(currentClip = allocVector(REALSXP, 4)); + REAL(currentClip)[0] = xx; + REAL(currentClip)[1] = yy; + REAL(currentClip)[2] = xx + ww; + REAL(currentClip)[3] = yy + hh; + SET_VECTOR_ELT(currentvp, PVP_CLIPRECT, currentClip); + UNPROTECT(1); + } + } else { + warning(_("unable to clip to rotated rectangle")); + } + GEMode(0, dd); + return R_NilValue; +} + +SEXP L_pretty(SEXP scale) { + double min = numeric(scale, 0); + double max = numeric(scale, 1); + double temp; + /* FIXME: This is just a dummy pointer because we do not have + * log scales. This will cause death and destruction if it is + * not addressed when log scales are added ! + */ + double *usr = NULL; + double axp[3]; + /* FIXME: Default preferred number of ticks hard coded ! */ + int n = 5; + Rboolean swap = min > max; + /* + * Feature: + * like R, something like xscale = c(100,0) just works + */ + if(swap) { + temp = min; min = max; max = temp; + } + + GEPretty(&min, &max, &n); + + if(swap) { + temp = min; min = max; max = temp; + } + + axp[0] = min; + axp[1] = max; + axp[2] = n; + /* FIXME: "log" flag hard-coded to FALSE because we do not + * have log scales yet + */ + return Rf_CreateAtVector(axp, usr, n, FALSE); +} + +/* + * NOTE: This does not go through the graphics engine, but + * skips straight to the device to obtain a mouse click. + * This is because I do not want to put a GELocator in the + * graphics engine; that would be a crappy long term solution. + * I will wait for a better event-loop/call-back solution before + * doing something with the graphics engine. + * This is a stop gap in the meantime. + * + * The answer is in INCHES + */ + +SEXP L_locator() { + double x = 0; + double y = 0; + SEXP answer; + /* Get the current device + */ + pGEDevDesc dd = getDevice(); + GEMode(2, dd); + PROTECT(answer = allocVector(REALSXP, 2)); + /* + * Get a mouse click + * Fails if user did not click mouse button 1 + */ + if(dd->dev->locator && dd->dev->locator(&x, &y, dd->dev)) { + REAL(answer)[0] = fromDeviceX(x, GE_INCHES, dd); + REAL(answer)[1] = fromDeviceY(y, GE_INCHES, dd); + } else { + REAL(answer)[0] = NA_REAL; + REAL(answer)[1] = NA_REAL; + } + GEMode(0, dd); + UNPROTECT(1); + return answer; +} + +/* + * **************************************** + * Calculating boundaries of primitives + * + * **************************************** + */ + +/* + * Return four values representing boundary of set of locations + * in INCHES. + * + * Result is (xmin, xmax, ymin, ymax) + * + * Used for lines, segments, polygons + */ +SEXP L_locnBounds(SEXP x, SEXP y, SEXP theta) +{ + int i, nx, ny, nloc; + double *xx, *yy; + double vpWidthCM, vpHeightCM; + double rotationAngle; + LViewportContext vpc; + R_GE_gcontext gc; + LTransform transform; + SEXP currentvp, currentgp; + SEXP result = R_NilValue; + const void *vmax; + double xmin = DOUBLE_XMAX; + double xmax = -DOUBLE_XMAX; + double ymin = DOUBLE_XMAX; + double ymax = -DOUBLE_XMAX; + double edgex, edgey; + /* Get the current device + */ + pGEDevDesc dd = getDevice(); + currentvp = gridStateElement(dd, GSS_VP); + currentgp = gridStateElement(dd, GSS_GPAR); + getViewportTransform(currentvp, dd, + &vpWidthCM, &vpHeightCM, + transform, &rotationAngle); + getViewportContext(currentvp, &vpc); + nx = unitLength(x); + ny = unitLength(y); + if (ny > nx) + nx = ny; + nloc = 0; + vmax = vmaxget(); + if (nx > 0) { + xx = (double *) R_alloc(nx, sizeof(double)); + yy = (double *) R_alloc(nx, sizeof(double)); + for (i=0; i<nx; i++) { + gcontextFromgpar(currentgp, i, &gc, dd); + xx[i] = transformXtoINCHES(x, i, vpc, &gc, + vpWidthCM, vpHeightCM, + dd); + yy[i] = transformYtoINCHES(y, i, vpc, &gc, + vpWidthCM, vpHeightCM, + dd); + /* + * Determine min/max x/y values + */ + if (R_FINITE(xx[i]) && R_FINITE(yy[i])) { + if (xx[i] < xmin) + xmin = xx[i]; + if (xx[i] > xmax) + xmax = xx[i]; + if (yy[i] < ymin) + ymin = yy[i]; + if (yy[i] > ymax) + ymax = yy[i]; + nloc++; + } + } + } + if (nloc > 0) { + hullEdge(xx, yy, nx, REAL(theta)[0], &edgex, &edgey); + result = allocVector(REALSXP, 4); + /* + * Reverse the scale adjustment (zoom factor) + * when calculating physical value to return to user-level + */ + REAL(result)[0] = edgex / + REAL(gridStateElement(dd, GSS_SCALE))[0]; + REAL(result)[1] = edgey / + REAL(gridStateElement(dd, GSS_SCALE))[0]; + REAL(result)[2] = (xmax - xmin) / + REAL(gridStateElement(dd, GSS_SCALE))[0]; + REAL(result)[3] = (ymax - ymin) / + REAL(gridStateElement(dd, GSS_SCALE))[0]; + } + vmaxset(vmax); + return result; +} + +/* + * **************************************** + * Calculating text metrics + * + * **************************************** + */ +SEXP L_stringMetric(SEXP label) +{ + int i, n; + double vpWidthCM, vpHeightCM; + double rotationAngle; + LViewportContext vpc; + R_GE_gcontext gc; + LTransform transform; + SEXP currentvp, currentgp; + SEXP txt; + SEXP result = R_NilValue; + SEXP ascent = R_NilValue; + SEXP descent = R_NilValue; + SEXP width = R_NilValue; + const void *vmax; + double asc, dsc, wid; + /* Get the current device + */ + pGEDevDesc dd = getDevice(); + currentvp = gridStateElement(dd, GSS_VP); + currentgp = gridStateElement(dd, GSS_GPAR); + getViewportTransform(currentvp, dd, + &vpWidthCM, &vpHeightCM, + transform, &rotationAngle); + getViewportContext(currentvp, &vpc); + /* The label can be a string or an expression: is protected. + */ + txt = label; + if (isSymbol(txt) || isLanguage(txt)) + txt = coerceVector(txt, EXPRSXP); + else if (!isExpression(txt)) + txt = coerceVector(txt, STRSXP); + PROTECT(txt); + n = LENGTH(txt); + vmax = vmaxget(); + PROTECT(ascent = allocVector(REALSXP, n)); + PROTECT(descent = allocVector(REALSXP, n)); + PROTECT(width = allocVector(REALSXP, n)); + if (n > 0) { + for (i=0; i<n; i++) { + gcontextFromgpar(currentgp, i, &gc, dd); + if (isExpression(txt)) + GEExpressionMetric(VECTOR_ELT(txt, i % LENGTH(txt)), &gc, + &asc, &dsc, &wid, + dd); + else + GEStrMetric(CHAR(STRING_ELT(txt, i)), + getCharCE(STRING_ELT(txt, i)), &gc, + &asc, &dsc, &wid, + dd); + /* + * Reverse the scale adjustment (zoom factor) + * when calculating physical value to return to user-level + */ + REAL(ascent)[i] = fromDeviceHeight(asc, GE_INCHES, dd) / + REAL(gridStateElement(dd, GSS_SCALE))[0]; + REAL(descent)[i] = fromDeviceHeight(dsc, GE_INCHES, dd) / + REAL(gridStateElement(dd, GSS_SCALE))[0]; + REAL(width)[i] = fromDeviceWidth(wid, GE_INCHES, dd) / + REAL(gridStateElement(dd, GSS_SCALE))[0]; + } + } + PROTECT(result = allocVector(VECSXP, 3)); + SET_VECTOR_ELT(result, 0, ascent); + SET_VECTOR_ELT(result, 1, descent); + SET_VECTOR_ELT(result, 2, width); + vmaxset(vmax); + UNPROTECT(5); + return result; +} + diff --git a/com.oracle.truffle.r.native/gnur/patch/src/library/grid/src/grid.h b/com.oracle.truffle.r.native/gnur/patch/src/library/grid/src/grid.h new file mode 100644 index 0000000000000000000000000000000000000000..f71c915955a8b1cd23eeea07d886ef567a186298 --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/library/grid/src/grid.h @@ -0,0 +1,639 @@ +/* + * R : A Computer Language for Statistical Data Analysis + * Copyright (C) 2001-3 Paul Murrell + * 2003-2016 The R Core Team + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version. + * + * This program 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 this program; if not, a copy is available at + * https://www.R-project.org/Licenses/ + */ + +#include <R.h> +#include <Rconfig.h> +#include <Rinternals.h> +#include <Rmath.h> + +#include <R_ext/Constants.h> +#include <R_ext/GraphicsEngine.h> + +#include <Rinternals.h> +#ifdef ENABLE_NLS +#include <libintl.h> +#define _(String) dgettext ("grid", String) +#else +#define _(String) (String) +#endif + +/* All grid type names are prefixed with an "L" + * All grid global variable names are prefixed with an "L_" + */ + +/* This information is stored with R's graphics engine so that + * grid can have state information per device and grid output can + * be maintained on multiple devices. + */ + +#define GSS_DEVSIZE 0 +#define GSS_CURRLOC 1 +#define GSS_DL 2 +#define GSS_DLINDEX 3 +#define GSS_DLON 4 +#define GSS_GPAR 5 +#define GSS_GPSAVED 6 +#define GSS_VP 7 +#define GSS_GLOBALINDEX 8 +#define GSS_GRIDDEVICE 9 +#define GSS_PREVLOC 10 +#define GSS_ENGINEDLON 11 +#define GSS_CURRGROB 12 +#define GSS_ENGINERECORDING 13 +/* #define GSS_ASK 14 unused in R >= 2.7.0 */ +#define GSS_SCALE 15 + +/* + * Structure of a viewport + */ +#define VP_X 0 +#define VP_Y 1 +#define VP_WIDTH 2 +#define VP_HEIGHT 3 +#define VP_JUST 4 +#define VP_GP 5 +#define VP_CLIP 6 +#define VP_XSCALE 7 +#define VP_YSCALE 8 +#define VP_ANGLE 9 +#define VP_LAYOUT 10 +#define VP_LPOSROW 11 +#define VP_LPOSCOL 12 +#define VP_VALIDJUST 13 +#define VP_VALIDLPOSROW 14 +#define VP_VALIDLPOSCOL 15 +#define VP_NAME 16 +/* + * Additional structure of a pushedvp + */ +#define PVP_PARENTGPAR 17 +#define PVP_GPAR 18 +#define PVP_TRANS 19 +#define PVP_WIDTHS 20 +#define PVP_HEIGHTS 21 +#define PVP_WIDTHCM 22 +#define PVP_HEIGHTCM 23 +#define PVP_ROTATION 24 +#define PVP_CLIPRECT 25 +#define PVP_PARENT 26 +#define PVP_CHILDREN 27 +#define PVP_DEVWIDTHCM 28 +#define PVP_DEVHEIGHTCM 29 + +/* + * Structure of a layout + */ +#define LAYOUT_NROW 0 +#define LAYOUT_NCOL 1 +#define LAYOUT_WIDTHS 2 +#define LAYOUT_HEIGHTS 3 +#define LAYOUT_RESPECT 4 +#define LAYOUT_VRESPECT 5 +#define LAYOUT_MRESPECT 6 +#define LAYOUT_JUST 7 +#define LAYOUT_VJUST 8 + +#define GP_FILL 0 +#define GP_COL 1 +#define GP_GAMMA 2 +#define GP_LTY 3 +#define GP_LWD 4 +#define GP_CEX 5 +#define GP_FONTSIZE 6 +#define GP_LINEHEIGHT 7 +#define GP_FONT 8 +#define GP_FONTFAMILY 9 +#define GP_ALPHA 10 +#define GP_LINEEND 11 +#define GP_LINEJOIN 12 +#define GP_LINEMITRE 13 +#define GP_LEX 14 +/* + * Keep fontface at the end because it is never used in C code + */ +#define GP_FONTFACE 15 + +/* + * Structure of an arrow description + */ +#define GRID_ARROWANGLE 0 +#define GRID_ARROWLENGTH 1 +#define GRID_ARROWENDS 2 +#define GRID_ARROWTYPE 3 + +typedef double LTransform[3][3]; + +typedef double LLocation[3]; + +typedef enum { + L_adding = 1, + L_subtracting = 2, + L_summing = 3, + L_plain = 4, + L_maximising = 5, + L_minimising = 6, + L_multiplying = 7 +} LNullArithmeticMode; + +/* NOTE: The order of the enums here must match the order of the + * strings in unit.R + */ +typedef enum { + L_NPC = 0, + L_CM = 1, + L_INCHES = 2, + L_LINES = 3, + L_NATIVE = 4, + L_NULL = 5, /* only used in layout specifications (?) */ + L_SNPC = 6, + L_MM = 7, + /* Some units based on TeX's definition thereof + */ + L_POINTS = 8, /* 72.27 pt = 1 in */ + L_PICAS = 9, /* 1 pc = 12 pt */ + L_BIGPOINTS = 10, /* 72 bp = 1 in */ + L_DIDA = 11, /* 1157 dd = 1238 pt */ + L_CICERO = 12, /* 1 cc = 12 dd */ + L_SCALEDPOINTS = 13, /* 65536 sp = 1pt */ + /* Some units which require an object to query for a value. + */ + L_STRINGWIDTH = 14, + L_STRINGHEIGHT = 15, + L_STRINGASCENT = 16, + L_STRINGDESCENT = 17, + /* L_LINES now means multiples of the line height. + * This is multiples of the font size. + */ + L_CHAR = 18, + L_GROBX = 19, + L_GROBY = 20, + L_GROBWIDTH = 21, + L_GROBHEIGHT = 22, + L_GROBASCENT = 23, + L_GROBDESCENT = 24, + /* + * No longer used + */ + L_MYLINES = 103, + L_MYCHAR = 104, + L_MYSTRINGWIDTH = 105, + L_MYSTRINGHEIGHT = 106 +} LUnit; + +typedef enum { + L_LEFT = 0, + L_RIGHT = 1, + L_BOTTOM = 2, + L_TOP = 3, + L_CENTRE = 4, + L_CENTER = 5 +} LJustification; + +/* An arbitrarily-oriented rectangle. + * The vertices are assumed to be in order going anticlockwise + * around the rectangle. + */ +typedef struct { + double x1; + double x2; + double x3; + double x4; + double y1; + double y2; + double y3; + double y4; +} LRect; + +/* A description of the location of a viewport */ +typedef struct { + SEXP x; + SEXP y; + SEXP width; + SEXP height; + double hjust; + double vjust; +} LViewportLocation; + +/* Components of a viewport which provide coordinate information + * for children of the viewport + */ +typedef struct { + double xscalemin; + double xscalemax; + double yscalemin; + double yscalemax; +} LViewportContext; + +/* Evaluation environment */ +#ifndef GRID_MAIN +extern SEXP R_gridEvalEnv; +#else +SEXP R_gridEvalEnv; +#endif + + +/* Functions called by R code + * (from all over the place) + */ +SEXP L_initGrid(SEXP GridEvalEnv); +SEXP L_killGrid(); +SEXP L_gridDirty(); +SEXP L_currentViewport(); +SEXP L_setviewport(SEXP vp, SEXP hasParent); +SEXP L_downviewport(SEXP vp, SEXP strict); +SEXP L_downvppath(SEXP path, SEXP name, SEXP strict); +SEXP L_unsetviewport(SEXP last); +SEXP L_upviewport(SEXP last); +SEXP L_getDisplayList(); +SEXP L_setDisplayList(SEXP dl); +SEXP L_getDLelt(SEXP index); +SEXP L_setDLelt(SEXP value); +SEXP L_getDLindex(); +SEXP L_setDLindex(SEXP index); +SEXP L_getDLon(); +SEXP L_setDLon(SEXP value); +SEXP L_getEngineDLon(); +SEXP L_setEngineDLon(SEXP value); +SEXP L_getCurrentGrob(); +SEXP L_setCurrentGrob(SEXP value); +SEXP L_getEngineRecording(); +SEXP L_setEngineRecording(SEXP value); +SEXP L_currentGPar(); +SEXP L_newpagerecording(); +SEXP L_newpage(); +SEXP L_initGPar(); +SEXP L_initViewportStack(); +SEXP L_initDisplayList(); +SEXP L_convertToNative(SEXP x, SEXP what); +SEXP L_moveTo(SEXP x, SEXP y); +SEXP L_lineTo(SEXP x, SEXP y, SEXP arrow); +SEXP L_lines(SEXP x, SEXP y, SEXP index, SEXP arrow); +SEXP L_segments(SEXP x0, SEXP y0, SEXP x1, SEXP y1, SEXP arrow); +SEXP L_arrows(SEXP x1, SEXP x2, SEXP xnm1, SEXP xn, + SEXP y1, SEXP y2, SEXP ynm1, SEXP yn, + SEXP angle, SEXP length, SEXP ends, SEXP type); +SEXP L_path(SEXP x, SEXP y, SEXP index, SEXP rule); +SEXP L_polygon(SEXP x, SEXP y, SEXP index); +SEXP L_xspline(SEXP x, SEXP y, SEXP s, SEXP o, SEXP a, SEXP rep, SEXP index); +SEXP L_circle(SEXP x, SEXP y, SEXP r); +SEXP L_rect(SEXP x, SEXP y, SEXP w, SEXP h, SEXP hjust, SEXP vjust); +SEXP L_raster(SEXP raster, SEXP x, SEXP y, SEXP w, SEXP h, + SEXP hjust, SEXP vjust, SEXP interpolate); +SEXP L_cap(); +SEXP L_text(SEXP label, SEXP x, SEXP y, SEXP hjust, SEXP vjust, + SEXP rot, SEXP checkOverlap); +SEXP L_points(SEXP x, SEXP y, SEXP pch, SEXP size); +SEXP L_clip(SEXP x, SEXP y, SEXP w, SEXP h, SEXP hjust, SEXP vjust); +SEXP L_pretty(SEXP scale); +SEXP L_locator(); +SEXP L_convert(SEXP x, SEXP whatfrom, + SEXP whatto, SEXP unitto); +SEXP L_layoutRegion(SEXP layoutPosRow, SEXP layoutPosCol); + +SEXP L_stringMetric(SEXP label); + +/* From matrix.c */ +double locationX(LLocation l); + +double locationY(LLocation l); + +void copyTransform(LTransform t1, LTransform t2); + +void invTransform(LTransform t, LTransform invt); + +void identity(LTransform m); + +void translation(double tx, double ty, LTransform m); + +void scaling(double sx, double sy, LTransform m); + +void rotation(double theta, LTransform m); + +void multiply(LTransform m1, LTransform m2, LTransform m); + +void location(double x, double y, LLocation v); + +void trans(LLocation vin, LTransform m, LLocation vout); + +/* From unit.c */ +int isUnitArithmetic(SEXP ua); + +int isUnitList(SEXP ul); + +SEXP unit(double value, int unit); + +double unitValue(SEXP unit, int index); + +int unitUnit(SEXP unit, int index); + +SEXP unitData(SEXP unit, int index); + +int unitLength(SEXP u); + +extern int L_nullLayoutMode; + +double pureNullUnitValue(SEXP unit, int index); + +int pureNullUnit(SEXP unit, int index, pGEDevDesc dd); + +double transformX(SEXP x, int index, LViewportContext vpc, + const pGEcontext gc, + double widthCM, double heightCM, + int nullLMode, int nullAMode, + pGEDevDesc dd); + +double transformY(SEXP y, int index, LViewportContext vpc, + const pGEcontext gc, + double widthCM, double heightCM, + int nullLMode, int nullAMode, + pGEDevDesc dd); + +double transformWidth(SEXP width, int index, LViewportContext vpc, + const pGEcontext gc, + double widthCM, double heightCM, + int nullLMode, int nullAMode, + pGEDevDesc dd); + +double transformHeight(SEXP height, int index, LViewportContext vpc, + const pGEcontext gc, + double widthCM, double heightCM, + int nullLMode, int nullAMode, + pGEDevDesc dd); + +double transformXtoINCHES(SEXP x, int index, LViewportContext vpc, + const pGEcontext gc, + double widthCM, double heightCM, + pGEDevDesc dd); + +double transformYtoINCHES(SEXP y, int index, LViewportContext vpc, + const pGEcontext gc, + double widthCM, double heightCM, + pGEDevDesc dd); + +void transformLocn(SEXP x, SEXP y, int index, LViewportContext vpc, + const pGEcontext gc, + double widthCM, double heightCM, + pGEDevDesc dd, + LTransform t, + double *xx, double *yy); + +double transformWidthtoINCHES(SEXP w, int index, LViewportContext vpc, + const pGEcontext gc, + double widthCM, double heightCM, + pGEDevDesc dd); + +double transformHeighttoINCHES(SEXP h, int index, LViewportContext vpc, + const pGEcontext gc, + double widthCM, double heightCM, + pGEDevDesc dd); + +void transformDimn(SEXP w, SEXP h, int index, LViewportContext vpc, + const pGEcontext gc, + double widthCM, double heightCM, + pGEDevDesc dd, + double rotationAngle, + double *ww, double *hh); + +double transformXYFromINCHES(double location, int unit, + double scalemin, double scalemax, + const pGEcontext gc, + double thisCM, double otherCM, + pGEDevDesc dd); + +double transformWidthHeightFromINCHES(double value, int unit, + double scalemin, double scalemax, + const pGEcontext gc, + double thisCM, double otherCM, + pGEDevDesc dd); + +double transformXYtoNPC(double x, int from, double min, double max); + +double transformWHtoNPC(double x, int from, double min, double max); + +double transformXYfromNPC(double x, int to, double min, double max); + +double transformWHfromNPC(double x, int to, double min, double max); + +/* From just.c */ +double justifyX(double x, double width, double hjust); + +double justifyY(double y, double height, double vjust); + +double convertJust(int vjust); + +void justification(double width, double height, double hjust, double vjust, + double *hadj, double *vadj); + +/* From util.c */ +SEXP getListElement(SEXP list, char *str); + +void setListElement(SEXP list, char *str, SEXP value); + +SEXP getSymbolValue(char *symbolName); + +void setSymbolValue(char *symbolName, SEXP value); + +double numeric(SEXP x, int index); + +void rect(double x1, double x2, double x3, double x4, + double y1, double y2, double y3, double y4, + LRect *r); + +void copyRect(LRect r1, LRect *r); + +int intersect(LRect r1, LRect r2); + +void textRect(double x, double y, SEXP text, int i, + const pGEcontext gc, + double xadj, double yadj, + double rot, pGEDevDesc dd, LRect *r); + +/* From gpar.c */ +double gpFontSize(SEXP gp, int i); + +double gpLineHeight(SEXP gp, int i); + +int gpCol(SEXP gp, int i); + +SEXP gpFillSXP(SEXP gp); + +int gpFill(SEXP gp, int i); + +double gpGamma(SEXP gp, int i); + +int gpLineType(SEXP gp, int i); + +double gpLineWidth(SEXP gp, int i); + +double gpCex(SEXP gp, int i); + +int gpFont(SEXP gp, int i); + +const char* gpFontFamily(SEXP gp, int i); + +SEXP gpFontSXP(SEXP gp); + +SEXP gpFontFamilySXP(SEXP gp); + +SEXP gpFontSizeSXP(SEXP gp); + +SEXP gpLineHeightSXP(SEXP gp); + +void gcontextFromgpar(SEXP gp, int i, const pGEcontext gc, pGEDevDesc dd); + +void initGPar(pGEDevDesc dd); + +/* From viewport.c */ +SEXP viewportX(SEXP vp); + +SEXP viewportY(SEXP vp); + +SEXP viewportWidth(SEXP vp); + +SEXP viewportHeight(SEXP vp); + +SEXP viewportgpar(SEXP vp); + +const char* viewportFontFamily(SEXP vp); + +int viewportFont(SEXP vp); + +double viewportFontSize(SEXP vp); + +double viewportLineHeight(SEXP vp); + +Rboolean viewportClip(SEXP vp); + +SEXP viewportClipRect(SEXP vp); + +double viewportXScaleMin(SEXP vp); + +double viewportXScaleMax(SEXP vp); + +double viewportYScaleMin(SEXP vp); + +double viewportYScaleMax(SEXP vp); + +double viewportHJust(SEXP v); + +double viewportVJust(SEXP vp); + +SEXP viewportLayoutPosRow(SEXP vp); + +SEXP viewportLayoutPosCol(SEXP vp); + +SEXP viewportLayout(SEXP vp); + +SEXP viewportParent(SEXP vp); + +SEXP viewportTransform(SEXP vp); + +SEXP viewportLayoutWidths(SEXP vp); + +SEXP viewportLayoutHeights(SEXP vp); + +SEXP viewportWidthCM(SEXP vp); + +SEXP viewportHeightCM(SEXP vp); + +SEXP viewportRotation(SEXP vp); + +SEXP viewportParent(SEXP vp); + +SEXP viewportChildren(SEXP vp); + +SEXP viewportDevWidthCM(SEXP vp); + +SEXP viewportDevHeightCM(SEXP vp); + +void fillViewportContextFromViewport(SEXP vp, LViewportContext *vpc); + +void copyViewportContext(LViewportContext vpc1, LViewportContext *vpc2); + +void gcontextFromViewport(SEXP vp, const pGEcontext gc, pGEDevDesc dd); + +void calcViewportTransform(SEXP vp, SEXP parent, Rboolean incremental, + pGEDevDesc dd); + +void initVP(pGEDevDesc dd); + +/* From layout.c */ +Rboolean checkPosRowPosCol(SEXP viewport, SEXP parent); + +void calcViewportLayout(SEXP viewport, + double parentWidthCM, + double parentHeightCM, + LViewportContext parentContext, + const pGEcontext parentgc, + pGEDevDesc dd); + +void calcViewportLocationFromLayout(SEXP layoutPosRow, + SEXP layoutPosCol, + SEXP parent, + LViewportLocation *vpl); + +/* From state.c */ +void initDL(pGEDevDesc dd); + +SEXP gridStateElement(pGEDevDesc dd, int elementIndex); + +void setGridStateElement(pGEDevDesc dd, int elementIndex, SEXP value); + +SEXP gridCallback(GEevent task, pGEDevDesc dd, SEXP data); + +int gridRegisterIndex; + + +/* From grid.c */ +SEXP doSetViewport(SEXP vp, + Rboolean topLevelVP, + Rboolean pushing, + pGEDevDesc dd); + +void getDeviceSize(pGEDevDesc dd, double *devWidthCM, double *devHeightCM); + +/* This is, confusingly, a wrapper for GEcurrentDevice */ +pGEDevDesc getDevice(); + +void dirtyGridDevice(pGEDevDesc dd); + +void getViewportTransform(SEXP currentvp, + pGEDevDesc dd, + double *vpWidthCM, double *vpHeightCM, + LTransform transform, double *rotationAngle); + +SEXP L_circleBounds(SEXP x, SEXP y, SEXP r, SEXP theta); +SEXP L_locnBounds(SEXP x, SEXP y, SEXP theta); +SEXP L_rectBounds(SEXP x, SEXP y, SEXP w, SEXP h, SEXP hjust, SEXP vjust, + SEXP theta); +SEXP L_textBounds(SEXP label, SEXP x, SEXP y, + SEXP hjust, SEXP vjust, SEXP rot, SEXP theta); +SEXP L_xsplineBounds(SEXP x, SEXP y, SEXP s, SEXP o, SEXP a, SEXP rep, + SEXP index, SEXP theta); +SEXP L_xsplinePoints(SEXP x, SEXP y, SEXP s, SEXP o, SEXP a, SEXP rep, + SEXP index, SEXP theta); + +/* From unit.c */ +SEXP validUnits(SEXP units); + +/* From gpar.c */ +SEXP L_getGPar(void); +SEXP L_setGPar(SEXP gpars); + diff --git a/com.oracle.truffle.r.native/gnur/patch/src/library/grid/src/just.c b/com.oracle.truffle.r.native/gnur/patch/src/library/grid/src/just.c new file mode 100644 index 0000000000000000000000000000000000000000..92c3ecfcdf124195afd67b45aadc6c7db0e02c63 --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/library/grid/src/just.c @@ -0,0 +1,128 @@ +/* + * R : A Computer Language for Statistical Data Analysis + * Copyright (C) 2001-3 Paul Murrell + * 2003 The R Core Team + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version. + * + * This program 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 this program; if not, a copy is available at + * https://www.R-project.org/Licenses/ + */ + +#include "grid.h" + +/* Modify a location for the correct justification */ + +/* These tranformations assume that x and width are in the same units */ +/* FIXME: I don't think we check anywhere that a horizontal justification + * is not L_BOTTOM or L_TOP (i.e., meaningless). Ditto for checking + * vertical justification. + */ +double justifyX(double x, double width, double hjust) { + return x - width*hjust; + /* + * From when hjust and vjust were enums + * + double result = 0; + switch (hjust) { + case L_LEFT: + result = x; + break; + case L_RIGHT: + result = x - width; + break; + case L_CENTRE: + case L_CENTER: + result = x - width/2; + break; + } + return result; + */ +} + +double justifyY(double y, double height, double vjust) { + return y - height*vjust; + /* + * From when hjust and vjust were enums + * + double result = 0; + switch (vjust) { + case L_BOTTOM: + result = y; + break; + case L_TOP: + result = y - height; + break; + case L_CENTRE: + case L_CENTER: + result = y - height/2; + break; + } + return result; + */ +} + +/* Convert enum justification into 0..1 justification */ +double convertJust(int just) { + double result = 0; + switch (just) { + case L_BOTTOM: + case L_LEFT: + result = 0; + break; + case L_CENTRE: + case L_CENTER: + result = .5; + break; + case L_TOP: + case L_RIGHT: + result = 1; + break; + } + return result; +} + +/* Return the amount of justification required + */ +void justification(double width, double height, double hjust, double vjust, + double *hadj, double *vadj) +{ + *hadj = -width*hjust; + *vadj = -height*vjust; + /* + * From when hjust and vjust were enums + switch (hjust) { + case L_LEFT: + *hadj = 0; + break; + case L_RIGHT: + *hadj = -width; + break; + case L_CENTRE: + case L_CENTER: + *hadj = -width/2; + break; + } + switch (vjust) { + case L_BOTTOM: + *vadj = 0; + break; + case L_TOP: + *vadj = -height; + break; + case L_CENTRE: + case L_CENTER: + *vadj = -height/2; + break; + } + */ +} diff --git a/com.oracle.truffle.r.native/gnur/patch/src/library/grid/src/layout.c b/com.oracle.truffle.r.native/gnur/patch/src/library/grid/src/layout.c new file mode 100644 index 0000000000000000000000000000000000000000..c326f3f686ca91b717bd2082e18a2cc82bf86d38 --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/library/grid/src/layout.c @@ -0,0 +1,648 @@ +/* + * R : A Computer Language for Statistical Data Analysis + * Copyright (C) 2001-3 Paul Murrell + * 2003-2013 The R Core Team + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version. + * + * This program 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 this program; if not, a copy is available at + * https://www.R-project.org/Licenses/ + */ + +#include "grid.h" + +/* This stuff always returns an LViewportLocation in "npc" units + */ + +int layoutNRow(SEXP l) { + return INTEGER(VECTOR_ELT(l, LAYOUT_NROW))[0]; +} + +int layoutNCol(SEXP l) { + return INTEGER(VECTOR_ELT(l, LAYOUT_NCOL))[0]; +} + +SEXP layoutWidths(SEXP l) { + return VECTOR_ELT(l, LAYOUT_WIDTHS); +} + +SEXP layoutHeights(SEXP l) { + return VECTOR_ELT(l, LAYOUT_HEIGHTS); +} + +int layoutRespect(SEXP l) { + return INTEGER(VECTOR_ELT(l, LAYOUT_VRESPECT))[0]; +} + +int* layoutRespectMat(SEXP l) { + return INTEGER(VECTOR_ELT(l, LAYOUT_MRESPECT)); +} + +double layoutHJust(SEXP l) { + return REAL(VECTOR_ELT(l, LAYOUT_VJUST))[0]; +} + +double layoutVJust(SEXP l) { + return REAL(VECTOR_ELT(l, LAYOUT_VJUST))[1]; +} + +Rboolean relativeUnit(SEXP unit, int index, + pGEDevDesc dd) { + return pureNullUnit(unit, index, dd); +} + +void findRelWidths(SEXP layout, int *relativeWidths, + pGEDevDesc dd) +{ + int i; + SEXP widths = layoutWidths(layout); + for (i=0; i<layoutNCol(layout); i++) + relativeWidths[i] = relativeUnit(widths, i, dd); +} + +void findRelHeights(SEXP layout, int *relativeHeights, + pGEDevDesc dd) +{ + int i; + SEXP heights = layoutHeights(layout); + for (i=0; i<layoutNRow(layout); i++) + relativeHeights[i] = relativeUnit(heights, i, dd); +} + +void allocateKnownWidths(SEXP layout, + int *relativeWidths, + double parentWidthCM, double parentHeightCM, + LViewportContext parentContext, + const pGEcontext parentgc, + pGEDevDesc dd, + double *npcWidths, double *widthLeftCM) +{ + int i; + SEXP widths = layoutWidths(layout); + for (i=0; i<layoutNCol(layout); i++) + if (!relativeWidths[i]) { + npcWidths[i] = transformWidth(widths, i, parentContext, + parentgc, + parentWidthCM, parentHeightCM, + 0, 0, dd)*2.54; + *widthLeftCM -= npcWidths[i]; + } +} + +void allocateKnownHeights(SEXP layout, + int *relativeHeights, + double parentWidthCM, double parentHeightCM, + LViewportContext parentContext, + const pGEcontext parentgc, + pGEDevDesc dd, + double *npcHeights, double *heightLeftCM) +{ + int i; + SEXP heights = layoutHeights(layout); + for (i=0; i<layoutNRow(layout); i++) + if (!relativeHeights[i]) { + npcHeights[i] = transformHeight(heights, i, parentContext, + parentgc, + parentWidthCM, parentHeightCM, + 0, 0, dd)*2.54; + *heightLeftCM -= npcHeights[i]; + } +} + +int colRespected(int col, SEXP layout) { + int i; + int result = 0; + int respect = layoutRespect(layout); + int *respectMat = layoutRespectMat(layout); + if (respect == 1) + result = 1; + else + for (i=0; i<layoutNRow(layout); i++) + if (respectMat[col*layoutNRow(layout) + i] != 0) + result = 1; + return result; +} + +int rowRespected(int row, SEXP layout) { + int i; + int result = 0; + int respect = layoutRespect(layout); + int *respectMat = layoutRespectMat(layout); + if (respect == 1) + result = 1; + else + for (i=0; i<layoutNCol(layout); i++) + if (respectMat[i*layoutNRow(layout) + row] != 0) + result = 1; + return result; +} + +/* + * These sum up ALL relative widths and heights (unit = "null") + * Some effort is made to find all truly null units + * (e.g., including a grobwidth unit where the grob's width is null) + */ +double totalWidth(SEXP layout, int *relativeWidths, + LViewportContext parentContext, + const pGEcontext parentgc, + pGEDevDesc dd) +{ + int i; + SEXP widths = layoutWidths(layout); + double totalWidth = 0; + for (i=0; i<layoutNCol(layout); i++) + if (relativeWidths[i]) + totalWidth += transformWidth(widths, i, parentContext, + parentgc, + /* + * NOTE: 0, 0, here is ok + * because we are only + * obtaining "null" units + */ + 0, 0, 1, 0, dd); + return totalWidth; +} + +double totalHeight(SEXP layout, int *relativeHeights, + LViewportContext parentContext, + const pGEcontext parentgc, + pGEDevDesc dd) +{ + int i; + SEXP heights = layoutHeights(layout); + double totalHeight = 0; + for (i=0; i<layoutNRow(layout); i++) + if (relativeHeights[i]) + totalHeight += transformHeight(heights, i, parentContext, + parentgc, + /* + * NOTE: 0, 0, here is ok + * because we are only + * obtaining "null" units + */ + 0, 0, 1, 0, dd); + return totalHeight; +} + +void allocateRespected(SEXP layout, + int *relativeWidths, int *relativeHeights, + double *reducedWidthCM, double *reducedHeightCM, + LViewportContext parentContext, + const pGEcontext parentgc, + pGEDevDesc dd, + double *npcWidths, double *npcHeights) +{ + int i; + SEXP widths = layoutWidths(layout); + SEXP heights = layoutHeights(layout); + int respect = layoutRespect(layout); + double sumWidth = totalWidth(layout, relativeWidths, parentContext, + parentgc, dd); + double sumHeight = totalHeight(layout, relativeHeights, parentContext, + parentgc, dd); + double denom, mult; + double tempWidthCM = *reducedWidthCM; + double tempHeightCM = *reducedHeightCM; + if (respect > 0) { + /* Determine whether aspect ratio of available space is + * bigger or smaller than aspect ratio of layout + */ + // NB: widths could be zero + // if ((tempHeightCM / tempWidthCM) > (sumHeight / sumWidth)) { + if ( tempHeightCM * sumWidth > sumHeight * tempWidthCM) { + denom = sumWidth; + mult = tempWidthCM; + } + else { + denom = sumHeight; + mult = tempHeightCM; + } + /* Allocate respected widths + */ + for (i=0; i<layoutNCol(layout); i++) + if (relativeWidths[i]) + if (colRespected(i, layout)) { + /* + * Special case of respect, but sumHeight = 0. + * Action is to allocate widths as if unrespected. + * Ok to test == 0 because will only be 0 if + * all relative heights are actually exactly 0. + */ + if (sumHeight == 0) { + denom = sumWidth; + mult = tempWidthCM; + } + /* Build a unit SEXP with a single value and no data + */ + npcWidths[i] = pureNullUnitValue(widths, i) / + denom*mult; + *reducedWidthCM -= npcWidths[i]; + } + /* Allocate respected heights + */ + for (i=0; i<layoutNRow(layout); i++) + if (relativeHeights[i]) + if (rowRespected(i, layout)) { + /* + * Special case of respect, but sumWidth = 0. + * Action is to allocate widths as if unrespected. + * Ok to test == 0 because will only be 0 if + * all relative heights are actually exactly 0. + */ + if (sumWidth == 0) { + denom = sumHeight; + mult = tempHeightCM; + } + npcHeights[i] = pureNullUnitValue(heights, i) / + denom*mult; + *reducedHeightCM -= npcHeights[i]; + } + } +} + +void setRespectedZero(SEXP layout, + int *relativeWidths, int *relativeHeights, + double *npcWidths, double *npcHeights) +{ + int i; + for (i=0; i<layoutNCol(layout); i++) + if (relativeWidths[i]) + if (colRespected(i, layout)) + npcWidths[i] = 0; + for (i=0; i<layoutNRow(layout); i++) + if (relativeHeights[i]) + if (rowRespected(i, layout)) + npcHeights[i] = 0; +} + +/* These sum up unrespected relative widths and heights (unit = "null") + */ +double totalUnrespectedWidth(SEXP layout, int *relativeWidths, + LViewportContext parentContext, + const pGEcontext parentgc, + pGEDevDesc dd) +{ + int i; + SEXP widths = layoutWidths(layout); + double totalWidth = 0; + for (i=0; i<layoutNCol(layout); i++) + if (relativeWidths[i]) + if (!colRespected(i, layout)) + totalWidth += transformWidth(widths, i, parentContext, + parentgc, + /* + * NOTE: 0, 0, here is ok + * because we are only + * obtaining "null" units + */ + 0, 0, 1, 0, dd); + return totalWidth; +} + +double totalUnrespectedHeight(SEXP layout, int *relativeHeights, + LViewportContext parentContext, + const pGEcontext parentgc, + pGEDevDesc dd) +{ + int i; + SEXP heights = layoutHeights(layout); + double totalHeight = 0; + for (i=0; i<layoutNRow(layout); i++) + if (relativeHeights[i]) + if (!rowRespected(i, layout)) + totalHeight += transformHeight(heights, i, parentContext, + parentgc, + /* + * NOTE: 0, 0, here is ok + * because we are only + * obtaining "null" units + */ + 0, 0, 1, 0, dd); + return totalHeight; +} + + +void setRemainingWidthZero(SEXP layout, + int *relativeWidths, + double *npcWidths) +{ + int i; + for (i=0; i<layoutNCol(layout); i++) + if (relativeWidths[i]) + if (!colRespected(i, layout)) + npcWidths[i] = 0; +} + +void allocateRemainingWidth(SEXP layout, int *relativeWidths, + double remainingWidthCM, + LViewportContext parentContext, + const pGEcontext parentgc, + pGEDevDesc dd, + double *npcWidths) +{ + int i; + SEXP widths = layoutWidths(layout); + double sumWidth; + sumWidth = totalUnrespectedWidth(layout, relativeWidths, + parentContext, parentgc, dd); + if (sumWidth > 0) { + for (i=0; i<layoutNCol(layout); i++) + if (relativeWidths[i]) + if (!colRespected(i, layout)) + npcWidths[i] = remainingWidthCM* + transformWidth(widths, i, parentContext, parentgc, + /* + * NOTE: 0, 0, here is ok + * because we are only + * obtaining "null" units + */ + 0, 0, 1, 0, dd)/ + sumWidth; + } else { + /* + * If ALL relative widths are zero then they all get + * allocated zero width + */ + setRemainingWidthZero(layout, relativeWidths, npcWidths); + } +} + +void setRemainingHeightZero(SEXP layout, + int *relativeHeights, + double *npcHeights) +{ + int i; + for (i=0; i<layoutNRow(layout); i++) + if (relativeHeights[i]) + if (!rowRespected(i, layout)) + npcHeights[i] = 0; +} + +void allocateRemainingHeight(SEXP layout, int *relativeHeights, + double remainingHeightCM, + LViewportContext parentContext, + const pGEcontext parentgc, + pGEDevDesc dd, + double *npcHeights) +{ + int i; + SEXP heights = layoutHeights(layout); + double sumHeight; + sumHeight = totalUnrespectedHeight(layout, relativeHeights, + parentContext, parentgc, dd); + if (sumHeight > 0) { + for (i=0; i<layoutNRow(layout); i++) + if (relativeHeights[i]) + if (!rowRespected(i, layout)) + npcHeights[i] = remainingHeightCM* + transformHeight(heights, i, parentContext, parentgc, + /* + * NOTE: 0, 0, here is ok + * because we are only + * obtaining "null" units + */ + 0, 0, 1, 0, dd)/ + sumHeight; + } else { + /* + * If ALL relative heights are zero then they all get + * allocated zero height + */ + setRemainingHeightZero(layout, relativeHeights, npcHeights); + } +} + +static double sumDims(double dims[], int from, int to) +{ + int i; + double s = 0; + for (i = from; i < to + 1; i++) + s = s + dims[i]; + return s; +} + +static void subRegion(SEXP layout, + int minrow, int maxrow, int mincol, int maxcol, + double widths[], double heights[], + double parentWidthCM, double parentHeightCM, + double *left, double *bottom, + double *width, double *height) +{ + double hjust = layoutHJust(layout); + double vjust = layoutVJust(layout); + double totalWidth = sumDims(widths, 0, layoutNCol(layout) - 1); + double totalHeight = sumDims(heights, 0, layoutNRow(layout) - 1); + *width = sumDims(widths, mincol, maxcol); + *height = sumDims(heights, minrow, maxrow); + /* widths and heights are in CM */ + *left = parentWidthCM*hjust - totalWidth*hjust + + sumDims(widths, 0, mincol - 1); + *bottom = parentHeightCM*vjust + (1 - vjust)*totalHeight - + sumDims(heights, 0, maxrow); + /* + * From when hjust and vjust were enums + * + switch (layoutHJust(layout)) { + case L_LEFT: + *left = sumDims(widths, 0, mincol - 1); + break; + case L_RIGHT: + *left = 1 - sumDims(widths, mincol, layoutNCol(layout) - 1); + break; + case L_CENTRE: + case L_CENTER: + *left = (0.5 - totalWidth/2) + sumDims(widths, 0, mincol - 1); + break; + } + switch (layoutVJust(layout)) { + case L_BOTTOM: + *bottom = totalHeight - sumDims(heights, 0, maxrow); + break; + case L_TOP: + *bottom = 1 - sumDims(heights, 0, maxrow); + break; + case L_CENTRE: + case L_CENTER: + *bottom = (0.5 - totalHeight/2) + totalHeight + - sumDims(heights, 0, maxrow); + } + */ +} + +void calcViewportLayout(SEXP viewport, + double parentWidthCM, + double parentHeightCM, + LViewportContext parentContext, + const pGEcontext parentgc, + pGEDevDesc dd) +{ + int i; + SEXP currentWidths, currentHeights; + SEXP layout = viewportLayout(viewport); + double *npcWidths = (double *) R_alloc(layoutNCol(layout), sizeof(double)); + double *npcHeights = (double *) R_alloc(layoutNRow(layout), + sizeof(double)); + int *relativeWidths = (int *) R_alloc(layoutNCol(layout), sizeof(int)); + int *relativeHeights = (int *) R_alloc(layoutNRow(layout), sizeof(int)); + double reducedWidthCM = parentWidthCM; + double reducedHeightCM = parentHeightCM; + /* Figure out which rows and cols have relative heights and widths + */ + findRelWidths(layout, relativeWidths, dd); + findRelHeights(layout, relativeHeights, dd); + /* For any width or height which has a unit other than "null" + * we can immediately figure out its physical size. + * We do this and return the widthCM and heightCM + * remaining after these widths and heights have been allocated + */ + allocateKnownWidths(layout, relativeWidths, + parentWidthCM, parentHeightCM, + parentContext, parentgc, + dd, npcWidths, + &reducedWidthCM); + allocateKnownHeights(layout, relativeHeights, + parentWidthCM, parentHeightCM, + parentContext, parentgc, + dd, npcHeights, + &reducedHeightCM); + + /* Now allocate respected widths and heights and return + * widthCM and heightCM remaining + */ + if (reducedWidthCM > 0 || + reducedHeightCM > 0) { + allocateRespected(layout, relativeWidths, relativeHeights, + &reducedWidthCM, &reducedHeightCM, + parentContext, parentgc, dd, + npcWidths, npcHeights); + } else { + /* + * IF EITHER we started with ZERO widthCM and heightCM + * OR we've used up all the widthCM and heightCM + * THEN all respected widths/heights get ZERO + */ + setRespectedZero(layout, relativeWidths, relativeHeights, + npcWidths, npcHeights); + } + /* Now allocate relative widths and heights (unit = "null") + * in the remaining space + */ + if (reducedWidthCM > 0) { + allocateRemainingWidth(layout, relativeWidths, + reducedWidthCM, + parentContext, parentgc, dd, npcWidths); + } else { + /* + * IF EITHER we started with ZERO width + * OR we've used up all the width + * THEN any relative widths get ZERO + */ + setRemainingWidthZero(layout, relativeWidths, npcWidths); + } + if (reducedHeightCM > 0) { + allocateRemainingHeight(layout, relativeHeights, + reducedHeightCM, + parentContext, parentgc, dd, npcHeights); + } else { + /* + * IF EITHER we started with ZERO height + * OR we've used up all the height + * THEN any relative heights get ZERO + */ + setRemainingHeightZero(layout, relativeHeights, npcHeights); + } + /* Record the widths and heights in the viewport + */ + PROTECT(currentWidths = allocVector(REALSXP, layoutNCol(layout))); + PROTECT(currentHeights = allocVector(REALSXP, layoutNRow(layout))); + for (i=0; i<layoutNCol(layout); i++) { + /* Layout widths are stored in CM + */ + REAL(currentWidths)[i] = npcWidths[i]; + } + for (i=0; i<layoutNRow(layout); i++) { + /* Layout heights are stored in CM + */ + REAL(currentHeights)[i] = npcHeights[i]; + } + SET_VECTOR_ELT(viewport, PVP_WIDTHS, currentWidths); + SET_VECTOR_ELT(viewport, PVP_HEIGHTS, currentHeights); + UNPROTECT(2); +} + +Rboolean checkPosRowPosCol(SEXP vp, SEXP parent) +{ + int ncol = layoutNCol(viewportLayout(parent)); + int nrow = layoutNRow(viewportLayout(parent)); + if (!isNull(viewportLayoutPosRow(vp)) && + (INTEGER(viewportLayoutPosRow(vp))[0] < 1 || + INTEGER(viewportLayoutPosRow(vp))[1] > nrow)) + error(_("invalid 'layout.pos.row'")); + if (!isNull(viewportLayoutPosCol(vp)) && + (INTEGER(viewportLayoutPosCol(vp))[0] < 1 || + INTEGER(viewportLayoutPosCol(vp))[1] > ncol)) + error(_("invalid 'layout.pos.col'")); + return TRUE; +} + +void calcViewportLocationFromLayout(SEXP layoutPosRow, + SEXP layoutPosCol, + SEXP parent, + LViewportLocation *vpl) +{ + int minrow, maxrow, mincol, maxcol; + double x, y, width, height; + SEXP vpx, vpy, vpwidth, vpheight; + SEXP layout = viewportLayout(parent); + /* It is possible for ONE of layoutPosRow and layoutPosCol to + * be NULL; this is interpreted as "occupy all rows/cols" + * NOTE: The " - 1" is there because R is 1-based and C is zero-based + */ + if (isNull(layoutPosRow)) { + minrow = 0; + maxrow = layoutNRow(layout) - 1; + } else { + minrow = INTEGER(layoutPosRow)[0] - 1; + maxrow = INTEGER(layoutPosRow)[1] - 1; + } + if (isNull(layoutPosCol)) { + mincol = 0; + maxcol = layoutNCol(layout) - 1; + } else { + mincol = INTEGER(layoutPosCol)[0] - 1; + maxcol = INTEGER(layoutPosCol)[1] - 1; + } + /* Put the relevant values into vpl */ + subRegion(viewportLayout(parent), minrow, maxrow, mincol, maxcol, + REAL(viewportLayoutWidths(parent)), + REAL(viewportLayoutHeights(parent)), + REAL(viewportWidthCM(parent))[0], + REAL(viewportHeightCM(parent))[0], + &x, &y, &width, &height); + /* Layout widths and heights are stored in CM + */ + PROTECT(vpx = unit(x, L_CM)); + vpl->x = vpx; + PROTECT(vpy = unit(y, L_CM)); + vpl->y = vpy; + PROTECT(vpwidth = unit(width, L_CM)); + vpl->width = vpwidth; + PROTECT(vpheight = unit(height, L_CM)); + vpl->height = vpheight; + vpl->hjust = 0; + vpl->vjust = 0; + /* Question: Is there any chance that these newly-allocated + * unit SEXPs will get corrupted after this unprotect ?? + */ + UNPROTECT(4); +} + diff --git a/com.oracle.truffle.r.native/gnur/patch/src/library/grid/src/matrix.c b/com.oracle.truffle.r.native/gnur/patch/src/library/grid/src/matrix.c new file mode 100644 index 0000000000000000000000000000000000000000..a39b22631a777fb86b0edcc8aed7dca22a0ec29d --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/library/grid/src/matrix.c @@ -0,0 +1,154 @@ +/* + * R : A Computer Language for Statistical Data Analysis + * Copyright (C) 2001-3 Paul Murrell + * 2003 The R Core Team + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version. + * + * This program 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 this program; if not, a copy is available at + * https://www.R-project.org/Licenses/ + */ + +#include "grid.h" +#include <math.h> + +/* Code for matrices, matrix multiplication, etc for performing + * 2D affine transformations: translations, scaling, and rotations. + */ + +double locationX(LLocation l) { + return l[0]; +} + +double locationY(LLocation l) { + return l[1]; +} + +void copyTransform(LTransform t1, LTransform t2) +{ + int i, j; + for (i=0; i<3; i++) + for (j=0; j<3; j++) + t2[i][j] = t1[i][j]; +} + +void invTransform(LTransform t, LTransform invt) +{ + double det = t[0][0]*(t[2][2]*t[1][1] - t[2][1]*t[1][2]) - + t[1][0]*(t[2][2]*t[0][1] - t[2][1]*t[0][2]) + + t[2][0]*(t[1][2]*t[0][1] - t[1][1]*t[0][2]); + if (det == 0) + error(_("singular transformation matrix")); + invt[0][0] = 1/det*(t[2][2]*t[1][1] - t[2][1]*t[1][2]); + invt[0][1] = -1/det*(t[2][2]*t[0][1] - t[2][1]*t[0][2]); + invt[0][2] = 1/det*(t[1][2]*t[0][1] - t[1][1]*t[0][2]); + invt[1][0] = -1/det*(t[2][2]*t[1][0] - t[2][0]*t[1][2]); + invt[1][1] = 1/det*(t[2][2]*t[0][0] - t[2][0]*t[0][2]); + invt[1][2] = -1/det*(t[1][2]*t[0][0] - t[1][0]*t[0][2]); + invt[2][0] = 1/det*(t[2][1]*t[1][0] - t[2][0]*t[1][1]); + invt[2][1] = -1/det*(t[2][1]*t[0][0] - t[2][0]*t[0][1]); + invt[2][2] = 1/det*(t[1][1]*t[0][0] - t[1][0]*t[0][1]); +} + +void identity(LTransform m) +{ + int i, j; + for (i=0; i<3; i++) + for (j=0; j<3; j++) + if (i == j) + m[i][j] = 1; + else + m[i][j] = 0; +} + +void translation(double tx, double ty, LTransform m) +{ + identity(m); + m[2][0] = tx; + m[2][1] = ty; +} + +void scaling(double sx, double sy, LTransform m) +{ + identity(m); + m[0][0] = sx; + m[1][1] = sy; +} + +void rotation(double theta, LTransform m) +{ + double thetarad = theta/180*M_PI; + double costheta = cos(thetarad); + double sintheta = sin(thetarad); + identity(m); + m[0][0] = costheta; + m[0][1] = sintheta; + m[1][0] = -sintheta; + m[1][1] = costheta; +} + +void multiply(LTransform m1, LTransform m2, LTransform m) +{ + m[0][0] = m1[0][0]*m2[0][0] + m1[0][1]*m2[1][0] + m1[0][2]*m2[2][0]; + m[0][1] = m1[0][0]*m2[0][1] + m1[0][1]*m2[1][1] + m1[0][2]*m2[2][1]; + m[0][2] = m1[0][0]*m2[0][2] + m1[0][1]*m2[1][2] + m1[0][2]*m2[2][2]; + m[1][0] = m1[1][0]*m2[0][0] + m1[1][1]*m2[1][0] + m1[1][2]*m2[2][0]; + m[1][1] = m1[1][0]*m2[0][1] + m1[1][1]*m2[1][1] + m1[1][2]*m2[2][1]; + m[1][2] = m1[1][0]*m2[0][2] + m1[1][1]*m2[1][2] + m1[1][2]*m2[2][2]; + m[2][0] = m1[2][0]*m2[0][0] + m1[2][1]*m2[1][0] + m1[2][2]*m2[2][0]; + m[2][1] = m1[2][0]*m2[0][1] + m1[2][1]*m2[1][1] + m1[2][2]*m2[2][1]; + m[2][2] = m1[2][0]*m2[0][2] + m1[2][1]*m2[1][2] + m1[2][2]*m2[2][2]; +} + +void location(double x, double y, LLocation v) +{ + v[0] = x; + v[1] = y; + v[2] = 1; +} + +void trans(LLocation vin, LTransform m, LLocation vout) +{ + vout[0] = vin[0]*m[0][0] + vin[1]*m[1][0] + vin[2]*m[2][0]; + vout[1] = vin[0]*m[0][1] + vin[1]*m[1][1] + vin[2]*m[2][1]; + vout[2] = vin[0]*m[0][2] + vin[1]*m[1][2] + vin[2]*m[2][2]; +} + +/* Testing code + * Need to undocument main() below and add #include <math.h> at top of file + * Correct answers are "2.67 2.00 1.00" for m4=identity + * and "0.00 2.00 1.00" for m4=rotation + */ + +/* + main() + { + LLocation v1, v2; + LTransform m1, m2, m3, m4, m5, m6, m7, m8, m9, m10, m11; + location(9, 10, v1); + translation(-5, -6, m1); + scaling(1/7.0, 1/8.0, m2); + scaling(7, 8, m3); + identity(m4); + rotation(3.141592 / 2, m4); + translation(4, 4, m5); + scaling(1/3.0, 1/4.0, m6); + multiply(m1, m2, m7); + multiply(m7, m3, m8); + multiply(m8, m4, m9); + multiply(m9, m5, m10); + multiply(m10, m6, m11); + transform(v1, m11, v2); + printf("%1.2f %1.2f %1.2f\n", v2[0], v2[1], v2[2]); + } +*/ + diff --git a/com.oracle.truffle.r.native/gnur/patch/src/library/grid/src/register.c b/com.oracle.truffle.r.native/gnur/patch/src/library/grid/src/register.c new file mode 100644 index 0000000000000000000000000000000000000000..b30642fa7ecaea8fb50720dae5a9a517ed040f4d --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/library/grid/src/register.c @@ -0,0 +1,99 @@ +/* + * R : A Computer Language for Statistical Data Analysis + * Copyright (C) 2001-3 Paul Murrell + * 2003-2017 The R Core Team + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version. + * + * This program 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 this program; if not, a copy is available at + * https://www.R-project.org/Licenses/ + */ + +/* Code to register grid functions with R + */ +#include <R_ext/Visibility.h> +#include <R_ext/Rdynload.h> +#include "grid.h" + +#define LCALLDEF(name, n) {#name, (DL_FUNC) &L_##name, n} + +static const R_CallMethodDef callMethods[] = { + LCALLDEF(initGrid, 1), + LCALLDEF(killGrid, 0), + LCALLDEF(gridDirty, 0), + LCALLDEF(currentViewport, 0), + LCALLDEF(setviewport, 2), + LCALLDEF(downviewport, 2), + LCALLDEF(downvppath, 3), + LCALLDEF(unsetviewport, 1), + LCALLDEF(upviewport, 1), + LCALLDEF(getDisplayList, 0), + LCALLDEF(setDisplayList, 1), + LCALLDEF(getDLelt, 1), + LCALLDEF(setDLelt, 1), + LCALLDEF(getDLindex, 0), + LCALLDEF(setDLindex, 1), + LCALLDEF(getDLon, 0), + LCALLDEF(setDLon, 1), + LCALLDEF(getEngineDLon, 0), + LCALLDEF(setEngineDLon, 1), + LCALLDEF(getCurrentGrob, 0), + LCALLDEF(setCurrentGrob, 1), + LCALLDEF(getEngineRecording, 0), + LCALLDEF(setEngineRecording, 1), + LCALLDEF(currentGPar, 0), + LCALLDEF(newpagerecording, 0), + LCALLDEF(newpage, 0), + LCALLDEF(initGPar, 0), + LCALLDEF(initViewportStack, 0), + LCALLDEF(initDisplayList, 0), + LCALLDEF(moveTo, 2), + LCALLDEF(lineTo, 3), + LCALLDEF(lines, 4), + LCALLDEF(segments, 5), + LCALLDEF(arrows, 12), + LCALLDEF(path, 4), + LCALLDEF(polygon, 3), + LCALLDEF(xspline, 7), + LCALLDEF(circle, 3), + LCALLDEF(rect, 6), + LCALLDEF(raster, 8), + LCALLDEF(cap, 0), + LCALLDEF(text, 7), + LCALLDEF(points, 4), + LCALLDEF(clip, 6), + LCALLDEF(pretty, 1), + LCALLDEF(locator, 0), + LCALLDEF(convert, 4), + LCALLDEF(layoutRegion, 2), + LCALLDEF(getGPar, 0), + LCALLDEF(setGPar, 1), + LCALLDEF(circleBounds, 4), + LCALLDEF(locnBounds, 3), + LCALLDEF(rectBounds, 7), + LCALLDEF(textBounds, 7), + LCALLDEF(xsplineBounds, 8), + LCALLDEF(xsplinePoints, 8), + LCALLDEF(stringMetric, 1), + {"validUnits", (DL_FUNC) &validUnits, 1}, + { NULL, NULL, 0 } +}; + + +void attribute_visible R_init_grid(DllInfo *dll) +{ + /* No .C, .Fortran, or .External routines => NULL + */ + R_registerRoutines(dll, NULL, callMethods, NULL, NULL); + R_useDynamicSymbols(dll, FALSE); + R_forceSymbols(dll, FALSE); +} diff --git a/com.oracle.truffle.r.native/gnur/patch/src/library/grid/src/state.c b/com.oracle.truffle.r.native/gnur/patch/src/library/grid/src/state.c new file mode 100644 index 0000000000000000000000000000000000000000..f965a0d13707827dc81cfb8f32ae2058b7bd630a --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/library/grid/src/state.c @@ -0,0 +1,430 @@ +/* + * R : A Computer Language for Statistical Data Analysis + * Copyright (C) 2001-3 Paul Murrell + * 2003-5 The R Core Team + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version. + * + * This program 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 this program; if not, a copy is available at + * https://www.R-project.org/Licenses/ + */ + +#include "grid.h" +#include <string.h> + +int gridRegisterIndex; + +/* The gridSystemState (per device) consists of + * GSS_DEVSIZE 0 = current size of device + * GSS_CURRLOC 1 = current location of grid "pen" + * GSS_DL 2 = grid display list + * GSS_DLINDEX 3 = display list index + * GSS_DLON 4 = is the display list on? + * GSS_GPAR 5 = gpar settings + * GSS_GPSAVED 6 = previous gpar settings + * GSS_VP 7 = viewport + * GSS_GLOBALINDEX 8 = index of this system state in the global list of states + * GSS_GRIDDEVICE 9 = does this device contain grid output? + * GSS_PREVLOC 10 = previous location of grid "pen" + * GSS_ENGINEDLON 11 = are we using the graphics engine's display list? + * GSS_CURRGROB 12 = current grob being drawn (for determining + * the list of grobs to search when evaluating a grobwidth/height + * unit via gPath) + * GSS_ENGINERECORDING 13 = are we already inside a .Call.graphics call? + * Used by grid.Call.graphics to avoid unnecessary recording on + * engine display list + * [GSS_ASK 14 = should we prompt the user before starting a new page? + * Replaced by per-device setting as from R 2.7.0.] + * GSS_SCALE 15 = a scale or "zoom" factor for all output + * (to support "fit to window" resizing on windows device) + * + * NOTE: if you add to this list you MUST change the size of the vector + * allocated in createGridSystemState() below. +*/ + +SEXP createGridSystemState() +{ + return allocVector(VECSXP, 16); +} + +void initDL(pGEDevDesc dd) +{ + SEXP dl, dlindex; + SEXP vp = gridStateElement(dd, GSS_VP); + SEXP gsd = (SEXP) dd->gesd[gridRegisterIndex]->systemSpecific; + /* The top-level viewport goes at the start of the display list + */ + PROTECT(dl = allocVector(VECSXP, 100)); + SET_VECTOR_ELT(dl, 0, vp); + SET_VECTOR_ELT(gsd, GSS_DL, dl); + PROTECT(dlindex = allocVector(INTSXP, 1)); + INTEGER(dlindex)[0] = 1; + SET_VECTOR_ELT(gsd, GSS_DLINDEX, dlindex); + UNPROTECT(2); +} + +/* + * This is used to init some bits of the system state + * Called when a grahpics engine redraw is about to occur + * NOTE that it does not init all of the state, in particular, + * the display list is not initialised here (see initDL), + * nor is the ROOT viewport (see initVP), + * nor is the current gpar (see initGP) + */ +void initOtherState(pGEDevDesc dd) +{ + SEXP currloc, prevloc, recording; + SEXP state = (SEXP) dd->gesd[gridRegisterIndex]->systemSpecific; + currloc = VECTOR_ELT(state, GSS_CURRLOC); + REAL(currloc)[0] = NA_REAL; + REAL(currloc)[1] = NA_REAL; + prevloc = VECTOR_ELT(state, GSS_PREVLOC); + REAL(prevloc)[0] = NA_REAL; + REAL(prevloc)[1] = NA_REAL; + SET_VECTOR_ELT(state, GSS_CURRGROB, R_NilValue); + recording = VECTOR_ELT(state, GSS_ENGINERECORDING); + LOGICAL(recording)[0] = FALSE; + SET_VECTOR_ELT(state, GSS_ENGINERECORDING, recording); +} + +void fillGridSystemState(SEXP state, pGEDevDesc dd) +{ + SEXP devsize, currloc, prevloc; + + PROTECT(state); + devsize = allocVector(REALSXP, 2); + REAL(devsize)[0] = 0; + REAL(devsize)[1] = 0; + SET_VECTOR_ELT(state, GSS_DEVSIZE, devsize); + /* "current location" + * Initial setting relies on the fact that all values sent to devices + * are in INCHES; so (0, 0) is the bottom-left corner of the device. + */ + currloc = allocVector(REALSXP, 2); + REAL(currloc)[0] = NA_REAL; + REAL(currloc)[1] = NA_REAL; + SET_VECTOR_ELT(state, GSS_CURRLOC, currloc); + prevloc = allocVector(REALSXP, 2); + REAL(prevloc)[0] = NA_REAL; + REAL(prevloc)[1] = NA_REAL; + SET_VECTOR_ELT(state, GSS_PREVLOC, prevloc); + SET_VECTOR_ELT(state, GSS_DLON, ScalarLogical(TRUE)); + SET_VECTOR_ELT(state, GSS_ENGINEDLON, ScalarLogical(TRUE)); + SET_VECTOR_ELT(state, GSS_CURRGROB, R_NilValue); + SET_VECTOR_ELT(state, GSS_ENGINERECORDING, ScalarLogical(FALSE)); + initGPar(dd); + SET_VECTOR_ELT(state, GSS_GPSAVED, R_NilValue); + /* Do NOT initialise top-level viewport or grid display list for + * this device until there is some grid output + */ + SET_VECTOR_ELT(state, GSS_GLOBALINDEX, R_NilValue); + /* Note that no grid output has occurred on the device yet. + */ + SET_VECTOR_ELT(state, GSS_GRIDDEVICE, ScalarLogical(FALSE)); +#if 0 + SET_VECTOR_ELT(state, GSS_ASK, ScalarLogical(dd->ask)); +#endif + SET_VECTOR_ELT(state, GSS_SCALE, ScalarReal(1.0)); + UNPROTECT(1); +} + +SEXP gridStateElement(pGEDevDesc dd, int elementIndex) +{ + return VECTOR_ELT((SEXP) dd->gesd[gridRegisterIndex]->systemSpecific, + elementIndex); +} + +void setGridStateElement(pGEDevDesc dd, int elementIndex, SEXP value) +{ + SET_VECTOR_ELT((SEXP) dd->gesd[gridRegisterIndex]->systemSpecific, + elementIndex, value); +} + +static void deglobaliseState(SEXP state) +{ + int index = INTEGER(VECTOR_ELT(state, GSS_GLOBALINDEX))[0]; + SET_VECTOR_ELT(findVar(install(".GRID.STATE"), R_gridEvalEnv), + index, R_NilValue); +} + +static int findStateSlot() +{ + int i; + int result = -1; + SEXP globalstate = findVar(install(".GRID.STATE"), R_gridEvalEnv); + for (i = 0; i < length(globalstate); i++) + if (VECTOR_ELT(globalstate, i) == R_NilValue) { + result = i; + break; + } + if (result < 0) + error(_("unable to store 'grid' state. Too many devices open?")); + return result; +} + +static void globaliseState(SEXP state) +{ + int index = findStateSlot(); + SEXP globalstate, indexsxp; + PROTECT(globalstate = findVar(install(".GRID.STATE"), R_gridEvalEnv)); + /* Record the index for deglobalisation + */ + PROTECT(indexsxp = allocVector(INTSXP, 1)); + INTEGER(indexsxp)[0] = index; + SET_VECTOR_ELT(state, GSS_GLOBALINDEX, indexsxp); + SET_VECTOR_ELT(globalstate, index, state); + UNPROTECT(2); +} + +SEXP gridCallback(GEevent task, pGEDevDesc dd, SEXP data) { + SEXP result = R_NilValue; + SEXP valid, scale; + SEXP gridState; + GESystemDesc *sd; + SEXP currentgp; + SEXP gsd; + SEXP devsize; + R_GE_gcontext gc; + switch (task) { + case GE_InitState: + /* Create the initial grid state for a device + */ + PROTECT(gridState = createGridSystemState()); + /* Store that state with the device for easy retrieval + */ + sd = dd->gesd[gridRegisterIndex]; + sd->systemSpecific = (void*) gridState; + /* Initialise the grid state for a device + */ + fillGridSystemState(gridState, dd); + /* Also store the state beneath a top-level variable so + * that it does not get garbage-collected + */ + globaliseState(gridState); + /* Indicate success */ + result = R_BlankString; + UNPROTECT(1); + break; + case GE_FinaliseState: + sd = dd->gesd[gridRegisterIndex]; + /* Simply detach the system state from the global variable + * and it will be garbage-collected + */ + deglobaliseState((SEXP) sd->systemSpecific); + /* Also set the device pointer to NULL + */ + sd->systemSpecific = NULL; + break; + case GE_SaveState: + break; + case GE_RestoreState: + gsd = (SEXP) dd->gesd[gridRegisterIndex]->systemSpecific; + PROTECT(devsize = allocVector(REALSXP, 2)); + getDeviceSize(dd, &(REAL(devsize)[0]), &(REAL(devsize)[1])); + SET_VECTOR_ELT(gsd, GSS_DEVSIZE, devsize); + UNPROTECT(1); + /* Only bother to do any grid drawing setup + * if there has been grid output + * on this device. + */ + if (LOGICAL(gridStateElement(dd, GSS_GRIDDEVICE))[0]) { + if (LOGICAL(gridStateElement(dd, GSS_ENGINEDLON))[0]) { + /* The graphics engine is about to replay the display list + * So we "clear" the device and reset the grid graphics state + */ + /* + * ONLY start a new page if 'grid' drawing is first entry + * on the DL. + * Determine this by checking for "C_par" or "C_plot_new" + * at head of DL (assumes that 'graphics' is only other + * possible graphics system). + * This is a NASTY solution to a RARE problem. + * RARE because it will only occur when resizing a + * window, copying between devices, or replaying a + * recorded plot when the engine DL contains a mix + * of 'graphics' and 'grid'. + * NASTY because it requires 'grid' to know about + * 'graphics' internals and the engine DL internals. + */ + /* 'data' is engine DL */ + if (data != R_NilValue) { + SEXP firstDLentry = CAR(data); + SEXP args = CADR(firstDLentry); + int newpage = 1; + if (isVector(CAR(args))) { + SEXP name = VECTOR_ELT(CAR(args), 0); + if (isString(name) && + (!strcmp(CHAR(STRING_ELT(name, 0)), + "C_par") || + !strcmp(CHAR(STRING_ELT(name, 0)), + "C_plot_new"))) { + newpage = 0; + } + } + if (newpage) { + currentgp = gridStateElement(dd, GSS_GPAR); + gcontextFromgpar(currentgp, 0, &gc, dd); + GENewPage(&gc, dd); + } + } + initGPar(dd); + initVP(dd); + initOtherState(dd); + } else { + /* + * If we have turned off the graphics engine's display list + * then we have to redraw the scene ourselves + */ + SEXP fcall; + PROTECT(fcall = lang1(install("draw.all"))); + eval(fcall, R_gridEvalEnv); + UNPROTECT(1); + } + } + break; + case GE_CopyState: + { + if (!isNull(gridStateElement(dd, GSS_DL))) { + int dlIndex = INTEGER(gridStateElement(dd, GSS_DLINDEX))[0]; + if (dlIndex > 0) { + /* called from GEcopyDisplayList */ + pGEDevDesc curdd = GEcurrentDevice(); + /* See GE_RestoreSnapshotState for explanation of this + * dirtying + */ + SEXP gsd, griddev; + gsd = (SEXP) curdd->gesd[gridRegisterIndex]->systemSpecific; + PROTECT(griddev = allocVector(LGLSXP, 1)); + LOGICAL(griddev)[0] = TRUE; + SET_VECTOR_ELT(gsd, GSS_GRIDDEVICE, griddev); + UNPROTECT(1); + GEdirtyDevice(curdd); + setGridStateElement(curdd, GSS_DL, + gridStateElement(dd, GSS_DL)); + setGridStateElement(curdd, GSS_DLINDEX, + gridStateElement(dd, GSS_DLINDEX)); + } + } + } + break; + case GE_CheckPlot: + PROTECT(valid = allocVector(LGLSXP, 1)); + LOGICAL(valid)[0] = TRUE; + UNPROTECT(1); + result = valid; + break; + case GE_SaveSnapshotState: + { + SEXP pkgName; + /* + * Save the current 'grid' DL. + */ + PROTECT(result = allocVector(VECSXP, 2)); + SET_VECTOR_ELT(result, 0, gridStateElement(dd, GSS_DL)); + SET_VECTOR_ELT(result, 1, gridStateElement(dd, GSS_DLINDEX)); + PROTECT(pkgName = mkString("grid")); + setAttrib(result, install("pkgName"), pkgName); + UNPROTECT(2); + } + break; + case GE_RestoreSnapshotState: + { + int i, nState = LENGTH(data) - 1; + SEXP gridState, snapshotEngineVersion; + PROTECT(gridState = R_NilValue); + /* Prior to engine version 11, "pkgName" was not stored. + * (can tell because "engineVersion" was not stored either.) + * Assume 'grid' is second state in snapshot + * (or first, if only one state) + * (though this could be fatal). + */ + PROTECT(snapshotEngineVersion = + getAttrib(data, install("engineVersion"))); + if (isNull(snapshotEngineVersion)) { + gridState = VECTOR_ELT(data, imin2(nState, 2)); + } else { + for (i=0; i<nState; i++) { + SEXP state = VECTOR_ELT(data, i + 1); + if (!strcmp(CHAR(STRING_ELT(getAttrib(state, + install("pkgName")), + 0)), + "grid")) { + gridState = state; + } + } + } + /* The recorded plot may have been recorded WITHOUT 'grid' loaded + * OR it might have been recorded with 'grid' loaded, but WITHOUT + * any grid drawing + */ + if (!isNull(gridState) && !isNull(VECTOR_ELT(gridState, 0))) { + int dlIndex = INTEGER(VECTOR_ELT(gridState, 1))[0]; + if (dlIndex > 0) { + /* + * Dirty the device, in a 'grid' sense, + * (in case this is first 'grid' drawing on device) + * to stop first element on 'grid' DL + * (which will be a call to L_gridDirty()) + * from resetting the 'grid' DL. + * This will have the side effect of stopping L_gridDirty() + * from starting a new page (if the device is clean) + * which is important because this + * GE_RestoreSnapshotState will be followed by + * GE_RestoreState, which will start a new page + * (and which will call initVP() by the way). + * + * NOTE to my future self: don't try to do this with + * a call to dirtyGridDevice() - seriously, I tried it + * and it's a BAD idea. The logic and interactions + * with device drivers is just insanely complicated. + * Leave it alone. + */ + if (!LOGICAL(gridStateElement(dd, GSS_GRIDDEVICE))[0]) { + SEXP gsd, griddev; + gsd = (SEXP) dd->gesd[gridRegisterIndex]->systemSpecific; + PROTECT(griddev = allocVector(LGLSXP, 1)); + LOGICAL(griddev)[0] = TRUE; + SET_VECTOR_ELT(gsd, GSS_GRIDDEVICE, griddev); + UNPROTECT(1); + /* If the device is 'grid' dirty, make sure it is + * also dirty overall + */ + GEdirtyDevice(dd); + } + /* + * Restore the saved 'grid' DL. + * (the 'grid' vpTree will be recreated by replay of + * 'grid' DL) + */ + setGridStateElement(dd, GSS_DL, + VECTOR_ELT(gridState, 0)); + setGridStateElement(dd, GSS_DLINDEX, + VECTOR_ELT(gridState, 1)); + } + } + UNPROTECT(2); + } + break; + case GE_ScalePS: + /* + * data is a numeric scale factor + */ + PROTECT(scale = allocVector(REALSXP, 1)); + REAL(scale)[0] = REAL(gridStateElement(dd, GSS_SCALE))[0]* + REAL(data)[0]; + setGridStateElement(dd, GSS_SCALE, scale); + UNPROTECT(1); + break; + } + return result; +} + diff --git a/com.oracle.truffle.r.native/gnur/patch/src/library/grid/src/unit.c b/com.oracle.truffle.r.native/gnur/patch/src/library/grid/src/unit.c new file mode 100644 index 0000000000000000000000000000000000000000..bfd34144575bd927402cca1a018648e5473b0782 --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/library/grid/src/unit.c @@ -0,0 +1,1920 @@ +/* + * R : A Computer Language for Statistical Data Analysis + * Copyright (C) 2001-3 Paul Murrell + * 2003-2016 The R Core Team + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version. + * + * This program 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 this program; if not, a copy is available at + * https://www.R-project.org/Licenses/ + */ + +#include "grid.h" +#include <math.h> +#include <float.h> +#include <string.h> + +int isUnitArithmetic(SEXP ua) { + return inherits(ua, "unit.arithmetic"); +} + +int isUnitList(SEXP ul) { + return inherits(ul, "unit.list"); +} + +/* Function to build a single-value unit SEXP internally. + * Cannot build units requiring data as yet. + */ +SEXP unit(double value, int unit) +{ + SEXP u, units, classname; + PROTECT(u = ScalarReal(value)); + PROTECT(units = ScalarInteger(unit)); + /* NOTE that we do not set the "unit" attribute */ + setAttrib(u, install("valid.unit"), units); + setAttrib(u, install("data"), R_NilValue); + PROTECT(classname = mkString("unit")); + classgets(u, classname); + UNPROTECT(3); + return u; +} + +/* Accessor functions for unit objects + */ + +/* + * This is an attempt to extract a single numeric value from + * a unit. This is ONLY designed for use on "simple" units + * (i.e., NOT unitLists or unitArithmetics) + */ +double unitValue(SEXP unit, int index) { + /* Recycle values if necessary (used in unit arithmetic) + */ + int n = LENGTH(unit); + return numeric(unit, index % n); +} + +int unitUnit(SEXP unit, int index) { + SEXP units = getAttrib(unit, install("valid.unit")); + /* Recycle units if necessary + */ + int n = LENGTH(units); + return INTEGER(units)[index % n]; +} + +SEXP unitData(SEXP unit, int index) { + SEXP result; + SEXP data = getAttrib(unit, install("data")); + if (isNull(data)) + result = R_NilValue; + else if(TYPEOF(data) == VECSXP) { + /* Recycle data if necessary + */ + int n = LENGTH(data); + result = VECTOR_ELT(data, index % n); + } else { + warning("unit attribute 'data' is of incorrect type"); + return R_NilValue; + } + return result; +} + +/* Accessor functions for unit arithmetic object + */ +const char* fName(SEXP ua) { + return CHAR(STRING_ELT(getListElement(ua, "fname"), 0)); +} + +SEXP arg1(SEXP ua) { + return getListElement(ua, "arg1"); +} + +SEXP arg2(SEXP ua) { + return getListElement(ua, "arg2"); +} + +int fNameMatch(SEXP ua, char *aString) { + return !strcmp(fName(ua), aString); +} + +int addOp(SEXP ua) { + return fNameMatch(ua, "+"); +} + +int minusOp(SEXP ua) { + return fNameMatch(ua, "-"); +} + +int timesOp(SEXP ua) { + return fNameMatch(ua, "*"); +} + +int fOp(SEXP ua) { + return addOp(ua) || minusOp(ua) || timesOp(ua); +} + +int minFunc(SEXP ua) { + return fNameMatch(ua, "min"); +} + +int maxFunc(SEXP ua) { + return fNameMatch(ua, "max"); +} + +int sumFunc(SEXP ua) { + return fNameMatch(ua, "sum"); +} + +/* Functions in lattice.c should use this to determine the length + * of a unit/unitArithmetic object rather than just LENGTH. + */ +int unitLength(SEXP u) +{ + int result = 0; + if (isUnitList(u)) + result = LENGTH(u); + else if (isUnitArithmetic(u)) + if (fOp(u)) { + if (timesOp(u)) { + /* + * arg1 is always the numeric vector + */ + int n1 = LENGTH(arg1(u)); + int n2 = unitLength(arg2(u)); + result = (n1 > n2) ? n1 : n2; + } else { /* must be "+" or "-" */ + int n1 = unitLength(arg1(u)); + int n2 = unitLength(arg2(u)); + result = (n1 > n2) ? n1 : n2; + } + } else /* must be "min" or "max" or "sum" */ + result = 1; /* unitLength(arg1(u)); */ + else /* Must be a unit object */ + result = LENGTH(u); + return result; +} + + +/************************** + * Code for handling "null" units + ************************** + */ + +/* Global mode indicators: + * The value returned for a "null" unit depends on ... + * (i) whether layout is calling for evaluation of a "pure null" unit + * (in which case, the value of the "null" unit is returned) + * (ii) the sort of arithmetic that is being performed + * (in which case, an "identity" value is returned) + */ + +/* + * Evaluate a "null" _value_ dependent on the evaluation context + */ +static double evaluateNullUnit(double value, double thisCM, + int nullLayoutMode, int nullArithmeticMode) { + double result = value; + if (!nullLayoutMode) + switch (nullArithmeticMode) { + case L_plain: + case L_adding: + case L_subtracting: + case L_summing: + result = 0; + break; + case L_multiplying: + result = 0; + break; + case L_maximising: + result = 0; + break; + case L_minimising: + result = thisCM; + break; + } + return result; +} + +/* + * Evaluate a "null" _unit_ + * This is used by layout code to get a single "null" _value_ + * from a pureNullUnit (which may be a unitList or a unitArithmetic) + * + * This must ONLY be called on a unit which has passed the + * pureNullUnit test below. + */ +double pureNullUnitValue(SEXP unit, int index) +{ + double result = 0; + if (isUnitArithmetic(unit)) { + int i; + if (addOp(unit)) { + result = pureNullUnitValue(arg1(unit), index) + + pureNullUnitValue(arg2(unit), index); + } + else if (minusOp(unit)) { + result = pureNullUnitValue(arg1(unit), index) - + pureNullUnitValue(arg2(unit), index); + } + else if (timesOp(unit)) { + result = REAL(arg1(unit))[index] * + pureNullUnitValue(arg2(unit), index); + } + else if (minFunc(unit)) { + int n = unitLength(arg1(unit)); + double temp = DBL_MAX; + result = pureNullUnitValue(arg1(unit), 0); + for (i=1; i<n; i++) { + temp = pureNullUnitValue(arg1(unit), i); + if (temp < result) + result = temp; + } + } + else if (maxFunc(unit)) { + int n = unitLength(arg1(unit)); + double temp = DBL_MIN; + result = pureNullUnitValue(arg1(unit), 0); + for (i=1; i<n; i++) { + temp = pureNullUnitValue(arg1(unit), i); + if (temp > result) + result = temp; + } + } + else if (sumFunc(unit)) { + int n = unitLength(arg1(unit)); + result = 0.0; + for (i=0; i<n; i++) { + result += pureNullUnitValue(arg1(unit), i); + } + } + else + error(_("unimplemented unit function")); + } else if (isUnitList(unit)) { + /* + * Recycle if necessary; it is up to the calling code + * to limit indices to unit length if desired + */ + int n = unitLength(unit); + result = pureNullUnitValue(VECTOR_ELT(unit, index % n), 0); + } else + result = unitValue(unit, index); + return result; +} + +int pureNullUnitArithmetic(SEXP unit, int index, pGEDevDesc dd); + +int pureNullUnit(SEXP unit, int index, pGEDevDesc dd) { + int result; + if (isUnitArithmetic(unit)) + result = pureNullUnitArithmetic(unit, index, dd); + else if (isUnitList(unit)) { + /* + * Recycle if necessary; it is up to the calling code + * to limit indices to unit length if desired + */ + int n = unitLength(unit); + result = pureNullUnit(VECTOR_ELT(unit, index % n), 0, dd); + } else { /* Just a plain unit */ + /* Special case: if "grobwidth" or "grobheight" unit + * and width/height(grob) is pure null + */ + if (unitUnit(unit, index) == L_GROBWIDTH) { + SEXP grob, updatedgrob, width; + SEXP widthPreFn, widthFn, widthPostFn, findGrobFn; + SEXP R_fcall0, R_fcall1, R_fcall2, R_fcall3; + SEXP savedgpar, savedgrob; + /* + * The data could be a gPath to a grob + * In this case, need to find the grob first, and in order + * to do that correctly, need to call pre/postDraw code + */ + PROTECT(grob = unitData(unit, index)); + PROTECT(savedgpar = gridStateElement(dd, GSS_GPAR)); + PROTECT(savedgrob = gridStateElement(dd, GSS_CURRGROB)); + PROTECT(widthPreFn = findFun(install("preDraw"), + R_gridEvalEnv)); + PROTECT(widthFn = findFun(install("width"), R_gridEvalEnv)); + PROTECT(widthPostFn = findFun(install("postDraw"), + R_gridEvalEnv)); + if (inherits(grob, "gPath")) { + if (isNull(savedgrob)) { + PROTECT(findGrobFn = findFun(install("findGrobinDL"), + R_gridEvalEnv)); + PROTECT(R_fcall0 = lang2(findGrobFn, + getListElement(grob, "name"))); + grob = eval(R_fcall0, R_gridEvalEnv); + } else { + PROTECT(findGrobFn =findFun(install("findGrobinChildren"), + R_gridEvalEnv)); + PROTECT(R_fcall0 = lang3(findGrobFn, + getListElement(grob, "name"), + getListElement(savedgrob, + "children"))); + grob = eval(R_fcall0, R_gridEvalEnv); + } + UNPROTECT(2); + } + PROTECT(R_fcall1 = lang2(widthPreFn, grob)); + PROTECT(updatedgrob = eval(R_fcall1, R_gridEvalEnv)); + PROTECT(R_fcall2 = lang2(widthFn, updatedgrob)); + PROTECT(width = eval(R_fcall2, R_gridEvalEnv)); + result = pureNullUnit(width, 0, dd); + PROTECT(R_fcall3 = lang2(widthPostFn, updatedgrob)); + eval(R_fcall3, R_gridEvalEnv); + setGridStateElement(dd, GSS_GPAR, savedgpar); + setGridStateElement(dd, GSS_CURRGROB, savedgrob); + UNPROTECT(11); + } else if (unitUnit(unit, index) == L_GROBHEIGHT) { + SEXP grob, updatedgrob, height; + SEXP heightPreFn, heightFn, heightPostFn, findGrobFn; + SEXP R_fcall0, R_fcall1, R_fcall2, R_fcall3; + SEXP savedgpar, savedgrob; + /* + * The data could be a gPath to a grob + * In this case, need to find the grob first, and in order + * to do that correctly, need to call pre/postDraw code + */ + PROTECT(grob = unitData(unit, index)); + PROTECT(savedgpar = gridStateElement(dd, GSS_GPAR)); + PROTECT(savedgrob = gridStateElement(dd, GSS_CURRGROB)); + PROTECT(heightPreFn = findFun(install("preDraw"), + R_gridEvalEnv)); + PROTECT(heightFn = findFun(install("height"), R_gridEvalEnv)); + PROTECT(heightPostFn = findFun(install("postDraw"), + R_gridEvalEnv)); + if (inherits(grob, "gPath")) { + if (isNull(savedgrob)) { + PROTECT(findGrobFn = findFun(install("findGrobinDL"), + R_gridEvalEnv)); + PROTECT(R_fcall0 = lang2(findGrobFn, + getListElement(grob, "name"))); + grob = eval(R_fcall0, R_gridEvalEnv); + } else { + PROTECT(findGrobFn =findFun(install("findGrobinChildren"), + R_gridEvalEnv)); + PROTECT(R_fcall0 = lang3(findGrobFn, + getListElement(grob, "name"), + getListElement(savedgrob, + "children"))); + grob = eval(R_fcall0, R_gridEvalEnv); + } + UNPROTECT(2); + } + PROTECT(R_fcall1 = lang2(heightPreFn, grob)); + PROTECT(updatedgrob = eval(R_fcall1, R_gridEvalEnv)); + PROTECT(R_fcall2 = lang2(heightFn, updatedgrob)); + PROTECT(height = eval(R_fcall2, R_gridEvalEnv)); + result = pureNullUnit(height, 0, dd); + PROTECT(R_fcall3 = lang2(heightPostFn, updatedgrob)); + eval(R_fcall3, R_gridEvalEnv); + setGridStateElement(dd, GSS_GPAR, savedgpar); + setGridStateElement(dd, GSS_CURRGROB, savedgrob); + UNPROTECT(11); + } else + result = unitUnit(unit, index) == L_NULL; + } + return result; +} + +int pureNullUnitArithmetic(SEXP unit, int index, pGEDevDesc dd) { + /* + * Initialised to shut up compiler + */ + int result = 0; + if (addOp(unit) || minusOp(unit)) { + result = pureNullUnit(arg1(unit), index, dd) && + pureNullUnit(arg2(unit), index, dd); + } + else if (timesOp(unit)) { + result = pureNullUnit(arg2(unit), index, dd); + } + else if (minFunc(unit) || maxFunc(unit) || sumFunc(unit)) { + int n = unitLength(arg1(unit)); + int i = 0; + result = 1; + while (result && i<n) { + result = result && pureNullUnit(arg1(unit), i, dd); + i += 1; + } + } + else + error(_("unimplemented unit function")); + return result; +} + +/************************** + * Code for handling "grobwidth" units + ************************** + */ + +/* NOTE: this code calls back to R code to perform + * set.gpar operations, which will impact on grid state variables + * BUT that's ok(ish) because we save and restore the relevant state + * variables in here so that the overall effect is NULL. + * + * FIXME: OTOH, the calls back to R Code may also perform + * viewport operations. Again, we restore state as much as possible, + * but this can "pollute" the viewport tree in some cases. + */ + +double evaluateGrobUnit(double value, SEXP grob, + double vpwidthCM, double vpheightCM, + int nullLMode, int nullAMode, + /* + * Evaluation type + * 0 = x, 1 = y, 2 = width, 3 = height + */ + int evalType, + pGEDevDesc dd) +{ + double vpWidthCM, vpHeightCM; + double rotationAngle; + LViewportContext vpc; + R_GE_gcontext gc; + LTransform transform, savedTransform; + SEXP currentvp, currentgp; + SEXP preFn, postFn, findGrobFn; + SEXP evalFnx = R_NilValue, evalFny = R_NilValue; + SEXP R_fcall0, R_fcall1, R_fcall2x, R_fcall2y, R_fcall3; + SEXP savedgpar, savedgrob, updatedgrob; + SEXP unitx = R_NilValue, unity = R_NilValue; + double result = 0.0; + Rboolean protectedGrob = FALSE; + /* + * We are just doing calculations, not drawing, so + * we don't want anything recorded on the graphics engine DL + * + * FIXME: This should probably be done via a GraphicsEngine.h + * function call rather than directly playing with dd->recordGraphics + */ + Rboolean record = dd->recordGraphics; + dd->recordGraphics = FALSE; + /* + * Save the current viewport transform + * (use to convert location relative to current viewport) + */ + currentvp = gridStateElement(dd, GSS_VP); + getViewportTransform(currentvp, dd, + &vpWidthCM, &vpHeightCM, + savedTransform, &rotationAngle); + /* + * Save the current gpar state and restore it at the end + */ + PROTECT(savedgpar = gridStateElement(dd, GSS_GPAR)); + /* + * Save the current grob and restore it at the end + */ + PROTECT(savedgrob = gridStateElement(dd, GSS_CURRGROB)); + /* + * Set up for calling R functions + */ + PROTECT(preFn = findFun(install("preDraw"), R_gridEvalEnv)); + switch(evalType) { + case 0: + case 1: + PROTECT(evalFnx = findFun(install("xDetails"), R_gridEvalEnv)); + PROTECT(evalFny = findFun(install("yDetails"), R_gridEvalEnv)); + break; + case 2: + PROTECT(evalFnx = findFun(install("width"), R_gridEvalEnv)); + break; + case 3: + PROTECT(evalFny = findFun(install("height"), R_gridEvalEnv)); + break; + case 4: + PROTECT(evalFny = findFun(install("ascentDetails"), R_gridEvalEnv)); + break; + case 5: + PROTECT(evalFny = findFun(install("descentDetails"), R_gridEvalEnv)); + break; + } + PROTECT(postFn = findFun(install("postDraw"), R_gridEvalEnv)); + /* + * If grob is actually a gPath, use it to find an actual grob + */ + if (inherits(grob, "gPath")) { + /* + * If the current grob is NULL then we are at the top level + * and we search the display list, otherwise we search the + * children of the current grob + * + * NOTE: assume here that only gPath of depth == 1 are valid + */ + if (isNull(savedgrob)) { + PROTECT(findGrobFn = findFun(install("findGrobinDL"), + R_gridEvalEnv)); + PROTECT(R_fcall0 = lang2(findGrobFn, + getListElement(grob, "name"))); + PROTECT(grob = eval(R_fcall0, R_gridEvalEnv)); + } else { + PROTECT(findGrobFn = findFun(install("findGrobinChildren"), + R_gridEvalEnv)); + PROTECT(R_fcall0 = lang3(findGrobFn, + getListElement(grob, "name"), + getListElement(savedgrob, "children"))); + PROTECT(grob = eval(R_fcall0, R_gridEvalEnv)); + } + /* + * Flag to make sure we UNPROTECT these at the end + */ + protectedGrob = TRUE; + } + /* Call preDraw(grob) + */ + PROTECT(R_fcall1 = lang2(preFn, grob)); + PROTECT(updatedgrob = eval(R_fcall1, R_gridEvalEnv)); + /* + * The call to preDraw may have pushed viewports and/or + * enforced gpar settings, SO we need to re-establish the + * current viewport and gpar settings before evaluating the + * width unit. + * + * NOTE: we are really relying on the grid state to be coherent + * when we do stuff like this (i.e., not to have changed since + * we started evaluating the unit [other than the changes we may + * have deliberately made above by calling preDraw]). In other + * words we are relying on no other drawing occurring at the + * same time as we are doing this evaluation. In other other + * words, we are relying on there being only ONE process + * (i.e., NOT multi-threaded). + */ + currentvp = gridStateElement(dd, GSS_VP); + currentgp = gridStateElement(dd, GSS_GPAR); + getViewportTransform(currentvp, dd, + &vpWidthCM, &vpHeightCM, + transform, &rotationAngle); + fillViewportContextFromViewport(currentvp, &vpc); + /* Call whatever(grob) + * to get the unit representing the x/y/width/height + */ + switch (evalType) { + case 0: + case 1: + /* + * When evaluating grobX/grobY, the value of the unit + * is an angle that gets passed to xDetails/yDetails + */ + { + SEXP val; + PROTECT(val = ScalarReal(value)); + PROTECT(R_fcall2x = lang3(evalFnx, updatedgrob, val)); + PROTECT(unitx = eval(R_fcall2x, R_gridEvalEnv)); + PROTECT(R_fcall2y = lang3(evalFny, updatedgrob, val)); + PROTECT(unity = eval(R_fcall2y, R_gridEvalEnv)); + } + break; + case 2: + PROTECT(R_fcall2x = lang2(evalFnx, updatedgrob)); + PROTECT(unitx = eval(R_fcall2x, R_gridEvalEnv)); + break; + case 3: + case 4: + case 5: + PROTECT(R_fcall2y = lang2(evalFny, updatedgrob)); + PROTECT(unity = eval(R_fcall2y, R_gridEvalEnv)); + break; + } + /* + * Transform the unit + * NOTE: We transform into INCHES so can produce final answer in terms + * of NPC for original context + */ + /* Special case for "null" units + */ + gcontextFromgpar(currentgp, 0, &gc, dd); + switch(evalType) { + case 0: + case 1: + if (evalType && pureNullUnit(unity, 0, dd)) { + result = evaluateNullUnit(pureNullUnitValue(unity, 0), + vpWidthCM, + nullLMode, nullAMode); + } else if (pureNullUnit(unitx, 0, dd)) { + result = evaluateNullUnit(pureNullUnitValue(unitx, 0), + vpWidthCM, + nullLMode, nullAMode); + } else { + /* + * Transform to device (to allow for viewports in grob) + * then adjust relative to current viewport. + */ + double xx, yy; + LLocation lin, lout; + LTransform invt; + invTransform(savedTransform, invt); + transformLocn(unitx, unity, 0, + vpc, &gc, + vpWidthCM, vpHeightCM, dd, + transform, &xx, &yy); + location(xx, yy, lin); + trans(lin, invt, lout); + xx = locationX(lout); + yy = locationY(lout); + if (evalType) + result = yy; + else + result = xx; + } + break; + case 2: + if (pureNullUnit(unitx, 0, dd)) { + result = evaluateNullUnit(pureNullUnitValue(unitx, 0), + vpWidthCM, + nullLMode, nullAMode); + } else { + result = transformWidthtoINCHES(unitx, 0, vpc, &gc, + vpWidthCM, vpHeightCM, + dd); + } + break; + case 3: + case 4: + case 5: + if (pureNullUnit(unity, 0, dd)) { + result = evaluateNullUnit(pureNullUnitValue(unity, 0), + vpWidthCM, + nullLMode, nullAMode); + } else { + result = transformHeighttoINCHES(unity, 0, vpc, &gc, + vpWidthCM, vpHeightCM, + dd); + } + break; + } + /* Call postDraw(grob) + */ + PROTECT(R_fcall3 = lang2(postFn, updatedgrob)); + eval(R_fcall3, R_gridEvalEnv); + /* + * Restore the saved gpar state and grob + */ + setGridStateElement(dd, GSS_GPAR, savedgpar); + setGridStateElement(dd, GSS_CURRGROB, savedgrob); + if (protectedGrob) + UNPROTECT(3); + switch(evalType) { + case 0: + case 1: + UNPROTECT(14); + break; + case 2: + case 3: + case 4: + case 5: + UNPROTECT(10); + } + /* Return the transformed width + */ + /* + * If there is an error or user-interrupt in the above + * evaluation, dd->recordGraphics is set to TRUE + * on all graphics devices (see GEonExit(); called in errors.c) + */ + dd->recordGraphics = record; + return result; +} + +double evaluateGrobXUnit(double value, SEXP grob, + double vpheightCM, double vpwidthCM, + int nullLMode, int nullAMode, + pGEDevDesc dd) +{ + return evaluateGrobUnit(value, grob, vpheightCM, vpwidthCM, + nullLMode, nullAMode, 0, dd); +} + +double evaluateGrobYUnit(double value, SEXP grob, + double vpheightCM, double vpwidthCM, + int nullLMode, int nullAMode, + pGEDevDesc dd) +{ + return evaluateGrobUnit(value, grob, vpheightCM, vpwidthCM, + nullLMode, nullAMode, 1, dd); +} + +double evaluateGrobWidthUnit(SEXP grob, + double vpheightCM, double vpwidthCM, + int nullLMode, int nullAMode, + pGEDevDesc dd) +{ + return evaluateGrobUnit(1, grob, vpheightCM, vpwidthCM, + nullLMode, nullAMode, 2, dd); +} + +double evaluateGrobHeightUnit(SEXP grob, + double vpheightCM, double vpwidthCM, + int nullLMode, int nullAMode, + pGEDevDesc dd) +{ + return evaluateGrobUnit(1, grob, vpheightCM, vpwidthCM, + nullLMode, nullAMode, 3, dd); +} + +double evaluateGrobAscentUnit(SEXP grob, + double vpheightCM, double vpwidthCM, + int nullLMode, int nullAMode, + pGEDevDesc dd) +{ + return evaluateGrobUnit(1, grob, vpheightCM, vpwidthCM, + nullLMode, nullAMode, 4, dd); +} + +double evaluateGrobDescentUnit(SEXP grob, + double vpheightCM, double vpwidthCM, + int nullLMode, int nullAMode, + pGEDevDesc dd) +{ + return evaluateGrobUnit(1, grob, vpheightCM, vpwidthCM, + nullLMode, nullAMode, 5, dd); +} + +/************************** + * TRANSFORMATIONS + ************************** + */ + +/* Map a value from arbitrary units to INCHES */ + +/* + * NULL units are a special case + * If L_nullLayoutMode = 1 then the value returned is a NULL unit value + * Otherwise it is an INCHES value + */ +double transform(double value, int unit, SEXP data, + double scalemin, double scalemax, + const pGEcontext gc, + double thisCM, double otherCM, + int nullLMode, int nullAMode, pGEDevDesc dd) +{ + double asc, dsc, wid; + double result = value; + switch (unit) { + case L_NPC: + result = (result * thisCM)/2.54; /* 2.54 cm per inch */ + break; + case L_CM: + result = result/2.54; + break; + case L_INCHES: + break; + /* FIXME: The following two assume that the pointsize specified + * by the user is actually the pointsize provided by the + * device. This is NOT a safe assumption + * One possibility would be to do a call to GReset(), just so + * that mapping() gets called, just so that things like + * xNDCPerLine are up-to-date, THEN call GStrHeight("M") + * or somesuch. + */ + case L_CHAR: + case L_MYCHAR: /* FIXME: Remove this when I can */ + result = (result * gc->ps * gc->cex)/72; /* 72 points per inch */ + break; + case L_LINES: + case L_MYLINES: /* FIXME: Remove this when I can */ + result = (result * gc->ps * gc->cex * gc->lineheight)/72; + break; + case L_SNPC: + if (thisCM <= otherCM) + result = (result * thisCM)/2.54; + else + result = (result * otherCM)/2.54; + break; + case L_MM: + result = (result/10)/2.54; + break; + /* Maybe an opportunity for some constants below here (!) + */ + case L_POINTS: + result = result/72.27; + break; + case L_PICAS: + result = (result*12)/72.27; + break; + case L_BIGPOINTS: + result = result/72; + break; + case L_DIDA: + result = result/1157*1238/72.27; + break; + case L_CICERO: + result = result*12/1157*1238/72.27; + break; + case L_SCALEDPOINTS: + result = result/65536/72.27; + break; + case L_STRINGWIDTH: + case L_MYSTRINGWIDTH: /* FIXME: Remove this when I can */ + if (isExpression(data)) + result = result* + fromDeviceWidth(GEExpressionWidth(VECTOR_ELT(data, 0), gc, dd), + GE_INCHES, dd); + else + result = result* + fromDeviceWidth(GEStrWidth(CHAR(STRING_ELT(data, 0)), + getCharCE(STRING_ELT(data, 0)), + gc, dd), + GE_INCHES, dd); + break; + case L_STRINGHEIGHT: + case L_MYSTRINGHEIGHT: /* FIXME: Remove this when I can */ + if (isExpression(data)) + result = result* + fromDeviceHeight(GEExpressionHeight(VECTOR_ELT(data, 0), + gc, dd), + GE_INCHES, dd); + else + /* FIXME: what encoding is this? */ + result = result* + fromDeviceHeight(GEStrHeight(CHAR(STRING_ELT(data, 0)), -1, + gc, dd), + GE_INCHES, dd); + break; + case L_STRINGASCENT: + if (isExpression(data)) + GEExpressionMetric(VECTOR_ELT(data, 0), gc, + &asc, &dsc, &wid, + dd); + else + GEStrMetric(CHAR(STRING_ELT(data, 0)), + getCharCE(STRING_ELT(data, 0)), gc, + &asc, &dsc, &wid, + dd); + result = result*fromDeviceHeight(asc, GE_INCHES, dd); + break; + case L_STRINGDESCENT: + if (isExpression(data)) + GEExpressionMetric(VECTOR_ELT(data, 0), gc, + &asc, &dsc, &wid, + dd); + else + GEStrMetric(CHAR(STRING_ELT(data, 0)), + getCharCE(STRING_ELT(data, 0)), gc, + &asc, &dsc, &wid, + dd); + result = result*fromDeviceHeight(dsc, GE_INCHES, dd); + break; + case L_GROBX: + result = evaluateGrobXUnit(value, data, thisCM, otherCM, + nullLMode, nullAMode, dd); + break; + case L_GROBY: + result = evaluateGrobYUnit(value, data, otherCM, thisCM, + nullLMode, nullAMode, dd); + break; + case L_GROBWIDTH: + result = value*evaluateGrobWidthUnit(data, thisCM, otherCM, + nullLMode, nullAMode, dd); + break; + case L_GROBHEIGHT: + result = value*evaluateGrobHeightUnit(data, otherCM, thisCM, + nullLMode, nullAMode, dd); + break; + case L_GROBASCENT: + result = value*evaluateGrobAscentUnit(data, otherCM, thisCM, + nullLMode, nullAMode, dd); + break; + case L_GROBDESCENT: + result = value*evaluateGrobDescentUnit(data, otherCM, thisCM, + nullLMode, nullAMode, dd); + break; + case L_NULL: + result = evaluateNullUnit(result, thisCM, nullLMode, nullAMode); + break; + default: + error(_("invalid unit or unit not yet implemented")); + } + /* + * For physical units, scale the result by GSS_SCALE (a "zoom" factor) + */ + switch (unit) { + case L_INCHES: + case L_CM: + case L_MM: + case L_POINTS: + case L_PICAS: + case L_BIGPOINTS: + case L_DIDA: + case L_CICERO: + case L_SCALEDPOINTS: + result = result * REAL(gridStateElement(dd, GSS_SCALE))[0]; + break; + default: + /* + * No need to scale relative coordinates (NPC, NATIVE, NULL) + * CHAR and LINES already scaled because of scaling in gcontextFromGPar() + * Ditto STRINGWIDTH/HEIGHT + * GROBWIDTH/HEIGHT recurse into here so scaling already done + */ + break; + } + return result; +} + +/* FIXME: scales are only linear at the moment */ +double transformLocation(double location, int unit, SEXP data, + double scalemin, double scalemax, + const pGEcontext gc, + double thisCM, double otherCM, + int nullLMode, int nullAMode, pGEDevDesc dd) +{ + double result = location; + switch (unit) { + case L_NATIVE: + /* It is invalid to create a viewport with identical limits on scale + * so we are protected from divide-by-zero + */ + result = ((result - scalemin)/(scalemax - scalemin))*thisCM/2.54; + break; + default: + result = transform(location, unit, data, scalemin, scalemax, + gc, thisCM, otherCM, nullLMode, nullAMode, dd); + } + return result; +} + +double transformXArithmetic(SEXP x, int index, + LViewportContext vpc, + const pGEcontext gc, + double widthCM, double heightCM, + int nullLMode, pGEDevDesc dd); + +double transformX(SEXP x, int index, + LViewportContext vpc, + const pGEcontext gc, + double widthCM, double heightCM, + int nullLMode, int nullAMode, pGEDevDesc dd) +{ + double result; + int unit; + SEXP data; + if (isUnitArithmetic(x)) + result = transformXArithmetic(x, index, vpc, gc, + widthCM, heightCM, nullLMode, dd); + else if (isUnitList(x)) { + int n = unitLength(x); + result = transformX(VECTOR_ELT(x, index % n), 0, vpc, gc, + widthCM, heightCM, nullLMode, nullAMode, dd); + } else { /* Just a plain unit */ + int nullamode; + if (nullAMode == 0) + nullamode = L_plain; + else + nullamode = nullAMode; + result = unitValue(x, index); + unit = unitUnit(x, index); + PROTECT(data = unitData(x, index)); + result = transformLocation(result, unit, data, + vpc.xscalemin, vpc.xscalemax, gc, + widthCM, heightCM, + nullLMode, + nullamode, + dd); + UNPROTECT(1); + } + return result; +} + +double transformYArithmetic(SEXP y, int index, + LViewportContext vpc, + const pGEcontext gc, + double widthCM, double heightCM, + int nullLMode, pGEDevDesc dd); + +double transformY(SEXP y, int index, + LViewportContext vpc, + const pGEcontext gc, + double widthCM, double heightCM, + int nullLMode, int nullAMode, pGEDevDesc dd) +{ + double result; + int unit; + SEXP data; + if (isUnitArithmetic(y)) + result = transformYArithmetic(y, index, vpc, gc, + widthCM, heightCM, nullLMode, dd); + else if (isUnitList(y)) { + int n = unitLength(y); + result = transformY(VECTOR_ELT(y, index % n), 0, vpc, gc, + widthCM, heightCM, nullLMode, nullAMode, dd); + } else { /* Just a unit object */ + int nullamode; + if (nullAMode == 0) + nullamode = L_plain; + else + nullamode = nullAMode; + result = unitValue(y, index); + unit = unitUnit(y, index); + PROTECT(data = unitData(y, index)); + result = transformLocation(result, unit, data, + vpc.yscalemin, vpc.yscalemax, gc, + heightCM, widthCM, + nullLMode, + nullamode, + dd); + UNPROTECT(1); + } + return result; +} + +double transformDimension(double dim, int unit, SEXP data, + double scalemin, double scalemax, + const pGEcontext gc, + double thisCM, double otherCM, + int nullLMode, int nullAMode, + pGEDevDesc dd) +{ + double result = dim; + switch (unit) { + case L_NATIVE: + /* It is invalid to create a viewport with identical limits on scale + * so we are protected from divide-by-zero + */ + result = ((dim)/(scalemax - scalemin))*thisCM/2.54; + break; + default: + result = transform(dim, unit, data, scalemin, scalemax, gc, + thisCM, otherCM, nullLMode, nullAMode, dd); + } + return result; +} + +double transformWidthArithmetic(SEXP width, int index, + LViewportContext vpc, + const pGEcontext gc, + double widthCM, double heightCM, + int nullLMode, pGEDevDesc dd); + +double transformWidth(SEXP width, int index, + LViewportContext vpc, + const pGEcontext gc, + double widthCM, double heightCM, + int nullLMode, int nullAMode, pGEDevDesc dd) +{ + double result; + int unit; + SEXP data; + if (isUnitArithmetic(width)) + result = transformWidthArithmetic(width, index, vpc, gc, + widthCM, heightCM, nullLMode, dd); + else if (isUnitList(width)) { + int n = unitLength(width); + result = transformWidth(VECTOR_ELT(width, index % n), 0, vpc, gc, + widthCM, heightCM, nullLMode, nullAMode, dd); + } else { /* Just a unit object */ + int nullamode; + if (nullAMode == 0) + nullamode = L_plain; + else + nullamode = nullAMode; + result = unitValue(width, index); + unit = unitUnit(width, index); + PROTECT(data = unitData(width, index)); + result = transformDimension(result, unit, data, + vpc.xscalemin, vpc.xscalemax, gc, + widthCM, heightCM, + nullLMode, + nullamode, + dd); + UNPROTECT(1); + } + return result; +} + +double transformHeightArithmetic(SEXP height, int index, + LViewportContext vpc, + const pGEcontext gc, + double widthCM, double heightCM, + int nullLMode, pGEDevDesc dd); + +double transformHeight(SEXP height, int index, + LViewportContext vpc, + const pGEcontext gc, + double widthCM, double heightCM, + int nullLMode, int nullAMode, pGEDevDesc dd) +{ + double result; + int unit; + SEXP data; + if (isUnitArithmetic(height)) + result = transformHeightArithmetic(height, index, vpc, gc, + widthCM, heightCM, nullLMode, dd); + else if (isUnitList(height)) { + int n = unitLength(height); + result = transformHeight(VECTOR_ELT(height, index % n), 0, vpc, gc, + widthCM, heightCM, nullLMode, nullAMode, dd); + } else { /* Just a unit object */ + int nullamode; + if (nullAMode == 0) + nullamode = L_plain; + else + nullamode = nullAMode; + result = unitValue(height, index); + unit = unitUnit(height, index); + PROTECT(data = unitData(height, index)); + result = transformDimension(result, unit, data, + vpc.yscalemin, vpc.yscalemax, gc, + heightCM, widthCM, + nullLMode, + nullamode, + dd); + UNPROTECT(1); + } + return result; +} + +double transformXArithmetic(SEXP x, int index, + LViewportContext vpc, + const pGEcontext gc, + double widthCM, double heightCM, + int nullLMode, pGEDevDesc dd) +{ + int i; + double result = 0; + if (addOp(x)) { + result = transformX(arg1(x), index, vpc, gc, + widthCM, heightCM, + nullLMode, L_adding, + dd) + + transformX(arg2(x), index, vpc, gc, + widthCM, heightCM, + nullLMode, L_adding, + dd); + } + else if (minusOp(x)) { + result = transformX(arg1(x), index, vpc, gc, + widthCM, heightCM, + nullLMode, L_subtracting, + dd) - + transformX(arg2(x), index, vpc, gc, + widthCM, heightCM, + nullLMode, L_subtracting, + dd); + } + else if (timesOp(x)) { + result = REAL(arg1(x))[index % LENGTH(arg1(x))] * + transformX(arg2(x), index, vpc, gc, + widthCM, heightCM, + nullLMode, L_multiplying, dd); + } + else if (minFunc(x)) { + int n = unitLength(arg1(x)); + double temp = DBL_MAX; + result = transformX(arg1(x), 0, vpc, gc, + widthCM, heightCM, + nullLMode, L_minimising, + dd); + for (i=1; i<n; i++) { + temp = transformX(arg1(x), i, vpc, gc, + widthCM, heightCM, + nullLMode, L_minimising, + dd); + if (temp < result) + result = temp; + } + } + else if (maxFunc(x)) { + int n = unitLength(arg1(x)); + double temp = DBL_MIN; + result = transformX(arg1(x), 0, vpc, gc, + widthCM, heightCM, + nullLMode, L_maximising, + dd); + for (i=1; i<n; i++) { + temp = transformX(arg1(x), i, vpc, gc, + widthCM, heightCM, + nullLMode, L_maximising, + dd); + if (temp > result) + result = temp; + } + } + else if (sumFunc(x)) { + int n = unitLength(arg1(x)); + result = 0.0; + for (i=0; i<n; i++) { + result += transformX(arg1(x), i, vpc, gc, + widthCM, heightCM, + nullLMode, L_summing, dd); + } + } + else + error(_("unimplemented unit function")); + return result; +} + +double transformYArithmetic(SEXP y, int index, + LViewportContext vpc, + const pGEcontext gc, + double widthCM, double heightCM, + int nullLMode, pGEDevDesc dd) +{ + int i; + double result = 0; + if (addOp(y)) { + result = transformY(arg1(y), index, vpc, gc, + widthCM, heightCM, + nullLMode, L_adding, + dd) + + transformY(arg2(y), index, vpc, gc, + widthCM, heightCM, + nullLMode, L_adding, + dd); + } + else if (minusOp(y)) { + result = transformY(arg1(y), index, vpc, gc, + widthCM, heightCM, + nullLMode, L_subtracting, + dd) - + transformY(arg2(y), index, vpc, gc, + widthCM, heightCM, + nullLMode, L_subtracting, + dd); + } + else if (timesOp(y)) { + result = REAL(arg1(y))[index % LENGTH(arg1(y))] * + transformY(arg2(y), index, vpc, gc, + widthCM, heightCM, + nullLMode, L_multiplying, dd); + } + else if (minFunc(y)) { + int n = unitLength(arg1(y)); + double temp = DBL_MAX; + result = transformY(arg1(y), 0, vpc, gc, + widthCM, heightCM, + nullLMode, L_minimising, + dd); + for (i=1; i<n; i++) { + temp = transformY(arg1(y), i, vpc, gc, + widthCM, heightCM, + nullLMode, L_minimising, + dd); + if (temp < result) + result = temp; + } + } + else if (maxFunc(y)) { + int n = unitLength(arg1(y)); + double temp = DBL_MIN; + result = transformY(arg1(y), 0, vpc, gc, + widthCM, heightCM, + nullLMode, L_maximising, + dd); + for (i=1; i<n; i++) { + temp = transformY(arg1(y), i, vpc, gc, + widthCM, heightCM, + nullLMode, L_maximising, + dd); + if (temp > result) + result = temp; + } + } + else if (sumFunc(y)) { + int n = unitLength(arg1(y)); + result = 0.0; + for (i=0; i<n; i++) { + result += transformY(arg1(y), i, vpc, gc, + widthCM, heightCM, + nullLMode, L_summing, dd); + } + } + else + error(_("unimplemented unit function")); + return result; +} + +double transformWidthArithmetic(SEXP width, int index, + LViewportContext vpc, + const pGEcontext gc, + double widthCM, double heightCM, + int nullLMode, pGEDevDesc dd) +{ + int i; + double result = 0; + if (addOp(width)) { + result = transformWidth(arg1(width), index, vpc, gc, + widthCM, heightCM, + nullLMode, L_adding, + dd) + + transformWidth(arg2(width), index, vpc, gc, + widthCM, heightCM, + nullLMode, L_adding, + dd); + } + else if (minusOp(width)) { + result = transformWidth(arg1(width), index, vpc, gc, + widthCM, heightCM, + nullLMode, L_subtracting, + dd) - + transformWidth(arg2(width), index, vpc, gc, + widthCM, heightCM, + nullLMode, L_subtracting, + dd); + } + else if (timesOp(width)) { + result = REAL(arg1(width))[index % LENGTH(arg1(width))] * + transformWidth(arg2(width), index, vpc, gc, + widthCM, heightCM, + nullLMode, L_multiplying, dd); + } + else if (minFunc(width)) { + int n = unitLength(arg1(width)); + double temp = DBL_MAX; + result = transformWidth(arg1(width), 0, vpc, gc, + widthCM, heightCM, + nullLMode, L_minimising, + dd); + for (i=1; i<n; i++) { + temp = transformWidth(arg1(width), i, vpc, gc, + widthCM, heightCM, + nullLMode, L_minimising, + dd); + if (temp < result) + result = temp; + } + } + else if (maxFunc(width)) { + int n = unitLength(arg1(width)); + double temp = DBL_MIN; + result = transformWidth(arg1(width), 0, vpc, gc, + widthCM, heightCM, + nullLMode, L_maximising, + dd); + for (i=1; i<n; i++) { + temp = transformWidth(arg1(width), i, vpc, gc, + widthCM, heightCM, + nullLMode, L_maximising, + dd); + if (temp > result) + result = temp; + } + } + else if (sumFunc(width)) { + int n = unitLength(arg1(width)); + result = 0.0; + for (i=0; i<n; i++) { + result += transformWidth(arg1(width), i, vpc, gc, + widthCM, heightCM, + nullLMode, L_summing, dd); + } + } + else + error(_("unimplemented unit function")); + return result; +} + +double transformHeightArithmetic(SEXP height, int index, + LViewportContext vpc, + const pGEcontext gc, + double widthCM, double heightCM, + int nullLMode, pGEDevDesc dd) +{ + int i; + double result = 0; + if (addOp(height)) { + result = transformHeight(arg1(height), index, vpc, gc, + widthCM, heightCM, + nullLMode, L_adding, + dd) + + transformHeight(arg2(height), index, vpc, gc, + widthCM, heightCM, + nullLMode, L_adding, + dd); + } + else if (minusOp(height)) { + result = transformHeight(arg1(height), index, vpc, gc, + widthCM, heightCM, + nullLMode, L_subtracting, + dd) - + transformHeight(arg2(height), index, vpc, gc, + widthCM, heightCM, + nullLMode, L_subtracting, + dd); + } + else if (timesOp(height)) { + result = REAL(arg1(height))[index % LENGTH(arg1(height))] * + transformHeight(arg2(height), index, vpc, gc, + widthCM, heightCM, + nullLMode, L_multiplying, dd); + } + else if (minFunc(height)) { + int n = unitLength(arg1(height)); + double temp = DBL_MAX; + result = transformHeight(arg1(height), 0, vpc, gc, + widthCM, heightCM, + nullLMode, L_minimising, + dd); + for (i=1; i<n; i++) { + temp = transformHeight(arg1(height), i, vpc, gc, + widthCM, heightCM, + nullLMode, L_minimising, + dd); + if (temp < result) + result = temp; + } + } + else if (maxFunc(height)) { + int n = unitLength(arg1(height)); + double temp = DBL_MIN; + result = transformHeight(arg1(height), 0, vpc, gc, + widthCM, heightCM, + nullLMode, L_maximising, + dd); + for (i=1; i<n; i++) { + temp = transformHeight(arg1(height), i, vpc, gc, + widthCM, heightCM, + nullLMode, L_maximising, + dd); + if (temp > result) + result = temp; + } + } + else if (sumFunc(height)) { + int n = unitLength(arg1(height)); + result = 0.0; + for (i=0; i<n; i++) { + result += transformHeight(arg1(height), i, vpc, gc, + widthCM, heightCM, + nullLMode, L_summing, dd); + } + } + else + error(_("unimplemented unit function")); + return result; +} + +/* Code for transforming a location in INCHES using a transformation matrix. + * We work in INCHES so that rotations can be incorporated within the + * transformation matrix (i.e., the units are the same in both x- and + * y-directions). + * INCHES rather than CM because the R graphics engine only has INCHES. + */ + +/* The original transform[X | Y | Width | Height] functions + * were written to transform to NPC. Rather than muck with them, + * I am just wrappering them to get the new transformation to INCHES + * In other words, the reason for the apparent inefficiency here + * is historical. + */ + +/* It is even more inefficient-looking now because I ended up mucking + * with transform() to return INCHES (to fix bug if width/heightCM == 0) + * and by then there was too much code that called transformXtoINCHES + * to be bothered changing calls to it + */ + +/* The difference between transform*toINCHES and transformLocn/Dimn + * is that the former are just converting from one coordinate system + * to INCHES; the latter are converting from INCHES relative to + * the parent to INCHES relative to the device. + */ +double transformXtoINCHES(SEXP x, int index, + LViewportContext vpc, + const pGEcontext gc, + double widthCM, double heightCM, + pGEDevDesc dd) +{ + return transformX(x, index, vpc, gc, + widthCM, heightCM, 0, 0, dd); +} + +double transformYtoINCHES(SEXP y, int index, + LViewportContext vpc, + const pGEcontext gc, + double widthCM, double heightCM, + pGEDevDesc dd) +{ + return transformY(y, index, vpc, gc, + widthCM, heightCM, 0, 0, dd); +} + +void transformLocn(SEXP x, SEXP y, int index, + LViewportContext vpc, + const pGEcontext gc, + double widthCM, double heightCM, + pGEDevDesc dd, + LTransform t, + double *xx, double *yy) +{ + LLocation lin, lout; + /* x and y are unit objects (i.e., values in any old coordinate + * system) so the first step is to convert them both to CM + */ + *xx = transformXtoINCHES(x, index, vpc, gc, + widthCM, heightCM, dd); + *yy = transformYtoINCHES(y, index, vpc, gc, + widthCM, heightCM, dd); + location(*xx, *yy, lin); + trans(lin, t, lout); + *xx = locationX(lout); + *yy = locationY(lout); +} + +double transformWidthtoINCHES(SEXP w, int index, + LViewportContext vpc, + const pGEcontext gc, + double widthCM, double heightCM, + pGEDevDesc dd) +{ + return transformWidth(w, index, vpc, gc, + widthCM, heightCM, 0, 0, dd); +} + +double transformHeighttoINCHES(SEXP h, int index, + LViewportContext vpc, + const pGEcontext gc, + double widthCM, double heightCM, + pGEDevDesc dd) +{ + return transformHeight(h, index, vpc, gc, + widthCM, heightCM, 0, 0, dd); +} + +void transformDimn(SEXP w, SEXP h, int index, + LViewportContext vpc, + const pGEcontext gc, + double widthCM, double heightCM, + pGEDevDesc dd, + double rotationAngle, + double *ww, double *hh) +{ + LLocation din, dout; + LTransform r; + *ww = transformWidthtoINCHES(w, index, vpc, gc, + widthCM, heightCM, dd); + *hh = transformHeighttoINCHES(h, index, vpc, gc, + widthCM, heightCM, dd); + location(*ww, *hh, din); + rotation(rotationAngle, r); + trans(din, r, dout); + *ww = locationX(dout); + *hh = locationY(dout); +} + +/* + * **************************** + * Inverse Transformations + * **************************** + */ + +/* + * Take a value in inches within the viewport and convert to some + * other coordinate system + */ + +double transformFromINCHES(double value, int unit, + const pGEcontext gc, + double thisCM, double otherCM, + pGEDevDesc dd) +{ + /* + * Convert to NPC + */ + double result = value; + switch (unit) { + case L_NPC: + result = result/(thisCM/2.54); + break; + case L_CM: + result = result*2.54; + break; + case L_INCHES: + break; + /* FIXME: The following two assume that the pointsize specified + * by the user is actually the pointsize provided by the + * device. This is NOT a safe assumption + * One possibility would be to do a call to GReset(), just so + * that mapping() gets called, just so that things like + * xNDCPerLine are up-to-date, THEN call GStrHeight("M") + * or somesuch. + */ + case L_CHAR: + result = (result*72)/(gc->ps*gc->cex); + break; + case L_LINES: + result = (result*72)/(gc->ps*gc->cex*gc->lineheight); + break; + case L_MM: + result = result*2.54*10; + break; + /* Maybe an opportunity for some constants below here (!) + */ + case L_POINTS: + result = result*72.27; + break; + case L_PICAS: + result = result/12*72.27; + break; + case L_BIGPOINTS: + result = result*72; + break; + case L_DIDA: + result = result/1238*1157*72.27; + break; + case L_CICERO: + result = result/1238*1157*72.27/12; + break; + case L_SCALEDPOINTS: + result = result*65536*72.27; + break; + /* + * I'm not sure the remaining ones makes any sense. + * For simplicity, these are just forbidden for now. + */ + case L_SNPC: + case L_MYCHAR: + case L_MYLINES: + case L_STRINGWIDTH: + case L_MYSTRINGWIDTH: + case L_STRINGHEIGHT: + case L_MYSTRINGHEIGHT: + case L_GROBX: + case L_GROBY: + case L_GROBWIDTH: + case L_GROBHEIGHT: + case L_NULL: + default: + error(_("invalid unit or unit not yet implemented")); + } + /* + * For physical units, reverse the scale by GSS_SCALE (a "zoom" factor) + */ + switch (unit) { + case L_INCHES: + case L_CM: + case L_MM: + case L_POINTS: + case L_PICAS: + case L_BIGPOINTS: + case L_DIDA: + case L_CICERO: + case L_SCALEDPOINTS: + result = result / REAL(gridStateElement(dd, GSS_SCALE))[0]; + break; + default: + /* + * No need to scale relative coordinates (NPC, NATIVE, NULL) + * All other units forbidden anyway + */ + break; + } + return result; +} + +/* + * This corresponds to transform[X|Y]toINCHES() because + * it works only within the current viewport, BUT + * it is much simpler because it is supplied with a + * double value in INCHES (rather than a unit object in + * an arbitrary unit). + * + * For conceptual symmetry, it should probably return a + * unit object, but it only returns a double value. + * The construction of a unit object with the appropriate + * unit must be performed by the calling function (or higher). + * This is probably easiest done right up in R code. + */ +double transformXYFromINCHES(double location, int unit, + double scalemin, double scalemax, + const pGEcontext gc, + double thisCM, double otherCM, + pGEDevDesc dd) +{ + double result = location; + /* Special case if "thisCM == 0": + * If converting FROM relative unit, result will already be zero + * so leave it there. + * If converting FROM absolute unit that is zero, ditto. + * Otherwise (converting FROM non-zero absolute unit), + * converting to relative unit is an error. + */ + if ((unit == L_NATIVE || unit == L_NPC) && + thisCM < 1e-6) { + if (result != 0) + error(_("Viewport has zero dimension(s)")); + } else { + switch (unit) { + case L_NATIVE: + result = scalemin + (result/(thisCM/2.54))*(scalemax - scalemin); + break; + default: + result = transformFromINCHES(location, unit, gc, + thisCM, otherCM, dd); + } + } + return result; +} + +double transformWidthHeightFromINCHES(double dimension, int unit, + double scalemin, double scalemax, + const pGEcontext gc, + double thisCM, double otherCM, + pGEDevDesc dd) +{ + double result = dimension; + /* Special case if "thisCM == 0": + * If converting FROM relative unit, result will already be zero + * so leave it there. + * If converting FROM absolute unit that is zero, ditto. + * Otherwise (converting FROM non-zero absolute unit), + * converting to relative unit is an error. + */ + if ((unit == L_NATIVE || unit == L_NPC) && + thisCM < 1e-6) { + if (result != 0) + error(_("Viewport has zero dimension(s)")); + } else { + switch (unit) { + case L_NATIVE: + result = (result/(thisCM/2.54))*(scalemax - scalemin); + break; + default: + result = transformFromINCHES(dimension, unit, gc, + thisCM, otherCM, dd); + } + } + return result; +} + +/* + * Special case conversion from relative unit to relative unit, + * only used when relevant widthCM or heightCM is zero, so + * we cannot transform thru INCHES (or we get divide-by-zero) + * + * Protected from divide-by-zero here because viewport with + * identical scale limits is disallowed. + */ +double transformXYtoNPC(double x, int from, double min, double max) +{ + double result = x; + switch (from) { + case L_NPC: + break; + case L_NATIVE: + result = (x - min)/(max - min); + break; + default: + error(_("Unsupported unit conversion")); + } + return(result); +} + +double transformWHtoNPC(double x, int from, double min, double max) +{ + double result = x; + switch (from) { + case L_NPC: + break; + case L_NATIVE: + result = x/(max - min); + break; + default: + error(_("Unsupported unit conversion")); + } + return(result); +} + +double transformXYfromNPC(double x, int to, double min, double max) +{ + double result = x; + switch (to) { + case L_NPC: + break; + case L_NATIVE: + result = min + x*(max - min); + break; + default: + error(_("Unsupported unit conversion")); + } + return(result); +} + +double transformWHfromNPC(double x, int to, double min, double max) +{ + double result = x; + switch (to) { + case L_NPC: + break; + case L_NATIVE: + result = x*(max - min); + break; + default: + error(_("Unsupported unit conversion")); + } + return(result); +} + +/* Attempt to make validating units faster + */ +typedef struct { + char *name; + int code; +} UnitTab; + +/* NOTE this table must match the order in grid.h + */ +static UnitTab UnitTable[] = { + { "npc", 0 }, + { "cm", 1 }, + { "inches", 2 }, + { "lines", 3 }, + { "native", 4 }, + { "null", 5 }, + { "snpc", 6 }, + { "mm", 7 }, + { "points", 8 }, + { "picas", 9 }, + { "bigpts", 10 }, + { "dida", 11 }, + { "cicero", 12 }, + { "scaledpts", 13 }, + { "strwidth", 14 }, + { "strheight", 15 }, + { "strascent", 16 }, + { "strdescent", 17 }, + + { "char", 18 }, + { "grobx", 19 }, + { "groby", 20 }, + { "grobwidth", 21 }, + { "grobheight", 22 }, + { "grobascent", 23 }, + { "grobdescent", 24 }, + + { "mylines", 103 }, + { "mychar", 104 }, + { "mystrwidth", 105 }, + { "mystrheight", 106 }, + + /* + * Some pseudonyms + */ + { "centimetre", 1001 }, + { "centimetres", 1001 }, + { "centimeter", 1001 }, + { "centimeters", 1001 }, + { "in", 1002 }, + { "inch", 1002 }, + { "line", 1003 }, + { "millimetre", 1007 }, + { "millimetres", 1007 }, + { "millimeter", 1007 }, + { "millimeters", 1007 }, + { "point", 1008 }, + { "pt", 1008 }, + + { NULL, -1 } +}; + +int convertUnit(SEXP unit, int index) +{ + int i = 0; + int result = 0; + int found = 0; + while (result >= 0 && !found) { + if (UnitTable[i].name == NULL) + result = -1; + else { + found = !strcmp(CHAR(STRING_ELT(unit, index)), UnitTable[i].name); + if (found) { + result = UnitTable[i].code; + /* resolve pseudonyms */ + if (result > 1000) { + result = result - 1000; + } + } + } + i += 1; + } + if (result < 0) + error(_("Invalid unit")); + return result; +} + +SEXP validUnits(SEXP units) +{ + int i; + int n = LENGTH(units); + SEXP answer = R_NilValue; + if (n > 0) { + if (isString(units)) { + PROTECT(answer = allocVector(INTSXP, n)); + for (i = 0; i<n; i++) + INTEGER(answer)[i] = convertUnit(units, i); + UNPROTECT(1); + } else { + error(_("'units' must be character")); + } + } else { + error(_("'units' must be of length > 0")); + } + return answer; +} diff --git a/com.oracle.truffle.r.native/gnur/patch/src/library/grid/src/util.c b/com.oracle.truffle.r.native/gnur/patch/src/library/grid/src/util.c new file mode 100644 index 0000000000000000000000000000000000000000..2a7c44832ed517d0fb005ea18bc7be9c3f77643d --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/library/grid/src/util.c @@ -0,0 +1,288 @@ +/* + * R : A Computer Language for Statistical Data Analysis + * Copyright (C) 2001-3 Paul Murrell + * 2003-8 The R Core Team + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version. + * + * This program 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 this program; if not, a copy is available at + * https://www.R-project.org/Licenses/ + */ + +#include "grid.h" +#include <string.h> + +/* Get the list element named str, or return NULL. + * Copied from the Writing R Extensions manual (which copied it from nls) + */ +SEXP getListElement(SEXP list, char *str) +{ + SEXP elmt = R_NilValue; + SEXP names = getAttrib(list, R_NamesSymbol); + int i; + + for (i = 0; i < length(list); i++) + if(strcmp(CHAR(STRING_ELT(names, i)), str) == 0) { + elmt = VECTOR_ELT(list, i); + break; + } + return elmt; +} + +void setListElement(SEXP list, char *str, SEXP value) +{ + SEXP names = getAttrib(list, R_NamesSymbol); + int i; + + for (i = 0; i < length(list); i++) + if(strcmp(CHAR(STRING_ELT(names, i)), str) == 0) { + SET_VECTOR_ELT(list, i, value); + break; + } +} + +/* The lattice R code checks values to make sure that they are numeric + * BUT we do not know whether the values are integer or real + * SO we have to be careful when extracting numeric values. + * This function assumes that x is numeric (obviously). + */ +double numeric(SEXP x, int index) +{ + if (isReal(x)) + return REAL(x)[index]; + else if (isInteger(x)) + return INTEGER(x)[index]; + return NA_REAL; +} + +/*********************** + * Stuff for rectangles + ***********************/ + +/* Fill a rectangle struct + */ +void rect(double x1, double x2, double x3, double x4, + double y1, double y2, double y3, double y4, + LRect *r) +{ + r->x1 = x1; + r->x2 = x2; + r->x3 = x3; + r->x4 = x4; + r->y1 = y1; + r->y2 = y2; + r->y3 = y3; + r->y4 = y4; +} + +void copyRect(LRect r1, LRect *r) +{ + r->x1 = r1.x1; + r->x2 = r1.x2; + r->x3 = r1.x3; + r->x4 = r1.x4; + r->y1 = r1.y1; + r->y2 = r1.y2; + r->y3 = r1.y3; + r->y4 = r1.y4; +} + +/* Do two lines intersect ? + * Algorithm from Paul Bourke + * (http://www.swin.edu.au/astronomy/pbourke/geometry/lineline2d/index.html) + */ +int linesIntersect(double x1, double x2, double x3, double x4, + double y1, double y2, double y3, double y4) +{ + double result = 0; + double denom = (y4 - y3)*(x2 - x1) - (x4 - x3)*(y2 - y1); + double ua = ((x4 - x3)*(y1 - y3) - (y4 - y3)*(x1 - x3)); + /* If the lines are parallel ... + */ + if (denom == 0) { + /* If the lines are coincident ... + */ + if (ua == 0) { + /* If the lines are vertical ... + */ + if (x1 == x2) { + /* Compare y-values + */ + if (!((y1 < y3 && fmax2(y1, y2) < fmin2(y3, y4)) || + (y3 < y1 && fmax2(y3, y4) < fmin2(y1, y2)))) + result = 1; + } else { + /* Compare x-values + */ + if (!((x1 < x3 && fmax2(x1, x2) < fmin2(x3, x4)) || + (x3 < x1 && fmax2(x3, x4) < fmin2(x1, x2)))) + result = 1; + } + } + } + /* ... otherwise, calculate where the lines intersect ... + */ + else { + double ub = ((x2 - x1)*(y1 - y3) - (y2 - y1)*(x1 - x3)); + ua = ua/denom; + ub = ub/denom; + /* Check for overlap + */ + if ((ua > 0 && ua < 1) && (ub > 0 && ub < 1)) + result = 1; + } + return (int) result; +} + +int edgesIntersect(double x1, double x2, double y1, double y2, + LRect r) +{ + int result = 0; + if (linesIntersect(x1, x2, r.x1, r.x2, y1, y2, r.y1, r.y2) || + linesIntersect(x1, x2, r.x2, r.x3, y1, y2, r.y2, r.y3) || + linesIntersect(x1, x2, r.x3, r.x4, y1, y2, r.y3, r.y4) || + linesIntersect(x1, x2, r.x4, r.x1, y1, y2, r.y4, r.y1)) + result = 1; + return result; +} + +/* Do two rects intersect ? + * For each edge in r1, does the edge intersect with any edge in r2 ? + * FIXME: Should add first check for non-intersection of + * bounding boxes of rects (?) + */ +int intersect(LRect r1, LRect r2) +{ + int result = 0; + if (edgesIntersect(r1.x1, r1.x2, r1.y1, r1.y2, r2) || + edgesIntersect(r1.x2, r1.x3, r1.y2, r1.y3, r2) || + edgesIntersect(r1.x3, r1.x4, r1.y3, r1.y4, r2) || + edgesIntersect(r1.x4, r1.x1, r1.y4, r1.y1, r2)) + result = 1; + return result; +} + +/* Calculate the bounding rectangle for a string. + * x and y assumed to be in INCHES. + */ +void textRect(double x, double y, SEXP text, int i, + const pGEcontext gc, + double xadj, double yadj, + double rot, pGEDevDesc dd, LRect *r) +{ + /* NOTE that we must work in inches for the angles to be correct + */ + LLocation bl, br, tr, tl; + LLocation tbl, tbr, ttr, ttl; + LTransform thisLocation, thisRotation, thisJustification; + LTransform tempTransform, transform; + double w, h; + if (isExpression(text)) { + SEXP expr = VECTOR_ELT(text, i % LENGTH(text)); + w = fromDeviceWidth(GEExpressionWidth(expr, gc, dd), + GE_INCHES, dd); + h = fromDeviceHeight(GEExpressionHeight(expr, gc, dd), + GE_INCHES, dd); + } else { + const char* string = CHAR(STRING_ELT(text, i % LENGTH(text))); + w = fromDeviceWidth(GEStrWidth(string, + (gc->fontface == 5) ? CE_SYMBOL : + getCharCE(STRING_ELT(text, i % LENGTH(text))), + gc, dd), + GE_INCHES, dd); + h = fromDeviceHeight(GEStrHeight(string, + (gc->fontface == 5) ? CE_SYMBOL : + getCharCE(STRING_ELT(text, i % LENGTH(text))), + gc, dd), + GE_INCHES, dd); + } + location(0, 0, bl); + location(w, 0, br); + location(w, h, tr); + location(0, h, tl); + translation(-xadj*w, -yadj*h, thisJustification); + translation(x, y, thisLocation); + if (rot != 0) + rotation(rot, thisRotation); + else + identity(thisRotation); + /* Position relative to origin of rotation THEN rotate. + */ + multiply(thisJustification, thisRotation, tempTransform); + /* Translate to (x, y) + */ + multiply(tempTransform, thisLocation, transform); + trans(bl, transform, tbl); + trans(br, transform, tbr); + trans(tr, transform, ttr); + trans(tl, transform, ttl); + rect(locationX(tbl), locationX(tbr), locationX(ttr), locationX(ttl), + locationY(tbl), locationY(tbr), locationY(ttr), locationY(ttl), + r); + /* For debugging, the following prints out an R statement to draw the + * bounding box + */ + /* + Rprintf("\ngrid.lines(c(%f, %f, %f, %f, %f), c(%f, %f, %f, %f, %f), default.units=\"inches\")\n", + locationX(tbl), locationX(tbr), locationX(ttr), locationX(ttl), + locationX(tbl), + locationY(tbl), locationY(tbr), locationY(ttr), locationY(ttl), + locationY(tbl) + ); + */ +} + +/*********************** + * Stuff for making persistent graphical objects + ***********************/ + +/* Will have already created an SEXP in R. This just stores the + * SEXP in an external reference so that I can get multiple + * references to it. + */ +SEXP L_CreateSEXPPtr(SEXP s) +{ + /* Allocate a list of length one on the R heap + */ + SEXP data, result; + PROTECT(data = allocVector(VECSXP, 1)); + SET_VECTOR_ELT(data, 0, s); + result = R_MakeExternalPtr(data, R_NilValue, data); + UNPROTECT(1); + return result; +} + +SEXP L_GetSEXPPtr(SEXP sp) +{ + SEXP data = R_ExternalPtrAddr(sp); + /* Check for NULL ptr + * This can occur if, for example, a grid grob is saved + * and then loaded. The saved grob has its ptr null'ed + */ + if (data == NULL) + error("grid grob object is empty"); + return VECTOR_ELT(data, 0); +} + +SEXP L_SetSEXPPtr(SEXP sp, SEXP s) +{ + SEXP data = R_ExternalPtrAddr(sp); + /* Check for NULL ptr + * This can occur if, for example, a grid grob is saved + * and then loaded. The saved grob has its ptr null'ed + */ + if (data == NULL) + error("grid grob object is empty"); + SET_VECTOR_ELT(data, 0, s); + return R_NilValue; +} + diff --git a/com.oracle.truffle.r.native/gnur/patch/src/library/grid/src/viewport.c b/com.oracle.truffle.r.native/gnur/patch/src/library/grid/src/viewport.c new file mode 100644 index 0000000000000000000000000000000000000000..697b02905f5cec4bc77ef07afe794ad7eb208af6 --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/library/grid/src/viewport.c @@ -0,0 +1,395 @@ +/* + * R : A Computer Language for Statistical Data Analysis + * Copyright (C) 2001-3 Paul Murrell + * 2003-2014 The R Core Team + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version. + * + * This program 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 this program; if not, a copy is available at + * https://www.R-project.org/Licenses/ + */ + +#include "grid.h" +#include <string.h> + +/* Some access methods for viewports */ +SEXP viewportX(SEXP vp) { + return VECTOR_ELT(vp, VP_X); +} + +SEXP viewportY(SEXP vp) { + return VECTOR_ELT(vp, VP_Y); +} + +SEXP viewportWidth(SEXP vp) { + return VECTOR_ELT(vp, VP_WIDTH); +} + +SEXP viewportHeight(SEXP vp) { + return VECTOR_ELT(vp, VP_HEIGHT); +} + +Rboolean viewportClip(SEXP vp) { + return LOGICAL(VECTOR_ELT(vp, VP_CLIP))[0]; +} + +double viewportXScaleMin(SEXP vp) { + return numeric(VECTOR_ELT(vp, VP_XSCALE), 0); +} + +double viewportXScaleMax(SEXP vp) { + return numeric(VECTOR_ELT(vp, VP_XSCALE), 1); +} + +double viewportYScaleMin(SEXP vp) { + return numeric(VECTOR_ELT(vp, VP_YSCALE), 0); +} + +double viewportYScaleMax(SEXP vp) { + return numeric(VECTOR_ELT(vp, VP_YSCALE), 1); +} + +double viewportAngle(SEXP vp) { + return numeric(VECTOR_ELT(vp, VP_ANGLE), 0); +} + +SEXP viewportLayout(SEXP vp) { + return VECTOR_ELT(vp, VP_LAYOUT); +} + +double viewportHJust(SEXP vp) { + return REAL(VECTOR_ELT(vp, VP_VALIDJUST))[0]; +} + +double viewportVJust(SEXP vp) { + return REAL(VECTOR_ELT(vp, VP_VALIDJUST))[1]; +} + +SEXP viewportLayoutPosRow(SEXP vp) { + return VECTOR_ELT(vp, VP_VALIDLPOSROW); +} + +SEXP viewportLayoutPosCol(SEXP vp) { + return VECTOR_ELT(vp, VP_VALIDLPOSCOL); +} + +SEXP viewportgpar(SEXP vp) { + return VECTOR_ELT(vp, PVP_GPAR); +} + +const char* viewportFontFamily(SEXP vp) { + return CHAR(STRING_ELT(VECTOR_ELT(VECTOR_ELT(vp, PVP_GPAR), GP_FONTFAMILY), + 0)); +} + +int viewportFont(SEXP vp) { + return INTEGER(VECTOR_ELT(VECTOR_ELT(vp, PVP_GPAR), GP_FONT))[0]; +} + +double viewportFontSize(SEXP vp) { + return REAL(VECTOR_ELT(VECTOR_ELT(vp, PVP_GPAR), GP_FONTSIZE))[0]; +} + +double viewportLineHeight(SEXP vp) { + return REAL(VECTOR_ELT(VECTOR_ELT(vp, PVP_GPAR), GP_LINEHEIGHT))[0]; +} + +double viewportCex(SEXP vp) { + return numeric(VECTOR_ELT(VECTOR_ELT(vp, PVP_GPAR), GP_CEX), 0); +} + +SEXP viewportTransform(SEXP vp) { + return VECTOR_ELT(vp, PVP_TRANS); +} + +SEXP viewportLayoutWidths(SEXP vp) { + return VECTOR_ELT(vp, PVP_WIDTHS); +} + +SEXP viewportLayoutHeights(SEXP vp) { + return VECTOR_ELT(vp, PVP_HEIGHTS); +} + +SEXP viewportWidthCM(SEXP vp) { + return VECTOR_ELT(vp, PVP_WIDTHCM); +} + +SEXP viewportHeightCM(SEXP vp) { + return VECTOR_ELT(vp, PVP_HEIGHTCM); +} + +SEXP viewportRotation(SEXP vp) { + return VECTOR_ELT(vp, PVP_ROTATION); +} + +SEXP viewportClipRect(SEXP vp) { + return VECTOR_ELT(vp, PVP_CLIPRECT); +} + +SEXP viewportParent(SEXP vp) { + return VECTOR_ELT(vp, PVP_PARENT); +} + +SEXP viewportChildren(SEXP vp) { + return VECTOR_ELT(vp, PVP_CHILDREN); +} + +SEXP viewportDevWidthCM(SEXP vp) { + return VECTOR_ELT(vp, PVP_DEVWIDTHCM); +} + +SEXP viewportDevHeightCM(SEXP vp) { + return VECTOR_ELT(vp, PVP_DEVHEIGHTCM); +} + +SEXP viewportParentGPar(SEXP vp) { + return VECTOR_ELT(vp, PVP_PARENTGPAR); +} + +void fillViewportLocationFromViewport(SEXP vp, LViewportLocation *vpl) +{ + vpl->x = viewportX(vp); + vpl->y = viewportY(vp); + vpl->width = viewportWidth(vp); + vpl->height = viewportHeight(vp); + vpl->hjust = viewportHJust(vp); + vpl->vjust = viewportVJust(vp); +} + +void fillViewportContextFromViewport(SEXP vp, + LViewportContext *vpc) +{ + vpc->xscalemin = viewportXScaleMin(vp); + vpc->xscalemax = viewportXScaleMax(vp); + vpc->yscalemin = viewportYScaleMin(vp); + vpc->yscalemax = viewportYScaleMax(vp); +} + +void copyViewportContext(LViewportContext vpc1, LViewportContext *vpc2) +{ + vpc2->xscalemin = vpc1.xscalemin; + vpc2->xscalemax = vpc1.xscalemax; + vpc2->yscalemin = vpc1.yscalemin; + vpc2->yscalemax = vpc1.yscalemax; +} + +void gcontextFromViewport(SEXP vp, const pGEcontext gc, pGEDevDesc dd) { + gcontextFromgpar(viewportgpar(vp), 0, gc, dd); +} + +/* The idea is to produce a transformation for this viewport which + * will take any location in INCHES and turn it into a location on the + * Device in INCHES. + * The reason for working in INCHES is because we want to be able to + * do rotations as part of the transformation. + * If "incremental" is true, then we just work from the "current" + * values of the parent. Otherwise, we have to recurse and recalculate + * everything from scratch. + */ +void calcViewportTransform(SEXP vp, SEXP parent, Rboolean incremental, + pGEDevDesc dd) +{ + int i, j; + double vpWidthCM, vpHeightCM, rotationAngle; + double parentWidthCM, parentHeightCM; + double xINCHES, yINCHES; + double xadj, yadj; + double parentAngle; + LViewportLocation vpl; + LViewportContext vpc, parentContext; + R_GE_gcontext gc, parentgc; + LTransform thisLocation, thisRotation, thisJustification, thisTransform; + LTransform tempTransform, parentTransform, transform; + SEXP currentWidthCM, currentHeightCM, currentRotation; + SEXP currentTransform; + /* This should never be true when we are doing an incremental + * calculation + */ + if (isNull(parent)) { + /* We have a top-level viewport; the parent is the device + */ + getDeviceSize(dd, &parentWidthCM, &parentHeightCM); + /* For a device the transform is the identity transform + */ + identity(parentTransform); + /* For a device, xmin=0, ymin=0, xmax=1, ymax=1, and + */ + parentContext.xscalemin = 0; + parentContext.yscalemin = 0; + parentContext.xscalemax = 1; + parentContext.yscalemax = 1; + /* FIXME: How do I figure out the device fontsize ? + * From ps.options etc, ... ? + * FIXME: How do I figure out the device lineheight ?? + * FIXME: How do I figure out the device cex ?? + * FIXME: How do I figure out the device font ?? + * FIXME: How do I figure out the device fontfamily ?? + */ + parentgc.ps = 10; + parentgc.lineheight = 1.2; + parentgc.cex = 1; + parentgc.fontface = 1; + parentgc.fontfamily[0] = '\0'; // This picks up the device default + /* The device is not rotated + */ + parentAngle = 0; + fillViewportLocationFromViewport(vp, &vpl); + } else { + /* Get parent transform (etc ...) + * If necessary, recalculate the parent transform (etc ...) + */ + if (!incremental) + calcViewportTransform(parent, viewportParent(parent), 0, dd); + /* Get information required to transform viewport location + */ + parentWidthCM = REAL(viewportWidthCM(parent))[0]; + parentHeightCM = REAL(viewportHeightCM(parent))[0]; + parentAngle = REAL(viewportRotation(parent))[0]; + for (i=0; i<3; i++) + for (j=0; j<3; j++) + parentTransform[i][j] = + REAL(viewportTransform(parent))[i +3*j]; + fillViewportContextFromViewport(parent, &parentContext); + /* + * Don't get gcontext from parent because the most recent + * previous gpar setting may have come from a gTree + * So we look at this viewport's parentgpar slot instead + * + * WAS gcontextFromViewport(parent, &parentgc); + */ + gcontextFromgpar(viewportParentGPar(vp), 0, &parentgc, dd); + /* In order for the vp to get its vpl from a layout + * it must have specified a layout.pos and the parent + * must have a layout + * FIXME: Actually, in addition, layout.pos.row and + * layout.pos.col must be valid for the layout + */ + if ((isNull(viewportLayoutPosRow(vp)) && + isNull(viewportLayoutPosCol(vp))) || + isNull(viewportLayout(parent))) + fillViewportLocationFromViewport(vp, &vpl); + else if (checkPosRowPosCol(vp, parent)) + calcViewportLocationFromLayout(viewportLayoutPosRow(vp), + viewportLayoutPosCol(vp), + parent, + &vpl); + } + /* NOTE that we are not doing a transformLocn here because + * we just want locations and dimensions (in INCHES) relative to + * the parent, NOT relative to the device. + */ + /* First, convert the location of the viewport into CM + */ + xINCHES = transformXtoINCHES(vpl.x, 0, parentContext, &parentgc, + parentWidthCM, parentHeightCM, + dd); + yINCHES = transformYtoINCHES(vpl.y, 0, parentContext, &parentgc, + parentWidthCM, parentHeightCM, + dd); + /* Calculate the width and height of the viewport in CM too + * so that any viewports within this one can do transformations + */ + vpWidthCM = transformWidthtoINCHES(vpl.width, 0, parentContext, &parentgc, + parentWidthCM, parentHeightCM, + dd)*2.54; + vpHeightCM = transformHeighttoINCHES(vpl.height, 0, parentContext, + &parentgc, + parentWidthCM, + parentHeightCM, + dd)*2.54; + /* Fall out if location or size are non-finite + */ + if (!R_FINITE(xINCHES) || + !R_FINITE(yINCHES) || + !R_FINITE(vpWidthCM) || + !R_FINITE(vpHeightCM)) + error(_("non-finite location and/or size for viewport")); + /* Determine justification required + */ + justification(vpWidthCM, vpHeightCM, vpl.hjust, vpl.vjust, + &xadj, &yadj); + /* Next, produce the transformation to add the location of + * the viewport to the location. + */ + /* Produce transform for this viewport + */ + translation(xINCHES, yINCHES, thisLocation); + if (viewportAngle(vp) != 0) + rotation(viewportAngle(vp), thisRotation); + else + identity(thisRotation); + translation(xadj/2.54, yadj/2.54, thisJustification); + /* Position relative to origin of rotation THEN rotate. + */ + multiply(thisJustification, thisRotation, tempTransform); + /* Translate to bottom-left corner. + */ + multiply(tempTransform, thisLocation, thisTransform); + /* Combine with parent's transform + */ + multiply(thisTransform, parentTransform, transform); + /* Sum up the rotation angles + */ + rotationAngle = parentAngle + viewportAngle(vp); + /* Finally, allocate the rows and columns for this viewport's + * layout if it has one + */ + if (!isNull(viewportLayout(vp))) { + fillViewportContextFromViewport(vp, &vpc); + gcontextFromViewport(vp, &gc, dd); + calcViewportLayout(vp, vpWidthCM, vpHeightCM, vpc, &gc, dd); + } + /* Record all of the answers in the viewport + * (the layout calculations are done within calcViewportLayout) + */ + PROTECT(currentWidthCM = ScalarReal(vpWidthCM)); + PROTECT(currentHeightCM = ScalarReal(vpHeightCM)); + PROTECT(currentRotation = ScalarReal(rotationAngle)); + PROTECT(currentTransform = allocMatrix(REALSXP, 3, 3)); + for (i=0; i<3; i++) + for (j=0; j<3; j++) + REAL(currentTransform)[i + 3*j] = transform[i][j]; + SET_VECTOR_ELT(vp, PVP_WIDTHCM, currentWidthCM); + SET_VECTOR_ELT(vp, PVP_HEIGHTCM, currentHeightCM); + SET_VECTOR_ELT(vp, PVP_ROTATION, currentRotation); + SET_VECTOR_ELT(vp, PVP_TRANS, currentTransform); + UNPROTECT(4); +} + +void initVP(pGEDevDesc dd) +{ + SEXP vpfnname, vpfn, vp; + SEXP xscale, yscale; + SEXP currentgp = gridStateElement(dd, GSS_GPAR); + SEXP gsd = (SEXP) dd->gesd[gridRegisterIndex]->systemSpecific; + PROTECT(vpfnname = findFun(install("grid.top.level.vp"), R_gridEvalEnv)); + PROTECT(vpfn = lang1(vpfnname)); + PROTECT(vp = eval(vpfn, R_GlobalEnv)); + /* + * Set the "native" scale of the top viewport to be the + * natural device coordinate system (e.g., points in + * postscript, pixels in X11, ...) + */ + PROTECT(xscale = allocVector(REALSXP, 2)); + REAL(xscale)[0] = dd->dev->left; + REAL(xscale)[1] = dd->dev->right; + SET_VECTOR_ELT(vp, VP_XSCALE, xscale); + PROTECT(yscale = allocVector(REALSXP, 2)); + REAL(yscale)[0] = dd->dev->bottom; + REAL(yscale)[1] = dd->dev->top; + SET_VECTOR_ELT(vp, VP_YSCALE, yscale); + SET_VECTOR_ELT(vp, PVP_GPAR, currentgp); + vp = doSetViewport(vp, TRUE, TRUE, dd); + SET_VECTOR_ELT(gsd, GSS_VP, vp); + UNPROTECT(5); +} + diff --git a/com.oracle.truffle.r.native/gnur/patch/src/library/methods/src/init.c b/com.oracle.truffle.r.native/gnur/patch/src/library/methods/src/init.c new file mode 100644 index 0000000000000000000000000000000000000000..b048a4df2843cef202d91c683a121922c0be9148 --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/library/methods/src/init.c @@ -0,0 +1,65 @@ +/* + * R : A Computer Language for Statistical Data Analysis + * Copyright (C) 2005-2017 The R Core Team. + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version. + * + * This program 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 this program; if not, a copy is available at + * https://www.R-project.org/Licenses/ + */ + +#include <R.h> +#include <Rinternals.h> + +#include "methods.h" +#include <R_ext/Rdynload.h> +#include <R_ext/Visibility.h> + +#define CALLDEF(name, n) {#name, (DL_FUNC) &name, n} + +static const R_CallMethodDef CallEntries[] = { + CALLDEF(R_M_setPrimitiveMethods, 5), + CALLDEF(R_clear_method_selection, 0), + CALLDEF(R_dummy_extern_place, 0), + CALLDEF(R_el_named, 2), + CALLDEF(R_externalptr_prototype_object, 0), + CALLDEF(R_getClassFromCache, 2), + CALLDEF(R_getGeneric, 4), + CALLDEF(R_get_slot, 2), + CALLDEF(R_hasSlot, 2), + CALLDEF(R_identC, 2), + CALLDEF(R_initMethodDispatch, 1), + CALLDEF(R_methodsPackageMetaName, 3), + CALLDEF(R_methods_test_MAKE_CLASS, 1), + CALLDEF(R_methods_test_NEW, 1), + CALLDEF(R_missingArg, 2), + CALLDEF(R_nextMethodCall, 2), + CALLDEF(R_quick_method_check, 3), + CALLDEF(R_selectMethod, 4), + CALLDEF(R_set_el_named, 3), + CALLDEF(R_set_slot, 3), + CALLDEF(R_standardGeneric, 3), + CALLDEF(do_substitute_direct, 2), + CALLDEF(Rf_allocS4Object, 0), + CALLDEF(R_set_method_dispatch, 1), + CALLDEF(R_get_primname, 1), + CALLDEF(new_object, 1), + {NULL, NULL, 0} +}; + +void attribute_visible +R_init_methods(DllInfo *dll) +{ + R_registerRoutines(dll, NULL, CallEntries, NULL, NULL); + R_useDynamicSymbols(dll, FALSE); + R_forceSymbols(dll, TRUE); +} diff --git a/com.oracle.truffle.r.native/gnur/patch/src/library/methods/src/methods.h b/com.oracle.truffle.r.native/gnur/patch/src/library/methods/src/methods.h new file mode 100644 index 0000000000000000000000000000000000000000..5b8f1a21e438ff1d76af88a1fcddd5e1244fdeda --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/library/methods/src/methods.h @@ -0,0 +1,57 @@ +/* + * R : A Computer Language for Statistical Data Analysis + * Copyright (C) 2005-12 The R Core Team. + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version. + * + * This program 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 this program; if not, a copy is available at + * https://www.R-project.org/Licenses/ + */ + +#include <Rinternals.h> +#ifdef ENABLE_NLS +#include <libintl.h> +#define _(String) dgettext ("methods", String) +#else +#define _(String) (String) +#endif + +#define DUPLICATE_CLASS_CASE(method) TYPEOF(method) == ENVSXP + + +SEXP R_M_setPrimitiveMethods(SEXP fname, SEXP op, SEXP code_vec, + SEXP fundef, SEXP mlist); +SEXP R_clear_method_selection(); +SEXP NORET R_dummy_extern_place(); +SEXP R_el_named(SEXP object, SEXP what); +SEXP R_externalptr_prototype_object(); +SEXP R_getGeneric(SEXP name, SEXP mustFind, SEXP env, SEXP package); +SEXP R_get_slot(SEXP obj, SEXP name); +SEXP R_getClassFromCache(SEXP class, SEXP table); +SEXP R_hasSlot(SEXP obj, SEXP name); +SEXP R_identC(SEXP e1, SEXP e2); +SEXP R_initMethodDispatch(SEXP envir); +SEXP R_methodsPackageMetaName(SEXP prefix, SEXP name, SEXP pkg); +SEXP R_methods_test_MAKE_CLASS(SEXP className); +SEXP R_methods_test_NEW(SEXP className); +SEXP R_missingArg(SEXP symbol, SEXP ev); +SEXP R_nextMethodCall(SEXP matched_call, SEXP ev); +SEXP R_quick_method_check(SEXP args, SEXP mlist, SEXP fdef); +SEXP R_selectMethod(SEXP fname, SEXP ev, SEXP mlist, SEXP evalArgs); +SEXP R_set_el_named(SEXP object, SEXP what, SEXP value); +SEXP R_set_slot(SEXP obj, SEXP name, SEXP value); +SEXP R_standardGeneric(SEXP fname, SEXP ev, SEXP fdef); +SEXP do_substitute_direct(SEXP f, SEXP env); +SEXP Rf_allocS4Object(); +SEXP R_set_method_dispatch(SEXP onOff); +SEXP R_get_primname(SEXP object); +SEXP new_object(SEXP class_def); diff --git a/com.oracle.truffle.r.native/gnur/patch/src/library/parallel/src/glpi.h b/com.oracle.truffle.r.native/gnur/patch/src/library/parallel/src/glpi.h new file mode 100644 index 0000000000000000000000000000000000000000..4957b8aa719169be2001bf3e470d16f9da70f067 --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/library/parallel/src/glpi.h @@ -0,0 +1,41 @@ +/* Mingw.org headers are missing this */ + +typedef enum _LOGICAL_PROCESSOR_RELATIONSHIP { + RelationProcessorCore, + RelationNumaNode, + RelationCache, + RelationProcessorPackage, + RelationGroup, + RelationAll=0xffff +} LOGICAL_PROCESSOR_RELATIONSHIP; + +typedef enum _PROCESSOR_CACHE_TYPE { + CacheUnified,CacheInstruction,CacheData,CacheTrace +} PROCESSOR_CACHE_TYPE; + +typedef struct _CACHE_DESCRIPTOR { + BYTE Level; + BYTE Associativity; + WORD LineSize; + DWORD Size; + PROCESSOR_CACHE_TYPE Type; +} CACHE_DESCRIPTOR,*PCACHE_DESCRIPTOR; + +typedef struct _SYSTEM_LOGICAL_PROCESSOR_INFORMATION { + ULONG_PTR ProcessorMask; + LOGICAL_PROCESSOR_RELATIONSHIP Relationship; + union { + struct { + BYTE Flags; + } ProcessorCore; + struct { + DWORD NodeNumber; + } NumaNode; + CACHE_DESCRIPTOR Cache; + ULONGLONG Reserved[2]; + }; +} SYSTEM_LOGICAL_PROCESSOR_INFORMATION,*PSYSTEM_LOGICAL_PROCESSOR_INFORMATION; + +WINBASEAPI WINBOOL WINAPI +GetLogicalProcessorInformation(PSYSTEM_LOGICAL_PROCESSOR_INFORMATION Buffer, + PDWORD ReturnedLength); diff --git a/com.oracle.truffle.r.native/gnur/patch/src/library/parallel/src/init.c b/com.oracle.truffle.r.native/gnur/patch/src/library/parallel/src/init.c new file mode 100644 index 0000000000000000000000000000000000000000..a2b75dd830ebe7b959ea6be4eb39e097e415c4a7 --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/library/parallel/src/init.c @@ -0,0 +1,61 @@ +/* + * R : A Computer Language for Statistical Data Analysis + * Copyright (C) 2011-2017 The R Core Team. + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version. + * + * This program 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 this program; if not, a copy is available at + * https://www.R-project.org/Licenses/ + */ + +#include <R.h> +#include "parallel.h" +#include <R_ext/Rdynload.h> +#include <R_ext/Visibility.h> + +#define CALLDEF(name, n) {#name, (DL_FUNC) &name, n} + +static const R_CallMethodDef callMethods[] = { + CALLDEF(nextStream, 1), + CALLDEF(nextSubStream, 1), +#ifndef _WIN32 + CALLDEF(mc_children, 0), + CALLDEF(mc_close_fds, 1), + CALLDEF(mc_close_stderr, 1), + CALLDEF(mc_close_stdout, 1), + CALLDEF(mc_exit, 1), + CALLDEF(mc_fds, 1), + CALLDEF(mc_fork, 1), + CALLDEF(mc_is_child, 0), + CALLDEF(mc_kill, 2), + CALLDEF(mc_master_fd, 0), + CALLDEF(mc_read_child, 1), + CALLDEF(mc_read_children, 1), + CALLDEF(mc_rm_child, 1), + CALLDEF(mc_send_master, 1), + CALLDEF(mc_select_children, 2), + CALLDEF(mc_send_child_stdin, 2), + CALLDEF(mc_affinity, 1), + CALLDEF(mc_interactive, 1), +#else + CALLDEF(ncpus, 1), +#endif + {NULL, NULL, 0} +}; + +void attribute_visible +R_init_parallel(DllInfo *dll) +{ + R_registerRoutines(dll, NULL, callMethods, NULL, NULL); + R_useDynamicSymbols(dll, FALSE); + R_forceSymbols(dll, FALSE); +} diff --git a/com.oracle.truffle.r.native/gnur/patch/src/library/parallel/src/parallel.h b/com.oracle.truffle.r.native/gnur/patch/src/library/parallel/src/parallel.h new file mode 100644 index 0000000000000000000000000000000000000000..a3674c876f56e643d623e5b5ddea4bda177daf91 --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/library/parallel/src/parallel.h @@ -0,0 +1,58 @@ +/* + * R : A Computer Language for Statistical Data Analysis + * Copyright (C) 2011 The R Core Team. + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version. + * + * This program 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 this program; if not, a copy is available at + * https://www.R-project.org/Licenses/ + */ + +#ifndef R_PARALLEL_H +#define R_PARALLEL_H + +#include <Rinternals.h> +#ifdef ENABLE_NLS +#include <libintl.h> +#define _(String) dgettext ("parallel", String) +#else +#define _(String) (String) +#endif + +SEXP nextStream(SEXP); +SEXP nextSubStream(SEXP); + +#ifndef _WIN32 +SEXP mc_children(void); +SEXP mc_close_fds(SEXP); +SEXP mc_close_stderr(SEXP); +SEXP mc_close_stdout(SEXP); +SEXP mc_create_list(SEXP); +SEXP mc_exit(SEXP); +SEXP mc_fds(SEXP); +SEXP mc_fork(SEXP); +SEXP mc_is_child(void); +SEXP mc_kill(SEXP, SEXP); +SEXP mc_master_fd(void); +SEXP mc_read_child(SEXP); +SEXP mc_read_children(SEXP); +SEXP mc_rm_child(SEXP); +SEXP mc_send_master(SEXP); +SEXP mc_select_children(SEXP, SEXP); +SEXP mc_send_child_stdin(SEXP, SEXP); +SEXP mc_affinity(SEXP); +SEXP mc_interactive(SEXP); +#else +SEXP ncpus(SEXP); +#endif + +#endif diff --git a/com.oracle.truffle.r.native/gnur/patch/src/library/parallel/src/rngstream.c b/com.oracle.truffle.r.native/gnur/patch/src/library/parallel/src/rngstream.c new file mode 100644 index 0000000000000000000000000000000000000000..3de81fbbcb3ba84bbb7efdae17b4cdc5775c338f --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/library/parallel/src/rngstream.c @@ -0,0 +1,99 @@ +/* + * R : A Computer Language for Statistical Data Analysis + * Copyright (C) 2011 The R Core Team. + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version. + * + * This program 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 this program; if not, a copy is available at + * https://www.R-project.org/Licenses/ + */ + +#include "parallel.h" +#include <stdint.h> + +typedef uint_least64_t Uint64; + +static Uint64 A1p76[3][3] = { + { 82758667, 1871391091, 4127413238 }, + { 3672831523, 69195019, 1871391091 }, + { 3672091415, 3528743235, 69195019 } + }; + +static Uint64 A2p76[3][3] = { + { 1511326704, 3759209742, 1610795712 }, + { 4292754251, 1511326704, 3889917532 }, + { 3859662829, 4292754251, 3708466080 } + }; + +static Uint64 A1p127[3][3] = { + { 2427906178, 3580155704, 949770784 }, + { 226153695, 1230515664, 3580155704 }, + { 1988835001, 986791581, 1230515664 } + }; + +static Uint64 A2p127[3][3] = { + { 1464411153, 277697599, 1610723613 }, + { 32183930, 1464411153, 1022607788 }, + { 2824425944, 32183930, 2093834863 } + }; + +SEXP nextStream(SEXP x) +{ + Uint64 seed[6], nseed[6], tmp; + for (int i = 0; i < 6; i++) seed[i] = (unsigned int)INTEGER(x)[i+1]; + for (int i = 0; i < 3; i++) { + tmp = 0; + for(int j = 0; j < 3; j++) { + tmp += A1p127[i][j] * seed[j]; + tmp %= 4294967087; + } + nseed[i] = tmp; + } + for (int i = 0; i < 3; i++) { + tmp = 0; + for(int j = 0; j < 3; j++) { + tmp += A2p127[i][j] * seed[j+3]; + tmp %= 4294944443; + } + nseed[i+3] = tmp; + } + SEXP ans = allocVector(INTSXP, 7); + INTEGER(ans)[0] = INTEGER(x)[0]; + for (int i = 0; i < 6; i++) INTEGER(ans)[i+1] = (int) nseed[i]; + return ans; +} + +SEXP nextSubStream(SEXP x) +{ + Uint64 seed[6], nseed[6], tmp; + for (int i = 0; i < 6; i++) seed[i] = (unsigned int)INTEGER(x)[i+1]; + for (int i = 0; i < 3; i++) { + tmp = 0; + for(int j = 0; j < 3; j++) { + tmp += A1p76[i][j] * seed[j]; + tmp %= 4294967087; + } + nseed[i] = tmp; + } + for (int i = 0; i < 3; i++) { + tmp = 0; + for(int j = 0; j < 3; j++) { + tmp += A2p76[i][j] * seed[j+3]; + tmp %= 4294944443; + } + nseed[i+3] = tmp; + } + SEXP ans = allocVector(INTSXP, 7); + INTEGER(ans)[0] = INTEGER(x)[0]; + for (int i = 0; i < 6; i++) INTEGER(ans)[i+1] = (int) nseed[i]; + return ans; +} diff --git a/com.oracle.truffle.r.native/gnur/patch/src/library/splines/src/splines.c b/com.oracle.truffle.r.native/gnur/patch/src/library/splines/src/splines.c new file mode 100644 index 0000000000000000000000000000000000000000..1bbae7b8951da8dd2242b003e8f278bd6015259d --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/library/splines/src/splines.c @@ -0,0 +1,253 @@ +/* Routines for manipulating B-splines. These are intended for use with + * S or S-PLUS or R. + * + * Copyright (C) 1998 Douglas M. Bates and William N. Venables. + * Copyright (C) 1999-2017 The R Core Team. + * + * This program 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. + * + * These functions are distributed in the hope that they 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 this program; if not, a copy is available at + * https://www.R-project.org/Licenses/ + * + * The routines are loosely based on the pseudo-code in Schumacher (Wiley, + * 1981) and the CMLIB library DBSPLINES. + */ + +#include <R.h> +#include <Rinternals.h> +#include <string.h> // for memcpy + +#ifdef ENABLE_NLS +#include <libintl.h> +#define _(String) dgettext ("splines", String) +#else +#define _(String) (String) +#endif + +typedef struct spl_struct { + int order, /* order of the spline */ + ordm1, /* order - 1 (3 for cubic splines) */ + nknots, /* number of knots */ + curs, /* current position in knots vector */ + boundary; /* must have knots[curs] <= x < knots[curs+1] */ + /* except for the boundary case */ + + double *ldel, /* differences from knots on the left */ + *rdel, /* differences from knots on the right */ + *knots, /* knot vector */ + *coeff, /* coefficients */ + *a; /* scratch array */ +} *splPTR; + +/* Exports */ +SEXP spline_basis(SEXP knots, SEXP order, SEXP xvals, SEXP derivs); +SEXP spline_value(SEXP knots, SEXP coeff, SEXP order, SEXP x, SEXP deriv); + + +/* set sp->curs to the index of the first knot position > x. + Special handling for x == sp->knots[sp->nknots - sp-order + 1] */ +static int +set_cursor(splPTR sp, double x) +{ + int i; + /* don't assume x's are sorted */ + + sp->curs = -1; /* Wall */ + sp->boundary = 0; + for (i = 0; i < sp->nknots; i++) { + if (sp->knots[i] >= x) sp->curs = i; + if (sp->knots[i] > x) break; + } + if (sp->curs > sp->nknots - sp->order) { + int lastLegit = sp->nknots - sp->order; + if (x == sp->knots[lastLegit]) { + sp->boundary = 1; sp->curs = lastLegit; + } + } + return sp->curs; +} + +static void +diff_table(splPTR sp, double x, int ndiff) +{ + int i; + for (i = 0; i < ndiff; i++) { + sp->rdel[i] = sp->knots[sp->curs + i] - x; + sp->ldel[i] = x - sp->knots[sp->curs - (i + 1)]; + } +} + +/* fast evaluation of basis functions */ +static void +basis_funcs(splPTR sp, double x, double *b) +{ + diff_table(sp, x, sp->ordm1); + b[0] = 1.; + for (int j = 1; j <= sp->ordm1; j++) { + double saved = 0.; + for (int r = 0; r < j; r++) { // do not divide by zero + double den = sp->rdel[r] + sp->ldel[j - 1 - r]; + if(den != 0) { + double term = b[r]/den; + b[r] = saved + sp->rdel[r] * term; + saved = sp->ldel[j - 1 - r] * term; + } else { + if(r != 0 || sp->rdel[r] != 0.) + b[r] = saved; + saved = 0.; + } + } + b[j] = saved; + } +} + +/* "slow" evaluation of (derivative of) basis functions */ +static double +evaluate(splPTR sp, double x, int nder) +{ + register double *lpt, *rpt, *apt, *ti = sp->knots + sp->curs; + int inner, outer = sp->ordm1; + + if (sp->boundary && nder == sp->ordm1) { /* value is arbitrary */ + return 0.0; + } + while(nder--) { // FIXME: divides by zero + for(inner = outer, apt = sp->a, lpt = ti - outer; inner--; apt++, lpt++) + *apt = outer * (*(apt + 1) - *apt)/(*(lpt + outer) - *lpt); + outer--; + } + diff_table(sp, x, outer); + while(outer--) + for(apt = sp->a, lpt = sp->ldel + outer, rpt = sp->rdel, inner = outer + 1; + inner--; lpt--, rpt++, apt++) + // FIXME: divides by zero + *apt = (*(apt + 1) * *lpt + *apt * *rpt)/(*rpt + *lpt); + return sp->a[0]; +} + +/* called from predict.bSpline() and predict.pbSpline() : */ +SEXP +spline_value(SEXP knots, SEXP coeff, SEXP order, SEXP x, SEXP deriv) +{ + SEXP val; + splPTR sp; + double *xx, *kk; + int n, nk; + + PROTECT(knots = coerceVector(knots, REALSXP)); + kk = REAL(knots); nk = length(knots); + PROTECT(coeff = coerceVector(coeff, REALSXP)); + PROTECT(x = coerceVector(x, REALSXP)); + xx = REAL(x); n = length(x); + int ord = asInteger(order); + int der = asInteger(deriv); + if (ord == NA_INTEGER || ord <= 0) + error(_("'ord' must be a positive integer")); + + /* populate the spl_struct */ + sp = (struct spl_struct *) R_alloc(1, sizeof(struct spl_struct)); + sp->order = ord; + sp->ordm1 = ord - 1; + sp->ldel = (double *) R_alloc(sp->ordm1, sizeof(double)); + sp->rdel = (double *) R_alloc(sp->ordm1, sizeof(double)); + sp->knots = kk; sp->nknots = nk; + sp->coeff = REAL(coeff); + sp->a = (double *) R_alloc(sp->order, sizeof(double)); + + PROTECT(val = allocVector(REALSXP, n)); + double *rval = REAL(val); + + for (int i = 0; i < n; i++) { + set_cursor(sp, xx[i]); + if (sp->curs < sp->order || sp->curs > (nk - sp->order)) { + rval[i] = R_NaN; + } else { + Memcpy(sp->a, sp->coeff + sp->curs - sp->order, sp->order); + rval[i] = evaluate(sp, xx[i], der); + } + } + UNPROTECT(4); + return val; +} + +/* called from splineDesign() : */ +SEXP +spline_basis(SEXP knots, SEXP order, SEXP xvals, SEXP derivs) +{ +/* evaluate the non-zero B-spline basis functions (or their derivatives) + * at xvals. */ + + PROTECT(knots = coerceVector(knots, REALSXP)); + double *kk = REAL(knots); int nk = length(knots); + int ord = asInteger(order); + PROTECT(xvals = coerceVector(xvals, REALSXP)); + double *xx = REAL(xvals); int nx = length(xvals); + PROTECT(derivs = coerceVector(derivs, INTSXP)); + int *ders = INTEGER(derivs), nd = length(derivs); + + splPTR sp = (struct spl_struct *) R_alloc(1, sizeof(struct spl_struct)); + /* fill sp : */ + sp->order = ord; + sp->ordm1 = ord - 1; + sp->rdel = (double *) R_alloc(sp->ordm1, sizeof(double)); + sp->ldel = (double *) R_alloc(sp->ordm1, sizeof(double)); + sp->knots = kk; sp->nknots = nk; + sp->a = (double *) R_alloc(sp->order, sizeof(double)); + SEXP val = PROTECT(allocMatrix(REALSXP, sp->order, nx)), + offsets = PROTECT(allocVector(INTSXP, nx)); + double *valM = REAL(val); + int *ioff = INTEGER(offsets); + + for(int i = 0; i < nx; i++) { + set_cursor(sp, xx[i]); + int io = ioff[i] = sp->curs - sp->order; + if (io < 0 || io > nk) { + for (int j = 0; j < sp->order; j++) { + valM[i * sp->order + j] = R_NaN; + } + } else if (ders[i % nd] > 0) { /* slow method for derivatives */ + for(int ii = 0; ii < sp->order; ii++) { + for(int j = 0; j < sp->order; j++) sp->a[j] = 0; + sp->a[ii] = 1; + valM[i * sp->order + ii] = + evaluate(sp, xx[i], ders[i % nd]); + } + } else { /* fast method for value */ + basis_funcs(sp, xx[i], valM + i * sp->order); + } + } + setAttrib(val, install("Offsets"), offsets); + UNPROTECT(5); + return val; +} + +#include <R_ext/Rdynload.h> + +#define CALLDEF(name, n) {#name, (DL_FUNC) &name, n} + +static const R_CallMethodDef R_CallDef[] = { + CALLDEF(spline_basis, 4), + CALLDEF(spline_value, 5), + {NULL, NULL, 0} +}; + + +void +#ifdef HAVE_VISIBILITY_ATTRIBUTE +__attribute__ ((visibility ("default"))) +#endif +R_init_splines(DllInfo *dll) +{ + R_registerRoutines(dll, NULL, R_CallDef, NULL, NULL); + R_useDynamicSymbols(dll, FALSE); + R_forceSymbols(dll, TRUE); +} diff --git a/com.oracle.truffle.r.native/gnur/patch/src/library/stats/src/bsplvd.f b/com.oracle.truffle.r.native/gnur/patch/src/library/stats/src/bsplvd.f new file mode 100644 index 0000000000000000000000000000000000000000..97e0695824543822738fc9d86a0cca8de74407c3 --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/library/stats/src/bsplvd.f @@ -0,0 +1,228 @@ + subroutine bsplvd ( t, lent, k, x, left, a, dbiatx, nderiv ) +c -------- ------ +c implicit none + +C calculates value and deriv.s of all b-splines which do not vanish at x +C calls bsplvb +c +c****** i n p u t ****** +c t the knot array, of length left+k (at least) +c k the order of the b-splines to be evaluated +c x the point at which these values are sought +c left an integer indicating the left endpoint of the interval of +c interest. the k b-splines whose support contains the interval +c (t(left), t(left+1)) +c are to be considered. +c a s s u m p t i o n - - - it is assumed that +c t(left) < t(left+1) +c division by zero will result otherwise (in b s p l v b ). +c also, the output is as advertised only if +c t(left) <= x <= t(left+1) . +c nderiv an integer indicating that values of b-splines and their +c derivatives up to but not including the nderiv-th are asked +c for. ( nderiv is replaced internally by the integer in (1,k) +c closest to it.) +c +c****** w o r k a r e a ****** +c a an array of order (k,k), to contain b-coeff.s of the derivat- +c ives of a certain order of the k b-splines of interest. +c +c****** o u t p u t ****** +c dbiatx an array of order (k,nderiv). its entry (i,m) contains +c value of (m-1)st derivative of (left-k+i)-th b-spline of +c order k for knot sequence t , i=m,...,k; m=1,...,nderiv. +c +c****** m e t h o d ****** +c values at x of all the relevant b-splines of order k,k-1,..., +c k+1-nderiv are generated via bsplvb and stored temporarily +c in dbiatx . then, the b-coeffs of the required derivatives of the +c b-splines of interest are generated by differencing, each from the +c preceding one of lower order, and combined with the values of b- +c splines of corresponding order in dbiatx to produce the desired +c values. + +C Args + integer lent,k,left,nderiv + double precision t(lent),x, dbiatx(k,nderiv), a(k,k) +C Locals + double precision factor,fkp1mm,sum + integer i,ideriv,il,j,jlow,jp1mid, kp1,kp1mm,ldummy,m,mhigh + + mhigh = max0(min0(nderiv,k),1) +c mhigh is usually equal to nderiv. + kp1 = k+1 + call bsplvb(t,lent,kp1-mhigh,1,x,left,dbiatx) + if (mhigh .eq. 1) return +c the first column of dbiatx always contains the b-spline values +c for the current order. these are stored in column k+1-current +c order before bsplvb is called to put values for the next +c higher order on top of it. + ideriv = mhigh + do 15 m=2,mhigh + jp1mid = 1 + do 11 j=ideriv,k + dbiatx(j,ideriv) = dbiatx(jp1mid,1) + jp1mid = jp1mid + 1 + 11 continue + ideriv = ideriv - 1 + call bsplvb(t,lent,kp1-ideriv,2,x,left,dbiatx) + 15 continue +c +c at this point, b(left-k+i, k+1-j)(x) is in dbiatx(i,j) for +c i=j,...,k and j=1,...,mhigh ('=' nderiv). in particular, the +c first column of dbiatx is already in final form. to obtain cor- +c responding derivatives of b-splines in subsequent columns, gene- +c rate their b-repr. by differencing, then evaluate at x. +c + jlow = 1 + do 20 i=1,k + do 19 j=jlow,k + a(j,i) = 0d0 + 19 continue + jlow = i + a(i,i) = 1d0 + 20 continue +c at this point, a(.,j) contains the b-coeffs for the j-th of the +c k b-splines of interest here. +c + do 45 m=2,mhigh + kp1mm = kp1 - m + fkp1mm = dble(kp1mm) + il = left + i = k +c +c for j=1,...,k, construct b-coeffs of (m-1)st derivative of +c b-splines from those for preceding derivative by differencing +c and store again in a(.,j) . the fact that a(i,j) = 0 for +c i < j is used.sed. + do 25 ldummy=1,kp1mm + factor = fkp1mm/(t(il+kp1mm) - t(il)) +c the assumption that t(left) < t(left+1) makes denominator +c in factor nonzero. + do 24 j=1,i + a(i,j) = (a(i,j) - a(i-1,j))*factor + 24 continue + il = il - 1 + i = i - 1 + 25 continue +c +c for i=1,...,k, combine b-coeffs a(.,i) with b-spline values +c stored in dbiatx(.,m) to get value of (m-1)st derivative of +c i-th b-spline (of interest here) at x , and store in +c dbiatx(i,m). storage of this value over the value of a b-spline +c of order m there is safe since the remaining b-spline derivat- +c ive of the same order do not use this value due to the fact +c that a(j,i) = 0 for j < i . + do 40 i=1,k + sum = 0.d0 + jlow = max0(i,m) + do 35 j=jlow,k + sum = a(j,i)*dbiatx(j,m) + sum + 35 continue + dbiatx(i,m) = sum + 40 continue + 45 continue + end + + subroutine bsplvb ( t, lent,jhigh, index, x, left, biatx ) +c implicit none +c ------------- + +calculates the value of all possibly nonzero b-splines at x of order +c +c jout = dmax( jhigh , (j+1)*(index-1) ) +c +c with knot sequence t . +c +c****** i n p u t ****** +c t.....knot sequence, of length left + jout , assumed to be nonde- +c creasing. +c a s s u m p t i o n : t(left) < t(left + 1) +c d i v i s i o n b y z e r o will result if t(left) = t(left+1) +c +c jhigh, +c index.....integers which determine the order jout = max(jhigh, +c (j+1)*(index-1)) of the b-splines whose values at x are to +c be returned. index is used to avoid recalculations when seve- +c ral columns of the triangular array of b-spline values are nee- +c ded (e.g., in bvalue or in bsplvd ). precisely, +c if index = 1 , +c the calculation starts from scratch and the entire triangular +c array of b-spline values of orders 1,2,...,jhigh is generated +c order by order , i.e., column by column . +c if index = 2 , +c only the b-spline values of order j+1, j+2, ..., jout are ge- +c nerated, the assumption being that biatx , j , deltal , deltar +c are, on entry, as they were on exit at the previous call. +c in particular, if jhigh = 0, then jout = j+1, i.e., just +c the next column of b-spline values is generated. +c +c w a r n i n g . . . the restriction jout <= jmax (= 20) is +c imposed arbitrarily by the dimension statement for deltal and +c deltar below, but is n o w h e r e c h e c k e d for . +c +c x.....the point at which the b-splines are to be evaluated. +c left.....an integer chosen (usually) so that +c t(left) <= x <= t(left+1) . +c +c****** o u t p u t ****** +c biatx.....array of length jout , with biatx(i) containing the val- +c ue at x of the polynomial of order jout which agrees with +c the b-spline b(left-jout+i,jout,t) on the interval (t(left), +c t(left+1)) . +c +c****** m e t h o d ****** +c the recurrence relation +c +c x - t(i) t(i+j+1) - x +c b(i,j+1)(x) = ----------- b(i,j)(x) + --------------- b(i+1,j)(x) +c t(i+j)-t(i) t(i+j+1)-t(i+1) +c +c is used (repeatedly) to generate the +c (j+1)-vector b(left-j,j+1)(x),...,b(left,j+1)(x) +c from the j-vector b(left-j+1,j)(x),...,b(left,j)(x), +c storing the new values in biatx over the old. the facts that +c b(i,1) = 1 if t(i) <= x < t(i+1) +c and that +c b(i,j)(x) = 0 unless t(i) <= x < t(i+j) +c are used. the particular organization of the calculations follows +c algorithm (8) in chapter x of the text. +c + +C Arguments + integer lent, jhigh, index, left + double precision t(lent),x, biatx(jhigh) +c dimension t(left+jout), biatx(jout) +c ----------------------------------- +c current fortran standard makes it impossible to specify the length of +c t and of biatx precisely without the introduction of otherwise +c superfluous additional arguments. + +C Local Variables + integer jmax + parameter(jmax = 20) + integer i,j,jp1 + double precision deltal(jmax), deltar(jmax),saved,term + + save j,deltal,deltar + data j/1/ +c +c go to (10,20), index + if (index .eq. 2) go to 20 + j = 1 + biatx(1) = 1d0 + if (j .ge. jhigh) return +c + 20 jp1 = j + 1 + deltar(j) = t(left+j) - x + deltal(j) = x - t(left+1-j) + saved = 0d0 + do 26 i=1,j + term = biatx(i)/(deltar(i) + deltal(jp1-i)) + biatx(i) = saved + deltar(i)*term + saved = deltal(jp1-i)*term + 26 continue + biatx(jp1) = saved + j = jp1 + if (j .lt. jhigh) go to 20 + end diff --git a/com.oracle.truffle.r.native/gnur/patch/src/library/stats/src/bvalue.f b/com.oracle.truffle.r.native/gnur/patch/src/library/stats/src/bvalue.f new file mode 100644 index 0000000000000000000000000000000000000000..4abf281c9ef237f67fe320f7c40207bd404efdb6 --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/library/stats/src/bvalue.f @@ -0,0 +1,185 @@ + double precision function bvalue(t,bcoef,n,k,x,jderiv) + +c Calculates value at x of jderiv-th derivative of spline from B-repr. +c The spline is taken to be continuous from the right. +c +C calls interv() (from ../../../appl/interv.c ) +c +c****** i n p u t ****** +c t, bcoef, n, k......forms the b-representation of the spline f to +c be evaluated. specifically, +c t.....knot sequence, of length n+k, assumed nondecreasing. +c bcoef.....b-coefficient sequence, of length n . +c n.....length of bcoef and dimension of s(k,t), +c a s s u m e d positive . +c k.....order of the spline . +c +c w a r n i n g . . . the restriction k <= kmax (=20) is imposed +c arbitrarily by the dimension statement for aj, dm, dm below, +c but is n o w h e r e c h e c k e d for. +c however in R, this is only called from bvalus() with k=4 anyway! +c +c x.....the point at which to evaluate . +c jderiv.....integer giving the order of the derivative to be evaluated +c a s s u m e d to be zero or positive. +c +c****** o u t p u t ****** +c bvalue.....the value of the (jderiv)-th derivative of f at x . +c +c****** m e t h o d ****** +c the nontrivial knot interval (t(i),t(i+1)) containing x is lo- +c cated with the aid of interv(). the k b-coeffs of f relevant for +c this interval are then obtained from bcoef (or taken to be zero if +c not explicitly available) and are then differenced jderiv times to +c obtain the b-coeffs of (d^jderiv)f relevant for that interval. +c precisely, with j = jderiv, we have from x.(12) of the text that +c +c (d^j)f = sum ( bcoef(.,j)*b(.,k-j,t) ) +c +c where +c / bcoef(.), , j .eq. 0 +c / +c bcoef(.,j) = / bcoef(.,j-1) - bcoef(.-1,j-1) +c / ----------------------------- , j > 0 +c / (t(.+k-j) - t(.))/(k-j) +c +c then, we use repeatedly the fact that +c +c sum ( a(.)*b(.,m,t)(x) ) = sum ( a(.,x)*b(.,m-1,t)(x) ) +c with +c (x - t(.))*a(.) + (t(.+m-1) - x)*a(.-1) +c a(.,x) = --------------------------------------- +c (x - t(.)) + (t(.+m-1) - x) +c +c to write (d^j)f(x) eventually as a linear combination of b-splines +c of order 1 , and the coefficient for b(i,1,t)(x) must then +c be the desired number (d^j)f(x). (see x.(17)-(19) of text). +c +C Arguments + integer n,k, jderiv + DOUBLE precision t(*),bcoef(n),x +c dimension t(n+k) +c current fortran standard makes it impossible to specify the length of +c t precisely without the introduction of otherwise superfluous +c additional arguments. + +C Local Variables + integer kmax + parameter(kmax = 20) + + DOUBLE precision aj(kmax),dm(kmax),dp(kmax),fkmj + + integer i,ilo,imk,j,jc,jcmin,jcmax,jj,km1,kmj,mflag,nmi, jdrvp1 +c + integer interv + external interv + +c initialize + data i/1/ + + bvalue = 0.d0 + if (jderiv .ge. k) go to 99 +c +c *** find i s.t. 1 <= i < n+k and t(i) < t(i+1) and +c t(i) <= x < t(i+1) . if no such i can be found, x lies +c outside the support of the spline f and bvalue = 0. +c {this case is handled in the calling R code} +c (the asymmetry in this choice of i makes f rightcontinuous) + if( (x.ne.t(n+1)) .or. (t(n+1).ne.t(n+k)) ) then + i = interv ( t, n+k, x, 0, 0, i, mflag) + if (mflag .ne. 0) then + call rwarn('bvalue() mflag != 0: should never happen!') + go to 99 + endif + else + i = n + endif + +c *** if k = 1 (and jderiv = 0), bvalue = bcoef(i). + km1 = k - 1 + if (km1 .le. 0) then + bvalue = bcoef(i) + go to 99 + endif +c +c *** store the k b-spline coefficients relevant for the knot interval +c (t(i),t(i+1)) in aj(1),...,aj(k) and compute dm(j) = x - t(i+1-j), +c dp(j) = t(i+j) - x, j=1,...,k-1 . set any of the aj not obtainable +c from input to zero. set any t.s not obtainable equal to t(1) or +c to t(n+k) appropriately. + jcmin = 1 + imk = i - k + if (imk .ge. 0) then + do 9 j=1,km1 + dm(j) = x - t(i+1-j) + 9 continue + else + jcmin = 1 - imk + do 5 j=1,i + dm(j) = x - t(i+1-j) + 5 continue + do 6 j=i,km1 + aj(k-j) = 0.d0 + dm(j) = dm(i) + 6 continue + endif +c + jcmax = k + nmi = n - i + if (nmi .ge. 0) then + do 19 j=1,km1 +C the following if() happens; e.g. in pp <- predict(cars.spl, xx) +c - if( (i+j) .gt. lent) write(6,9911) i+j,lent +c - 9911 format(' i+j, lent ',2(i6,1x)) + dp(j) = t(i+j) - x + 19 continue + else + jcmax = k + nmi + do 15 j=1,jcmax + dp(j) = t(i+j) - x + 15 continue + do 16 j=jcmax,km1 + aj(j+1) = 0.d0 + dp(j) = dp(jcmax) + 16 continue + endif + +c + do 21 jc=jcmin,jcmax + aj(jc) = bcoef(imk + jc) + 21 continue +c +c *** difference the coefficients jderiv times. + if (jderiv .ge. 1) then + do 23 j=1,jderiv + kmj = k-j + fkmj = dble(kmj) + ilo = kmj + do 24 jj=1,kmj + aj(jj) = ((aj(jj+1) - aj(jj))/(dm(ilo) + dp(jj)))*fkmj + ilo = ilo - 1 + 24 continue + 23 continue + endif + +c +c *** compute value at x in (t(i),t(i+1)) of jderiv-th derivative, +c given its relevant b-spline coeffs in aj(1),...,aj(k-jderiv). + + if (jderiv .ne. km1) then + jdrvp1 = jderiv + 1 + do 33 j=jdrvp1,km1 + kmj = k-j + ilo = kmj + do 34 jj=1,kmj + aj(jj) = (aj(jj+1)*dm(ilo) + aj(jj)*dp(jj)) / + * (dm(ilo)+dp(jj)) + ilo = ilo - 1 + 34 continue + 33 continue + endif + + bvalue = aj(1) +c + 99 return + end diff --git a/com.oracle.truffle.r.native/gnur/patch/src/library/stats/src/bvalus.f b/com.oracle.truffle.r.native/gnur/patch/src/library/stats/src/bvalus.f new file mode 100644 index 0000000000000000000000000000000000000000..1dd84f856ecf005cf922c5a7f3188ff481541bad --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/library/stats/src/bvalus.f @@ -0,0 +1,13 @@ + subroutine bvalus(n,knot,coef,nk,x,s,order) +C Args + integer n, nk, order + double precision knot(*),coef(*),x(*),s(*) +C Local + double precision bvalue + integer i + + do 10 i=1,n + s(i)=bvalue(knot,coef,nk,4,x(i),order) + 10 continue + return + end diff --git a/com.oracle.truffle.r.native/gnur/patch/src/library/stats/src/eureka.f b/com.oracle.truffle.r.native/gnur/patch/src/library/stats/src/eureka.f new file mode 100644 index 0000000000000000000000000000000000000000..8397d8e6869d414dc0b116d5d1984fbd4fff526b --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/library/stats/src/eureka.f @@ -0,0 +1,70 @@ +c----------------------------------------------------------------------- +c +c R : A Computer Language for Statistical Data Analysis +c Copyright (C) 1977 B.D. Ripley +c Copyright (C) 1999 the R Core Team +c +c This program is free software; you can redistribute it and/or modify +c it under the terms of the GNU General Public License as published by +c the Free Software Foundation; either version 2 of the License, or +c (at your option) any later version. +c +c This program is distributed in the hope that it will be useful, +c but WITHOUT ANY WARRANTY; without even the implied warranty of +c MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +c GNU General Public License for more details. +c +c You should have received a copy of the GNU General Public License +c along with this program; if not, a copy is available at +c https://www.R-project.org/Licenses/ +c +c----------------------------------------------------------------------- +c + subroutine eureka (lr,r,g,f,var,a) +c +c solves Toeplitz matrix equation toep(r)f=g(1+.) +c by Levinson's algorithm +c a is a workspace of size lr, the number +c of equations +c + integer lr,l,l1,l2,i,j,k + double precision r(lr+1), g(lr+1), f(lr,lr), a(lr), var(lr) + double precision v, d, q, hold + v = r(1) + d = r(2) + a(1) = 1.0d0 + f(1,1) = g(2)/v + q = f(1,1)*r(2) + var(1) = (1 - f(1,1)*f(1,1))*r(1) + if (lr .eq. 1) return + do 60 l = 2, lr + a(l) = -d/v + if (l .gt. 2) then + l1 = (l - 2)/2 + l2 = l1 + 1 + do 10 j = 2, l2 + hold = a(j) + k = l - j + 1 + a(j) = a(j) + a(l)*a(k) + a(k) = a(k) + a(l)*hold + 10 continue + if (2*l1 .ne. l - 2) a(l2+1) = a(l2+1)*(1.0d0 + a(l)) + endif + v = v + a(l)*d + f(l,l) = (g(l+1) - q)/v + do 40 j = 1, l-1 + f(l,j) = f(l-1, j) + f(l, l)*a(l-j+1) + 40 continue +c estimate the innovations variance + var(l) = var(l-1) * (1 - f(l,l)*f(l,l)) + if (l .eq. lr) return + d = 0.0d0 + q = 0.0d0 + do 50 i = 1, l + k = l-i+2 + d = d + a(i)*r(k) + q = q + f(l,i)*r(k) + 50 continue + 60 continue + return + end diff --git a/com.oracle.truffle.r.native/gnur/patch/src/library/stats/src/fft.c b/com.oracle.truffle.r.native/gnur/patch/src/library/stats/src/fft.c new file mode 100644 index 0000000000000000000000000000000000000000..451bd8d5a0be8ac481bac29672cb5acee5cc1fce --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/library/stats/src/fft.c @@ -0,0 +1,873 @@ +/* + * R : A Computer Language for Statistical Data Analysis + * Copyright (C) 1995, 1996, 1997 Robert Gentleman and Ross Ihaka + * Copyright (C) 1998--2000, 2013 The R Core Team + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version. + * + * This program 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 this program; if not, a copy is available at + * https://www.R-project.org/Licenses/ + */ + +#ifdef HAVE_CONFIG_H +#include <config.h> +#endif + +#include <limits.h> /* for INT_MAX */ +#include <stddef.h> /* for size_t */ +#include <stdlib.h> /* for abs */ +#include <math.h> +#include <Rmath.h> /* for imax2(.),..*/ +#include <R_ext/Applic.h> + +/* Fast Fourier Transform + * + * These routines are based on code by Richard Singleton in the + * book "Programs for Digital Signal Processing" put out by IEEE. + * + * I have translated them to C and moved the memory allocation + * so that it takes place under the control of the algorithm + * which calls these; for R, see ../main/fourier.c + * + * void fft_factor(int n, int *maxf, int *maxp) + * + * This factorizes the series length and computes the values of + * maxf and maxp which determine the amount of scratch storage + * required by the algorithm. + * + * If maxf is zero on return, an error occured during factorization. + * The nature of the error can be determined from the value of maxp. + * If maxp is zero, an invalid (zero) parameter was passed and + * if maxp is one, the internal nfac array was too small. This can only + * happen for series lengths which exceed 12,754,584. + * + * PROBLEM (see fftmx below): nfac[] is overwritten by fftmx() in fft_work() + * ------- Consequence: fft_factor() must be called way too often, + * at least from do_mvfft() [ ../main/fourier.c ] + * + * The following arrays need to be allocated following the call to + * fft_factor and preceding the call to fft_work. + * + * work double[4*maxf] + * iwork int[maxp] + * + * int fft_work(double *a, double *b, int nseg, int n, int nspn, + * int isn, double *work, int *iwork) + * + * The routine returns 1 if the transform was completed successfully and + * 0 if invalid values of the parameters were supplied. + * + * Ross Ihaka + * University of Auckland + * February 1997 + * ========================================================================== + * + * Header from the original Singleton algorithm: + * + * -------------------------------------------------------------- + * subroutine: fft + * multivariate complex fourier transform, computed in place + * using mixed-radix fast fourier transform algorithm. + * -------------------------------------------------------------- + * + * arrays a and b originally hold the real and imaginary + * components of the data, and return the real and + * imaginary components of the resulting fourier coefficients. + * multivariate data is indexed according to the fortran + * array element successor function, without limit + * on the number of implied multiple subscripts. + * the subroutine is called once for each variate. + * the calls for a multivariate transform may be in any order. + * + * n is the dimension of the current variable. + * nspn is the spacing of consecutive data values + * while indexing the current variable. + * nseg nseg*n*nspn is the total number of complex data values. + * isn the sign of isn determines the sign of the complex + * exponential, and the magnitude of isn is normally one. + * the magnitude of isn determines the indexing increment for a&b. + * + * if fft is called twice, with opposite signs on isn, an + * identity transformation is done...calls can be in either order. + * the results are scaled by 1/n when the sign of isn is positive. + * + * a tri-variate transform with a(n1,n2,n3), b(n1,n2,n3) + * is computed by + * call fft(a,b,n2*n3,n1, 1, -1) + * call fft(a,b,n3 ,n2,n1, -1) + * call fft(a,b,1, n3,n1*n2,-1) + * + * a single-variate transform of n complex data values is computed by + * call fft(a,b,1,n,1,-1) + * + * the data may alternatively be stored in a single complex + * array a, then the magnitude of isn changed to two to + * give the correct indexing increment and a(2) used to + * pass the initial address for the sequence of imaginary + * values, e.g. + * call fft(a,a(2),nseg,n,nspn,-2) + * + * nfac[15] (array) is working storage for factoring n. the smallest + * number exceeding the 15 locations provided is 12,754,584. + * + * Update in R 3.1.0: nfac[20], increased array size. It is now possible to + * factor any positive int n, up to 2^31 - 1. + */ + +static void fftmx(double *a, double *b, int ntot, int n, int nspan, int isn, + int m, int kt, double *at, double *ck, double *bt, double *sk, + int *np, int *nfac) +{ +/* called from fft_work() */ + +/* Design BUG: One purpose of fft_factor() would be to compute + * ---------- nfac[] once and for all; and fft_work() [i.e. fftmx ] + * could reuse the factorization. + * However: nfac[] is `destroyed' currently in the code below + */ + double aa, aj, ajm, ajp, ak, akm, akp; + double bb, bj, bjm, bjp, bk, bkm, bkp; + double c1, c2=0, c3=0, c72, cd; + double dr, rad; + double s1, s120, s2=0, s3=0, s72, sd; + int i, inc, j, jc, jf, jj; + int k, k1, k2, k3=0, k4, kk, klim, ks, kspan, kspnn; + int lim, maxf, mm, nn, nt; + + a--; b--; at--; ck--; bt--; sk--; + np--; + nfac--;/*the global one!*/ + + inc = abs(isn); + nt = inc*ntot; + ks = inc*nspan; + rad = M_PI_4;/* = pi/4 =^= 45 degrees */ + s72 = rad/0.625;/* 72 = 45 / .625 degrees */ + c72 = cos(s72); + s72 = sin(s72); + s120 = 0.5*M_SQRT_3;/* sin(120) = sqrt(3)/2 */ + if(isn <= 0) { + s72 = -s72; + s120 = -s120; + rad = -rad; + } else { +#ifdef SCALING + /* scale by 1/n for isn > 0 */ + ak = 1.0/n; + for(j=1 ; j<=nt ; j+=inc) { + a[j] *= ak; + b[j] *= ak; + } +#endif + } + + kspan = ks; + nn = nt - inc; + jc = ks/n; + + /* sin, cos values are re-initialized each lim steps */ + + lim = 32; + klim = lim*jc; + i = 0; + jf = 0; + maxf = nfac[m - kt]; + if(kt > 0) maxf = imax2(nfac[kt],maxf); + + /* compute fourier transform */ + +L_start: + dr = (8.0*jc)/kspan; + cd = sin(0.5*dr*rad); + cd = 2.0*cd*cd; + sd = sin(dr*rad); + kk = 1; + i++; + if( nfac[i] != 2) goto L110; + +/* transform for factor of 2 (including rotation factor) */ + + kspan /= 2; + k1 = kspan + 2; + do { + do { + k2 = kk + kspan; + ak = a[k2]; + bk = b[k2]; + a[k2] = a[kk] - ak; + b[k2] = b[kk] - bk; + a[kk] += ak; + b[kk] += bk; + kk = k2 + kspan; + } while(kk <= nn); + kk -= nn; + } while(kk <= jc); + + if(kk > kspan) goto L_fin; +L60: + c1 = 1.0 - cd; + s1 = sd; + mm = imin2(k1/2,klim); + goto L80; + +L70: + ak = c1 - (cd*c1+sd*s1); + s1 = (sd*c1-cd*s1) + s1; + +/* the following three statements compensate for truncation error. */ +/* if rounded arithmetic is used (nowadays always ?!), substitute c1=ak */ +#ifdef TRUNCATED_ARITHMETIC + c1 = 0.5/(ak*ak+s1*s1) + 0.5; + s1 = c1*s1; + c1 = c1*ak; +#else + c1 = ak; +#endif + +L80: + do { + k2 = kk + kspan; + ak = a[kk] - a[k2]; + bk = b[kk] - b[k2]; + a[kk] += a[k2]; + b[kk] += b[k2]; + a[k2] = c1*ak - s1*bk; + b[k2] = s1*ak + c1*bk; + kk = k2 + kspan; + } while(kk < nt); + k2 = kk - nt; + c1 = -c1; + kk = k1 - k2; + if( kk > k2) goto L80; + kk += jc; + if(kk <= mm) goto L70; + if(kk >= k2) { + k1 = k1 + inc + inc; + kk = (k1-kspan)/2 + jc; + if( kk <= jc+jc) goto L60; + goto L_start; + } + + s1 = ((kk-1)/jc)*dr*rad; + c1 = cos(s1); + s1 = sin(s1); + mm = imin2(k1/2,mm+klim); + goto L80; + +/* transform for factor of 3 (optional code) */ + +L100: + k1 = kk + kspan; + k2 = k1 + kspan; + ak = a[kk]; + bk = b[kk]; + aj = a[k1] + a[k2]; + bj = b[k1] + b[k2]; + a[kk] = ak + aj; + b[kk] = bk + bj; + ak = -0.5*aj + ak; + bk = -0.5*bj + bk; + aj = (a[k1]-a[k2])*s120; + bj = (b[k1]-b[k2])*s120; + a[k1] = ak - bj; + b[k1] = bk + aj; + a[k2] = ak + bj; + b[k2] = bk - aj; + kk = k2 + kspan; + if( kk < nn) goto L100; + kk = kk - nn; + if( kk <= kspan) goto L100; + goto L290; + +/* transform for factor of 4 */ + +L110: + if( nfac[i] != 4) goto L_f_odd; + kspnn = kspan; + kspan /= 4; +L120: + c1 = 1.0; + s1 = 0; + mm = imin2(kspan,klim); + goto L150; +L130: + c2 = c1 - (cd*c1+sd*s1); + s1 = (sd*c1-cd*s1) + s1; + +/* the following three statements compensate for truncation error. */ +/* if rounded arithmetic is used (nowadays always ?!), substitute c1=c2 */ +#ifdef TRUNCATED_ARITHMETIC + c1 = 0.5/(c2*c2+s1*s1) + 0.5; + s1 = c1*s1; + c1 = c1*c2; +#else + c1 = c2; +#endif + +L140: + c2 = c1*c1 - s1*s1; + s2 = c1*s1*2.0; + c3 = c2*c1 - s2*s1; + s3 = c2*s1 + s2*c1; + +L150: + k1 = kk + kspan; + k2 = k1 + kspan; + k3 = k2 + kspan; + akp = a[kk] + a[k2]; + akm = a[kk] - a[k2]; + ajp = a[k1] + a[k3]; + ajm = a[k1] - a[k3]; + a[kk] = akp + ajp; + ajp = akp - ajp; + bkp = b[kk] + b[k2]; + bkm = b[kk] - b[k2]; + bjp = b[k1] + b[k3]; + bjm = b[k1] - b[k3]; + b[kk] = bkp + bjp; + bjp = bkp - bjp; + if( isn < 0) goto L180; + akp = akm - bjm; + akm = akm + bjm; + bkp = bkm + ajm; + bkm = bkm - ajm; + if( s1 == 0.0) goto L190; +L160: + a[k1] = akp*c1 - bkp*s1; + b[k1] = akp*s1 + bkp*c1; + a[k2] = ajp*c2 - bjp*s2; + b[k2] = ajp*s2 + bjp*c2; + a[k3] = akm*c3 - bkm*s3; + b[k3] = akm*s3 + bkm*c3; + kk = k3 + kspan; + if( kk <= nt) goto L150; +L170: + kk = kk - nt + jc; + if( kk <= mm) goto L130; + if( kk < kspan) goto L200; + kk = kk - kspan + inc; + if(kk <= jc) goto L120; + if(kspan == jc) goto L_fin; + goto L_start; +L180: + akp = akm + bjm; + akm = akm - bjm; + bkp = bkm - ajm; + bkm = bkm + ajm; + if( s1 != 0.0) goto L160; +L190: + a[k1] = akp; + b[k1] = bkp; + a[k2] = ajp; + b[k2] = bjp; + a[k3] = akm; + b[k3] = bkm; + kk = k3 + kspan; + if( kk <= nt) goto L150; + goto L170; +L200: + s1 = ((kk-1)/jc)*dr*rad; + c1 = cos(s1); + s1 = sin(s1); + mm = imin2(kspan,mm+klim); + goto L140; + +/* transform for factor of 5 (optional code) */ + +L_f5: + c2 = c72*c72 - s72*s72; + s2 = 2.0*c72*s72; +L220: + k1 = kk + kspan; + k2 = k1 + kspan; + k3 = k2 + kspan; + k4 = k3 + kspan; + akp = a[k1] + a[k4]; + akm = a[k1] - a[k4]; + bkp = b[k1] + b[k4]; + bkm = b[k1] - b[k4]; + ajp = a[k2] + a[k3]; + ajm = a[k2] - a[k3]; + bjp = b[k2] + b[k3]; + bjm = b[k2] - b[k3]; + aa = a[kk]; + bb = b[kk]; + a[kk] = aa + akp + ajp; + b[kk] = bb + bkp + bjp; + ak = akp*c72 + ajp*c2 + aa; + bk = bkp*c72 + bjp*c2 + bb; + aj = akm*s72 + ajm*s2; + bj = bkm*s72 + bjm*s2; + a[k1] = ak - bj; + a[k4] = ak + bj; + b[k1] = bk + aj; + b[k4] = bk - aj; + ak = akp*c2 + ajp*c72 + aa; + bk = bkp*c2 + bjp*c72 + bb; + aj = akm*s2 - ajm*s72; + bj = bkm*s2 - bjm*s72; + a[k2] = ak - bj; + a[k3] = ak + bj; + b[k2] = bk + aj; + b[k3] = bk - aj; + kk = k4 + kspan; + if( kk < nn) goto L220; + kk = kk - nn; + if( kk <= kspan) goto L220; + goto L290; + +/* transform for odd factors */ + +L_f_odd: + k = nfac[i]; + kspnn = kspan; + kspan /= k; + if(k == 3) goto L100; + if(k == 5) goto L_f5; + if(k == jf) goto L250; + jf = k; + s1 = rad/(k/8.0); + c1 = cos(s1); + s1 = sin(s1); + ck[jf] = 1.0; + sk[jf] = 0.0; + + for(j = 1; j < k; j++) { /* k is changing as well */ + ck[j] = ck[k]*c1 + sk[k]*s1; + sk[j] = ck[k]*s1 - sk[k]*c1; + k--; + ck[k] = ck[j]; + sk[k] = -sk[j]; + } + +L250: + k1 = kk; + k2 = kk + kspnn; + aa = a[kk]; + bb = b[kk]; + ak = aa; + bk = bb; + j = 1; + k1 = k1 + kspan; +L260: + k2 = k2 - kspan; + j++; + at[j] = a[k1] + a[k2]; + ak = at[j] + ak; + bt[j] = b[k1] + b[k2]; + bk = bt[j] + bk; + j++; + at[j] = a[k1] - a[k2]; + bt[j] = b[k1] - b[k2]; + k1 = k1 + kspan; + if( k1 < k2) goto L260; + a[kk] = ak; + b[kk] = bk; + k1 = kk; + k2 = kk + kspnn; + j = 1; +L270: + k1 += kspan; + k2 -= kspan; + jj = j; + ak = aa; + bk = bb; + aj = 0.0; + bj = 0.0; + k = 1; + for(k=2; k < jf; k++) { + ak += at[k]*ck[jj]; + bk += bt[k]*ck[jj]; + k++; + aj += at[k]*sk[jj]; + bj += bt[k]*sk[jj]; + jj += j; + if(jj > jf) jj -= jf; + } + k = jf - j; + a[k1] = ak - bj; + b[k1] = bk + aj; + a[k2] = ak + bj; + b[k2] = bk - aj; + j++; + if( j < k) goto L270; + kk = kk + kspnn; + if( kk <= nn) goto L250; + kk = kk - nn; + if( kk <= kspan) goto L250; + +/* multiply by rotation factor (except for factors of 2 and 4) */ + +L290: + if(i == m) goto L_fin; + kk = jc + 1; +L300: + c2 = 1.0 - cd; + s1 = sd; + mm = imin2(kspan,klim); + + do { /* L320: */ + c1 = c2; + s2 = s1; + kk += kspan; + do { /* L330: */ + do { + ak = a[kk]; + a[kk] = c2*ak - s2*b[kk]; + b[kk] = s2*ak + c2*b[kk]; + kk += kspnn; + } while(kk <= nt); + ak = s1*s2; + s2 = s1*c2 + c1*s2; + c2 = c1*c2 - ak; + kk += -nt + kspan; + } while(kk <= kspnn); + kk += -kspnn + jc; + if(kk <= mm) { /* L310: */ + c2 = c1 - (cd*c1+sd*s1); + s1 = s1 + (sd*c1-cd*s1); +/* the following three statements compensate for truncation error.*/ +/* if rounded arithmetic is used (nowadays always ?!), they may be deleted. */ +#ifdef TRUNCATED_ARITHMETIC + c1 = 0.5/(c2*c2+s1*s1) + 0.5; + s1 = c1*s1; + c2 = c1*c2; +#endif + continue/* goto L320*/; + } + if(kk >= kspan) { + kk = kk - kspan + jc + inc; + if( kk <= jc+jc) goto L300; + goto L_start; + } + s1 = ((kk-1)/jc)*dr*rad; + c2 = cos(s1); + s1 = sin(s1); + mm = imin2(kspan,mm+klim); + } while(1); + +/*------------------------------------------------------------*/ + + +/* permute the results to normal order---done in two stages */ +/* permutation for square factors of n */ + +L_fin: + np[1] = ks; + if( kt == 0) goto L440; + k = kt + kt + 1; + if( m < k) k--; + np[k+1] = jc; + for(j = 1; j < k; j++, k--) { + np[j+1] = np[j]/nfac[j]; + np[k] = np[k+1]*nfac[j]; + } + k3 = np[k+1]; + kspan = np[2]; + kk = jc + 1; + k2 = kspan + 1; + j = 1; + + if(n == ntot) { + + /* permutation for single-variate transform (optional code) */ + + L370: + do { + ak = a[kk]; a[kk] = a[k2]; a[k2] = ak; + bk = b[kk]; b[kk] = b[k2]; b[k2] = bk; + kk += inc; + k2 += kspan; + } while(k2 < ks); + L380: + do { k2 -= np[j]; j++; k2 += np[j+1]; } while(k2 > np[j]); + j = 1; + do { + if(kk < k2) goto L370; + kk += inc; + k2 += kspan; + } while(k2 < ks); + if( kk < ks) goto L380; + jc = k3; + + } else { + + /* permutation for multivariate transform */ + + L400: + k = kk + jc; + do { + ak = a[kk]; a[kk] = a[k2]; a[k2] = ak; + bk = b[kk]; b[kk] = b[k2]; b[k2] = bk; + kk += inc; + k2 += inc; + } while( kk < k); + kk += ks - jc; + k2 += ks - jc; + if(kk < nt) goto L400; + k2 += - nt + kspan; + kk += - nt + jc; + if( k2 < ks) goto L400; + + do { + do { k2 -= np[j]; j++; k2 += np[j+1]; } while(k2 > np[j]); + j = 1; + do { + if(kk < k2) goto L400; + kk += jc; + k2 += kspan; + } while(k2 < ks); + } while(kk < ks); + jc = k3; + } + +L440: + if( 2*kt+1 >= m) return; + kspnn = np[kt+1]; + +/* permutation for square-free factors of n */ + + /* Here, nfac[] is overwritten... -- now CUMULATIVE ("cumprod") factors */ + nn = m - kt; + nfac[nn+1] = 1; + for(j = nn; j > kt; j--) + nfac[j] *= nfac[j+1]; + kt++; + nn = nfac[kt] - 1; + jj = 0; + j = 0; + goto L480; +L460: + jj -= k2; + k2 = kk; + k++; + kk = nfac[k]; +L470: + jj += kk; + if( jj >= k2) goto L460; + np[j] = jj; +L480: + k2 = nfac[kt]; + k = kt + 1; + kk = nfac[k]; + j++; + if( j <= nn) goto L470; + +/* determine the permutation cycles of length greater than 1 */ + + j = 0; + goto L500; + + do { + do { k = kk; kk = np[k]; np[k] = -kk; } while(kk != j); + k3 = kk; + L500: + do { j++; kk = np[j]; } while(kk < 0); + } while(kk != j); + np[j] = -j; + if( j != nn) goto L500; + maxf *= inc; + goto L570; + +/* reorder a and b, following the permutation cycles */ + +L_ord: + do j--; while(np[j] < 0); + jj = jc; + +L520: + kspan = imin2(jj,maxf); + jj -= kspan; + k = np[j]; + kk = jc*k + i + jj; + + for(k1= kk + kspan, k2= 1; k1 != kk; + k1 -= inc, k2++) { + at[k2] = a[k1]; + bt[k2] = b[k1]; + } + + do { + k1 = kk + kspan; + k2 = k1 - jc*(k+np[k]); + k = -np[k]; + do { + a[k1] = a[k2]; + b[k1] = b[k2]; + k1 -= inc; + k2 -= inc; + } while( k1 != kk); + kk = k2; + } while(k != j); + + for(k1= kk + kspan, k2= 1; k1 > kk; + k1 -= inc, k2++) { + a[k1] = at[k2]; + b[k1] = bt[k2]; + } + + if(jj != 0) goto L520; + if( j != 1) goto L_ord; + +L570: + j = k3 + 1; + nt = nt - kspnn; + i = nt - inc + 1; + if( nt >= 0) goto L_ord; +} /* fftmx */ + +static int old_n = 0; + +static int nfac[20]; +static int m_fac; +static int kt; +static int maxf; +static int maxp; + +/* At the end of factorization, + * nfac[] contains the factors, + * m_fac contains the number of factors and + * kt contains the number of square factors */ + +/* non-API, but used by package RandomFields */ +void fft_factor(int n, int *pmaxf, int *pmaxp) +{ +/* fft_factor - factorization check and determination of memory + * requirements for the fft. + * + * On return, *pmaxf will give the maximum factor size + * and *pmaxp will give the amount of integer scratch storage required. + * + * If *pmaxf == 0, there was an error, the error type is indicated by *pmaxp: + * + * If *pmaxp == 0 There was an illegal zero parameter among nseg, n, and nspn. + * If *pmaxp == 1 There we more than 15 factors to ntot. */ + + int j, jj, k, sqrtk, kchanged; + + /* check series length */ + + if (n <= 0) { + old_n = 0; *pmaxf = 0; *pmaxp = 0; + return; + } + else old_n = n; + + /* determine the factors of n */ + + m_fac = 0; + k = n;/* k := remaining unfactored factor of n */ + if (k == 1) + return; + + /* extract square factors first ------------------ */ + + /* extract 4^2 = 16 separately + * ==> at most one remaining factor 2^2 = 4, done below */ + while(k % 16 == 0) { + nfac[m_fac++] = 4; + k /= 16; + } + + /* extract 3^2, 5^2, ... */ + kchanged = 0; + sqrtk = (int)sqrt(k); + for(j = 3; j <= sqrtk; j += 2) { + jj = j * j; + while(k % jj == 0) { + nfac[m_fac++] = j; + k /= jj; + kchanged = 1; + } + if (kchanged) { + kchanged = 0; + sqrtk = (int)sqrt(k); + } + } + + if(k <= 4) { + kt = m_fac; + nfac[m_fac] = k; + if(k != 1) m_fac++; + } + else { + if(k % 4 == 0) { + nfac[m_fac++] = 2; + k /= 4; + } + + /* all square factors out now, but k >= 5 still */ + + kt = m_fac; + maxp = imax2(kt+kt+2, k-1); + j = 2; + do { + if (k % j == 0) { + nfac[m_fac++] = j; + k /= j; + } + if (j > INT_MAX - 2) + break; + j = ((j+1)/2)*2 + 1; + } + while(j <= k); + } + + if (m_fac <= kt+1) + maxp = m_fac+kt+1; + if (m_fac+kt > 20) { /* error - too many factors */ + old_n = 0; *pmaxf = 0; *pmaxp = 0; + return; + } + else { + if (kt != 0) { + j = kt; + while(j != 0) + nfac[m_fac++] = nfac[--j]; + } + maxf = nfac[m_fac-kt-1]; +/* The last squared factor is not necessarily the largest PR#1429 */ + if (kt > 0) maxf = imax2(nfac[kt-1], maxf); + if (kt > 1) maxf = imax2(nfac[kt-2], maxf); + if (kt > 2) maxf = imax2(nfac[kt-3], maxf); + } + *pmaxf = maxf; + *pmaxp = maxp; +} + + +Rboolean fft_work(double *a, double *b, int nseg, int n, int nspn, int isn, + double *work, int *iwork) +{ + int nf, nspan, ntot; + + /* check that factorization was successful */ + + if(old_n == 0) return FALSE; + + /* check that the parameters match those of the factorization call */ + + if(n != old_n || nseg <= 0 || nspn <= 0 || isn == 0) + return FALSE; + + /* perform the transform */ + + nf = n; + nspan = nf * nspn; + ntot = nspan * nseg; + + fftmx(a, b, ntot, nf, nspan, isn, m_fac, kt, + &work[0], &work[maxf], &work[2*(size_t)maxf], &work[3*(size_t)maxf], + iwork, nfac); + + return TRUE; +} diff --git a/com.oracle.truffle.r.native/gnur/patch/src/library/stats/src/hclust.f b/com.oracle.truffle.r.native/gnur/patch/src/library/stats/src/hclust.f new file mode 100644 index 0000000000000000000000000000000000000000..2f4c05d2f05cfac54f2af7fb078061df22e202a4 --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/library/stats/src/hclust.f @@ -0,0 +1,322 @@ +C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++C +C C +C HIERARCHICAL CLUSTERING using (user-specified) criterion. C +C C +C Parameters: C +C C +C N the number of points being clustered C +C DISS(LEN) dissimilarities in lower half diagonal C +C storage; LEN = N.N-1/2, C +C IOPT clustering criterion to be used, C +C IA, IB, CRIT history of agglomerations; dimensions C +C N, first N-1 locations only used, C +C MEMBR, NN, DISNN vectors of length N, used to store C +C cluster cardinalities, current nearest C +C neighbour, and the dissimilarity assoc. C +C with the latter. C +C MEMBR must be initialized by R to the C +C default of rep(1, N) C +C FLAG boolean indicator of agglomerable obj./ C +C clusters. C +C C +C F. Murtagh, ESA/ESO/STECF, Garching, February 1986. C +C Modifications for R: Ross Ihaka, Dec 1996 C +C Fritz Leisch, Jun 2000 C +C all vars declared: Martin Maechler, Apr 2001 C +C C +c- R Bug PR#4195 fixed "along" qclust.c, given in the report C +C- Testing: --> "hclust" in ../../../../tests/reg-tests-1b.R C +C "ward.D2" (iOpt = 8): Martin Maechler, Mar 2014 C +C------------------------------------------------------------C + SUBROUTINE HCLUST(N,LEN,IOPT,IA,IB,CRIT,MEMBR,NN,DISNN, + X FLAG,DISS) +c Args + INTEGER N, LEN, IOPT + INTEGER IA(N),IB(N), NN(N) + LOGICAL FLAG(N), isWard + DOUBLE PRECISION CRIT(N), MEMBR(N),DISS(LEN), DISNN(N) +c Var + INTEGER IM, JJ, JM, I, NCL, J, IND, I2, J2, K, IND1, IND2 + DOUBLE PRECISION INF, DMIN, D12 +c External function + INTEGER IOFFST +c +c was 1D+20 + DATA INF/1.D+300/ +c +c unnecessary initialization of im jj jm to keep g77 -Wall happy +c + IM = 0 + JJ = 0 + JM = 0 +C +C Initializations +C + DO I=1,N +C We do not initialize MEMBR in order to be able to restart the +C algorithm from a cut. +C MEMBR(I)=1. + FLAG(I)=.TRUE. + end do + NCL=N + + IF (iOpt .eq. 8) THEN ! Ward "D2" ---> using *squared* distances + do I=1,LEN + DISS(I)=DISS(I)*DISS(I) + end do + ENDIF + +C +C Carry out an agglomeration - first create list of NNs +C Note NN and DISNN are the nearest neighbour and its distance +C TO THE RIGHT of I. +C + DO I=1,N-1 + DMIN=INF + DO J=I+1,N + IND=IOFFST(N,I,J) + IF (DMIN .GT. DISS(IND)) THEN + DMIN=DISS(IND) + JM=J + end if + end do + NN(I)=JM + DISNN(I)=DMIN + end do + +C-- Repeat ------------------------------------------------------- + 400 CONTINUE + +C Next, determine least diss. using list of NNs + DMIN=INF + DO I=1,N-1 + IF (FLAG(I) .AND. DISNN(I) .LT. DMIN) THEN + DMIN=DISNN(I) + IM=I + JM=NN(I) + end if + end do + NCL=NCL-1 +C +C This allows an agglomeration to be carried out. +C + I2=MIN0(IM,JM) + J2=MAX0(IM,JM) + IA(N-NCL)=I2 + IB(N-NCL)=J2 +C WARD'S "D1", or "D2" MINIMUM VARIANCE METHOD -- iOpt = 1 or 8. + isWard = (iOpt .eq. 1 .or. iOpt .eq. 8) + IF (iOpt .eq. 8) DMIN = dsqrt(DMIN) + CRIT(N-NCL)=DMIN + FLAG(J2)=.FALSE. +C +C Update dissimilarities from new cluster. +C + DMIN=INF + DO K=1,N + IF (FLAG(K) .AND. K .NE. I2) THEN + IF (I2.LT.K) THEN + IND1=IOFFST(N,I2,K) + ELSE + IND1=IOFFST(N,K,I2) + ENDIF + IF (J2.LT.K) THEN + IND2=IOFFST(N,J2,K) + ELSE + IND2=IOFFST(N,K,J2) + ENDIF + D12=DISS(IOFFST(N,I2,J2)) +C +C WARD'S "D1", or "D2" MINIMUM VARIANCE METHOD - IOPT=8. + IF (isWard) THEN + DISS(IND1)=(MEMBR(I2)+MEMBR(K))*DISS(IND1)+ + X (MEMBR(J2)+MEMBR(K))*DISS(IND2) - MEMBR(K)*D12 + DISS(IND1)=DISS(IND1) / (MEMBR(I2)+MEMBR(J2)+MEMBR(K)) +C +C SINGLE LINK METHOD - IOPT=2. + ELSEIF (IOPT.EQ.2) THEN + DISS(IND1)=MIN(DISS(IND1),DISS(IND2)) +C +C COMPLETE LINK METHOD - IOPT=3. + ELSEIF (IOPT.EQ.3) THEN + DISS(IND1)=MAX(DISS(IND1),DISS(IND2)) +C +C AVERAGE LINK (OR GROUP AVERAGE) METHOD - IOPT=4. + ELSEIF (IOPT.EQ.4) THEN + DISS(IND1)= (MEMBR(I2)*DISS(IND1)+MEMBR(J2)*DISS(IND2)) + X / (MEMBR(I2)+MEMBR(J2)) +C +C MCQUITTY'S METHOD - IOPT=5. + ELSEIF (IOPT.EQ.5) THEN + DISS(IND1)=(DISS(IND1)+DISS(IND2)) / 2 +C +C MEDIAN (GOWER'S) METHOD aka "Weighted Centroid" - IOPT=6. + ELSEIF (IOPT.EQ.6) THEN + DISS(IND1)= ((DISS(IND1)+DISS(IND2)) - D12/2) / 2 +C +C Unweighted CENTROID METHOD - IOPT=7. + ELSEIF (IOPT.EQ.7) THEN + DISS(IND1)=(MEMBR(I2)*DISS(IND1)+MEMBR(J2)*DISS(IND2)- + X MEMBR(I2)*MEMBR(J2)*D12/(MEMBR(I2)+MEMBR(J2)))/ + X (MEMBR(I2)+MEMBR(J2)) + ENDIF + +C + IF (I2 .lt. K) THEN + IF (DISS(IND1) .LT. DMIN) THEN + DMIN=DISS(IND1) + JJ=K + ENDIF + else ! i2 > k +c FIX: the rest of the else clause is a fix by JB to ensure +c correct nearest neighbours are found when a non-monotone +c clustering method (e.g. the centroid methods) are used + if(DISS(IND1) .lt. DISNN(K)) then ! find nearest neighbour of i2 + DISNN(K) = DISS(IND1) + NN(K) = I2 + end if + ENDIF + ENDIF + END DO + MEMBR(I2)=MEMBR(I2)+MEMBR(J2) + DISNN(I2)=DMIN + NN(I2)=JJ +C +C Update list of NNs insofar as this is required. +C + DO I=1,N-1 + IF (FLAG(I) .AND. + X ((NN(I).EQ.I2) .OR. (NN(I).EQ.J2))) THEN +C (Redetermine NN of I:) + DMIN=INF + DO J=I+1,N + if (FLAG(J)) then + IND=IOFFST(N,I,J) + if (DISS(IND) .lt. DMIN) then + DMIN=DISS(IND) + JJ=J + end if + end if + end do + NN(I)=JJ + DISNN(I)=DMIN + end if + end do +C +C Repeat previous steps until N-1 agglomerations carried out. +C + IF (NCL.GT.1) GOTO 400 +C +C + RETURN + END +C of HCLUST() +C +C + INTEGER FUNCTION IOFFST(N,I,J) +C Map row I and column J of upper half diagonal symmetric matrix +C onto vector. + INTEGER N,I,J + IOFFST=J+(I-1)*N-(I*(I+1))/2 + RETURN + END + +C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++C +C C +C Given a HIERARCHIC CLUSTERING, described as a sequence of C +C agglomerations, prepare the seq. of aggloms. and "horiz." C +C order of objects for plotting the dendrogram using S routine C +C 'plclust'. C +C C +C Parameters: C +C C +C IA, IB: vectors of dimension N defining the agglomer- C +C ations. C +C IIA, IIB: used to store IA and IB values differently C +C (in form needed for S command 'plclust' C +C IORDER: "horiz." order of objects for dendrogram C +C C +C F. Murtagh, ESA/ESO/STECF, Garching, June 1991 C +C C +C HISTORY C +C C +C Adapted from routine HCASS, which additionally determines C +C cluster assignments at all levels, at extra comput. expense C +C C +C---------------------------------------------------------------C + SUBROUTINE HCASS2(N,IA,IB,IORDER,IIA,IIB) +c Args + INTEGER N,IA(N),IB(N),IORDER(N),IIA(N),IIB(N) +c Var + INTEGER I, J, K, K1, K2, LOC +C +C Following bit is to get seq. of merges into format acceptable to plclust +C I coded clusters as lowest seq. no. of constituents; S's 'hclust' codes +C singletons as -ve numbers, and non-singletons with their seq. nos. +C + do I=1,N + IIA(I)=IA(I) + IIB(I)=IB(I) + end do + do I=1,N-2 +C In the following, smallest (+ve or -ve) seq. no. wanted + K=MIN(IA(I),IB(I)) + do J=I+1, N-1 + IF(IA(J).EQ.K) IIA(J)=-I + IF(IB(J).EQ.K) IIB(J)=-I + end do + end do + do I=1,N-1 + IIA(I)=-IIA(I) + IIB(I)=-IIB(I) + end do + do I=1,N-1 + IF (IIA(I).GT.0 .AND. IIB(I).LT.0) THEN + K = IIA(I) + IIA(I) = IIB(I) + IIB(I) = K + ENDIF + IF (IIA(I).GT.0 .AND. IIB(I).GT.0) THEN + K1 = MIN(IIA(I),IIB(I)) + K2 = MAX(IIA(I),IIB(I)) + IIA(I) = K1 + IIB(I) = K2 + ENDIF + end do +C +C +C NEW PART FOR 'ORDER' +C + IORDER(1) = IIA(N-1) + IORDER(2) = IIB(N-1) + LOC=2 + DO I=N-2,1,-1 + DO J=1,LOC + IF(IORDER(J).EQ.I) THEN +C REPLACE IORDER(J) WITH IIA(I) AND IIB(I) + IORDER(J)=IIA(I) + IF (J.EQ.LOC) THEN + LOC=LOC+1 + IORDER(LOC)=IIB(I) + else + LOC=LOC+1 + do K=LOC,J+2,-1 + IORDER(K)=IORDER(K-1) + end do + IORDER(J+1)=IIB(I) + end if + GOTO 171 + ENDIF + end do +C SHOULD NEVER REACH HERE + 171 CONTINUE + end do +C +C + do I=1,N + IORDER(I) = -IORDER(I) + end do +C +C + RETURN + END diff --git a/com.oracle.truffle.r.native/gnur/patch/src/library/stats/src/init.c b/com.oracle.truffle.r.native/gnur/patch/src/library/stats/src/init.c new file mode 100644 index 0000000000000000000000000000000000000000..472d7cf806a1374de643795d19bc1ee6e50b8717 --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/library/stats/src/init.c @@ -0,0 +1,314 @@ +/* + * R : A Computer Language for Statistical Data Analysis + * Copyright (C) 2001-2017 The R Core Team. + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version. + * + * This program 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 this program; if not, a copy is available at + * https://www.R-project.org/Licenses/ + */ + +#include "modreg.h" +#include "nls.h" +#include "port.h" +#include "stats.h" +#include "statsR.h" +#include "ts.h" +#include <R_ext/Rdynload.h> +#include <R_ext/Visibility.h> + +#define C_DEF(name, n) {#name, (DL_FUNC) &name, n} + +static const R_CMethodDef CEntries[] = { + C_DEF(loess_raw, 24), + C_DEF(loess_dfit, 13), + C_DEF(loess_dfitse, 16), + C_DEF(loess_ifit, 8), + C_DEF(loess_ise, 15), + C_DEF(multi_burg, 11), + C_DEF(multi_yw, 10), + C_DEF(HoltWinters, 17), + C_DEF(kmeans_Lloyd, 9), + C_DEF(kmeans_MacQueen, 9), + C_DEF(rcont2, 8), + {NULL, NULL, 0} +}; + +#define CALLDEF(name, n) {#name, (DL_FUNC) &name, n} + +#define CALLDEF_DO(name, n) {#name, (DL_FUNC) &do_##name, n} +#define CALLDEF_MATH2_1(name) CALLDEF_DO(name, 3) +#define CALLDEF_MATH2_2(name) CALLDEF_DO(name, 4) +#define CALLDEF_MATH3_1(name) CALLDEF_DO(name, 4) +#define CALLDEF_MATH3_2(name) CALLDEF_DO(name, 5) +#define CALLDEF_MATH4_1(name) CALLDEF_DO(name, 5) +#define CALLDEF_MATH4_2(name) CALLDEF_DO(name, 6) + +#define CALLDEF_RAND1(name) CALLDEF_DO(name, 2) +#define CALLDEF_RAND2(name) CALLDEF_DO(name, 3) +#define CALLDEF_RAND3(name) CALLDEF_DO(name, 4) + +static const R_CallMethodDef CallEntries[] = { + CALLDEF(cutree, 2), + CALLDEF(isoreg, 1), + CALLDEF(monoFC_m, 2), + CALLDEF(numeric_deriv, 4), + CALLDEF(nls_iter, 3), + CALLDEF(setup_starma, 8), + CALLDEF(free_starma, 1), + CALLDEF(set_trans, 2), + CALLDEF(arma0fa, 2), + CALLDEF(get_s2, 1), + CALLDEF(get_resid, 1), + CALLDEF(Dotrans, 2), + CALLDEF(arma0_kfore, 4), + CALLDEF(Starma_method, 2), + CALLDEF(Invtrans, 2), + CALLDEF(Gradtrans, 2), + CALLDEF(ARMAtoMA, 3), + CALLDEF(KalmanLike, 5), + CALLDEF(KalmanFore, 3), + CALLDEF(KalmanSmooth, 3), + CALLDEF(ARIMA_undoPars, 2), + CALLDEF(ARIMA_transPars, 3), + CALLDEF(ARIMA_Invtrans, 2), + CALLDEF(ARIMA_Gradtrans, 2), + CALLDEF(ARIMA_Like, 4), + CALLDEF(ARIMA_CSS, 6), + CALLDEF(TSconv, 2), + CALLDEF(getQ0, 2), + CALLDEF(getQ0bis, 3), + CALLDEF(port_ivset, 3), + CALLDEF(port_nlminb, 9), + CALLDEF(port_nlsb, 7), + CALLDEF(logit_link, 1), + CALLDEF(logit_linkinv, 1), + CALLDEF(logit_mu_eta, 1), + CALLDEF(binomial_dev_resids, 3), + CALLDEF(rWishart, 3), + CALLDEF(Cdqrls, 4), + CALLDEF(Cdist, 4), + CALLDEF(cor, 4), + CALLDEF(cov, 4), + CALLDEF(updateform, 2), + CALLDEF(fft, 2), + CALLDEF(mvfft, 2), + CALLDEF(nextn, 2), + CALLDEF(r2dtable, 3), + CALLDEF(cfilter, 4), + CALLDEF(rfilter, 3), + CALLDEF(lowess, 5), + CALLDEF(DoubleCentre, 1), + CALLDEF(BinDist, 5), + CALLDEF(Rsm, 3), + CALLDEF(tukeyline, 3), + CALLDEF(runmed, 5), + CALLDEF(influence, 4), + CALLDEF(pSmirnov2x, 3), + CALLDEF(pKolmogorov2x, 2), + CALLDEF(pKS2, 2), + CALLDEF(ksmooth, 5), + CALLDEF(SplineCoef, 3), + CALLDEF(SplineEval, 2), + CALLDEF(Approx, 7), + CALLDEF(ApproxTest, 4), + CALLDEF(LogLin, 7), + CALLDEF(pAnsari, 3), + CALLDEF(qAnsari, 3), + CALLDEF(pKendall, 2), + CALLDEF(pRho, 3), + CALLDEF(SWilk, 1), + CALLDEF(bw_den, 2), + CALLDEF(bw_den_binned, 1), + CALLDEF(bw_ucv, 4), + CALLDEF(bw_bcv, 4), + CALLDEF(bw_phi4, 4), + CALLDEF(bw_phi6, 4), + CALLDEF(acf, 3), + CALLDEF(pacf1, 2), + CALLDEF(ar2ma, 2), + CALLDEF(Burg, 2), + CALLDEF(intgrt_vec, 3), + CALLDEF(pp_sum, 2), + CALLDEF(Fexact, 4), + CALLDEF(Fisher_sim, 3), + CALLDEF(chisq_sim, 4), + CALLDEF(d2x2xk, 5), + + CALLDEF_MATH2_1(dchisq), + CALLDEF_MATH2_1(dexp), + CALLDEF_MATH2_1(dgeom), + CALLDEF_MATH2_1(dpois), + CALLDEF_MATH2_1(dt), + CALLDEF_MATH2_1(dsignrank), + CALLDEF_MATH2_2(pchisq), + CALLDEF_MATH2_2(qchisq), + CALLDEF_MATH2_2(pexp), + CALLDEF_MATH2_2(qexp), + CALLDEF_MATH2_2(pgeom), + CALLDEF_MATH2_2(qgeom), + CALLDEF_MATH2_2(ppois), + CALLDEF_MATH2_2(qpois), + CALLDEF_MATH2_2(pt), + CALLDEF_MATH2_2(qt), + CALLDEF_MATH2_2(psignrank), + CALLDEF_MATH2_2(qsignrank), + + CALLDEF_MATH3_1(dbeta), + CALLDEF_MATH3_1(dbinom), + CALLDEF_MATH3_1(dcauchy), + CALLDEF_MATH3_1(df), + CALLDEF_MATH3_1(dgamma), + CALLDEF_MATH3_1(dlnorm), + CALLDEF_MATH3_1(dlogis), + CALLDEF_MATH3_1(dnbinom), + CALLDEF_MATH3_1(dnbinom_mu), + CALLDEF_MATH3_1(dnorm), + CALLDEF_MATH3_1(dweibull), + CALLDEF_MATH3_1(dunif), + CALLDEF_MATH3_1(dnt), + CALLDEF_MATH3_1(dnchisq), + CALLDEF_MATH3_1(dwilcox), + CALLDEF_MATH3_2(pbeta), + CALLDEF_MATH3_2(qbeta), + CALLDEF_MATH3_2(pbinom), + CALLDEF_MATH3_2(qbinom), + CALLDEF_MATH3_2(pcauchy), + CALLDEF_MATH3_2(qcauchy), + CALLDEF_MATH3_2(pf), + CALLDEF_MATH3_2(qf), + CALLDEF_MATH3_2(pgamma), + CALLDEF_MATH3_2(qgamma), + CALLDEF_MATH3_2(plnorm), + CALLDEF_MATH3_2(qlnorm), + CALLDEF_MATH3_2(plogis), + CALLDEF_MATH3_2(qlogis), + CALLDEF_MATH3_2(pnbinom), + CALLDEF_MATH3_2(qnbinom), + CALLDEF_MATH3_2(pnbinom_mu), + CALLDEF_MATH3_2(qnbinom_mu), + CALLDEF_MATH3_2(pnorm), + CALLDEF_MATH3_2(qnorm), + CALLDEF_MATH3_2(pweibull), + CALLDEF_MATH3_2(qweibull), + CALLDEF_MATH3_2(punif), + CALLDEF_MATH3_2(qunif), + CALLDEF_MATH3_2(pnt), + CALLDEF_MATH3_2(qnt), + CALLDEF_MATH3_2(pnchisq), + CALLDEF_MATH3_2(qnchisq), + CALLDEF_MATH3_2(pwilcox), + CALLDEF_MATH3_2(qwilcox), + // {"qnbinom_mu", (DL_FUNC) &distn3, 5}, // exists but currently unused + + CALLDEF_MATH4_1(dhyper), + CALLDEF_MATH4_1(dnbeta), + CALLDEF_MATH4_1(dnf), + CALLDEF_MATH4_2(phyper), + CALLDEF_MATH4_2(qhyper), + CALLDEF_MATH4_2(pnbeta), + CALLDEF_MATH4_2(qnbeta), + CALLDEF_MATH4_2(pnf), + CALLDEF_MATH4_2(qnf), + CALLDEF_MATH4_2(ptukey), + CALLDEF_MATH4_2(qtukey), + + CALLDEF_RAND1(rchisq), + CALLDEF_RAND1(rexp), + CALLDEF_RAND1(rgeom), + CALLDEF_RAND1(rpois), + CALLDEF_RAND1(rt), + CALLDEF_RAND1(rsignrank), + + CALLDEF_RAND2(rbeta), + CALLDEF_RAND2(rbinom), + CALLDEF_RAND2(rcauchy), + CALLDEF_RAND2(rf), + CALLDEF_RAND2(rgamma), + CALLDEF_RAND2(rlnorm), + CALLDEF_RAND2(rlogis), + CALLDEF_RAND2(rnbinom), + CALLDEF_RAND2(rnorm), + CALLDEF_RAND2(runif), + CALLDEF_RAND2(rweibull), + CALLDEF_RAND2(rwilcox), + CALLDEF_RAND2(rnchisq), + CALLDEF_RAND2(rnbinom_mu), + + CALLDEF_RAND3(rhyper), + + CALLDEF_DO(rmultinom, 3), + + {NULL, NULL, 0} +}; + +#define FDEF(name) {#name, (DL_FUNC) &F77_NAME(name), sizeof(name ## _t)/sizeof(name ## _t[0]), name ##_t} + + +static R_NativePrimitiveArgType lowesw_t[] = { + REALSXP, INTSXP, REALSXP, INTSXP}; +static R_NativePrimitiveArgType lowesp_t[] = { + INTSXP, REALSXP, REALSXP, REALSXP, REALSXP, INTSXP, REALSXP}; + + +static const R_FortranMethodDef FortEntries[] = { + FDEF(lowesw), + FDEF(lowesp), + {"setppr", (DL_FUNC) &F77_NAME(setppr), 6}, + {"smart", (DL_FUNC) &F77_NAME(smart), 16}, + {"pppred", (DL_FUNC) &F77_NAME(pppred), 5}, + {"setsmu", (DL_FUNC) &F77_NAME(setsmu), 1}, + {"rbart", (DL_FUNC) &F77_NAME(rbart), 20}, + {"bvalus", (DL_FUNC) &F77_NAME(bvalus), 7}, + {"supsmu", (DL_FUNC) &F77_NAME(supsmu), 10}, + {"hclust", (DL_FUNC) &F77_NAME(hclust), 11}, + {"hcass2", (DL_FUNC) &F77_NAME(hcass2), 6}, + {"kmns", (DL_FUNC) &F77_NAME(kmns), 17}, + {"eureka", (DL_FUNC) &F77_NAME(eureka), 6}, + {"stl", (DL_FUNC) &F77_NAME(stl), 18}, + {NULL, NULL, 0} +}; + +#define EXTDEF(name, n) {#name, (DL_FUNC) &name, n} +// These argument counts are not checked +static const R_ExternalMethodDef ExtEntries[] = { + EXTDEF(compcases, -1), + EXTDEF(doD, 2), + EXTDEF(deriv, 5), + EXTDEF(modelframe, 8), + EXTDEF(modelmatrix, 2), + EXTDEF(termsform, 5), + EXTDEF(do_fmin, 4), + EXTDEF(nlm, 11), + EXTDEF(zeroin2, 7), + EXTDEF(optim, 7), + EXTDEF(optimhess, 4), + EXTDEF(call_dqags, 7), + EXTDEF(call_dqagi, 7), + + {"signrank_free", (DL_FUNC) &stats_signrank_free, 0}, + {"wilcox_free", (DL_FUNC) &stats_wilcox_free, 0}, + {NULL, NULL, 0} +}; + + +void attribute_visible R_init_stats(DllInfo *dll) +{ + R_registerRoutines(dll, CEntries, CallEntries, FortEntries, ExtEntries); + R_useDynamicSymbols(dll, FALSE); + R_forceSymbols(dll, TRUE); + + R_RegisterCCallable("stats", "nlminb_iterate", (DL_FUNC) nlminb_iterate); + R_RegisterCCallable("stats", "nlsb_iterate", (DL_FUNC) nlsb_iterate); + R_RegisterCCallable("stats", "Rf_divset", (DL_FUNC) Rf_divset); + R_RegisterCCallable("stats", "rcont2", (DL_FUNC) rcont2); +} diff --git a/com.oracle.truffle.r.native/gnur/patch/src/library/stats/src/isoreg.c b/com.oracle.truffle.r.native/gnur/patch/src/library/stats/src/isoreg.c new file mode 100644 index 0000000000000000000000000000000000000000..5cd75d5451686d6ee0f8b1eda1da79b638da642f --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/library/stats/src/isoreg.c @@ -0,0 +1,68 @@ +/* --- Isotonic regression --- + * code simplified from VR_mds_fn() which is part of MASS.c, + * Copyright (C) 1995 Brian Ripley + * --- + * R : A Computer Language for Statistical Data Analysis + * Copyright (C) 2003 The R Foundation + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version. + * + * This program 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 this program; if not, a copy is available at + * https://www.R-project.org/Licenses/ + */ + +#include "modreg.h" + +SEXP isoreg(SEXP y) +{ + int n = LENGTH(y), i, ip, known, n_ip; + double tmp, slope; + SEXP yc, yf, iKnots, ans; + const char *anms[] = {"y", "yc", "yf", "iKnots", ""}; + + /* unneeded: y = coerceVector(y, REALSXP); */ + + PROTECT(ans = mkNamed(VECSXP, anms)); + + SET_VECTOR_ELT(ans, 0, y); + SET_VECTOR_ELT(ans, 1, yc = allocVector(REALSXP, n+1)); + SET_VECTOR_ELT(ans, 2, yf = allocVector(REALSXP, n)); + SET_VECTOR_ELT(ans, 3, iKnots= allocVector(INTSXP, n)); + + /* yc := cumsum(0,y) */ + REAL(yc)[0] = 0.; + tmp = 0.; + for (i = 0; i < n; i++) { + tmp += REAL(y)[i]; + REAL(yc)[i + 1] = tmp; + } + known = 0; ip = 0, n_ip = 0; + do { + slope = R_PosInf;/*1e+200*/ + for (i = known + 1; i <= n; i++) { + tmp = (REAL(yc)[i] - REAL(yc)[known]) / (i - known); + if (tmp < slope) { + slope = tmp; + ip = i; + } + }/* tmp := max{i= kn+1,.., n} slope(p[kn] -> p[i]) and + * ip = argmax{...}... */ + INTEGER(iKnots)[n_ip++] = ip; + for (i = known; i < ip; i++) + REAL(yf)[i] = (REAL(yc)[ip] - REAL(yc)[known]) / (ip - known); + } while ((known = ip) < n); + + if (n_ip < n) + SET_VECTOR_ELT(ans, 3, lengthgets(iKnots, n_ip)); + UNPROTECT(1); + return(ans); +} diff --git a/com.oracle.truffle.r.native/gnur/patch/src/library/stats/src/kmeans.c b/com.oracle.truffle.r.native/gnur/patch/src/library/stats/src/kmeans.c new file mode 100644 index 0000000000000000000000000000000000000000..bf25fa0bd5f1c63e79a2b63207d64228ce030d2d --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/library/stats/src/kmeans.c @@ -0,0 +1,162 @@ +/* + * R : A Computer Language for Statistical Data Analysis + * Copyright (C) 2004 The R Core Team. + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version. + * + * This program 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 this program; if not, a copy is available at + * https://www.R-project.org/Licenses/ + */ + +#include "modreg.h" /* for declarations for registration */ + +void kmeans_Lloyd(double *x, int *pn, int *pp, double *cen, int *pk, int *cl, + int *pmaxiter, int *nc, double *wss) +{ + int n = *pn, k = *pk, p = *pp, maxiter = *pmaxiter; + int iter, i, j, c, it, inew = 0; + double best, dd, tmp; + Rboolean updated; + + for(i = 0; i < n; i++) cl[i] = -1; + for(iter = 0; iter < maxiter; iter++) { + updated = FALSE; + for(i = 0; i < n; i++) { + /* find nearest centre for each point */ + best = R_PosInf; + for(j = 0; j < k; j++) { + dd = 0.0; + for(c = 0; c < p; c++) { + tmp = x[i+n*c] - cen[j+k*c]; + dd += tmp * tmp; + } + if(dd < best) { + best = dd; + inew = j+1; + } + } + if(cl[i] != inew) { + updated = TRUE; + cl[i] = inew; + } + } + if(!updated) break; + /* update each centre */ + for(j = 0; j < k*p; j++) cen[j] = 0.0; + for(j = 0; j < k; j++) nc[j] = 0; + for(i = 0; i < n; i++) { + it = cl[i] - 1; nc[it]++; + for(c = 0; c < p; c++) cen[it+c*k] += x[i+c*n]; + } + for(j = 0; j < k*p; j++) cen[j] /= nc[j % k]; + } + + *pmaxiter = iter + 1; + for(j = 0; j < k; j++) wss[j] = 0.0; + for(i = 0; i < n; i++) { + it = cl[i] - 1; + for(c = 0; c < p; c++) { + tmp = x[i+n*c] - cen[it+k*c]; + wss[it] += tmp * tmp; + } + } +} + +void kmeans_MacQueen(double *x, int *pn, int *pp, double *cen, int *pk, + int *cl, int *pmaxiter, int *nc, double *wss) +{ + int n = *pn, k = *pk, p = *pp, maxiter = *pmaxiter; + int iter, i, j, c, it, inew = 0, iold; + double best, dd, tmp; + Rboolean updated; + + /* first assign each point to the nearest cluster centre */ + for(i = 0; i < n; i++) { + best = R_PosInf; + for(j = 0; j < k; j++) { + dd = 0.0; + for(c = 0; c < p; c++) { + tmp = x[i+n*c] - cen[j+k*c]; + dd += tmp * tmp; + } + if(dd < best) { + best = dd; + inew = j+1; + } + } + if(cl[i] != inew) cl[i] = inew; + } + /* and recompute centres as centroids */ + for(j = 0; j < k*p; j++) cen[j] = 0.0; + for(j = 0; j < k; j++) nc[j] = 0; + for(i = 0; i < n; i++) { + it = cl[i] - 1; nc[it]++; + for(c = 0; c < p; c++) cen[it+c*k] += x[i+c*n]; + } + for(j = 0; j < k*p; j++) cen[j] /= nc[j % k]; + + for(iter = 0; iter < maxiter; iter++) { + updated = FALSE; + for(i = 0; i < n; i++) { + best = R_PosInf; + for(j = 0; j < k; j++) { + dd = 0.0; + for(c = 0; c < p; c++) { + tmp = x[i+n*c] - cen[j+k*c]; + dd += tmp * tmp; + } + if(dd < best) { + best = dd; + inew = j; + } + } + if((iold = cl[i] - 1) != inew) { + updated = TRUE; + cl[i] = inew + 1; + nc[iold]--; nc[inew]++; + /* update old and new cluster centres */ + for(c = 0; c < p; c++) { + cen[iold+k*c] += (cen[iold+k*c] - x[i+n*c])/nc[iold]; + cen[inew+k*c] += (x[i+n*c] - cen[inew+k*c])/nc[inew]; + } + } + } + if(!updated) break; + } + + *pmaxiter = iter + 1; + for(j = 0; j < k; j++) wss[j] = 0.0; + for(i = 0; i < n; i++) { + it = cl[i] - 1; + for(c = 0; c < p; c++) { + tmp = x[i+n*c] - cen[it+k*c]; + wss[it] += tmp * tmp; + } + } +} + +// tracing for kmeans() in ./kmns.f + +void F77_SUB(kmns1)(int *k, int *it, int *indx) { + Rprintf("KMNS(*, k=%d): iter=%3d, indx=%d\n", *k, *it, *indx); +} + +void F77_SUB(kmnsqpr)(int *istep, int *icoun, int *NCP, int *k, int *trace) +{ + Rprintf(" QTRAN(): istep=%d, icoun=%d", *istep, *icoun); + if(*trace >= 2) { + Rprintf(", NCP[1:%d]=", k[0]); + for(int i=0; i < k[0]; i++) Rprintf(" %d", NCP[i]); + } + Rprintf("\n"); +} + diff --git a/com.oracle.truffle.r.native/gnur/patch/src/library/stats/src/kmns.f b/com.oracle.truffle.r.native/gnur/patch/src/library/stats/src/kmns.f new file mode 100644 index 0000000000000000000000000000000000000000..27f1c227159b954f9dde5eb794a858e3c1f7415c --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/library/stats/src/kmns.f @@ -0,0 +1,446 @@ +c Code in this file based on Applied Statistics algorithms +c (C) Royal Statistical Society 1979 +c +C a minimal modification of AS136 to use double precision +C all variables are now declared. +C B.D. Ripley 1998/06/17 +C Declaration re-ordering to satisfy "f77 -ansi", M.Maechler 2001/04/12 +C +c ~= R's kmeans(x=A, centers=C, iter.max=ITER, algorithm = "Hartigan-Wong") +C + SUBROUTINE KMNS(A, M, N, C, K, IC1, IC2, NC, AN1, AN2, NCP, D, + * ITRAN, LIVE, ITER, WSS, IFAULT) +C +C ALGORITHM AS 136 APPL. STATIST. (1979) VOL.28, NO.1 +C +C Divide M points in N-dimensional space into K clusters so that +C the within cluster sum of squares is minimized. +C + INTEGER M,N,K,ITER,IFAULT + INTEGER IC1(M), IC2(M), NC(K), NCP(K), ITRAN(K), LIVE(K) + DOUBLE PRECISION A(M,N), D(M), C(K,N), AN1(K), AN2(K), WSS(K) +c ------ ------ +c data x[,] centers[,] + DOUBLE PRECISION DT(2), ZERO, ONE + INTEGER I,IL,J,L,INDX,IJ,II, iTrace, iMaxQtr + DOUBLE PRECISION BIG, DA, TEMP, DB, DC,AA +C +C Define BIG to be a very large positive number +C + DATA BIG /1.E30/, ZERO /0.0/, ONE /1.0/ +C + iTrace = IFAULT + iMaxQtr = ITRAN(1) + IFAULT = 3 + IF (K .LE. 1 .OR. K .GE. M) RETURN + IFAULT = 0 +C +C For each point I, find its two closest centres, IC1(I) and +C IC2(I). Assign it to IC1(I). +C + DO 60 I = 1, M + IC1(I) = 1 + IC2(I) = 2 + DO IL = 1, 2 + DT(IL) = ZERO + DO J = 1, N + DA = A(I,J) - C(IL,J) + DT(IL) = DT(IL) + DA*DA + end DO + end DO ! IL + IF (DT(1) .GT. DT(2)) THEN + IC1(I) = 2 + IC2(I) = 1 + TEMP = DT(1) + DT(1) = DT(2) + DT(2) = TEMP + END IF + DO 50 L = 3, K + DB = ZERO + DO J = 1, N + DC = A(I,J) - C(L,J) + DB = DB + DC*DC + IF (DB .GE. DT(2)) GO TO 50 + end DO + IF (DB .ge. DT(1)) then + DT(2) = DB + IC2(I) = L + else + DT(2) = DT(1) + IC2(I) = IC1(I) + DT(1) = DB + IC1(I) = L + end IF + 50 CONTINUE + 60 CONTINUE +C +C Update cluster centres to be the average of points contained +C within them. +C NC(L) := #{units in cluster L}, L = 1..K + DO L = 1, K + NC(L) = 0 + DO J = 1, N + C(L,J) = ZERO + end DO + end DO + DO I = 1, M + L = IC1(I) + NC(L) = NC(L) + 1 + DO J = 1, N + C(L,J) = C(L,J) + A(I,J) + end DO + end DO +C +C Check to see if there is any empty cluster at this stage +C + DO L = 1, K + IF (NC(L) .EQ. 0) THEN + IFAULT = 1 + RETURN + END IF + AA = NC(L) + DO J = 1, N + C(L,J) = C(L,J) / AA + end DO +C +C Initialize AN1, AN2, ITRAN & NCP +C AN1(L) = NC(L) / (NC(L) - 1) +C AN2(L) = NC(L) / (NC(L) + 1) +C ITRAN(L) = 1 if cluster L is updated in the quick-transfer stage, +C = 0 otherwise +C In the optimal-transfer stage, NCP(L) stores the step at which +C cluster L is last updated. +C In the quick-transfer stage, NCP(L) stores the step at which +C cluster L is last updated plus M. +C + AN2(L) = AA / (AA + ONE) + AN1(L) = BIG + IF (AA .GT. ONE) AN1(L) = AA / (AA - ONE) + ITRAN(L) = 1 + NCP(L) = -1 + end DO + + INDX = 0 + DO IJ = 1, ITER +C +C OPtimal-TRAnsfer stage: there is only one pass through the data. +C Each point is re-allocated, if necessary, to the cluster that will +C induce the maximum reduction in within-cluster sum of squares. +C + CALL OPTRA(A, M, N, C, K, IC1, IC2, NC, AN1, AN2, NCP, D, + * ITRAN, LIVE, INDX) + + if(iTrace .gt. 0) call kmns1(K, IJ, INDX) +C +C Stop if no transfer took place in the last M optimal transfer steps. + IF (INDX .EQ. M) GO TO 150 + +C +C Quick-TRANSfer stage: Each point is tested in turn to see if it should +C be re-allocated to the cluster to which it is most likely to be +C transferred, IC2(I), from its present cluster, IC1(I). +C Loop through the data until no further change is to take place. +C + CALL QTRAN(A, M, N, C, K, IC1, IC2, NC, AN1, AN2, NCP, D, + * ITRAN, INDX, iTrace, iMaxQtr) +C + if(iMaxQtr .lt. 0) then + IFAULT = 4 + GO TO 150 + end if +C +C If there are only two clusters, there is no need to re-enter the +C optimal transfer stage. +C + IF (K .EQ. 2) GO TO 150 +C +C NCP has to be set to 0 before entering OPTRA. +C + DO L = 1, K + NCP(L) = 0 + end DO + + end DO ! iter -------------------------------------- +C +C Since the specified number of iterations has been exceeded, set +C IFAULT = 2. This may indicate unforeseen looping. +C + IFAULT = 2 + + 150 continue + ITER = IJ +C +C Compute within-cluster sum of squares for each cluster. +C + do L = 1, K + WSS(L) = ZERO + do J = 1, N + C(L,J) = ZERO + end do + end do + + do I = 1, M + II = IC1(I) + do J = 1, N + C(II,J) = C(II,J) + A(I,J) + end do + end do + + do J = 1, N + do L = 1, K + C(L,J) = C(L,J) / DBLE(NC(L)) + end do + do I = 1, M + II = IC1(I) + DA = A(I,J) - C(II,J) + WSS(II) = WSS(II) + DA*DA + end do + end do +C + RETURN + END +C +C + SUBROUTINE OPTRA(A, M, N, C, K, IC1, IC2, NC, AN1, AN2, NCP, D, + * ITRAN, LIVE, INDX) +C +C ALGORITHM AS 136.1 APPL. STATIST. (1979) VOL.28, NO.1 +C +C This is the OPtimal TRAnsfer stage. +C ---------------------- +C Each point is re-allocated, if necessary, to the cluster that +C will induce a maximum reduction in the within-cluster sum of +C squares. +C + INTEGER M,N,K,INDX + INTEGER IC1(M), IC2(M), NC(K), NCP(K), ITRAN(K), LIVE(K) + DOUBLE PRECISION A(M,N), D(M), C(K,N), AN1(K), AN2(K) + + INTEGER L,I,L1,L2,LL,J + DOUBLE PRECISION ZERO, ONE + DOUBLE PRECISION BIG,DE,DF,DA,DB,R2,RR,DC,DD,AL1,ALW,AL2,ALT +C + DATA BIG /1.0E30/, ! BIG := a very large positive number + + ZERO /0.0/, ONE/1.0/ +C +C If cluster L is updated in the last quick-transfer stage, it +C belongs to the live set throughout this stage. Otherwise, at +C each step, it is not in the live set if it has not been updated +C in the last M optimal transfer steps. +C + do L = 1, K + IF (ITRAN(L) .EQ. 1) LIVE(L) = M + 1 + end do + +C ---------------------- Loop over each point ------------------- + DO I = 1, M + INDX = INDX + 1 + L1 = IC1(I) + L2 = IC2(I) + LL = L2 +C +C If point I is the only member of cluster L1, no transfer. +C + IF (NC(L1) .EQ. 1) GO TO 90 +C +C If L1 has not yet been updated in this stage, no need to +C re-compute D(I). +C + IF (NCP(L1) .ne. 0) then + DE = ZERO + do J = 1, N + DF = A(I,J) - C(L1,J) + DE = DE + DF*DF + end do + D(I) = DE * AN1(L1) + END IF +C +C Find the cluster with minimum R2. +C + DA = ZERO + do J = 1, N + DB = A(I,J) - C(L2,J) + DA = DA + DB*DB + end do + R2 = DA * AN2(L2) + DO 60 L = 1, K +C +C If I >= LIVE(L1), then L1 is not in the live set. If this is +C true, we only need to consider clusters that are in the live set +C for possible transfer of point I. Otherwise, we need to consider +C all possible clusters. +C + IF (I .GE. LIVE(L1) .AND. I .GE. LIVE(L) .OR. L .EQ. L1 .OR. + * L .EQ. LL) GO TO 60 + RR = R2 / AN2(L) + DC = ZERO + do J = 1, N + DD = A(I,J) - C(L,J) + DC = DC + DD*DD + IF (DC .GE. RR) GO TO 60 + end do + R2 = DC * AN2(L) + L2 = L + 60 CONTINUE + IF (R2 .ge. D(I)) then +C If no transfer is necessary, L2 is the new IC2(I). + IC2(I) = L2 + ELSE +C +C Update cluster centres, LIVE, NCP, AN1 & AN2 for clusters L1 and +C L2, and update IC1(I) & IC2(I). + INDX = 0 + LIVE(L1) = M + I + LIVE(L2) = M + I + NCP(L1) = I + NCP(L2) = I + AL1 = NC(L1) + ALW = AL1 - ONE + AL2 = NC(L2) + ALT = AL2 + ONE + do J = 1, N + C(L1,J) = (C(L1,J) * AL1 - A(I,J)) / ALW + C(L2,J) = (C(L2,J) * AL2 + A(I,J)) / ALT + end do + NC(L1) = NC(L1) - 1 + NC(L2) = NC(L2) + 1 + AN2(L1) = ALW / AL1 + AN1(L1) = BIG + IF (ALW .GT. ONE) AN1(L1) = ALW / (ALW - ONE) + AN1(L2) = ALT / AL2 + AN2(L2) = ALT / (ALT + ONE) + IC1(I) = L2 + IC2(I) = L1 + END IF + + 90 CONTINUE + IF (INDX .EQ. M) RETURN + + end do +C ---------------------- each point ------------------- + + do L = 1, K + ITRAN(L) = 0 !before entering QTRAN. +c LIVE(L) has to be decreased by M before re-entering OPTRA + LIVE(L) = LIVE(L) - M + end do +C + RETURN + END +C +C + SUBROUTINE QTRAN(A, M, N, C, K, IC1, IC2, NC, AN1, AN2, NCP, D, + * ITRAN, INDX, iTrace, iMaxQtr) +C +C ALGORITHM AS 136.2 APPL. STATIST. (1979) VOL.28, NO.1 +C +C This is the Quick TRANsfer stage. +c -------------------- +C IC1(I) is the cluster which point I belongs to. +C IC2(I) is the cluster which point I is most likely to be +C transferred to. +C For each point I, IC1(I) & IC2(I) are switched, if necessary, to +C reduce within-cluster sum of squares. The cluster centres are +C updated after each step. +C + INTEGER M,N,K,INDX, iTrace + INTEGER IC1(M), IC2(M), NC(K), NCP(K), ITRAN(K) + DOUBLE PRECISION A(M,N), D(M), C(K,N), AN1(K), AN2(K) + + DOUBLE PRECISION ZERO, ONE + INTEGER ICOUN,ISTEP,I,L1,L2,J + DOUBLE PRECISION BIG,DA,DB,DD,AL1,ALW,AL2,ALT,R2,DE + external kmnsQpr +C +C Define BIG to be a very large positive number +C + DATA BIG /1.0E30/, ZERO /0.0/, ONE /1.0/ +C +C In the quick transfer stage, NCP(L) +C is equal to the step at which cluster L is last updated plus M. +C + ICOUN = 0 + ISTEP = 0 +c Repeat { + 10 continue + + DO I = 1, M + if(iTrace .gt. 0 .and. ISTEP .ge. 1 .and. I .eq. 1) ! only from second "round" on + + call kmnsQpr(ISTEP, ICOUN, NCP, K, iTrace) + ICOUN = ICOUN + 1 + ISTEP = ISTEP + 1 + IF(ISTEP .ge. iMaxQtr) THEN + iMaxQtr = -1 + RETURN + ENDIF + L1 = IC1(I) + L2 = IC2(I) +C +C If point I is the only member of cluster L1, no transfer. +C + IF (NC(L1) .EQ. 1) GO TO 60 +C +C If ISTEP > NCP(L1), no need to re-compute distance from point I to +C cluster L1. Note that if cluster L1 is last updated exactly M +C steps ago, we still need to compute the distance from point I to +C cluster L1. +C + IF (ISTEP .le. NCP(L1)) then + DA = ZERO + DO J = 1, N + DB = A(I,J) - C(L1,J) + DA = DA + DB*DB + end DO + D(I) = DA * AN1(L1) + end IF +C +C If ISTEP >= both NCP(L1) & NCP(L2) there will be no transfer of +C point I at this step. +C + IF (ISTEP .lt. NCP(L1) .or. ISTEP .lt. NCP(L2)) then + R2 = D(I) / AN2(L2) + DD = ZERO + DO J = 1, N + DE = A(I,J) - C(L2,J) + DD = DD + DE*DE + IF (DD .GE. R2) GO TO 60 + end DO +C +C Update cluster centres, NCP, NC, ITRAN, AN1 & AN2 for clusters +C L1 & L2. Also update IC1(I) & IC2(I). Note that if any +C updating occurs in this stage, INDX is set back to 0. +C + ICOUN = 0 + INDX = 0 + ITRAN(L1) = 1 + ITRAN(L2) = 1 + NCP(L1) = ISTEP + M + NCP(L2) = ISTEP + M + AL1 = NC(L1) + ALW = AL1 - ONE + AL2 = NC(L2) + ALT = AL2 + ONE + DO J = 1, N + C(L1,J) = (C(L1,J) * AL1 - A(I,J)) / ALW + C(L2,J) = (C(L2,J) * AL2 + A(I,J)) / ALT + end DO + NC(L1) = NC(L1) - 1 + NC(L2) = NC(L2) + 1 + AN2(L1) = ALW / AL1 + AN1(L1) = BIG + IF (ALW .GT. ONE) AN1(L1) = ALW / (ALW - ONE) + AN1(L2) = ALT / AL2 + AN2(L2) = ALT / (ALT + ONE) + IC1(I) = L2 + IC2(I) = L1 + end if +C +C If no re-allocation took place in the last M steps, return. +C + 60 IF (ICOUN .EQ. M) RETURN + end do + + call rchkusr() ! allow user interrupt + GO TO 10 +c -------- + END diff --git a/com.oracle.truffle.r.native/gnur/patch/src/library/stats/src/lminfl.f b/com.oracle.truffle.r.native/gnur/patch/src/library/stats/src/lminfl.f new file mode 100644 index 0000000000000000000000000000000000000000..d757c31846bb2f9a61ede935c875d229eb6dee3f --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/library/stats/src/lminfl.f @@ -0,0 +1,136 @@ +c----------------------------------------------------------------------- +c +c R : A Computer Language for Statistical Data Analysis +c Copyright (C) 1996, 1997 Robert Gentleman and Ross Ihaka +c Copyright (C) 2003-5 The R Foundation +c +c This program is free software; you can redistribute it and/or modify +c it under the terms of the GNU General Public License as published by +c the Free Software Foundation; either version 2 of the License, or +c (at your option) any later version. +c +c This program is distributed in the hope that it will be useful, +c but WITHOUT ANY WARRANTY; without even the implied warranty of +c MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +c GNU General Public License for more details. +c +c You should have received a copy of the GNU General Public License +c along with this program; if not, a copy is available at +c https://www.R-project.org/Licenses/ +c +c----------------------------------------------------------------------- +c +c lminfl computes basic quantities useful for computing +c regression diagnostics. +c +c on entry +c +c x double precision(ldx,k) +c the qr decomposition as computed by dqrdc or dqrdc2. +c +c ldx integer +c the leading dimension of the array x. +c +c n integer +c the number of rows of the matrix x. +c +c k integer +c the number of columns in the matrix k. +c +c docoef integer (logical) indicating if coef(*,*) should be computed +c Computation of coef(.) is O(n^2 * k) which may be too much. +c +c qraux double precision(k) +c auxiliary information about the qr decomposition. +c +c resid double precision(k) +c the residuals from the regression. +c +c on return +c +c hat double precision(n) +c the diagonal of the hat matrix. +c +c coef double precision(n,p) +c a matrix which has as i-th row the estimated +c regression coefficients when the i-th case is omitted +c from the regression. +c +c sigma double precision(n) +c the i-th element of sigma contains an estimate +c of the residual standard deviation for the model with +c the i-th case omitted. +c +c This version dated Aug 24, 1996. +c Ross Ihaka, University of Auckland. +c `docoef' option added Feb 17, 2003; Martin Maechler ETH Zurich. +c Handle hat == 1 case, Nov 2005. +c Argument 'tol' was real not double precision, Aug 2007 + + subroutine lminfl(x, ldx, n, k, docoef, qraux, resid, + + hat, coef, sigma, tol) + integer ldx, n, k, docoef + double precision x(ldx,k), qraux(k), resid(n), + + hat(n), coef(n,k), sigma(n), tol +c coef(.,.) can be dummy(1) when docoef is 0(false) + + integer i, j, info + double precision sum, denom, dummy +c +c hat matrix diagonal +c + do 10 i = 1,n + hat(i) = 0.0d0 + 10 continue + + do 40 j = 1,k + do 20 i = 1,n + sigma(i) = 0.0d0 + 20 continue + sigma(j) = 1.0d0 + call dqrsl(x, ldx, n, k, qraux, sigma, sigma, dummy, + . dummy, dummy, dummy, 10000, info) + do 30 i = 1, n + hat(i) = hat(i)+sigma(i)*sigma(i) + 30 continue + 40 continue + do 45 i = 1, n + if(hat(i) .ge. 1.0d0 - tol) hat(i) = 1.0d0 + 45 continue +c +c changes in the estimated coefficients +c + if(docoef .ne. 0) then + do 70 i = 1,n + do 50 j = 1,n + sigma(j) = 0.0d0 + 50 continue +c if hat is effectively 1, change is zero + if(hat(i) .lt. 1.0d0) then + sigma(i) = resid(i)/(1.0d0 - hat(i)) + call dqrsl(x, ldx, n, k, qraux, sigma, dummy, sigma, + . dummy, dummy, dummy, 1000, info) + call dtrsl(x, ldx, k, sigma, 1, info) + endif + do 60 j = 1,k + coef(i,j) = sigma(j) + 60 continue + 70 continue + endif +c +c estimated residual standard deviation +c + denom = (n - k - 1) + sum = 0.0d0 + do 80 i = 1,n + sum = sum + resid(i)*resid(i) + 80 continue + do 90 i = 1,n + if(hat(i) .lt. 1.0d0) then + sigma(i) = sqrt((sum-resid(i)*resid(i)/(1.0d0-hat(i)))/denom) + else + sigma(i) = sqrt(sum/denom) + endif + 90 continue + return + end diff --git a/com.oracle.truffle.r.native/gnur/patch/src/library/stats/src/loessc.c b/com.oracle.truffle.r.native/gnur/patch/src/library/stats/src/loessc.c new file mode 100644 index 0000000000000000000000000000000000000000..fdf570d2d4689b29901c31b8cc93fa89f57eb26a --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/library/stats/src/loessc.c @@ -0,0 +1,427 @@ +/* + * The authors of this software are Cleveland, Grosse, and Shyu. + * Copyright (c) 1989, 1992 by AT&T. + * Permission to use, copy, modify, and distribute this software for any + * purpose without fee is hereby granted, provided that this entire notice + * is included in all copies of any software which is or includes a copy + * or modification of this software and in all copies of the supporting + * documentation for such software. + * THIS SOFTWARE IS BEING PROVIDED "AS IS", WITHOUT ANY EXPRESS OR IMPLIED + * WARRANTY. IN PARTICULAR, NEITHER THE AUTHORS NOR AT&T MAKE ANY + * REPRESENTATION OR WARRANTY OF ANY KIND CONCERNING THE MERCHANTABILITY + * OF THIS SOFTWARE OR ITS FITNESS FOR ANY PARTICULAR PURPOSE. + */ + +/* <UTF8> chars are handled as whole strings. + They are passed from Fortran so had better be ASCII. + */ + +/* + * Altered by B.D. Ripley to use F77_*, declare routines before use. + * + * 'protoize'd to ANSI C headers; indented: M.Maechler + */ + +#include <string.h> +#include <stdio.h> +#include <math.h> +#include <limits.h> +#include <R.h> + +#ifdef ENABLE_NLS +#include <libintl.h> +#define _(String) dgettext ("stats", String) +#else +#define _(String) (String) +#endif + +/* Forward declarations */ +static +void loess_workspace(int *d, int *n, double *span, int *degree, + int *nonparametric, int *drop_square, + int *sum_drop_sqr, int *setLf); +static +void loess_prune(int *parameter, int *a, + double *xi, double *vert, double *vval); +static +void loess_grow (int *parameter, int *a, + double *xi, double *vert, double *vval); + +/* These (and many more) are in ./loessf.f : */ +void F77_NAME(lowesa)(double*, int*, int*, int*, int*, double*, double*); +void F77_NAME(lowesb)(double*, double*, double*, double*, int*, int*, int*, + int*, double*); +void F77_NAME(lowesc)(int*, double*, double*, double*, double*, double*); +void F77_NAME(lowesd)(int*, int*, int*, int*, double*, int*, int*, + double*, int*, int*, int*); +void F77_NAME(lowese)(int*, int*, int*, double*, int*, double*, double*); +void F77_NAME(lowesf)(double*, double*, double*, int*, int*, int*, double*, + int*, double*, double*, int*, double*); +void F77_NAME(lowesl)(int*, int*, int*, double*, int*, double*, double*); +void F77_NAME(ehg169)(int*, int*, int*, int*, int*, int*, + double*, int*, double*, int*, int*, int*); +void F77_NAME(ehg196)(int*, int*, double*, double*); +/* exported (for loessf.f) : */ +void F77_SUB(ehg182)(int *i); +void F77_SUB(ehg183a)(char *s, int *nc,int *i,int *n,int *inc); +void F77_SUB(ehg184a)(char *s, int *nc, double *x, int *n, int *inc); + + + +#undef min +#undef max + +#define min(x,y) ((x) < (y) ? (x) : (y)) +#define max(x,y) ((x) > (y) ? (x) : (y)) +#define GAUSSIAN 1 +#define SYMMETRIC 0 + +static int *iv = NULL, liv, lv, tau; +static double *v = NULL; + +/* these are set in an earlier call to loess_workspace or loess_grow */ +static void loess_free(void) +{ + Free(v); + Free(iv); +} + +void +loess_raw(double *y, double *x, double *weights, double *robust, int *d, + int *n, double *span, int *degree, int *nonparametric, + int *drop_square, int *sum_drop_sqr, double *cell, + char **surf_stat, double *surface, int *parameter, + int *a, double *xi, double *vert, double *vval, double *diagonal, + double *trL, double *one_delta, double *two_delta, int *setLf) +{ + int zero = 0, one = 1, two = 2, nsing, i, k; + double *hat_matrix, *LL, dzero=0.0; + + *trL = 0; + + loess_workspace(d, n, span, degree, nonparametric, drop_square, + sum_drop_sqr, setLf); + v[1] = *cell;/* = v(2) in Fortran (!) */ + + /* NB: surf_stat = (surface / statistics); + * statistics = "none" for all robustness iterations + */ + if(!strcmp(*surf_stat, "interpolate/none")) { // default for loess.smooth() and robustness iter. + F77_CALL(lowesb)(x, y, robust, &dzero, &zero, iv, &liv, &lv, v); + F77_CALL(lowese)(iv, &liv, &lv, v, n, x, surface); + loess_prune(parameter, a, xi, vert, vval); + } + else if (!strcmp(*surf_stat, "direct/none")) { + F77_CALL(lowesf)(x, y, robust, iv, &liv, &lv, v, n, x, + &dzero, &zero, surface); + } + else if (!strcmp(*surf_stat, "interpolate/1.approx")) { // default (trace.hat is "exact") + F77_CALL(lowesb)(x, y, weights, diagonal, &one, iv, &liv, &lv, v); + F77_CALL(lowese)(iv, &liv, &lv, v, n, x, surface); + nsing = iv[29]; + for(i = 0; i < (*n); i++) *trL = *trL + diagonal[i]; + F77_CALL(lowesa)(trL, n, d, &tau, &nsing, one_delta, two_delta); + loess_prune(parameter, a, xi, vert, vval); + } + else if (!strcmp(*surf_stat, "interpolate/2.approx")) { // default for trace.hat = "approximate" + // vvvvvvv (had 'robust' in R <= 3.2.x) + F77_CALL(lowesb)(x, y, weights, &dzero, &zero, iv, &liv, &lv, v); + F77_CALL(lowese)(iv, &liv, &lv, v, n, x, surface); + nsing = iv[29]; + F77_CALL(ehg196)(&tau, d, span, trL); + F77_CALL(lowesa)(trL, n, d, &tau, &nsing, one_delta, two_delta); + loess_prune(parameter, a, xi, vert, vval); + } + else if (!strcmp(*surf_stat, "direct/approximate")) { + F77_CALL(lowesf)(x, y, weights, iv, &liv, &lv, v, n, x, + diagonal, &one, surface); + nsing = iv[29]; + for(i = 0; i < (*n); i++) *trL = *trL + diagonal[i]; + F77_CALL(lowesa)(trL, n, d, &tau, &nsing, one_delta, two_delta); + } + else if (!strcmp(*surf_stat, "interpolate/exact")) { + hat_matrix = (double *) R_alloc((*n)*(*n), sizeof(double)); + LL = (double *) R_alloc((*n)*(*n), sizeof(double)); + F77_CALL(lowesb)(x, y, weights, diagonal, &one, iv, &liv, &lv, v); + F77_CALL(lowesl)(iv, &liv, &lv, v, n, x, hat_matrix); + F77_CALL(lowesc)(n, hat_matrix, LL, trL, one_delta, two_delta); + F77_CALL(lowese)(iv, &liv, &lv, v, n, x, surface); + loess_prune(parameter, a, xi, vert, vval); + } + else if (!strcmp(*surf_stat, "direct/exact")) { + hat_matrix = (double *) R_alloc((*n)*(*n), sizeof(double)); + LL = (double *) R_alloc((*n)*(*n), sizeof(double)); + F77_CALL(lowesf)(x, y, weights, iv, &liv, &lv, v, n, x, + hat_matrix, &two, surface); + F77_CALL(lowesc)(n, hat_matrix, LL, trL, one_delta, two_delta); + k = (*n) + 1; + for(i = 0; i < (*n); i++) + diagonal[i] = hat_matrix[i * k]; + } + loess_free(); +} + +void +loess_dfit(double *y, double *x, double *x_evaluate, double *weights, + double *span, int *degree, int *nonparametric, + int *drop_square, int *sum_drop_sqr, + int *d, int *n, int *m, double *fit) +{ + int zero = 0; + double dzero = 0.0; + + loess_workspace(d, n, span, degree, nonparametric, drop_square, + sum_drop_sqr, &zero); + F77_CALL(lowesf)(x, y, weights, iv, &liv, &lv, v, m, x_evaluate, + &dzero, &zero, fit); + loess_free(); +} + +void +loess_dfitse(double *y, double *x, double *x_evaluate, double *weights, + double *robust, int *family, double *span, int *degree, + int *nonparametric, int *drop_square, + int *sum_drop_sqr, + int *d, int *n, int *m, double *fit, double *L) +{ + int zero = 0, two = 2; + double dzero = 0.0; + + loess_workspace(d, n, span, degree, nonparametric, drop_square, + sum_drop_sqr, &zero); + if(*family == GAUSSIAN) + F77_CALL(lowesf)(x, y, weights, iv, &liv, &lv, v, m, + x_evaluate, L, &two, fit); + else if(*family == SYMMETRIC) + { + F77_CALL(lowesf)(x, y, weights, iv, &liv, &lv, v, m, + x_evaluate, L, &two, fit); + F77_CALL(lowesf)(x, y, robust, iv, &liv, &lv, v, m, + x_evaluate, &dzero, &zero, fit); + } + loess_free(); +} + +void +loess_ifit(int *parameter, int *a, double *xi, double *vert, + double *vval, int *m, double *x_evaluate, double *fit) +{ + loess_grow(parameter, a, xi, vert, vval); + F77_CALL(lowese)(iv, &liv, &lv, v, m, x_evaluate, fit); + loess_free(); +} + +void +loess_ise(double *y, double *x, double *x_evaluate, double *weights, + double *span, int *degree, int *nonparametric, + int *drop_square, int *sum_drop_sqr, double *cell, + int *d, int *n, int *m, double *fit, double *L) +{ + int zero = 0, one = 1; + double dzero = 0.0; + + loess_workspace(d, n, span, degree, nonparametric, drop_square, + sum_drop_sqr, &one); + v[1] = *cell; + F77_CALL(lowesb)(x, y, weights, &dzero, &zero, iv, &liv, &lv, v); + F77_CALL(lowesl)(iv, &liv, &lv, v, m, x_evaluate, L); + loess_free(); +} + +void +loess_workspace(int *d, int *n, double *span, int *degree, + int *nonparametric, int *drop_square, + int *sum_drop_sqr, int *setLf) +{ + int D = *d, N = *n, tau0, nvmax, nf, version = 106, i; + + nvmax = max(200, N); + nf = min(N, (int) floor(N * (*span) + 1e-5)); + if(nf <= 0) error(_("span is too small")); + tau0 = ((*degree) > 1) ? (int)((D + 2) * (D + 1) * 0.5) : (D + 1); + tau = tau0 - (*sum_drop_sqr); + lv = 50 + (3 * D + 3) * nvmax + N + (tau0 + 2) * nf; + double dliv = 50 + (pow(2.0, (double)D) + 4.0) * nvmax + 2.0 * N; + if (dliv < INT_MAX) liv = (int) dliv; + else error("workspace required is too large"); + if(*setLf) { + lv = lv + (D + 1) * nf * nvmax; + liv = liv + nf * nvmax; + } + iv = Calloc(liv, int); + v = Calloc(lv, double); + + F77_CALL(lowesd)(&version, iv, &liv, &lv, v, d, n, span, degree, + &nvmax, setLf); + iv[32] = *nonparametric; + for(i = 0; i < D; i++) + iv[i + 40] = drop_square[i]; +} + +static void +loess_prune(int *parameter, int *a, double *xi, double *vert, + double *vval) +{ + int d, vc, a1, v1, xi1, vv1, nc, nv, nvmax, i, k; + + d = iv[1]; + vc = iv[3] - 1; + nc = iv[4]; + nv = iv[5]; + a1 = iv[6] - 1; + v1 = iv[10] - 1; + xi1 = iv[11] - 1; + vv1 = iv[12] - 1; + nvmax = iv[13]; + + for(i = 0; i < 5; i++) + parameter[i] = iv[i + 1]; + parameter[5] = iv[21] - 1; + parameter[6] = iv[14] - 1; + + for(i = 0; i < d; i++) { + k = nvmax * i; + vert[i] = v[v1 + k]; + vert[i + d] = v[v1 + vc + k]; + } + for(i = 0; i < nc; i++) { + xi[i] = v[xi1 + i]; + a[i] = iv[a1 + i]; + } + k = (d + 1) * nv; + for(i = 0; i < k; i++) + vval[i] = v[vv1 + i]; +} + +static void +loess_grow(int *parameter, int *a, double *xi, + double *vert, double *vval) +{ + int d, vc, nc, nv, a1, v1, xi1, vv1, i, k; + + d = parameter[0]; + vc = parameter[2]; + nc = parameter[3]; + nv = parameter[4]; + liv = parameter[5]; + lv = parameter[6]; + iv = Calloc(liv, int); + v = Calloc(lv, double); + + iv[1] = d; + iv[2] = parameter[1]; + iv[3] = vc; + iv[5] = iv[13] = nv; + iv[4] = iv[16] = nc; + iv[6] = 50; + iv[7] = iv[6] + nc; + iv[8] = iv[7] + vc * nc; + iv[9] = iv[8] + nc; + iv[10] = 50; + iv[12] = iv[10] + nv * d; + iv[11] = iv[12] + (d + 1) * nv; + iv[27] = 173; + + v1 = iv[10] - 1; + xi1 = iv[11] - 1; + a1 = iv[6] - 1; + vv1 = iv[12] - 1; + + for(i = 0; i < d; i++) { + k = nv * i; + v[v1 + k] = vert[i]; + v[v1 + vc - 1 + k] = vert[i + d]; + } + for(i = 0; i < nc; i++) { + v[xi1 + i] = xi[i]; + iv[a1 + i] = a[i]; + } + k = (d + 1) * nv; + for(i = 0; i < k; i++) + v[vv1 + i] = vval[i]; + + F77_CALL(ehg169)(&d, &vc, &nc, &nc, &nv, &nv, v+v1, iv+a1, + v+xi1, iv+iv[7]-1, iv+iv[8]-1, iv+iv[9]-1); +} + + +/* begin ehg's FORTRAN-callable C-codes */ +#define MSG(_m_) msg = _(_m_) ; break ; + +void F77_SUB(ehg182)(int *i) +{ + char *msg, msg2[50]; + +switch(*i){ + case 100:MSG("wrong version number in lowesd. Probably typo in caller.") + case 101:MSG("d>dMAX in ehg131. Need to recompile with increased dimensions.") + case 102:MSG("liv too small. (Discovered by lowesd)") + case 103:MSG("lv too small. (Discovered by lowesd)") + case 104:MSG("span too small. fewer data values than degrees of freedom.") + case 105:MSG("k>d2MAX in ehg136. Need to recompile with increased dimensions.") + case 106:MSG("lwork too small") + case 107:MSG("invalid value for kernel") + case 108:MSG("invalid value for ideg") + case 109:MSG("lowstt only applies when kernel=1.") + case 110:MSG("not enough extra workspace for robustness calculation") + case 120:MSG("zero-width neighborhood. make span bigger") + case 121:MSG("all data on boundary of neighborhood. make span bigger") + case 122:MSG("extrapolation not allowed with blending") + case 123:MSG("ihat=1 (diag L) in l2fit only makes sense if z=x (eval=data).") + case 171:MSG("lowesd must be called first.") + case 172:MSG("lowesf must not come between lowesb and lowese, lowesr, or lowesl.") + case 173:MSG("lowesb must come before lowese, lowesr, or lowesl.") + case 174:MSG("lowesb need not be called twice.") + case 175:MSG("need setLf=.true. for lowesl.") + case 180:MSG("nv>nvmax in cpvert.") + case 181:MSG("nt>20 in eval.") + case 182:MSG("svddc failed in l2fit.") + case 183:MSG("didnt find edge in vleaf.") + case 184:MSG("zero-width cell found in vleaf.") + case 185:MSG("trouble descending to leaf in vleaf.") + case 186:MSG("insufficient workspace for lowesf.") + case 187:MSG("insufficient stack space") + case 188:MSG("lv too small for computing explicit L") + case 191:MSG("computed trace L was negative; something is wrong!") + case 192:MSG("computed delta was negative; something is wrong!") + case 193:MSG("workspace in loread appears to be corrupted") + case 194:MSG("trouble in l2fit/l2tr") + case 195:MSG("only constant, linear, or quadratic local models allowed") + case 196:MSG("degree must be at least 1 for vertex influence matrix") + case 999:MSG("not yet implemented") + default: { + snprintf(msg2, 50, "Assert failed; error code %d\n",*i); + msg = msg2; + } +} +warning(msg); +} +#undef MSG + +void F77_SUB(ehg183a)(char *s, int *nc,int *i,int *n,int *inc) +{ + char mess[4000], num[20]; + int j; + strncpy(mess,s,*nc); + mess[*nc] = '\0'; + for (j=0; j<*n; j++) { + snprintf(num, 20, " %d",i[j * *inc]); + strcat(mess,num); + } + strcat(mess,"\n"); + warning(mess); +} + +void F77_SUB(ehg184a)(char *s, int *nc, double *x, int *n, int *inc) +{ + char mess[4000], num[30]; + int j; + strncpy(mess,s,*nc); + mess[*nc] = '\0'; + for (j=0; j<*n; j++) { + snprintf(num,30," %.5g",x[j * *inc]); + strcat(mess,num); + } + strcat(mess,"\n"); + warning(mess); +} diff --git a/com.oracle.truffle.r.native/gnur/patch/src/library/stats/src/loessf.f b/com.oracle.truffle.r.native/gnur/patch/src/library/stats/src/loessf.f new file mode 100644 index 0000000000000000000000000000000000000000..c6b8513ba659d12156e03cea6036ff58b44cadc7 --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/library/stats/src/loessf.f @@ -0,0 +1,2047 @@ +C +C The authors of this software are Cleveland, Grosse, and Shyu. +C Copyright (c) 1989, 1992 by AT&T. +C Permission to use, copy, modify, and distribute this software for any +C purpose without fee is hereby granted, provided that this entire notice +C is included in all copies of any software which is or includes a copy +C or modification of this software and in all copies of the supporting +C documentation for such software. +C THIS SOFTWARE IS BEING PROVIDED "AS IS", WITHOUT ANY EXPRESS OR IMPLIED +C WARRANTY. IN PARTICULAR, NEITHER THE AUTHORS NOR AT&T MAKE ANY +C REPRESENTATION OR WARRANTY OF ANY KIND CONCERNING THE MERCHANTABILITY +C OF THIS SOFTWARE OR ITS FITNESS FOR ANY PARTICULAR PURPOSE. + +C altered by B.D. Ripley to +C +C remove unused variables +C make phi in ehg139 double precision to match calling sequence +C +C Note that ehg182(errormsg_code) is in ./loessc.c + + subroutine ehg126(d,n,vc,x,v,nvmax) + integer d,execnt,i,j,k,n,nvmax,vc + DOUBLE PRECISION machin,alpha,beta,mu,t + DOUBLE PRECISION v(nvmax,d),x(n,d) + + DOUBLE PRECISION D1MACH + external D1MACH + save machin,execnt + data execnt /0/ +c MachInf -> machin + execnt=execnt+1 + if(execnt.eq.1)then +c initialize d1mach(2) === DBL_MAX: + machin=D1MACH(2) + end if +c fill in vertices for bounding box of $x$ +c lower left, upper right + do 3 k=1,d + alpha=machin + beta=-machin + do 4 i=1,n + t=x(i,k) + alpha=min(alpha,t) + beta=max(beta,t) + 4 continue +c expand the box a little + mu=0.005D0*max(beta-alpha,1.d-10*max(DABS(alpha),DABS(beta))+ + + 1.d-30) + alpha=alpha-mu + beta=beta+mu + v(1,k)=alpha + v(vc,k)=beta + 3 continue +c remaining vertices + do 5 i=2,vc-1 + j=i-1 + do 6 k=1,d + v(i,k)=v(1+mod(j,2)*(vc-1),k) + j=DBLE(j)/2.D0 + 6 continue + 5 continue + return + end + + subroutine ehg125(p,nv,v,vhit,nvmax,d,k,t,r,s,f,l,u) + logical i1,i2,match + integer d,h,i,i3,j,k,m,mm,nv,nvmax,p,r,s + integer f(r,0:1,s),l(r,0:1,s),u(r,0:1,s),vhit(nvmax) + DOUBLE PRECISION t + DOUBLE PRECISION v(nvmax,d) + external ehg182 + h=nv + do 3 i=1,r + do 4 j=1,s + h=h+1 + do 5 i3=1,d + v(h,i3)=v(f(i,0,j),i3) + 5 continue + v(h,k)=t +c check for redundant vertex + match=.false. + m=1 +c top of while loop + 6 if(.not.match)then + i1=(m.le.nv) + else + i1=.false. + end if + if(.not.(i1))goto 7 + match=(v(m,1).eq.v(h,1)) + mm=2 +c top of while loop + 8 if(match)then + i2=(mm.le.d) + else + i2=.false. + end if + if(.not.(i2))goto 9 + match=(v(m,mm).eq.v(h,mm)) + mm=mm+1 + goto 8 +c bottom of while loop + 9 m=m+1 + goto 6 +c bottom of while loop + 7 m=m-1 + if(match)then + h=h-1 + else + m=h + if(vhit(1).ge.0)then + vhit(m)=p + end if + end if + l(i,0,j)=f(i,0,j) + l(i,1,j)=m + u(i,0,j)=m + u(i,1,j)=f(i,1,j) + 4 continue + 3 continue + nv=h + if(.not.(nv.le.nvmax))then + call ehg182(180) + end if + return + end + + integer function ehg138(i,z,a,xi,lo,hi,ncmax) + logical i1 + integer i,j,ncmax + integer a(ncmax),hi(ncmax),lo(ncmax) + DOUBLE PRECISION xi(ncmax),z(8) +c descend tree until leaf or ambiguous + j=i +c top of while loop + 3 if(a(j).ne.0)then + i1=(z(a(j)).ne.xi(j)) + else + i1=.false. + end if + if(.not.(i1))goto 4 + if(z(a(j)).le.xi(j))then + j=lo(j) + else + j=hi(j) + end if + goto 3 +c bottom of while loop + 4 ehg138=j + return + end + + subroutine ehg106(il,ir,k,nk,p,pi,n) + +c Partial sorting of p(1, il:ir) returning the sort indices pi() only +c such that p(1, pi(k)) is correct + +c implicit none +c Arguments +c Input: + integer il,ir,k,nk,n + DOUBLE PRECISION p(nk,n) +c using only p(1, pi(*)) +c Output: + integer pi(n) + +c Variables + DOUBLE PRECISION t + integer i,ii,j,l,r + +c find the $k$-th smallest of $n$ elements +c Floyd+Rivest, CACM Mar '75, Algorithm 489 + l=il + r=ir +c while (l < r ) + 3 if(.not.(l.lt.r))goto 4 +c to avoid recursion, sophisticated partition deleted +c partition $x sub {l..r}$ about $t$ + t=p(1,pi(k)) + i=l + j=r + ii=pi(l) + pi(l)=pi(k) + pi(k)=ii + if(t.lt.p(1,pi(r)))then + ii=pi(l) + pi(l)=pi(r) + pi(r)=ii + end if +c top of while loop + 5 if(.not.(i.lt.j))goto 6 + ii=pi(i) + pi(i)=pi(j) + pi(j)=ii + i=i+1 + j=j-1 +c top of while loop + 7 if(.not.(p(1,pi(i)).lt.t))goto 8 + i=i+1 + goto 7 +c bottom of while loop + 8 continue +c top of while loop + 9 if(.not.(t.lt.p(1,pi(j))))goto 10 + j=j-1 + goto 9 +c bottom of while loop + 10 goto 5 +c bottom of while loop + 6 if(p(1,pi(l)).eq.t)then + ii=pi(l) + pi(l)=pi(j) + pi(j)=ii + else + j=j+1 + ii=pi(r) + pi(r)=pi(j) + pi(j)=ii + end if + if(j.le.k)then + l=j+1 + end if + if(k.le.j)then + r=j-1 + end if + goto 3 +c bottom of while loop + 4 return + end + + + subroutine ehg127(q,n,d,nf,f,x,psi,y,rw,kernel,k,dist,eta,b,od,w, + + rcond,sing,sigma,u,e,dgamma,qraux,work,tol,dd,tdeg,cdeg,s) + integer column,d,dd,execnt,i,i3,i9,info,inorm2,j,jj,jpvt,k,kernel, + + n,nf,od,sing,tdeg + integer cdeg(8),psi(n) + double precision machep,f,i1,i10,i2,i4,i5,i6,i7,i8,rcond,rho,scal, + + tol + double precision g(15),sigma(15),u(15,15),e(15,15),b(nf,k), + + colnor(15),dist(n),eta(nf),dgamma(15),q(d),qraux(15),rw(n), + + s(0:od),w(nf),work(15),x(n,d),y(n) + + integer idamax + double precision d1mach, ddot + + external ehg106,ehg182,ehg184,dqrdc,dqrsl,dsvdc + external idamax, d1mach, ddot + + save machep,execnt + data execnt /0/ +c colnorm -> colnor +c E -> g +c MachEps -> machep +c V -> e +c X -> b + execnt=execnt+1 + if(execnt.eq.1)then +c initialize d1mach(4) === 1 / DBL_EPSILON === 2^52 : + machep=d1mach(4) + end if +c sort by distance + do 3 i3=1,n + dist(i3)=0 + 3 continue + do 4 j=1,dd + i4=q(j) + do 5 i3=1,n + dist(i3)=dist(i3)+(x(i3,j)-i4)**2 + 5 continue + 4 continue + call ehg106(1,n,nf,1,dist,psi,n) + rho=dist(psi(nf))*max(1.d0,f) + if(rho .le. 0)then + call ehg182(120) + end if +c compute neighborhood weights + if(kernel.eq.2)then + do 6 i=1,nf + if(dist(psi(i)).lt.rho)then + i1=dsqrt(rw(psi(i))) + else + i1=0 + end if + w(i)=i1 + 6 continue + else + do 7 i3=1,nf + w(i3)=dsqrt(dist(psi(i3))/rho) + 7 continue + do 8 i3=1,nf + w(i3)=dsqrt(rw(psi(i3))*(1-w(i3)**3)**3) + 8 continue + end if + if(dabs(w(idamax(nf,w,1))).eq.0)then + call ehg184('at ',q(1),dd,1) + call ehg184('radius ',rho,1,1) + if(.not..false.)then + call ehg182(121) + end if + end if +c fill design matrix + column=1 + do 9 i3=1,nf + b(i3,column)=w(i3) + 9 continue + if(tdeg.ge.1)then + do 10 j=1,d + if(cdeg(j).ge.1)then + column=column+1 + i5=q(j) + do 11 i3=1,nf + b(i3,column)=w(i3)*(x(psi(i3),j)-i5) + 11 continue + end if + 10 continue + end if + if(tdeg.ge.2)then + do 12 j=1,d + if(cdeg(j).ge.1)then + if(cdeg(j).ge.2)then + column=column+1 + i6=q(j) + do 13 i3=1,nf + b(i3,column)=w(i3)*(x(psi(i3),j)-i6)**2 + 13 continue + end if + do 14 jj=j+1,d + if(cdeg(jj).ge.1)then + column=column+1 + i7=q(j) + i8=q(jj) + do 15 i3=1,nf + b(i3,column)=w(i3)*(x(psi(i3),j)-i7)*(x(psi(i3), + +jj)-i8) + 15 continue + end if + 14 continue + end if + 12 continue + k=column + end if + do 16 i3=1,nf + eta(i3)=w(i3)*y(psi(i3)) + 16 continue +c equilibrate columns + do 17 j=1,k + scal=0 + do 18 inorm2=1,nf + scal=scal+b(inorm2,j)**2 + 18 continue + scal=dsqrt(scal) + if(0.lt.scal)then + do 19 i3=1,nf + b(i3,j)=b(i3,j)/scal + 19 continue + colnor(j)=scal + else + colnor(j)=1 + end if + 17 continue +c singular value decomposition + call dqrdc(b,nf,nf,k,qraux,jpvt,work,0) + call dqrsl(b,nf,nf,k,qraux,eta,work,eta,eta,work,work,1000,info) + do 20 i9=1,k + do 21 i3=1,k + u(i3,i9)=0 + 21 continue + 20 continue + do 22 i=1,k + do 23 j=i,k +c FIXME: this has i = 3 vs bound 2 in a ggplot2 test + u(i,j)=b(i,j) + 23 continue + 22 continue + call dsvdc(u,15,k,k,sigma,g,u,15,e,15,work,21,info) + if(.not.(info.eq.0))then + call ehg182(182) + end if + tol=sigma(1)*(100*machep) + rcond=min(rcond,sigma(k)/sigma(1)) + if(sigma(k).le.tol)then + sing=sing+1 + if(sing.eq.1)then + call ehg184('pseudoinverse used at',q(1),d,1) + call ehg184('neighborhood radius',dsqrt(rho),1,1) + call ehg184('reciprocal condition number ',rcond,1,1) + else + if(sing.eq.2)then + call ehg184('There are other near singularities as well.' + +,rho,1,1) + end if + end if + end if +c compensate for equilibration + do 24 j=1,k + i10=colnor(j) + do 25 i3=1,k + e(j,i3)=e(j,i3)/i10 + 25 continue + 24 continue +c solve least squares problem + do 26 j=1,k + if(tol.lt.sigma(j))then + i2=ddot(k,u(1,j),1,eta,1)/sigma(j) + else + i2=0.d0 + end if + dgamma(j)=i2 + 26 continue + do 27 j=0,od +c bug fix 2006-07-04 for k=1, od>1. (thanks btyner@gmail.com) + if(j.lt.k)then + s(j)=ddot(k,e(j+1,1),15,dgamma,1) + else + s(j)=0.d0 + end if + 27 continue + return + end + + subroutine ehg131(x,y,rw,trl,diagl,kernel,k,n,d,nc,ncmax,vc,nv, + + nvmax,nf,f,a,c,hi,lo,pi,psi,v,vhit,vval,xi,dist,eta,b,ntol, + + fd,w,vval2,rcond,sing,dd,tdeg,cdeg,lq,lf,setlf) + logical setlf + integer identi,d,dd,i1,i2,j,k,kernel,n,nc,ncmax,nf,ntol,nv, + + nvmax,sing,tdeg,vc + integer lq(nvmax,nf),a(ncmax),c(vc,ncmax),cdeg(8),hi(ncmax), + + lo(ncmax),pi(n),psi(n),vhit(nvmax) + double precision f,fd,rcond,trl + double precision lf(0:d,nvmax,nf),b(*),delta(8),diagl(n),dist(n), + + eta(nf),rw(n),v(nvmax,d),vval(0:d,nvmax),vval2(0:d,nvmax), + + w(nf),x(n,d),xi(ncmax),y(n) + external ehg126,ehg182,ehg139,ehg124 + double precision dnrm2 + external dnrm2 +c Identity -> identi +c X -> b + if(.not.(d.le.8))then + call ehg182(101) + end if +c build $k$-d tree + call ehg126(d,n,vc,x,v,nvmax) + nv=vc + nc=1 + do 3 j=1,vc + c(j,nc)=j + vhit(j)=0 + 3 continue + do 4 i1=1,d + delta(i1)=v(vc,i1)-v(1,i1) + 4 continue + fd=fd*dnrm2(d,delta,1) + do 5 identi=1,n + pi(identi)=identi + 5 continue + call ehg124(1,n,d,n,nv,nc,ncmax,vc,x,pi,a,xi,lo,hi,c,v,vhit,nvmax, + +ntol,fd,dd) +c smooth + if(trl.ne.0)then + do 6 i2=1,nv + do 7 i1=0,d + vval2(i1,i2)=0 + 7 continue + 6 continue + end if + call ehg139(v,nvmax,nv,n,d,nf,f,x,pi,psi,y,rw,trl,kernel,k,dist, + + dist,eta,b,d,w,diagl,vval2,nc,vc,a,xi,lo,hi,c,vhit,rcond, + + sing,dd,tdeg,cdeg,lq,lf,setlf,vval) + return + end + + subroutine ehg133(n,d,vc,nvmax,nc,ncmax,a,c,hi,lo,v,vval,xi,m,z,s) + integer n,d,vc,nvmax,nc,ncmax, m + integer a(ncmax),c(vc,ncmax),hi(ncmax),lo(ncmax) + double precision v(nvmax,d),vval(0:d,nvmax),xi(ncmax),z(m,d),s(m) +c Var + double precision delta(8) + integer i,i1 + + double precision ehg128 + external ehg128 + + do 3 i=1,m + do 4 i1=1,d + delta(i1)=z(i,i1) + 4 continue + s(i)=ehg128(delta,d,ncmax,vc,a,xi,lo,hi,c,v,nvmax,vval) + 3 continue + return + end + + subroutine ehg140(iw,i,j) + integer i,j + integer iw(i) + iw(i)=j + return + end + + subroutine ehg141(trl,n,deg,k,d,nsing,dk,delta1,delta2) + double precision trl,delta1,delta2 + integer n,deg,k,d,nsing,dk + + double precision c(48), c1, c2, c3, c4, corx,z,zz(1) + integer i + + external ehg176 + double precision ehg176 + +c coef, d, deg, del + data c / .2971620d0,.3802660d0,.5886043d0,.4263766d0,.3346498d0, + +.6271053d0,.5241198d0,.3484836d0,.6687687d0,.6338795d0,.4076457d0, + +.7207693d0,.1611761d0,.3091323d0,.4401023d0,.2939609d0,.3580278d0, + +.5555741d0,.3972390d0,.4171278d0,.6293196d0,.4675173d0,.4699070d0, + +.6674802d0,.2848308d0,.2254512d0,.2914126d0,.5393624d0,.2517230d0, + +.3898970d0,.7603231d0,.2969113d0,.4740130d0,.9664956d0,.3629838d0, + +.5348889d0,.2075670d0,.2822574d0,.2369957d0,.3911566d0,.2981154d0, + +.3623232d0,.5508869d0,.3501989d0,.4371032d0,.7002667d0,.4291632d0, + +.4930370d0 / + + if(deg.eq.0) dk=1 + if(deg.eq.1) dk=d+1 + if(deg.eq.2) dk=dble((d+2)*(d+1))/2.d0 + corx=dsqrt(k/dble(n)) + z=(dsqrt(k/trl)-corx)/(1-corx) + if(nsing .eq. 0 .and. 1 .lt. z) call ehg184('Chernobyl! trL<k',t + +rl,1,1) + if(z .lt. 0) call ehg184('Chernobyl! trL>n',trl,1,1) + z=min(1.0d0,max(0.0d0,z)) +c R fix + zz(1)=z + c4=dexp(ehg176(zz)) + i=1+3*(min(d,4)-1+4*(deg-1)) + if(d.le.4)then + c1=c(i) + c2=c(i+1) + c3=c(i+2) + else + c1=c(i)+(d-4)*(c(i)-c(i-3)) + c2=c(i+1)+(d-4)*(c(i+1)-c(i-2)) + c3=c(i+2)+(d-4)*(c(i+2)-c(i-1)) + endif + delta1=n-trl*dexp(c1*z**c2*(1-z)**c3*c4) + i=i+24 + if(d.le.4)then + c1=c(i) + c2=c(i+1) + c3=c(i+2) + else + c1=c(i)+(d-4)*(c(i)-c(i-3)) + c2=c(i+1)+(d-4)*(c(i+1)-c(i-2)) + c3=c(i+2)+(d-4)*(c(i+2)-c(i-1)) + endif + delta2=n-trl*dexp(c1*z**c2*(1-z)**c3*c4) + return + end + + subroutine lowesc(n,l,ll,trl,delta1,delta2) + integer i,j,n + double precision delta1,delta2,trl + double precision l(n,n),ll(n,n) + double precision ddot + external ddot +c compute $LL~=~(I-L)(I-L)'$ + do 3 i=1,n + l(i,i)=l(i,i)-1 + 3 continue + do 4 i=1,n + do 5 j=1,i + ll(i,j)=ddot(n,l(i,1),n,l(j,1),n) + 5 continue + 4 continue + do 6 i=1,n + do 7 j=i+1,n + ll(i,j)=ll(j,i) + 7 continue + 6 continue + do 8 i=1,n + l(i,i)=l(i,i)+1 + 8 continue +c accumulate first two traces + trl=0 + delta1=0 + do 9 i=1,n + trl=trl+l(i,i) + delta1=delta1+ll(i,i) + 9 continue +c $delta sub 2 = "tr" LL sup 2$ + delta2=0 + do 10 i=1,n + delta2=delta2+ddot(n,ll(i,1),n,ll(1,i),1) + 10 continue + return + end + + subroutine ehg169(d,vc,nc,ncmax,nv,nvmax,v,a,xi,c,hi,lo) + integer d,vc,nc,ncmax,nv,nvmax + integer a(ncmax), c(vc,ncmax), hi(ncmax), lo(ncmax) + DOUBLE PRECISION v(nvmax,d),xi(ncmax) + + integer novhit(1),i,j,k,mc,mv,p + external ehg125,ehg182 + integer ifloor + external ifloor + +c as in bbox +c remaining vertices + do 3 i=2,vc-1 + j=i-1 + do 4 k=1,d + v(i,k)=v(1+mod(j,2)*(vc-1),k) + j=ifloor(DBLE(j)/2.D0) + 4 continue + 3 continue +c as in ehg131 + mc=1 + mv=vc + novhit(1)=-1 + do 5 j=1,vc + c(j,mc)=j + 5 continue +c as in rbuild + p=1 +c top of while loop + 6 if(.not.(p.le.nc))goto 7 + if(a(p).ne.0)then + k=a(p) +c left son + mc=mc+1 + lo(p)=mc +c right son + mc=mc+1 + hi(p)=mc + call ehg125(p,mv,v,novhit,nvmax,d,k,xi(p),2**(k-1),2**(d-k), + + c(1,p),c(1,lo(p)),c(1,hi(p))) + end if + p=p+1 + goto 6 +c bottom of while loop + 7 if(.not.(mc.eq.nc))then + call ehg182(193) + end if + if(.not.(mv.eq.nv))then + call ehg182(193) + end if + return + end + + DOUBLE PRECISION function ehg176(z) +c + DOUBLE PRECISION z(*) +c + integer d,vc,nv,nc + integer a(17), c(2,17) + integer hi(17), lo(17) + DOUBLE PRECISION v(10,1) + DOUBLE PRECISION vval(0:1,10) + DOUBLE PRECISION xi(17) + double precision ehg128 + external ehg128 + + data d,vc,nv,nc /1,2,10,17/ + data a(1) /1/ + data hi(1),lo(1),xi(1) /3,2,0.3705D0/ + data c(1,1) /1/ + data c(2,1) /2/ + data a(2) /1/ + data hi(2),lo(2),xi(2) /5,4,0.2017D0/ + data c(1,2) /1/ + data c(2,2) /3/ + data a(3) /1/ + data hi(3),lo(3),xi(3) /7,6,0.5591D0/ + data c(1,3) /3/ + data c(2,3) /2/ + data a(4) /1/ + data hi(4),lo(4),xi(4) /9,8,0.1204D0/ + data c(1,4) /1/ + data c(2,4) /4/ + data a(5) /1/ + data hi(5),lo(5),xi(5) /11,10,0.2815D0/ + data c(1,5) /4/ + data c(2,5) /3/ + data a(6) /1/ + data hi(6),lo(6),xi(6) /13,12,0.4536D0/ + data c(1,6) /3/ + data c(2,6) /5/ + data a(7) /1/ + data hi(7),lo(7),xi(7) /15,14,0.7132D0/ + data c(1,7) /5/ + data c(2,7) /2/ + data a(8) /0/ + data c(1,8) /1/ + data c(2,8) /6/ + data a(9) /0/ + data c(1,9) /6/ + data c(2,9) /4/ + data a(10) /0/ + data c(1,10) /4/ + data c(2,10) /7/ + data a(11) /0/ + data c(1,11) /7/ + data c(2,11) /3/ + data a(12) /0/ + data c(1,12) /3/ + data c(2,12) /8/ + data a(13) /0/ + data c(1,13) /8/ + data c(2,13) /5/ + data a(14) /0/ + data c(1,14) /5/ + data c(2,14) /9/ + data a(15) /1/ + data hi(15),lo(15),xi(15) /17,16,0.8751D0/ + data c(1,15) /9/ + data c(2,15) /2/ + data a(16) /0/ + data c(1,16) /9/ + data c(2,16) /10/ + data a(17) /0/ + data c(1,17) /10/ + data c(2,17) /2/ + data vval(0,1) /-9.0572D-2/ + data v(1,1) /-5.D-3/ + data vval(1,1) /4.4844D0/ + data vval(0,2) /-1.0856D-2/ + data v(2,1) /1.005D0/ + data vval(1,2) /-0.7736D0/ + data vval(0,3) /-5.3718D-2/ + data v(3,1) /0.3705D0/ + data vval(1,3) /-0.3495D0/ + data vval(0,4) /2.6152D-2/ + data v(4,1) /0.2017D0/ + data vval(1,4) /-0.7286D0/ + data vval(0,5) /-5.8387D-2/ + data v(5,1) /0.5591D0/ + data vval(1,5) /0.1611D0/ + data vval(0,6) /9.5807D-2/ + data v(6,1) /0.1204D0/ + data vval(1,6) /-0.7978D0/ + data vval(0,7) /-3.1926D-2/ + data v(7,1) /0.2815D0/ + data vval(1,7) /-0.4457D0/ + data vval(0,8) /-6.4170D-2/ + data v(8,1) /0.4536D0/ + data vval(1,8) /3.2813D-2/ + data vval(0,9) /-2.0636D-2/ + data v(9,1) /0.7132D0/ + data vval(1,9) /0.3350D0/ + data vval(0,10) /4.0172D-2/ + data v(10,1) /0.8751D0/ + data vval(1,10) /-4.1032D-2/ + ehg176=ehg128(z,d,nc,vc,a,xi,lo,hi,c,v,nv,vval) + end + + subroutine lowesa(trl,n,d,tau,nsing,delta1,delta2) + integer n,d,tau,nsing + double precision trl, delta1,delta2 + + integer dka,dkb + double precision alpha,d1a,d1b,d2a,d2b + external ehg141 + + call ehg141(trl,n,1,tau,d,nsing,dka,d1a,d2a) + call ehg141(trl,n,2,tau,d,nsing,dkb,d1b,d2b) + alpha=dble(tau-dka)/dble(dkb-dka) + delta1=(1-alpha)*d1a+alpha*d1b + delta2=(1-alpha)*d2a+alpha*d2b + return + end + + subroutine ehg191(m,z,l,d,n,nf,nv,ncmax,vc,a,xi,lo,hi,c,v,nvmax, + + vval2,lf,lq) +c Args + integer m,d,n,nf,nv,ncmax,nvmax,vc + double precision z(m,d), l(m,n), xi(ncmax), v(nvmax,d), + + vval2(0:d,nvmax), lf(0:d,nvmax,nf) + integer lq(nvmax,nf),a(ncmax),c(vc,ncmax),lo(ncmax),hi(ncmax) +c Var + integer lq1,i,i1,i2,j,p + double precision zi(8) + double precision ehg128 + external ehg128 + + do 3 j=1,n + do 4 i2=1,nv + do 5 i1=0,d + vval2(i1,i2)=0 + 5 continue + 4 continue + do 6 i=1,nv +c linear search for i in Lq + lq1=lq(i,1) + lq(i,1)=j + p=nf +c top of while loop + 7 if(.not.(lq(i,p).ne.j))goto 8 + p=p-1 + goto 7 +c bottom of while loop + 8 lq(i,1)=lq1 + if(lq(i,p).eq.j)then + do 9 i1=0,d + vval2(i1,i)=lf(i1,i,p) + 9 continue + end if + 6 continue + do 10 i=1,m + do 11 i1=1,d + zi(i1)=z(i,i1) + 11 continue + l(i,j)=ehg128(zi,d,ncmax,vc,a,xi,lo,hi,c,v,nvmax,vval2) + 10 continue + 3 continue + return + end + + subroutine ehg196(tau,d,f,trl) + integer d,dka,dkb,tau + double precision alpha,f,trl,trla,trlb + external ehg197 + call ehg197(1,tau,d,f,dka,trla) + call ehg197(2,tau,d,f,dkb,trlb) + alpha=dble(tau-dka)/dble(dkb-dka) + trl=(1-alpha)*trla+alpha*trlb + return + end + + subroutine ehg197(deg,tau,d,f,dk,trl) + integer deg,tau,d,dk + double precision f, trl + + double precision g1 + dk = 0 + if(deg.eq.1) dk=d+1 + if(deg.eq.2) dk=dble((d+2)*(d+1))/2.d0 + g1 = (-0.08125d0*d+0.13d0)*d+1.05d0 + trl = dk*(1+max(0.d0,(g1-f)/f)) + return + end + + subroutine ehg192(y,d,n,nf,nv,nvmax,vval,lf,lq) + integer d,i,i1,i2,j,n,nf,nv,nvmax + integer lq(nvmax,nf) + DOUBLE PRECISION i3 + DOUBLE PRECISION lf(0:d,nvmax,nf),vval(0:d,nvmax),y(n) + + do 3 i2=1,nv + do 4 i1=0,d + vval(i1,i2)=0 + 4 continue + 3 continue + do 5 i=1,nv + do 6 j=1,nf + i3=y(lq(i,j)) + do 7 i1=0,d + vval(i1,i)=vval(i1,i)+i3*lf(i1,i,j) + 7 continue + 6 continue + 5 continue + return + end + + DOUBLE PRECISION function ehg128(z,d,ncmax,vc,a,xi,lo,hi,c,v, + + nvmax,vval) + +c implicit none +c Args + integer d,ncmax,nvmax,vc + integer a(ncmax),c(vc,ncmax),hi(ncmax),lo(ncmax) + DOUBLE PRECISION z(d),xi(ncmax),v(nvmax,d), vval(0:d,nvmax) +c Vars + logical i2,i3,i4,i5,i6,i7,i8,i9,i10 + integer i,i1,i11,i12,ig,ii,j,lg,ll,m,nt,ur + integer t(20) + DOUBLE PRECISION ge,gn,gs,gw,gpe,gpn,gps,gpw,h,phi0,phi1, + + psi0,psi1,s,sew,sns,v0,v1,xibar + DOUBLE PRECISION g(0:8,256),g0(0:8),g1(0:8) + + external ehg182,ehg184 +c locate enclosing cell + nt=1 + t(nt)=1 + j=1 +c top of while loop + 3 if(.not.(a(j).ne.0))goto 4 + nt=nt+1 + if(z(a(j)).le.xi(j))then + i1=lo(j) + else + i1=hi(j) + end if + t(nt)=i1 + if(.not.(nt.lt.20))then + call ehg182(181) + end if + j=t(nt) + goto 3 +c bottom of while loop + 4 continue +c tensor + do 5 i12=1,vc + do 6 i11=0,d + g(i11,i12)=vval(i11,c(i12,j)) + 6 continue + 5 continue + lg=vc + ll=c(1,j) + ur=c(vc,j) + do 7 i=d,1,-1 + h=(z(i)-v(ll,i))/(v(ur,i)-v(ll,i)) + if(h.lt.-.001D0)then + call ehg184('eval ',z(1),d,1) + call ehg184('lowerlimit ',v(ll,1),d,nvmax) + else + if(1.001D0.lt.h)then + call ehg184('eval ',z(1),d,1) + call ehg184('upperlimit ',v(ur,1),d,nvmax) + end if + end if + if(-.001D0.le.h)then + i2=(h.le.1.001D0) + else + i2=.false. + end if + if(.not.i2)then + call ehg182(122) + end if + lg=DBLE(lg)/2.D0 + do 8 ig=1,lg +c Hermite basis + phi0=(1-h)**2*(1+2*h) + phi1=h**2*(3-2*h) + psi0=h*(1-h)**2 + psi1=h**2*(h-1) + g(0,ig)=phi0*g(0,ig) + phi1*g(0,ig+lg) + + + (psi0*g(i,ig)+psi1*g(i,ig+lg)) * (v(ur,i)-v(ll,i)) + do 9 ii=1,i-1 + g(ii,ig)=phi0*g(ii,ig)+phi1*g(ii,ig+lg) + 9 continue + 8 continue + 7 continue + s=g(0,1) +c blending + if(d.eq.2)then +c ----- North ----- + v0=v(ll,1) + v1=v(ur,1) + do 10 i11=0,d + g0(i11)=vval(i11,c(3,j)) + 10 continue + do 11 i11=0,d + g1(i11)=vval(i11,c(4,j)) + 11 continue + xibar=v(ur,2) + m=nt-1 +c top of while loop + 12 if(m.eq.0)then + i4=.true. + else + if(a(t(m)).eq.2)then + i3=(xi(t(m)).eq.xibar) + else + i3=.false. + end if + i4=i3 + end if + if(.not.(.not.i4))goto 13 + m=m-1 +c voidp junk + goto 12 +c bottom of while loop + 13 if(m.ge.1)then + m=hi(t(m)) +c top of while loop + 14 if(.not.(a(m).ne.0))goto 15 + if(z(a(m)).le.xi(m))then + m=lo(m) + else + m=hi(m) + end if + goto 14 +c bottom of while loop + 15 if(v0.lt.v(c(1,m),1))then + v0=v(c(1,m),1) + do 16 i11=0,d + g0(i11)=vval(i11,c(1,m)) + 16 continue + end if + if(v(c(2,m),1).lt.v1)then + v1=v(c(2,m),1) + do 17 i11=0,d + g1(i11)=vval(i11,c(2,m)) + 17 continue + end if + end if + h=(z(1)-v0)/(v1-v0) +c Hermite basis + phi0=(1-h)**2*(1+2*h) + phi1=h**2*(3-2*h) + psi0=h*(1-h)**2 + psi1=h**2*(h-1) + gn=phi0*g0(0)+phi1*g1(0)+(psi0*g0(1)+psi1*g1(1))*(v1-v0) + gpn=phi0*g0(2)+phi1*g1(2) +c ----- South ----- + v0=v(ll,1) + v1=v(ur,1) + do 18 i11=0,d + g0(i11)=vval(i11,c(1,j)) + 18 continue + do 19 i11=0,d + g1(i11)=vval(i11,c(2,j)) + 19 continue + xibar=v(ll,2) + m=nt-1 +c top of while loop + 20 if(m.eq.0)then + i6=.true. + else + if(a(t(m)).eq.2)then + i5=(xi(t(m)).eq.xibar) + else + i5=.false. + end if + i6=i5 + end if + if(.not.(.not.i6))goto 21 + m=m-1 +c voidp junk + goto 20 +c bottom of while loop + 21 if(m.ge.1)then + m=lo(t(m)) +c top of while loop + 22 if(.not.(a(m).ne.0))goto 23 + if(z(a(m)).le.xi(m))then + m=lo(m) + else + m=hi(m) + end if + goto 22 +c bottom of while loop + 23 if(v0.lt.v(c(3,m),1))then + v0=v(c(3,m),1) + do 24 i11=0,d + g0(i11)=vval(i11,c(3,m)) + 24 continue + end if + if(v(c(4,m),1).lt.v1)then + v1=v(c(4,m),1) + do 25 i11=0,d + g1(i11)=vval(i11,c(4,m)) + 25 continue + end if + end if + h=(z(1)-v0)/(v1-v0) +c Hermite basis + phi0=(1-h)**2*(1+2*h) + phi1=h**2*(3-2*h) + psi0=h*(1-h)**2 + psi1=h**2*(h-1) + gs=phi0*g0(0)+phi1*g1(0)+(psi0*g0(1)+psi1*g1(1))*(v1-v0) + gps=phi0*g0(2)+phi1*g1(2) +c ----- East ----- + v0=v(ll,2) + v1=v(ur,2) + do 26 i11=0,d + g0(i11)=vval(i11,c(2,j)) + 26 continue + do 27 i11=0,d + g1(i11)=vval(i11,c(4,j)) + 27 continue + xibar=v(ur,1) + m=nt-1 +c top of while loop + 28 if(m.eq.0)then + i8=.true. + else + if(a(t(m)).eq.1)then + i7=(xi(t(m)).eq.xibar) + else + i7=.false. + end if + i8=i7 + end if + if(.not.(.not.i8))goto 29 + m=m-1 +c voidp junk + goto 28 +c bottom of while loop + 29 if(m.ge.1)then + m=hi(t(m)) +c top of while loop + 30 if(.not.(a(m).ne.0))goto 31 + if(z(a(m)).le.xi(m))then + m=lo(m) + else + m=hi(m) + end if + goto 30 +c bottom of while loop + 31 if(v0.lt.v(c(1,m),2))then + v0=v(c(1,m),2) + do 32 i11=0,d + g0(i11)=vval(i11,c(1,m)) + 32 continue + end if + if(v(c(3,m),2).lt.v1)then + v1=v(c(3,m),2) + do 33 i11=0,d + g1(i11)=vval(i11,c(3,m)) + 33 continue + end if + end if + h=(z(2)-v0)/(v1-v0) +c Hermite basis + phi0=(1-h)**2*(1+2*h) + phi1=h**2*(3-2*h) + psi0=h*(1-h)**2 + psi1=h**2*(h-1) + ge=phi0*g0(0)+phi1*g1(0)+(psi0*g0(2)+psi1*g1(2))*(v1-v0) + gpe=phi0*g0(1)+phi1*g1(1) +c ----- West ----- + v0=v(ll,2) + v1=v(ur,2) + do 34 i11=0,d + g0(i11)=vval(i11,c(1,j)) + 34 continue + do 35 i11=0,d + g1(i11)=vval(i11,c(3,j)) + 35 continue + xibar=v(ll,1) + m=nt-1 +c top of while loop + 36 if(m.eq.0)then + i10=.true. + else + if(a(t(m)).eq.1)then + i9=(xi(t(m)).eq.xibar) + else + i9=.false. + end if + i10=i9 + end if + if(.not.(.not.i10))goto 37 + m=m-1 +c voidp junk + goto 36 +c bottom of while loop + 37 if(m.ge.1)then + m=lo(t(m)) +c top of while loop + 38 if(.not.(a(m).ne.0))goto 39 + if(z(a(m)).le.xi(m))then + m=lo(m) + else + m=hi(m) + end if + goto 38 +c bottom of while loop + 39 if(v0.lt.v(c(2,m),2))then + v0=v(c(2,m),2) + do 40 i11=0,d + g0(i11)=vval(i11,c(2,m)) + 40 continue + end if + if(v(c(4,m),2).lt.v1)then + v1=v(c(4,m),2) + do 41 i11=0,d + g1(i11)=vval(i11,c(4,m)) + 41 continue + end if + end if + h=(z(2)-v0)/(v1-v0) +c Hermite basis + phi0=(1-h)**2*(1+2*h) + phi1=h**2*(3-2*h) + psi0=h*(1-h)**2 + psi1=h**2*(h-1) + gw=phi0*g0(0)+phi1*g1(0)+(psi0*g0(2)+psi1*g1(2))*(v1-v0) + gpw=phi0*g0(1)+phi1*g1(1) +c NS + h=(z(2)-v(ll,2))/(v(ur,2)-v(ll,2)) +c Hermite basis + phi0=(1-h)**2*(1+2*h) + phi1=h**2*(3-2*h) + psi0=h*(1-h)**2 + psi1=h**2*(h-1) + sns=phi0*gs+phi1*gn+(psi0*gps+psi1*gpn)*(v(ur,2)-v(ll,2)) +c EW + h=(z(1)-v(ll,1))/(v(ur,1)-v(ll,1)) +c Hermite basis + phi0=(1-h)**2*(1+2*h) + phi1=h**2*(3-2*h) + psi0=h*(1-h)**2 + psi1=h**2*(h-1) + sew=phi0*gw+phi1*ge+(psi0*gpw+psi1*gpe)*(v(ur,1)-v(ll,1)) + s=(sns+sew)-s + end if + ehg128=s + return + end + + integer function ifloor(x) + DOUBLE PRECISION x + ifloor=x + if(ifloor.gt.x) ifloor=ifloor-1 + end + +c DSIGN is unused, causes conflicts on some platforms +c DOUBLE PRECISION function DSIGN(a1,a2) +c DOUBLE PRECISION a1, a2 +c DSIGN=DABS(a1) +c if(a2.ge.0)DSIGN=-DSIGN +c end + + +c ehg136() is the workhorse of lowesf(.) +c n = number of observations +c m = number of x values at which to evaluate +c f = span +c nf = min(n, floor(f * n)) + subroutine ehg136(u,lm,m,n,d,nf,f,x,psi,y,rw,kernel,k,dist,eta,b, + + od,o,ihat,w,rcond,sing,dd,tdeg,cdeg,s) + integer identi,d,dd,i,i1,ihat,info,j,k,kernel,l,lm,m,n,nf, + + od,sing,tdeg + integer cdeg(8),psi(n) + double precision f,i2,rcond,scale,tol + double precision o(m,n),sigma(15),e(15,15),g(15,15),b(nf,k), + $ dist(n),eta(nf),dgamma(15),q(8),qraux(15),rw(n),s(0:od,m), + $ u(lm,d),w(nf),work(15),x(n,d),y(n) + + external ehg127,ehg182,dqrsl + double precision ddot + external ddot + +c V -> g +c U -> e +c Identity -> identi +c L -> o +c X -> b + if(k .gt. nf-1) call ehg182(104) + if(k .gt. 15) call ehg182(105) + do 3 identi=1,n + psi(identi)=identi + 3 continue + do 4 l=1,m + do 5 i1=1,d + q(i1)=u(l,i1) + 5 continue + call ehg127(q,n,d,nf,f,x,psi,y,rw,kernel,k,dist,eta,b,od,w, + + rcond,sing,sigma,e,g,dgamma,qraux,work,tol,dd,tdeg,cdeg, + + s(0,l)) + if(ihat.eq.1)then +c $L sub {l,l} = +c V sub {1,:} SIGMA sup {+} U sup T +c (Q sup T W e sub i )$ + if(.not.(m.eq.n))then + call ehg182(123) + end if +c find $i$ such that $l = psi sub i$ + i=1 +c top of while loop + 6 if(.not.(l.ne.psi(i)))goto 7 + i=i+1 + if(.not.(i.lt.nf))then + call ehg182(123) +c next line is not in current dloess + goto 7 + end if + goto 6 +c bottom of while loop + 7 do 8 i1=1,nf + eta(i1)=0 + 8 continue + eta(i)=w(i) +c $eta = Q sup T W e sub i$ + call dqrsl(b,nf,nf,k,qraux,eta,eta,eta,eta,eta,eta,1000, + + info) +c $gamma = U sup T eta sub {1:k}$ + do 9 i1=1,k + dgamma(i1)=0 + 9 continue + do 10 j=1,k + i2=eta(j) + do 11 i1=1,k + dgamma(i1)=dgamma(i1)+i2*e(j,i1) + 11 continue + 10 continue +c $gamma = SIGMA sup {+} gamma$ + do 12 j=1,k + if(tol.lt.sigma(j))then + dgamma(j)=dgamma(j)/sigma(j) + else + dgamma(j)=0.d0 + end if + 12 continue +c voidp junk +c voidp junk + o(l,1)=ddot(k,g(1,1),15,dgamma,1) + else + if(ihat.eq.2)then +c $L sub {l,:} = +c V sub {1,:} SIGMA sup {+} +c ( U sup T Q sup T ) W $ + do 13 i1=1,n + o(l,i1)=0 + 13 continue + do 14 j=1,k + do 15 i1=1,nf + eta(i1)=0 + 15 continue + do 16 i1=1,k + eta(i1)=e(i1,j) + 16 continue + call dqrsl(b,nf,nf,k,qraux,eta,eta,work,work,work,work + + ,10000,info) + if(tol.lt.sigma(j))then + scale=1.d0/sigma(j) + else + scale=0.d0 + end if + do 17 i1=1,nf + eta(i1)=eta(i1)*(scale*w(i1)) + 17 continue + do 18 i=1,nf + o(l,psi(i))=o(l,psi(i))+g(1,j)*eta(i) + 18 continue + 14 continue + end if + end if + 4 continue + return + end + +c called from lowesb() ... compute fit ..?..?... +c somewhat similar to ehg136 + subroutine ehg139(v,nvmax,nv,n,d,nf,f,x,pi,psi,y,rw,trl,kernel,k, + + dist,phi,eta,b,od,w,diagl,vval2,ncmax,vc,a,xi,lo,hi,c,vhit, + + rcond,sing,dd,tdeg,cdeg,lq,lf,setlf,s) + logical setlf + integer identi,d,dd,i,i2,i3,i5,i6,ii,ileaf,info,j,k,kernel, + + l,n,ncmax,nf,nleaf,nv,nvmax,od,sing,tdeg,vc + integer lq(nvmax,nf),a(ncmax),c(vc,ncmax),cdeg(8),hi(ncmax), + + leaf(256),lo(ncmax),pi(n),psi(n),vhit(nvmax) + DOUBLE PRECISION f,i1,i4,i7,rcond,scale,term,tol,trl + DOUBLE PRECISION lf(0:d,nvmax,nf),sigma(15),u(15,15),e(15,15), + + b(nf,k),diagl(n),dist(n),eta(nf),DGAMMA(15),q(8),qraux(15), + + rw(n),s(0:od,nv),v(nvmax,d),vval2(0:d,nv),w(nf),work(15), + + x(n,d),xi(ncmax),y(n),z(8) + DOUBLE PRECISION phi(n) + + external ehg127,ehg182,DQRSL,ehg137 + DOUBLE PRECISION ehg128 + external ehg128 + DOUBLE PRECISION DDOT + external DDOT + +c V -> e +c Identity -> identi +c X -> b +c l2fit with trace(L) + if(k .gt. nf-1) call ehg182(104) + if(k .gt. 15) call ehg182(105) + if(trl.ne.0)then + do 3 i5=1,n + diagl(i5)=0 + 3 continue + do 4 i6=1,nv + do 5 i5=0,d + vval2(i5,i6)=0 + 5 continue + 4 continue + end if + do 6 identi=1,n + psi(identi)=identi + 6 continue + do 7 l=1,nv + do 8 i5=1,d + q(i5)=v(l,i5) + 8 continue + call ehg127(q,n,d,nf,f,x,psi,y,rw,kernel,k,dist,eta,b,od,w, + + rcond,sing,sigma,u,e,DGAMMA,qraux,work,tol,dd,tdeg,cdeg, + + s(0,l)) + if(trl.ne.0)then +c invert $psi$ + do 9 i5=1,n + phi(i5)=0 + 9 continue + do 10 i=1,nf + phi(psi(i))=i + 10 continue + do 11 i5=1,d + z(i5)=v(l,i5) + 11 continue + call ehg137(z,vhit(l),leaf,nleaf,d,nv,nvmax,ncmax,a,xi, + + lo,hi) + do 12 ileaf=1,nleaf + do 13 ii=lo(leaf(ileaf)),hi(leaf(ileaf)) + i=phi(pi(ii)) + if(i.ne.0)then + if(.not.(psi(i).eq.pi(ii)))then + call ehg182(194) + end if + do 14 i5=1,nf + eta(i5)=0 + 14 continue + eta(i)=w(i) +c $eta = Q sup T W e sub i$ + call DQRSL(b,nf,nf,k,qraux,eta,work,eta,eta,work, + + work,1000,info) + do 15 j=1,k + if(tol.lt.sigma(j))then + i4=DDOT(k,u(1,j),1,eta,1)/sigma(j) + else + i4=0.D0 + end if + DGAMMA(j)=i4 + 15 continue + do 16 j=1,d+1 +c bug fix 2006-07-15 for k=1, od>1. (thanks btyner@gmail.com) + if(j.le.k)then + vval2(j-1,l)=DDOT(k,e(j,1),15,DGAMMA,1) + else + vval2(j-1,l)=0.0d0 + end if + 16 continue + do 17 i5=1,d + z(i5)=x(pi(ii),i5) + 17 continue + term=ehg128(z,d,ncmax,vc,a,xi,lo,hi,c,v,nvmax, + + vval2) + diagl(pi(ii))=diagl(pi(ii))+term + do 18 i5=0,d + vval2(i5,l)=0 + 18 continue + end if + 13 continue + 12 continue + end if + if(setlf)then +c $Lf sub {:,l,:} = V SIGMA sup {+} U sup T Q sup T W$ + if(.not.(k.ge.d+1))then + call ehg182(196) + end if + do 19 i5=1,nf + lq(l,i5)=psi(i5) + 19 continue + do 20 i6=1,nf + do 21 i5=0,d + lf(i5,l,i6)=0 + 21 continue + 20 continue + do 22 j=1,k + do 23 i5=1,nf + eta(i5)=0 + 23 continue + do 24 i5=1,k + eta(i5)=u(i5,j) + 24 continue + call DQRSL(b,nf,nf,k,qraux,eta,eta,work,work,work,work, + + 10000,info) + if(tol.lt.sigma(j))then + scale=1.D0/sigma(j) + else + scale=0.D0 + end if + do 25 i5=1,nf + eta(i5)=eta(i5)*(scale*w(i5)) + 25 continue + do 26 i=1,nf + i7=eta(i) + do 27 i5=0,d + if(i5.lt.k)then + lf(i5,l,i)=lf(i5,l,i)+e(1+i5,j)*i7 + else + lf(i5,l,i)=0 + end if + 27 continue + 26 continue + 22 continue + end if + 7 continue + if(trl.ne.0)then + if(n.le.0)then + trl=0.D0 + else + i3=n + i1=diagl(i3) + do 28 i2=i3-1,1,-1 + i1=diagl(i2)+i1 + 28 continue + trl=i1 + end if + end if + return + end + + subroutine lowesb(xx,yy,ww,diagl,infl,iv,liv,lv,wv) + logical infl + integer liv, lv + integer iv(*) + DOUBLE PRECISION xx(*),yy(*),ww(*),diagl(*),wv(*) +c Var + DOUBLE PRECISION trl + logical setlf + + integer ifloor + external ifloor + external ehg131,ehg182,ehg183 + + if(.not.(iv(28).ne.173))then + call ehg182(174) + end if + if(iv(28).ne.172)then + if(.not.(iv(28).eq.171))then + call ehg182(171) + end if + end if + iv(28)=173 + if(infl)then + trl=1.D0 + else + trl=0.D0 + end if + setlf=(iv(27).ne.iv(25)) + call ehg131(xx,yy,ww,trl,diagl,iv(20),iv(29),iv(3),iv(2),iv(5), + + iv(17),iv(4),iv(6),iv(14),iv(19),wv(1),iv(iv(7)),iv(iv(8)), + + iv(iv(9)),iv(iv(10)),iv(iv(22)),iv(iv(27)),wv(iv(11)), + + iv(iv(23)),wv(iv(13)),wv(iv(12)),wv(iv(15)),wv(iv(16)), + + wv(iv(18)),ifloor(iv(3)*wv(2)),wv(3),wv(iv(26)),wv(iv(24)), + + wv(4),iv(30),iv(33),iv(32),iv(41),iv(iv(25)),wv(iv(34)), + + setlf) + if(iv(14).lt.iv(6)+DBLE(iv(4))/2.D0)then + call ehg183('k-d tree limited by memory; nvmax=', + + iv(14),1,1) + else + if(iv(17).lt.iv(5)+2)then + call ehg183('k-d tree limited by memory. ncmax=', + + iv(17),1,1) + end if + end if + return + end + +c lowesd() : Initialize iv(*) and v(1:4) +c ------ called only by loess_workspace() in ./loessc.c + subroutine lowesd(versio,iv,liv,lv,v,d,n,f,ideg,nvmax,setlf) + integer versio,liv,lv,d,n,ideg,nvmax + integer iv(liv) + logical setlf + double precision f, v(lv) + + integer bound,i,i1,i2,j,ncmax,nf,vc + external ehg182 + integer ifloor + external ifloor +c +c unnecessary initialization of i1 to keep g77 -Wall happy +c + i1 = 0 +c version -> versio + if(.not.(versio.eq.106))then + call ehg182(100) + end if + iv(28)=171 + iv(2)=d + iv(3)=n + vc=2**d + iv(4)=vc + if(.not.(0.lt.f))then + call ehg182(120) + end if + nf=min(n,ifloor(n*f)) + iv(19)=nf + iv(20)=1 + if(ideg.eq.0)then + i1=1 + else + if(ideg.eq.1)then + i1=d+1 + else + if(ideg.eq.2)then + i1=dble((d+2)*(d+1))/2.d0 + end if + end if + end if + iv(29)=i1 + iv(21)=1 + iv(14)=nvmax + ncmax=nvmax + iv(17)=ncmax + iv(30)=0 + iv(32)=ideg + if(.not.(ideg.ge.0))then + call ehg182(195) + end if + if(.not.(ideg.le.2))then + call ehg182(195) + end if + iv(33)=d + do 3 i2=41,49 + iv(i2)=ideg + 3 continue + iv(7)=50 + iv(8)=iv(7)+ncmax + iv(9)=iv(8)+vc*ncmax + iv(10)=iv(9)+ncmax + iv(22)=iv(10)+ncmax +c initialize permutation + j=iv(22)-1 + do 4 i=1,n + iv(j+i)=i + 4 continue + iv(23)=iv(22)+n + iv(25)=iv(23)+nvmax + if(setlf)then + iv(27)=iv(25)+nvmax*nf + else + iv(27)=iv(25) + end if + bound=iv(27)+n + if(.not.(bound-1.le.liv))then + call ehg182(102) + end if + iv(11)=50 + iv(13)=iv(11)+nvmax*d + iv(12)=iv(13)+(d+1)*nvmax + iv(15)=iv(12)+ncmax + iv(16)=iv(15)+n + iv(18)=iv(16)+nf + iv(24)=iv(18)+iv(29)*nf + iv(34)=iv(24)+(d+1)*nvmax + if(setlf)then + iv(26)=iv(34)+(d+1)*nvmax*nf + else + iv(26)=iv(34) + end if + bound=iv(26)+nf + if(.not.(bound-1.le.lv))then + call ehg182(103) + end if + v(1)=f + v(2)=0.05d0 + v(3)=0.d0 + v(4)=1.d0 + return + end + + subroutine lowese(iv,liv,lv,wv,m,z,s) + integer liv,lv,m + integer iv(*) + double precision s(m),wv(*),z(m,1) + + external ehg133,ehg182 + + if(.not.(iv(28).ne.172))then + call ehg182(172) + end if + if(.not.(iv(28).eq.173))then + call ehg182(173) + end if + call ehg133(iv(3),iv(2),iv(4),iv(14),iv(5),iv(17),iv(iv(7)),iv(iv( + +8)),iv(iv(9)),iv(iv(10)),wv(iv(11)),wv(iv(13)),wv(iv(12)),m,z,s) + return + end + +c "direct" (non-"interpolate") fit aka predict() : + subroutine lowesf(xx,yy,ww,iv,liv,lv,wv,m,z,l,ihat,s) + integer liv,lv,m,ihat +c m = number of x values at which to evaluate + integer iv(*) + double precision xx(*),yy(*),ww(*),wv(*),z(m,1),l(m,*),s(m) + + logical i1 + + external ehg182,ehg136 + if(171.le.iv(28))then + i1=(iv(28).le.174) + else + i1=.false. + end if + if(.not.i1)then + call ehg182(171) + end if + iv(28)=172 + if(.not.(iv(14).ge.iv(19)))then + call ehg182(186) + end if + +c do the work; in ehg136() give the argument names as they are there: +c ehg136(u,lm,m, n, d, nf, f, x, psi, y ,rw, + call ehg136(z,m,m,iv(3),iv(2),iv(19),wv(1),xx,iv(iv(22)),yy,ww, +c kernel, k, dist, eta, b, od,o,ihat, + + iv(20),iv(29),wv(iv(15)),wv(iv(16)),wv(iv(18)),0,l,ihat, +c w, rcond,sing, dd, tdeg,cdeg, s) + + wv(iv(26)),wv(4),iv(30),iv(33),iv(32),iv(41),s) + return + end + + subroutine lowesl(iv,liv,lv,wv,m,z,l) + integer liv,lv,m + integer iv(*) + double precision l(m,*),wv(*),z(m,1) + + external ehg182,ehg191 + + if(.not.(iv(28).ne.172))then + call ehg182(172) + end if + if(.not.(iv(28).eq.173))then + call ehg182(173) + end if + if(.not.(iv(26).ne.iv(34)))then + call ehg182(175) + end if + call ehg191(m,z,l,iv(2),iv(3),iv(19),iv(6),iv(17),iv(4),iv(iv(7)), + + wv(iv(12)),iv(iv(10)),iv(iv(9)),iv(iv(8)),wv(iv(11)),iv(14), + + wv(iv(24)),wv(iv(34)),iv(iv(25))) + return + end + + subroutine lowesr(yy,iv,liv,lv,wv) + integer liv,lv + integer iv(*) + DOUBLE PRECISION yy(*),wv(*) + + external ehg182,ehg192 + if(.not.(iv(28).ne.172))then + call ehg182(172) + end if + if(.not.(iv(28).eq.173))then + call ehg182(173) + end if + call ehg192(yy,iv(2),iv(3),iv(19),iv(6),iv(14),wv(iv(13)), + + wv(iv(34)),iv(iv(25))) + return + end + + subroutine lowesw(res,n,rw,pi) +c Tranliterated from Devlin's ratfor + +c implicit none +c Args + integer n + double precision res(n),rw(n) + integer pi(n) +c Var + integer identi,i,i1,nh + double precision cmad,rsmall + + integer ifloor + double precision d1mach + + external ehg106 + external ifloor + external d1mach + +c Identity -> identi + +c find median of absolute residuals + do 3 i1=1,n + rw(i1)=dabs(res(i1)) + 3 continue + do 4 identi=1,n + pi(identi)=identi + 4 continue + nh=ifloor(dble(n)/2.d0)+1 +c partial sort to find 6*mad + call ehg106(1,n,nh,1,rw,pi,n) + if((n-nh)+1.lt.nh)then + call ehg106(1,nh-1,nh-1,1,rw,pi,n) + cmad=3*(rw(pi(nh))+rw(pi(nh-1))) + else + cmad=6*rw(pi(nh)) + end if + rsmall=d1mach(1) + if(cmad.lt.rsmall)then + do 5 i1=1,n + rw(i1)=1 + 5 continue + else + do 6 i=1,n + if(cmad*0.999d0.lt.rw(i))then + rw(i)=0 + else + if(cmad*0.001d0.lt.rw(i))then + rw(i)=(1-(rw(i)/cmad)**2)**2 + else + rw(i)=1 + end if + end if + 6 continue + end if + return + end + + subroutine lowesp(n,y,yhat,pwgts,rwgts,pi,ytilde) + integer n + integer pi(n) + double precision y(n),yhat(n),pwgts(n),rwgts(n),ytilde(n) +c Var + double precision c,i1,i4,mad + integer i2,i3,i,m + + external ehg106 + integer ifloor + external ifloor +c median absolute deviation (using partial sort): + do 3 i=1,n + ytilde(i)=dabs(y(i)-yhat(i))*dsqrt(pwgts(i)) + pi(i) = i + 3 continue + m=ifloor(dble(n)/2.d0)+1 + call ehg106(1,n,m,1,ytilde,pi,n) + if((n-m)+1.lt.m)then + call ehg106(1,m-1,m-1,1,ytilde,pi,n) + mad=(ytilde(pi(m-1))+ytilde(pi(m)))/2 + else + mad=ytilde(pi(m)) + end if +c magic constant + c=(6*mad)**2/5 + do 5 i=1,n + ytilde(i)= 1 - ((y(i)-yhat(i))**2 * pwgts(i))/c + 5 continue + do 6 i=1,n + ytilde(i)=ytilde(i)*dsqrt(rwgts(i)) + 6 continue + if(n.le.0)then + i4=0.d0 + else + i3=n + i1=ytilde(i3) + do 7 i2=i3-1,1,-1 + i1=ytilde(i2)+i1 + 7 continue + i4=i1 + end if + c=n/i4 +c pseudovalues + do 8 i=1,n + ytilde(i)=yhat(i) + (c*rwgts(i))*(y(i)-yhat(i)) + 8 continue + return + end + + subroutine ehg124(ll,uu,d,n,nv,nc,ncmax,vc,x,pi,a,xi,lo,hi,c,v, + + vhit,nvmax,fc,fd,dd) + + integer ll,uu,d,n,nv,nc,ncmax,vc,nvmax,fc,dd + integer a(ncmax),c(vc,ncmax),hi(ncmax),lo(ncmax),pi(n),vhit(nvmax) + DOUBLE PRECISION fd, v(nvmax,d),x(n,d),xi(ncmax) + + logical i1,i2,leaf + integer i4,inorm2,k,l,m,p,u, upper, lower, check, offset + DOUBLE PRECISION diam,diag(8),sigma(8) + + external ehg125,ehg106,ehg129 + integer IDAMAX + external IDAMAX + p=1 + l=ll + u=uu + lo(p)=l + hi(p)=u +c top of while loop + 3 if(.not.(p.le.nc))goto 4 + do 5 i4=1,dd + diag(i4)=v(c(vc,p),i4)-v(c(1,p),i4) + 5 continue + diam=0 + do 6 inorm2=1,dd + diam=diam+diag(inorm2)**2 + 6 continue + diam=DSQRT(diam) + if((u-l)+1.le.fc)then + i1=.true. + else + i1=(diam.le.fd) + end if + if(i1)then + leaf=.true. + else + if(ncmax.lt.nc+2)then + i2=.true. + else + i2=(nvmax.lt.nv+DBLE(vc)/2.D0) + end if + leaf=i2 + end if + if(.not.leaf)then + call ehg129(l,u,dd,x,pi,n,sigma) + k=IDAMAX(dd,sigma,1) + m=DBLE(l+u)/2.D0 + call ehg106(l,u,m,1,x(1,k),pi,n) + +c all ties go with hi son +c top of while loop +c bug fix from btyner@gmail.com 2006-07-20 + offset = 0 + 7 if(((m+offset).ge.u).or.((m+offset).lt.l))goto 8 + if(offset .lt. 0)then + lower = l + check = m + offset + upper = check + else + lower = m + offset + 1 + check = lower + upper = u + end if + call ehg106(lower,upper,check,1,x(1,k),pi,n) + if(x(pi(m + offset),k).eq.x(pi(m+offset+1),k))then + offset = -offset + if(offset .ge. 0) then + offset = offset + 1 + end if + goto 7 + else + m = m + offset + goto 8 + end if + +c bottom of while loop + 8 if(v(c(1,p),k).eq.x(pi(m),k))then + leaf=.true. + else + leaf=(v(c(vc,p),k).eq.x(pi(m),k)) + end if + end if + if(leaf)then + a(p)=0 + else + a(p)=k + xi(p)=x(pi(m),k) +c left son + nc=nc+1 + lo(p)=nc + lo(nc)=l + hi(nc)=m +c right son + nc=nc+1 + hi(p)=nc + lo(nc)=m+1 + hi(nc)=u + call ehg125(p,nv,v,vhit,nvmax,d,k,xi(p),2**(k-1),2**(d-k), + + c(1,p),c(1,lo(p)),c(1,hi(p))) + end if + p=p+1 + l=lo(p) + u=hi(p) + goto 3 +c bottom of while loop + 4 return + end + + subroutine ehg129(l,u,d,x,pi,n,sigma) + integer d,execnt,i,k,l,n,u + integer pi(n) + DOUBLE PRECISION machin,alpha,beta,t + DOUBLE PRECISION sigma(d),x(n,d) + DOUBLE PRECISION D1MACH + external D1MACH + save machin,execnt + data execnt /0/ +c MachInf -> machin + execnt=execnt+1 + if(execnt.eq.1)then +c initialize d1mach(2) === DBL_MAX: + machin=D1MACH(2) + end if + do 3 k=1,d + alpha=machin + beta=-machin + do 4 i=l,u + t=x(pi(i),k) + alpha=min(alpha,x(pi(i),k)) + beta=max(beta,t) + 4 continue + sigma(k)=beta-alpha + 3 continue + return + end + +c {called only from ehg127} purpose...?... + subroutine ehg137(z,kappa,leaf,nleaf,d,nv,nvmax,ncmax,a,xi,lo,hi) + integer kappa,d,nv,nvmax,ncmax,nleaf + integer leaf(256),a(ncmax),hi(ncmax),lo(ncmax),pstack(20) + DOUBLE PRECISION z(d),xi(ncmax) + + integer p,stackt + + external ehg182 +c stacktop -> stackt +c find leaf cells affected by $z$ + stackt=0 + p=1 + nleaf=0 +c top of while loop + 3 if(.not.(0.lt.p))goto 4 + if(a(p).eq.0)then +c leaf + nleaf=nleaf+1 + leaf(nleaf)=p +c Pop + if(stackt.ge.1)then + p=pstack(stackt) + else + p=0 + end if + stackt=max(0,stackt-1) + else + if(z(a(p)).eq.xi(p))then +c Push + stackt=stackt+1 + if(.not.(stackt.le.20))then + call ehg182(187) + end if + pstack(stackt)=hi(p) + p=lo(p) + else + if(z(a(p)).le.xi(p))then + p=lo(p) + else + p=hi(p) + end if + end if + end if + goto 3 +c bottom of while loop + 4 if(.not.(nleaf.le.256))then + call ehg182(185) + end if + return + end + +C-- For Error messaging, call the "a" routines at the bottom of ./loessc.c : + subroutine ehg183(s, i, n, inc) + character s*(*) + integer i, n, inc + call ehg183a(s, len(s), i, n, inc) + end + + subroutine ehg184(s, x, n, inc) + character s*(*) + double precision x + integer n, inc + call ehg184a(s, len(s), x, n, inc) + end diff --git a/com.oracle.truffle.r.native/gnur/patch/src/library/stats/src/modreg.h b/com.oracle.truffle.r.native/gnur/patch/src/library/stats/src/modreg.h new file mode 100644 index 0000000000000000000000000000000000000000..a0b26201018ef978af8152aeccc1db1fc02d4754 --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/library/stats/src/modreg.h @@ -0,0 +1,125 @@ +/* + * R : A Computer Language for Statistical Data Analysis + * Copyright (C) 2001-2017 The R Core Team. + * Copyright (C) 2003-2016 The R Foundation + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version. + * + * This program 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 this program; if not, a copy is available at + * https://www.R-project.org/Licenses/ + */ + +#ifndef R_MODREG_H +#define R_MODREG_H + +#include <R.h> +#include <Rinternals.h> +#ifdef ENABLE_NLS +#include <libintl.h> +#define _(String) dgettext ("stats", String) +#else +#define _(String) (String) +#endif + +SEXP isoreg(SEXP y); + +/* monoSpl.c : */ +SEXP monoFC_m(SEXP m, SEXP Sx); +void monoFC_mod(double *m, double Sx[], int n); + +void +loess_raw(double *y, double *x, double *weights, double *robust, int *d, + int *n, double *span, int *degree, int *nonparametric, + int *drop_square, int *sum_drop_sqr, double *cell, + char **surf_stat, double *surface, int *parameter, + int *a, double *xi, double *vert, double *vval, double *diagonal, + double *trL, double *one_delta, double *two_delta, int *setLf); +void +loess_dfit(double *y, double *x, double *x_evaluate, double *weights, + double *span, int *degree, int *nonparametric, + int *drop_square, int *sum_drop_sqr, + int *d, int *n, int *m, double *fit); +void +loess_dfitse(double *y, double *x, double *x_evaluate, double *weights, + double *robust, int *family, double *span, int *degree, + int *nonparametric, int *drop_square, + int *sum_drop_sqr, + int *d, int *n, int *m, double *fit, double *L); +void +loess_ifit(int *parameter, int *a, double *xi, double *vert, + double *vval, int *m, double *x_evaluate, double *fit); +void +loess_ise(double *y, double *x, double *x_evaluate, double *weights, + double *span, int *degree, int *nonparametric, + int *drop_square, int *sum_drop_sqr, double *cell, + int *d, int *n, int *m, double *fit, double *L); + +void kmeans_Lloyd(double *x, int *pn, int *pp, double *cen, int *pk, int *cl, + int *pmaxiter, int *nc, double *wss); + +void kmeans_MacQueen(double *x, int *pn, int *pp, double *cen, int *pk, + int *cl, int *pmaxiter, int *nc, double *wss); + +/* Fortran : */ + +void F77_NAME(lowesw)(double *res, int *n, double *rw, int *pi); +void F77_NAME(lowesp)(int *n, double *y, double *yhat, double *pwgts, + double *rwgts, int *pi, double *ytilde); +void F77_NAME(setppr)(double *span1, double *alpha1, + int *optlevel, int *ism, double *df1, double *gcvpen1); +void F77_NAME(smart)(int *m, int *mu, int *p, int * q, int *n, + double *w, double *x, double *y, + double *ww, double *smod, int *nsmod, double *sp, + int *nsp, double *dp, int *ndp, double *edf); +void F77_NAME(setsmu)(int *tr); +void F77_NAME(pppred)(int *np, double *x, double *smod, double *y, double *sc); +void F77_NAME(rbart)(double *penalt, double *dofoff, + double *xs, double *ys, double *ws, double *ssw, + int *n, double *knot, int *nk, double *coef, + double *sz, double *lev, double *crit, int *iparms, + double *spar, double *parms, + double *scrtch, int *ld4, int *ldnk, int *ier); + +void F77_NAME(sbart) + (double *penalt, double *dofoff, + double *xs, double *ys, double *ws, double *ssw, + int *n, double *knot, int *nk, double *coef, + double *sz, double *lev, double *crit, + int *icrit, double *spar, int *ispar, int *iter, + double *lspar, double *uspar, double *tol, double *eps, double *Ratio, + int *isetup, + double *xwy, double *hs0, double *hs1, double *hs2, + double *hs3, double *sg0, double *sg1, double *sg2, + double *sg3, double *abd, double *p1ip, double *p2ip, + int *ld4, int *ldnk, int *ier); + +void F77_NAME(sgram)(double *sg0, double *sg1, double *sg2, double *sg3, + double *tb, int *nb); +void F77_NAME(stxwx)(double *x, double *z, double *w, + int *k, double *xknot, int *n, double *y, + double *hs0, double *hs1, double *hs2, double *hs3); +void F77_NAME(sslvrg)(double *penalt, double *dofoff, + double *x, double *y, double *w, double *ssw, int *n, + double *knot, int *nk, double *coef, double *sz, + double *lev, double *crit, int *icrit, double *lambda, + double *xwy, + double *hs0, double *hs1, double *hs2, double *hs3, + double *sg0, double *sg1, double *sg2, double *sg3, + double *abd, double *p1ip, double *p2ip, + int *ld4, int *ldnk, int *info); + +void F77_NAME(bvalus)(int *n, double *knot, double *coef, + int *nk, double *x, double *s, int *order); +void F77_NAME(supsmu)(int *n, double *x, double *y, + double *w, int *iper, double *span, double *alpha, + double *smo, double *sc, double *edf); +#endif diff --git a/com.oracle.truffle.r.native/gnur/patch/src/library/stats/src/monoSpl.c b/com.oracle.truffle.r.native/gnur/patch/src/library/stats/src/monoSpl.c new file mode 100644 index 0000000000000000000000000000000000000000..ae3060106c7cad34363cce4d0fcfd9a036b64a05 --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/library/stats/src/monoSpl.c @@ -0,0 +1,81 @@ +/* R : A Computer Language for Statistical Data Analysis + * Copyright (C) 2010 The R Foundation + * Copyright (C) 2016 The R Core Team + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version. + * + * This program 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 this program; if not, a copy is available at + * https://www.R-project.org/Licenses/ + */ + +#include "modreg.h" +#include <math.h> + +/* To be "exported" (as part of R's C API): */ +/** + * Modify the slopes m_k := s'(x_k) using Fritsch & Carlson (1980)'s algorithm + * + * @param m numeric vector of length n, the preliminary desired slopes s'(x_i), i = 1:n + * @param S the divided differences (y_{i+1} - y_i) / (x_{i+1} - x_i); i = 1:(n-1) + * @param n == length(m) == 1 + length(S) + * @return m*: the modified m[]'s: Note that m[] is modified in place + * @author Martin Maechler, Date: 19 Apr 2010 + */ +void monoFC_mod(double *m, double S[], int n) +{ + if(n < 2) + error(_("n must be at least two")); + + for(int k = 0; k < n - 1; k++) { + /* modify both (m[k] & m[k+1]) if needed : */ + double Sk = S[k]; + int k1 = k + 1; + if(Sk == 0.) { /* or |S| < eps ?? FIXME ?? */ + m[k] = m[k1] = 0.; + } else { + double + alpha = m[k ] / Sk, + beta = m[k1] / Sk, a2b3, ab23; + if((a2b3 = 2*alpha + beta - 3) > 0 && + (ab23 = alpha + 2*beta - 3) > 0 && + alpha * (a2b3 + ab23) < a2b3*a2b3) { + /* we are outside the monotonocity region ==> fix slopes */ + double tauS = 3*Sk / sqrt(alpha*alpha + beta*beta); + m[k ] = tauS * alpha; + m[k1] = tauS * beta; + } + } + } /* end for */ +} + +SEXP monoFC_m(SEXP m, SEXP Sx) +{ + SEXP val; + int n = LENGTH(m); + + if (isInteger(m)) + val = PROTECT(coerceVector(m, REALSXP)); + else { + if (!isReal(m)) + error(_("Argument m must be numeric")); + val = PROTECT(duplicate(m)); + } + if(n < 2) error(_("length(m) must be at least two")); + if(!isReal(Sx) || LENGTH(Sx) != n-1) + error(_("Argument Sx must be numeric vector one shorter than m[]")); + + /* Fix up the slopes m[] := val[]: */ + monoFC_mod(REAL(val), REAL(Sx), n); + + UNPROTECT(1); + return(val); +} diff --git a/com.oracle.truffle.r.native/gnur/patch/src/library/stats/src/nls.c b/com.oracle.truffle.r.native/gnur/patch/src/library/stats/src/nls.c new file mode 100644 index 0000000000000000000000000000000000000000..ad230bd4c7ebe2cf7da249bb0794a36bbf7be67d --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/library/stats/src/nls.c @@ -0,0 +1,357 @@ +/* + * Routines used in calculating least squares solutions in a + * nonlinear model in nls library for R. + * + * Copyright 1999-2001 Douglas M. Bates + * Saikat DebRoy + * + * Copyright 2005--2016 The R Core Team + * Copyright 2006 The R Foundation + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version. + * + * This program 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 this program; if not, a copy is available at + * https://www.R-project.org/Licenses/ + */ + +#include <stdlib.h> +#include <string.h> +#include <math.h> +#include <float.h> +#include <R.h> +#include <Rinternals.h> +#include "nls.h" + +#ifndef MIN +#define MIN(a,b) (((a)<(b))?(a):(b)) +#endif + +/* + * get the list element named str. names is the name attribute of list + */ + +static SEXP +getListElement(SEXP list, SEXP names, const char *str) +{ + SEXP elmt = (SEXP) NULL; + const char *tempChar; + int i; + + for (i = 0; i < length(list); i++) { + tempChar = CHAR(STRING_ELT(names, i)); /* ASCII only */ + if( strcmp(tempChar,str) == 0) { + elmt = VECTOR_ELT(list, i); + break; + } + } + return elmt; +} + +/* + * put some convergence-related information into list + */ +static SEXP +ConvInfoMsg(char* msg, int iter, int whystop, double fac, + double minFac, int maxIter, double convNew) +{ + const char *nms[] = {"isConv", "finIter", "finTol", + "stopCode", "stopMessage", ""}; + SEXP ans; + PROTECT(ans = mkNamed(VECSXP, nms)); + + SET_VECTOR_ELT(ans, 0, ScalarLogical(whystop == 0)); /* isConv */ + SET_VECTOR_ELT(ans, 1, ScalarInteger(iter)); /* finIter */ + SET_VECTOR_ELT(ans, 2, ScalarReal (convNew)); /* finTol */ + SET_VECTOR_ELT(ans, 3, ScalarInteger(whystop)); /* stopCode */ + SET_VECTOR_ELT(ans, 4, mkString(msg)); /* stopMessage */ + + UNPROTECT(1); + return ans; +} + + +/* + * call to nls_iter from R --- .Call("nls_iter", m, control, doTrace) + * where m and control are nlsModel and nlsControl objects + * doTrace is a logical value. + * m is modified; the return value is a "convergence-information" list. + */ +SEXP +nls_iter(SEXP m, SEXP control, SEXP doTraceArg) +{ + double dev, fac, minFac, tolerance, newDev, convNew = -1./*-Wall*/; + int i, j, maxIter, hasConverged, nPars, doTrace, evaltotCnt = -1, warnOnly, printEval; + SEXP tmp, conv, incr, deviance, setPars, getPars, pars, newPars, trace; + + doTrace = asLogical(doTraceArg); + + if(!isNewList(control)) + error(_("'control' must be a list")); + if(!isNewList(m)) + error(_("'m' must be a list")); + + PROTECT(tmp = getAttrib(control, R_NamesSymbol)); + + conv = getListElement(control, tmp, "maxiter"); + if(conv == NULL || !isNumeric(conv)) + error(_("'%s' absent"), "control$maxiter"); + maxIter = asInteger(conv); + + conv = getListElement(control, tmp, "tol"); + if(conv == NULL || !isNumeric(conv)) + error(_("'%s' absent"), "control$tol"); + tolerance = asReal(conv); + + conv = getListElement(control, tmp, "minFactor"); + if(conv == NULL || !isNumeric(conv)) + error(_("'%s' absent"), "control$minFactor"); + minFac = asReal(conv); + + conv = getListElement(control, tmp, "warnOnly"); + if(conv == NULL || !isLogical(conv)) + error(_("'%s' absent"), "control$warnOnly"); + warnOnly = asLogical(conv); + + conv = getListElement(control, tmp, "printEval"); + if(conv == NULL || !isLogical(conv)) + error(_("'%s' absent"), "control$printEval"); + printEval = asLogical(conv); + +#define CONV_INFO_MSG(_STR_, _I_) \ + ConvInfoMsg(_STR_, i, _I_, fac, minFac, maxIter, convNew) + +#define NON_CONV_FINIS(_ID_, _MSG_) \ + if(warnOnly) { \ + warning(_MSG_); \ + return CONV_INFO_MSG(_MSG_, _ID_); \ + } \ + else \ + error(_MSG_); + +#define NON_CONV_FINIS_1(_ID_, _MSG_, _A1_) \ + if(warnOnly) { \ + char msgbuf[1000]; \ + warning(_MSG_, _A1_); \ + snprintf(msgbuf, 1000, _MSG_, _A1_); \ + return CONV_INFO_MSG(msgbuf, _ID_); \ + } \ + else \ + error(_MSG_, _A1_); + +#define NON_CONV_FINIS_2(_ID_, _MSG_, _A1_, _A2_) \ + if(warnOnly) { \ + char msgbuf[1000]; \ + warning(_MSG_, _A1_, _A2_); \ + snprintf(msgbuf, 1000, _MSG_, _A1_, _A2_); \ + return CONV_INFO_MSG(msgbuf, _ID_); \ + } \ + else \ + error(_MSG_, _A1_, _A2_); + + + + /* now get parts from 'm' */ + tmp = getAttrib(m, R_NamesSymbol); + + conv = getListElement(m, tmp, "conv"); + if(conv == NULL || !isFunction(conv)) + error(_("'%s' absent"), "m$conv()"); + PROTECT(conv = lang1(conv)); + + incr = getListElement(m, tmp, "incr"); + if(incr == NULL || !isFunction(incr)) + error(_("'%s' absent"), "m$incr()"); + PROTECT(incr = lang1(incr)); + + deviance = getListElement(m, tmp, "deviance"); + if(deviance == NULL || !isFunction(deviance)) + error(_("'%s' absent"), "m$deviance()"); + PROTECT(deviance = lang1(deviance)); + + trace = getListElement(m, tmp, "trace"); + if(trace == NULL || !isFunction(trace)) + error(_("'%s' absent"), "m$trace()"); + PROTECT(trace = lang1(trace)); + + setPars = getListElement(m, tmp, "setPars"); + if(setPars == NULL || !isFunction(setPars)) + error(_("'%s' absent"), "m$setPars()"); + PROTECT(setPars); + + getPars = getListElement(m, tmp, "getPars"); + if(getPars == NULL || !isFunction(getPars)) + error(_("'%s' absent"), "m$getPars()"); + PROTECT(getPars = lang1(getPars)); + + PROTECT(pars = eval(getPars, R_GlobalEnv)); + nPars = LENGTH(pars); + + dev = asReal(eval(deviance, R_GlobalEnv)); + if(doTrace) eval(trace,R_GlobalEnv); + + fac = 1.0; + hasConverged = FALSE; + + PROTECT(newPars = allocVector(REALSXP, nPars)); + if(printEval) + evaltotCnt = 1; + for (i = 0; i < maxIter; i++) { + SEXP newIncr; + int evalCnt = -1; + if((convNew = asReal(eval(conv, R_GlobalEnv))) < tolerance) { + hasConverged = TRUE; + break; + } + PROTECT(newIncr = eval(incr, R_GlobalEnv)); + + if(printEval) + evalCnt = 1; + + while(fac >= minFac) { + if(printEval) { + Rprintf(" It. %3d, fac= %11.6g, eval (no.,total): (%2d,%3d):", + i+1, fac, evalCnt, evaltotCnt); + evalCnt++; + evaltotCnt++; + } + for(j = 0; j < nPars; j++) + REAL(newPars)[j] = REAL(pars)[j] + fac * REAL(newIncr)[j]; + + PROTECT(tmp = lang2(setPars, newPars)); + if (asLogical(eval(tmp, R_GlobalEnv))) { /* singular gradient */ + UNPROTECT(11); + + NON_CONV_FINIS(1, _("singular gradient")); + } + UNPROTECT(1); + + newDev = asReal(eval(deviance, R_GlobalEnv)); + if(printEval) + Rprintf(" new dev = %g\n", newDev); + if(newDev <= dev) { + dev = newDev; + fac = MIN(2*fac, 1); + tmp = newPars; + newPars = pars; + pars = tmp; + break; + } + fac /= 2.; + } + UNPROTECT(1); + if( fac < minFac ) { + UNPROTECT(9); + NON_CONV_FINIS_2(2, + _("step factor %g reduced below 'minFactor' of %g"), + fac, minFac); + } + if(doTrace) eval(trace, R_GlobalEnv); + } + + UNPROTECT(9); + if(!hasConverged) { + NON_CONV_FINIS_1(3, + _("number of iterations exceeded maximum of %d"), + maxIter); + } + /* else */ + + return CONV_INFO_MSG(_("converged"), 0); +} +#undef CONV_INFO_MSG +#undef NON_CONV_FINIS +#undef NON_CONV_FINIS_1 +#undef NON_CONV_FINIS_2 + + +/* + * call to numeric_deriv from R - + * .Call("numeric_deriv", expr, theta, rho) + * Returns: ans + */ +SEXP +numeric_deriv(SEXP expr, SEXP theta, SEXP rho, SEXP dir) +{ + SEXP ans, gradient, pars; + double eps = sqrt(DOUBLE_EPS), *rDir; + int start, i, j, k, lengthTheta = 0; + + if(!isString(theta)) + error(_("'theta' should be of type character")); + if (isNull(rho)) { + error(_("use of NULL environment is defunct")); + rho = R_BaseEnv; + } else + if(!isEnvironment(rho)) + error(_("'rho' should be an environment")); + PROTECT(dir = coerceVector(dir, REALSXP)); + if(TYPEOF(dir) != REALSXP || LENGTH(dir) != LENGTH(theta)) + error(_("'dir' is not a numeric vector of the correct length")); + rDir = REAL(dir); + + PROTECT(pars = allocVector(VECSXP, LENGTH(theta))); + + PROTECT(ans = duplicate(eval(expr, rho))); + + if(!isReal(ans)) { + SEXP temp = coerceVector(ans, REALSXP); + UNPROTECT(1); + PROTECT(ans = temp); + } + for(i = 0; i < LENGTH(ans); i++) { + if (!R_FINITE(REAL(ans)[i])) + error(_("Missing value or an infinity produced when evaluating the model")); + } + const void *vmax = vmaxget(); + for(i = 0; i < LENGTH(theta); i++) { + const char *name = translateChar(STRING_ELT(theta, i)); + SEXP s_name = install(name); + SEXP temp = findVar(s_name, rho); + if(isInteger(temp)) + error(_("variable '%s' is integer, not numeric"), name); + if(!isReal(temp)) + error(_("variable '%s' is not numeric"), name); + if (MAYBE_SHARED(temp)) /* We'll be modifying the variable, so need to make sure it's unique PR#15849 */ + defineVar(s_name, temp = duplicate(temp), rho); + MARK_NOT_MUTABLE(temp); + SET_VECTOR_ELT(pars, i, temp); + lengthTheta += LENGTH(VECTOR_ELT(pars, i)); + } + vmaxset(vmax); + PROTECT(gradient = allocMatrix(REALSXP, LENGTH(ans), lengthTheta)); + + for(i = 0, start = 0; i < LENGTH(theta); i++) { + for(j = 0; j < LENGTH(VECTOR_ELT(pars, i)); j++, start += LENGTH(ans)) { + SEXP ans_del; + double origPar, xx, delta; + + origPar = REAL(VECTOR_ELT(pars, i))[j]; + xx = fabs(origPar); + delta = (xx == 0) ? eps : xx*eps; + REAL(VECTOR_ELT(pars, i))[j] += rDir[i] * delta; + PROTECT(ans_del = eval(expr, rho)); + if(!isReal(ans_del)) ans_del = coerceVector(ans_del, REALSXP); + UNPROTECT(1); + for(k = 0; k < LENGTH(ans); k++) { + if (!R_FINITE(REAL(ans_del)[k])) + error(_("Missing value or an infinity produced when evaluating the model")); + REAL(gradient)[start + k] = + rDir[i] * (REAL(ans_del)[k] - REAL(ans)[k])/delta; + } + REAL(VECTOR_ELT(pars, i))[j] = origPar; + } + } + setAttrib(ans, install("gradient"), gradient); + UNPROTECT(4); + return ans; +} diff --git a/com.oracle.truffle.r.native/gnur/patch/src/library/stats/src/nls.h b/com.oracle.truffle.r.native/gnur/patch/src/library/stats/src/nls.h new file mode 100644 index 0000000000000000000000000000000000000000..3a0c7f8eb22bd189c888798fc31b9529f33cf09c --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/library/stats/src/nls.h @@ -0,0 +1,30 @@ +/* + * R : A Computer Language for Statistical Data Analysis + * Copyright (C) 1997-2007 The R Core Team. + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version. + * + * This program 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 this program; if not, a copy is available at + * https://www.R-project.org/Licenses/ + */ + +#ifdef ENABLE_NLS +#include <libintl.h> +#define _(String) dgettext ("stats", String) +#else +#define _(String) (String) +#endif + +SEXP nls_iter(SEXP m, SEXP control, SEXP doTraceArg); +SEXP numeric_deriv(SEXP expr, SEXP theta, SEXP rho, SEXP dir); + + diff --git a/com.oracle.truffle.r.native/gnur/patch/src/library/stats/src/port.c b/com.oracle.truffle.r.native/gnur/patch/src/library/stats/src/port.c new file mode 100644 index 0000000000000000000000000000000000000000..afdbe681848f17fbd673a2408828da70ffa714ec --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/library/stats/src/port.c @@ -0,0 +1,607 @@ +/* + * R : A Computer Language for Statistical Data Analysis + * Copyright (C) 2005-2015 The R Core Team. + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version. + * + * This program 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 this program; if not, a copy is available at + * https://www.R-project.org/Licenses/ + */ + +#include "port.h" + +#include <R_ext/Constants.h> +#include <R_ext/BLAS.h> +#include <R_ext/Print.h> + + /* names of 1-based indices into iv and v */ +#define AFCTOL 31 +#define ALGSAV 51 +#define COVPRT 14 +#define COVREQ 15 +#define DRADPR 101 +#define DTYPE 16 +#define F 10 +#define F0 13 +#define FDIF 11 +#define G 28 +#define HC 71 +#define IERR 75 +#define INITH 25 +#define INITS 25 +#define IPIVOT 76 +#define IVNEED 3 +#define LASTIV 44 +#define LASTV 45 +#define LMAT 42 +#define MXFCAL 17 +#define MXITER 18 +#define NEXTV 47 +#define NFCALL 6 +#define NFCOV 52 +#define NFGCAL 7 +#define NGCOV 53 +#define NITER 31 +#define NVDFLT 50 +#define NVSAVE 9 +#define OUTLEV 19 +#define PARPRT 20 +#define PARSAV 49 +#define PERM 58 +#define PRUNIT 21 +#define QRTYP 80 +#define RDREQ 57 +#define RMAT 78 +#define SOLPRT 22 +#define STATPR 23 +#define TOOBIG 2 +#define VNEED 4 +#define VSAVE 60 +#define X0PRT 24 + + +/* C-language replacements for Fortran utilities in PORT sources */ + +/* dd7tpr... returns inner product of two vectors. */ +double F77_NAME(dd7tpr)(int *p, const double x[], const double y[]) +{ + int ione = 1; + return F77_CALL(ddot)(p, x, &ione, y, &ione); +} + +/* ditsum... prints iteration summary, initial and final alf. */ +void F77_NAME(ditsum)(const double d[], const double g[], + int iv[], const int *liv, const int *lv, + const int *n, double v[], const double x[]) +{ + int i, nn = *n; + int *ivm = iv - 1; double *vm = v - 1; /* offsets for 1-based indices */ + if (!ivm[OUTLEV]) return; /* no iteration output */ + if (!(ivm[NITER] % ivm[OUTLEV])) { /* output every ivm[OUTLEV] iterations */ + Rprintf("%3d:%#14.8g:", ivm[NITER], vm[F]); + for (i = 0; i < nn; i++) Rprintf(" %#8g", x[i]); + Rprintf("\n"); + } +} + + /* port sources */ +/* dv7dfl.... provides default values to v. */ +extern void F77_NAME(dv7dfl)(const int *Alg, const int *Lv, double v[]); + +/** + * Supply default values for elements of the iv and v arrays + * + * @param alg algorithm specification (1 <= alg <= 2) (was alg <= 4, but reduced to work around gcc bug; see PR#15914) + * @param iv integer working vector + * @param liv length of iv + * @param lv length of v + * @param v double precision working vector + */ +void Rf_divset(int alg, int iv[], int liv, int lv, double v[]) +{ +/* *** ALG = 1 MEANS REGRESSION CONSTANTS. */ +/* *** ALG = 2 MEANS GENERAL UNCONSTRAINED OPTIMIZATION CONSTANTS. */ + + + /* Initialized data */ + + // alg[orithm] : 1 2 3 4 + static int miniv[] = {0, 82, 59, 103, 103}; + static int minv [] = {0, 98, 71, 101, 85}; + + int mv, miv, alg1; + + /* Parameter adjustments - code will use 1-based indices*/ + --iv; + --v; + + /* Function Body */ + + + if (PRUNIT <= liv) iv[PRUNIT] = 0; /* suppress all Fortran output */ + if (ALGSAV <= liv) iv[ALGSAV] = alg; + if (alg < 1 || alg > 4) + error(_("Rf_divset: alg = %d must be 1, 2, 3, or 4"), alg); + + miv = miniv[alg]; + if (liv < miv) { + iv[1] = 15; + return; + } + mv = minv[alg]; + if (lv < mv) { + iv[1] = 16; + return; + } + alg1 = (alg - 1) % 2 + 1; + F77_CALL(dv7dfl)(&alg1, &lv, &v[1]); + // ------ + iv[1] = 12; + if (alg > 2) error(_("port algorithms 3 or higher are not supported")); + iv[IVNEED] = 0; + iv[LASTIV] = miv; + iv[LASTV] = mv; + iv[LMAT] = mv + 1; + iv[MXFCAL] = 200; + iv[MXITER] = 150; + iv[OUTLEV] = 0; /* default is no iteration output */ + iv[PARPRT] = 1; + iv[PERM] = miv + 1; + iv[SOLPRT] = 0; /* was 1 but we suppress Fortran output */ + iv[STATPR] = 0; /* was 1 but we suppress Fortran output */ + iv[VNEED] = 0; + iv[X0PRT] = 1; + + if (alg1 >= 2) { /* GENERAL OPTIMIZATION values: nlminb() */ + iv[DTYPE] = 0; + iv[INITS] = 1; + iv[NFCOV] = 0; + iv[NGCOV] = 0; + iv[NVDFLT] = 25; + iv[PARSAV] = (alg > 2) ? 61 : 47; + + v[AFCTOL] = 0.0; /* since R 2.12.0: Skip |f(x)| test */ + } + else { /* REGRESSION values: nls() */ + iv[COVPRT] = 3; + iv[COVREQ] = 1; + iv[DTYPE] = 1; + iv[HC] = 0; + iv[IERR] = 0; + iv[INITH] = 0; + iv[IPIVOT] = 0; + iv[NVDFLT] = 32; + iv[VSAVE] = (alg > 2) ? 61 : 58; + iv[PARSAV] = iv[60] + 9; + iv[QRTYP] = 1; + iv[RDREQ] = 3; + iv[RMAT] = 0; + } + return; +} + + +/* divset.... supply default values for elements of the iv and v arrays */ +void F77_NAME(divset)(const int *Alg, int iv[], const int *Liv, + const int *Lv, double v[]) +{ + Rf_divset(*Alg, iv, *Liv, *Lv, v); +} + +/* dn2cvp... prints covariance matrix. */ +void F77_NAME(dn2cvp)(const int iv[], int *liv, int *lv, int *p, + const double v[]) +{ + /* Done elsewhere */ +} + +/* dn2rdp... prints regression diagnostics for mlpsl and nl2s1. */ +void F77_NAME(dn2rdp)(const int iv[], int *liv, int *lv, int *n, + const double rd[], const double v[]) +{ + /* Done elsewhere */ +} + +/* ds7cpr... prints linear parameters at solution. */ +void F77_NAME(ds7cpr)(const double c[], const int iv[], int *l, int *liv) +{ + /* Done elsewhere */ +} + +/* dv2axy... computes scalar times one vector plus another */ +void F77_NAME(dv2axy)(int *n, double w[], const double *a, + const double x[], const double y[]) +{ + int i, nn = *n; double aa = *a; + for (i = 0; i < nn; i++) w[i] = aa * x[i] + y[i]; +} + +/* dv2nrm... returns the 2-norm of a vector. */ +double F77_NAME(dv2nrm)(int *n, const double x[]) +{ + int ione = 1; + return F77_CALL(dnrm2)(n, x, &ione); +} + +/* dv7cpy.... copy src to dest */ +void F77_NAME(dv7cpy)(int *n, double dest[], const double src[]) +{ + /* Was memcpy, but overlaps seen */ + memmove(dest, src, *n * sizeof(double)); +} + +/* dv7ipr... applies forward permutation to vector. */ +void F77_NAME(dv7ipr)(int *n, const int ip[], double x[]) +{ + /* permute x so that x[i] := x[ip[i]]. */ + int i, nn = *n; + double *xcp = Calloc(nn, double); + + for (i = 0; i < nn; i++) xcp[i] = x[ip[i] - 1]; /* ip contains 1-based indices */ + Memcpy(x, xcp, nn); + Free(xcp); +} + +/* dv7prm... applies reverse permutation to vector. */ +void F77_NAME(dv7prm)(int *n, const int ip[], double x[]) +{ + /* permute x so that x[ip[i]] := x[i]. */ + int i, nn = *n; + double *xcp = Calloc(nn, double); + + for (i = 0; i < nn; i++) xcp[ip[i] - 1] = x[i]; /* ip contains 1-based indices */ + Memcpy(x, xcp, nn); + Free(xcp); +} + +/* dv7scl... scale src by *scal to dest */ +void F77_NAME(dv7scl)(int *n, double dest[], + const double *scal, const double src[]) +{ + int nn = *n; double sc = *scal; + while (nn-- > 0) *dest++ = sc * *src++; +} + +/* dv7scp... set values of an array to a constant */ +void F77_NAME(dv7scp)(int *n, double dest[], double *c) +{ + int nn = *n; double cc = *c; + while (nn-- > 0) *dest++ = cc; +} + +/* dv7swp... interchange n-vectors x and y. */ +void F77_NAME(dv7swp)(int *n, double x[], double y[]) +{ + int ione = 1; + F77_CALL(dswap)(n, x, &ione, y, &ione); +} + +/* i7copy... copies one integer vector to another. */ +void F77_NAME(i7copy)(int *n, int dest[], const int src[]) +{ + int nn = *n; + while (nn-- > 0) *dest++ = *src++; +} + +/* i7pnvr... inverts permutation array. (Indices in array are 1-based) */ +void F77_NAME(i7pnvr)(int *n, int x[], const int y[]) +{ + int i, nn = *n; + for (i = 0; i < nn; i++) x[y[i] - 1] = i + 1; +} + +/* stopx.... returns .true. if the break key has been pressed. */ +int F77_NAME(stopx)(void) +{ + return 0; /* interrupts are caught elsewhere */ +} + +static +double* check_gv(SEXP gr, SEXP hs, SEXP rho, int n, double *gv, double *hv) +{ + SEXP gval = PROTECT(coerceVector(PROTECT(eval(gr, rho)), REALSXP)); + if (LENGTH(gval) != n) + error(_("gradient function must return a numeric vector of length %d"), n); + Memcpy(gv, REAL(gval), n); + for (int i = 0; i < n; i++) + if(ISNAN(gv[i])) error("NA/NaN gradient evaluation"); + if (hv) { + SEXP hval = PROTECT(eval(hs, rho)); + SEXP dim = getAttrib(hval, R_DimSymbol); + int i, j, pos; + double *rhval = REAL(hval); + + if (!isReal(hval) || LENGTH(dim) != 2 || + INTEGER(dim)[0] != n || INTEGER(dim)[1] != n) + error(_("Hessian function must return a square numeric matrix of order %d"), + n); + for (i = 0, pos = 0; i < n; i++) /* copy lower triangle row-wise */ + for (j = 0; j <= i; j++) { + hv[pos] = rhval[i + j * n]; + if(ISNAN(hv[pos])) error("NA/NaN Hessian evaluation"); + pos++; + } + UNPROTECT(1); + } + UNPROTECT(2); + return gv; +} + +void +nlminb_iterate(double b[], double d[], double fx, double g[], double h[], + int iv[], int liv, int lv, int n, double v[], double x[]) +{ + int lh = (n * (n + 1))/2; + if (b) { + if (g) { + if (h) + F77_CALL(drmnhb)(b, d, &fx, g, h, iv, &lh, &liv, &lv, &n, v, x); + else + F77_CALL(drmngb)(b, d, &fx, g, iv, &liv, &lv, &n, v, x); + } else F77_CALL(drmnfb)(b, d, &fx, iv, &liv, &lv, &n, v, x); + } else { + if (g) { + if (h) + F77_CALL(drmnh)(d, &fx, g, h, iv, &lh, &liv, &lv, &n, v, x); + else + F77_CALL(drmng)(d, &fx, g, iv, &liv, &lv, &n, v, x); + } else F77_CALL(drmnf)(d, &fx, iv, &liv, &lv, &n, v, x); + } +} + +SEXP port_ivset(SEXP kind, SEXP iv, SEXP v) +{ + Rf_divset(asInteger(kind), INTEGER(iv), LENGTH(iv), LENGTH(v), REAL(v)); + return R_NilValue; +} + +SEXP port_nlminb(SEXP fn, SEXP gr, SEXP hs, SEXP rho, + SEXP lowerb, SEXP upperb, SEXP d, SEXP iv, SEXP v) +{ + int i, n = LENGTH(d); + SEXP xpt; + SEXP dot_par_symbol = install(".par"); + double *b = (double *) NULL, *g = (double *) NULL, + *h = (double *) NULL, fx = R_PosInf; + if (isNull(rho)) { + error(_("use of NULL environment is defunct")); + rho = R_BaseEnv; + } else + if (!isEnvironment(rho)) + error(_("'rho' must be an environment")); + if (!isReal(d) || n < 1) + error(_("'d' must be a nonempty numeric vector")); + if (hs != R_NilValue && gr == R_NilValue) + error(_("When Hessian defined must also have gradient defined")); + if (R_NilValue == (xpt = findVarInFrame(rho, dot_par_symbol)) || + !isReal(xpt) || LENGTH(xpt) != n) + error(_("environment 'rho' must contain a numeric vector '.par' of length %d"), + n); + /* We are going to alter .par, so must duplicate it */ + defineVar(dot_par_symbol, duplicate(xpt), rho); + PROTECT(xpt = findVarInFrame(rho, dot_par_symbol)); + + if ((LENGTH(lowerb) == n) && (LENGTH(upperb) == n)) { + if (isReal(lowerb) && isReal(upperb)) { + double *rl=REAL(lowerb), *ru=REAL(upperb); + b = (double *)R_alloc(2*n, sizeof(double)); + for (i = 0; i < n; i++) { + b[2*i] = rl[i]; + b[2*i + 1] = ru[i]; + } + } else error(_("'lower' and 'upper' must be numeric vectors")); + } + if (gr != R_NilValue) { + g = (double *)R_alloc(n, sizeof(double)); + if (hs != R_NilValue) + h = (double *)R_alloc((n * (n + 1))/2, sizeof(double)); + } + + do { + nlminb_iterate(b, REAL(d), fx, g, h, INTEGER(iv), LENGTH(iv), + LENGTH(v), n, REAL(v), REAL(xpt)); + if (INTEGER(iv)[0] == 2 && g) check_gv(gr, hs, rho, n, g, h); + else { + fx = asReal(eval(fn, rho)); + if (ISNAN(fx)) { + warning("NA/NaN function evaluation"); + fx = R_PosInf; + } + } + + /* duplicate .par value again in case a callback has stored + value (package varComp does this) */ + defineVar(dot_par_symbol, duplicate(xpt), rho); + xpt = findVarInFrame(rho, dot_par_symbol); + UNPROTECT(1); + PROTECT(xpt); + } while(INTEGER(iv)[0] < 3); + + UNPROTECT(1); /* xpt */ + return R_NilValue; +} + +void +nlsb_iterate(double b[], double d[], double dr[], int iv[], int liv, + int lv, int n, int nd, int p, double r[], double rd[], + double v[], double x[]) +{ + int ione = 1; + if (b) + F77_CALL(drn2gb)(b, d, dr, iv, &liv, &lv, &n, &nd, + &ione, &nd, &p, r, rd, v, x); + else + F77_CALL(drn2g)(d, dr, iv, &liv, &lv, &n, &nd, &ione, + &nd, &p, r, rd, v, x); +} + +/** + * Return the element of a given name from a named list + * + * @param list + * @param nm name of desired element + * + * @return element of list with name nm + */ +static R_INLINE SEXP getElement(SEXP list, char *nm) +{ + int i; SEXP names = getAttrib(list, R_NamesSymbol); + + if (!isNewList(list) || LENGTH(names) != LENGTH(list)) + error(_("'getElement' applies only to named lists")); + for (i = 0; i < LENGTH(list); i++) + if (!strcmp(CHAR(STRING_ELT(names, i)), nm)) /* ASCII only */ + return(VECTOR_ELT(list, i)); + return R_NilValue; +} + +/** + * Return the element of a given name from a named list after ensuring + * that it is a function + * + * @param list + * @param enm name of desired element + * @param lnm string version of the name of the list + * + * @return a SEXP that points to a function + */ +static R_INLINE SEXP getFunc(SEXP list, char *enm, char *lnm) +{ + SEXP ans; + if (!isFunction(ans = getElement(list, enm))) + error(_("%s$%s() not found"), lnm, enm); + return ans; +} + +static void neggrad(SEXP gf, SEXP rho, SEXP gg) +{ + SEXP val = PROTECT(eval(gf, rho)); + int *dims = INTEGER(getAttrib(val, R_DimSymbol)), + *gdims = INTEGER(getAttrib(gg, R_DimSymbol)); + int i, ntot = gdims[0] * gdims[1]; + + if (TYPEOF(val) != TYPEOF(gg) || !isMatrix(val) || dims[0] != gdims[0] || + dims[1] != gdims[1]) + error(_("'gradient' must be a numeric matrix of dimension (%d,%d)"), + gdims[0], gdims[1]); + for (i = 0; i < ntot; i++) REAL(gg)[i] = - REAL(val)[i]; + UNPROTECT(1); +} + +/** + * Evaluate an expression in an environment, check that the length and + * mode are as expected and store the result. + * + * @param fcn expression to evaluate + * @param rho environment in which to evaluate it + * @param vv position to store the result + * + * @return vv with new contents + */ +static +SEXP eval_check_store(SEXP fcn, SEXP rho, SEXP vv) +{ + SEXP v = PROTECT(eval(fcn, rho)); + if (TYPEOF(v) != TYPEOF(vv) || LENGTH(v) != LENGTH(vv)) + error(_("fcn produced mode %d, length %d - wanted mode %d, length %d"), + TYPEOF(v), LENGTH(v), TYPEOF(vv), LENGTH(vv)); + switch (TYPEOF(v)) { + case LGLSXP: + Memcpy(LOGICAL(vv), LOGICAL(v), LENGTH(vv)); + break; + case INTSXP: + Memcpy(INTEGER(vv), INTEGER(v), LENGTH(vv)); + break; + case REALSXP: + Memcpy(REAL(vv), REAL(v), LENGTH(vv)); + break; + default: + error(_("invalid type for eval_check_store")); + } + UNPROTECT(1); + return vv; +} + +SEXP port_nlsb(SEXP m, SEXP d, SEXP gg, SEXP iv, SEXP v, + SEXP lowerb, SEXP upperb) +{ + int *dims = INTEGER(getAttrib(gg, R_DimSymbol)); + int i, n = LENGTH(d), p = LENGTH(d), nd = dims[0]; + SEXP getPars, setPars, resid, gradient, + rr = PROTECT(allocVector(REALSXP, nd)), + x = PROTECT(allocVector(REALSXP, n)); + // This used to use Calloc, but that will leak if + // there is a premature return (and did in package drfit) + double *b = (double *) NULL, + *rd = (double *)R_alloc(nd, sizeof(double)); + + if (!isReal(d) || n < 1) + error(_("'d' must be a nonempty numeric vector")); + if(!isNewList(m)) error(_("m must be a list")); + /* Initialize parameter vector */ + getPars = PROTECT(lang1(getFunc(m, "getPars", "m"))); + eval_check_store(getPars, R_GlobalEnv, x); + /* Create the setPars call */ + setPars = PROTECT(lang2(getFunc(m, "setPars", "m"), x)); + /* Evaluate residual and gradient */ + resid = PROTECT(lang1(getFunc(m, "resid", "m"))); + eval_check_store(resid, R_GlobalEnv, rr); + gradient = PROTECT(lang1(getFunc(m, "gradient", "m"))); + neggrad(gradient, R_GlobalEnv, gg); + + if ((LENGTH(lowerb) == n) && (LENGTH(upperb) == n)) { + if (isReal(lowerb) && isReal(upperb)) { + double *rl = REAL(lowerb), *ru = REAL(upperb); + b = (double *)R_alloc(2*n, sizeof(double)); + for (i = 0; i < n; i++) { + b[2*i] = rl[i]; + b[2*i + 1] = ru[i]; + } + } else error(_("'lowerb' and 'upperb' must be numeric vectors")); + } + + do { + nlsb_iterate(b, REAL(d), REAL(gg), INTEGER(iv), LENGTH(iv), + LENGTH(v), n, nd, p, REAL(rr), rd, + REAL(v), REAL(x)); + switch(INTEGER(iv)[0]) { + case -3: + eval(setPars, R_GlobalEnv); + eval_check_store(resid, R_GlobalEnv, rr); + neggrad(gradient, R_GlobalEnv, gg); + break; + case -2: + eval_check_store(resid, R_GlobalEnv, rr); + neggrad(gradient, R_GlobalEnv, gg); + break; + case -1: + eval(setPars, R_GlobalEnv); + eval_check_store(resid, R_GlobalEnv, rr); + neggrad(gradient, R_GlobalEnv, gg); + break; + case 0: + Rprintf("nlsb_iterate returned %d", INTEGER(iv)[0]); + break; + case 1: + eval(setPars, R_GlobalEnv); + eval_check_store(resid, R_GlobalEnv, rr); + break; + case 2: + eval(setPars, R_GlobalEnv); + neggrad(gradient, R_GlobalEnv, gg); + break; + } + } while(INTEGER(iv)[0] < 3); + + UNPROTECT(6); + return R_NilValue; +} diff --git a/com.oracle.truffle.r.native/gnur/patch/src/library/stats/src/port.h b/com.oracle.truffle.r.native/gnur/patch/src/library/stats/src/port.h new file mode 100644 index 0000000000000000000000000000000000000000..3206cbbb74b51560cc03ba8627ba106e9c69ce5b --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/library/stats/src/port.h @@ -0,0 +1,106 @@ +/* + * R : A Computer Language for Statistical Data Analysis + * Copyright (C) 2005-2016 The R Core Team. + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version. + * + * This program 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 this program; if not, a copy is available at + * https://www.R-project.org/Licenses/ + */ + +#ifndef PORT_PORT_H +#define PORT_PORT_H + +/* Header file for the C utilities to accompany the Fortran + * optimization routines for the port library. + * + * Copyright (C) 2005-5 the R Core Team + * Licensed under the GNU General Public License, version 2 or later. + */ + +#include <math.h> +#include <string.h> // for memmove, memcpy, strcmp +#include <Rinternals.h> +#include <R_ext/RS.h> + +#ifdef ENABLE_NLS +#include <libintl.h> +#define _(String) dgettext ("stats", String) +#else +#define _(String) (String) +#endif + +/* PORT interface functions - reverse communication */ + +/* DRMNF(D, FX, IV, LIV, LV, N, V, X) */ +extern void F77_NAME(drmnf)(double[], double*, + int[], int*, int*, int*, double[], double[]); + +/* DRMNG(D, FX, G, IV, LIV, LV, N, V, X) */ +extern void F77_NAME(drmng)(double[], double*, double[], + int[], int*, int*, int*, double[], double[]); + +/* DRMNH(D, FX, G, H, IV, LH, LIV, LV, N, V, X) */ +extern void F77_NAME(drmnh)(double[], double*, double[], double[], + int[], int*, int*, int*, int*, double[], double[]); + +/* DRMNFB(B, D, FX, IV, LIV, LV, N, V, X) */ +extern void F77_NAME(drmnfb)(double[], double[], double*, + int[], int*, int*, int*, double[], double[]); + +/* DRMNGB(B, D, FX, G, IV, LIV, LV, N, V, X) */ +extern void F77_NAME(drmngb)(double[], double[], double*, double[], + int[], int*, int*, int*, double[], double[]); + +/* DRMNH(B, D, FX, G, H, IV, LH, LIV, LV, N, V, X) */ +extern void F77_NAME(drmnhb)(double[], double[], double*, double[], double[], + int[], int*, int*, int*, int*, double[], double[]); + +/* DRN2GB(B, D, DR, IV, LIV, LV, N, ND, N1, N2, P, R, RD, V, X) */ +extern void F77_NAME(drn2gb)(double[], double[], double[], + int[], int*, int*, int*, int*, int*, int*, int*, + double[], double[], double[], double[]); +/* DRN2G(D, DR, IV, LIV, LV, N, ND, N1, N2, P, R, RD, V, X) */ +extern void F77_NAME(drn2g)(double[], double[], + int[], int*, int*, int*, int*, int*, int*, int*, + double[], double[], double[], double[]); +/* DRNSGB(A, ALF, B, C, DA, IN, IV, L, L1, LA, LIV, LV, N, NDA, P, V, Y) */ +extern void F77_NAME(drnsgb)(double[], double[], double[], double[], double[], + int[], int[], int*, int*, int*, int*, + int*, int*, int*, int*, int*, + double[], double[]); +/* DRNSG(A, ALF, C, DA, IN, IV, L, L1, LA, LIV, LV, N, NDA, P, V, Y) */ +extern void F77_NAME(drnsg)(double[], double[], double[], double[], + int[], int[], int*, int*, int*, int*, + int*, int*, int*, int*, int*, + double[], double[]); + +SEXP port_ivset(SEXP kind, SEXP iv, SEXP v); + +SEXP port_nlminb(SEXP fn, SEXP gr, SEXP hs, SEXP rho, + SEXP lowerb, SEXP upperb, SEXP d, SEXP iv, SEXP v); + +SEXP port_nlsb(SEXP m, SEXP d, SEXP gg, SEXP iv, SEXP v, + SEXP lowerb, SEXP upperb); + +void Rf_divset(int alg, int iv[], int liv, int lv, double v[]); + +void +nlminb_iterate(double b[], double d[], double fx, double g[], double h[], + int iv[], int liv, int lv, int n, double v[], double x[]); + +void +nlsb_iterate(double b[], double d[], double dr[], int iv[], int liv, + int lv, int n, int nd, int p, double r[], double rd[], + double v[], double x[]); + +#endif diff --git a/com.oracle.truffle.r.native/gnur/patch/src/library/stats/src/ppr.f b/com.oracle.truffle.r.native/gnur/patch/src/library/stats/src/ppr.f new file mode 100644 index 0000000000000000000000000000000000000000..886e9357865364d9fc0154b8309e5b320e2e4e9e --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/library/stats/src/ppr.f @@ -0,0 +1,1495 @@ +C +C Modified from the SMART package by J.H. Friedman, 10/10/84 +C Main change is to add spline smoothing modified from BRUTO, +C calling code written for smooth.spline in S. +C +C B.D. Ripley (ripley@stats.ox.ac.uk) 1994-7. +C +C + subroutine smart(m,mu,p,q,n, w,x,y,ww,smod,nsmod, + & sp,nsp,dp,ndp,edf) + + integer m,mu,p,q,n, nsmod, nsp,ndp + double precision x(p,n),y(q,n),w(n),ww(q),smod(nsmod), + & sp(nsp),edf(m),dp(ndp) + smod(1)=m + smod(2)=p + smod(3)=q + smod(4)=n + call smart1(m,mu,p,q,n, w,x,y,ww, smod(6),smod(q+6), + & smod(q+7),smod(q+7+p*m),smod(q+7+m*(p+q)), + & smod(q+7+m*(p+q+n)),smod(q+7+m*(p+q+2*n)), + & sp,sp(q*n+1),sp(n*(q+15)+1),sp(n*(q+15)+q+1), + & dp,smod(5),edf) + return + end + + subroutine smart1(m,mu,p,q,n, w,x,y,ww, yb,ys, + & a,b,f, + & t,asr, + & r,sc,bt,g, + & dp,flm,edf) + + integer m,mu,p,q,n + double precision w(n),x(p,n),y(*),ww(q), yb(q), ys + double precision a(p,m),b(q,m),f(n,m),t(n,m), asr(15),asr1 + double precision r(q,n),sc(n,15),bt(q),g(p,3) + double precision dp(*), flm,edf(m) +C ^^^ really (ndb) of smart(.) + integer i,j,l, lm + double precision sw,s +c Common Vars + double precision span,alpha,big + integer ifl,lf + common /pprpar/ ifl,lf,span,alpha,big + + double precision conv, cutmin,fdel,cjeps + integer maxit,mitone, mitcj + common /pprz01/ conv,maxit,mitone,cutmin,fdel,cjeps,mitcj + + sw=0d0 + do j=1,n + sw=sw+w(j) + end do + do j=1,n + do i=1,q + r(i,j)=y(q*(j-1)+i) + end do + end do + do i=1,q + s=0d0 + do j=1,n + s=s+w(j)*r(i,j) + end do + yb(i)=s/sw + end do +c yb is vector of means + do j=1,n + do i=1,q + r(i,j)=r(i,j)-yb(i) + end do + end do + ys=0.d0 + do i=1,q + s=0.d0 + do j=1,n + s=s+w(j)*r(i,j)**2 + end do + ys=ys+ww(i)*s/sw + end do + if(ys .gt. 0d0) goto 311 +c ys is the overall standard deviation -- quit if zero + return + + 311 continue + ys=sqrt(ys) + s=1.d0/ys + do j=1,n + do i=1,q + r(i,j)=r(i,j)*s + end do + end do + +c r is now standardized residuals +c subfit adds up to m terms one at time; lm is the number fitted. + call subfit(m,p,q,n,w,sw,x,r,ww,lm,a,b,f,t,asr(1),sc,bt,g,dp,edf) + if(lf.le.0) go to 9999 + call fulfit(lm,lf,p,q,n,w,sw,x,r,ww,a,b,f,t,asr,sc,bt,g,dp,edf) +C REPEAT + 371 continue + do l=1,lm + sc(l,1)=l+0.1d0 + s=0d0 + do i=1,q + s=s+ww(i)*abs(b(i,l)) + end do + sc(l,2)=-s + end do + call sort(sc(1,2),sc,1,lm) + do j=1,n + do i=1,q + r(i,j)=y(q*(j-1)+i) + end do + end do + + do i=1,q + do j=1,n + r(i,j)=r(i,j)-yb(i) + s=0.d0 + do l=1,lm + s=s+b(i,l)*f(j,l) + end do + r(i,j)=r(i,j)/ys-s + end do + end do + + if(lm.le.mu) goto 9999 +c back to integer: + l=int(sc(lm,1)) + asr1=0d0 + do j=1,n + do i=1,q + r(i,j)=r(i,j)+b(i,l)*f(j,l) + asr1=asr1+w(j)*ww(i)*r(i,j)**2 + end do + end do + + asr1=asr1/sw + asr(1)=asr1 + if(l .ge. lm) goto 591 + do i=1,p + a(i,l)=a(i,lm) + end do + do i=1,q + b(i,l)=b(i,lm) + end do + do j=1,n + f(j,l)=f(j,lm) + t(j,l)=t(j,lm) + end do + + 591 continue + lm=lm-1 + call fulfit(lm,lf,p,q,n,w,sw,x,r,ww,a,b,f,t,asr,sc,bt,g,dp,edf) + goto 371 +C END REPEAT + 9999 continue + flm=lm + return + end + + subroutine subfit(m,p,q,n,w,sw,x,r,ww,lm,a,b,f,t,asr,sc, + & bt,g,dp,edf) +c Args + integer m,p,q,n, lm + double precision w(n),sw, x(p,n),r(q,n),ww(q),a(p,m),b(q,m), + & f(n,m), t(n,m), asr(15), sc(n,15), bt(q), g(p,3), edf(m) + double precision dp(*) +c Var + integer i,j,l, iflsv + double precision asrold +c Common Vars + double precision span,alpha,big + integer ifl,lf + common /pprpar/ ifl,lf,span,alpha,big + + double precision conv, cutmin,fdel,cjeps + integer maxit,mitone, mitcj + common /pprz01/ conv,maxit,mitone,cutmin,fdel,cjeps,mitcj + + asr(1)=big + lm=0 + do 100 l=1,m + call rchkusr() + lm=lm+1 + asrold=asr(1) + call newb(lm,q,ww,b) +c does 'edf' mean 'edf(1)' or 'edf(l)'? + call onetrm(0,p,q,n,w,sw,x,r,ww,a(1,lm),b(1,lm), + & f(1,lm),t(1,lm),asr(1),sc,g,dp,edf(1)) + do 20 j=1,n + do 10 i=1,q + r(i,j)=r(i,j)-b(i,lm)*f(j,lm) + 10 continue + 20 continue + if(lm.eq.1) goto 100 + if(lf.gt.0) then + if(lm.eq.m) return + iflsv=ifl + ifl=0 + call fulfit(lm,1,p,q,n,w,sw,x,r,ww,a,b,f,t,asr,sc,bt, + & g,dp, edf) + ifl=iflsv + endif + if(asr(1).le.0d0.or.(asrold-asr(1))/asrold.lt.conv) return +100 continue + return + end + + subroutine fulfit(lm,lbf,p,q,n,w,sw,x,r,ww,a,b,f,t, + & asr,sc,bt,g,dp,edf) +c Args + integer lm,lbf,p,q,n + double precision w(n),sw,x(p,n),r(q,n),ww(q),a(p,lm),b(q,lm), + & f(n,lm),t(n,lm),asr(1+lm), sc(n,15),bt(q),g(p,3), edf(lm) + double precision dp(*) +c Var + double precision asri, fsv, asrold + integer i,j,iter,lp,isv +c Common Vars + double precision span,alpha,big + integer ifl,lf + common /pprpar/ ifl,lf,span,alpha,big + + double precision conv, cutmin,fdel,cjeps + integer maxit,mitone, mitcj + common /pprz01/ conv,maxit,mitone,cutmin,fdel,cjeps,mitcj + + if(lbf.le.0) return + asri=asr(1) + fsv=cutmin + isv=mitone + if(lbf .lt. 3) then + cutmin=1d0 + mitone=lbf-1 + endif + iter=0 +C Outer loop: +1000 continue + asrold=asri + iter=iter+1 + do 100 lp=1,lm + do 10 i=1,q + bt(i)=b(i,lp) + 10 continue + do 20 i=1,p + g(i,3)=a(i,lp) + 20 continue + do 35 j=1,n + do 30 i=1,q + r(i,j)=r(i,j)+bt(i)*f(j,lp) + 30 continue + 35 continue + + call onetrm(1,p,q,n,w,sw,x,r,ww,g(1,3),bt,sc(1,14),sc(1,15), + & asri,sc,g,dp,edf(lp)) + if(asri .lt. asrold) then + do 40 i=1,q + b(i,lp)=bt(i) + 40 continue + do 50 i=1,p + a(i,lp)=g(i,3) + 50 continue + do 60 j=1,n + f(j,lp)=sc(j,14) + t(j,lp)=sc(j,15) + 60 continue + else + asri=asrold + endif + do 85 j=1,n + do 80 i=1,q + r(i,j)=r(i,j)-b(i,lp)*f(j,lp) + 80 continue + 85 continue +100 continue + if((iter .le. maxit) .and. ((asri .gt. 0d0) + & .and. ((asrold-asri)/asrold .ge. conv))) goto 1000 + cutmin=fsv + mitone=isv + if(ifl .gt. 0) then + asr(1+lm) = asri + asr(1) = asri + endif + return + end + + subroutine onetrm(jfl,p,q,n,w,sw,x,y,ww,a,b,f,t,asr, + & sc,g,dp,edf) +c Args + integer jfl,p,q,n + double precision w(n),sw, x(p,n),y(q,n),ww(q),a(p),b(q),f(n),t(n), + & asr, sc(n,13),g(p,2), edf + double precision dp(*) +c Var + double precision asrold,s + integer i,j,iter +c Common Vars + double precision span,alpha,big + integer ifl,lf + common /pprpar/ ifl,lf,span,alpha,big + + double precision conv, cutmin,fdel,cjeps + integer maxit,mitone, mitcj + common /pprz01/ conv,maxit,mitone,cutmin,fdel,cjeps,mitcj + + iter=0 + asr=big +C REPEAT +1000 continue + iter=iter+1 + asrold=asr + do 11 j=1,n + s=0d0 + do 21 i=1,q + s=s+ww(i)*b(i)*y(i,j) + 21 continue + sc(j,13)=s + 11 continue + call oneone(max0(jfl,iter-1),p,n,w,sw,sc(1,13),x,a,f,t, + & asr,sc,g,dp,edf) + do 31 i=1,q + s=0d0 + do 41 j=1,n + s=s+w(j)*y(i,j)*f(j) + 41 continue + b(i)=s/sw + 31 continue + asr=0d0 + do 51 i=1,q + s=0d0 + do 61 j=1,n + s=s+w(j)*(y(i,j)-b(i)*f(j))**2 + 61 continue + asr=asr+ww(i)*s/sw + 51 continue + if((q .ne. 1) .and. (iter .le. maxit) .and. (asr .gt. 0d0) + & .and. (asrold-asr)/asrold .ge. conv) goto 1000 + return + end + + subroutine oneone(ist,p,n, w,sw,y,x,a,f,t,asr,sc,g,dp,edf) +c Args + integer ist,p,n + double precision w(n),sw,y(n),x(p,n),a(p),f(n),t(n),asr, + & sc(n,12), g(p,2), edf, dp(*) +c Var + integer i,j,k,iter + double precision sml, s,v,cut,asrold +c Common Vars + double precision span,alpha,big + integer ifl,lf + common /pprpar/ ifl,lf,span,alpha,big + + double precision conv, cutmin,fdel,cjeps + integer maxit,mitone, mitcj + common /pprz01/ conv,maxit,mitone,cutmin,fdel,cjeps,mitcj + + sml=1d0/big + if(ist .le. 0) then + if(p .le. 1) a(1)=1d0 + do 10 j=1,n + sc(j,2)=1d0 + 10 continue + call pprdir(p,n,w,sw,y,x,sc(1,2),a,dp) + endif + s=0d0 + do 20 i=1,p + g(i,1)=0d0 + s=s+a(i)**2 + 20 continue + s=1d0/sqrt(s) + do 30 i=1,p + a(i)=a(i)*s + 30 continue + iter=0 + asr=big + cut=1d0 +C REPEAT ----------------------------- + 100 continue + iter=iter+1 + asrold=asr +C REPEAT [inner loop] ----- + 60 continue + s=0d0 + do 70 i=1,p + g(i,2)=a(i)+g(i,1) + s=s+g(i,2)**2 + 70 continue + s=1.d0/sqrt(s) + do 80 i=1,p + g(i,2)=g(i,2)*s + 80 continue + do 90 j=1,n + sc(j,1)=j+0.1d0 + s=0.d0 + do 91 i=1,p + s=s+g(i,2)*x(i,j) + 91 continue + sc(j,11)=s + 90 continue + call sort(sc(1,11),sc,1,n) + do 110 j=1,n + k=int(sc(j,1)) + sc(j,2)=y(k) + sc(j,3)=max(w(k),sml) + 110 continue + call supsmu(n,sc(1,11),sc(1,2),sc(1,3),1,span,alpha, + & sc(1,12),sc(1,4), edf) + s=0d0 + do 120 j=1,n + s=s+sc(j,3)*(sc(j,2)-sc(j,12))**2 + 120 continue + s=s/sw + if(s .lt. asr) goto 140 + cut=cut*0.5d0 + if(cut.lt.cutmin) goto 199 + do 150 i=1,p + g(i,1)=g(i,1)*cut + 150 continue + go to 60 +C -------- + 140 continue + asr=s + cut=1d0 + do 160 i=1,p + a(i)=g(i,2) + 160 continue + do 170 j=1,n + k=int(sc(j,1)) + t(k)=sc(j,11) + f(k)=sc(j,12) + 170 continue + if(asr.le.0d0.or.(asrold-asr)/asrold.lt.conv) goto 199 + if(iter.gt.mitone.or.p.le.1) goto 199 + call pprder(n,sc(1,11),sc(1,12),sc(1,3),fdel,sc(1,4),sc(1,5)) + do 180 j=1,n + k=int(sc(j,1)) + sc(j,5)=y(j)-f(j) + sc(k,6)=sc(j,4) + 180 continue + call pprdir(p,n,w,sw,sc(1,5),x,sc(1,6),g,dp) + + goto 100 +c-------------- + 199 continue +c-------------- + s=0d0 + v=s + do 210 j=1,n + s=s+w(j)*f(j) + 210 continue + s=s/sw + do 220 j=1,n + f(j)=f(j)-s + v=v+w(j)*f(j)**2 + 220 continue + if(v .gt. 0d0) then + v=1d0/sqrt(v/sw) + do 230 j=1,n + f(j)=f(j)*v + 230 continue + endif + return + end + + + subroutine pprdir(p,n,w,sw,r,x,d,e,g) + + integer p,n + double precision w(n),sw,r(n),x(p,n),d(n),e(p), g(*) + + double precision s + integer i,j,k,l,m1,m2 + + double precision conv, cutmin,fdel,cjeps + integer maxit,mitone, mitcj + common /pprz01/ conv,maxit,mitone,cutmin,fdel,cjeps,mitcj + + do 10 i=1,p + s=0d0 + do 15 j=1,n + s=s+w(j)*d(j)*x(i,j) + 15 continue + e(i)=s/sw + 10 continue + k=0 + m1=p*(p+1)/2 + m2=m1+p + do 20 j=1,p + s=0d0 + do 22 l=1,n + s=s+w(l)*r(l)*(d(l)*x(j,l)-e(j)) + 22 continue + g(m1+j)=s/sw + do 25 i=1,j + s=0d0 + do 27 l=1,n + s=s+w(l)*(d(l)*x(i,l)-e(i))*(d(l)*x(j,l)-e(j)) + 27 continue + k=k+1 + g(k)=s/sw + 25 continue + 20 continue + call ppconj(p,g,g(m1+1),g(m2+1),cjeps,mitcj,g(m2+p+1)) + do 30 i=1,p + e(i)=g(m2+i) + 30 continue + return + end + + subroutine ppconj(p,g,c,x,eps,maxit,sc) + integer p,maxit + double precision g(*),c(p),x(p),eps,sc(p,4) + + integer i,j,im1,iter,nit + double precision beta,h,s,alpha,t + + do 1 i=1,p + x(i)=0d0 + sc(i,2)=0d0 + 1 continue + nit=0 +C REPEAT +11321 continue + nit=nit+1 + h=0d0 + beta=0d0 + do 11331 i=1,p + sc(i,4)=x(i) + s=g(i*(i-1)/2+i)*x(i) + im1=i-1 + j=1 + goto 11343 +11341 j=j+1 +11343 if(j.gt.im1) goto 11342 + s=s+g(i*(i-1)/2+j)*x(j) + goto 11341 +11342 continue + j=i+1 + goto 11353 +11351 j=j+1 +11353 if(j.gt.p) goto 11352 + s=s+g(j*(j-1)/2+i)*x(j) + goto 11351 +11352 continue + sc(i,1)=s-c(i) + h=h+sc(i,1)**2 +11331 continue + if(h.le.0d0) goto 11322 + do 11361 iter=1,p + do 11371 i=1,p + sc(i,2)=beta*sc(i,2)-sc(i,1) +11371 continue + t=0d0 + do 11381 i=1,p + s=g(i*(i-1)/2+i)*sc(i,2) + im1=i-1 + j=1 + goto 11393 +11391 j=j+1 +11393 if(j.gt.im1) goto 11392 + s=s+g(i*(i-1)/2+j)*sc(j,2) + goto 11391 +11392 continue + j=i+1 + goto 11403 +11401 j=j+1 +11403 if(j.gt.p) goto 11402 + s=s+g(j*(j-1)/2+i)*sc(j,2) + goto 11401 +11402 continue + sc(i,3)=s + t=t+s*sc(i,2) +11381 continue + alpha=h/t + s=0d0 + do 11411 i=1,p + x(i)=x(i)+alpha*sc(i,2) + sc(i,1)=sc(i,1)+alpha*sc(i,3) + s=s+sc(i,1)**2 +11411 continue + if(s.le.0d0) goto 11362 + beta=s/h + h=s +11361 continue +11362 continue + s=0d0 + do 11421 i=1,p + s=dmax1(s,dabs(x(i)-sc(i,4))) +11421 continue + if((s .ge. eps) .and. (nit .lt. maxit)) goto 11321 +11322 continue + return + end + + subroutine pprder (n,x,s,w,fdel,d,sc) + integer n + double precision x(n),s(n),w(n), fdel, d(n),sc(n,3) + + integer i,j,bl,el,bc,ec,br,er + double precision scale, del +c +c unnecessary initialization of bl el ec to keep g77 -Wall happy +c + bl = 0 + el = 0 + ec = 0 +c + if(x(n) .gt. x(1)) goto 11441 + do 11451 j=1,n + d(j)=0d0 +11451 continue + return +11441 continue + i=n/4 + j=3*i + scale=x(j)-x(i) +11461 if(scale.gt.0d0) goto 11462 + if(j.lt.n) j=j+1 + if(i.gt.1) i=i-1 + scale=x(j)-x(i) + goto 11461 +11462 continue + del=fdel*scale*2d0 + do 11471 j=1,n + sc(j,1)=x(j) + sc(j,2)=s(j) + sc(j,3)=w(j) +11471 continue + call pool (n,sc,sc(1,2),sc(1,3),del) + bc=0 + br=bc + er=br +11481 continue + br=er+1 + er=br +11491 if(er .ge. n) goto 11492 + if(sc(br,1) .ne. sc(er+1,1)) goto 11511 + er=er+1 + goto 11521 +11511 continue + goto 11492 +11521 continue + goto 11491 +11492 continue + if(br .ne. 1) goto 11541 + bl=br + el=er + goto 11481 +11541 continue + if(bc .ne. 0) goto 11561 + bc=br + ec=er + do 11571 j=bl,el + d(j)=(sc(bc,2)-sc(bl,2))/(sc(bc,1)-sc(bl,1)) +11571 continue + goto 11481 +11561 continue +c sanity check needed for PR#13517 + if(br.gt.n) call rexit('br is too large') + do 11581 j=bc,ec + d(j)=(sc(br,2)-sc(bl,2))/(sc(br,1)-sc(bl,1)) +11581 continue + if(er .ne. n) goto 11601 + do 11611 j=br,er + d(j)=(sc(br,2)-sc(bc,2))/(sc(br,1)-sc(bc,1)) +11611 continue + goto 11482 +11601 continue + bl=bc + el=ec + bc=br + ec=er + goto 11481 +11482 continue + return + end + + subroutine pool (n,x,y,w,del) + integer n + double precision x(n),y(n),w(n),del + + integer i,bb,eb,br,er,bl,el + double precision px, py, pw + + bb=0 + eb=bb +11621 if(eb.ge.n) goto 11622 + bb=eb+1 + eb=bb +11631 if(eb .ge. n) goto 11632 + if(x(bb) .ne. x(eb+1)) goto 11651 + eb=eb+1 + goto 11661 +11651 continue + goto 11632 +11661 continue + goto 11631 +11632 continue + if(eb .ge. n) goto 11681 + if(x(eb+1)-x(eb) .ge. del) goto 11701 + br=eb+1 + er=br +11711 if(er .ge. n) goto 11712 + if(x(er+1) .ne. x(br)) goto 11731 + er=er+1 + goto 11741 +11731 continue + goto 11712 +11741 continue + goto 11711 +11712 continue +C avoid bounds error: this was .and. but order is not guaranteed + if(er.lt.n) then + if(x(er+1)-x(er).lt.x(eb+1)-x(eb)) goto 11621 + endif + eb=er + pw=w(bb)+w(eb) + px=(x(bb)*w(bb)+x(eb)*w(eb))/pw + py=(y(bb)*w(bb)+y(eb)*w(eb))/pw + do 11751 i=bb,eb + x(i)=px + y(i)=py + w(i)=pw +11751 continue +11701 continue +11681 continue +11761 continue + if(bb.le.1) goto 11762 + if(x(bb)-x(bb-1).ge.del) goto 11762 + bl=bb-1 + el=bl +11771 if(bl .le. 1) goto 11772 + if(x(bl-1) .ne. x(el)) goto 11791 + bl=bl-1 + goto 11801 +11791 continue + goto 11772 +11801 continue + goto 11771 +11772 continue + bb=bl + pw=w(bb)+w(eb) + px=(x(bb)*w(bb)+x(eb)*w(eb))/pw + py=(y(bb)*w(bb)+y(eb)*w(eb))/pw + do 11811 i=bb,eb + x(i)=px + y(i)=py + w(i)=pw +11811 continue + goto 11761 +11762 continue + goto 11621 +11622 continue + return + end + + subroutine newb(lm,q,ww,b) + integer lm, q + double precision ww(q),b(q,lm) + + integer i,lm1,l,l1 + double precision s,t,sml +c Common + double precision span,alpha,big + integer ifl,lf + common /pprpar/ ifl,lf,span,alpha,big + + + sml=1d0/big + if(q .ne. 1) goto 11831 + b(1,lm)=1d0 + return +11831 continue + if(lm .ne. 1) goto 11851 + do 11861 i=1,q + b(i,lm)=i +11861 continue + return +11851 continue + lm1=lm-1 + do 11871 i=1,q + b(i,lm)=0d0 +11871 continue + t=0d0 + do 11881 i=1,q + s=0d0 + do 11891 l=1,lm1 + s=s+abs(b(i,l)) +11891 continue + b(i,lm)=s + t=t+s +11881 continue + do 11901 i=1,q + b(i,lm)=ww(i)*(t-b(i,lm)) +11901 continue + l1=1 + if(lm.gt.q) l1=lm-q+1 + do 11911 l=l1,lm1 + s=0d0 + t=s + do 11921 i=1,q + s=s+ww(i)*b(i,lm)*b(i,l) + t=t+ww(i)*b(i,l)**2 +11921 continue + s=s/sqrt(t) + do 11931 i=1,q + b(i,lm)=b(i,lm)-s*b(i,l) +11931 continue +11911 continue + do 11941 i=2,q + if(abs(b(i-1,lm)-b(i,lm)).gt.sml) return +11941 continue + do 11951 i=1,q + b(i,lm)=i +11951 continue + return + end + + block data bkppr + +c Common Vars + double precision span,alpha,big + integer ifl,lf + common /pprpar/ ifl,lf,span,alpha,big + + double precision conv, cutmin,fdel,cjeps + integer maxit,mitone, mitcj + common /pprz01/ conv,maxit,mitone,cutmin,fdel,cjeps,mitcj + + double precision df, gcvpen + integer ismethod + logical trace + common /spsmooth/ df, gcvpen, ismethod, trace + + data df, gcvpen, ismethod, trace /4d0, 1d0, 0, .false./ + + data ifl,maxit, conv, mitone, cutmin, fdel, + & span,alpha, big, cjeps, mitcj, lf + & /6, 20, .005, 20, 0.1, 0.02, + & 0.0, 0.0,1.0e20,0.001, 1, 2/ + end + + subroutine setppr(span1, alpha1, optlevel, ism, df1, gcvpen1) +c Put 'parameters' into Common blocks + integer optlevel,ism + double precision span1,alpha1, df1, gcvpen1 + + double precision span,alpha,big + integer ifl,lf + common /pprpar/ ifl,lf,span,alpha,big + + double precision df, gcvpen + integer ismethod + logical trace + common /spsmooth/ df, gcvpen, ismethod, trace + + span = span1 + lf = optlevel + alpha = alpha1 + if(ism .ge. 0) then + ismethod = ism + trace = .false. + else + ismethod = -(ism+1) + trace = .true. + end if + df = df1 + gcvpen = gcvpen1 + return + end + + subroutine fsort(mu,n,f,t,sp) +c + integer mu, n + double precision f(n,mu),t(n,mu),sp(n,2) +c + integer l,j,k + + do 100 l=1,mu + do 10 j=1,n + sp(j,1)=j+0.1d0 + sp(j,2)=f(j,l) + 10 continue + call sort(t(1,l),sp,1,n) + do 20 j=1,n + k=int(sp(j,1)) + f(j,l)=sp(k,2) + 20 continue + 100 continue + return + end + + subroutine pppred(np,x,smod,y,sc) + + integer np + double precision x(np,*),y(np,*),smod(*), sc(*) + + integer p,q, place,low,high, i,j,l,m,n, + + inp,ja,jb,jf,jt,jfl,jfh,jtl,jth, mu + double precision ys, s, t + + m= int(smod(1)+0.1d0) + p= int(smod(2)+0.1d0) + q= int(smod(3)+0.1d0) + n= int(smod(4)+0.1d0) + mu=int(smod(5)+0.1d0) + ys=smod(q+6) + ja=q+6 + jb=ja+p*m + jf=jb+m*q + jt=jf+n*m + call fsort(mu,n,smod(jf+1),smod(jt+1),sc) + do 100 inp = 1, np + ja=q+6 + jb=ja+p*m + jf=jb+m*q + jt=jf+n*m + do 81 i=1,q + y(inp,i)=0d0 + 81 continue + do 91 l=1,mu + s=0d0 + do 12201 j=1,p + s=s+smod(ja+j)*x(inp,j) +12201 continue + if(s .gt. smod(jt+1)) goto 12221 + place=1 + go to 12230 +12221 continue + if(s .lt. smod(jt+n)) goto 12251 + place=n + go to 12230 + +12251 continue + low=0 + high=n+1 +C WHILE +12261 if(low+1.ge.high) goto 12262 + place=(low+high)/2 + t=smod(jt+place) + if(s.eq.t) goto 12230 + if(s .lt. t) then + high=place + else + low=place + endif + goto 12261 +C END +12262 continue + jfl=jf+low + jfh=jf+high + jtl=jt+low + jth=jt+high + t=smod(jfl)+(smod(jfh)-smod(jfl))*(s-smod(jtl)) / + & (smod(jth)-smod(jtl)) + go to 12300 +12230 continue + t=smod(jf+place) +12300 continue + do 12311 i=1,q + y(inp,i)=y(inp,i)+smod(jb+i)*t +12311 continue + ja=ja+p + jb=jb+q + jf=jf+n + jt=jt+n + 91 continue + do 12321 i=1,q + y(inp,i)=ys*y(inp,i)+smod(i+5) +12321 continue + 100 continue + return + end + +c Called from R's supsmu() + subroutine setsmu (tr) + integer tr + + double precision df, gcvpen + integer ismethod + logical trace + common /spsmooth/ df, gcvpen, ismethod, trace + + ismethod = 0 + trace = tr .ne. 0 + return + end + + subroutine supsmu (n,x,y,w,iper,span,alpha,smo,sc,edf) +c +c------------------------------------------------------------------ +c +c super smoother (Friedman, 1984). +c +c version 10/10/84 +c +c coded and copywrite (c) 1984 by: +c +c Jerome H. Friedman +c department of statistics +c and +c stanford linear accelerator center +c stanford university +c +c all rights reserved. +c +c +c input: +c n : number of observations (x,y - pairs). +c x(n) : ordered abscissa values. +c y(n) : corresponding ordinate (response) values. +c w(n) : weight for each (x,y) observation. +c iper : periodic variable flag. +c iper=1 => x is ordered interval variable. +c iper=2 => x is a periodic variable with values +c in the range (0.0,1.0) and period 1.0. +c span : smoother span (fraction of observations in window). +c span=0.0 <=> "cv" : automatic (variable) span selection. +c alpha : controls high frequency (small span) penality +c used with automatic span selection (bass tone control). +c (alpha.le.0.0 or alpha.gt.10.0 => no effect.) +c output: +c smo(n) : smoothed ordinate (response) values. +c scratch: +c sc(n,7) : internal working storage. +c +c note: +c for small samples (n < 40) or if there are substantial serial +c correlations between observations close in x - value, then +c a prespecified fixed span smoother (span > 0) should be +c used. reasonable span values are 0.2 to 0.4. +c +c------------------------------------------------------------------ + +c Args + integer n, iper + double precision x(n),y(n),w(n), smo(n),sc(n,7) + double precision span, alpha, edf +c Var + double precision sy,sw, a,h(n),f, scale,vsmlsq,resmin + integer i,j, jper + + double precision spans(3), big,sml,eps + common /spans/ spans /consts/ big,sml,eps + + double precision df, gcvpen + integer ismethod + logical trace + common /spsmooth/ df, gcvpen, ismethod, trace +c Called from R's supsmu(), ismethod = 0, always (but not when called from ppr) + + if (x(n).gt.x(1)) go to 30 +c x(n) <= x(1) : boundary case: smo[.] := weighted mean( y ) + sy=0d0 + sw=sy + do 10 j=1,n + sy=sy+w(j)*y(j) + sw=sw+w(j) + 10 continue + a=0d0 + if (sw.gt.0d0) a=sy/sw + do 20 j=1,n + smo(j)=a + 20 continue + return + +C Normal Case + 30 continue + if (ismethod .ne. 0) then ! possible only when called from ppr() + call spline(n, x, y, w, smo, edf, sc) + else + i=n/4 + j=3*i + scale=x(j)-x(i) ! = IQR(x) + 40 if (scale.gt.0d0) go to 50 + if (j.lt.n) j=j+1 + if (i.gt.1) i=i-1 + scale=x(j)-x(i) + go to 40 + 50 vsmlsq=(eps*scale)**2 + jper=iper + if (iper.eq.2.and.(x(1).lt.0d0.or.x(n).gt.1d0)) jper=1 + if (jper.lt.1.or.jper.gt.2) jper=1 + if (span .gt. 0d0) then + call smooth (n,x,y,w,span,jper,vsmlsq,smo,sc) + return + end if +C else "cv" (crossvalidation) from three spans[] + do 70 i=1,3 + call smooth (n,x,y,w,spans(i),jper,vsmlsq, + & sc(1,2*i-1),sc(1,7)) + call smooth (n,x,sc(1,7),w,spans(2),-jper,vsmlsq, + & sc(1,2*i),h) + 70 continue + do 90 j=1,n + resmin=big + do 80 i=1,3 + if (sc(j,2*i).ge.resmin) go to 80 + resmin=sc(j,2*i) + sc(j,7)=spans(i) + 80 continue + if (alpha.gt.0d0 .and. alpha.le.10d0 .and. + & resmin.lt.sc(j,6) .and. resmin.gt.0d0) + & sc(j,7)= sc(j,7)+(spans(3)-sc(j,7)) * + & max(sml,resmin/sc(j,6))**(10d0-alpha) + 90 continue + + call smooth (n,x,sc(1,7),w,spans(2),-jper,vsmlsq,sc(1,2),h) + do 110 j=1,n + if (sc(j,2).le.spans(1)) sc(j,2)=spans(1) + if (sc(j,2).ge.spans(3)) sc(j,2)=spans(3) + f=sc(j,2)-spans(2) + if (f.ge.0d0) go to 100 + f=-f/(spans(2)-spans(1)) + sc(j,4)=(1d0-f)*sc(j,3)+f*sc(j,1) + go to 110 + 100 f=f/(spans(3)-spans(2)) + sc(j,4)=(1d0-f)*sc(j,3)+f*sc(j,5) + 110 continue + call smooth (n,x,sc(1,4),w,spans(1),-jper,vsmlsq,smo,h) + edf = 0 + endif + return + end + + subroutine smooth (n,x,y,w,span,iper,vsmlsq,smo,acvr) +c Args + integer n, iper + double precision x(n),y(n),w(n), span,vsmlsq, smo(n),acvr(n) +c Var + integer i,j, in,out, jper,ibw,it, j0 + double precision xm,ym,var,cvar, fbw,fbo,xti,xto,tmp, a,h,sy,wt + +c will use 'trace': + double precision df, gcvpen + integer ismethod + logical trace + common /spsmooth/ df, gcvpen, ismethod, trace + + xm=0d0 + ym=xm + var=ym + cvar=var + fbw=cvar + jper=iabs(iper) + ibw=int(0.5d0*span*n+0.5d0) + if (ibw.lt.2) ibw=2 + it=2*ibw+1 + if (it .gt. n) it = n + do i=1,it + j=i + if (jper.eq.2) j=i-ibw-1 + if (j.ge.1) then + xti=x(j) + else ! if (j.lt.1) then + j=n+j + xti=x(j)-1d0 + end if + wt=w(j) + fbo=fbw + fbw=fbw+wt + if (fbw.gt.0d0) xm=(fbo*xm+wt*xti)/fbw + if (fbw.gt.0d0) ym=(fbo*ym+wt*y(j))/fbw + tmp=0d0 + if (fbo.gt.0d0) tmp=fbw*wt*(xti-xm)/fbo + var =var +tmp*(xti-xm) + cvar=cvar+tmp*(y(j)-ym) + end do + + do 80 j=1,n + out=j-ibw-1 + in=j+ibw + if ((jper.ne.2) .and. (out.lt.1.or.in.gt.n)) go to 60 + if (out .lt. 1) then + out=n+out + xto=x(out)-1d0 + xti=x(in) + else if (in .gt. n) then + in=in-n + xti=x(in)+1d0 + xto=x(out) + else + xto=x(out) + xti=x(in) + end if + wt=w(out) + fbo=fbw + fbw=fbw-wt + tmp=0d0 + if (fbw.gt.0d0) tmp=fbo*wt*(xto-xm)/fbw + var = var-tmp*(xto-xm) + cvar=cvar-tmp*(y(out)-ym) + if (fbw.gt.0d0) xm=(fbo*xm-wt*xto)/fbw + if (fbw.gt.0d0) ym=(fbo*ym-wt*y(out))/fbw + wt=w(in) + fbo=fbw + fbw=fbw+wt + if (fbw.gt.0d0) xm=(fbo*xm+wt*xti)/fbw + if (fbw.gt.0d0) ym=(fbo*ym+wt*y(in))/fbw + tmp=0d0 + if (fbo.gt.0d0) tmp=fbw*wt*(xti-xm)/fbo + var = var+tmp*(xti-xm) + cvar=cvar+tmp*(y(in)-ym) + 60 a=0d0 + if (var.gt.vsmlsq) a=cvar/var + smo(j)=a*(x(j)-xm)+ym + if (iper.gt.0) then + h=0d0 + if (fbw.gt.0d0) h=1d0/fbw + if (var.gt.vsmlsq) h=h+(x(j)-xm)**2/var + acvr(j)=0d0 + a=1d0-w(j)*h + if (a.gt.0d0) then + acvr(j)=abs(y(j)-smo(j))/a + else if (j.gt.1) then + acvr(j)=acvr(j-1) + end if + end if + 80 continue + + if(trace) call smoothprt(span, iper, var, cvar) ! -> ./ksmooth.c + +c-- Recompute fitted values smo(j) as weighted mean for non-unique x(.) values: + j=1 + 90 j0=j + sy=smo(j)*w(j) + fbw=w(j) + if (j.ge.n) go to 110 + 100 if (x(j+1).le.x(j)) then + j=j+1 + sy=sy+w(j)*smo(j) + fbw=fbw+w(j) + if (j.lt.n) go to 100 + end if + 110 if (j.gt.j0) then + a=0d0 + if (fbw.gt.0d0) a=sy/fbw + do i=j0,j + smo(i)=a + end do + end if + j=j+1 + if (j.le.n) go to 90 + return + end + + + block data bksupsmu + double precision spans(3), big,sml,eps + common /spans/ spans /consts/ big,sml,eps + + data spans, big,sml,eps /0.05,0.2,0.5, 1.0e20,1.0e-7,1.0e-3/ + end +c--------------------------------------------------------------- +c +c this sets the compile time (default) values for various +c internal parameters : +c +c spans : span values for the three running linear smoothers. +c spans(1) : tweeter span. +c spans(2) : midrange span. +c spans(3) : woofer span. +c (these span values should be changed only with care.) +c big : a large representable floating point number. +c sml : a small number. should be set so that (sml)**(10.0) does +c not cause floating point underflow. +c eps : used to numerically stabilize slope calculations for +c running linear fits. +c +c these parameter values can be changed by declaring the +c relevant labeled common in the main program and resetting +c them with executable statements. +c + +c Only for ppr(*, ismethod != 0): Compute "smoothing" spline +c (rather, a penalized regression spline with at most 15 (inner) knots): +c----------------------------------------------------------------- +c + subroutine spline (n, x, y, w, smo, edf, sc) +c +c------------------------------------------------------------------ +c +c input: +c n : number of observations. +c x(n) : ordered abscissa values. +c y(n) : corresponding ordinate (response) values. +c w(n) : weight for each (x,y) observation. +c work space: +c sc(n,7) : used for dx(n), dy(n), dw(n), dsmo(n), lev(n) +c output: +c smo(n) : smoothed ordinate (response) values. +c edf : equivalent degrees of freedom +c +c------------------------------------------------------------------ +c Args + integer n + double precision x(n), y(n), w(n), smo(n), edf, sc(n,7) + + call splineAA(n, x, y, w, smo, edf, + + sc(n,1), ! dx + + sc(n,2), ! dy + + sc(n,3), ! dw + + sc(n,4), ! dsmo + + sc(n,5)) ! lev + + return + end + + + subroutine splineAA(n, x, y, w, smo, edf, dx, dy, dw, dsmo, lev) +c +c Workhorse of spline() above +c------------------------------------------------------------------ +c +c Additional input variables (no extra output, work): +c dx : +c dy : +c dw : +c dsmo: +c lev : "leverages", i.e., diagonal entries S_{i,i} of the smoother matrix + +c +c------------------------------------------------------------------ +c Args + integer n + double precision x(n), y(n), w(n), smo(n), edf, + + dx(n), dy(n), dw(n), dsmo(n), lev(n) +c Var + double precision knot(29), coef(25), work((17+25)*25) + double precision param(5), df1, lambda, crit, p, s + integer iparms(4), i, nk, ip, ier + + double precision df, gcvpen + integer ismethod + logical trace + common /spsmooth/ df, gcvpen, ismethod, trace + +c__no-more__ if (n .gt. 2500) call bdrsplerr() + do i = 1,n + dx(i) = (x(i)-x(1))/(x(n)-x(1)) + dy(i) = y(i) + dw(i) = w(i) + end do + nk = min(n,15) + knot(1) = dx(1) + knot(2) = dx(1) + knot(3) = dx(1) + knot(4) = dx(1) + knot(nk+1) = dx(n) + knot(nk+2) = dx(n) + knot(nk+3) = dx(n) + knot(nk+4) = dx(n) + do i = 5, nk + p = (n-1)*real(i-4)/real(nk-3) + ip = int(p) + p = p-ip + knot(i) = (1-p)*dx(ip+1) + p*dx(ip+2) + end do +c call dblepr('knots', 5, knot, nk+4) +C iparms(1:2) := (icrit, ispar) for ./sbart.c + if (ismethod .eq. 1) then + iparms(1) = 3 + df1 = df + else + iparms(1) = 1 + df1 = 0d0 + endif +c + iparms(2) = 0 ! ispar := 0 <==> estimate `spar' + iparms(3) = 500 ! maxit = 500 + iparms(4) = 0 ! spar (!= lambda) +c + param(1) = 0d0 ! = lspar : min{spar} + param(2) = 1.5d0 ! = uspar : max{spar} +c tol for 'spar' estimation: + param(3) = 1d-2 +c 'eps' (~= 2^-12 = sqrt(2^-24) ?= sqrt(machine eps)) in ./sbart.c : + param(4) = .000244 + + ier = 1 + call rbart(gcvpen,df1,dx,dy,dw,0.0d0,n,knot,nk,coef,dsmo,lev, + & crit,iparms,lambda,param, work,4,1,ier) + if(ier .gt. 0) call intpr('spline(.) TROUBLE:', 18, ier, 1) + do i = 1,n + smo(i) = dsmo(i) + end do +c call dblepr('smoothed',8, dsmo, n) + s = 0 + do i = 1, n + s = s + lev(i) + end do + edf = s + if(trace) call splineprt(df,gcvpen,ismethod, lambda, edf) + return + end + + +*********************************************************************** + +C=== This was 'sort()' in gamfit's mysort.f [or sortdi() in sortdi.f ] : +C +C=== FIXME: Translate to C and add to ../../../main/sort.c <<<<< +C +C a[] is double precision because the caller reuses a double (sometimes v[] itself!) + subroutine sort (v,a, ii,jj) +c +c Puts into a the permutation vector which sorts v into +c increasing order. Only elements from ii to jj are considered. +c Arrays iu(k) and il(k) permit sorting up to 2**(k+1)-1 elements +c +c This is a modification of CACM algorithm #347 by R. C. Singleton, +c which is a modified Hoare quicksort. +c + integer ii,jj + double precision v(*), a(jj) +c + integer iu(20),il(20) + integer t,tt, m,i,j,ij,k,l + double precision vt, vtt + + m=1 + i=ii + j=jj + 10 if (i.ge.j) go to 80 + 20 k=i + ij=(j+i)/2 + t=int(a(ij)) + vt=v(ij) + if (v(i).le.vt) go to 30 + a(ij)=a(i) + a(i)=t + t=int(a(ij)) + v(ij)=v(i) + v(i)=vt + vt=v(ij) + 30 l=j + if (v(j).ge.vt) go to 50 + a(ij)=a(j) + a(j)=t + t=int(a(ij)) + v(ij)=v(j) + v(j)=vt + vt=v(ij) + if (v(i).le.vt) go to 50 + a(ij)=a(i) + a(i)=t + t=int(a(ij)) + v(ij)=v(i) + v(i)=vt + vt=v(ij) + go to 50 + 40 a(l)=a(k) + a(k)=tt + v(l)=v(k) + v(k)=vtt + 50 l=l-1 + if (v(l).gt.vt) go to 50 + tt=int(a(l)) + vtt=v(l) + 60 k=k+1 + if (v(k).lt.vt) go to 60 + if (k.le.l) go to 40 + if (l-i.le.j-k) go to 70 + il(m)=i + iu(m)=l + i=k + m=m+1 + go to 90 + 70 il(m)=k + iu(m)=j + j=l + m=m+1 + go to 90 + 80 m=m-1 + if (m.eq.0) return + i=il(m) + j=iu(m) + 90 if (j-i.gt.10) go to 20 + if (i.eq.ii) go to 10 + i=i-1 + 100 i=i+1 + if (i.eq.j) go to 80 + t=int(a(i+1)) + vt=v(i+1) + if (v(i).le.vt) go to 100 + k=i + 110 a(k+1)=a(k) + v(k+1)=v(k) + k=k-1 + if (vt.lt.v(k)) go to 110 + a(k+1)=t + v(k+1)=vt + go to 100 + end diff --git a/com.oracle.truffle.r.native/gnur/patch/src/library/stats/src/qsbart.f b/com.oracle.truffle.r.native/gnur/patch/src/library/stats/src/qsbart.f new file mode 100644 index 0000000000000000000000000000000000000000..16310781938008b8855717f956f51d1c77472f3b --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/library/stats/src/qsbart.f @@ -0,0 +1,68 @@ +c----------------------------------------------------------------------- +c +c R : A Computer Language for Statistical Data Analysis +c Copyright (C) 1998-2016 The R Core Team +c +c This program is free software; you can redistribute it and/or modify +c it under the terms of the GNU General Public License as published by +c the Free Software Foundation; either version 2 of the License, or +c (at your option) any later version. +c +c This program is distributed in the hope that it will be useful, +c but WITHOUT ANY WARRANTY; without even the implied warranty of +c MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +c GNU General Public License for more details. +c +c You should have received a copy of the GNU General Public License +c along with this program; if not, a copy is available at +c https://www.R-project.org/Licenses/ +c +c----------------------------------------------------------------------- + +C Called from R's smooth.spline in ../R/smspline.R as .Fortran(C, ..) +C and from C's + +C An interface to sbart() --- fewer arguments BUT unspecified scrtch() dimension +C +C NB: this routine alters ws [and isetup]. +C renamed for safety +C + subroutine rbart(penalt,dofoff,xs,ys,ws,ssw,n,knot,nk, + & coef,sz,lev, + & crit,iparms,spar,parms, + & scrtch, ld4,ldnk,ier) +c Args: + integer n,nk, iparms(4), ld4,ldnk,ier + double precision penalt,dofoff, xs(n),ys(n),ws(n), ssw, + & knot(nk+4), coef(nk), sz(n), lev(n), + & crit, spar, parms(5), + & scrtch(*) +C ^^^^^^^^ dimension (9+2*ld4+ldnk)*nk = (17 + 1)*nk [last nk never accessed] +c Vars: + integer isetup + + if(iparms(4) .eq. 1) then ! spar is lambda + isetup = 2 + else + isetup = 0 + endif + call sbart(penalt,dofoff,xs,ys,ws,ssw,n,knot,nk, + & coef,sz,lev, crit, + & iparms(1),spar,iparms(2),iparms(3), +c = icrit spar ispar iter + & parms(1),parms(2),parms(3),parms(4),parms(5), +c = lspar uspar tol eps ratio + & isetup, scrtch(1), +c = 0|2 xwy == X'W y + & scrtch( nk+1),scrtch(2*nk+1),scrtch(3*nk+1),scrtch(4*nk+1), +c = hs0 hs1 hs2 hs3 ==> X'W X + & scrtch(5*nk+1),scrtch(6*nk+1),scrtch(7*nk+1),scrtch(8*nk+1), +c = sg0 sg1 sg2 sg3 ==> SIGMA + & scrtch(9*nk+1), +c = abd [ld4 x nk] ==> R + & scrtch(9*nk+ ld4*nk+1), scrtch(9*nk+2*ld4*nk+1), +c = p1ip[ld4 x nk] p2ip [ldnk x nk] + & ld4,ldnk,ier) + + return + end diff --git a/com.oracle.truffle.r.native/gnur/patch/src/library/stats/src/sbart.c b/com.oracle.truffle.r.native/gnur/patch/src/library/stats/src/sbart.c new file mode 100644 index 0000000000000000000000000000000000000000..ed734b9b28a02df53d2355cceb366ef16503bb39 --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/library/stats/src/sbart.c @@ -0,0 +1,387 @@ +/* sbart.f -- translated by f2c (version 20010821). + * ------- and f2c-clean,v 1.9 2000/01/13 + * + * According to the GAMFIT sources, this was derived from code by + * Finbarr O'Sullivan. + */ + +#include "modreg.h" +#include <math.h> +#include <Rmath.h> + +/* sbart() : The cubic spline smoother + ------- + Calls sgram (sg0,sg1,sg2,sg3,knot,nk) + stxwx (xs,ys,ws,n,knot,nk,xwy,hs0,hs1,hs2,hs3) + sslvrg (penalt,dofoff,xs,ys,ws,ssw,n,knot,nk, coef,sz,lev,crit,icrit, + lambda, xwy, hs0,hs1,hs2,hs3, sg0,sg1,sg2,sg3, + abd,p1ip,p2ip,ld4,ldnk,ier) + + is itself called from qsbart() [./qsbart.f] which has only one work array +*/ + +/***** TODO : allow to pass 'lambda' (not just 'spar') e.g. via uspar[0] * + ** ---- and signalling that via *isetup = 2 + */ +void F77_SUB(sbart) + (double *penalt, double *dofoff, + double *xs, double *ys, double *ws, double *ssw, + int *n, double *knot, int *nk, double *coef, + double *sz, double *lev, double *crit, + int *icrit, double *spar, int *ispar, int *iter, + double *lspar, double *uspar, double *tol, double *eps, double *Ratio, + int *isetup, + double *xwy, double *hs0, double *hs1, double *hs2, + double *hs3, double *sg0, double *sg1, double *sg2, + double *sg3, double *abd, double *p1ip, double *p2ip, + int *ld4, int *ldnk, int *ier) +{ + +/* A Cubic B-spline Smoothing routine. + + The algorithm minimises: + + (1/n) * sum ws(i)^2 * (ys(i)-sz(i))^2 + lambda* int ( s"(x) )^2 dx + + lambda is a function of the spar which is assumed to be between 0 and 1 + + INPUT + ----- + penalt A penalty > 1 to be used in the gcv criterion + dofoff either `df.offset' for GCV or `df' (to be matched). + n number of data points + ys(n) vector of length n containing the observations + ws(n) vector containing the weights given to each data point + NB: the code alters the values here. + xs(n) vector containing the ordinates of the observations + ssw `centered weighted sum of y^2' + nk number of b-spline coefficients to be estimated + nk <= n+2 + knot(nk+4) vector of knot points defining the cubic b-spline basis. + To obtain full cubic smoothing splines one might + have (provided the xs-values are strictly increasing) + spar penalised likelihood smoothing parameter + ispar indicating if spar is supplied (ispar=1) or to be estimated + lspar, uspar lower and upper values for spar search; 0.,1. are good values + tol, eps used in Golden Search routine + isetup setup indicator initially 0 or 2 (if 'spar' is lambda) + NB: this alters that, and it is a constant in the caller! + icrit indicator saying which cross validation score is to be computed + 0: none ; 1: GCV ; 2: CV ; 3: 'df matching' + ld4 the leading dimension of abd (ie ld4=4) + ldnk the leading dimension of p2ip (not referenced) + + OUTPUT + ------ + coef(nk) vector of spline coefficients + sz(n) vector of smoothed z-values + lev(n) vector of leverages + crit either ordinary or generalized CV score + spar if ispar != 1 + lspar == lambda (a function of spar and the design if(setup != 1) + iter number of iterations needed for spar search (if ispar != 1) + ier error indicator + ier = 0 ___ everything fine + ier = 1 ___ spar too small or too big + problem in cholesky decomposition + + Working arrays/matrix + xwy X'Wy + hs0,hs1,hs2,hs3 the non-zero diagonals of the X'WX matrix + sg0,sg1,sg2,sg3 the non-zero diagonals of the Gram matrix SIGMA + abd (ld4, nk) [ X'WX + lambda*SIGMA ] = R'R in banded form; output = R + p1ip(ld4, nk) inner products between columns of R^{-1} + p2ip(ldnk,nk) all inner products between columns of R inverse + where R'R = [X'WX + lambda*SIGMA] NOT REFERENCED +*/ + +// "Correct" ./sslvrg.f (line 129): crit = 3 + (dofoff-df)**2 +#define CRIT(FX) (*icrit == 3 ? FX - 3. : FX) + /* cancellation in (3 + eps) - 3, but still...informative */ + +#define BIG_f (1e100) + + /* c_Gold is the squared inverse of the golden ratio */ + static const double c_Gold = 0.381966011250105151795413165634; + /* == (3. - sqrt(5.)) / 2. */ + + /* Local variables */ + static double ratio;/* must be static (not needed in R) */ + + double a, b, d, e, p, q, r, u, v, w, x; + double ax, fu, fv, fw, fx, bx, xm; + double tol1, tol2; + + int i, maxit; + Rboolean Fparabol = FALSE, tracing = (*ispar < 0), spar_is_lambda = FALSE; + + /* unnecessary initializations to keep -Wall happy */ + d = 0.; fu = 0.; u = 0.; + // never computed if(spar_is_lambda) + ratio = 1.; + +/* Compute SIGMA, X' W X, X' W z, trace ratio, s0, s1. + + SIGMA -> sg0,sg1,sg2,sg3 -- via sgram() in ./sgram.f + X' W X -> hs0,hs1,hs2,hs3 \ + X' W Z -> xwy _\ via stxwx() in ./stxwx.f +*/ + +/* trevor fixed this 4/19/88 + * Note: sbart, i.e. stxwx() and sslvrg() {mostly, not always!}, use + * the square of the weights; the following rectifies that */ + for (i = 0; i < *n; ++i) + if (ws[i] > 0.) + ws[i] = sqrt(ws[i]); + + if (*isetup < 0) + spar_is_lambda = TRUE; + else if (*isetup != 1) { // 0 or 2 + /* SIGMA[i,j] := Int B''(i,t) B''(j,t) dt {B(k,.) = k-th B-spline} */ + F77_CALL(sgram)(sg0, sg1, sg2, sg3, knot, nk); + F77_CALL(stxwx)(xs, ys, ws, n, + knot, nk, + xwy, + hs0, hs1, hs2, hs3); + spar_is_lambda = (*isetup == 2); + if(!spar_is_lambda) { + /* Compute ratio := tr(X' W X) / tr(SIGMA) */ + double t1 = 0., t2 = 0.; + for (i = 3 - 1; i < (*nk - 3); ++i) { + t1 += hs0[i]; + t2 += sg0[i]; + } + ratio = t1 / t2; + } + *isetup = 1; + } +/* Compute estimate */ + +// Compute SSPLINE(SPAR), assign result to *crit (and the auxil.variables) +#define SSPLINE_COMP(_SPAR_) \ + *lspar = spar_is_lambda ? _SPAR_ \ + : ratio * R_pow(16., (_SPAR_) * 6. - 2.); \ + F77_CALL(sslvrg)(penalt, dofoff, xs, ys, ws, ssw, n, \ + knot, nk, \ + coef, sz, lev, crit, icrit, lspar, xwy, \ + hs0, hs1, hs2, hs3, \ + sg0, sg1, sg2, sg3, abd, \ + p1ip, p2ip, ld4, ldnk, ier) + + if (*ispar == 1) { /* Value of spar supplied */ + SSPLINE_COMP(*spar); + /* got through check 2 */ + *Ratio = ratio; + return; + } + +/* ELSE ---- spar not supplied --> compute it ! --------------------------- + */ + ax = *lspar; + bx = *uspar; + +/* + Use Forsythe Malcom and Moler routine to MINIMIZE criterion + f denotes the value of the criterion + + an approximation x to the point where f attains a minimum on + the interval (ax,bx) is determined. + + + INPUT + + ax left endpoint of initial interval + bx right endpoint of initial interval + f function subprogram which evaluates f(x) for any x + in the interval (ax,bx) + tol desired length of the interval of uncertainty of the final + result ( >= 0 ) + + OUTPUT + + fmin abcissa approximating the point where f attains a minimum +*/ + +/* + The method used is a combination of golden section search and + successive parabolic interpolation. convergence is never much slower + than that for a fibonacci search. if f has a continuous second + derivative which is positive at the minimum (which is not at ax or + bx), then convergence is superlinear, and usually of the order of + about 1.324.... + the function f is never evaluated at two points closer together + than eps*abs(fmin) + (tol/3), where eps is approximately the square + root of the relative machine precision. if f is a unimodal + function and the computed values of f are always unimodal when + separated by at least eps*abs(x) + (tol/3), then fmin approximates + the abcissa of the global minimum of f on the interval ax,bx with + an error less than 3*eps*abs(fmin) + tol. if f is not unimodal, + then fmin may approximate a local, but perhaps non-global, minimum to + the same accuracy. + this function subprogram is a slightly modified version of the + algol 60 procedure localmin given in richard brent, algorithms for + minimization without derivatives, prentice - hall, inc. (1973). + + Double a,b,c,d,e,eps,xm,p,q,r,tol1,tol2,u,v,w + Double fu,fv,fw,fx,x +*/ + +/* eps is approximately the square root of the relative machine + precision. + + - eps = 1e0 + - 10 eps = eps/2e0 + - tol1 = 1e0 + eps + - if (tol1 > 1e0) go to 10 + - eps = sqrt(eps) + R Version <= 1.3.x had + eps = .000244 ( = sqrt(5.954 e-8) ) + -- now eps is passed as argument +*/ + + /* initialization */ + + maxit = *iter; + *iter = 0; + a = ax; + b = bx; + v = a + c_Gold * (b - a); + w = v; + x = v; + e = 0.; + SSPLINE_COMP(x); + fx = *crit; + fv = fx; + fw = fx; + +/* main loop + --------- */ + while(*ier == 0) { /* L20: */ + xm = (a + b) * .5; + tol1 = *eps * fabs(x) + *tol / 3.; + tol2 = tol1 * 2.; + ++(*iter); + + if(tracing) { + if(*iter == 1) {/* write header */ + Rprintf("sbart (ratio = %15.8g) iterations;" + " initial tol1 = %12.6e :\n" + "%11s %14s %9s %11s Kind %11s %12s\n%s\n", + ratio, tol1, "spar", + ((*icrit == 1) ? "GCV" : + (*icrit == 2) ? "CV" : + (*icrit == 3) ?"(df0-df)^2" : + /*else (should not happen) */"?f?"), + "b - a", "e", "NEW lspar", "crit", + " ---------------------------------------" + "----------------------------------------"); + } + Rprintf("%11.8f %14.9g %9.4e %11.5g", x, CRIT(fx), b - a, e); + Fparabol = FALSE; + } + + /* Check the (somewhat peculiar) stopping criterion: note that + the RHS is negative as long as the interval [a,b] is not small:*/ + if (fabs(x - xm) <= tol2 - (b - a) * .5 || *iter > maxit) + goto L_End; + + +/* is golden-section necessary */ + + if (fabs(e) <= tol1 || + /* if had Inf then go to golden-section */ + fx >= BIG_f || fv >= BIG_f || fw >= BIG_f) goto L_GoldenSect; + +/* Fit Parabola */ + if(tracing) { Rprintf(" FP"); Fparabol = TRUE; } + + r = (x - w) * (fx - fv); + q = (x - v) * (fx - fw); + p = (x - v) * q - (x - w) * r; + q = (q - r) * 2.; + if (q > 0.) + p = -p; + q = fabs(q); + r = e; + e = d; + +/* is parabola acceptable? Otherwise do golden-section */ + + if (fabs(p) >= fabs(.5 * q * r) || + q == 0.) + /* above line added by BDR; + * [the abs(.) >= abs() = 0 should have branched..] + * in FTN: COMMON above ensures q is NOT a register variable */ + + goto L_GoldenSect; + + if (p <= q * (a - x) || + p >= q * (b - x)) goto L_GoldenSect; + + + +/* Parabolic Interpolation step */ + + if(tracing) Rprintf(" PI "); + d = p / q; + if(!R_FINITE(d)) + REprintf(" !FIN(d:=p/q): ier=%d, (v,w, p,q)= %g, %g, %g, %g\n", + *ier, v,w, p, q); + u = x + d; + + /* f must not be evaluated too close to ax or bx */ + if (u - a < tol2 || + b - u < tol2) d = fsign(tol1, xm - x); + + goto L50; + /*------*/ + + L_GoldenSect: /* a golden-section step */ + + if(tracing) Rprintf(" GS%s ", Fparabol ? "" : " --"); + + if (x >= xm) e = a - x; + else/* x < xm*/ e = b - x; + d = c_Gold * e; + + + L50: + u = x + ((fabs(d) >= tol1) ? d : fsign(tol1, d)); + /* tol1 check : f must not be evaluated too close to x */ + + SSPLINE_COMP(u); + fu = *crit; + if(tracing) Rprintf("%11g %12g\n", *lspar, CRIT(fu)); + if(!R_FINITE(fu)) { + REprintf("spar-finding: non-finite value %g; using BIG value\n", fu); + fu = 2. * BIG_f; + } + +/* update a, b, v, w, and x */ + + if (fu <= fx) { + if (u >= x) a = x; else b = x; + + v = w; fv = fw; + w = x; fw = fx; + x = u; fx = fu; + } + else { + if (u < x) a = u; else b = u; + + if (fu <= fw || w == x) { /* L70: */ + v = w; fv = fw; + w = u; fw = fu; + } else if (fu <= fv || v == x || v == w) { /* L80: */ + v = u; fv = fu; + } + } + }/* end main loop -- goto L20; */ + + L_End: + if(tracing) Rprintf(" >>> %12g %12g\n", *lspar, CRIT(fx)); + *Ratio = ratio; + *spar = x; + *crit = fx; + return; +} /* sbart */ diff --git a/com.oracle.truffle.r.native/gnur/patch/src/library/stats/src/sgram.f b/com.oracle.truffle.r.native/gnur/patch/src/library/stats/src/sgram.f new file mode 100644 index 0000000000000000000000000000000000000000..a0e50ccdf99ab7e6180504090f5e8a4eded21013 --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/library/stats/src/sgram.f @@ -0,0 +1,141 @@ +C Output from Public domain Ratfor, version 1.0 + +C PURPOSE +C Calculation of the cubic B-spline smoothness prior +C for "usual" interior knot setup. +C Uses BSPVD and INTRV in the CMLIB +C sgm[0-3](nb) Symmetric matrix 'SIGMA' +C whose (i,j)'th element contains the integral of +C B''(i,.) B''(j,.) , i=1,2 ... nb and j=i,...nb. +C Only the upper four diagonals are computed. + + subroutine sgram(sg0,sg1,sg2,sg3,tb,nb) + +c implicit none +C indices + integer nb + DOUBLE precision sg0(nb),sg1(nb),sg2(nb),sg3(nb), tb(nb+4) +c ------------- + integer ileft,mflag, i,ii,jj, lentb + DOUBLE precision vnikx(4,3),work(16),yw1(4),yw2(4), wpt +c + integer interv + external interv ! in ../../../appl/interv.c + + lentb=nb+4 +C Initialise the sigma vectors + do i=1,nb + sg0(i)=0.d0 + sg1(i)=0.d0 + sg2(i)=0.d0 + sg3(i)=0.d0 + end do + + ileft = 1 + do i=1,nb +C Calculate a linear approximation to the second derivative of the +C non-zero B-splines over the interval [tb(i),tb(i+1)]. + ileft = interv(tb(1), nb+1,tb(i), 0,0, ileft, mflag) + +C Left end second derivatives + call bsplvd (tb,lentb,4,tb(i),ileft,work,vnikx,3) + +C Put values into yw1 + do ii=1,4 + yw1(ii) = vnikx(ii,3) + end do + +C Right end second derivatives + call bsplvd (tb,lentb,4,tb(i+1),ileft,work,vnikx,3) + +C Slope*(length of interval) in Linear Approximation to B'' + do ii=1,4 + yw2(ii) = vnikx(ii,3) - yw1(ii) + end do + +C Calculate Contributions to the sigma vectors + wpt = tb(i+1) - tb(i) + if(ileft.ge.4) then + do ii=1,4 + jj=ii + sg0(ileft-4+ii) = sg0(ileft-4+ii) + + & wpt*(yw1(ii)*yw1(jj)+ + & (yw2(ii)*yw1(jj) + yw2(jj)*yw1(ii))*0.5d0 + & + yw2(ii)*yw2(jj)*0.3330d0) + jj=ii+1 + if(jj.le.4) then + sg1(ileft+ii-4) = sg1(ileft+ii-4) + + & wpt* (yw1(ii)*yw1(jj) + + * (yw2(ii)*yw1(jj) + yw2(jj)*yw1(ii))*0.5d0 + & +yw2(ii)*yw2(jj)*0.3330d0 ) + endif + jj=ii+2 + if(jj.le.4) then + sg2(ileft+ii-4) = sg2(ileft+ii-4) + + & wpt* (yw1(ii)*yw1(jj) + + * (yw2(ii)*yw1(jj) + yw2(jj)*yw1(ii))*0.5d0 + & +yw2(ii)*yw2(jj)*0.3330d0 ) + endif + jj=ii+3 + if(jj.le.4) then + sg3(ileft+ii-4) = sg3(ileft+ii-4) + + & wpt* (yw1(ii)*yw1(jj) + + * (yw2(ii)*yw1(jj) + yw2(jj)*yw1(ii))*0.5d0 + & +yw2(ii)*yw2(jj)*0.3330d0 ) + endif + end do + + else if(ileft.eq.3) then + do ii=1,3 + jj=ii + sg0(ileft-3+ii) = sg0(ileft-3+ii) + + & wpt* (yw1(ii)*yw1(jj) + + * (yw2(ii)*yw1(jj) + yw2(jj)*yw1(ii))*0.5d0 + & +yw2(ii)*yw2(jj)*0.3330d0 ) + jj=ii+1 + if(jj.le.3) then + sg1(ileft+ii-3) = sg1(ileft+ii-3) + + & wpt* (yw1(ii)*yw1(jj) + + * (yw2(ii)*yw1(jj) + yw2(jj)*yw1(ii))*0.5d0 + & +yw2(ii)*yw2(jj)*0.3330d0 ) + endif + jj=ii+2 + if(jj.le.3) then + sg2(ileft+ii-3) = sg2(ileft+ii-3) + + & wpt* (yw1(ii)*yw1(jj) + + * (yw2(ii)*yw1(jj) + yw2(jj)*yw1(ii))*0.5d0 + & +yw2(ii)*yw2(jj)*0.3330d0 ) + endif + end do + + else if(ileft.eq.2) then + do ii=1,2 + jj=ii + sg0(ileft-2+ii) = sg0(ileft-2+ii) + + & wpt* (yw1(ii)*yw1(jj) + + * (yw2(ii)*yw1(jj) + yw2(jj)*yw1(ii))*0.5d0 + & +yw2(ii)*yw2(jj)*0.3330d0 ) + jj=ii+1 + if(jj.le.2) then + sg1(ileft+ii-2) = sg1(ileft+ii-2) + + & wpt* (yw1(ii)*yw1(jj) + + * (yw2(ii)*yw1(jj) + yw2(jj)*yw1(ii))*0.5d0 + & +yw2(ii)*yw2(jj)*0.3330d0 ) + endif + end do + + + else if(ileft.eq.1) then + do ii=1,1 + jj=ii + sg0(ileft-1+ii) = sg0(ileft-1+ii) + + & wpt* (yw1(ii)*yw1(jj) + + * (yw2(ii)*yw1(jj) + yw2(jj)*yw1(ii))*0.5d0 + & +yw2(ii)*yw2(jj)*0.3330d0 ) + end do + endif + + end do + + return + end diff --git a/com.oracle.truffle.r.native/gnur/patch/src/library/stats/src/sinerp.f b/com.oracle.truffle.r.native/gnur/patch/src/library/stats/src/sinerp.f new file mode 100644 index 0000000000000000000000000000000000000000..061aee15e8e1039763f81b17980be5e326486aae --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/library/stats/src/sinerp.f @@ -0,0 +1,98 @@ +C Output from Public domain Ratfor, version 1.0 + subroutine sinerp(abd,ld4,nk,p1ip,p2ip,ldnk,flag) +c +C Purpose : Computes Inner Products between columns of L^{-1} +C where L = abd is a Banded Matrix with 3 subdiagonals + +C The algorithm works in two passes: +C +C Pass 1 computes (cj,ck) k=j,j-1,j-2,j-3 ; j=nk, .. 1 +C Pass 2 computes (cj,ck) k <= j-4 (If flag == 1 ). +C +C A refinement of Elden's trick is used. +c Args + integer ld4,nk,ldnk,flag + DOUBLE precision abd(ld4,nk),p1ip(ld4,nk), p2ip(ldnk,nk) +c Locals + integer i,j,k + DOUBLE precision wjm3(3),wjm2(2),wjm1(1),c0,c1,c2,c3 +c +c unnecessary initialization of c1 c2 c3 to keep g77 -Wall happy +c + c1 = 0.0d0 + c2 = 0.0d0 + c3 = 0.0d0 +C +C Pass 1 + wjm3(1)=0d0 + wjm3(2)=0d0 + wjm3(3)=0d0 + wjm2(1)=0d0 + wjm2(2)=0d0 + wjm1(1)=0d0 + do 100 i=1,nk + j=nk-i+1 + c0 = 1d0/abd(4,j) + if(j.le.nk-3)then + c1 = abd(1,j+3)*c0 + c2 = abd(2,j+2)*c0 + c3 = abd(3,j+1)*c0 + else if(j.eq.nk-2)then + c1 = 0d0 + c2 = abd(2,j+2)*c0 + c3 = abd(3,j+1)*c0 + else if(j.eq.nk-1)then + c1 = 0d0 + c2 = 0d0 + c3 = abd(3,j+1)*c0 + else if(j.eq.nk)then + c1 = 0d0 + c2 = 0d0 + c3 = 0d0 + endif + p1ip(1,j) = 0d0- (c1*wjm3(1)+c2*wjm3(2)+c3*wjm3(3)) + p1ip(2,j) = 0d0- (c1*wjm3(2)+c2*wjm2(1)+c3*wjm2(2)) + p1ip(3,j) = 0d0- (c1*wjm3(3)+c2*wjm2(2)+c3*wjm1(1)) + p1ip(4,j) = c0**2 + c1**2*wjm3(1) + 2d0*c1*c2*wjm3(2)+ + & 2d0*c1*c3*wjm3(3) + c2**2*wjm2(1) + 2d0*c2*c3*wjm2(2) + + & c3**2*wjm1(1) + wjm3(1)=wjm2(1) + wjm3(2)=wjm2(2) + wjm3(3)=p1ip(2,j) + wjm2(1)=wjm1(1) + wjm2(2)=p1ip(3,j) + wjm1(1)=p1ip(4,j) + 100 continue + + if(flag.ne.0)then + +C ____ Pass 2 _____ + +C Compute p2ip + do 120 i=1,nk + j=nk-i+1 +C for(k=1;k<=4 & j+k-1<=nk;k=k+1) { p2ip(.) = .. }: + do 160 k=1,4 + if(j+k-1 .gt. nk)goto 120 + p2ip(j,j+k-1) = p1ip(5-k,j) + 160 continue + 120 continue + + do 170 i=1,nk + j=nk-i+1 +c for(k=j-4;k>=1;k=k-1){ + if(j-4 .ge. 1) then + do 210 k= j-4,1, -1 + c0 = 1d0/abd(4,k) + c1 = abd(1,k+3)*c0 + c2 = abd(2,k+2)*c0 + c3 = abd(3,k+1)*c0 + p2ip(k,j)= 0d0 - ( c1*p2ip(k+3,j) + c2*p2ip(k+2,j) + + & c3*p2ip(k+1,j) ) + 210 continue + endif + 170 continue + endif + return + end + diff --git a/com.oracle.truffle.r.native/gnur/patch/src/library/stats/src/sslvrg.f b/com.oracle.truffle.r.native/gnur/patch/src/library/stats/src/sslvrg.f new file mode 100644 index 0000000000000000000000000000000000000000..9214e0eb572980e16cc15c8918aeeb8b0fcbc784 --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/library/stats/src/sslvrg.f @@ -0,0 +1,143 @@ +C Output from Public domain Ratfor, version 1.0 + +c Smoothing Spline LeVeRaGes = SSLVRG +c ----------------------------------- leverages = H_ii = diagonal entries of Hat matrix + subroutine sslvrg(penalt,dofoff,x,y,w,ssw, n, knot,nk,coef, + * sz,lev, crit,icrit, lambda, xwy, hs0,hs1,hs2,hs3, + * sg0,sg1,sg2,sg3, abd,p1ip,p2ip,ld4,ldnk,info) + +C Purpose : +C Compute smoothing spline for smoothing parameter lambda +C and compute one of three `criteria' (OCV , GCV , "df match"). +C See comments in ./sbart.c from which this is called + + integer n,nk,icrit,ld4,ldnk,info + DOUBLE precision penalt,dofoff,x(n),y(n),w(n),ssw, + & knot(nk+4), coef(nk),sz(n),lev(n), crit, lambda, + * xwy(nk), hs0(nk),hs1(nk),hs2(nk),hs3(nk), + * sg0(nk),sg1(nk),sg2(nk),sg3(nk), abd(ld4,nk), + & p1ip(ld4,nk), p2ip(ldnk,nk) + + EXTERNAL bvalue + double precision bvalue +C local variables + double precision vnikx(4,1),work(16) + integer i,ileft,j,mflag, lenkno + double precision b0,b1,b2,b3,eps, xv,rss,df, sumw +c + integer interv + external interv ! in ../../../appl/interv.c + + lenkno = nk+4 + ileft = 1 + eps = 1d-11 + +C compute the coefficients coef() of estimated smooth + + do i=1,nk + coef(i) = xwy(i) + abd(4,i) = hs0(i)+lambda*sg0(i) + end do + + do i=1,(nk-1) + abd(3,i+1) = hs1(i)+lambda*sg1(i) + end do + + do i=1,(nk-2) + abd(2,i+2) = hs2(i)+lambda*sg2(i) + end do + + do i=1,(nk-3) + abd(1,i+3) = hs3(i)+lambda*sg3(i) + end do + +c factorize banded matrix abd (into upper triangular): + call dpbfa(abd,ld4,nk,3,info) + if(info.ne.0) then +C matrix could not be factorized -> ier := info + return + endif +c solve linear system (from factorized abd): + call dpbsl(abd,ld4,nk,3,coef) + +C Value of smooth at the data points + do i=1,n + xv = x(i) + sz(i) = bvalue(knot,coef,nk,4,xv,0) + end do + +C Compute the criterion function if requested (icrit > 0) : + if(icrit .ge. 1) then + +C --- Ordinary or Generalized CV or "df match" --- + +C Get Leverages First + call sinerp(abd,ld4,nk,p1ip,p2ip,ldnk, 0) + do i=1,n + xv = x(i) + ileft = interv(knot(1), nk+1, xv, 0,0, ileft, mflag) + if(mflag .eq. -1) then + ileft = 4 + xv = knot(4)+eps + else if(mflag .eq. 1) then + ileft = nk + xv = knot(nk+1) - eps + endif + j=ileft-3 +C call bspvd(knot,4,1,xv,ileft,4,vnikx,work) + call bsplvd(knot,lenkno,4,xv,ileft,work,vnikx,1) + b0=vnikx(1,1) + b1=vnikx(2,1) + b2=vnikx(3,1) + b3=vnikx(4,1) + lev(i) = ( + & p1ip(4,j)*b0**2 + 2.d0*p1ip(3,j)*b0*b1 + + * 2.d0*p1ip(2,j)*b0*b2 + 2.d0*p1ip(1,j)*b0*b3 + + * p1ip(4,j+1)*b1**2 + 2.d0*p1ip(3,j+1)*b1*b2 + + * 2.d0*p1ip(2,j+1)*b1*b3 + p1ip(4,j+2)*b2**2 + + & 2.d0*p1ip(3,j+2)*b2*b3 + p1ip(4,j+3)*b3**2 + & )*w(i)**2 + end do + + +C Evaluate Criterion + + df = 0d0 + if(icrit .eq. 1) then ! Generalized CV -------------------- + rss = ssw + sumw = 0d0 +c w(i) are sqrt( wt[i] ) weights scaled in ../R/smspline.R such +c that sumw = number of observations with w(i) > 0 + do i=1,n + rss = rss + ((y(i)-sz(i))*w(i))**2 + df = df + lev(i) + sumw = sumw + w(i)**2 + end do + + crit = (rss/sumw)/((1d0-(dofoff + penalt*df)/sumw)**2) +c call dblepr("spar", 4, spar, 1) +c call dblepr("crit", 4, crit, 1) + + else if(icrit .eq. 2) then ! Ordinary CV ------------------ + crit = 0d0 + do i = 1,n + crit = crit + (((y(i)-sz(i))*w(i))/(1-lev(i)))**2 + end do + crit = crit/n +c call dblepr("spar", 4, spar, 1) +c call dblepr("crit", 4, crit, 1) + + else ! df := sum( lev[i] ) + do i=1,n + df = df + lev(i) + end do + if(icrit .eq. 3) then ! df matching -------------------- + crit = 3 + (dofoff-df)**2 + else ! if(icrit .eq. 4) then df - dofoff (=> zero finding) + crit = df - dofoff + endif + endif + endif +C Criterion evaluation + return + end diff --git a/com.oracle.truffle.r.native/gnur/patch/src/library/stats/src/stats.h b/com.oracle.truffle.r.native/gnur/patch/src/library/stats/src/stats.h new file mode 100644 index 0000000000000000000000000000000000000000..ba75ba2cbe14d285f14c70488611f52514c3f1ae --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/library/stats/src/stats.h @@ -0,0 +1,56 @@ +/* + * R : A Computer Language for Statistical Data Analysis + * Copyright (C) 2005-2017 The R Core Team + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version. + * + * This program 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 this program; if not, a copy is available at + * https://www.R-project.org/Licenses/ + */ + +#ifndef R_STATS_H +#define R_STATS_H + +/* definitions not involving SEXPs, plus _() */ + +#ifdef ENABLE_NLS +#include <libintl.h> +#define _(String) dgettext ("stats", String) +#else +#define _(String) (String) +#endif + +#include <R_ext/RS.h> +void +F77_NAME(hclust)(int *n, int *len, int *iopt, int *ia, int *ib, + double *crit, double *membr, int *nn, + double *disnn, int *flag, double *diss); + +void +F77_NAME(hcass2)(int *n, int *ia, int *ib, int *iorder, int *iia, int *iib); + +void +F77_NAME(kmns)(double *a, int *m, int *n, double *c, int *k, + int *ic1, int *ic2, int *nc, double * an1, double *an2, + int *ncp, double *d, int *itran, + int *live, int *iter, double *wss, int *ifault); + + +void rcont2(int *nrow, int *ncol, int *nrowt, int *ncolt, int *ntotal, + double *fact, int *jwork, int *matrix); + +double R_zeroin2(double ax, double bx, double fa, double fb, + double (*f)(double x, void *info), void *info, + double *Tol, int *Maxit); + + +#endif diff --git a/com.oracle.truffle.r.native/gnur/patch/src/library/stats/src/statsR.h b/com.oracle.truffle.r.native/gnur/patch/src/library/stats/src/statsR.h new file mode 100644 index 0000000000000000000000000000000000000000..38eb8555d98f2709b274c3e2c31862826808d672 --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/library/stats/src/statsR.h @@ -0,0 +1,207 @@ +/* + * R : A Computer Language for Statistical Data Analysis + * Copyright (C) 2012 The R Core Team. + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version. + * + * This program 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 this program; if not, a copy is available at + * https://www.R-project.org/Licenses/ + */ + +/* auxiliary */ +SEXP getListElement(SEXP list, char *str); + +/* Declarations for .Call entry points */ + +SEXP logit_link(SEXP mu); +SEXP logit_linkinv(SEXP eta); +SEXP logit_mu_eta(SEXP eta); +SEXP binomial_dev_resids(SEXP y, SEXP mu, SEXP wt); + +SEXP cutree(SEXP merge, SEXP which); +SEXP rWishart(SEXP ns, SEXP nuP, SEXP scal); +SEXP Cdqrls(SEXP x, SEXP y, SEXP tol, SEXP chk); +SEXP Cdist(SEXP x, SEXP method, SEXP attrs, SEXP p); +SEXP r2dtable(SEXP n, SEXP r, SEXP c); +SEXP cor(SEXP x, SEXP y, SEXP na_method, SEXP method); +SEXP cov(SEXP x, SEXP y, SEXP na_method, SEXP method); +SEXP updateform(SEXP old, SEXP new); +SEXP fft(SEXP z, SEXP inverse); +SEXP mvfft(SEXP z, SEXP inverse); +SEXP nextn(SEXP n, SEXP factors); + +SEXP cfilter(SEXP sx, SEXP sfilter, SEXP ssides, SEXP scircular); +SEXP rfilter(SEXP x, SEXP filter, SEXP out); +SEXP lowess(SEXP x, SEXP y, SEXP sf, SEXP siter, SEXP sdelta); +SEXP DoubleCentre(SEXP A); +SEXP BinDist(SEXP x, SEXP weights, SEXP slo, SEXP sup, SEXP sn); + +SEXP do_dchisq(SEXP sa, SEXP sb, SEXP sI); +SEXP do_dexp(SEXP sa, SEXP sb, SEXP sI); +SEXP do_dgeom(SEXP sa, SEXP sb, SEXP sI); +SEXP do_dpois(SEXP sa, SEXP sb, SEXP sI); +SEXP do_dt(SEXP sa, SEXP sb, SEXP sI); +SEXP do_dsignrank(SEXP sa, SEXP sb, SEXP sI); +SEXP do_pchisq(SEXP sa, SEXP sb, SEXP sI, SEXP sJ); +SEXP do_qchisq(SEXP sa, SEXP sb, SEXP sI, SEXP sJ); +SEXP do_pexp(SEXP sa, SEXP sb, SEXP sI, SEXP sJ); +SEXP do_qexp(SEXP sa, SEXP sb, SEXP sI, SEXP sJ); +SEXP do_pgeom(SEXP sa, SEXP sb, SEXP sI, SEXP sJ); +SEXP do_qgeom(SEXP sa, SEXP sb, SEXP sI, SEXP sJ); +SEXP do_ppois(SEXP sa, SEXP sb, SEXP sI, SEXP sJ); +SEXP do_qpois(SEXP sa, SEXP sb, SEXP sI, SEXP sJ); +SEXP do_pt(SEXP sa, SEXP sb, SEXP sI, SEXP sJ); +SEXP do_qt(SEXP sa, SEXP sb, SEXP sI, SEXP sJ); +SEXP do_psignrank(SEXP sa, SEXP sb, SEXP sI, SEXP sJ); +SEXP do_qsignrank(SEXP sa, SEXP sb, SEXP sI, SEXP sJ); + +SEXP do_dbeta(SEXP sa, SEXP sb, SEXP sc, SEXP sI); +SEXP do_dbinom(SEXP sa, SEXP sb, SEXP sc, SEXP sI); +SEXP do_dcauchy(SEXP sa, SEXP sb, SEXP sc, SEXP sI); +SEXP do_df(SEXP sa, SEXP sb, SEXP sc, SEXP sI); +SEXP do_dgamma(SEXP sa, SEXP sb, SEXP sc, SEXP sI); +SEXP do_dlnorm(SEXP sa, SEXP sb, SEXP sc, SEXP sI); +SEXP do_dlogis(SEXP sa, SEXP sb, SEXP sc, SEXP sI); +SEXP do_dnbinom(SEXP sa, SEXP sb, SEXP sc, SEXP sI); +SEXP do_dnbinom_mu(SEXP sa, SEXP sb, SEXP sc, SEXP sI); +SEXP do_dnorm(SEXP sa, SEXP sb, SEXP sc, SEXP sI); +SEXP do_dweibull(SEXP sa, SEXP sb, SEXP sc, SEXP sI); +SEXP do_dunif(SEXP sa, SEXP sb, SEXP sc, SEXP sI); +SEXP do_dnt(SEXP sa, SEXP sb, SEXP sc, SEXP sI); +SEXP do_dnchisq(SEXP sa, SEXP sb, SEXP sc, SEXP sI); +SEXP do_dwilcox(SEXP sa, SEXP sb, SEXP sc, SEXP sI); +SEXP do_pbeta(SEXP sa, SEXP sb, SEXP sc, SEXP sI, SEXP sJ); +SEXP do_qbeta(SEXP sa, SEXP sb, SEXP sc, SEXP sI, SEXP sJ); +SEXP do_pbinom(SEXP sa, SEXP sb, SEXP sc, SEXP sI, SEXP sJ); +SEXP do_qbinom(SEXP sa, SEXP sb, SEXP sc, SEXP sI, SEXP sJ); +SEXP do_pcauchy(SEXP sa, SEXP sb, SEXP sc, SEXP sI, SEXP sJ); +SEXP do_qcauchy(SEXP sa, SEXP sb, SEXP sc, SEXP sI, SEXP sJ); +SEXP do_pf(SEXP sa, SEXP sb, SEXP sc, SEXP sI, SEXP sJ); +SEXP do_qf(SEXP sa, SEXP sb, SEXP sc, SEXP sI, SEXP sJ); +SEXP do_pgamma(SEXP sa, SEXP sb, SEXP sc, SEXP sI, SEXP sJ); +SEXP do_qgamma(SEXP sa, SEXP sb, SEXP sc, SEXP sI, SEXP sJ); +SEXP do_plnorm(SEXP sa, SEXP sb, SEXP sc, SEXP sI, SEXP sJ); +SEXP do_qlnorm(SEXP sa, SEXP sb, SEXP sc, SEXP sI, SEXP sJ); +SEXP do_plogis(SEXP sa, SEXP sb, SEXP sc, SEXP sI, SEXP sJ); +SEXP do_qlogis(SEXP sa, SEXP sb, SEXP sc, SEXP sI, SEXP sJ); +SEXP do_pnbinom(SEXP sa, SEXP sb, SEXP sc, SEXP sI, SEXP sJ); +SEXP do_qnbinom(SEXP sa, SEXP sb, SEXP sc, SEXP sI, SEXP sJ); +SEXP do_pnbinom_mu(SEXP sa, SEXP sb, SEXP sc, SEXP sI, SEXP sJ); +SEXP do_qnbinom_mu(SEXP sa, SEXP sb, SEXP sc, SEXP sI, SEXP sJ); +SEXP do_pnorm(SEXP sa, SEXP sb, SEXP sc, SEXP sI, SEXP sJ); +SEXP do_qnorm(SEXP sa, SEXP sb, SEXP sc, SEXP sI, SEXP sJ); +SEXP do_pweibull(SEXP sa, SEXP sb, SEXP sc, SEXP sI, SEXP sJ); +SEXP do_qweibull(SEXP sa, SEXP sb, SEXP sc, SEXP sI, SEXP sJ); +SEXP do_punif(SEXP sa, SEXP sb, SEXP sc, SEXP sI, SEXP sJ); +SEXP do_qunif(SEXP sa, SEXP sb, SEXP sc, SEXP sI, SEXP sJ); +SEXP do_pnt(SEXP sa, SEXP sb, SEXP sc, SEXP sI, SEXP sJ); +SEXP do_qnt(SEXP sa, SEXP sb, SEXP sc, SEXP sI, SEXP sJ); +SEXP do_pnchisq(SEXP sa, SEXP sb, SEXP sc, SEXP sI, SEXP sJ); +SEXP do_qnchisq(SEXP sa, SEXP sb, SEXP sc, SEXP sI, SEXP sJ); +SEXP do_pwilcox(SEXP sa, SEXP sb, SEXP sc, SEXP sI, SEXP sJ); +SEXP do_qwilcox(SEXP sa, SEXP sb, SEXP sc, SEXP sI, SEXP sJ); + +SEXP do_dhyper(SEXP sa, SEXP sb, SEXP sc, SEXP sd, SEXP sI); +SEXP do_dnbeta(SEXP sa, SEXP sb, SEXP sc, SEXP sd, SEXP sI); +SEXP do_dnf(SEXP sa, SEXP sb, SEXP sc, SEXP sd, SEXP sI); +SEXP do_phyper(SEXP sa, SEXP sb, SEXP sc, SEXP sd, SEXP sI, SEXP sJ); +SEXP do_qhyper(SEXP sa, SEXP sb, SEXP sc, SEXP sd, SEXP sI, SEXP sJ); +SEXP do_pnbeta(SEXP sa, SEXP sb, SEXP sc, SEXP sd, SEXP sI, SEXP sJ); +SEXP do_qnbeta(SEXP sa, SEXP sb, SEXP sc, SEXP sd, SEXP sI, SEXP sJ); +SEXP do_pnf(SEXP sa, SEXP sb, SEXP sc, SEXP sd, SEXP sI, SEXP sJ); +SEXP do_qnf(SEXP sa, SEXP sb, SEXP sc, SEXP sd, SEXP sI, SEXP sJ); +SEXP do_ptukey(SEXP sa, SEXP sb, SEXP sc, SEXP sd, SEXP sI, SEXP sJ); +SEXP do_qtukey(SEXP sa, SEXP sb, SEXP sc, SEXP sd, SEXP sI, SEXP sJ); + +SEXP do_rchisq(SEXP sn, SEXP sa); +SEXP do_rexp(SEXP sn, SEXP sa); +SEXP do_rgeom(SEXP sn, SEXP sa); +SEXP do_rpois(SEXP sn, SEXP sa); +SEXP do_rt(SEXP sn, SEXP sa); +SEXP do_rsignrank(SEXP sn, SEXP sa); + +SEXP do_rbeta(SEXP sn, SEXP sa, SEXP sb); +SEXP do_rbinom(SEXP sn, SEXP sa, SEXP sb); +SEXP do_rcauchy(SEXP sn, SEXP sa, SEXP sb); +SEXP do_rf(SEXP sn, SEXP sa, SEXP sb); +SEXP do_rgamma(SEXP sn, SEXP sa, SEXP sb); +SEXP do_rlnorm(SEXP sn, SEXP sa, SEXP sb); +SEXP do_rlogis(SEXP sn, SEXP sa, SEXP sb); +SEXP do_rnbinom(SEXP sn, SEXP sa, SEXP sb); +SEXP do_rnorm(SEXP sn, SEXP sa, SEXP sb); +SEXP do_runif(SEXP sn, SEXP sa, SEXP sb); +SEXP do_rweibull(SEXP sn, SEXP sa, SEXP sb); +SEXP do_rwilcox(SEXP sn, SEXP sa, SEXP sb); +SEXP do_rnchisq(SEXP sn, SEXP sa, SEXP sb); +SEXP do_rnbinom_mu(SEXP sn, SEXP sa, SEXP sb); + +SEXP do_rhyper(SEXP sn, SEXP sa, SEXP sb, SEXP sc); + +SEXP do_rmultinom(SEXP sn, SEXP ssize, SEXP sprob); + +/* Declarations for .External[2] entry points */ + +SEXP compcases(SEXP args); +SEXP doD(SEXP args); +SEXP deriv(SEXP args); +SEXP modelframe(SEXP call, SEXP op, SEXP args, SEXP rho); +SEXP modelmatrix(SEXP call, SEXP op, SEXP args, SEXP rho); +SEXP termsform(SEXP args); +SEXP do_fmin(SEXP call, SEXP op, SEXP args, SEXP rho); +SEXP nlm(SEXP call, SEXP op, SEXP args, SEXP rho); +SEXP zeroin2(SEXP call, SEXP op, SEXP args, SEXP rho); +SEXP optim(SEXP call, SEXP op, SEXP args, SEXP rho); +SEXP optimhess(SEXP call, SEXP op, SEXP args, SEXP rho); +SEXP call_dqagi(SEXP); +SEXP call_dqags(SEXP); + +SEXP Rsm(SEXP x, SEXP stype, SEXP send); +SEXP tukeyline(SEXP x, SEXP y, SEXP call); +SEXP runmed(SEXP x, SEXP stype, SEXP sk, SEXP end, SEXP print_level); +SEXP influence(SEXP mqr, SEXP do_coef, SEXP e, SEXP stol); + +SEXP pSmirnov2x(SEXP statistic, SEXP snx, SEXP sny); +SEXP pKolmogorov2x(SEXP statistic, SEXP sn); +SEXP pKS2(SEXP sn, SEXP stol); + +SEXP ksmooth(SEXP x, SEXP y, SEXP snp, SEXP skrn, SEXP sbw); + +SEXP SplineCoef(SEXP method, SEXP x, SEXP y); +SEXP SplineEval(SEXP xout, SEXP z); + +SEXP ApproxTest(SEXP x, SEXP y, SEXP method, SEXP sf); +SEXP Approx(SEXP x, SEXP y, SEXP v, SEXP method, + SEXP yleft, SEXP yright, SEXP sf); + +SEXP LogLin(SEXP dtab, SEXP conf, SEXP table, SEXP start, + SEXP snmar, SEXP eps, SEXP iter); + +SEXP pAnsari(SEXP q, SEXP sm, SEXP sn); +SEXP qAnsari(SEXP p, SEXP sm, SEXP sn); +SEXP pKendall(SEXP q, SEXP sn); +SEXP pRho(SEXP q, SEXP sn, SEXP lower); +SEXP SWilk(SEXP x); + +SEXP bw_den(SEXP nbin, SEXP sx); +SEXP bw_den_binned(SEXP sx); +SEXP bw_ucv(SEXP sn, SEXP sd, SEXP cnt, SEXP sh); +SEXP bw_bcv(SEXP sn, SEXP sd, SEXP cnt, SEXP sh); +SEXP bw_phi4(SEXP sn, SEXP sd, SEXP cnt, SEXP sh); +SEXP bw_phi6(SEXP sn, SEXP sd, SEXP cnt, SEXP sh); + +SEXP Fexact(SEXP x, SEXP pars, SEXP work, SEXP smult); +SEXP Fisher_sim(SEXP sr, SEXP sc, SEXP sB); +SEXP chisq_sim(SEXP sr, SEXP sc, SEXP sB, SEXP E); +SEXP d2x2xk(SEXP sK, SEXP sm, SEXP sn, SEXP st, SEXP srn); + +SEXP stats_signrank_free(void); +SEXP stats_wilcox_free(void); diff --git a/com.oracle.truffle.r.native/gnur/patch/src/library/stats/src/stl.f b/com.oracle.truffle.r.native/gnur/patch/src/library/stats/src/stl.f new file mode 100644 index 0000000000000000000000000000000000000000..83d99b4589b59f0ccb46fd475920404be1a027cc --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/library/stats/src/stl.f @@ -0,0 +1,615 @@ +c +c from netlib/a/stl: no authorship nor copyright claim in the source; +c presumably by the authors of +c +c R.B. Cleveland, W.S.Cleveland, J.E. McRae, and I. Terpenning, +c STL: A Seasonal-Trend Decomposition Procedure Based on Loess, +c Statistics Research Report, AT&T Bell Laboratories. +c +c Converted to double precision by B.D. Ripley 1999. +c Indented, goto labels renamed, many goto's replaced by `if then {else}' +c (using Emacs), many more comments; by M.Maechler 2001-02. +c + subroutine stl(y,n,np,ns,nt,nl, isdeg,itdeg,ildeg, + & nsjump,ntjump,nljump, ni,no, rw,season,trend,work) + +c implicit none +c Arg + integer n, np, ns,nt,nl, isdeg,itdeg,ildeg, nsjump,ntjump,nljump, + & ni, no +c n : length(y) +c ns, nt, nl : spans for `s', `t' and `l' smoother +c isdeg, itdeg, ildeg : local degree for `s', `t' and `l' smoother +c nsjump,ntjump,nljump: ........ for `s', `t' and `l' smoother +c ni, no : number of inner and outer (robust) iterations + + double precision y(n), rw(n), season(n), trend(n), + & work(n+2*np,5) +c Var + integer i,k, newns, newnt, newnl, newnp + logical userw + + userw = .false. + do 1 i = 1,n + trend(i) = 0.d0 + 1 continue +c the three spans must be at least three and odd: + newns = max0(3,ns) + newnt = max0(3,nt) + newnl = max0(3,nl) + if(mod(newns,2) .eq. 0) newns = newns + 1 + if(mod(newnt,2) .eq. 0) newnt = newnt + 1 + if(mod(newnl,2) .eq. 0) newnl = newnl + 1 +c periodicity at least 2: + newnp = max0(2,np) + + k = 0 +c --- outer loop -- robustnes iterations + 100 continue + call stlstp(y,n, newnp,newns,newnt,newnl, isdeg,itdeg,ildeg, + & nsjump,ntjump,nljump, ni,userw,rw,season, trend, work) + k = k+1 + if(k .gt. no) goto 10 + + do 3 i = 1,n + work(i,1) = trend(i)+season(i) + 3 continue + call stlrwt(y,n,work(1,1),rw) + userw = .true. + goto 100 +c --- end Loop + 10 continue + +c robustness weights when there were no robustness iterations: + if(no .le. 0) then + do 15 i = 1,n + rw(i) = 1.d0 + 15 continue + endif + return + end + + subroutine stless(y,n,len,ideg,njump,userw,rw,ys,res) + +c implicit none +c Arg + integer n, len, ideg, njump + double precision y(n), rw(n), ys(n), res(n) +c Var + integer newnj, nleft, nright, nsh, k, i, j + double precision delta + logical ok, userw + + if(n .lt. 2) then + ys(1) = y(1) + return + endif + + newnj = min0(njump, n-1) + if(len .ge. n) then + nleft = 1 + nright = n + do 20 i = 1,n,newnj + call stlest(y,n,len,ideg,dble(i),ys(i),nleft,nright,res, + & userw,rw,ok) + if(.not. ok) ys(i) = y(i) + 20 continue + + else + + if(newnj .eq. 1) then + nsh = (len+1)/2 + nleft = 1 + nright = len + do 30 i = 1,n + if(i .gt. nsh .and. nright .ne. n) then + nleft = nleft+1 + nright = nright+1 + endif + call stlest(y,n,len,ideg,dble(i),ys(i),nleft,nright,res, + & userw,rw,ok) + if(.not. ok) ys(i) = y(i) + 30 continue + else + nsh = (len+1)/2 + do 40 i = 1,n,newnj + if(i .lt. nsh) then + nleft = 1 + nright = len + else if(i .ge. n-nsh+1) then + nleft = n-len+1 + nright = n + else + nleft = i-nsh+1 + nright = len+i-nsh + endif + + call stlest(y,n,len,ideg,dble(i),ys(i),nleft,nright,res, + & userw,rw,ok) + if(.not. ok) ys(i) = y(i) + 40 continue + + endif + + endif + + if(newnj .ne. 1) then + do 45 i = 1,n-newnj,newnj + delta = (ys(i+newnj)-ys(i))/dble(newnj) + do 47 j = i+1,i+newnj-1 + ys(j) = ys(i)+delta*dble(j-i) + 47 continue + 45 continue + k = ((n-1)/newnj)*newnj+1 + + if(k .ne. n) then + call stlest(y,n,len,ideg,dble(n),ys(n),nleft,nright,res, + & userw,rw,ok) + if(.not. ok) ys(n) = y(n) + + if(k .ne. n-1) then + delta = (ys(n)-ys(k))/dble(n-k) + do 55 j = k+1,n-1 + ys(j) = ys(k)+delta*dble(j-k) + 55 continue + endif + endif + endif + return + end + + subroutine stlest(y,n,len,ideg,xs,ys,nleft,nright,w, + & userw,rw,ok) + +c implicit none +c Arg + integer n, len, ideg, nleft, nright + double precision y(n), w(n), rw(n), xs, ys + logical userw,ok +c Var + double precision range, h, h1, h9, a, b, c, r + integer j + + range = dble(n)-dble(1) + h = max(xs - dble(nleft), dble(nright) - xs) + if(len .gt. n) h = h + dble((len-n)/2) + h9 = 0.999d0*h + h1 = 0.001d0*h + a = 0.d0 + do 60 j = nleft,nright + r = abs(dble(j)-xs) + if(r .le. h9) then + if(r .le. h1) then + w(j) = 1.d0 + else + w(j) = (1.d0 - (r/h)**3)**3 + endif + if(userw) w(j) = rw(j)*w(j) + a = a+w(j) + else + w(j) = 0.d0 + endif + 60 continue + + if(a .le. 0.d0) then + ok = .false. + else + ok = .true. + do 69 j = nleft,nright + w(j) = w(j)/a + 69 continue + if((h .gt. 0.d0) .and. (ideg .gt. 0)) then + a = 0.d0 + do 73 j = nleft,nright + a = a+w(j)*dble(j) + 73 continue + b = xs-a + c = 0.d0 + do 75 j = nleft,nright + c = c+w(j)*(dble(j)-a)**2 + 75 continue + if(sqrt(c) .gt. 0.001d0*range) then + b = b/c + do 79 j = nleft,nright + w(j) = w(j)*(b*(dble(j)-a)+1.0d0) + 79 continue + endif + endif + ys = 0.d0 + do 81 j = nleft,nright + ys = ys+w(j)*y(j) + 81 continue + endif + + return + end + + subroutine stlfts(x,n,np,trend,work) + integer n, np + double precision x(n), trend(n), work(n) + + call stlma(x, n, np, trend) + call stlma(trend,n-np+1, np, work) + call stlma(work, n-2*np+2,3, trend) + return + end + + + subroutine stlma(x, n, len, ave) + +c Moving Average (aka "running mean") +c ave(i) := mean(x{j}, j = max(1,i-k),..., min(n, i+k)) +c for i = 1,2,..,n + +c implicit none +c Arg + integer n, len + double precision x(n), ave(n) +c Var + double precision flen, v + integer i, j, k, m, newn + newn = n-len+1 + flen = dble(len) + v = 0.d0 + do 3 i = 1,len + v = v+x(i) + 3 continue + ave(1) = v/flen + if(newn .gt. 1) then + k = len + m = 0 + do 7 j = 2, newn + k = k+1 + m = m+1 + v = v-x(m)+x(k) + ave(j) = v/flen + 7 continue + endif + return + end + + + subroutine stlstp(y,n,np,ns,nt,nl,isdeg,itdeg,ildeg,nsjump, + & ntjump,nljump,ni,userw,rw,season,trend,work) + +c implicit none +c Arg + integer n,np,ns,nt,nl,isdeg,itdeg,ildeg,nsjump,ntjump,nljump,ni + logical userw + double precision y(n),rw(n),season(n),trend(n),work(n+2*np,5) +c Var + integer i,j + + do 80 j = 1,ni + do 1 i = 1,n + work(i,1) = y(i)-trend(i) + 1 continue + call stlss(work(1,1),n,np,ns,isdeg,nsjump,userw,rw,work(1,2), + & work(1,3),work(1,4),work(1,5),season) + call stlfts(work(1,2),n+2*np,np,work(1,3),work(1,1)) + call stless(work(1,3),n,nl,ildeg,nljump,.false.,work(1,4), + & work(1,1),work(1,5)) + do 3 i = 1,n + season(i) = work(np+i,2)-work(i,1) + 3 continue + do 5 i = 1,n + work(i,1) = y(i)-season(i) + 5 continue + call stless(work(1,1),n,nt,itdeg,ntjump,userw,rw,trend, + & work(1,3)) + 80 continue + return + end + + subroutine stlrwt(y,n,fit,rw) +c Robustness Weights +c rw_i := B( |y_i - fit_i| / (6 M) ), i = 1,2,...,n +c where B(u) = (1 - u^2)^2 * 1[|u| < 1] {Tukey's biweight} +c and M := median{ |y_i - fit_i| } +c implicit none +c Arg + integer n + double precision y(n), fit(n), rw(n) +c Var + integer mid(2), i + double precision cmad, c9, c1, r + + do 7 i = 1,n + rw(i) = abs(y(i)-fit(i)) + 7 continue + mid(1) = n/2+1 + mid(2) = n-mid(1)+1 + call psort(rw,n,mid,2) + cmad = 3.0d0*(rw(mid(1))+rw(mid(2))) +c = 6 * MAD + c9 = 0.999d0*cmad + c1 = 0.001d0*cmad + do 10 i = 1,n + r = abs(y(i)-fit(i)) + if(r .le. c1) then + rw(i) = 1.d0 + else if(r .le. c9) then + rw(i) = (1.d0 - (r/cmad)**2)**2 + else + rw(i) = 0.d0 + endif + 10 continue + return + end + + subroutine stlss(y,n,np,ns,isdeg,nsjump,userw,rw,season, + & work1,work2,work3,work4) +c +c called by stlstp() at the beginning of each (inner) iteration +c +c implicit none +c Arg + integer n, np, ns, isdeg, nsjump + double precision y(n), rw(n), season(n+2*np), + & work1(n), work2(n), work3(n), work4(n) + logical userw +c Var + integer nright, nleft, i, j, k, m + logical ok + double precision xs + + if(np .lt. 1) return + + do 200 j = 1, np + k = (n-j)/np+1 + do 10 i = 1,k + work1(i) = y((i-1)*np+j) + 10 continue + if(userw) then + do 12 i = 1,k + work3(i) = rw((i-1)*np+j) + 12 continue + endif + call stless(work1,k,ns,isdeg,nsjump,userw,work3,work2(2),work4) + xs = 0 + nright = min0(ns,k) + call stlest(work1,k,ns,isdeg,xs,work2(1),1,nright,work4, + & userw,work3,ok) + if(.not. ok) work2(1) = work2(2) + xs = k+1 + nleft = max0(1,k-ns+1) + call stlest(work1,k,ns,isdeg,xs,work2(k+2),nleft,k,work4, + & userw,work3,ok) + if(.not. ok) work2(k+2) = work2(k+1) + do 18 m = 1,k+2 + season((m-1)*np+j) = work2(m) + 18 continue + + 200 continue + + return + end + + +c STL E_Z_ : "Easy" user interface -- not called from R + + subroutine stlez(y, n, np, ns, isdeg, itdeg, robust, no, rw, + & season, trend, work) + +c implicit none +c Arg + integer n, np, ns, isdeg, itdeg, no + logical robust + double precision y(n), rw(n), season(n), trend(n), work(n+2*np,7) +c Var + integer i, j, ildeg, nt, nl, ni, nsjump, ntjump, nljump, + & newns, newnp + double precision maxs, mins, maxt, mint, maxds, maxdt, difs, dift + + ildeg = itdeg + newns = max0(3,ns) + if(mod(newns,2) .eq. 0) newns = newns+1 + newnp = max0(2,np) + nt = int((1.5d0*newnp)/(1.d0 - 1.5d0/newns) + 0.5d0) + nt = max0(3,nt) + if(mod(nt,2) .eq. 0) nt = nt+1 + nl = newnp + if(mod(nl,2) .eq. 0) nl = nl+1 + + if(robust) then + ni = 1 + else + ni = 2 + endif + + nsjump = max0(1,int(float(newns)/10 + 0.9)) + ntjump = max0(1,int(float(nt)/10 + 0.9)) + nljump = max0(1,int(float(nl)/10 + 0.9)) + do 2 i = 1,n + trend(i) = 0.d0 + 2 continue + call stlstp(y,n,newnp,newns,nt,nl,isdeg,itdeg,ildeg,nsjump, + & ntjump,nljump,ni,.false.,rw,season,trend,work) + + no = 0 + if(robust) then + j=1 +C Loop --- 15 robustness iterations + 100 if(j .le. 15) then + do 35 i = 1,n + work(i,6) = season(i) + work(i,7) = trend(i) + work(i,1) = trend(i)+season(i) + 35 continue + call stlrwt(y,n,work(1,1),rw) + call stlstp(y, n, newnp, newns, nt,nl, isdeg,itdeg,ildeg, + & nsjump,ntjump,nljump, ni, .true., + & rw, season, trend, work) + no = no+1 + maxs = work(1,6) + mins = work(1,6) + maxt = work(1,7) + mint = work(1,7) + maxds = abs(work(1,6) - season(1)) + maxdt = abs(work(1,7) - trend(1)) + do 137 i = 2,n + if(maxs .lt. work(i,6)) maxs = work(i,6) + if(maxt .lt. work(i,7)) maxt = work(i,7) + if(mins .gt. work(i,6)) mins = work(i,6) + if(mint .gt. work(i,7)) mint = work(i,7) + difs = abs(work(i,6) - season(i)) + dift = abs(work(i,7) - trend(i)) + if(maxds .lt. difs) maxds = difs + if(maxdt .lt. dift) maxdt = dift + 137 continue + if((maxds/(maxs-mins) .lt. 0.01d0) .and. + & (maxdt/(maxt-mint) .lt. 0.01d0)) goto 300 + continue + j=j+1 + goto 100 + endif +C end Loop + 300 continue + + else +c .not. robust + + do 150 i = 1,n + rw(i) = 1.0d0 + 150 continue + endif + + return + end + + subroutine psort(a,n,ind,ni) +c +c Partial Sorting ; used for Median (MAD) computation only +c +c implicit none +c Arg + integer n,ni + double precision a(n) + integer ind(ni) +c Var + integer indu(16),indl(16),iu(16),il(16),p,jl,ju,i,j,m,k,ij,l + double precision t,tt + + if(n .lt. 0 .or. ni .lt. 0) return + + if(n .lt. 2 .or. ni .eq. 0) return + + jl = 1 + ju = ni + indl(1) = 1 + indu(1) = ni + i = 1 + j = n + m = 1 + +c Outer Loop + 161 continue + if(i .lt. j) go to 10 + +c _Loop_ + 166 continue + m = m-1 + if(m .eq. 0) return + i = il(m) + j = iu(m) + jl = indl(m) + ju = indu(m) + if(.not.(jl .le. ju)) goto 166 + +c while (j - i > 10) + 173 if(.not.(j-i .gt. 10)) goto 174 + + 10 k = i + ij = (i+j)/2 + t = a(ij) + if(a(i) .gt. t) then + a(ij) = a(i) + a(i) = t + t = a(ij) + endif + l = j + if(a(j) .lt. t) then + a(ij) = a(j) + a(j) = t + t = a(ij) + if(a(i) .gt. t) then + a(ij) = a(i) + a(i) = t + t = a(ij) + endif + endif + + 181 continue + l = l-1 + if(a(l) .le. t)then + tt = a(l) + 186 continue + k = k+1 + if(.not.(a(k) .ge. t)) goto 186 + + if(k .gt. l) goto 183 + + a(l) = a(k) + a(k) = tt + endif + goto 181 + + 183 continue + indl(m) = jl + indu(m) = ju + p = m + m = m+1 + if(l-i .le. j-k) then + il(p) = k + iu(p) = j + j = l + + 193 continue + if(jl .gt. ju) goto 166 + if(ind(ju) .gt. j) then + ju = ju-1 + goto 193 + endif + indl(p) = ju+1 + else + il(p) = i + iu(p) = l + i = k + + 200 continue + if(jl .gt. ju) goto 166 + if(ind(jl) .lt. i) then + jl = jl+1 + goto 200 + endif + indu(p) = jl-1 + endif + + goto 173 +c end while + 174 continue + + if(i .ne. 1) then + i = i-1 + 209 continue + i = i+1 + if(i .eq. j) goto 166 + t = a(i+1) + if(a(i) .gt. t) then + k = i +c repeat + 216 continue + a(k+1) = a(k) + k = k-1 + if(.not.(t .ge. a(k))) goto 216 +c until t >= a(k) + a(k+1) = t + endif + goto 209 + + endif + + goto 161 +c End Outer Loop + + end diff --git a/com.oracle.truffle.r.native/gnur/patch/src/library/stats/src/stxwx.f b/com.oracle.truffle.r.native/gnur/patch/src/library/stats/src/stxwx.f new file mode 100644 index 0000000000000000000000000000000000000000..2e9ac2ebe1d7964a116dedafa75daceea93d3ecf --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/library/stats/src/stxwx.f @@ -0,0 +1,66 @@ +C Output from Public domain Ratfor, version 1.0 + subroutine stxwx(x,z,w,k,xknot,n,y,hs0,hs1,hs2,hs3) + +c implicit none + integer k,n + DOUBLE precision x(k),z(k),w(k), xknot(n+4),y(n), + & hs0(n),hs1(n),hs2(n),hs3(n) +C local + DOUBLE precision eps,vnikx(4,1),work(16) + integer lenxk, i,j, ileft,mflag +c + integer interv + external interv ! in ../../../appl/interv.c + + lenxk=n+4 +C Initialise the output vectors + do i=1,n + y(i)=0d0 + hs0(i)=0d0 + hs1(i)=0d0 + hs2(i)=0d0 + hs3(i)=0d0 + end do + +C Compute X' W^2 X -> hs0,hs1,hs2,hs3 and X' W^2 Z -> y +C Note that here the weights w(i) == sqrt(wt[i]) where wt[] where original weights + ileft=1 + eps= .1d-9 + + do i=1,k + ileft= interv(xknot(1), n+1, x(i), 0,0, ileft, mflag) +C if(mflag==-1) {write(6,'("Error in hess ",i2)')mflag;stop} +C if(mflag==-1) {return} + if(mflag.eq. 1)then + if(x(i).le.(xknot(ileft)+eps))then + ileft=ileft-1 + else + return + endif +C else{write(6,'("Error in hess ",i2)')mflag;stop}} + endif + call bsplvd (xknot,lenxk,4,x(i),ileft,work,vnikx,1) + + j= ileft-4+1 + y(j) = y(j)+w(i)**2*z(i)*vnikx(1,1) + hs0(j)=hs0(j)+w(i)**2*vnikx(1,1)**2 + hs1(j)=hs1(j)+w(i)**2*vnikx(1,1)*vnikx(2,1) + hs2(j)=hs2(j)+w(i)**2*vnikx(1,1)*vnikx(3,1) + hs3(j)=hs3(j)+w(i)**2*vnikx(1,1)*vnikx(4,1) + j= ileft-4+2 + y(j) = y(j)+w(i)**2*z(i)*vnikx(2,1) + hs0(j)=hs0(j)+w(i)**2*vnikx(2,1)**2 + hs1(j)=hs1(j)+w(i)**2*vnikx(2,1)*vnikx(3,1) + hs2(j)=hs2(j)+w(i)**2*vnikx(2,1)*vnikx(4,1) + j= ileft-4+3 + y(j) = y(j)+w(i)**2*z(i)*vnikx(3,1) + hs0(j)=hs0(j)+w(i)**2*vnikx(3,1)**2 + hs1(j)=hs1(j)+w(i)**2*vnikx(3,1)*vnikx(4,1) + j= ileft-4+4 + y(j) = y(j)+w(i)**2*z(i)*vnikx(4,1) + hs0(j)=hs0(j)+w(i)**2*vnikx(4,1)**2 + + enddo + + return + end diff --git a/com.oracle.truffle.r.native/gnur/patch/src/library/stats/src/ts.h b/com.oracle.truffle.r.native/gnur/patch/src/library/stats/src/ts.h new file mode 100644 index 0000000000000000000000000000000000000000..97d5c0e774271340dee9245d7e2dcd43582bee9e --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/library/stats/src/ts.h @@ -0,0 +1,100 @@ +/* + * R : A Computer Language for Statistical Data Analysis + * Copyright (C) 2001-2017 The R Core Team. + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version. + * + * This program 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 this program; if not, a copy is available at + * https://www.R-project.org/Licenses/ + */ + +#ifndef R_TS_H +#define R_TS_H +#include <Rinternals.h> +#include "stats.h" + +void multi_burg(int *pn, double *x, int *pomax, int *pnser, double *coef, + double *pacf, double *var, double *aic, int *porder, + int *useaic, int *vmethod); +void multi_yw(double *acf, int *pn, int *pomax, int *pnser, double *coef, + double *pacf, double *var, double *aic, int *porder, + int *puseaic); +void HoltWinters (double *x, int *xl, double *alpha, double *beta, + double *gamma, int *start_time, int *seasonal, int *period, + int *dotrend, int *doseasonal, + double *a, double *b, double *s, double *SSE, double *level, + double *trend, double *season); + +void +F77_NAME(eureka)(int *lr, double *r__, double *g, + double *f, double *var, double *a); + +void +F77_NAME(stl)(double *y, int *n, int *np, int *ns, + int *nt, int *nl, int *isdeg, int *itdeg, int *ildeg, + int *nsjump, int *ntjump, int *nljump, int *ni, + int *no, double *rw, double *season, double *trend, + double *work); + +typedef struct +{ + int p, q, r, np, nrbar, n, ncond, m, trans, method, nused; + int mp, mq, msp, msq, ns; + double delta, s2; + double *params, *phi, *theta, *a, *P, *V; + double *thetab, *xnext, *xrow, *rbar, *w, *wkeep, *resid, *reg; +} starma_struct, *Starma; + +void starma(Starma G, int *ifault); + +void karma(Starma G, double *sumlog, double *ssq, int iupd, int *nit); + +void forkal(Starma G, int id, int il, double *delta, double *y, + double *amse, int *ifault); + +SEXP setup_starma(SEXP na, SEXP x, SEXP pn, SEXP xreg, SEXP pm, + SEXP dt, SEXP ptrans, SEXP sncond); +SEXP free_starma(SEXP pG); +SEXP set_trans(SEXP pG, SEXP ptrans); +SEXP arma0fa(SEXP pG, SEXP inparams); +SEXP get_s2(SEXP pG); +SEXP get_resid(SEXP pG); +SEXP Dotrans(SEXP pG, SEXP x); +SEXP arma0_kfore(SEXP pG, SEXP pd, SEXP psd, SEXP n_ahead); +SEXP Starma_method(SEXP pG, SEXP method); +SEXP Gradtrans(SEXP pG, SEXP x); +SEXP Invtrans(SEXP pG, SEXP x); + +SEXP ARMAtoMA(SEXP ar, SEXP ma, SEXP lag_max); + +SEXP KalmanLike(SEXP sy, SEXP mod, SEXP sUP, SEXP op, SEXP fast); +SEXP KalmanFore(SEXP nahead, SEXP mod, SEXP fast); +SEXP KalmanSmooth(SEXP sy, SEXP mod, SEXP sUP); +SEXP ARIMA_undoPars(SEXP sin, SEXP sarma); +SEXP ARIMA_transPars(SEXP sin, SEXP sarma, SEXP strans); +SEXP ARIMA_Invtrans(SEXP in, SEXP sarma); +SEXP ARIMA_Gradtrans(SEXP in, SEXP sarma); +SEXP ARIMA_Like(SEXP sy, SEXP mod, SEXP sUP, SEXP giveResid); +SEXP ARIMA_CSS(SEXP sy, SEXP sarma, SEXP sPhi, SEXP sTheta, SEXP sncond, + SEXP giveResid); +SEXP TSconv(SEXP a, SEXP b); +SEXP getQ0(SEXP sPhi, SEXP sTheta); +SEXP getQ0bis(SEXP sPhi, SEXP sTheta, SEXP sTol); + +SEXP acf(SEXP x, SEXP lmax, SEXP sCor); +SEXP pacf1(SEXP acf, SEXP lmax); +SEXP ar2ma(SEXP ar, SEXP npsi); +SEXP Burg(SEXP x, SEXP order); +SEXP pp_sum(SEXP u, SEXP sl); +SEXP intgrt_vec(SEXP x, SEXP xi, SEXP slag); + +#endif diff --git a/com.oracle.truffle.r.native/gnur/patch/src/library/tools/src/gramRd.c b/com.oracle.truffle.r.native/gnur/patch/src/library/tools/src/gramRd.c new file mode 100644 index 0000000000000000000000000000000000000000..2f6d3df6608fe191f3a6bcdbcf3c841296134488 --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/library/tools/src/gramRd.c @@ -0,0 +1,4559 @@ +/* A Bison parser, made by GNU Bison 2.7.12-4996. */ + +/* Bison implementation for Yacc-like parsers in C + + Copyright (C) 1984, 1989-1990, 2000-2013 Free Software Foundation, Inc. + + This program 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 3 of the License, or + (at your option) any later version. + + This program 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 this program. If not, see <http://www.gnu.org/licenses/>. */ + +/* As a special exception, you may create a larger work that contains + part or all of the Bison parser skeleton and distribute that work + under terms of your choice, so long as that work isn't itself a + parser generator using the skeleton or a modified version thereof + as a parser skeleton. Alternatively, if you modify or redistribute + the parser skeleton itself, you may (at your option) remove this + special exception, which will cause the skeleton and the resulting + Bison output files to be licensed under the GNU General Public + License without this special exception. + + This special exception was added by the Free Software Foundation in + version 2.2 of Bison. */ + +/* C LALR(1) parser skeleton written by Richard Stallman, by + simplifying the original so-called "semantic" parser. */ + +/* All symbols defined below should begin with yy or YY, to avoid + infringing on user name space. This should be done even for local + variables, as they might otherwise be expanded by user macros. + There are some unavoidable exceptions within include files to + define necessary library symbols; they are noted "INFRINGES ON + USER NAME SPACE" below. */ + +/* Identify Bison output. */ +#define YYBISON 1 + +/* Bison version. */ +#define YYBISON_VERSION "2.7.12-4996" + +/* Skeleton name. */ +#define YYSKELETON_NAME "yacc.c" + +/* Pure parsers. */ +#define YYPURE 0 + +/* Push parsers. */ +#define YYPUSH 0 + +/* Pull parsers. */ +#define YYPULL 1 + + + + +/* Copy the first part of user declarations. */ + + +/* + * R : A Computer Langage for Statistical Data Analysis + * Copyright (C) 1995, 1996, 1997 Robert Gentleman and Ross Ihaka + * Copyright (C) 1997--2016 The R Core Team + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version. + * + * This program 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 this program; if not, a copy is available at + * https://www.R-project.org/Licenses/ + */ + +#ifdef HAVE_CONFIG_H +#include <config.h> +#endif + +#define R_USE_SIGNALS 1 +#include <Defn.h> +#include <Parse.h> +#define STRICT_R_HEADERS +#include <R_ext/RS.h> /* for R_chk_* allocation */ +#include <ctype.h> +#include <Rmath.h> /* for imax2(.),..*/ +#undef _ +#ifdef ENABLE_NLS +#include <libintl.h> +#define _(String) dgettext ("tools", String) +#else +#define _(String) (String) +#endif + +/* bison creates a non-static symbol yylloc in both gramLatex.o and gramRd.o, + so remap */ + +#define yylloc yyllocR + +#define DEBUGVALS 0 /* 1 causes detailed internal state output to R console */ +#define DEBUGMODE 0 /* 1 causes Bison output of parse state, to stdout or stderr */ + +static Rboolean wCalls = TRUE; +static Rboolean warnDups = FALSE; + +#define YYERROR_VERBOSE 1 + +static void yyerror(const char *); +static int yylex(); +static int yyparse(void); + +#define yyconst const + +typedef struct yyltype +{ + int first_line; + int first_column; + int first_byte; + + int last_line; + int last_column; + int last_byte; +} yyltype; + +# define YYLTYPE yyltype +# define YYLLOC_DEFAULT(Current, Rhs, N) \ + do \ + if (N) \ + { \ + (Current).first_line = YYRHSLOC (Rhs, 1).first_line; \ + (Current).first_column = YYRHSLOC (Rhs, 1).first_column; \ + (Current).first_byte = YYRHSLOC (Rhs, 1).first_byte; \ + (Current).last_line = YYRHSLOC (Rhs, N).last_line; \ + (Current).last_column = YYRHSLOC (Rhs, N).last_column; \ + (Current).last_byte = YYRHSLOC (Rhs, N).last_byte; \ + } \ + else \ + { \ + (Current).first_line = (Current).last_line = \ + YYRHSLOC (Rhs, 0).last_line; \ + (Current).first_column = (Current).last_column = \ + YYRHSLOC (Rhs, 0).last_column; \ + (Current).first_byte = (Current).last_byte = \ + YYRHSLOC (Rhs, 0).last_byte; \ + } \ + while (0) + +/* Useful defines so editors don't get confused ... */ + +#define LBRACE '{' +#define RBRACE '}' + +/* Functions used in the parsing process */ + +static SEXP GrowList(SEXP, SEXP); +static int KeywordLookup(const char *); +static SEXP UserMacroLookup(const char *); +static SEXP InstallKeywords(); +static SEXP NewList(void); +static SEXP makeSrcref(YYLTYPE *, SEXP); +static int xxgetc(); +static int xxungetc(int); + +/* Flags used to mark need for postprocessing in the dynamicFlag attribute */ + +#define STATIC 0 +#define HAS_IFDEF 1 +#define HAS_SEXPR 2 + +/* Internal lexer / parser state variables */ + +static char const yyunknown[] = "unknown macro"; /* our message, not bison's */ + + +typedef struct ParseState ParseState; +struct ParseState { + int xxinRString, xxQuoteLine, xxQuoteCol; + int xxinEqn; + int xxNewlineInString; + int xxlineno, xxbyteno, xxcolno; + int xxmode, xxitemType, xxbraceDepth; /* context for lexer */ + int xxDebugTokens; /* non-zero causes debug output to R console */ + const char* xxBasename; /* basename of file for error messages */ + SEXP Value; + int xxinitvalue; + SEXP xxMacroList;/* A hashed environment containing all the standard and user-defined macro names */ + ParseState *prevState; +}; + +static Rboolean busy = FALSE; +static ParseState parseState; + +#define RLIKE 1 /* Includes R strings; xxinRString holds the opening quote char, or 0 outside a string */ +#define LATEXLIKE 2 +#define VERBATIM 3 +#define INOPTION 4 +#define COMMENTMODE 5 /* only used in deparsing */ +#define UNKNOWNMODE 6 /* ditto */ + +static SEXP SrcFile; /* parse_Rd will *always* supply a srcfile */ + +/* Routines used to build the parse tree */ + +static SEXP xxpushMode(int, int, int); +static void xxpopMode(SEXP); +static SEXP xxnewlist(SEXP); +static SEXP xxnewlist2(SEXP, SEXP); +static SEXP xxnewlist3(SEXP, SEXP, SEXP); +static SEXP xxnewlist4(SEXP, SEXP, SEXP, SEXP); +static SEXP xxnewlist5(SEXP, SEXP, SEXP, SEXP, SEXP); +static SEXP xxnewlist6(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP); +static SEXP xxnewlist7(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP); +static SEXP xxnewlist8(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP); +static SEXP xxnewlist9(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP); + +static SEXP xxlist(SEXP, SEXP); +static SEXP xxmarkup(SEXP, SEXP, int, YYLTYPE *); +static SEXP xxmarkup2(SEXP, SEXP, SEXP, int, int, YYLTYPE *); +static SEXP xxmarkup3(SEXP, SEXP, SEXP, SEXP, int, YYLTYPE *); +static SEXP xxOptionmarkup(SEXP, SEXP, SEXP, int, YYLTYPE *); +static SEXP xxtag(SEXP, int, YYLTYPE *); +static void xxsavevalue(SEXP, YYLTYPE *); +static void xxWarnNewline(); +static SEXP xxnewcommand(SEXP, SEXP, SEXP, YYLTYPE *); +static SEXP xxusermacro(SEXP, SEXP, YYLTYPE *); +static int mkMarkup(int); +static int mkIfdef(int); +static int mkCode(int); +static int mkText(int); +static int mkVerb(int); +static int mkComment(int); + +#define YYSTYPE SEXP + + + + +# ifndef YY_NULL +# if defined __cplusplus && 201103L <= __cplusplus +# define YY_NULL nullptr +# else +# define YY_NULL 0 +# endif +# endif + +/* Enabling verbose error messages. */ +#ifdef YYERROR_VERBOSE +# undef YYERROR_VERBOSE +# define YYERROR_VERBOSE 1 +#else +# define YYERROR_VERBOSE 0 +#endif + + +/* Enabling traces. */ +#ifndef YYDEBUG +# define YYDEBUG 0 +#endif +#if YYDEBUG +extern int yydebug; +#endif + +/* Tokens. */ +#ifndef YYTOKENTYPE +# define YYTOKENTYPE + /* Put the tokens into the symbol table, so that GDB and other debuggers + know about them. */ + enum yytokentype { + END_OF_INPUT = 258, + ERROR = 259, + SECTIONHEADER = 260, + RSECTIONHEADER = 261, + VSECTIONHEADER = 262, + SECTIONHEADER2 = 263, + RCODEMACRO = 264, + SEXPR = 265, + RDOPTS = 266, + LATEXMACRO = 267, + VERBMACRO = 268, + OPTMACRO = 269, + ESCAPE = 270, + LISTSECTION = 271, + ITEMIZE = 272, + DESCRIPTION = 273, + NOITEM = 274, + LATEXMACRO2 = 275, + VERBMACRO2 = 276, + VERBLATEX = 277, + LATEXMACRO3 = 278, + NEWCOMMAND = 279, + USERMACRO = 280, + USERMACRO1 = 281, + USERMACRO2 = 282, + USERMACRO3 = 283, + USERMACRO4 = 284, + USERMACRO5 = 285, + USERMACRO6 = 286, + USERMACRO7 = 287, + USERMACRO8 = 288, + USERMACRO9 = 289, + IFDEF = 290, + ENDIF = 291, + TEXT = 292, + RCODE = 293, + VERB = 294, + COMMENT = 295, + UNKNOWN = 296, + STARTFILE = 297, + STARTFRAGMENT = 298 + }; +#endif +/* Tokens. */ +#define END_OF_INPUT 258 +#define ERROR 259 +#define SECTIONHEADER 260 +#define RSECTIONHEADER 261 +#define VSECTIONHEADER 262 +#define SECTIONHEADER2 263 +#define RCODEMACRO 264 +#define SEXPR 265 +#define RDOPTS 266 +#define LATEXMACRO 267 +#define VERBMACRO 268 +#define OPTMACRO 269 +#define ESCAPE 270 +#define LISTSECTION 271 +#define ITEMIZE 272 +#define DESCRIPTION 273 +#define NOITEM 274 +#define LATEXMACRO2 275 +#define VERBMACRO2 276 +#define VERBLATEX 277 +#define LATEXMACRO3 278 +#define NEWCOMMAND 279 +#define USERMACRO 280 +#define USERMACRO1 281 +#define USERMACRO2 282 +#define USERMACRO3 283 +#define USERMACRO4 284 +#define USERMACRO5 285 +#define USERMACRO6 286 +#define USERMACRO7 287 +#define USERMACRO8 288 +#define USERMACRO9 289 +#define IFDEF 290 +#define ENDIF 291 +#define TEXT 292 +#define RCODE 293 +#define VERB 294 +#define COMMENT 295 +#define UNKNOWN 296 +#define STARTFILE 297 +#define STARTFRAGMENT 298 + + + +#if ! defined YYSTYPE && ! defined YYSTYPE_IS_DECLARED +typedef int YYSTYPE; +# define YYSTYPE_IS_TRIVIAL 1 +# define yystype YYSTYPE /* obsolescent; will be withdrawn */ +# define YYSTYPE_IS_DECLARED 1 +#endif + +#if ! defined YYLTYPE && ! defined YYLTYPE_IS_DECLARED +typedef struct YYLTYPE +{ + int first_line; + int first_column; + int last_line; + int last_column; +} YYLTYPE; +# define yyltype YYLTYPE /* obsolescent; will be withdrawn */ +# define YYLTYPE_IS_DECLARED 1 +# define YYLTYPE_IS_TRIVIAL 1 +#endif + +extern YYSTYPE yylval; +extern YYLTYPE yylloc; +#ifdef YYPARSE_PARAM +#if defined __STDC__ || defined __cplusplus +int yyparse (void *YYPARSE_PARAM); +#else +int yyparse (); +#endif +#else /* ! YYPARSE_PARAM */ +#if defined __STDC__ || defined __cplusplus +int yyparse (void); +#else +int yyparse (); +#endif +#endif /* ! YYPARSE_PARAM */ + + + +/* Copy the second part of user declarations. */ + + + +#ifdef short +# undef short +#endif + +#ifdef YYTYPE_UINT8 +typedef YYTYPE_UINT8 yytype_uint8; +#else +typedef unsigned char yytype_uint8; +#endif + +#ifdef YYTYPE_INT8 +typedef YYTYPE_INT8 yytype_int8; +#elif (defined __STDC__ || defined __C99__FUNC__ \ + || defined __cplusplus || defined _MSC_VER) +typedef signed char yytype_int8; +#else +typedef short int yytype_int8; +#endif + +#ifdef YYTYPE_UINT16 +typedef YYTYPE_UINT16 yytype_uint16; +#else +typedef unsigned short int yytype_uint16; +#endif + +#ifdef YYTYPE_INT16 +typedef YYTYPE_INT16 yytype_int16; +#else +typedef short int yytype_int16; +#endif + +#ifndef YYSIZE_T +# ifdef __SIZE_TYPE__ +# define YYSIZE_T __SIZE_TYPE__ +# elif defined size_t +# define YYSIZE_T size_t +# elif ! defined YYSIZE_T && (defined __STDC__ || defined __C99__FUNC__ \ + || defined __cplusplus || defined _MSC_VER) +# include <stddef.h> /* INFRINGES ON USER NAME SPACE */ +# define YYSIZE_T size_t +# else +# define YYSIZE_T unsigned int +# endif +#endif + +#define YYSIZE_MAXIMUM ((YYSIZE_T) -1) + +#ifndef YY_ +# if defined YYENABLE_NLS && YYENABLE_NLS +# if ENABLE_NLS +# include <libintl.h> /* INFRINGES ON USER NAME SPACE */ +# define YY_(Msgid) dgettext ("bison-runtime", Msgid) +# endif +# endif +# ifndef YY_ +# define YY_(Msgid) Msgid +# endif +#endif + +#ifndef __attribute__ +/* This feature is available in gcc versions 2.5 and later. */ +# if (! defined __GNUC__ || __GNUC__ < 2 \ + || (__GNUC__ == 2 && __GNUC_MINOR__ < 5)) +# define __attribute__(Spec) /* empty */ +# endif +#endif + +/* Suppress unused-variable warnings by "using" E. */ +#if ! defined lint || defined __GNUC__ +# define YYUSE(E) ((void) (E)) +#else +# define YYUSE(E) /* empty */ +#endif + + +/* Identity function, used to suppress warnings about constant conditions. */ +#ifndef lint +# define YYID(N) (N) +#else +#if (defined __STDC__ || defined __C99__FUNC__ \ + || defined __cplusplus || defined _MSC_VER) +static int +YYID (int yyi) +#else +static int +YYID (yyi) + int yyi; +#endif +{ + return yyi; +} +#endif + +#if ! defined yyoverflow || YYERROR_VERBOSE + +/* The parser invokes alloca or malloc; define the necessary symbols. */ + +# ifdef YYSTACK_USE_ALLOCA +# if YYSTACK_USE_ALLOCA +# ifdef __GNUC__ +# define YYSTACK_ALLOC __builtin_alloca +# elif defined __BUILTIN_VA_ARG_INCR +# include <alloca.h> /* INFRINGES ON USER NAME SPACE */ +# elif defined _AIX +# define YYSTACK_ALLOC __alloca +# elif defined _MSC_VER +# include <malloc.h> /* INFRINGES ON USER NAME SPACE */ +# define alloca _alloca +# else +# define YYSTACK_ALLOC alloca +# if ! defined _ALLOCA_H && ! defined EXIT_SUCCESS && (defined __STDC__ || defined __C99__FUNC__ \ + || defined __cplusplus || defined _MSC_VER) +# include <stdlib.h> /* INFRINGES ON USER NAME SPACE */ + /* Use EXIT_SUCCESS as a witness for stdlib.h. */ +# ifndef EXIT_SUCCESS +# define EXIT_SUCCESS 0 +# endif +# endif +# endif +# endif +# endif + +# ifdef YYSTACK_ALLOC + /* Pacify GCC's `empty if-body' warning. */ +# define YYSTACK_FREE(Ptr) do { /* empty */; } while (YYID (0)) +# ifndef YYSTACK_ALLOC_MAXIMUM + /* The OS might guarantee only one guard page at the bottom of the stack, + and a page size can be as small as 4096 bytes. So we cannot safely + invoke alloca (N) if N exceeds 4096. Use a slightly smaller number + to allow for a few compiler-allocated temporary stack slots. */ +# define YYSTACK_ALLOC_MAXIMUM 4032 /* reasonable circa 2006 */ +# endif +# else +# define YYSTACK_ALLOC YYMALLOC +# define YYSTACK_FREE YYFREE +# ifndef YYSTACK_ALLOC_MAXIMUM +# define YYSTACK_ALLOC_MAXIMUM YYSIZE_MAXIMUM +# endif +# if (defined __cplusplus && ! defined EXIT_SUCCESS \ + && ! ((defined YYMALLOC || defined malloc) \ + && (defined YYFREE || defined free))) +# include <stdlib.h> /* INFRINGES ON USER NAME SPACE */ +# ifndef EXIT_SUCCESS +# define EXIT_SUCCESS 0 +# endif +# endif +# ifndef YYMALLOC +# define YYMALLOC malloc +# if ! defined malloc && ! defined EXIT_SUCCESS && (defined __STDC__ || defined __C99__FUNC__ \ + || defined __cplusplus || defined _MSC_VER) +void *malloc (YYSIZE_T); /* INFRINGES ON USER NAME SPACE */ +# endif +# endif +# ifndef YYFREE +# define YYFREE free +# if ! defined free && ! defined EXIT_SUCCESS && (defined __STDC__ || defined __C99__FUNC__ \ + || defined __cplusplus || defined _MSC_VER) +void free (void *); /* INFRINGES ON USER NAME SPACE */ +# endif +# endif +# endif +#endif /* ! defined yyoverflow || YYERROR_VERBOSE */ + + +#if (! defined yyoverflow \ + && (! defined __cplusplus \ + || (defined YYLTYPE_IS_TRIVIAL && YYLTYPE_IS_TRIVIAL \ + && defined YYSTYPE_IS_TRIVIAL && YYSTYPE_IS_TRIVIAL))) + +/* A type that is properly aligned for any stack member. */ +union yyalloc +{ + yytype_int16 yyss_alloc; + YYSTYPE yyvs_alloc; + YYLTYPE yyls_alloc; +}; + +/* The size of the maximum gap between one aligned stack and the next. */ +# define YYSTACK_GAP_MAXIMUM (sizeof (union yyalloc) - 1) + +/* The size of an array large to enough to hold all stacks, each with + N elements. */ +# define YYSTACK_BYTES(N) \ + ((N) * (sizeof (yytype_int16) + sizeof (YYSTYPE) + sizeof (YYLTYPE)) \ + + 2 * YYSTACK_GAP_MAXIMUM) + +# define YYCOPY_NEEDED 1 + +/* Relocate STACK from its old location to the new one. The + local variables YYSIZE and YYSTACKSIZE give the old and new number of + elements in the stack, and YYPTR gives the new location of the + stack. Advance YYPTR to a properly aligned location for the next + stack. */ +# define YYSTACK_RELOCATE(Stack_alloc, Stack) \ + do \ + { \ + YYSIZE_T yynewbytes; \ + YYCOPY (&yyptr->Stack_alloc, Stack, yysize); \ + Stack = &yyptr->Stack_alloc; \ + yynewbytes = yystacksize * sizeof (*Stack) + YYSTACK_GAP_MAXIMUM; \ + yyptr += yynewbytes / sizeof (*yyptr); \ + } \ + while (YYID (0)) + +#endif + +#if defined YYCOPY_NEEDED && YYCOPY_NEEDED +/* Copy COUNT objects from SRC to DST. The source and destination do + not overlap. */ +# ifndef YYCOPY +# if defined __GNUC__ && 1 < __GNUC__ +# define YYCOPY(Dst, Src, Count) \ + __builtin_memcpy (Dst, Src, (Count) * sizeof (*(Src))) +# else +# define YYCOPY(Dst, Src, Count) \ + do \ + { \ + YYSIZE_T yyi; \ + for (yyi = 0; yyi < (Count); yyi++) \ + (Dst)[yyi] = (Src)[yyi]; \ + } \ + while (YYID (0)) +# endif +# endif +#endif /* !YYCOPY_NEEDED */ + +/* YYFINAL -- State number of the termination state. */ +#define YYFINAL 33 +/* YYLAST -- Last index in YYTABLE. */ +#define YYLAST 832 + +/* YYNTOKENS -- Number of terminals. */ +#define YYNTOKENS 48 +/* YYNNTS -- Number of nonterminals. */ +#define YYNNTS 31 +/* YYNRULES -- Number of rules. */ +#define YYNRULES 89 +/* YYNRULES -- Number of states. */ +#define YYNSTATES 194 + +/* YYTRANSLATE(YYLEX) -- Bison symbol number corresponding to YYLEX. */ +#define YYUNDEFTOK 2 +#define YYMAXUTOK 298 + +#define YYTRANSLATE(YYX) \ + ((unsigned int) (YYX) <= YYMAXUTOK ? yytranslate[YYX] : YYUNDEFTOK) + +/* YYTRANSLATE[YYLEX] -- Bison symbol number corresponding to YYLEX. */ +static const yytype_uint8 yytranslate[] = +{ + 0, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 46, 2, 47, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 44, 2, 45, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 1, 2, 3, 4, + 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, + 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, + 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, + 35, 36, 37, 38, 39, 40, 41, 42, 43 +}; + +#if YYDEBUG +/* YYPRHS[YYN] -- Index of the first RHS symbol of rule number YYN in + YYRHS. */ +static const yytype_uint16 yyprhs[] = +{ + 0, 0, 3, 7, 11, 13, 16, 18, 20, 23, + 26, 29, 32, 35, 38, 42, 47, 52, 56, 61, + 63, 65, 67, 70, 72, 75, 77, 79, 81, 83, + 85, 87, 89, 91, 94, 97, 101, 106, 109, 112, + 116, 121, 124, 128, 133, 136, 139, 143, 145, 150, + 155, 159, 163, 165, 168, 172, 177, 183, 190, 198, + 208, 219, 231, 234, 237, 240, 243, 246, 249, 254, + 258, 261, 264, 269, 273, 276, 277, 278, 279, 280, + 281, 282, 283, 284, 285, 289, 292, 297, 301, 306 +}; + +/* YYRHS -- A `-1'-separated list of the rules' RHS. */ +static const yytype_int8 yyrhs[] = +{ + 49, 0, -1, 42, 51, 3, -1, 43, 50, 3, + -1, 1, -1, 68, 54, -1, 52, -1, 53, -1, + 52, 53, -1, 7, 64, -1, 11, 64, -1, 6, + 62, -1, 5, 58, -1, 16, 61, -1, 8, 58, + 59, -1, 35, 67, 52, 36, -1, 35, 67, 52, + 1, -1, 10, 71, 63, -1, 10, 71, 78, 63, + -1, 40, -1, 37, -1, 57, -1, 1, 53, -1, + 55, -1, 54, 55, -1, 37, -1, 38, -1, 39, + -1, 40, -1, 41, -1, 77, -1, 56, -1, 57, + -1, 1, 55, -1, 12, 58, -1, 20, 58, 59, + -1, 23, 58, 59, 59, -1, 17, 60, -1, 18, + 61, -1, 14, 71, 58, -1, 14, 71, 78, 58, + -1, 9, 62, -1, 10, 71, 63, -1, 10, 71, + 78, 63, -1, 13, 64, -1, 21, 65, -1, 21, + 65, 66, -1, 15, -1, 35, 67, 54, 36, -1, + 35, 67, 54, 1, -1, 22, 64, 59, -1, 24, + 65, 64, -1, 25, -1, 26, 64, -1, 27, 64, + 64, -1, 28, 64, 64, 64, -1, 29, 64, 64, + 64, 64, -1, 30, 64, 64, 64, 64, 64, -1, + 31, 64, 64, 64, 64, 64, 64, -1, 32, 64, + 64, 64, 64, 64, 64, 64, 64, -1, 33, 64, + 64, 64, 64, 64, 64, 64, 64, 64, -1, 34, + 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, + -1, 68, 77, -1, 68, 77, -1, 68, 37, -1, + 75, 77, -1, 76, 77, -1, 69, 77, -1, 44, + 70, 54, 45, -1, 44, 70, 45, -1, 72, 77, + -1, 73, 77, -1, 44, 74, 54, 45, -1, 44, + 74, 45, -1, 68, 37, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, 44, 54, 45, -1, 44, + 45, -1, 44, 54, 1, 45, -1, 44, 1, 45, + -1, 44, 54, 1, 3, -1, 46, 55, 47, -1 +}; + +/* YYRLINE[YYN] -- source line where rule number YYN was defined. */ +static const yytype_uint16 yyrline[] = +{ + 0, 214, 214, 215, 216, 219, 222, 225, 226, 228, + 229, 230, 231, 232, 233, 234, 235, 236, 237, 238, + 239, 240, 241, 243, 244, 246, 247, 248, 249, 250, + 251, 252, 253, 254, 256, 257, 258, 259, 260, 261, + 262, 263, 264, 265, 266, 267, 268, 269, 270, 271, + 272, 274, 275, 276, 277, 279, 281, 283, 285, 287, + 290, 293, 298, 300, 301, 310, 312, 314, 318, 319, + 321, 323, 327, 328, 330, 333, 335, 337, 339, 341, + 343, 345, 347, 349, 351, 352, 353, 354, 355, 357 +}; +#endif + +#if YYDEBUG || YYERROR_VERBOSE || 0 +/* YYTNAME[SYMBOL-NUM] -- String name of the symbol SYMBOL-NUM. + First, the terminals, then, starting at YYNTOKENS, nonterminals. */ +static const char *const yytname[] = +{ + "$end", "error", "$undefined", "END_OF_INPUT", "ERROR", "SECTIONHEADER", + "RSECTIONHEADER", "VSECTIONHEADER", "SECTIONHEADER2", "RCODEMACRO", + "SEXPR", "RDOPTS", "LATEXMACRO", "VERBMACRO", "OPTMACRO", "ESCAPE", + "LISTSECTION", "ITEMIZE", "DESCRIPTION", "NOITEM", "LATEXMACRO2", + "VERBMACRO2", "VERBLATEX", "LATEXMACRO3", "NEWCOMMAND", "USERMACRO", + "USERMACRO1", "USERMACRO2", "USERMACRO3", "USERMACRO4", "USERMACRO5", + "USERMACRO6", "USERMACRO7", "USERMACRO8", "USERMACRO9", "IFDEF", "ENDIF", + "TEXT", "RCODE", "VERB", "COMMENT", "UNKNOWN", "STARTFILE", + "STARTFRAGMENT", "'{'", "'}'", "'['", "']'", "$accept", "Init", + "RdFragment", "RdFile", "SectionList", "Section", "ArgItems", "Item", + "Markup", "UserMacro", "LatexArg", "LatexArg2", "Item0Arg", "Item2Arg", + "RLikeArg", "RLikeArg2", "VerbatimArg", "VerbatimArg1", "VerbatimArg2", + "IfDefTarget", "goLatexLike", "goRLike", "goRLike2", "goOption", + "goVerbatim", "goVerbatim1", "goVerbatim2", "goItem0", "goItem2", "Arg", + "Option", YY_NULL +}; +#endif + +# ifdef YYPRINT +/* YYTOKNUM[YYLEX-NUM] -- Internal token number corresponding to + token YYLEX-NUM. */ +static const yytype_uint16 yytoknum[] = +{ + 0, 256, 257, 258, 259, 260, 261, 262, 263, 264, + 265, 266, 267, 268, 269, 270, 271, 272, 273, 274, + 275, 276, 277, 278, 279, 280, 281, 282, 283, 284, + 285, 286, 287, 288, 289, 290, 291, 292, 293, 294, + 295, 296, 297, 298, 123, 125, 91, 93 +}; +# endif + +/* YYR1[YYN] -- Symbol number of symbol that rule YYN derives. */ +static const yytype_uint8 yyr1[] = +{ + 0, 48, 49, 49, 49, 50, 51, 52, 52, 53, + 53, 53, 53, 53, 53, 53, 53, 53, 53, 53, + 53, 53, 53, 54, 54, 55, 55, 55, 55, 55, + 55, 55, 55, 55, 56, 56, 56, 56, 56, 56, + 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, + 56, 57, 57, 57, 57, 57, 57, 57, 57, 57, + 57, 57, 58, 59, 59, 60, 61, 62, 63, 63, + 64, 65, 66, 66, 67, 68, 69, 70, 71, 72, + 73, 74, 75, 76, 77, 77, 77, 77, 77, 78 +}; + +/* YYR2[YYN] -- Number of symbols composing right hand side of rule YYN. */ +static const yytype_uint8 yyr2[] = +{ + 0, 2, 3, 3, 1, 2, 1, 1, 2, 2, + 2, 2, 2, 2, 3, 4, 4, 3, 4, 1, + 1, 1, 2, 1, 2, 1, 1, 1, 1, 1, + 1, 1, 1, 2, 2, 3, 4, 2, 2, 3, + 4, 2, 3, 4, 2, 2, 3, 1, 4, 4, + 3, 3, 1, 2, 3, 4, 5, 6, 7, 9, + 10, 11, 2, 2, 2, 2, 2, 2, 4, 3, + 2, 2, 4, 3, 2, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 3, 2, 4, 3, 4, 3 +}; + +/* YYDEFACT[STATE-NAME] -- Default reduction number in state STATE-NUM. + Performed when YYTABLE doesn't specify something else to do. Zero + means the default is an error. */ +static const yytype_uint8 yydefact[] = +{ + 0, 4, 0, 75, 0, 0, 75, 76, 79, 75, + 78, 79, 83, 80, 52, 79, 79, 79, 79, 79, + 79, 79, 79, 79, 75, 20, 19, 0, 0, 7, + 21, 0, 0, 1, 22, 12, 0, 11, 0, 9, + 0, 75, 0, 10, 13, 0, 79, 0, 53, 79, + 79, 79, 79, 79, 79, 79, 79, 0, 0, 2, + 8, 3, 0, 76, 78, 75, 79, 78, 47, 82, + 83, 75, 80, 79, 75, 75, 25, 26, 27, 28, + 29, 0, 0, 23, 31, 32, 30, 62, 67, 70, + 14, 0, 77, 0, 17, 0, 66, 51, 71, 54, + 79, 79, 79, 79, 79, 79, 79, 0, 74, 33, + 41, 0, 34, 44, 75, 37, 0, 38, 75, 45, + 75, 75, 0, 0, 85, 0, 24, 64, 63, 0, + 0, 18, 55, 79, 79, 79, 79, 79, 79, 0, + 15, 42, 0, 39, 75, 65, 35, 81, 46, 50, + 75, 0, 87, 0, 84, 69, 0, 89, 56, 79, + 79, 79, 79, 79, 43, 40, 0, 36, 0, 48, + 88, 86, 68, 57, 79, 79, 79, 79, 73, 0, + 58, 79, 79, 79, 72, 79, 79, 79, 59, 79, + 79, 60, 79, 61 +}; + +/* YYDEFGOTO[NTERM-NUM]. */ +static const yytype_int16 yydefgoto[] = +{ + -1, 4, 31, 27, 28, 29, 82, 83, 84, 85, + 35, 90, 115, 44, 37, 94, 39, 46, 148, 57, + 36, 38, 129, 42, 40, 47, 166, 116, 45, 86, + 95 +}; + +/* YYPACT[STATE-NUM] -- Index in YYTABLE of the portion describing + STATE-NUM. */ +#define YYPACT_NINF -94 +static const yytype_int16 yypact[] = +{ + 28, -94, 792, -94, 20, 792, -94, -94, -94, -94, + -94, -94, -94, -94, -94, -94, -94, -94, -94, -94, + -94, -94, -94, -94, -94, -94, -94, 29, 718, -94, + -94, 34, 638, -94, -94, -94, -19, -94, -19, -94, + -19, -94, -30, -94, -94, -19, -94, -19, -94, -94, + -94, -94, -94, -94, -94, -94, -94, 792, -6, -94, + -94, -94, 638, -94, -94, -94, -94, -94, -94, -94, + -94, -94, -94, -94, -94, -94, -94, -94, -94, -94, + -94, 265, 556, -94, -94, -94, -94, -94, -94, -94, + -94, -22, -94, 638, -94, 2, -94, -94, -94, -94, + -94, -94, -94, -94, -94, -94, -94, 755, -94, -94, + -94, -30, -94, -94, 1, -94, -19, -94, -94, 4, + -94, -94, 638, 306, -94, 347, -94, -94, -94, 388, + 7, -94, -94, -94, -94, -94, -94, -94, -94, 680, + -94, -94, 2, -94, -94, -94, -94, -94, -94, -94, + -94, 597, -94, 224, -94, -94, 429, -94, -94, -94, + -94, -94, -94, -94, -94, -94, 470, -94, 179, -94, + -94, -94, -94, -94, -94, -94, -94, -94, -94, 511, + -94, -94, -94, -94, -94, -94, -94, -94, -94, -94, + -94, -94, -94, -94 +}; + +/* YYPGOTO[NTERM-NUM]. */ +static const yytype_int8 yypgoto[] = +{ + -94, -94, -94, -94, 3, -2, -64, -10, -94, 22, + -8, -43, -94, -9, -4, -93, -11, -5, -94, -7, + 10, -94, -94, -31, -94, -94, -94, -94, -94, -17, + -58 +}; + +/* YYTABLE[YYPACT[STATE-NUM]]. What to do in state STATE-NUM. If + positive, shift that token. If negative, reduce the rule which + number is the opposite. If YYTABLE_NINF, syntax error. */ +#define YYTABLE_NINF -50 +static const yytype_int16 yytable[] = +{ + 43, 41, 131, 34, 48, 49, 50, 51, 52, 53, + 54, 55, 56, 32, 92, 127, 93, 125, 141, 87, + 33, 88, 81, 89, 30, 81, 60, 30, 96, 1, + 98, 108, 59, 111, 58, 97, 114, 61, 99, 100, + 101, 102, 103, 104, 105, 106, 92, 93, 147, 164, + 30, 91, 109, 142, 157, 113, 144, 112, 151, 110, + 107, 117, 120, 118, 0, 156, 121, 119, 122, 0, + 2, 3, 126, 0, 128, 146, 0, 149, 150, 30, + 0, 0, 0, 130, 0, 58, 0, 0, 0, 132, + 133, 134, 135, 136, 137, 138, 0, 0, 0, 145, + 0, 0, 179, 0, 0, 60, 143, 167, 0, 0, + 0, 0, 0, 109, 0, 126, 0, 0, 0, 0, + 0, 0, 158, 159, 160, 161, 162, 163, 91, 30, + 91, 91, 0, 0, 0, 0, 165, 34, 0, 0, + 0, 126, 0, 109, 0, 0, 126, 0, 173, 174, + 175, 176, 177, 0, 0, 0, 0, 0, 109, 0, + 91, 30, 0, 180, 181, 182, 183, 0, 0, 126, + 185, 186, 187, 0, 188, 189, 190, 0, 191, 192, + 62, 193, -49, 0, 0, 0, 0, 0, 63, 64, + 0, 65, 66, 67, 68, 0, 69, 70, 0, 71, + 72, 73, 74, 13, 14, 15, 16, 17, 18, 19, + 20, 21, 22, 23, 75, -49, 76, 77, 78, 79, + 80, 0, 0, 81, -49, 62, -49, 170, 0, 0, + 0, 0, 0, 63, 64, 0, 65, 66, 67, 68, + 0, 69, 70, 0, 71, 72, 73, 74, 13, 14, + 15, 16, 17, 18, 19, 20, 21, 22, 23, 75, + 0, 76, 77, 78, 79, 80, 123, 0, 81, 171, + 0, 0, 0, 0, 63, 64, 0, 65, 66, 67, + 68, 0, 69, 70, 0, 71, 72, 73, 74, 13, + 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, + 75, 0, 76, 77, 78, 79, 80, 62, 0, 81, + 124, 0, 0, 0, 0, 63, 64, 0, 65, 66, + 67, 68, 0, 69, 70, 0, 71, 72, 73, 74, + 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, + 23, 75, 0, 76, 77, 78, 79, 80, 153, 0, + 81, 152, 0, 0, 0, 0, 63, 64, 0, 65, + 66, 67, 68, 0, 69, 70, 0, 71, 72, 73, + 74, 13, 14, 15, 16, 17, 18, 19, 20, 21, + 22, 23, 75, 0, 76, 77, 78, 79, 80, 62, + 0, 81, 154, 0, 0, 0, 0, 63, 64, 0, + 65, 66, 67, 68, 0, 69, 70, 0, 71, 72, + 73, 74, 13, 14, 15, 16, 17, 18, 19, 20, + 21, 22, 23, 75, 0, 76, 77, 78, 79, 80, + 62, 0, 81, 155, 0, 0, 0, 0, 63, 64, + 0, 65, 66, 67, 68, 0, 69, 70, 0, 71, + 72, 73, 74, 13, 14, 15, 16, 17, 18, 19, + 20, 21, 22, 23, 75, 0, 76, 77, 78, 79, + 80, 62, 0, 81, 172, 0, 0, 0, 0, 63, + 64, 0, 65, 66, 67, 68, 0, 69, 70, 0, + 71, 72, 73, 74, 13, 14, 15, 16, 17, 18, + 19, 20, 21, 22, 23, 75, 0, 76, 77, 78, + 79, 80, 62, 0, 81, 178, 0, 0, 0, 0, + 63, 64, 0, 65, 66, 67, 68, 0, 69, 70, + 0, 71, 72, 73, 74, 13, 14, 15, 16, 17, + 18, 19, 20, 21, 22, 23, 75, 0, 76, 77, + 78, 79, 80, 0, 0, 81, 184, 62, 0, -5, + 0, 0, 0, 0, 0, 63, 64, 0, 65, 66, + 67, 68, 0, 69, 70, 0, 71, 72, 73, 74, + 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, + 23, 75, 0, 76, 77, 78, 79, 80, 168, 0, + 81, 0, 0, 0, 0, 0, 63, 64, 0, 65, + 66, 67, 68, 0, 69, 70, 0, 71, 72, 73, + 74, 13, 14, 15, 16, 17, 18, 19, 20, 21, + 22, 23, 75, 169, 76, 77, 78, 79, 80, 62, + 0, 81, 0, 0, 0, 0, 0, 63, 64, 0, + 65, 66, 67, 68, 0, 69, 70, 0, 71, 72, + 73, 74, 13, 14, 15, 16, 17, 18, 19, 20, + 21, 22, 23, 75, 0, 76, 77, 78, 79, 80, + 0, 5, 81, -16, 0, 6, 7, 8, 9, 0, + 10, 11, 0, 0, 0, 0, 12, 0, 0, 0, + 0, 0, 0, 0, 13, 14, 15, 16, 17, 18, + 19, 20, 21, 22, 23, 24, -16, 25, 0, 5, + 26, -6, 0, 6, 7, 8, 9, 0, 10, 11, + 0, 0, 0, 0, 12, 0, 0, 0, 0, 0, + 0, 0, 13, 14, 15, 16, 17, 18, 19, 20, + 21, 22, 23, 24, 0, 25, 139, 0, 26, 0, + 6, 7, 8, 9, 0, 10, 11, 0, 0, 0, + 0, 12, 0, 0, 0, 0, 0, 0, 0, 13, + 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, + 24, 140, 25, 5, 0, 26, 0, 6, 7, 8, + 9, 0, 10, 11, 0, 0, 0, 0, 12, 0, + 0, 0, 0, 0, 0, 0, 13, 14, 15, 16, + 17, 18, 19, 20, 21, 22, 23, 24, 0, 25, + 0, 0, 26 +}; + +#define yypact_value_is_default(Yystate) \ + (!!((Yystate) == (-94))) + +#define yytable_value_is_error(Yytable_value) \ + YYID (0) + +static const yytype_int16 yycheck[] = +{ + 11, 9, 95, 5, 15, 16, 17, 18, 19, 20, + 21, 22, 23, 3, 44, 37, 46, 81, 111, 36, + 0, 38, 44, 40, 2, 44, 28, 5, 45, 1, + 47, 37, 3, 64, 24, 46, 67, 3, 49, 50, + 51, 52, 53, 54, 55, 56, 44, 46, 44, 142, + 28, 41, 62, 111, 47, 66, 114, 65, 122, 63, + 57, 70, 73, 71, -1, 129, 74, 72, 75, -1, + 42, 43, 82, -1, 91, 118, -1, 120, 121, 57, + -1, -1, -1, 93, -1, 75, -1, -1, -1, 100, + 101, 102, 103, 104, 105, 106, -1, -1, -1, 116, + -1, -1, 166, -1, -1, 107, 114, 150, -1, -1, + -1, -1, -1, 123, -1, 125, -1, -1, -1, -1, + -1, -1, 133, 134, 135, 136, 137, 138, 118, 107, + 120, 121, -1, -1, -1, -1, 144, 139, -1, -1, + -1, 151, -1, 153, -1, -1, 156, -1, 159, 160, + 161, 162, 163, -1, -1, -1, -1, -1, 168, -1, + 150, 139, -1, 174, 175, 176, 177, -1, -1, 179, + 181, 182, 183, -1, 185, 186, 187, -1, 189, 190, + 1, 192, 3, -1, -1, -1, -1, -1, 9, 10, + -1, 12, 13, 14, 15, -1, 17, 18, -1, 20, + 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, + 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, + 41, -1, -1, 44, 45, 1, 47, 3, -1, -1, + -1, -1, -1, 9, 10, -1, 12, 13, 14, 15, + -1, 17, 18, -1, 20, 21, 22, 23, 24, 25, + 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, + -1, 37, 38, 39, 40, 41, 1, -1, 44, 45, + -1, -1, -1, -1, 9, 10, -1, 12, 13, 14, + 15, -1, 17, 18, -1, 20, 21, 22, 23, 24, + 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, + 35, -1, 37, 38, 39, 40, 41, 1, -1, 44, + 45, -1, -1, -1, -1, 9, 10, -1, 12, 13, + 14, 15, -1, 17, 18, -1, 20, 21, 22, 23, + 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, + 34, 35, -1, 37, 38, 39, 40, 41, 1, -1, + 44, 45, -1, -1, -1, -1, 9, 10, -1, 12, + 13, 14, 15, -1, 17, 18, -1, 20, 21, 22, + 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, + 33, 34, 35, -1, 37, 38, 39, 40, 41, 1, + -1, 44, 45, -1, -1, -1, -1, 9, 10, -1, + 12, 13, 14, 15, -1, 17, 18, -1, 20, 21, + 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, + 32, 33, 34, 35, -1, 37, 38, 39, 40, 41, + 1, -1, 44, 45, -1, -1, -1, -1, 9, 10, + -1, 12, 13, 14, 15, -1, 17, 18, -1, 20, + 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, + 31, 32, 33, 34, 35, -1, 37, 38, 39, 40, + 41, 1, -1, 44, 45, -1, -1, -1, -1, 9, + 10, -1, 12, 13, 14, 15, -1, 17, 18, -1, + 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, + 30, 31, 32, 33, 34, 35, -1, 37, 38, 39, + 40, 41, 1, -1, 44, 45, -1, -1, -1, -1, + 9, 10, -1, 12, 13, 14, 15, -1, 17, 18, + -1, 20, 21, 22, 23, 24, 25, 26, 27, 28, + 29, 30, 31, 32, 33, 34, 35, -1, 37, 38, + 39, 40, 41, -1, -1, 44, 45, 1, -1, 3, + -1, -1, -1, -1, -1, 9, 10, -1, 12, 13, + 14, 15, -1, 17, 18, -1, 20, 21, 22, 23, + 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, + 34, 35, -1, 37, 38, 39, 40, 41, 1, -1, + 44, -1, -1, -1, -1, -1, 9, 10, -1, 12, + 13, 14, 15, -1, 17, 18, -1, 20, 21, 22, + 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, + 33, 34, 35, 36, 37, 38, 39, 40, 41, 1, + -1, 44, -1, -1, -1, -1, -1, 9, 10, -1, + 12, 13, 14, 15, -1, 17, 18, -1, 20, 21, + 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, + 32, 33, 34, 35, -1, 37, 38, 39, 40, 41, + -1, 1, 44, 3, -1, 5, 6, 7, 8, -1, + 10, 11, -1, -1, -1, -1, 16, -1, -1, -1, + -1, -1, -1, -1, 24, 25, 26, 27, 28, 29, + 30, 31, 32, 33, 34, 35, 36, 37, -1, 1, + 40, 3, -1, 5, 6, 7, 8, -1, 10, 11, + -1, -1, -1, -1, 16, -1, -1, -1, -1, -1, + -1, -1, 24, 25, 26, 27, 28, 29, 30, 31, + 32, 33, 34, 35, -1, 37, 1, -1, 40, -1, + 5, 6, 7, 8, -1, 10, 11, -1, -1, -1, + -1, 16, -1, -1, -1, -1, -1, -1, -1, 24, + 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, + 35, 36, 37, 1, -1, 40, -1, 5, 6, 7, + 8, -1, 10, 11, -1, -1, -1, -1, 16, -1, + -1, -1, -1, -1, -1, -1, 24, 25, 26, 27, + 28, 29, 30, 31, 32, 33, 34, 35, -1, 37, + -1, -1, 40 +}; + +/* YYSTOS[STATE-NUM] -- The (internal number of the) accessing + symbol of state STATE-NUM. */ +static const yytype_uint8 yystos[] = +{ + 0, 1, 42, 43, 49, 1, 5, 6, 7, 8, + 10, 11, 16, 24, 25, 26, 27, 28, 29, 30, + 31, 32, 33, 34, 35, 37, 40, 51, 52, 53, + 57, 50, 68, 0, 53, 58, 68, 62, 69, 64, + 72, 58, 71, 64, 61, 76, 65, 73, 64, 64, + 64, 64, 64, 64, 64, 64, 64, 67, 68, 3, + 53, 3, 1, 9, 10, 12, 13, 14, 15, 17, + 18, 20, 21, 22, 23, 35, 37, 38, 39, 40, + 41, 44, 54, 55, 56, 57, 77, 77, 77, 77, + 59, 68, 44, 46, 63, 78, 77, 64, 77, 64, + 64, 64, 64, 64, 64, 64, 64, 52, 37, 55, + 62, 71, 58, 64, 71, 60, 75, 61, 58, 65, + 64, 58, 67, 1, 45, 54, 55, 37, 77, 70, + 55, 63, 64, 64, 64, 64, 64, 64, 64, 1, + 36, 63, 78, 58, 78, 77, 59, 44, 66, 59, + 59, 54, 45, 1, 45, 45, 54, 47, 64, 64, + 64, 64, 64, 64, 63, 58, 74, 59, 1, 36, + 3, 45, 45, 64, 64, 64, 64, 64, 45, 54, + 64, 64, 64, 64, 45, 64, 64, 64, 64, 64, + 64, 64, 64, 64 +}; + +#define yyerrok (yyerrstatus = 0) +#define yyclearin (yychar = YYEMPTY) +#define YYEMPTY (-2) +#define YYEOF 0 + +#define YYACCEPT goto yyacceptlab +#define YYABORT goto yyabortlab +#define YYERROR goto yyerrorlab + + +/* Like YYERROR except do call yyerror. This remains here temporarily + to ease the transition to the new meaning of YYERROR, for GCC. + Once GCC version 2 has supplanted version 1, this can go. However, + YYFAIL appears to be in use. Nevertheless, it is formally deprecated + in Bison 2.4.2's NEWS entry, where a plan to phase it out is + discussed. */ + +#define YYFAIL goto yyerrlab +#if defined YYFAIL + /* This is here to suppress warnings from the GCC cpp's + -Wunused-macros. Normally we don't worry about that warning, but + some users do, and we want to make it easy for users to remove + YYFAIL uses, which will produce warnings from Bison 2.5. */ +#endif + +#define YYRECOVERING() (!!yyerrstatus) + +#define YYBACKUP(Token, Value) \ +do \ + if (yychar == YYEMPTY) \ + { \ + yychar = (Token); \ + yylval = (Value); \ + YYPOPSTACK (yylen); \ + yystate = *yyssp; \ + goto yybackup; \ + } \ + else \ + { \ + yyerror (YY_("syntax error: cannot back up")); \ + YYERROR; \ + } \ +while (YYID (0)) + +/* Error token number */ +#define YYTERROR 1 +#define YYERRCODE 256 + + +/* YYLLOC_DEFAULT -- Set CURRENT to span from RHS[1] to RHS[N]. + If N is 0, then set CURRENT to the empty location which ends + the previous symbol: RHS[0] (always defined). */ + +#ifndef YYLLOC_DEFAULT +# define YYLLOC_DEFAULT(Current, Rhs, N) \ + do \ + if (YYID (N)) \ + { \ + (Current).first_line = YYRHSLOC (Rhs, 1).first_line; \ + (Current).first_column = YYRHSLOC (Rhs, 1).first_column; \ + (Current).last_line = YYRHSLOC (Rhs, N).last_line; \ + (Current).last_column = YYRHSLOC (Rhs, N).last_column; \ + } \ + else \ + { \ + (Current).first_line = (Current).last_line = \ + YYRHSLOC (Rhs, 0).last_line; \ + (Current).first_column = (Current).last_column = \ + YYRHSLOC (Rhs, 0).last_column; \ + } \ + while (YYID (0)) +#endif + +#define YYRHSLOC(Rhs, K) ((Rhs)[K]) + + +/* YY_LOCATION_PRINT -- Print the location on the stream. + This macro was not mandated originally: define only if we know + we won't break user code: when these are the locations we know. */ + +#ifndef YY_LOCATION_PRINT +# if defined YYLTYPE_IS_TRIVIAL && YYLTYPE_IS_TRIVIAL + +/* Print *YYLOCP on YYO. Private, do not rely on its existence. */ + +__attribute__((__unused__)) +#if (defined __STDC__ || defined __C99__FUNC__ \ + || defined __cplusplus || defined _MSC_VER) +static unsigned +yy_location_print_ (FILE *yyo, YYLTYPE const * const yylocp) +#else +static unsigned +yy_location_print_ (yyo, yylocp) + FILE *yyo; + YYLTYPE const * const yylocp; +#endif +{ + unsigned res = 0; + int end_col = 0 != yylocp->last_column ? yylocp->last_column - 1 : 0; + if (0 <= yylocp->first_line) + { + res += fprintf (yyo, "%d", yylocp->first_line); + if (0 <= yylocp->first_column) + res += fprintf (yyo, ".%d", yylocp->first_column); + } + if (0 <= yylocp->last_line) + { + if (yylocp->first_line < yylocp->last_line) + { + res += fprintf (yyo, "-%d", yylocp->last_line); + if (0 <= end_col) + res += fprintf (yyo, ".%d", end_col); + } + else if (0 <= end_col && yylocp->first_column < end_col) + res += fprintf (yyo, "-%d", end_col); + } + return res; + } + +# define YY_LOCATION_PRINT(File, Loc) \ + yy_location_print_ (File, &(Loc)) + +# else +# define YY_LOCATION_PRINT(File, Loc) ((void) 0) +# endif +#endif + + +/* YYLEX -- calling `yylex' with the right arguments. */ +#ifdef YYLEX_PARAM +# define YYLEX yylex (YYLEX_PARAM) +#else +# define YYLEX yylex () +#endif + +/* Enable debugging if requested. */ +#if YYDEBUG + +# ifndef YYFPRINTF +# include <stdio.h> /* INFRINGES ON USER NAME SPACE */ +# define YYFPRINTF fprintf +# endif + +# define YYDPRINTF(Args) \ +do { \ + if (yydebug) \ + YYFPRINTF Args; \ +} while (YYID (0)) + +# define YY_SYMBOL_PRINT(Title, Type, Value, Location) \ +do { \ + if (yydebug) \ + { \ + YYFPRINTF (stderr, "%s ", Title); \ + yy_symbol_print (stderr, \ + Type, Value, Location); \ + YYFPRINTF (stderr, "\n"); \ + } \ +} while (YYID (0)) + + +/*--------------------------------. +| Print this symbol on YYOUTPUT. | +`--------------------------------*/ + +/*ARGSUSED*/ +#if (defined __STDC__ || defined __C99__FUNC__ \ + || defined __cplusplus || defined _MSC_VER) +static void +yy_symbol_value_print (FILE *yyoutput, int yytype, YYSTYPE const * const yyvaluep, YYLTYPE const * const yylocationp) +#else +static void +yy_symbol_value_print (yyoutput, yytype, yyvaluep, yylocationp) + FILE *yyoutput; + int yytype; + YYSTYPE const * const yyvaluep; + YYLTYPE const * const yylocationp; +#endif +{ + FILE *yyo = yyoutput; + YYUSE (yyo); + if (!yyvaluep) + return; + YYUSE (yylocationp); +# ifdef YYPRINT + if (yytype < YYNTOKENS) + YYPRINT (yyoutput, yytoknum[yytype], *yyvaluep); +# else + YYUSE (yyoutput); +# endif + YYUSE (yytype); +} + + +/*--------------------------------. +| Print this symbol on YYOUTPUT. | +`--------------------------------*/ + +#if (defined __STDC__ || defined __C99__FUNC__ \ + || defined __cplusplus || defined _MSC_VER) +static void +yy_symbol_print (FILE *yyoutput, int yytype, YYSTYPE const * const yyvaluep, YYLTYPE const * const yylocationp) +#else +static void +yy_symbol_print (yyoutput, yytype, yyvaluep, yylocationp) + FILE *yyoutput; + int yytype; + YYSTYPE const * const yyvaluep; + YYLTYPE const * const yylocationp; +#endif +{ + if (yytype < YYNTOKENS) + YYFPRINTF (yyoutput, "token %s (", yytname[yytype]); + else + YYFPRINTF (yyoutput, "nterm %s (", yytname[yytype]); + + YY_LOCATION_PRINT (yyoutput, *yylocationp); + YYFPRINTF (yyoutput, ": "); + yy_symbol_value_print (yyoutput, yytype, yyvaluep, yylocationp); + YYFPRINTF (yyoutput, ")"); +} + +/*------------------------------------------------------------------. +| yy_stack_print -- Print the state stack from its BOTTOM up to its | +| TOP (included). | +`------------------------------------------------------------------*/ + +#if (defined __STDC__ || defined __C99__FUNC__ \ + || defined __cplusplus || defined _MSC_VER) +static void +yy_stack_print (yytype_int16 *yybottom, yytype_int16 *yytop) +#else +static void +yy_stack_print (yybottom, yytop) + yytype_int16 *yybottom; + yytype_int16 *yytop; +#endif +{ + YYFPRINTF (stderr, "Stack now"); + for (; yybottom <= yytop; yybottom++) + { + int yybot = *yybottom; + YYFPRINTF (stderr, " %d", yybot); + } + YYFPRINTF (stderr, "\n"); +} + +# define YY_STACK_PRINT(Bottom, Top) \ +do { \ + if (yydebug) \ + yy_stack_print ((Bottom), (Top)); \ +} while (YYID (0)) + + +/*------------------------------------------------. +| Report that the YYRULE is going to be reduced. | +`------------------------------------------------*/ + +#if (defined __STDC__ || defined __C99__FUNC__ \ + || defined __cplusplus || defined _MSC_VER) +static void +yy_reduce_print (YYSTYPE *yyvsp, YYLTYPE *yylsp, int yyrule) +#else +static void +yy_reduce_print (yyvsp, yylsp, yyrule) + YYSTYPE *yyvsp; + YYLTYPE *yylsp; + int yyrule; +#endif +{ + int yynrhs = yyr2[yyrule]; + int yyi; + unsigned long int yylno = yyrline[yyrule]; + YYFPRINTF (stderr, "Reducing stack by rule %d (line %lu):\n", + yyrule - 1, yylno); + /* The symbols being reduced. */ + for (yyi = 0; yyi < yynrhs; yyi++) + { + YYFPRINTF (stderr, " $%d = ", yyi + 1); + yy_symbol_print (stderr, yyrhs[yyprhs[yyrule] + yyi], + &(yyvsp[(yyi + 1) - (yynrhs)]) + , &(yylsp[(yyi + 1) - (yynrhs)]) ); + YYFPRINTF (stderr, "\n"); + } +} + +# define YY_REDUCE_PRINT(Rule) \ +do { \ + if (yydebug) \ + yy_reduce_print (yyvsp, yylsp, Rule); \ +} while (YYID (0)) + +/* Nonzero means print parse trace. It is left uninitialized so that + multiple parsers can coexist. */ +int yydebug; +#else /* !YYDEBUG */ +# define YYDPRINTF(Args) +# define YY_SYMBOL_PRINT(Title, Type, Value, Location) +# define YY_STACK_PRINT(Bottom, Top) +# define YY_REDUCE_PRINT(Rule) +#endif /* !YYDEBUG */ + + +/* YYINITDEPTH -- initial size of the parser's stacks. */ +#ifndef YYINITDEPTH +# define YYINITDEPTH 200 +#endif + +/* YYMAXDEPTH -- maximum size the stacks can grow to (effective only + if the built-in stack extension method is used). + + Do not make this value too large; the results are undefined if + YYSTACK_ALLOC_MAXIMUM < YYSTACK_BYTES (YYMAXDEPTH) + evaluated with infinite-precision integer arithmetic. */ + +#ifndef YYMAXDEPTH +# define YYMAXDEPTH 10000 +#endif + + +#if YYERROR_VERBOSE + +# ifndef yystrlen +# if defined __GLIBC__ && defined _STRING_H +# define yystrlen strlen +# else +/* Return the length of YYSTR. */ +#if (defined __STDC__ || defined __C99__FUNC__ \ + || defined __cplusplus || defined _MSC_VER) +static YYSIZE_T +yystrlen (const char *yystr) +#else +static YYSIZE_T +yystrlen (yystr) + const char *yystr; +#endif +{ + YYSIZE_T yylen; + for (yylen = 0; yystr[yylen]; yylen++) + continue; + return yylen; +} +# endif +# endif + +# ifndef yystpcpy +# if defined __GLIBC__ && defined _STRING_H && defined _GNU_SOURCE +# define yystpcpy stpcpy +# else +/* Copy YYSRC to YYDEST, returning the address of the terminating '\0' in + YYDEST. */ +#if (defined __STDC__ || defined __C99__FUNC__ \ + || defined __cplusplus || defined _MSC_VER) +static char * +yystpcpy (char *yydest, const char *yysrc) +#else +static char * +yystpcpy (yydest, yysrc) + char *yydest; + const char *yysrc; +#endif +{ + char *yyd = yydest; + const char *yys = yysrc; + + while ((*yyd++ = *yys++) != '\0') + continue; + + return yyd - 1; +} +# endif +# endif + +# ifndef yytnamerr +/* Copy to YYRES the contents of YYSTR after stripping away unnecessary + quotes and backslashes, so that it's suitable for yyerror. The + heuristic is that double-quoting is unnecessary unless the string + contains an apostrophe, a comma, or backslash (other than + backslash-backslash). YYSTR is taken from yytname. If YYRES is + null, do not copy; instead, return the length of what the result + would have been. */ +static YYSIZE_T +yytnamerr (char *yyres, const char *yystr) +{ + if (*yystr == '"') + { + YYSIZE_T yyn = 0; + char const *yyp = yystr; + + for (;;) + switch (*++yyp) + { + case '\'': + case ',': + goto do_not_strip_quotes; + + case '\\': + if (*++yyp != '\\') + goto do_not_strip_quotes; + /* Fall through. */ + default: + if (yyres) + yyres[yyn] = *yyp; + yyn++; + break; + + case '"': + if (yyres) + yyres[yyn] = '\0'; + return yyn; + } + do_not_strip_quotes: ; + } + + if (! yyres) + return yystrlen (yystr); + + return yystpcpy (yyres, yystr) - yyres; +} +# endif + +/* Copy into *YYMSG, which is of size *YYMSG_ALLOC, an error message + about the unexpected token YYTOKEN for the state stack whose top is + YYSSP. + + Return 0 if *YYMSG was successfully written. Return 1 if *YYMSG is + not large enough to hold the message. In that case, also set + *YYMSG_ALLOC to the required number of bytes. Return 2 if the + required number of bytes is too large to store. */ +static int +yysyntax_error (YYSIZE_T *yymsg_alloc, char **yymsg, + yytype_int16 *yyssp, int yytoken) +{ + YYSIZE_T yysize0 = yytnamerr (YY_NULL, yytname[yytoken]); + YYSIZE_T yysize = yysize0; + enum { YYERROR_VERBOSE_ARGS_MAXIMUM = 5 }; + /* Internationalized format string. */ + const char *yyformat = YY_NULL; + /* Arguments of yyformat. */ + char const *yyarg[YYERROR_VERBOSE_ARGS_MAXIMUM]; + /* Number of reported tokens (one for the "unexpected", one per + "expected"). */ + int yycount = 0; + + /* There are many possibilities here to consider: + - Assume YYFAIL is not used. It's too flawed to consider. See + <http://lists.gnu.org/archive/html/bison-patches/2009-12/msg00024.html> + for details. YYERROR is fine as it does not invoke this + function. + - If this state is a consistent state with a default action, then + the only way this function was invoked is if the default action + is an error action. In that case, don't check for expected + tokens because there are none. + - The only way there can be no lookahead present (in yychar) is if + this state is a consistent state with a default action. Thus, + detecting the absence of a lookahead is sufficient to determine + that there is no unexpected or expected token to report. In that + case, just report a simple "syntax error". + - Don't assume there isn't a lookahead just because this state is a + consistent state with a default action. There might have been a + previous inconsistent state, consistent state with a non-default + action, or user semantic action that manipulated yychar. + - Of course, the expected token list depends on states to have + correct lookahead information, and it depends on the parser not + to perform extra reductions after fetching a lookahead from the + scanner and before detecting a syntax error. Thus, state merging + (from LALR or IELR) and default reductions corrupt the expected + token list. However, the list is correct for canonical LR with + one exception: it will still contain any token that will not be + accepted due to an error action in a later state. + */ + if (yytoken != YYEMPTY) + { + int yyn = yypact[*yyssp]; + yyarg[yycount++] = yytname[yytoken]; + if (!yypact_value_is_default (yyn)) + { + /* Start YYX at -YYN if negative to avoid negative indexes in + YYCHECK. In other words, skip the first -YYN actions for + this state because they are default actions. */ + int yyxbegin = yyn < 0 ? -yyn : 0; + /* Stay within bounds of both yycheck and yytname. */ + int yychecklim = YYLAST - yyn + 1; + int yyxend = yychecklim < YYNTOKENS ? yychecklim : YYNTOKENS; + int yyx; + + for (yyx = yyxbegin; yyx < yyxend; ++yyx) + if (yycheck[yyx + yyn] == yyx && yyx != YYTERROR + && !yytable_value_is_error (yytable[yyx + yyn])) + { + if (yycount == YYERROR_VERBOSE_ARGS_MAXIMUM) + { + yycount = 1; + yysize = yysize0; + break; + } + yyarg[yycount++] = yytname[yyx]; + { + YYSIZE_T yysize1 = yysize + yytnamerr (YY_NULL, yytname[yyx]); + if (! (yysize <= yysize1 + && yysize1 <= YYSTACK_ALLOC_MAXIMUM)) + return 2; + yysize = yysize1; + } + } + } + } + + switch (yycount) + { +# define YYCASE_(N, S) \ + case N: \ + yyformat = S; \ + break + YYCASE_(0, YY_("syntax error")); + YYCASE_(1, YY_("syntax error, unexpected %s")); + YYCASE_(2, YY_("syntax error, unexpected %s, expecting %s")); + YYCASE_(3, YY_("syntax error, unexpected %s, expecting %s or %s")); + YYCASE_(4, YY_("syntax error, unexpected %s, expecting %s or %s or %s")); + YYCASE_(5, YY_("syntax error, unexpected %s, expecting %s or %s or %s or %s")); +# undef YYCASE_ + } + + { + YYSIZE_T yysize1 = yysize + yystrlen (yyformat); + if (! (yysize <= yysize1 && yysize1 <= YYSTACK_ALLOC_MAXIMUM)) + return 2; + yysize = yysize1; + } + + if (*yymsg_alloc < yysize) + { + *yymsg_alloc = 2 * yysize; + if (! (yysize <= *yymsg_alloc + && *yymsg_alloc <= YYSTACK_ALLOC_MAXIMUM)) + *yymsg_alloc = YYSTACK_ALLOC_MAXIMUM; + return 1; + } + + /* Avoid sprintf, as that infringes on the user's name space. + Don't have undefined behavior even if the translation + produced a string with the wrong number of "%s"s. */ + { + char *yyp = *yymsg; + int yyi = 0; + while ((*yyp = *yyformat) != '\0') + if (*yyp == '%' && yyformat[1] == 's' && yyi < yycount) + { + yyp += yytnamerr (yyp, yyarg[yyi++]); + yyformat += 2; + } + else + { + yyp++; + yyformat++; + } + } + return 0; +} +#endif /* YYERROR_VERBOSE */ + +/*-----------------------------------------------. +| Release the memory associated to this symbol. | +`-----------------------------------------------*/ + +/*ARGSUSED*/ +#if (defined __STDC__ || defined __C99__FUNC__ \ + || defined __cplusplus || defined _MSC_VER) +static void +yydestruct (const char *yymsg, int yytype, YYSTYPE *yyvaluep, YYLTYPE *yylocationp) +#else +static void +yydestruct (yymsg, yytype, yyvaluep, yylocationp) + const char *yymsg; + int yytype; + YYSTYPE *yyvaluep; + YYLTYPE *yylocationp; +#endif +{ + YYUSE (yyvaluep); + YYUSE (yylocationp); + + if (!yymsg) + yymsg = "Deleting"; + YY_SYMBOL_PRINT (yymsg, yytype, yyvaluep, yylocationp); + + switch (yytype) + { + case 5: /* SECTIONHEADER */ + + { UNPROTECT_PTR((*yyvaluep)); }; + + break; + case 6: /* RSECTIONHEADER */ + + { UNPROTECT_PTR((*yyvaluep)); }; + + break; + case 7: /* VSECTIONHEADER */ + + { UNPROTECT_PTR((*yyvaluep)); }; + + break; + case 8: /* SECTIONHEADER2 */ + + { UNPROTECT_PTR((*yyvaluep)); }; + + break; + case 9: /* RCODEMACRO */ + + { UNPROTECT_PTR((*yyvaluep)); }; + + break; + case 10: /* SEXPR */ + + { UNPROTECT_PTR((*yyvaluep)); }; + + break; + case 12: /* LATEXMACRO */ + + { UNPROTECT_PTR((*yyvaluep)); }; + + break; + case 13: /* VERBMACRO */ + + { UNPROTECT_PTR((*yyvaluep)); }; + + break; + case 14: /* OPTMACRO */ + + { UNPROTECT_PTR((*yyvaluep)); }; + + break; + case 15: /* ESCAPE */ + + { UNPROTECT_PTR((*yyvaluep)); }; + + break; + case 16: /* LISTSECTION */ + + { UNPROTECT_PTR((*yyvaluep)); }; + + break; + case 17: /* ITEMIZE */ + + { UNPROTECT_PTR((*yyvaluep)); }; + + break; + case 18: /* DESCRIPTION */ + + { UNPROTECT_PTR((*yyvaluep)); }; + + break; + case 19: /* NOITEM */ + + { UNPROTECT_PTR((*yyvaluep)); }; + + break; + case 20: /* LATEXMACRO2 */ + + { UNPROTECT_PTR((*yyvaluep)); }; + + break; + case 21: /* VERBMACRO2 */ + + { UNPROTECT_PTR((*yyvaluep)); }; + + break; + case 22: /* VERBLATEX */ + + { UNPROTECT_PTR((*yyvaluep)); }; + + break; + case 23: /* LATEXMACRO3 */ + + { UNPROTECT_PTR((*yyvaluep)); }; + + break; + case 24: /* NEWCOMMAND */ + + { UNPROTECT_PTR((*yyvaluep)); }; + + break; + case 25: /* USERMACRO */ + + { UNPROTECT_PTR((*yyvaluep)); }; + + break; + case 26: /* USERMACRO1 */ + + { UNPROTECT_PTR((*yyvaluep)); }; + + break; + case 27: /* USERMACRO2 */ + + { UNPROTECT_PTR((*yyvaluep)); }; + + break; + case 28: /* USERMACRO3 */ + + { UNPROTECT_PTR((*yyvaluep)); }; + + break; + case 29: /* USERMACRO4 */ + + { UNPROTECT_PTR((*yyvaluep)); }; + + break; + case 30: /* USERMACRO5 */ + + { UNPROTECT_PTR((*yyvaluep)); }; + + break; + case 31: /* USERMACRO6 */ + + { UNPROTECT_PTR((*yyvaluep)); }; + + break; + case 32: /* USERMACRO7 */ + + { UNPROTECT_PTR((*yyvaluep)); }; + + break; + case 33: /* USERMACRO8 */ + + { UNPROTECT_PTR((*yyvaluep)); }; + + break; + case 34: /* USERMACRO9 */ + + { UNPROTECT_PTR((*yyvaluep)); }; + + break; + case 35: /* IFDEF */ + + { UNPROTECT_PTR((*yyvaluep)); }; + + break; + case 36: /* ENDIF */ + + { UNPROTECT_PTR((*yyvaluep)); }; + + break; + case 37: /* TEXT */ + + { UNPROTECT_PTR((*yyvaluep)); }; + + break; + case 38: /* RCODE */ + + { UNPROTECT_PTR((*yyvaluep)); }; + + break; + case 39: /* VERB */ + + { UNPROTECT_PTR((*yyvaluep)); }; + + break; + case 40: /* COMMENT */ + + { UNPROTECT_PTR((*yyvaluep)); }; + + break; + case 41: /* UNKNOWN */ + + { UNPROTECT_PTR((*yyvaluep)); }; + + break; + case 42: /* STARTFILE */ + + { UNPROTECT_PTR((*yyvaluep)); }; + + break; + case 43: /* STARTFRAGMENT */ + + { UNPROTECT_PTR((*yyvaluep)); }; + + break; + case 54: /* ArgItems */ + + { UNPROTECT_PTR((*yyvaluep)); }; + + break; + case 58: /* LatexArg */ + + { UNPROTECT_PTR((*yyvaluep)); }; + + break; + case 63: /* RLikeArg2 */ + + { UNPROTECT_PTR((*yyvaluep)); }; + + break; + case 65: /* VerbatimArg1 */ + + { UNPROTECT_PTR((*yyvaluep)); }; + + break; + case 66: /* VerbatimArg2 */ + + { UNPROTECT_PTR((*yyvaluep)); }; + + break; + case 67: /* IfDefTarget */ + + { UNPROTECT_PTR((*yyvaluep)); }; + + break; + case 68: /* goLatexLike */ + + { UNPROTECT_PTR((*yyvaluep)); }; + + break; + case 69: /* goRLike */ + + { UNPROTECT_PTR((*yyvaluep)); }; + + break; + case 70: /* goRLike2 */ + + { UNPROTECT_PTR((*yyvaluep)); }; + + break; + case 71: /* goOption */ + + { UNPROTECT_PTR((*yyvaluep)); }; + + break; + case 72: /* goVerbatim */ + + { UNPROTECT_PTR((*yyvaluep)); }; + + break; + case 73: /* goVerbatim1 */ + + { UNPROTECT_PTR((*yyvaluep)); }; + + break; + case 74: /* goVerbatim2 */ + + { UNPROTECT_PTR((*yyvaluep)); }; + + break; + case 75: /* goItem0 */ + + { UNPROTECT_PTR((*yyvaluep)); }; + + break; + case 76: /* goItem2 */ + + { UNPROTECT_PTR((*yyvaluep)); }; + + break; + case 78: /* Option */ + + { UNPROTECT_PTR((*yyvaluep)); }; + + break; + + default: + break; + } +} + + + + +/* The lookahead symbol. */ +int yychar; + + +#ifndef YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN +# define YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN +# define YY_IGNORE_MAYBE_UNINITIALIZED_END +#endif +#ifndef YY_INITIAL_VALUE +# define YY_INITIAL_VALUE(Value) /* Nothing. */ +#endif + +/* The semantic value of the lookahead symbol. */ +YYSTYPE yylval YY_INITIAL_VALUE(yyval_default); + +/* Location data for the lookahead symbol. */ +YYLTYPE yylloc +# if defined YYLTYPE_IS_TRIVIAL && YYLTYPE_IS_TRIVIAL + = { 1, 1, 1, 1 } +# endif +; + + +/* Number of syntax errors so far. */ +int yynerrs; + + +/*----------. +| yyparse. | +`----------*/ + +#ifdef YYPARSE_PARAM +#if (defined __STDC__ || defined __C99__FUNC__ \ + || defined __cplusplus || defined _MSC_VER) +int +yyparse (void *YYPARSE_PARAM) +#else +int +yyparse (YYPARSE_PARAM) + void *YYPARSE_PARAM; +#endif +#else /* ! YYPARSE_PARAM */ +#if (defined __STDC__ || defined __C99__FUNC__ \ + || defined __cplusplus || defined _MSC_VER) +int +yyparse (void) +#else +int +yyparse () + +#endif +#endif +{ + int yystate; + /* Number of tokens to shift before error messages enabled. */ + int yyerrstatus; + + /* The stacks and their tools: + `yyss': related to states. + `yyvs': related to semantic values. + `yyls': related to locations. + + Refer to the stacks through separate pointers, to allow yyoverflow + to reallocate them elsewhere. */ + + /* The state stack. */ + yytype_int16 yyssa[YYINITDEPTH]; + yytype_int16 *yyss; + yytype_int16 *yyssp; + + /* The semantic value stack. */ + YYSTYPE yyvsa[YYINITDEPTH]; + YYSTYPE *yyvs; + YYSTYPE *yyvsp; + + /* The location stack. */ + YYLTYPE yylsa[YYINITDEPTH]; + YYLTYPE *yyls; + YYLTYPE *yylsp; + + /* The locations where the error started and ended. */ + YYLTYPE yyerror_range[3]; + + YYSIZE_T yystacksize; + + int yyn; + int yyresult; + /* Lookahead token as an internal (translated) token number. */ + int yytoken = 0; + /* The variables used to return semantic value and location from the + action routines. */ + YYSTYPE yyval; + YYLTYPE yyloc; + +#if YYERROR_VERBOSE + /* Buffer for error messages, and its allocated size. */ + char yymsgbuf[128]; + char *yymsg = yymsgbuf; + YYSIZE_T yymsg_alloc = sizeof yymsgbuf; +#endif + +#define YYPOPSTACK(N) (yyvsp -= (N), yyssp -= (N), yylsp -= (N)) + + /* The number of symbols on the RHS of the reduced rule. + Keep to zero when no symbol should be popped. */ + int yylen = 0; + + yyssp = yyss = yyssa; + yyvsp = yyvs = yyvsa; + yylsp = yyls = yylsa; + yystacksize = YYINITDEPTH; + + YYDPRINTF ((stderr, "Starting parse\n")); + + yystate = 0; + yyerrstatus = 0; + yynerrs = 0; + yychar = YYEMPTY; /* Cause a token to be read. */ + yylsp[0] = yylloc; + goto yysetstate; + +/*------------------------------------------------------------. +| yynewstate -- Push a new state, which is found in yystate. | +`------------------------------------------------------------*/ + yynewstate: + /* In all cases, when you get here, the value and location stacks + have just been pushed. So pushing a state here evens the stacks. */ + yyssp++; + + yysetstate: + *yyssp = yystate; + + if (yyss + yystacksize - 1 <= yyssp) + { + /* Get the current used size of the three stacks, in elements. */ + YYSIZE_T yysize = yyssp - yyss + 1; + +#ifdef yyoverflow + { + /* Give user a chance to reallocate the stack. Use copies of + these so that the &'s don't force the real ones into + memory. */ + YYSTYPE *yyvs1 = yyvs; + yytype_int16 *yyss1 = yyss; + YYLTYPE *yyls1 = yyls; + + /* Each stack pointer address is followed by the size of the + data in use in that stack, in bytes. This used to be a + conditional around just the two extra args, but that might + be undefined if yyoverflow is a macro. */ + yyoverflow (YY_("memory exhausted"), + &yyss1, yysize * sizeof (*yyssp), + &yyvs1, yysize * sizeof (*yyvsp), + &yyls1, yysize * sizeof (*yylsp), + &yystacksize); + + yyls = yyls1; + yyss = yyss1; + yyvs = yyvs1; + } +#else /* no yyoverflow */ +# ifndef YYSTACK_RELOCATE + goto yyexhaustedlab; +# else + /* Extend the stack our own way. */ + if (YYMAXDEPTH <= yystacksize) + goto yyexhaustedlab; + yystacksize *= 2; + if (YYMAXDEPTH < yystacksize) + yystacksize = YYMAXDEPTH; + + { + yytype_int16 *yyss1 = yyss; + union yyalloc *yyptr = + (union yyalloc *) YYSTACK_ALLOC (YYSTACK_BYTES (yystacksize)); + if (! yyptr) + goto yyexhaustedlab; + YYSTACK_RELOCATE (yyss_alloc, yyss); + YYSTACK_RELOCATE (yyvs_alloc, yyvs); + YYSTACK_RELOCATE (yyls_alloc, yyls); +# undef YYSTACK_RELOCATE + if (yyss1 != yyssa) + YYSTACK_FREE (yyss1); + } +# endif +#endif /* no yyoverflow */ + + yyssp = yyss + yysize - 1; + yyvsp = yyvs + yysize - 1; + yylsp = yyls + yysize - 1; + + YYDPRINTF ((stderr, "Stack size increased to %lu\n", + (unsigned long int) yystacksize)); + + if (yyss + yystacksize - 1 <= yyssp) + YYABORT; + } + + YYDPRINTF ((stderr, "Entering state %d\n", yystate)); + + if (yystate == YYFINAL) + YYACCEPT; + + goto yybackup; + +/*-----------. +| yybackup. | +`-----------*/ +yybackup: + + /* Do appropriate processing given the current state. Read a + lookahead token if we need one and don't already have one. */ + + /* First try to decide what to do without reference to lookahead token. */ + yyn = yypact[yystate]; + if (yypact_value_is_default (yyn)) + goto yydefault; + + /* Not known => get a lookahead token if don't already have one. */ + + /* YYCHAR is either YYEMPTY or YYEOF or a valid lookahead symbol. */ + if (yychar == YYEMPTY) + { + YYDPRINTF ((stderr, "Reading a token: ")); + yychar = YYLEX; + } + + if (yychar <= YYEOF) + { + yychar = yytoken = YYEOF; + YYDPRINTF ((stderr, "Now at end of input.\n")); + } + else + { + yytoken = YYTRANSLATE (yychar); + YY_SYMBOL_PRINT ("Next token is", yytoken, &yylval, &yylloc); + } + + /* If the proper action on seeing token YYTOKEN is to reduce or to + detect an error, take that action. */ + yyn += yytoken; + if (yyn < 0 || YYLAST < yyn || yycheck[yyn] != yytoken) + goto yydefault; + yyn = yytable[yyn]; + if (yyn <= 0) + { + if (yytable_value_is_error (yyn)) + goto yyerrlab; + yyn = -yyn; + goto yyreduce; + } + + /* Count tokens shifted since error; after three, turn off error + status. */ + if (yyerrstatus) + yyerrstatus--; + + /* Shift the lookahead token. */ + YY_SYMBOL_PRINT ("Shifting", yytoken, &yylval, &yylloc); + + /* Discard the shifted token. */ + yychar = YYEMPTY; + + yystate = yyn; + YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN + *++yyvsp = yylval; + YY_IGNORE_MAYBE_UNINITIALIZED_END + *++yylsp = yylloc; + goto yynewstate; + + +/*-----------------------------------------------------------. +| yydefault -- do the default action for the current state. | +`-----------------------------------------------------------*/ +yydefault: + yyn = yydefact[yystate]; + if (yyn == 0) + goto yyerrlab; + goto yyreduce; + + +/*-----------------------------. +| yyreduce -- Do a reduction. | +`-----------------------------*/ +yyreduce: + /* yyn is the number of a rule to reduce with. */ + yylen = yyr2[yyn]; + + /* If YYLEN is nonzero, implement the default value of the action: + `$$ = $1'. + + Otherwise, the following line sets YYVAL to garbage. + This behavior is undocumented and Bison + users should not rely upon it. Assigning to YYVAL + unconditionally makes the parser a bit smaller, and it avoids a + GCC warning that YYVAL may be used uninitialized. */ + yyval = yyvsp[1-yylen]; + + /* Default location. */ + YYLLOC_DEFAULT (yyloc, (yylsp - yylen), yylen); + YY_REDUCE_PRINT (yyn); + switch (yyn) + { + case 2: + + { xxsavevalue((yyvsp[(2) - (3)]), &(yyloc)); UNPROTECT_PTR((yyvsp[(1) - (3)])); YYACCEPT; } + break; + + case 3: + + { xxsavevalue((yyvsp[(2) - (3)]), &(yyloc)); UNPROTECT_PTR((yyvsp[(1) - (3)])); YYACCEPT; } + break; + + case 4: + + { PROTECT(parseState.Value = R_NilValue); YYABORT; } + break; + + case 5: + + { (yyval) = (yyvsp[(2) - (2)]); UNPROTECT_PTR((yyvsp[(1) - (2)])); } + break; + + case 6: + + { (yyval) = (yyvsp[(1) - (1)]); } + break; + + case 7: + + { (yyval) = xxnewlist((yyvsp[(1) - (1)])); } + break; + + case 8: + + { (yyval) = xxlist((yyvsp[(1) - (2)]), (yyvsp[(2) - (2)])); } + break; + + case 9: + + { (yyval) = xxmarkup((yyvsp[(1) - (2)]), (yyvsp[(2) - (2)]), STATIC, &(yyloc)); } + break; + + case 10: + + { (yyval) = xxmarkup((yyvsp[(1) - (2)]), (yyvsp[(2) - (2)]), HAS_SEXPR, &(yyloc)); } + break; + + case 11: + + { (yyval) = xxmarkup((yyvsp[(1) - (2)]), (yyvsp[(2) - (2)]), STATIC, &(yyloc)); } + break; + + case 12: + + { (yyval) = xxmarkup((yyvsp[(1) - (2)]), (yyvsp[(2) - (2)]), STATIC, &(yyloc)); } + break; + + case 13: + + { (yyval) = xxmarkup((yyvsp[(1) - (2)]), (yyvsp[(2) - (2)]), STATIC, &(yyloc)); } + break; + + case 14: + + { (yyval) = xxmarkup2((yyvsp[(1) - (3)]), (yyvsp[(2) - (3)]), (yyvsp[(3) - (3)]), 2, STATIC, &(yyloc)); } + break; + + case 15: + + { (yyval) = xxmarkup2((yyvsp[(1) - (4)]), (yyvsp[(2) - (4)]), (yyvsp[(3) - (4)]), 2, HAS_IFDEF, &(yyloc)); UNPROTECT_PTR((yyvsp[(4) - (4)])); } + break; + + case 16: + + { (yyval) = xxmarkup2((yyvsp[(1) - (4)]), (yyvsp[(2) - (4)]), (yyvsp[(3) - (4)]), 2, HAS_IFDEF, &(yyloc)); } + break; + + case 17: + + { (yyval) = xxmarkup((yyvsp[(1) - (3)]), (yyvsp[(3) - (3)]), HAS_SEXPR, &(yyloc)); xxpopMode((yyvsp[(2) - (3)])); } + break; + + case 18: + + { (yyval) = xxOptionmarkup((yyvsp[(1) - (4)]), (yyvsp[(3) - (4)]), (yyvsp[(4) - (4)]), HAS_SEXPR, &(yyloc)); xxpopMode((yyvsp[(2) - (4)])); } + break; + + case 19: + + { (yyval) = xxtag((yyvsp[(1) - (1)]), COMMENT, &(yyloc)); } + break; + + case 20: + + { (yyval) = xxtag((yyvsp[(1) - (1)]), TEXT, &(yyloc)); } + break; + + case 21: + + { (yyval) = (yyvsp[(1) - (1)]); } + break; + + case 22: + + { (yyval) = (yyvsp[(2) - (2)]); } + break; + + case 23: + + { (yyval) = xxnewlist((yyvsp[(1) - (1)])); } + break; + + case 24: + + { (yyval) = xxlist((yyvsp[(1) - (2)]), (yyvsp[(2) - (2)])); } + break; + + case 25: + + { (yyval) = xxtag((yyvsp[(1) - (1)]), TEXT, &(yyloc)); } + break; + + case 26: + + { (yyval) = xxtag((yyvsp[(1) - (1)]), RCODE, &(yyloc)); } + break; + + case 27: + + { (yyval) = xxtag((yyvsp[(1) - (1)]), VERB, &(yyloc)); } + break; + + case 28: + + { (yyval) = xxtag((yyvsp[(1) - (1)]), COMMENT, &(yyloc)); } + break; + + case 29: + + { (yyval) = xxtag((yyvsp[(1) - (1)]), UNKNOWN, &(yyloc)); yyerror(yyunknown); } + break; + + case 30: + + { (yyval) = xxmarkup(R_NilValue, (yyvsp[(1) - (1)]), STATIC, &(yyloc)); } + break; + + case 31: + + { (yyval) = (yyvsp[(1) - (1)]); } + break; + + case 32: + + { (yyval) = (yyvsp[(1) - (1)]); } + break; + + case 33: + + { (yyval) = (yyvsp[(2) - (2)]); } + break; + + case 34: + + { (yyval) = xxmarkup((yyvsp[(1) - (2)]), (yyvsp[(2) - (2)]), STATIC, &(yyloc)); } + break; + + case 35: + + { (yyval) = xxmarkup2((yyvsp[(1) - (3)]), (yyvsp[(2) - (3)]), (yyvsp[(3) - (3)]), 2, STATIC, &(yyloc)); } + break; + + case 36: + + { (yyval) = xxmarkup3((yyvsp[(1) - (4)]), (yyvsp[(2) - (4)]), (yyvsp[(3) - (4)]), (yyvsp[(4) - (4)]), STATIC, &(yyloc)); } + break; + + case 37: + + { (yyval) = xxmarkup((yyvsp[(1) - (2)]), (yyvsp[(2) - (2)]), STATIC, &(yyloc)); } + break; + + case 38: + + { (yyval) = xxmarkup((yyvsp[(1) - (2)]), (yyvsp[(2) - (2)]), STATIC, &(yyloc)); } + break; + + case 39: + + { (yyval) = xxmarkup((yyvsp[(1) - (3)]), (yyvsp[(3) - (3)]), STATIC, &(yyloc)); xxpopMode((yyvsp[(2) - (3)])); } + break; + + case 40: + + { (yyval) = xxOptionmarkup((yyvsp[(1) - (4)]), (yyvsp[(3) - (4)]), (yyvsp[(4) - (4)]), STATIC, &(yyloc)); xxpopMode((yyvsp[(2) - (4)])); } + break; + + case 41: + + { (yyval) = xxmarkup((yyvsp[(1) - (2)]), (yyvsp[(2) - (2)]), STATIC, &(yyloc)); } + break; + + case 42: + + { (yyval) = xxmarkup((yyvsp[(1) - (3)]), (yyvsp[(3) - (3)]), HAS_SEXPR, &(yyloc)); xxpopMode((yyvsp[(2) - (3)])); } + break; + + case 43: + + { (yyval) = xxOptionmarkup((yyvsp[(1) - (4)]), (yyvsp[(3) - (4)]), (yyvsp[(4) - (4)]), HAS_SEXPR, &(yyloc)); xxpopMode((yyvsp[(2) - (4)])); } + break; + + case 44: + + { (yyval) = xxmarkup((yyvsp[(1) - (2)]), (yyvsp[(2) - (2)]), STATIC, &(yyloc)); } + break; + + case 45: + + { (yyval) = xxmarkup2((yyvsp[(1) - (2)]), (yyvsp[(2) - (2)]), R_NilValue, 1, STATIC, &(yyloc)); } + break; + + case 46: + + { (yyval) = xxmarkup2((yyvsp[(1) - (3)]), (yyvsp[(2) - (3)]), (yyvsp[(3) - (3)]), 2, STATIC, &(yyloc)); } + break; + + case 47: + + { (yyval) = xxmarkup((yyvsp[(1) - (1)]), R_NilValue, STATIC, &(yyloc)); } + break; + + case 48: + + { (yyval) = xxmarkup2((yyvsp[(1) - (4)]), (yyvsp[(2) - (4)]), (yyvsp[(3) - (4)]), 2, HAS_IFDEF, &(yyloc)); UNPROTECT_PTR((yyvsp[(4) - (4)])); } + break; + + case 49: + + { (yyval) = xxmarkup2((yyvsp[(1) - (4)]), (yyvsp[(2) - (4)]), (yyvsp[(3) - (4)]), 2, HAS_IFDEF, &(yyloc)); } + break; + + case 50: + + { (yyval) = xxmarkup2((yyvsp[(1) - (3)]), (yyvsp[(2) - (3)]), (yyvsp[(3) - (3)]), 2, STATIC, &(yyloc)); } + break; + + case 51: + + { (yyval) = xxnewcommand((yyvsp[(1) - (3)]), (yyvsp[(2) - (3)]), (yyvsp[(3) - (3)]), &(yyloc)); } + break; + + case 52: + + { (yyval) = xxusermacro((yyvsp[(1) - (1)]), xxnewlist(NULL), &(yyloc)); } + break; + + case 53: + + { (yyval) = xxusermacro((yyvsp[(1) - (2)]), xxnewlist((yyvsp[(2) - (2)])), &(yyloc)); } + break; + + case 54: + + { (yyval) = xxusermacro((yyvsp[(1) - (3)]), xxnewlist2((yyvsp[(2) - (3)]), (yyvsp[(3) - (3)])), &(yyloc)); } + break; + + case 55: + + { (yyval) = xxusermacro((yyvsp[(1) - (4)]), xxnewlist3((yyvsp[(2) - (4)]), (yyvsp[(3) - (4)]), (yyvsp[(4) - (4)])), &(yyloc)); } + break; + + case 56: + + { (yyval) = xxusermacro((yyvsp[(1) - (5)]), xxnewlist4((yyvsp[(2) - (5)]), (yyvsp[(3) - (5)]), (yyvsp[(4) - (5)]), (yyvsp[(5) - (5)])), &(yyloc)); } + break; + + case 57: + + { (yyval) = xxusermacro((yyvsp[(1) - (6)]), xxnewlist5((yyvsp[(2) - (6)]), (yyvsp[(3) - (6)]), (yyvsp[(4) - (6)]), (yyvsp[(5) - (6)]), (yyvsp[(6) - (6)])), &(yyloc)); } + break; + + case 58: + + { (yyval) = xxusermacro((yyvsp[(1) - (7)]), xxnewlist6((yyvsp[(2) - (7)]), (yyvsp[(3) - (7)]), (yyvsp[(4) - (7)]), (yyvsp[(5) - (7)]), (yyvsp[(6) - (7)]), (yyvsp[(7) - (7)])), &(yyloc)); } + break; + + case 59: + + { (yyval) = xxusermacro((yyvsp[(1) - (9)]), xxnewlist7((yyvsp[(2) - (9)]), (yyvsp[(3) - (9)]), (yyvsp[(4) - (9)]), (yyvsp[(5) - (9)]), (yyvsp[(6) - (9)]), (yyvsp[(7) - (9)]), (yyvsp[(8) - (9)])), &(yyloc)); } + break; + + case 60: + + { (yyval) = xxusermacro((yyvsp[(1) - (10)]), xxnewlist8((yyvsp[(2) - (10)]), (yyvsp[(3) - (10)]), (yyvsp[(4) - (10)]), (yyvsp[(5) - (10)]), (yyvsp[(6) - (10)]), (yyvsp[(7) - (10)]), (yyvsp[(8) - (10)]), (yyvsp[(9) - (10)])), &(yyloc)); } + break; + + case 61: + + { (yyval) = xxusermacro((yyvsp[(1) - (11)]), xxnewlist9((yyvsp[(2) - (11)]), (yyvsp[(3) - (11)]), (yyvsp[(4) - (11)]), (yyvsp[(5) - (11)]), (yyvsp[(6) - (11)]), (yyvsp[(7) - (11)]), (yyvsp[(8) - (11)]), (yyvsp[(9) - (11)]), (yyvsp[(10) - (11)])), &(yyloc)); } + break; + + case 62: + + { xxpopMode((yyvsp[(1) - (2)])); (yyval) = (yyvsp[(2) - (2)]); } + break; + + case 63: + + { xxpopMode((yyvsp[(1) - (2)])); (yyval) = (yyvsp[(2) - (2)]); } + break; + + case 64: + + { xxpopMode((yyvsp[(1) - (2)])); (yyval) = xxnewlist((yyvsp[(2) - (2)])); + if(wCalls) + warning(_("bad markup (extra space?) at %s:%d:%d"), + parseState.xxBasename, (yylsp[(2) - (2)]).first_line, (yylsp[(2) - (2)]).first_column); + else + warningcall(R_NilValue, _("bad markup (extra space?) at %s:%d:%d"), + parseState.xxBasename, (yylsp[(2) - (2)]).first_line, (yylsp[(2) - (2)]).first_column); + } + break; + + case 65: + + { xxpopMode((yyvsp[(1) - (2)])); (yyval) = (yyvsp[(2) - (2)]); } + break; + + case 66: + + { xxpopMode((yyvsp[(1) - (2)])); (yyval) = (yyvsp[(2) - (2)]); } + break; + + case 67: + + { xxpopMode((yyvsp[(1) - (2)])); (yyval) = (yyvsp[(2) - (2)]); } + break; + + case 68: + + { xxpopMode((yyvsp[(2) - (4)])); (yyval) = (yyvsp[(3) - (4)]); } + break; + + case 69: + + { xxpopMode((yyvsp[(2) - (3)])); (yyval) = xxnewlist(NULL); } + break; + + case 70: + + { xxpopMode((yyvsp[(1) - (2)])); (yyval) = (yyvsp[(2) - (2)]); } + break; + + case 71: + + { xxpopMode((yyvsp[(1) - (2)])); (yyval) = (yyvsp[(2) - (2)]); } + break; + + case 72: + + { xxpopMode((yyvsp[(2) - (4)])); (yyval) = (yyvsp[(3) - (4)]); } + break; + + case 73: + + { xxpopMode((yyvsp[(2) - (3)])); (yyval) = xxnewlist(NULL); } + break; + + case 74: + + { xxpopMode((yyvsp[(1) - (2)])); (yyval) = xxnewlist(xxtag((yyvsp[(2) - (2)]), TEXT, &(yyloc))); } + break; + + case 75: + + { (yyval) = xxpushMode(LATEXLIKE, UNKNOWN, FALSE); } + break; + + case 76: + + { (yyval) = xxpushMode(RLIKE, UNKNOWN, FALSE); } + break; + + case 77: + + { parseState.xxbraceDepth--; (yyval) = xxpushMode(RLIKE, UNKNOWN, FALSE); parseState.xxbraceDepth++; } + break; + + case 78: + + { (yyval) = xxpushMode(INOPTION, UNKNOWN, FALSE); } + break; + + case 79: + + { (yyval) = xxpushMode(VERBATIM, UNKNOWN, FALSE); } + break; + + case 80: + + { (yyval) = xxpushMode(VERBATIM, UNKNOWN, TRUE); } + break; + + case 81: + + { parseState.xxbraceDepth--; (yyval) = xxpushMode(VERBATIM, UNKNOWN, FALSE); parseState.xxbraceDepth++; } + break; + + case 82: + + { (yyval) = xxpushMode(LATEXLIKE, ESCAPE, FALSE); } + break; + + case 83: + + { (yyval) = xxpushMode(LATEXLIKE, LATEXMACRO2, FALSE); } + break; + + case 84: + + { (yyval) = (yyvsp[(2) - (3)]); } + break; + + case 85: + + { (yyval) = xxnewlist(NULL); } + break; + + case 86: + + { (yyval) = (yyvsp[(2) - (4)]); } + break; + + case 87: + + { (yyval) = xxnewlist(NULL); } + break; + + case 88: + + { (yyval) = (yyvsp[(2) - (4)]); } + break; + + case 89: + + { (yyval) = (yyvsp[(2) - (3)]); } + break; + + + + default: break; + } + /* User semantic actions sometimes alter yychar, and that requires + that yytoken be updated with the new translation. We take the + approach of translating immediately before every use of yytoken. + One alternative is translating here after every semantic action, + but that translation would be missed if the semantic action invokes + YYABORT, YYACCEPT, or YYERROR immediately after altering yychar or + if it invokes YYBACKUP. In the case of YYABORT or YYACCEPT, an + incorrect destructor might then be invoked immediately. In the + case of YYERROR or YYBACKUP, subsequent parser actions might lead + to an incorrect destructor call or verbose syntax error message + before the lookahead is translated. */ + YY_SYMBOL_PRINT ("-> $$ =", yyr1[yyn], &yyval, &yyloc); + + YYPOPSTACK (yylen); + yylen = 0; + YY_STACK_PRINT (yyss, yyssp); + + *++yyvsp = yyval; + *++yylsp = yyloc; + + /* Now `shift' the result of the reduction. Determine what state + that goes to, based on the state we popped back to and the rule + number reduced by. */ + + yyn = yyr1[yyn]; + + yystate = yypgoto[yyn - YYNTOKENS] + *yyssp; + if (0 <= yystate && yystate <= YYLAST && yycheck[yystate] == *yyssp) + yystate = yytable[yystate]; + else + yystate = yydefgoto[yyn - YYNTOKENS]; + + goto yynewstate; + + +/*------------------------------------. +| yyerrlab -- here on detecting error | +`------------------------------------*/ +yyerrlab: + /* Make sure we have latest lookahead translation. See comments at + user semantic actions for why this is necessary. */ + yytoken = yychar == YYEMPTY ? YYEMPTY : YYTRANSLATE (yychar); + + /* If not already recovering from an error, report this error. */ + if (!yyerrstatus) + { + ++yynerrs; +#if ! YYERROR_VERBOSE + yyerror (YY_("syntax error")); +#else +# define YYSYNTAX_ERROR yysyntax_error (&yymsg_alloc, &yymsg, \ + yyssp, yytoken) + { + char const *yymsgp = YY_("syntax error"); + int yysyntax_error_status; + yysyntax_error_status = YYSYNTAX_ERROR; + if (yysyntax_error_status == 0) + yymsgp = yymsg; + else if (yysyntax_error_status == 1) + { + if (yymsg != yymsgbuf) + YYSTACK_FREE (yymsg); + yymsg = (char *) YYSTACK_ALLOC (yymsg_alloc); + if (!yymsg) + { + yymsg = yymsgbuf; + yymsg_alloc = sizeof yymsgbuf; + yysyntax_error_status = 2; + } + else + { + yysyntax_error_status = YYSYNTAX_ERROR; + yymsgp = yymsg; + } + } + yyerror (yymsgp); + if (yysyntax_error_status == 2) + goto yyexhaustedlab; + } +# undef YYSYNTAX_ERROR +#endif + } + + yyerror_range[1] = yylloc; + + if (yyerrstatus == 3) + { + /* If just tried and failed to reuse lookahead token after an + error, discard it. */ + + if (yychar <= YYEOF) + { + /* Return failure if at end of input. */ + if (yychar == YYEOF) + YYABORT; + } + else + { + yydestruct ("Error: discarding", + yytoken, &yylval, &yylloc); + yychar = YYEMPTY; + } + } + + /* Else will try to reuse lookahead token after shifting the error + token. */ + goto yyerrlab1; + + +/*---------------------------------------------------. +| yyerrorlab -- error raised explicitly by YYERROR. | +`---------------------------------------------------*/ +yyerrorlab: + + /* Pacify compilers like GCC when the user code never invokes + YYERROR and the label yyerrorlab therefore never appears in user + code. */ + if (/*CONSTCOND*/ 0) + goto yyerrorlab; + + yyerror_range[1] = yylsp[1-yylen]; + /* Do not reclaim the symbols of the rule which action triggered + this YYERROR. */ + YYPOPSTACK (yylen); + yylen = 0; + YY_STACK_PRINT (yyss, yyssp); + yystate = *yyssp; + goto yyerrlab1; + + +/*-------------------------------------------------------------. +| yyerrlab1 -- common code for both syntax error and YYERROR. | +`-------------------------------------------------------------*/ +yyerrlab1: + yyerrstatus = 3; /* Each real token shifted decrements this. */ + + for (;;) + { + yyn = yypact[yystate]; + if (!yypact_value_is_default (yyn)) + { + yyn += YYTERROR; + if (0 <= yyn && yyn <= YYLAST && yycheck[yyn] == YYTERROR) + { + yyn = yytable[yyn]; + if (0 < yyn) + break; + } + } + + /* Pop the current state because it cannot handle the error token. */ + if (yyssp == yyss) + YYABORT; + + yyerror_range[1] = *yylsp; + yydestruct ("Error: popping", + yystos[yystate], yyvsp, yylsp); + YYPOPSTACK (1); + yystate = *yyssp; + YY_STACK_PRINT (yyss, yyssp); + } + + YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN + *++yyvsp = yylval; + YY_IGNORE_MAYBE_UNINITIALIZED_END + + yyerror_range[2] = yylloc; + /* Using YYLLOC is tempting, but would change the location of + the lookahead. YYLOC is available though. */ + YYLLOC_DEFAULT (yyloc, yyerror_range, 2); + *++yylsp = yyloc; + + /* Shift the error token. */ + YY_SYMBOL_PRINT ("Shifting", yystos[yyn], yyvsp, yylsp); + + yystate = yyn; + goto yynewstate; + + +/*-------------------------------------. +| yyacceptlab -- YYACCEPT comes here. | +`-------------------------------------*/ +yyacceptlab: + yyresult = 0; + goto yyreturn; + +/*-----------------------------------. +| yyabortlab -- YYABORT comes here. | +`-----------------------------------*/ +yyabortlab: + yyresult = 1; + goto yyreturn; + +#if !defined yyoverflow || YYERROR_VERBOSE +/*-------------------------------------------------. +| yyexhaustedlab -- memory exhaustion comes here. | +`-------------------------------------------------*/ +yyexhaustedlab: + yyerror (YY_("memory exhausted")); + yyresult = 2; + /* Fall through. */ +#endif + +yyreturn: + if (yychar != YYEMPTY) + { + /* Make sure we have latest lookahead translation. See comments at + user semantic actions for why this is necessary. */ + yytoken = YYTRANSLATE (yychar); + yydestruct ("Cleanup: discarding lookahead", + yytoken, &yylval, &yylloc); + } + /* Do not reclaim the symbols of the rule which action triggered + this YYABORT or YYACCEPT. */ + YYPOPSTACK (yylen); + YY_STACK_PRINT (yyss, yyssp); + while (yyssp != yyss) + { + yydestruct ("Cleanup: popping", + yystos[*yyssp], yyvsp, yylsp); + YYPOPSTACK (1); + } +#ifndef yyoverflow + if (yyss != yyssa) + YYSTACK_FREE (yyss); +#endif +#if YYERROR_VERBOSE + if (yymsg != yymsgbuf) + YYSTACK_FREE (yymsg); +#endif + /* Make sure YYID is used. */ + return YYID (yyresult); +} + + + + + +static SEXP xxpushMode(int newmode, int newitem, int neweqn) +{ + SEXP ans; + PROTECT(ans = allocVector(INTSXP, 7)); + + INTEGER(ans)[0] = parseState.xxmode; /* Lexer mode */ + INTEGER(ans)[1] = parseState.xxitemType; /* What is \item? */ + INTEGER(ans)[2] = parseState.xxbraceDepth; /* Brace depth used in RCODE and VERBATIM */ + INTEGER(ans)[3] = parseState.xxinRString; /* Quote char that started a string */ + INTEGER(ans)[4] = parseState.xxQuoteLine; /* Where the quote was */ + INTEGER(ans)[5] = parseState.xxQuoteCol; /* " */ + INTEGER(ans)[6] = parseState.xxinEqn; /* In the first arg to \eqn or \deqn: no escapes */ + +#if DEBUGMODE + Rprintf("xxpushMode(%d, %s) pushes %d, %s, %d\n", newmode, yytname[YYTRANSLATE(newitem)], + parseState.xxmode, yytname[YYTRANSLATE(parseState.xxitemType)], parseState.xxbraceDepth); +#endif + parseState.xxmode = newmode; + parseState.xxitemType = newitem; + parseState.xxbraceDepth = 0; + parseState.xxinRString = 0; + parseState.xxinEqn = neweqn; + + return ans; +} + +static void xxpopMode(SEXP oldmode) +{ +#if DEBUGVALS + Rprintf("xxpopMode(%d, %s, %d) replaces %d, %s, %d\n", INTEGER(oldmode)[0], yytname[YYTRANSLATE(INTEGER(oldmode)[1])], INTEGER(oldmode)[2], + parseState.xxmode, yytname[YYTRANSLATE(parseState.xxitemType)], parseState.xxbraceDepth); +#endif + parseState.xxmode = INTEGER(oldmode)[0]; + parseState.xxitemType = INTEGER(oldmode)[1]; + parseState.xxbraceDepth = INTEGER(oldmode)[2]; + parseState.xxinRString = INTEGER(oldmode)[3]; + parseState.xxQuoteLine = INTEGER(oldmode)[4]; + parseState.xxQuoteCol = INTEGER(oldmode)[5]; + parseState.xxinEqn = INTEGER(oldmode)[6]; + + UNPROTECT_PTR(oldmode); +} + +static int getDynamicFlag(SEXP item) +{ + SEXP flag = getAttrib(item, install("dynamicFlag")); + if (isNull(flag)) return 0; + else return INTEGER(flag)[0]; +} + +static void setDynamicFlag(SEXP item, int flag) +{ + if (flag) { + SEXP s_dynamicFlag = install("dynamicFlag"); + setAttrib(item, s_dynamicFlag, ScalarInteger(flag)); + } +} + +static SEXP xxnewlist(SEXP item) +{ + SEXP ans, tmp; +#if DEBUGVALS + Rprintf("xxnewlist(item=%p)", item); +#endif + PROTECT(tmp = NewList()); + if (item) { + int flag = getDynamicFlag(item); + PROTECT(ans = GrowList(tmp, item)); + setDynamicFlag(ans, flag); + UNPROTECT_PTR(tmp); + UNPROTECT_PTR(item); + } else ans = tmp; +#if DEBUGVALS + Rprintf(" result: %p is length %d\n", ans, length(ans)); +#endif + return ans; +} + +static SEXP xxnewlist2(SEXP item1, SEXP item2) +{ + return xxlist(xxnewlist(item1), item2); +} + +static SEXP xxnewlist3(SEXP item1, SEXP item2, SEXP item3) +{ + return xxlist(xxnewlist2(item1, item2), item3); +} + +static SEXP xxnewlist4(SEXP item1, SEXP item2, SEXP item3, SEXP item4) +{ + return xxlist(xxnewlist3(item1, item2, item3), item4); +} + +static SEXP xxnewlist5(SEXP item1, SEXP item2, SEXP item3, SEXP item4, SEXP item5) +{ + return xxlist(xxnewlist4(item1, item2, item3, item4), item5); +} + +static SEXP xxnewlist6(SEXP item1, SEXP item2, SEXP item3, SEXP item4, SEXP item5, + SEXP item6) +{ + return xxlist(xxnewlist5(item1, item2, item3, item4, item5), item6); +} + +static SEXP xxnewlist7(SEXP item1, SEXP item2, SEXP item3, SEXP item4, SEXP item5, + SEXP item6, SEXP item7) +{ + return xxlist(xxnewlist6(item1, item2, item3, item4, item5, item6), item7); +} + +static SEXP xxnewlist8(SEXP item1, SEXP item2, SEXP item3, SEXP item4, SEXP item5, + SEXP item6, SEXP item7, SEXP item8) +{ + return xxlist(xxnewlist7(item1, item2, item3, item4, item5, item6, item7), item8); +} + +static SEXP xxnewlist9(SEXP item1, SEXP item2, SEXP item3, SEXP item4, SEXP item5, + SEXP item6, SEXP item7, SEXP item8, SEXP item9) +{ + return xxlist(xxnewlist8(item1, item2, item3, item4, item5, item6, item7, item8), + item9); +} + +static SEXP xxlist(SEXP oldlist, SEXP item) +{ + SEXP ans; + int flag = getDynamicFlag(oldlist) | getDynamicFlag(item); +#if DEBUGVALS + Rprintf("xxlist(oldlist=%p, item=%p)", oldlist, item); +#endif + PROTECT(ans = GrowList(oldlist, item)); + UNPROTECT_PTR(item); + UNPROTECT_PTR(oldlist); + setDynamicFlag(ans, flag); +#if DEBUGVALS + Rprintf(" result: %p is length %d\n", ans, length(ans)); +#endif + return ans; +} + +static SEXP xxmarkup(SEXP header, SEXP body, int flag, YYLTYPE *lloc) +{ + SEXP ans; +#if DEBUGVALS + Rprintf("xxmarkup(header=%p, body=%p)", header, body); +#endif + if (isNull(body)) + PROTECT(ans = allocVector(VECSXP, 0)); + else { + flag |= getDynamicFlag(body); + PROTECT(ans = PairToVectorList(CDR(body))); + UNPROTECT_PTR(body); + } + if (isNull(header)) + PROTECT(header = mkString("LIST")); + + setAttrib(ans, install("Rd_tag"), header); + setAttrib(ans, R_SrcrefSymbol, makeSrcref(lloc, SrcFile)); + UNPROTECT_PTR(header); + setDynamicFlag(ans, flag); +#if DEBUGVALS + Rprintf(" result: %p\n", ans); +#endif + return ans; +} + +static SEXP xxnewcommand(SEXP cmd, SEXP name, SEXP defn, YYLTYPE *lloc) +{ + SEXP ans, prev, thename, thedefn; + char buffer[128]; + const char *c; + int maxarg = 0; +#if DEBUGVALS + Rprintf("xxnewcommand(cmd=%p, name=%p, defn=%p)", cmd, name, defn); +#endif + thename = CADR(name); + thedefn = CADR(defn); + if (TYPEOF(thedefn) == STRSXP) + PROTECT(thedefn = mkString(CHAR(STRING_ELT(thedefn,0)))); + else + PROTECT(thedefn = mkString("")); + if (warnDups) { + prev = findVar(installTrChar(STRING_ELT(thename, 0)), parseState.xxMacroList); + if (prev != R_UnboundValue && strcmp(CHAR(STRING_ELT(cmd,0)), "\\renewcommand")) { + snprintf(buffer, sizeof(buffer), _("Macro '%s' previously defined."), + CHAR(STRING_ELT(thename, 0))); + yyerror(buffer); + } + } + for (c = CHAR(STRING_ELT(thedefn, 0)); *c; c++) { + if (*c == '#' && isdigit(*(c+1))) + maxarg = imax2(maxarg, *(c+1) - '0'); + } + if (maxarg > 4) { + snprintf(buffer, sizeof(buffer), _("At most 4 arguments are allowed for user defined macros.")); + yyerror(buffer); + } + PROTECT(ans = ScalarInteger(USERMACRO + maxarg)); + setAttrib(ans, install("Rd_tag"), cmd); + setAttrib(ans, install("definition"), thedefn); + setAttrib(ans, R_SrcrefSymbol, makeSrcref(lloc, SrcFile)); + defineVar(installTrChar(STRING_ELT(thename, 0)), ans, parseState.xxMacroList); + + UNPROTECT_PTR(thedefn); + UNPROTECT_PTR(cmd); + UNPROTECT_PTR(name); + UNPROTECT_PTR(defn); + return ans; +} + +#define START_MACRO -2 +#define END_MACRO -3 + +static SEXP xxusermacro(SEXP macro, SEXP args, YYLTYPE *lloc) +{ + SEXP ans, value, nextarg; + int i,len; + const char *c, *start ; + +#if DEBUGVALS + Rprintf("xxusermacro(macro=%p, args=%p)", macro, args); +#endif + len = length(args)-1; + PROTECT(ans = allocVector(STRSXP, len + 1)); + value = UserMacroLookup(CHAR(STRING_ELT(macro,0))); + if (TYPEOF(value) == STRSXP) + SET_STRING_ELT(ans, 0, STRING_ELT(value, 0)); + else + error(_("No macro definition for '%s'."), CHAR(STRING_ELT(macro,0))); +/* Rprintf("len = %d", len); */ + for (i = 0, nextarg=args; i < len; i++, nextarg = CDR(nextarg)) { +/* Rprintf("arg i is"); + PrintValue(CADR(CADR(nextarg))); */ + SET_STRING_ELT(ans, i+1, STRING_ELT(CADR(CADR(nextarg)), 0)); + } + UNPROTECT_PTR(args); + + /* Now push the expanded macro onto the input stream, in reverse order */ + xxungetc(END_MACRO); + start = CHAR(STRING_ELT(ans, 0)); + for (c = start + strlen(start); c > start; c--) { + if (c > start + 1 && *(c-2) == '#' && isdigit(*(c-1))) { + int which = *(c-1) - '0'; + const char *arg = CHAR(STRING_ELT(ans, which)); + for (size_t ii = strlen(arg); ii > 0; ii--) xxungetc(arg[ii-1]); + c--; + } else { + xxungetc(*(c-1)); + } + } + xxungetc(START_MACRO); + + SEXP s_Rd_tag = install("Rd_tag"); + setAttrib(ans, s_Rd_tag, mkString("USERMACRO")); + setAttrib(ans, R_SrcrefSymbol, makeSrcref(lloc, SrcFile)); + setAttrib(ans, install("macro"), macro); + UNPROTECT_PTR(macro); +#if DEBUGVALS + Rprintf(" result: %p\n", ans); +#endif + return ans; +} + +static SEXP xxOptionmarkup(SEXP header, SEXP option, SEXP body, int flag, YYLTYPE *lloc) +{ + SEXP ans; +#if DEBUGVALS + Rprintf("xxOptionmarkup(header=%p, option=%p, body=%p)", header, option, body); +#endif + flag |= getDynamicFlag(body); + PROTECT(ans = PairToVectorList(CDR(body))); + UNPROTECT_PTR(body); + setAttrib(ans, install("Rd_tag"), header); + UNPROTECT_PTR(header); + flag |= getDynamicFlag(option); + setAttrib(ans, install("Rd_option"), option); + UNPROTECT_PTR(option); + setAttrib(ans, R_SrcrefSymbol, makeSrcref(lloc, SrcFile)); + setDynamicFlag(ans, flag); +#if DEBUGVALS + Rprintf(" result: %p\n", ans); +#endif + return ans; +} + +static SEXP xxmarkup2(SEXP header, SEXP body1, SEXP body2, int argcount, int flag, YYLTYPE *lloc) +{ + SEXP ans; +#if DEBUGVALS + Rprintf("xxmarkup2(header=%p, body1=%p, body2=%p)", header, body1, body2); +#endif + + PROTECT(ans = allocVector(VECSXP, argcount)); + if (!isNull(body1)) { + int flag1 = getDynamicFlag(body1); + SET_VECTOR_ELT(ans, 0, PairToVectorList(CDR(body1))); + UNPROTECT_PTR(body1); + setDynamicFlag(VECTOR_ELT(ans, 0), flag1); + flag |= flag1; + } + if (!isNull(body2)) { + int flag2; + if (argcount < 2) error("internal error: inconsistent argument count"); + flag2 = getDynamicFlag(body2); + SET_VECTOR_ELT(ans, 1, PairToVectorList(CDR(body2))); + UNPROTECT_PTR(body2); + setDynamicFlag(VECTOR_ELT(ans, 1), flag2); + flag |= flag2; + } + setAttrib(ans, install("Rd_tag"), header); + UNPROTECT_PTR(header); + setAttrib(ans, R_SrcrefSymbol, makeSrcref(lloc, SrcFile)); + setDynamicFlag(ans, flag); +#if DEBUGVALS + Rprintf(" result: %p\n", ans); +#endif + return ans; +} + +static SEXP xxmarkup3(SEXP header, SEXP body1, SEXP body2, SEXP body3, int flag, YYLTYPE *lloc) +{ + SEXP ans; +#if DEBUGVALS + Rprintf("xxmarkup2(header=%p, body1=%p, body2=%p, body3=%p)", header, body1, body2, body3); +#endif + + PROTECT(ans = allocVector(VECSXP, 3)); + if (!isNull(body1)) { + int flag1 = getDynamicFlag(body1); + SET_VECTOR_ELT(ans, 0, PairToVectorList(CDR(body1))); + UNPROTECT_PTR(body1); + setDynamicFlag(VECTOR_ELT(ans, 0), flag1); + flag |= flag1; + } + if (!isNull(body2)) { + int flag2; + flag2 = getDynamicFlag(body2); + SET_VECTOR_ELT(ans, 1, PairToVectorList(CDR(body2))); + UNPROTECT_PTR(body2); + setDynamicFlag(VECTOR_ELT(ans, 1), flag2); + flag |= flag2; + } + if (!isNull(body3)) { + int flag3; + flag3 = getDynamicFlag(body3); + SET_VECTOR_ELT(ans, 2, PairToVectorList(CDR(body3))); + UNPROTECT_PTR(body3); + setDynamicFlag(VECTOR_ELT(ans, 2), flag3); + flag |= flag3; + } + setAttrib(ans, install("Rd_tag"), header); + UNPROTECT_PTR(header); + setAttrib(ans, R_SrcrefSymbol, makeSrcref(lloc, SrcFile)); + setDynamicFlag(ans, flag); +#if DEBUGVALS + Rprintf(" result: %p\n", ans); +#endif + return ans; +} + +static void xxsavevalue(SEXP Rd, YYLTYPE *lloc) +{ + int flag = getDynamicFlag(Rd); + PROTECT(parseState.Value = PairToVectorList(CDR(Rd))); + if (!isNull(parseState.Value)) { + setAttrib(parseState.Value, R_ClassSymbol, mkString("Rd")); + setAttrib(parseState.Value, R_SrcrefSymbol, makeSrcref(lloc, SrcFile)); + setDynamicFlag(parseState.Value, flag); + } + UNPROTECT_PTR(Rd); +} + +static SEXP xxtag(SEXP item, int type, YYLTYPE *lloc) +{ + SEXP s_Rd_tag = install("Rd_tag"); + setAttrib(item, s_Rd_tag, mkString(yytname[YYTRANSLATE(type)])); + setAttrib(item, R_SrcrefSymbol, makeSrcref(lloc, SrcFile)); + return item; +} + +static void xxWarnNewline() +{ + if (parseState.xxNewlineInString) { + if(wCalls) + warning(_("newline within quoted string at %s:%d"), + parseState.xxBasename, parseState.xxNewlineInString); + else + warningcall(R_NilValue, + _("newline within quoted string at %s:%d"), + parseState.xxBasename, parseState.xxNewlineInString); + } +} + + +/*----------------------------------------------------------------------------*/ + + +static int (*ptr_getc)(void); + +/* Private pushback, since file ungetc only guarantees one byte. + We need arbitrarily large size, since this is how macros are expanded. */ + +#define PUSH_BACK(c) do { \ + if (npush >= pushsize - 1) { \ + int *old = pushbase; \ + pushsize *= 2; \ + pushbase = malloc(pushsize*sizeof(int)); \ + if(!pushbase) error(_("unable to allocate buffer for long macro at line %d"), parseState.xxlineno);\ + memmove(pushbase, old, npush*sizeof(int)); \ + if(old != pushback) free(old); } \ + pushbase[npush++] = (c); \ +} while(0) + + + +#define PUSHBACK_BUFSIZE 32 + +static int pushback[PUSHBACK_BUFSIZE]; +static int *pushbase; +static unsigned int npush, pushsize; +static int macrolevel; +static int prevpos = 0; +static int prevlines[PUSHBACK_BUFSIZE]; +static int prevcols[PUSHBACK_BUFSIZE]; +static int prevbytes[PUSHBACK_BUFSIZE]; + + +static int xxgetc(void) +{ + int c, oldpos; + + do { + if(npush) { + c = pushbase[--npush]; + if (c == START_MACRO) { + macrolevel++; + if (macrolevel > 1000) + error(_("macros nested too deeply: infinite recursion?")); + } else if (c == END_MACRO) macrolevel--; + } else c = ptr_getc(); + } while (c == START_MACRO || c == END_MACRO); + + if (!macrolevel) { + oldpos = prevpos; + prevpos = (prevpos + 1) % PUSHBACK_BUFSIZE; + prevbytes[prevpos] = parseState.xxbyteno; + prevlines[prevpos] = parseState.xxlineno; + /* We only advance the column for the 1st byte in UTF-8, so handle later bytes specially */ + if (0x80 <= (unsigned char)c && (unsigned char)c <= 0xBF) { + parseState.xxcolno--; + prevcols[prevpos] = prevcols[oldpos]; + } else + prevcols[prevpos] = parseState.xxcolno; + + if (c == EOF) return R_EOF; + + R_ParseContextLast = (R_ParseContextLast + 1) % PARSE_CONTEXT_SIZE; + R_ParseContext[R_ParseContextLast] = (char) c; + + if (c == '\n') { + parseState.xxlineno += 1; + parseState.xxcolno = 1; + parseState.xxbyteno = 1; + } else { + parseState.xxcolno++; + parseState.xxbyteno++; + } + + if (c == '\t') parseState.xxcolno = ((parseState.xxcolno + 6) & ~7) + 1; + + R_ParseContextLine = parseState.xxlineno; + } + /* Rprintf("get %c\n", c); */ + return c; +} + +static int xxungetc(int c) +{ + /* this assumes that c was the result of xxgetc; if not, some edits will be needed */ + if (c == END_MACRO) macrolevel++; + if (!macrolevel) { + parseState.xxlineno = prevlines[prevpos]; + parseState.xxbyteno = prevbytes[prevpos]; + parseState.xxcolno = prevcols[prevpos]; + prevpos = (prevpos + PUSHBACK_BUFSIZE - 1) % PUSHBACK_BUFSIZE; + + R_ParseContextLine = parseState.xxlineno; + + R_ParseContext[R_ParseContextLast] = '\0'; + /* macOS requires us to keep this non-negative */ + R_ParseContextLast = (R_ParseContextLast + PARSE_CONTEXT_SIZE - 1) + % PARSE_CONTEXT_SIZE; + } + if (c == START_MACRO) macrolevel--; + PUSH_BACK(c); + /* Rprintf("unget %c;", c); */ + return c; +} + +static SEXP makeSrcref(YYLTYPE *lloc, SEXP srcfile) +{ + SEXP val; + + PROTECT(val = allocVector(INTSXP, 6)); + INTEGER(val)[0] = lloc->first_line; + INTEGER(val)[1] = lloc->first_byte; + INTEGER(val)[2] = lloc->last_line; + INTEGER(val)[3] = lloc->last_byte; + INTEGER(val)[4] = lloc->first_column; + INTEGER(val)[5] = lloc->last_column; + setAttrib(val, R_SrcfileSymbol, srcfile); + setAttrib(val, R_ClassSymbol, mkString("srcref")); + UNPROTECT(1); + return val; +} + +static SEXP mkString2(const char *s, size_t len) +{ + SEXP t; + cetype_t enc = CE_UTF8; + + PROTECT(t = allocVector(STRSXP, 1)); + SET_STRING_ELT(t, 0, mkCharLenCE(s, (int) len, enc)); + UNPROTECT(1); + return t; +} + + +/* Stretchy List Structures : Lists are created and grown using a special */ +/* dotted pair. The CAR of the list points to the last cons-cell in the */ +/* list and the CDR points to the first. The list can be extracted from */ +/* the pair by taking its CDR, while the CAR gives fast access to the end */ +/* of the list. */ + + +/* Create a stretchy-list dotted pair */ + +static SEXP NewList(void) +{ + SEXP s = CONS(R_NilValue, R_NilValue); + SETCAR(s, s); + return s; +} + +/* Add a new element at the end of a stretchy list */ + +static SEXP GrowList(SEXP l, SEXP s) +{ + SEXP tmp; + PROTECT(s); + tmp = CONS(s, R_NilValue); + UNPROTECT(1); + SETCDR(CAR(l), tmp); + SETCAR(l, tmp); + return l; +} + +/*--------------------------------------------------------------------------*/ + +static SEXP ParseRd(ParseStatus *status, SEXP srcfile, Rboolean fragment, SEXP macros) +{ + Rboolean keepmacros = !isLogical(macros) || asLogical(macros); + + R_ParseContextLast = 0; + R_ParseContext[0] = '\0'; + + parseState.xxlineno = 1; + parseState.xxcolno = 1; + parseState.xxbyteno = 1; + + SrcFile = srcfile; + + npush = 0; + pushbase = pushback; + pushsize = PUSHBACK_BUFSIZE; + macrolevel = 0; + + parseState.xxmode = LATEXLIKE; + parseState.xxitemType = UNKNOWN; + parseState.xxbraceDepth = 0; + parseState.xxinRString = 0; + parseState.xxNewlineInString = 0; + parseState.xxinEqn = 0; + if (fragment) parseState.xxinitvalue = STARTFRAGMENT; + else parseState.xxinitvalue = STARTFILE; + + if (!isEnvironment(macros)) + macros = InstallKeywords(); + + PROTECT(macros); + PROTECT(parseState.xxMacroList = R_NewHashedEnv(macros, ScalarInteger(0))); + UNPROTECT_PTR(macros); + + parseState.Value = R_NilValue; + + if (yyparse()) *status = PARSE_ERROR; + else *status = PARSE_OK; + + if (keepmacros && !isNull(parseState.Value)) + setAttrib(parseState.Value, install("macros"), parseState.xxMacroList); + +#if DEBUGVALS + Rprintf("ParseRd result: %p\n", parseState.Value); +#endif + UNPROTECT_PTR(parseState.Value); + UNPROTECT_PTR(parseState.xxMacroList); + + if (pushbase != pushback) free(pushbase); + + return parseState.Value; +} + +#include "Rconnections.h" +static Rconnection con_parse; + +/* need to handle incomplete last line */ +static int con_getc(void) +{ + int c; + static int last=-1000; + + c = Rconn_fgetc(con_parse); + if (c == EOF && last != '\n') c = '\n'; + return (last = c); +} + +static +SEXP R_ParseRd(Rconnection con, ParseStatus *status, SEXP srcfile, Rboolean fragment, SEXP macros) +{ + con_parse = con; + ptr_getc = con_getc; + return ParseRd(status, srcfile, fragment, macros); +} + +/*---------------------------------------------------------------------------- + * + * The Lexical Analyzer: + * + * Basic lexical analysis is performed by the following + * routines. + * + * The function yylex() scans the input, breaking it into + * tokens which are then passed to the parser. + * + */ + + +/* Special Symbols */ +/* Section and R code headers */ + +struct { + char *name; + int token; +} + +/* When adding keywords here, make sure all the handlers + are also modified: checkRd, Rd2HTML, Rd2latex, Rd2txt, any other new ones... */ + +static keywords[] = { + /* These sections contain Latex-like text */ + + { "\\author", SECTIONHEADER }, + { "\\concept", SECTIONHEADER }, + { "\\description",SECTIONHEADER }, + { "\\details", SECTIONHEADER }, + { "\\docType", SECTIONHEADER }, + + { "\\encoding",SECTIONHEADER }, + { "\\format", SECTIONHEADER }, + { "\\keyword", SECTIONHEADER }, + { "\\note", SECTIONHEADER }, + { "\\references", SECTIONHEADER }, + + { "\\section", SECTIONHEADER2 }, + { "\\seealso", SECTIONHEADER }, + { "\\source", SECTIONHEADER }, + { "\\title", SECTIONHEADER }, + + /* These sections contain R-like text */ + + { "\\examples",RSECTIONHEADER }, + { "\\usage", RSECTIONHEADER }, + + /* These sections contain verbatim text */ + + { "\\alias", VSECTIONHEADER }, + { "\\name", VSECTIONHEADER }, + { "\\synopsis",VSECTIONHEADER }, + { "\\Rdversion",VSECTIONHEADER }, + + /* These macros take no arguments. One character non-alpha escapes get the + same token value */ + + { "\\cr", ESCAPE }, + { "\\dots", ESCAPE }, + { "\\ldots", ESCAPE }, + { "\\R", ESCAPE }, + { "\\tab", ESCAPE }, + + /* These macros take one LaTeX-like argument. */ + + { "\\acronym", LATEXMACRO }, + { "\\bold", LATEXMACRO }, + { "\\cite", LATEXMACRO }, + { "\\command", LATEXMACRO }, + { "\\dfn", LATEXMACRO }, + { "\\dQuote", LATEXMACRO }, + { "\\email", LATEXMACRO }, + + { "\\emph", LATEXMACRO }, + { "\\file", LATEXMACRO }, + { "\\linkS4class", LATEXMACRO }, + { "\\pkg", LATEXMACRO }, + { "\\sQuote", LATEXMACRO }, + + { "\\strong", LATEXMACRO }, + + { "\\var", LATEXMACRO }, + + /* These are like SECTIONHEADER/LATEXMACRO, but they change the interpretation of \item */ + + { "\\arguments",LISTSECTION }, + { "\\value", LISTSECTION }, + + { "\\describe",DESCRIPTION }, + { "\\enumerate",ITEMIZE }, + { "\\itemize", ITEMIZE }, + + { "\\item", NOITEM }, /* will change to UNKNOWN, ESCAPE, or LATEXMACRO2 depending on context */ + + /* These macros take two LaTeX-like arguments. */ + + { "\\enc", LATEXMACRO2 }, + { "\\if", LATEXMACRO2 }, + { "\\method", LATEXMACRO2 }, + { "\\S3method",LATEXMACRO2 }, + { "\\S4method",LATEXMACRO2 }, + { "\\tabular", LATEXMACRO2 }, + { "\\subsection", LATEXMACRO2 }, + + /* This macro takes one verbatim and one LaTeX-like argument. */ + + { "\\href", VERBLATEX }, + + /* This macro takes three LaTeX-like arguments. */ + + { "\\ifelse", LATEXMACRO3 }, + + /* These macros take one optional bracketed option and always take + one LaTeX-like argument */ + + { "\\link", OPTMACRO }, + + /* These markup macros require an R-like text argument */ + + { "\\code", RCODEMACRO }, + { "\\dontshow",RCODEMACRO }, + { "\\donttest",RCODEMACRO }, + { "\\testonly",RCODEMACRO }, + + /* This macro takes one optional bracketed option and one R-like argument */ + + { "\\Sexpr", SEXPR }, + + /* This is just like a VSECTIONHEADER, but it needs SEXPR processing */ + + { "\\RdOpts", RDOPTS }, + + /* These macros take one verbatim arg and ignore everything except braces */ + + { "\\dontrun", VERBMACRO }, /* at least for now */ + { "\\env", VERBMACRO }, + { "\\kbd", VERBMACRO }, + { "\\option", VERBMACRO }, + { "\\out", VERBMACRO }, + { "\\preformatted", VERBMACRO }, + + { "\\samp", VERBMACRO }, + { "\\special", VERBMACRO }, + { "\\url", VERBMACRO }, + { "\\verb", VERBMACRO }, + + /* These ones take one or two verbatim args */ + + { "\\eqn", VERBMACRO2 }, + { "\\deqn", VERBMACRO2 }, + { "\\figure", VERBMACRO2 }, + + /* We parse IFDEF/IFNDEF as markup, not as a separate preprocessor step */ + + { "#ifdef", IFDEF }, + { "#ifndef", IFDEF }, + { "#endif", ENDIF }, + + /* These allow user defined macros */ + { "\\newcommand", NEWCOMMAND }, + { "\\renewcommand", NEWCOMMAND }, + + { 0, 0 } + /* All other markup macros are rejected. */ +}; + +/* Record the longest # directive here */ +#define DIRECTIVE_LEN 7 + +static SEXP InstallKeywords() +{ + int i, num; + SEXP result, name, val; + num = sizeof(keywords)/sizeof(keywords[0]); + PROTECT(result = R_NewHashedEnv(R_EmptyEnv, ScalarInteger(num))); + for (i = 0; keywords[i].name; i++) { + PROTECT(name = install(keywords[i].name)); + PROTECT(val = ScalarInteger(keywords[i].token)); + defineVar(name, val, result); + UNPROTECT(2); + } + UNPROTECT(1); + return result; +} + +static int KeywordLookup(const char *s) +{ + SEXP rec = findVar(install(s), parseState.xxMacroList); + if (rec == R_UnboundValue) return UNKNOWN; + else return INTEGER(rec)[0]; +} + +static SEXP UserMacroLookup(const char *s) +{ + SEXP rec = findVar(install(s), parseState.xxMacroList); + if (rec == R_UnboundValue) error(_("Unable to find macro %s"), s); + PROTECT(rec); + SEXP res = getAttrib(rec, install("definition")); + UNPROTECT(1); + return res; +} + +static void yyerror(const char *s) +{ + static const char *const yytname_translations[] = + { + /* the left column are strings coming from bison, the right + column are translations for users. + The first YYENGLISH from the right column are English to be translated, + the rest are to be copied literally. The #if 0 block below allows xgettext + to see these. + */ +#define YYENGLISH 17 + "$undefined", "input", + "SECTIONHEADER","section header", + "RSECTIONHEADER","section header", + "VSECTIONHEADER","section header", + "LISTSECTION", "section header", + + "LATEXMACRO", "macro", + "LATEXMACRO2", "macro", + "LATEXMACRO3", "macro", + "RCODEMACRO", "macro", + "VERBMACRO", "macro", + "VERBMACRO2", "macro", + + "ESCAPE", "macro", + "ITEMIZE", "macro", + "IFDEF", "conditional", + "SECTIONHEADER2","section header", + "OPTMACRO", "macro", + + "DESCRIPTION", "macro", + "VERB", "VERBATIM TEXT", + 0, 0 + }; + static char const yyunexpected[] = "syntax error, unexpected "; + static char const yyexpecting[] = ", expecting "; + static char const yyshortunexpected[] = "unexpected %s"; + static char const yylongunexpected[] = "unexpected %s '%s'"; + char *expecting; + char ParseErrorMsg[PARSE_ERROR_SIZE]; + SEXP filename; + char ParseErrorFilename[PARSE_ERROR_SIZE]; + + xxWarnNewline(); /* post newline warning if necessary */ + + /* + R_ParseError = yylloc.first_line; + R_ParseErrorCol = yylloc.first_column; + R_ParseErrorFile = SrcFile; + */ + + if (!strncmp(s, yyunexpected, sizeof yyunexpected -1)) { + int i, translated = FALSE; + /* Edit the error message */ + expecting = strstr(s + sizeof yyunexpected -1, yyexpecting); + if (expecting) *expecting = '\0'; + for (i = 0; yytname_translations[i]; i += 2) { + if (!strcmp(s + sizeof yyunexpected - 1, yytname_translations[i])) { + if (yychar < 256) + snprintf(ParseErrorMsg, PARSE_ERROR_SIZE, + _(yyshortunexpected), + i/2 < YYENGLISH ? _(yytname_translations[i+1]) + : yytname_translations[i+1]); + else + snprintf(ParseErrorMsg, PARSE_ERROR_SIZE, + _(yylongunexpected), + i/2 < YYENGLISH ? _(yytname_translations[i+1]) + : yytname_translations[i+1], + CHAR(STRING_ELT(yylval, 0))); + translated = TRUE; + break; + } + } + if (!translated) { + if (yychar < 256) + snprintf(ParseErrorMsg, PARSE_ERROR_SIZE, _(yyshortunexpected), + s + sizeof yyunexpected - 1); + else + snprintf(ParseErrorMsg, PARSE_ERROR_SIZE, _(yylongunexpected), + s + sizeof yyunexpected - 1, CHAR(STRING_ELT(yylval, 0))); + } + if (expecting) { + translated = FALSE; + for (i = 0; yytname_translations[i]; i += 2) { + if (!strcmp(expecting + sizeof yyexpecting - 1, yytname_translations[i])) { + strcat(ParseErrorMsg, _(yyexpecting)); + strcat(ParseErrorMsg, i/2 < YYENGLISH ? _(yytname_translations[i+1]) + : yytname_translations[i+1]); + translated = TRUE; + break; + } + } + if (!translated) { + strcat(ParseErrorMsg, _(yyexpecting)); + strcat(ParseErrorMsg, expecting + sizeof yyexpecting - 1); + } + } + } else if (!strncmp(s, yyunknown, sizeof yyunknown-1)) { + snprintf(ParseErrorMsg, PARSE_ERROR_SIZE, + "%s '%s'", s, CHAR(STRING_ELT(yylval, 0))); + } else { + snprintf(ParseErrorMsg, PARSE_ERROR_SIZE, "%s", s); + } + filename = findVar(install("filename"), SrcFile); + if (isString(filename) && LENGTH(filename)) + strncpy(ParseErrorFilename, CHAR(STRING_ELT(filename, 0)), PARSE_ERROR_SIZE - 1); + else + ParseErrorFilename[0] = '\0'; + if (wCalls) { + if (yylloc.first_line != yylloc.last_line) + warning("%s:%d-%d: %s", + ParseErrorFilename, yylloc.first_line, yylloc.last_line, ParseErrorMsg); + else + warning("%s:%d: %s", + ParseErrorFilename, yylloc.first_line, ParseErrorMsg); + } else { + if (yylloc.first_line != yylloc.last_line) + warningcall(R_NilValue, "%s:%d-%d: %s", + ParseErrorFilename, yylloc.first_line, yylloc.last_line, ParseErrorMsg); + else + warningcall(R_NilValue, "%s:%d: %s", + ParseErrorFilename, yylloc.first_line, ParseErrorMsg); + } +} + +#define TEXT_PUSH(c) do { \ + size_t nc = bp - stext; \ + if (nc >= nstext - 1) { \ + char *old = stext; \ + nstext *= 2; \ + stext = malloc(nstext); \ + if(!stext) error(_("unable to allocate buffer for long string at line %d"), parseState.xxlineno);\ + memmove(stext, old, nc); \ + if(old != st0) free(old); \ + bp = stext+nc; } \ + *bp++ = ((char) c); \ +} while(0) + +static void setfirstloc(void) +{ + yylloc.first_line = parseState.xxlineno; + yylloc.first_column = parseState.xxcolno; + yylloc.first_byte = parseState.xxbyteno; +} + +static void setlastloc(void) +{ + yylloc.last_line = prevlines[prevpos]; + yylloc.last_column = prevcols[prevpos]; + yylloc.last_byte = prevbytes[prevpos]; +} + +/* Split the input stream into tokens. */ +/* This is the lowest of the parsing levels. */ + +static int token(void) +{ + int c, lookahead; + int outsideLiteral = parseState.xxmode == LATEXLIKE || parseState.xxmode == INOPTION || parseState.xxbraceDepth == 0; + + if (parseState.xxinitvalue) { + yylloc.first_line = 0; + yylloc.first_column = 0; + yylloc.first_byte = 0; + yylloc.last_line = 0; + yylloc.last_column = 0; + yylloc.last_byte = 0; + PROTECT(yylval = mkString("")); + c = parseState.xxinitvalue; + parseState.xxinitvalue = 0; + return(c); + } + + setfirstloc(); + c = xxgetc(); + + switch (c) { + case '%': if (!parseState.xxinEqn) return mkComment(c); + break; + case '\\': + if (!parseState.xxinEqn) { + lookahead = xxungetc(xxgetc()); + if (isalpha(lookahead) && parseState.xxmode != VERBATIM + /* In R strings, only link or var is allowed as markup */ + && (lookahead == 'l' || lookahead == 'v' || !parseState.xxinRString)) + return mkMarkup(c); + } + break; + case R_EOF: + if (parseState.xxinRString) { + xxWarnNewline(); + error(_("Unexpected end of input (in %c quoted string opened at %s:%d:%d)"), + parseState.xxinRString, parseState.xxBasename, parseState.xxQuoteLine, parseState.xxQuoteCol); + } + return END_OF_INPUT; + case '#': + if (!parseState.xxinEqn && yylloc.first_column == 1) return mkIfdef(c); + break; + case LBRACE: + if (!parseState.xxinRString) { + parseState.xxbraceDepth++; + if (outsideLiteral) return c; + } + break; + case RBRACE: + if (!parseState.xxinRString) { + parseState.xxbraceDepth--; + if (outsideLiteral || parseState.xxbraceDepth == 0) return c; + } + break; + case '[': + case ']': + if (parseState.xxmode == INOPTION ) return c; + break; + } + + switch (parseState.xxmode) { + case RLIKE: return mkCode(c); + case INOPTION: + case LATEXLIKE: return mkText(c); + case VERBATIM: return mkVerb(c); + } + + return ERROR; /* We shouldn't get here. */ +} + +#define INITBUFSIZE 128 + +static int mkText(int c) +{ + char st0[INITBUFSIZE]; + unsigned int nstext = INITBUFSIZE; + char *stext = st0, *bp = st0, lookahead; + + while(1) { + switch (c) { + case '\\': + lookahead = (char) xxgetc(); + if (lookahead == LBRACE || lookahead == RBRACE || + lookahead == '%' || lookahead == '\\') { + c = lookahead; + break; + } + xxungetc(lookahead); + if (isalpha(lookahead)) goto stop; + case ']': + if (parseState.xxmode == INOPTION) goto stop; + break; + case '%': + case LBRACE: + case RBRACE: + case R_EOF: + goto stop; + } + TEXT_PUSH(c); + if (c == '\n') goto stop; + c = xxgetc(); + }; +stop: + if (c != '\n') xxungetc(c); /* newline causes a break, but we keep it */ + PROTECT(yylval = mkString2(stext, bp - stext)); + if(stext != st0) free(stext); + return TEXT; +} + +static int mkComment(int c) +{ + char st0[INITBUFSIZE]; + unsigned int nstext = INITBUFSIZE; + char *stext = st0, *bp = st0; + + do TEXT_PUSH(c); + while ((c = xxgetc()) != '\n' && c != R_EOF); + + xxungetc(c); + + PROTECT(yylval = mkString2(stext, bp - stext)); + if(stext != st0) free(stext); + return COMMENT; +} + +static int mkCode(int c) +{ + char st0[INITBUFSIZE]; + unsigned int nstext = INITBUFSIZE; + char *stext = st0, *bp = st0; + + /* Avoid double counting initial braces */ + if (c == LBRACE && !parseState.xxinRString) parseState.xxbraceDepth--; + if (c == RBRACE && !parseState.xxinRString) parseState.xxbraceDepth++; + + while(1) { + int escaped = 0; + if (c == '\\') { + int lookahead = xxgetc(); + if (lookahead == '\\' || lookahead == '%') { + c = lookahead; + escaped = 1; + } else xxungetc(lookahead); + } + if ((!escaped && c == '%') || c == R_EOF) break; + if (parseState.xxinRString) { + /* This stuff is messy, because there are two levels of escaping: + The Rd escaping and the R code string escaping. */ + if (c == '\\') { + int lookahead = xxgetc(); + if (lookahead == '\\') { /* This must be the 3rd backslash */ + lookahead = xxgetc(); + if (lookahead == parseState.xxinRString || lookahead == '\\') { + TEXT_PUSH(c); + c = lookahead; + escaped = 1; + } else { + xxungetc(lookahead); /* put back the 4th char */ + xxungetc('\\'); /* and the 3rd */ + } + } else if (lookahead == parseState.xxinRString) { /* There could be one or two before this */ + TEXT_PUSH(c); + c = lookahead; + escaped = 1; + } else if (!escaped && (lookahead == 'l' || lookahead == 'v')) { + /* assume \link or \var; this breaks vertical tab, but does anyone ever use that? */ + xxungetc(lookahead); + break; + } else xxungetc(lookahead); + } + if (!escaped && c == parseState.xxinRString) + parseState.xxinRString = 0; + } else { + if (c == '#') { + do { + int escaped = 0; + TEXT_PUSH(c); + c = xxgetc(); + if (c == '\\') { + int lookahead = xxgetc(); + if (lookahead == '\\' || lookahead == '%' || lookahead == LBRACE || lookahead == RBRACE) { + c = lookahead; + escaped = 1; + } else xxungetc(lookahead); + } + if (c == LBRACE && !escaped) parseState.xxbraceDepth++; + else if (c == RBRACE && !escaped) parseState.xxbraceDepth--; + } while (c != '\n' && c != R_EOF && parseState.xxbraceDepth > 0); + if (c == RBRACE && !escaped) parseState.xxbraceDepth++; /* avoid double counting */ + } + if (c == '\'' || c == '"' || c == '`') { + parseState.xxinRString = c; + parseState.xxQuoteLine = parseState.xxlineno; + parseState.xxQuoteCol = parseState.xxcolno; + } else if (c == '\\' && !escaped) { + int lookahead = xxgetc(); + if (lookahead == LBRACE || lookahead == RBRACE) { + c = lookahead; + } else if (isalpha(lookahead)) { + xxungetc(lookahead); + c = '\\'; + break; + } else { + TEXT_PUSH('\\'); + c = lookahead; + } + } else if (c == LBRACE) { + parseState.xxbraceDepth++; + } else if (c == RBRACE) { + if (parseState.xxbraceDepth == 1) break; + else parseState.xxbraceDepth--; + } else if (c == R_EOF) break; + } + TEXT_PUSH(c); + if (c == '\n') { + if (parseState.xxinRString && !parseState.xxNewlineInString) + parseState.xxNewlineInString = parseState.xxlineno-1; + break; + } + c = xxgetc(); + } + if (c != '\n') xxungetc(c); + PROTECT(yylval = mkString2(stext, bp - stext)); + if(stext != st0) free(stext); + return RCODE; +} + +static int mkMarkup(int c) +{ + char st0[INITBUFSIZE]; + unsigned int nstext = INITBUFSIZE; + char *stext = st0, *bp = st0; + int retval = 0, attempt = 0; + + TEXT_PUSH(c); + while (isalnum((c = xxgetc()))) TEXT_PUSH(c); + + while (attempt++ < 2) { + /* character escapes are processed as text, not markup */ + if (bp == stext+1) { + TEXT_PUSH(c); + TEXT_PUSH('\0'); + retval = TEXT; + c = xxgetc(); + break; + } else { + TEXT_PUSH('\0'); + retval = KeywordLookup(stext); + if (retval == UNKNOWN && attempt == 1) { /* try again, non-digits only */ + bp--; /* pop the \0 */ + while (isdigit(*(bp-1))) { + xxungetc(c); + c = *(--bp); /* pop the last letter into c */ + } + } else { + if (retval == NOITEM) + retval = parseState.xxitemType; + break; + } + } + } + PROTECT(yylval = mkString2(stext, bp - stext - 1)); + if(stext != st0) free(stext); + xxungetc(c); + return retval; +} + +static int mkIfdef(int c) +{ + char st0[INITBUFSIZE]; + unsigned int nstext = INITBUFSIZE; + char *stext = st0, *bp = st0; + int retval; + + TEXT_PUSH(c); + while (isalpha((c = xxgetc())) && bp - stext <= DIRECTIVE_LEN) TEXT_PUSH(c); + TEXT_PUSH('\0'); + xxungetc(c); + + retval = KeywordLookup(stext); + PROTECT(yylval = mkString2(stext, bp - stext - 1)); + + switch (retval) { + case ENDIF: /* eat chars to the end of the line */ + do { c = xxgetc(); } + while (c != '\n' && c != R_EOF); + break; + case UNKNOWN: + UNPROTECT(1); + bp--; bp--; + for (; bp > stext; bp--) + xxungetc(*bp); + switch (parseState.xxmode) { + case RLIKE: + retval = mkCode(*bp); + break; + case INOPTION: + case LATEXLIKE: + retval = mkText(*bp); + break; + case VERBATIM: + retval = mkVerb(*bp); + break; + } + break; + } + if(stext != st0) free(stext); + return retval; +} + +static int mkVerb(int c) +{ + char st0[INITBUFSIZE]; + unsigned int nstext = INITBUFSIZE; + char *stext = st0, *bp = st0; + + /* Avoid double counting initial braces */ + if (c == LBRACE) parseState.xxbraceDepth--; + if (c == RBRACE) parseState.xxbraceDepth++; + + while(1) { + int escaped = 0; + if (c == '\\') { + int lookahead = xxgetc(); + if (lookahead == '\\' || lookahead == '%' || lookahead == LBRACE || lookahead == RBRACE) { + escaped = 1; + if (parseState.xxinEqn) TEXT_PUSH(c); + c = lookahead; + } else xxungetc(lookahead); + } + if (c == R_EOF) break; + if (!escaped) { + if (c == '%' && !parseState.xxinEqn) break; + else if (c == LBRACE) parseState.xxbraceDepth++; + else if (c == RBRACE) { + if (parseState.xxbraceDepth == 1) break; + else parseState.xxbraceDepth--; + } + } + TEXT_PUSH(c); + if (c == '\n') break; + c = xxgetc(); + }; + if (c != '\n') xxungetc(c); + PROTECT(yylval = mkString2(stext, bp - stext)); + if(stext != st0) free(stext); + return VERB; +} + +static int yylex(void) +{ + int tok = token(); + + if (parseState.xxDebugTokens) { + Rprintf("%d:%d: %s", yylloc.first_line, yylloc.first_column, yytname[YYTRANSLATE(tok)]); + if (parseState.xxinRString) Rprintf("(in %c%c)", parseState.xxinRString, parseState.xxinRString); + if (tok > 255 && tok != END_OF_INPUT) + Rprintf(": %s", CHAR(STRING_ELT(yylval, 0))); + Rprintf("\n"); + } + setlastloc(); + return tok; +} + +static void con_cleanup(void *data) +{ + Rconnection con = data; + if(con->isopen) con->close(con); +} + +static void PutState(ParseState *state) { + state->xxinRString = parseState.xxinRString; + state->xxQuoteLine = parseState.xxQuoteLine; + state->xxQuoteCol = parseState.xxQuoteCol; + state->xxinEqn = parseState.xxinEqn; + state->xxNewlineInString = parseState.xxNewlineInString; + state->xxlineno = parseState.xxlineno; + state->xxbyteno = parseState.xxbyteno; + state->xxcolno = parseState.xxcolno; + state->xxmode = parseState.xxmode; + state->xxitemType = parseState.xxitemType; + state->xxbraceDepth = parseState.xxbraceDepth; + state->xxDebugTokens = parseState.xxDebugTokens; + state->xxBasename = parseState.xxBasename; + state->Value = parseState.Value; + state->xxinitvalue = parseState.xxinitvalue; + state->xxMacroList = parseState.xxMacroList; + state->prevState = parseState.prevState; +} + +static void UseState(ParseState *state) { + parseState.xxinRString = state->xxinRString; + parseState.xxQuoteLine = state->xxQuoteLine; + parseState.xxQuoteCol = state->xxQuoteCol; + parseState.xxinEqn = state->xxinEqn; + parseState.xxNewlineInString = state->xxNewlineInString; + parseState.xxlineno = state->xxlineno; + parseState.xxbyteno = state->xxbyteno; + parseState.xxcolno = state->xxcolno; + parseState.xxmode = state->xxmode; + parseState.xxitemType = state->xxitemType; + parseState.xxbraceDepth = state->xxbraceDepth; + parseState.xxDebugTokens = state->xxDebugTokens; + parseState.xxBasename = state->xxBasename; + parseState.Value = state->Value; + parseState.xxinitvalue = state->xxinitvalue; + parseState.xxMacroList = state->xxMacroList; + parseState.prevState = state->prevState; +} + +static void PushState() { + if (busy) { + ParseState *prev = malloc(sizeof(ParseState)); + PutState(prev); + parseState.prevState = prev; + } else + parseState.prevState = NULL; + busy = TRUE; +} + +static void PopState() { + if (parseState.prevState) { + ParseState *prev = parseState.prevState; + UseState(prev); + free(prev); + } else + busy = FALSE; +} + +/* "do_parseRd" + + .External2(C_parseRd,file, srcfile, encoding, verbose, basename, warningCalls, macros, warndups) + If there is text then that is read and the other arguments are ignored. +*/ + +SEXP parseRd(SEXP call, SEXP op, SEXP args, SEXP env) +{ + args = CDR(args); + + SEXP s = R_NilValue, source; + Rconnection con; + Rboolean wasopen, fragment; + int ifile, wcall; + ParseStatus status; + RCNTXT cntxt; + SEXP macros; + +#if DEBUGMODE + yydebug = 1; +#endif + + R_ParseError = 0; + R_ParseErrorMsg[0] = '\0'; + + PushState(); + + ifile = asInteger(CAR(args)); args = CDR(args); + + con = getConnection(ifile); + wasopen = con->isopen; + source = CAR(args); args = CDR(args); + /* encoding is unused */ + args = CDR(args); + if(!isLogical(CAR(args)) || LENGTH(CAR(args)) != 1) + error(_("invalid '%s' value"), "verbose"); + parseState.xxDebugTokens = asInteger(CAR(args)); args = CDR(args); + parseState.xxBasename = CHAR(STRING_ELT(CAR(args), 0)); args = CDR(args); + fragment = asLogical(CAR(args)); args = CDR(args); + wcall = asLogical(CAR(args)); args = CDR(args); + if (wcall == NA_LOGICAL) + error(_("invalid '%s' value"), "warningCalls"); + wCalls = wcall; + macros = CAR(args); args = CDR(args); + warnDups = asLogical(CAR(args)); + + if (ifile >= 3) {/* file != "" */ + if(!wasopen) { + if(!con->open(con)) error(_("cannot open the connection")); + /* Set up a context which will close the connection on error */ + begincontext(&cntxt, CTXT_CCODE, R_NilValue, R_BaseEnv, R_BaseEnv, + R_NilValue, R_NilValue); + cntxt.cend = &con_cleanup; + cntxt.cenddata = con; + } + if(!con->canread) error(_("cannot read from this connection")); + s = R_ParseRd(con, &status, source, fragment, macros); + if(!wasopen) endcontext(&cntxt); + PopState(); + if (status != PARSE_OK) parseError(call, R_ParseError); + } + else { + PopState(); + error(_("invalid Rd file")); + } + return s; +} + +/* "do_deparseRd" + + .External2(C_deparseRd, element, state) +*/ + +SEXP deparseRd(SEXP e, SEXP state) +{ + SEXP result; + int outlen, *statevals, quoteBraces, inRComment; + const char *c; + char *outbuf, *out, lookahead; + Rboolean escape; + + if(!isString(e) || LENGTH(e) != 1) + error(_("'deparseRd' only supports deparsing character elements")); + e = STRING_ELT(e, 0); + + if(!isInteger(state) || LENGTH(state) != 5) error(_("bad state")); + + PushState(); + + parseState.xxbraceDepth = INTEGER(state)[0]; + parseState.xxinRString = INTEGER(state)[1]; + parseState.xxmode = INTEGER(state)[2]; + parseState.xxinEqn = INTEGER(state)[3]; + quoteBraces = INTEGER(state)[4]; + + if (parseState.xxmode != LATEXLIKE && parseState.xxmode != RLIKE && parseState.xxmode != VERBATIM && parseState.xxmode != COMMENTMODE + && parseState.xxmode != INOPTION && parseState.xxmode != UNKNOWNMODE) { + PopState(); + error(_("bad text mode %d in 'deparseRd'"), parseState.xxmode); + } + + for (c = CHAR(e), outlen=0; *c; c++) { + outlen++; + /* any special char might be escaped */ + if (*c == '{' || *c == '}' || *c == '%' || *c == '\\') outlen++; + } + out = outbuf = R_chk_calloc(outlen+1, sizeof(char)); + inRComment = FALSE; + for (c = CHAR(e); *c; c++) { + escape = FALSE; + if (parseState.xxmode != UNKNOWNMODE) { + switch (*c) { + case '\\': + if (parseState.xxmode == RLIKE && parseState.xxinRString) { + lookahead = *(c+1); + if (lookahead == '\\' || lookahead == parseState.xxinRString || lookahead == 'l') + escape = TRUE; + break; + } /* fall through to % case for non-strings... */ + case '%': + if (parseState.xxmode != COMMENTMODE && !parseState.xxinEqn) + escape = TRUE; + break; + case LBRACE: + case RBRACE: + if (quoteBraces) + escape = TRUE; + else if (!parseState.xxinRString && !parseState.xxinEqn && (parseState.xxmode == RLIKE || parseState.xxmode == VERBATIM)) { + if (*c == LBRACE) parseState.xxbraceDepth++; + else if (parseState.xxbraceDepth <= 0) escape = TRUE; + else parseState.xxbraceDepth--; + } + break; + case '\'': + case '"': + case '`': + if (parseState.xxmode == RLIKE) { + if (parseState.xxinRString) { + if (parseState.xxinRString == *c) parseState.xxinRString = 0; + } else if (!inRComment) parseState.xxinRString = *c; + } + break; + case '#': + if (parseState.xxmode == RLIKE && !parseState.xxinRString) + inRComment = TRUE; + break; + case '\n': + inRComment = FALSE; + break; + } + } + if (escape) + *out++ = '\\'; + *out++ = *c; + } + *out = '\0'; + PROTECT(result = allocVector(VECSXP, 2)); + SET_VECTOR_ELT(result, 0, ScalarString(mkChar(outbuf))); + SET_VECTOR_ELT(result, 1, duplicate(state)); + R_chk_free(outbuf); + + statevals = INTEGER( VECTOR_ELT(result, 1) ); + statevals[0] = parseState.xxbraceDepth; + statevals[1] = parseState.xxinRString; + + PopState(); + + UNPROTECT(1); + return result; +} + diff --git a/com.oracle.truffle.r.native/gnur/patch/src/library/tools/src/init.c b/com.oracle.truffle.r.native/gnur/patch/src/library/tools/src/init.c new file mode 100644 index 0000000000000000000000000000000000000000..a06080eabfc65010a4c841e9fff47c0540d7e26e --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/library/tools/src/init.c @@ -0,0 +1,75 @@ +/* + * R : A Computer Language for Statistical Data Analysis + * Copyright (C) 2003-2017 The R Core Team. + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version. + * + * This program 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 this program; if not, a copy is available at + * https://www.R-project.org/Licenses/ + */ + +#include "tools.h" +#include <R_ext/Rdynload.h> +#include <R_ext/Visibility.h> + +#ifdef UNUSED +/* a test for re-encoding */ +void Renctest(char **x) +{ + Rprintf("'%s', nbytes = %d\n", x[0], strlen(x[0])); +} + +static const R_CMethodDef CEntries[] = { + {"Renctest", (DL_FUNC) &Renctest, 1}, + {NULL, NULL, 0} +}; +#endif + +#define CALLDEF(name, n) {#name, (DL_FUNC) &name, n} + +static const R_CallMethodDef CallEntries[] = { + CALLDEF(codeFilesAppend, 2), + CALLDEF(delim_match, 2), + CALLDEF(dirchmod, 2), + CALLDEF(getfmts, 1), + CALLDEF(Rmd5, 1), + CALLDEF(check_nonASCII, 2), + CALLDEF(check_nonASCII2, 1), + CALLDEF(doTabExpand, 2), + CALLDEF(ps_kill, 2), + CALLDEF(ps_sigs, 1), + CALLDEF(ps_priority, 2), + CALLDEF(startHTTPD, 2), + CALLDEF(stopHTTPD, 0), + CALLDEF(deparseRd, 2), + CALLDEF(splitString, 2), + + {NULL, NULL, 0} +}; + +#define EXTDEF(name, n) {#name, (DL_FUNC) &name, n} +static const R_ExternalMethodDef ExtEntries[] = { + EXTDEF(parseLatex, 4), + EXTDEF(parseRd, 9), + + {NULL, NULL, 0} +}; + + +void attribute_visible +R_init_tools(DllInfo *dll) +{ + R_registerRoutines(dll, NULL, CallEntries, NULL, ExtEntries); + R_useDynamicSymbols(dll, FALSE); + R_forceSymbols(dll, FALSE); +} + diff --git a/com.oracle.truffle.r.native/gnur/patch/src/library/tools/src/tools.h b/com.oracle.truffle.r.native/gnur/patch/src/library/tools/src/tools.h new file mode 100644 index 0000000000000000000000000000000000000000..7ec79fdf7482ddfb31f5d266258964e45162c432 --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/library/tools/src/tools.h @@ -0,0 +1,51 @@ +/* + * R : A Computer Language for Statistical Data Analysis + * Copyright (C) 2003-2016 The R Core Team. + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version. + * + * This program 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 this program; if not, a copy is available at + * https://www.R-project.org/Licenses/ + */ + +#ifndef R_TOOLS_H +#define R_TOOLS_H + +#include <R.h> +#include <Rinternals.h> +#ifdef ENABLE_NLS +#include <libintl.h> +#define _(String) dgettext ("tools", String) +#else +#define _(String) (String) +#endif + +SEXP delim_match(SEXP x, SEXP delims); +SEXP dirchmod(SEXP dr); +SEXP Rmd5(SEXP files); +SEXP check_nonASCII(SEXP text, SEXP ignore_quotes); +SEXP check_nonASCII2(SEXP text); +SEXP doTabExpand(SEXP strings, SEXP starts); +SEXP ps_kill(SEXP pid, SEXP signal); +SEXP ps_sigs(SEXP); +SEXP ps_priority(SEXP pid, SEXP value); +SEXP codeFilesAppend(SEXP f1, SEXP f2); +SEXP getfmts(SEXP format); +SEXP startHTTPD(SEXP sIP, SEXP sPort); +SEXP stopHTTPD(void); +SEXP splitString(SEXP string, SEXP delims); + +SEXP parseLatex(SEXP call, SEXP op, SEXP args, SEXP env); +SEXP parseRd(SEXP call, SEXP op, SEXP args, SEXP env); +SEXP deparseRd(SEXP e, SEXP state); + +#endif diff --git a/com.oracle.truffle.r.native/gnur/patch/src/library/utils/src/init.c b/com.oracle.truffle.r.native/gnur/patch/src/library/utils/src/init.c new file mode 100644 index 0000000000000000000000000000000000000000..ebbaf1054ade905647042d4123f1bc3331276773 --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/library/utils/src/init.c @@ -0,0 +1,125 @@ +/* + * R : A Computer Language for Statistical Data Analysis + * Copyright (C) 2012-2017 The R Core Team. + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version. + * + * This program 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 this program; if not, a copy is available at + * https://www.R-project.org/Licenses/ + */ + +#ifdef HAVE_CONFIG_H +#include <config.h> +#endif + +#include <R.h> +#include <Rinternals.h> + +#include "utils.h" +#include <R_ext/Rdynload.h> +#include <R_ext/Visibility.h> + + +#define CALLDEF(name, n) {#name, (DL_FUNC) &name, n} + +static const R_CallMethodDef CallEntries[] = { + CALLDEF(crc64, 1), + CALLDEF(flushconsole, 0), + CALLDEF(menu, 1), + CALLDEF(nsl, 1), + CALLDEF(objectSize, 1), + CALLDEF(processevents, 0), + CALLDEF(octsize, 1), + + /* Sockets */ + CALLDEF(sockconnect, 2), + CALLDEF(sockread, 2), + CALLDEF(sockclose, 1), + CALLDEF(sockopen, 1), + CALLDEF(socklisten, 1), + CALLDEF(sockwrite, 2), + +#ifdef Win32 + CALLDEF(winver, 0), + CALLDEF(dllversion, 1), + CALLDEF(getClipboardFormats, 0), + CALLDEF(readClipboard, 2), + CALLDEF(writeClipboard, 2), + CALLDEF(getIdentification, 0), + CALLDEF(getWindowTitle, 0), + CALLDEF(setWindowTitle, 1), + CALLDEF(setStatusBar, 1), + CALLDEF(chooseFiles, 5), + CALLDEF(chooseDir, 2), + CALLDEF(getWindowsHandle, 1), + CALLDEF(getWindowsHandles, 2), + CALLDEF(loadRconsole, 1), + CALLDEF(memsize, 1), + CALLDEF(shortpath, 1), +#endif + + {NULL, NULL, 0} +}; + +#define EXTDEF(name, n) {#name, (DL_FUNC) &name, n} + +static const R_ExternalMethodDef ExtEntries[] = { +#ifdef Win32 + EXTDEF(download, 6), +#else + EXTDEF(download, 5), +#endif + EXTDEF(unzip, 7), + EXTDEF(Rprof, 8), + EXTDEF(Rprofmem, 3), + + EXTDEF(countfields, 6), + EXTDEF(readtablehead, 7), + EXTDEF(typeconvert, 5), + EXTDEF(writetable, 11), + + EXTDEF(addhistory, 1), + EXTDEF(loadhistory, 1), + EXTDEF(savehistory, 1), + + EXTDEF(dataentry, 2), + EXTDEF(dataviewer, 2), + EXTDEF(edit, 4), + EXTDEF(fileedit, 3), + EXTDEF(selectlist, 4), + +#ifdef Win32 + EXTDEF(winProgressBar, 6), + EXTDEF(closeWinProgressBar, 1), + EXTDEF(setWinProgressBar, 4), + EXTDEF(winDialog, 2), + EXTDEF(winDialogString, 2), + EXTDEF(winMenuNames, 0), + EXTDEF(winMenuItems, 1), + EXTDEF(winMenuAdd, 3), + EXTDEF(winMenuDel, 2), + + EXTDEF(readRegistry, 4), + EXTDEF(arrangeWindows, 4), +#endif + + {NULL, NULL, 0} +}; + + +void attribute_visible +R_init_utils(DllInfo *dll) +{ + R_registerRoutines(dll, NULL, CallEntries, NULL, ExtEntries); + R_useDynamicSymbols(dll, FALSE); + R_forceSymbols(dll, TRUE); +} diff --git a/com.oracle.truffle.r.native/gnur/patch/src/library/utils/src/utils.h b/com.oracle.truffle.r.native/gnur/patch/src/library/utils/src/utils.h new file mode 100644 index 0000000000000000000000000000000000000000..d46db52e98c359d9b52edcc34019979ca4fbd0c5 --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/library/utils/src/utils.h @@ -0,0 +1,96 @@ +/* + * R : A Computer Language for Statistical Data Analysis + * Copyright (C) 2012-2013 The R Core Team + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version. + * + * This program 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 this program; if not, a copy is available at + * https://www.R-project.org/Licenses/ + */ + +#ifdef ENABLE_NLS +#include <libintl.h> +#define _(String) dgettext ("utils", String) +#else +#define _(String) (String) +#endif + +SEXP objectSize(SEXP s); +SEXP unzip(SEXP args); +SEXP Rprof(SEXP args); +SEXP Rprofmem(SEXP args); + +SEXP countfields(SEXP args); +SEXP flushconsole(void); +SEXP menu(SEXP args); +SEXP readtablehead(SEXP args); +SEXP typeconvert(SEXP call, SEXP op, SEXP args, SEXP env); +SEXP writetable(SEXP call, SEXP op, SEXP args, SEXP env); + +SEXP crc64(SEXP in); +SEXP nsl(SEXP hostname); +SEXP download(SEXP args); + +SEXP sockconnect(SEXP sport, SEXP shost); +SEXP sockread(SEXP sport, SEXP smaxlen); +SEXP sockclose(SEXP sport); +SEXP sockopen(SEXP sport); +SEXP socklisten(SEXP sport); +SEXP sockwrite(SEXP sport, SEXP sstring); + +SEXP addhistory(SEXP call, SEXP op, SEXP args, SEXP rho); +SEXP loadhistory(SEXP call, SEXP op, SEXP args, SEXP rho); +SEXP savehistory(SEXP call, SEXP op, SEXP args, SEXP rho); +SEXP dataentry(SEXP call, SEXP op, SEXP args, SEXP rho); +SEXP dataviewer(SEXP call, SEXP op, SEXP args, SEXP rho); +SEXP edit(SEXP call, SEXP op, SEXP args, SEXP rho); +SEXP fileedit(SEXP call, SEXP op, SEXP args, SEXP rho); +SEXP selectlist(SEXP call, SEXP op, SEXP args, SEXP rho); + +SEXP processevents(void); + +SEXP octsize(SEXP); + +#ifdef Win32 +SEXP winProgressBar(SEXP call, SEXP op, SEXP args, SEXP rho); +SEXP closeWinProgressBar(SEXP call, SEXP op, SEXP args, SEXP rho); +SEXP setWinProgressBar(SEXP call, SEXP op, SEXP args, SEXP rho); + +SEXP winDialog(SEXP call, SEXP op, SEXP args, SEXP env); +SEXP winDialogString(SEXP call, SEXP op, SEXP args, SEXP env); +SEXP winMenuNames(SEXP call, SEXP op, SEXP args, SEXP env); +SEXP winMenuItems(SEXP call, SEXP op, SEXP args, SEXP env); +SEXP winMenuAdd(SEXP call, SEXP op, SEXP args, SEXP env); +SEXP winMenuDel(SEXP call, SEXP op, SEXP args, SEXP env); + +SEXP readRegistry(SEXP call, SEXP op, SEXP args, SEXP env); +SEXP winver(void); +SEXP getClipboardFormats(void); +SEXP readClipboard(SEXP sformat, SEXP sraw); +SEXP writeClipboard(SEXP text, SEXP sformat); +SEXP getIdentification(void); +SEXP getWindowTitle(void); +SEXP setWindowTitle(SEXP title); +SEXP setStatusBar(SEXP text); +SEXP chooseFiles(SEXP def, SEXP action, SEXP smulti, SEXP filters, SEXP sindex); +SEXP chooseDir(SEXP def, SEXP caption); + +SEXP getWindowsHandle(SEXP call, SEXP op, SEXP args, SEXP rho); +SEXP getWindowsHandles(SEXP call, SEXP op, SEXP args, SEXP rho); +SEXP arrangeWindows(SEXP call, SEXP op, SEXP args, SEXP env); + +SEXP dllversion(SEXP path); + +SEXP loadRconsole(SEXP file); +SEXP memsize(SEXP size); +SEXP shortpath(SEXP paths); +#endif diff --git a/com.oracle.truffle.r.native/gnur/patch/src/main/colors.c b/com.oracle.truffle.r.native/gnur/patch/src/main/colors.c new file mode 100644 index 0000000000000000000000000000000000000000..b64599a9415bef2b9dccb47bed68005dcb642a59 --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/main/colors.c @@ -0,0 +1,85 @@ +/* + * R : A Computer Language for Statistical Data Analysis + * Copyright (C) 2012-2014 The R Core Team + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version. + * + * This program 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 this program; if not, a copy is available at + * https://www.R-project.org/Licenses/ + */ + +/* This should be regarded as part of the graphics engine: + it is now a stub for code in grDevices */ + +#ifdef HAVE_CONFIG_H +#include <config.h> +#endif + +#include <Defn.h> +#include <R_ext/GraphicsEngine.h> + +typedef unsigned int (*F1)(SEXP x, int i, unsigned int bg); +typedef const char * (*F2)(unsigned int col); +typedef unsigned int (*F3)(const char *s); +typedef void (*F4)(Rboolean save); + +static F1 ptr_RGBpar3; +static F2 ptr_col2name; +static F3 ptr_R_GE_str2col; +static F4 ptr_savePalette; + +void Rg_set_col_ptrs(F1 f1, F2 f2, F3 f3, F4 f4) +{ + ptr_RGBpar3 = f1; + ptr_col2name = f2; + ptr_R_GE_str2col = f3; + ptr_savePalette = f4; +} + +/* used in grid/src/gpar.c with bg = R_TRANWHITE, + in packages Cairo, canvas and jpeg */ +/* in GraphicsEngine.h */ +unsigned int RGBpar3(SEXP x, int i, unsigned int bg) +{ + if (!ptr_RGBpar3) error("package grDevices must be loaded"); + return (ptr_RGBpar3)(x, i, bg); +} + +/* in GraphicsEngine.h, used by devices */ +unsigned int RGBpar(SEXP x, int i) +{ + return RGBpar3(x, i, R_TRANWHITE); +} + +/* used in grid */ +/* in GraphicsEngine.h */ +const char *col2name(unsigned int col) +{ + if (!ptr_col2name) error("package grDevices must be loaded"); + return (ptr_col2name)(col); +} + +/* used in grDevices for fg and bg of devices */ +/* in GraphicsEngine.h */ +unsigned int R_GE_str2col(const char *s) +{ + if (!ptr_R_GE_str2col) error("package grDevices must be loaded"); + return (ptr_R_GE_str2col)(s); +} + +/* used in engine.c */ +attribute_hidden +void savePalette(Rboolean save) +{ + if (!ptr_savePalette) error("package grDevices must be loaded"); + (ptr_savePalette)(save); +} diff --git a/com.oracle.truffle.r.native/gnur/patch/src/main/contour-common.h b/com.oracle.truffle.r.native/gnur/patch/src/main/contour-common.h new file mode 100644 index 0000000000000000000000000000000000000000..9c3d510a8a0d98c2f8ca267691a5d7ccc91e6acf --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/main/contour-common.h @@ -0,0 +1,336 @@ +/* + * R : A Computer Language for Statistical Data Analysis + * Copyright (C) 1995, 1996 Robert Gentleman and Ross Ihaka + * Copyright (C) 1997--2013 The R Core Team + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version. + * + * This program 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 this program; if not, a copy is available at + * https://www.R-project.org/Licenses/ + */ + + +/* Stuff for labels on contour plots + Originally written by Nicholas Hildreth + Adapted by Paul Murrell +*/ + +/* Included by src/main/plot3d.c and src/library/graphics/src/plot3d */ + + /* C o n t o u r P l o t t i n g */ + +typedef struct SEG { + struct SEG *next; + double x0; + double y0; + double x1; + double y1; +} SEG, *SEGP; + + +static int ctr_intersect(double z0, double z1, double zc, double *f) +{ +/* Old test was ((z0 - zc) * (z1 - zc) < 0.0), but rounding led to inconsistencies + in PR#15454 */ + if ( (z0 < zc) != (z1 < zc) && z0 != zc && z1 != zc ) { + *f = (zc - z0) / (z1 - z0); + return 1; + } + return 0; +} + +static SEGP ctr_newseg(double x0, double y0, double x1, double y1, SEGP prev) +{ + SEGP seg = (SEGP)R_alloc(1, sizeof(SEG)); + seg->x0 = x0; + seg->y0 = y0; + seg->x1 = x1; + seg->y1 = y1; + seg->next = prev; + return seg; +} + +static void ctr_swapseg(SEGP seg) +{ + double x, y; + x = seg->x0; + y = seg->y0; + seg->x0 = seg->x1; + seg->y0 = seg->y1; + seg->x1 = x; + seg->y1 = y; +} + + /* ctr_segdir(): Determine the entry direction to the next cell */ + /* and update the cell indices */ + +#define XMATCH(x0,x1) (fabs(x0-x1) == 0) +#define YMATCH(y0,y1) (fabs(y0-y1) == 0) + +static int ctr_segdir(double xend, double yend, double *x, double *y, + int *i, int *j, int nx, int ny) +{ + if (YMATCH(yend, y[*j])) { + if (*j == 0) + return 0; + *j = *j - 1; + return 3; + } + if (XMATCH(xend, x[*i])) { + if (*i == 0) + return 0; + *i = *i - 1; + return 4; + } + if (YMATCH(yend, y[*j + 1])) { + if (*j >= ny - 1) + return 0; + *j = *j + 1; + return 1; + } + if (XMATCH(xend, x[*i + 1])) { + if (*i >= nx - 1) + return 0; + *i = *i + 1; + return 2; + } + return 0; +} + +/* Search seglist for a segment with endpoint (xend, yend). */ +/* The cell entry direction is dir, and if tail=1/0 we are */ +/* building the tail/head of a contour. The matching segment */ +/* is pointed to by seg and the updated segment list (with */ +/* the matched segment stripped) is returned by the funtion. */ + +static SEGP ctr_segupdate(double xend, double yend, int dir, Rboolean tail, + SEGP seglist, SEGP* seg) +{ + if (seglist == NULL) { + *seg = NULL; + return NULL; + } + switch (dir) { + case 1: + case 3: + if (YMATCH(yend,seglist->y0)) { + if (!tail) + ctr_swapseg(seglist); + *seg = seglist; + return seglist->next; + } + if (YMATCH(yend,seglist->y1)) { + if (tail) + ctr_swapseg(seglist); + *seg = seglist; + return seglist->next; + } + break; + case 2: + case 4: + if (XMATCH(xend,seglist->x0)) { + if (!tail) + ctr_swapseg(seglist); + *seg = seglist; + return seglist->next; + } + if (XMATCH(xend,seglist->x1)) { + if (tail) + ctr_swapseg(seglist); + *seg = seglist; + return seglist->next; + } + break; + } + seglist->next = ctr_segupdate(xend, yend, dir, tail, seglist->next, seg); + return seglist; +} + + + +/* + * Generate a list of segments for a single level + * + * NB this R_allocs its return value, so callers need to manage R_alloc stack. + */ +static SEGP* contourLines(double *x, int nx, double *y, int ny, + double *z, double zc, double atom) +{ + double f, xl, xh, yl, yh, zll, zhl, zlh, zhh, xx[4], yy[4]; + int i, j, k, l, m, nacode; + SEGP seglist; + SEGP *segmentDB; + /* Initialize the segment data base */ + /* Note we must be careful about resetting */ + /* the top of the stack, otherwise we run out of */ + /* memory after a sequence of displaylist replays */ + /* + * This reset is done out in GEcontourLines + */ + segmentDB = (SEGP*)R_alloc(nx*ny, sizeof(SEGP)); + for (i = 0; i < nx; i++) + for (j = 0; j < ny; j++) + segmentDB[i + j * nx] = NULL; + for (i = 0; i < nx - 1; i++) { + xl = x[i]; + xh = x[i + 1]; + for (j = 0; j < ny - 1; j++) { + yl = y[j]; + yh = y[j + 1]; + k = i + j * nx; + zll = z[k]; + zhl = z[k + 1]; + zlh = z[k + nx]; + zhh = z[k + nx + 1]; + + /* If the value at a corner is exactly equal to a contour level, + * change that value by a tiny amount */ + + if (zll == zc) zll += atom; + if (zhl == zc) zhl += atom; + if (zlh == zc) zlh += atom; + if (zhh == zc) zhh += atom; +#ifdef DEBUG_contour + /* Haven't seen this happening (MM): */ + if (zll == zc) REprintf(" [%d,%d] ll: %g\n",i,j, zll); + if (zhl == zc) REprintf(" [%d,%d] hl: %g\n",i,j, zhl); + if (zlh == zc) REprintf(" [%d,%d] lh: %g\n",i,j, zlh); + if (zhh == zc) REprintf(" [%d,%d] hh: %g\n",i,j, zhh); +#endif + /* Check for intersections with sides */ + + nacode = 0; + if (R_FINITE(zll)) nacode += 1; + if (R_FINITE(zhl)) nacode += 2; + if (R_FINITE(zlh)) nacode += 4; + if (R_FINITE(zhh)) nacode += 8; + + k = 0; + switch (nacode) { + case 15: + if (ctr_intersect(zll, zhl, zc, &f)) { + xx[k] = xl + f * (xh - xl); + yy[k] = yl; k++; + } + if (ctr_intersect(zll, zlh, zc, &f)) { + yy[k] = yl + f * (yh - yl); + xx[k] = xl; k++; + } + if (ctr_intersect(zhl, zhh, zc, &f)) { + yy[k] = yl + f * (yh - yl); + xx[k] = xh; k++; + } + if (ctr_intersect(zlh, zhh, zc, &f)) { + xx[k] = xl + f * (xh - xl); + yy[k] = yh; k++; + } + break; + case 14: + if (ctr_intersect(zhl, zhh, zc, &f)) { + yy[k] = yl + f * (yh - yl); + xx[k] = xh; k++; + } + if (ctr_intersect(zlh, zhh, zc, &f)) { + xx[k] = xl + f * (xh - xl); + yy[k] = yh; k++; + } + if (ctr_intersect(zlh, zhl, zc, &f)) { + xx[k] = xl + f * (xh - xl); + yy[k] = yh + f * (yl - yh); + k++; + } + break; + case 13: + if (ctr_intersect(zll, zlh, zc, &f)) { + yy[k] = yl + f * (yh - yl); + xx[k] = xl; k++; + } + if (ctr_intersect(zlh, zhh, zc, &f)) { + xx[k] = xl + f * (xh - xl); + yy[k] = yh; k++; + } + if (ctr_intersect(zll, zhh, zc, &f)) { + xx[k] = xl + f * (xh - xl); + yy[k] = yl + f * (yh - yl); + k++; + } + break; + case 11: + if (ctr_intersect(zhl, zhh, zc, &f)) { + yy[k] = yl + f * (yh - yl); + xx[k] = xh; k++; + } + if (ctr_intersect(zll, zhl, zc, &f)) { + xx[k] = xl + f * (xh - xl); + yy[k] = yl; k++; + } + if (ctr_intersect(zll, zhh, zc, &f)) { + xx[k] = xl + f * (xh - xl); + yy[k] = yl + f * (yh - yl); + k++; + } + break; + case 7: + if (ctr_intersect(zll, zlh, zc, &f)) { + yy[k] = yl + f * (yh - yl); + xx[k] = xl; k++; + } + if (ctr_intersect(zll, zhl, zc, &f)) { + xx[k] = xl + f * (xh - xl); + yy[k] = yl; k++; + } + if (ctr_intersect(zlh, zhl, zc, &f)) { + xx[k] = xl + f * (xh - xl); + yy[k] = yh + f * (yl - yh); + k++; + } + break; + } + + /* We now have k(=2,4) endpoints */ + /* Decide which to join */ + + seglist = NULL; + + if (k > 0) { + if (k == 2) { + seglist = ctr_newseg(xx[0], yy[0], xx[1], yy[1], seglist); + } + else if (k == 4) { + for (k = 3; k >= 1; k--) { + m = k; + xl = xx[k]; + for (l = 0; l < k; l++) { + if (xx[l] > xl) { + xl = xx[l]; + m = l; + } + } + if (m != k) { + xl = xx[k]; + yl = yy[k]; + xx[k] = xx[m]; + yy[k] = yy[m]; + xx[m] = xl; + yy[m] = yl; + } + } + seglist = ctr_newseg(xx[0], yy[0], xx[1], yy[1], seglist); + seglist = ctr_newseg(xx[2], yy[2], xx[3], yy[3], seglist); + } + else error("k = %d, should be 2 or 4", k); + } + segmentDB[i + j * nx] = seglist; + } + } + return segmentDB; +} diff --git a/com.oracle.truffle.r.native/gnur/patch/src/main/devices.c b/com.oracle.truffle.r.native/gnur/patch/src/main/devices.c new file mode 100644 index 0000000000000000000000000000000000000000..69cce7136bd9f601d7076b89ced3622f10f3a706 --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/main/devices.c @@ -0,0 +1,534 @@ +/* + * R : A Computer Language for Statistical Data Analysis + * Copyright (C) 1995, 1996 Robert Gentleman and Ross Ihaka + * Copyright (C) 1997--2015 The R Core Team + * Copyright (C) 2002--2005 The R Foundation + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version. + * + * This program 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 this program; if not, a copy is available at + * https://www.R-project.org/Licenses/ + + + * This is an extensive reworking by Paul Murrell of an original + * quick hack by Ross Ihaka designed to give a superset of the + * functionality in the AT&T Bell Laboratories GRZ library. + * + */ + +/* This should be regarded as part of the graphics engine */ + +#ifdef HAVE_CONFIG_H +#include <config.h> +#endif + +#include <Defn.h> +#include <Internal.h> +#include <Graphics.h> +#include <GraphicsBase.h> +#include <R_ext/GraphicsEngine.h> + +int baseRegisterIndex = -1; + +GPar* dpptr(pGEDevDesc dd) { + if (baseRegisterIndex == -1) + error(_("the base graphics system is not registered")); + baseSystemState *bss = dd->gesd[baseRegisterIndex]->systemSpecific; + return &(bss->dp); +} + +static SEXP R_INLINE getSymbolValue(SEXP symbol) +{ + if (TYPEOF(symbol) != SYMSXP) + error("argument to 'getSymbolValue' is not a symbol"); + return findVar(symbol, R_BaseEnv); +} + +/* + * DEVICE FUNCTIONS + * + * R allows there to be (up to 64) multiple devices in + * existence at the same time. Only one device is the + * active device and all drawing occurs in this device + * + * Each device has its own set of graphics parameters + * so that switching between devices, switches between + * their graphical contexts (e.g., if you set the line + * width on one device then switch to another device, + * don't expect to be using the line width you just set!) + * + * Each device has additional device-specific graphics + * parameters which the device driver (i.e., NOT this + * generic graphics code) is wholly responsible for + * maintaining (including creating and destroying special + * resources such as X11 windows). + * + * Each device has a display list which records every + * graphical operation since the last dpptr(dd)->newPage; + * this is used to redraw the output on the device + * when it is resized and to copy output from one device + * to another (this can be disabled, which is the default + * for postscript). + * + * NOTE: that graphical operations should only be + * recorded in the displayList if they are "guaranteed" + * to succeed (to avoid heaps of error messages on a + * redraw) which means that the recording should be the + * last thing done in a graphical operation (see do_* + * in plot.c). + * + */ + +static int R_CurrentDevice = 0; +static int R_NumDevices = 1; +/* + R_MaxDevices is defined in Rgraphics.h to be 64. Slots are + initiialized to be NULL, and returned to NULL when a device is + removed. + + Slot 0 is the null device, and slot 63 is keep empty as a sentinel + for over-allocation: if a driver fails to call + R_CheckDeviceAvailable and uses this slot the device it allocated + will be killed. + + 'active' means has been successfully opened and is not in the + process of being closed and destroyed. We do this to allow for GUI + callbacks starting to kill a device whilst another is being killed. + */ +static pGEDevDesc R_Devices[R_MaxDevices]; +static Rboolean active[R_MaxDevices]; + +/* a dummy description to point to when there are no active devices */ + +static GEDevDesc nullDevice; + +/* In many cases this is used to mean that the current device is + the null device, and in others to mean that there is no open device. + The two condiions are currently the same, as no way is provided to + select the null device (selectDevice(0) immediately opens a device). + + But watch out if you intend to change the logic of any of this. +*/ + +/* Used in grid */ +int NoDevices(void) +{ + return (R_NumDevices == 1 || R_CurrentDevice == 0); +} + +int NumDevices(void) +{ + return R_NumDevices; +} + +pGEDevDesc GEcurrentDevice(void) +{ + /* If there are no active devices + * check the options for a "default device". + * If there is one, start it up. */ + if (NoDevices()) { + SEXP defdev = GetOption1(install("device")); + if (isString(defdev) && length(defdev) > 0) { + SEXP devName = installTrChar(STRING_ELT(defdev, 0)); + /* Not clear where this should be evaluated, since + grDevices need not be in the search path. + So we look for it first on the global search path. + */ + defdev = findVar(devName, R_GlobalEnv); + if(defdev != R_UnboundValue) { + PROTECT(defdev = lang1(devName)); + eval(defdev, R_GlobalEnv); + UNPROTECT(1); + } else { + /* Not globally visible: + try grDevices namespace if loaded. + The option is unlikely to be set if it is not loaded, + as the default setting is in grDevices:::.onLoad. + */ + SEXP ns = findVarInFrame(R_NamespaceRegistry, + install("grDevices")); + PROTECT(ns); + if(ns != R_UnboundValue && + findVar(devName, ns) != R_UnboundValue) { + PROTECT(defdev = lang1(devName)); + eval(defdev, ns); + UNPROTECT(1); + } else + error(_("no active or default device")); + UNPROTECT(1); + } + } else if(TYPEOF(defdev) == CLOSXP) { + PROTECT(defdev = lang1(defdev)); + eval(defdev, R_GlobalEnv); + UNPROTECT(1); + } else + error(_("no active or default device")); + } + return R_Devices[R_CurrentDevice]; +} + +pGEDevDesc GEgetDevice(int i) +{ + return R_Devices[i]; +} + +int curDevice(void) +{ + return R_CurrentDevice; +} + + +int nextDevice(int from) +{ + if (R_NumDevices == 1) + return 0; + else { + int i = from; + int nextDev = 0; + while ((i < (R_MaxDevices-1)) && (nextDev == 0)) + if (active[++i]) nextDev = i; + if (nextDev == 0) { + /* start again from 1 */ + i = 0; + while ((i < (R_MaxDevices-1)) && (nextDev == 0)) + if (active[++i]) nextDev = i; + } + return nextDev; + } +} + +int prevDevice(int from) +{ + if (R_NumDevices == 1) + return 0; + else { + int i = from; + int prevDev = 0; + if (i < R_MaxDevices) + while ((i > 1) && (prevDev == 0)) + if (active[--i]) prevDev = i; + if (prevDev == 0) { + /* start again from R_MaxDevices */ + i = R_MaxDevices; + while ((i > 1) && (prevDev == 0)) + if (active[--i]) prevDev = i; + } + return prevDev; + } +} + +/* This should be called if you have a pointer to a GEDevDesc + * and you want to find the corresponding device number + */ + +int GEdeviceNumber(pGEDevDesc dd) +{ + int i; + for (i = 1; i < R_MaxDevices; i++) + if (R_Devices[i] == dd) return i; + return 0; +} + +/* This should be called if you have a pointer to a DevDesc + * and you want to find the corresponding device number + */ +int ndevNumber(pDevDesc dd) +{ + int i; + for (i = 1; i < R_MaxDevices; i++) + if (R_Devices[i] != NULL && R_Devices[i]->dev == dd) + return i; + return 0; +} + +int selectDevice(int devNum) +{ + /* Valid to select nullDevice, but that will open a new device. + See ?dev.set. + */ + if((devNum >= 0) && (devNum < R_MaxDevices) && + (R_Devices[devNum] != NULL) && active[devNum]) + { + pGEDevDesc gdd; + + if (!NoDevices()) { + pGEDevDesc oldd = GEcurrentDevice(); + if (oldd->dev->deactivate) oldd->dev->deactivate(oldd->dev); + } + + R_CurrentDevice = devNum; + + /* maintain .Device */ + gsetVar(R_DeviceSymbol, + elt(getSymbolValue(R_DevicesSymbol), devNum), + R_BaseEnv); + + gdd = GEcurrentDevice(); /* will start a device if current is null */ + if (!NoDevices()) /* which it always will be */ + if (gdd->dev->activate) gdd->dev->activate(gdd->dev); + return devNum; + } + else + return selectDevice(nextDevice(devNum)); +} + +/* historically the close was in the [kK]illDevices. + only use findNext = FALSE when shutting R dowm, and .Device[s] are not + updated. +*/ +static +void removeDevice(int devNum, Rboolean findNext) +{ + /* Not vaild to remove nullDevice */ + if((devNum > 0) && (devNum < R_MaxDevices) && + (R_Devices[devNum] != NULL) && active[devNum]) + { + int i; + SEXP s; + pGEDevDesc g = R_Devices[devNum]; + + active[devNum] = FALSE; /* stops it being selected again */ + R_NumDevices--; + + if(findNext) { + /* maintain .Devices */ + PROTECT(s = getSymbolValue(R_DevicesSymbol)); + for (i = 0; i < devNum; i++) s = CDR(s); + SETCAR(s, mkString("")); + UNPROTECT(1); + + /* determine new current device */ + if (devNum == R_CurrentDevice) { + R_CurrentDevice = nextDevice(R_CurrentDevice); + /* maintain .Device */ + gsetVar(R_DeviceSymbol, + elt(getSymbolValue(R_DevicesSymbol), R_CurrentDevice), + R_BaseEnv); + + /* activate new current device */ + if (R_CurrentDevice) { + pGEDevDesc gdd = GEcurrentDevice(); + if(gdd->dev->activate) gdd->dev->activate(gdd->dev); + } + } + } + g->dev->close(g->dev); + GEdestroyDevDesc(g); + R_Devices[devNum] = NULL; + } +} + +void GEkillDevice(pGEDevDesc gdd) +{ + removeDevice(GEdeviceNumber(gdd), TRUE); +} + +void killDevice(int devNum) +{ + removeDevice(devNum, TRUE); +} + + +/* Used by front-ends via R_CleanUp to shutdown all graphics devices + at the end of a session. Not the same as graphics.off(), and leaves + .Devices and .Device in an invalid state. */ +void KillAllDevices(void) +{ + /* Avoid lots of activation followed by removal of devices + while (R_NumDevices > 1) killDevice(R_CurrentDevice); + */ + int i; + for(i = R_MaxDevices-1; i > 0; i--) removeDevice(i, FALSE); + R_CurrentDevice = 0; /* the null device, for tidyness */ + + /* <FIXME> Disable this for now */ + /* + * Free the font and encoding structures used by + * PostScript, Xfig, and PDF devices + */ + /* freeType1Fonts(); + </FIXME>*/ + + /* FIXME: There should really be a formal graphics finaliser + * but this is a good proxy for now. + */ + // unregisterBase(); + if (baseRegisterIndex != -1) { + GEunregisterSystem(baseRegisterIndex); + baseRegisterIndex = -1; + } +} + +/* A common construction in some graphics devices */ +pGEDevDesc desc2GEDesc(pDevDesc dd) +{ + int i; + for (i = 1; i < R_MaxDevices; i++) + if (R_Devices[i] != NULL && R_Devices[i]->dev == dd) + return R_Devices[i]; + /* shouldn't happen ... + but might if device is not yet registered or being killed */ + return R_Devices[0]; /* safe as will not replay a displayList */ +} + +/* ------- interface for creating devices ---------- */ + +void R_CheckDeviceAvailable(void) +{ + if (R_NumDevices >= R_MaxDevices - 1) + error(_("too many open devices")); +} + +Rboolean R_CheckDeviceAvailableBool(void) +{ + if (R_NumDevices >= R_MaxDevices - 1) return FALSE; + else return TRUE; +} + +void GEaddDevice(pGEDevDesc gdd) +{ + int i; + Rboolean appnd; + SEXP s, t; + pGEDevDesc oldd; + + PROTECT(s = getSymbolValue(R_DevicesSymbol)); + + if (!NoDevices()) { + oldd = GEcurrentDevice(); + if(oldd->dev->deactivate) oldd->dev->deactivate(oldd->dev); + } + + /* find empty slot for new descriptor */ + i = 1; + if (CDR(s) == R_NilValue) + appnd = TRUE; + else { + s = CDR(s); + appnd = FALSE; + } + while (R_Devices[i] != NULL) { + i++; + if (CDR(s) == R_NilValue) + appnd = TRUE; + else + s = CDR(s); + } + R_CurrentDevice = i; + R_NumDevices++; + R_Devices[i] = gdd; + active[i] = TRUE; + + GEregisterWithDevice(gdd); + if(gdd->dev->activate) gdd->dev->activate(gdd->dev); + + /* maintain .Devices (.Device has already been set) */ + t = PROTECT(duplicate(getSymbolValue(R_DeviceSymbol))); + if (appnd) + SETCDR(s, CONS(t, R_NilValue)); + else + SETCAR(s, t); + + UNPROTECT(2); + + /* In case a device driver did not call R_CheckDeviceAvailable + before starting its allocation, we complete the allocation and + then call killDevice here. This ensures that the device gets a + chance to deallocate its resources and the current active + device is restored to a sane value. */ + if (i == R_MaxDevices - 1) { + killDevice(i); + error(_("too many open devices")); + } +} + +/* convenience wrappers */ +void GEaddDevice2(pGEDevDesc gdd, const char *name) +{ + gsetVar(R_DeviceSymbol, mkString(name), R_BaseEnv); + GEaddDevice(gdd); + GEinitDisplayList(gdd); +} + +void GEaddDevice2f(pGEDevDesc gdd, const char *name, const char *file) +{ + SEXP f = PROTECT(mkString(name)); + if(file) { + SEXP s_filepath = install("filepath"); + setAttrib(f, s_filepath, mkString(file)); + } + gsetVar(R_DeviceSymbol, f, R_BaseEnv); + UNPROTECT(1); + GEaddDevice(gdd); + GEinitDisplayList(gdd); +} + + +Rboolean Rf_GetOptionDeviceAsk(void); /* from options.c */ + +/* Create a GEDevDesc, given a pDevDesc + */ +pGEDevDesc GEcreateDevDesc(pDevDesc dev) +{ + /* Wrap the device description within a graphics engine + * device description (add graphics engine information + * to the device description). + */ + pGEDevDesc gdd = (GEDevDesc*) calloc(1, sizeof(GEDevDesc)); + /* NULL the gesd array + */ + int i; + if (!gdd) + error(_("not enough memory to allocate device (in GEcreateDevDesc)")); + for (i = 0; i < MAX_GRAPHICS_SYSTEMS; i++) gdd->gesd[i] = NULL; + gdd->dev = dev; + gdd->displayListOn = dev->displayListOn; + gdd->displayList = R_NilValue; /* gc needs this */ + gdd->savedSnapshot = R_NilValue; /* gc needs this */ + gdd->dirty = FALSE; + gdd->recordGraphics = TRUE; + gdd->ask = Rf_GetOptionDeviceAsk(); + gdd->dev->eventEnv = R_NilValue; /* gc needs this */ + return gdd; +} + + +void attribute_hidden InitGraphics(void) +{ + R_Devices[0] = &nullDevice; + active[0] = TRUE; + // these are static arrays, not really needed + for (int i = 1; i < R_MaxDevices; i++) { + R_Devices[i] = NULL; + active[i] = FALSE; + } + + /* init .Device and .Devices */ + SEXP s = PROTECT(mkString("null device")); + gsetVar(R_DeviceSymbol, s, R_BaseEnv); + s = PROTECT(mkString("null device")); + gsetVar(R_DevicesSymbol, CONS(s, R_NilValue), R_BaseEnv); + UNPROTECT(2); +} + + +void NewFrameConfirm(pDevDesc dd) +{ + if(!R_Interactive) return; + /* dd->newFrameConfirm(dd) will either handle this, or return + FALSE to ask the engine to do so. */ + if(dd->newFrameConfirm && dd->newFrameConfirm(dd)) ; + else { + unsigned char buf[1024]; + R_ReadConsole(_("Hit <Return> to see next plot: "), buf, 1024, 0); + } +} diff --git a/com.oracle.truffle.r.native/gnur/patch/src/main/engine.c b/com.oracle.truffle.r.native/gnur/patch/src/main/engine.c new file mode 100644 index 0000000000000000000000000000000000000000..e7b4100de9f6b30e12a4f08396cd5aed2e56d432 --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/main/engine.c @@ -0,0 +1,3611 @@ +/* + * R : A Computer Language for Statistical Data Analysis + * Copyright (C) 2001-2015 The R Core Team. + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version. + * + * This program 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 this program; if not, a copy is available at + * https://www.R-project.org/Licenses/ + */ + +#ifdef HAVE_CONFIG_H +#include <config.h> +#endif + +#include <Defn.h> +#include <Internal.h> +#include <R_ext/GraphicsEngine.h> +#include <R_ext/Applic.h> /* pretty() */ +#include <Rmath.h> + +# include <rlocale.h> + +int R_GE_getVersion() +{ + return R_GE_version; +} + +void R_GE_checkVersionOrDie(int version) +{ + if (version != R_GE_version) + error(_("Graphics API version mismatch")); +} + +/* A note on memory management ... + * Here (with GEDevDesc's) I have continued the deplorable tradition of + * malloc'ing device structures and maintaining global variables to + * record the device structures. I believe that what I should + * be doing is recording the device structures in R-level objects + * (i.e., SEXP's) using Luke's reference pointers to make sure that + * nasty things like duplicate copies of device structures do not + * occur. The thing stopping me doing "the right thing" right now + * is time. Hopefully, I will get time later to come back and do + * it properly -- in the meantime I'll just have to burn in hell. + * Paul. + */ + +static int numGraphicsSystems = 0; + +static GESystemDesc* registeredSystems[MAX_GRAPHICS_SYSTEMS]; + + +/**************************************************************** + * GEdestroyDevDesc + **************************************************************** + */ + +static void unregisterOne(pGEDevDesc dd, int systemNumber) { + if (dd->gesd[systemNumber] != NULL) { + (dd->gesd[systemNumber]->callback)(GE_FinaliseState, dd, R_NilValue); + free(dd->gesd[systemNumber]); + dd->gesd[systemNumber] = NULL; + } +} + +/* NOTE that dd->dev has been shut down by a call + * to dev->close within devices.c + */ +void GEdestroyDevDesc(pGEDevDesc dd) +{ + int i; + if (dd != NULL) { + for (i = 0; i < MAX_GRAPHICS_SYSTEMS; i++) unregisterOne(dd, i); + free(dd->dev); + dd->dev = NULL; + free(dd); + } +} + +/**************************************************************** + * GEsystemState + **************************************************************** + + Currently unused, but future systems might need it. + */ + +void* GEsystemState(pGEDevDesc dd, int index) +{ + return dd->gesd[index]->systemSpecific; +} + +/**************************************************************** + * GEregisterWithDevice + **************************************************************** + */ + +/* The guts of adding information about a specific graphics + * system to a specific device. + */ +static void registerOne(pGEDevDesc dd, int systemNumber, GEcallback cb) { + SEXP result; + dd->gesd[systemNumber] = + (GESystemDesc*) calloc(1, sizeof(GESystemDesc)); + if (dd->gesd[systemNumber] == NULL) + error(_("unable to allocate memory (in GEregister)")); + result = cb(GE_InitState, dd, R_NilValue); + if (isNull(result)) { + /* tidy up */ + free(dd->gesd[systemNumber]); + error(_("unable to allocate memory (in GEregister)")); + } else { + dd->gesd[systemNumber]->callback = cb; + } +} + +/* Store the graphics system state and callback information + * for a specified device. + * This is called when a new device is created. + */ +void GEregisterWithDevice(pGEDevDesc dd) { + int i; + for (i = 0; i < MAX_GRAPHICS_SYSTEMS; i++) + /* If a graphics system has unregistered, there might be + * "holes" in the array of registeredSystems. + */ + if (registeredSystems[i] != NULL) + registerOne(dd, i, registeredSystems[i]->callback); +} + +/**************************************************************** + * GEregisterSystem + **************************************************************** + */ + +/* Record the state and callback information for a new graphics + * system. + * This is called when a graphics system is loaded. + * Return the index of the system's information in the graphic + * engine's register. + */ +void GEregisterSystem(GEcallback cb, int *systemRegisterIndex) { + int i, devNum; + pGEDevDesc gdd; + if (numGraphicsSystems + 1 == MAX_GRAPHICS_SYSTEMS) + error(_("too many graphics systems registered")); + /* Set the system register index so that, if there are existing + * devices, it will know where to put the system-specific + * information in those devices + * If a graphics system has been unregistered, there might + * be "holes" in the list of graphics systems, so start + * from zero and look for the first NULL + */ + *systemRegisterIndex = 0; + while (registeredSystems[*systemRegisterIndex] != NULL) { + (*systemRegisterIndex)++; + } + /* Run through the existing devices and add the new information + * to any GEDevDesc's + */ + i = 1; + if (!NoDevices()) { + devNum = curDevice(); + while (i++ < NumDevices()) { + gdd = GEgetDevice(devNum); + registerOne(gdd, *systemRegisterIndex, cb); + devNum = nextDevice(devNum); + } + } + /* Store the information for adding to any new devices + */ + registeredSystems[*systemRegisterIndex] = + (GESystemDesc*) calloc(1, sizeof(GESystemDesc)); + if (registeredSystems[*systemRegisterIndex] == NULL) + error(_("unable to allocate memory (in GEregister)")); + registeredSystems[*systemRegisterIndex]->callback = cb; + numGraphicsSystems += 1; +} + +/**************************************************************** + * GEunregisterSystem + **************************************************************** + */ + +void GEunregisterSystem(int registerIndex) +{ + int i, devNum; + pGEDevDesc gdd; + + /* safety check if called before Ginit() */ + if(registerIndex < 0) return; + if (numGraphicsSystems == 0) { + /* This gets called from KillAllDevices, which is called + during shutdown. Prior to 2.14.0 it gave an error, which + would inhibit shutdown. This should not happen, but + apparently it did after a segfault: + https://stat.ethz.ch/pipermail/r-devel/2011-June/061153.html + */ + warning(_("no graphics system to unregister")); + return; + } + /* Run through the existing devices and remove the information + * from any GEDevDesc's + */ + i = 1; + if (!NoDevices()) { + devNum = curDevice(); + while (i++ < NumDevices()) { + gdd = GEgetDevice(devNum); + unregisterOne(gdd, registerIndex); + devNum = nextDevice(devNum); + } + } + /* Remove the information from the global record + * NOTE that there is no systemSpecific information stored + * in the global record -- just the system callback pointer. + */ + if (registeredSystems[registerIndex] != NULL) { + free(registeredSystems[registerIndex]); + registeredSystems[registerIndex] = NULL; + } + numGraphicsSystems -= 1; +} + +/**************************************************************** + * GEhandleEvent + **************************************************************** + */ + +/* This guy can be called by device drivers. + * It calls back to registered graphics systems and passes on the event + * so that the graphics systems can respond however they want to. + * + * Currently only used for GE_ScalePS in devWindows.c + */ +SEXP GEhandleEvent(GEevent event, pDevDesc dev, SEXP data) +{ + int i; + pGEDevDesc gdd = desc2GEDesc(dev); + for (i = 0; i < MAX_GRAPHICS_SYSTEMS; i++) + if (registeredSystems[i] != NULL) + (registeredSystems[i]->callback)(event, gdd, data); + return R_NilValue; +} + +/**************************************************************** + * Some graphics engine transformations + **************************************************************** + */ + +double fromDeviceX(double value, GEUnit to, pGEDevDesc dd) +{ + double result = value; + switch (to) { + case GE_DEVICE: + break; + case GE_NDC: + result = (result - dd->dev->left) / (dd->dev->right - dd->dev->left); + break; + case GE_INCHES: + result = (result - dd->dev->left) / (dd->dev->right - dd->dev->left) * + fabs(dd->dev->right - dd->dev->left) * dd->dev->ipr[0]; + break; + case GE_CM: + result = (result - dd->dev->left) / (dd->dev->right - dd->dev->left) * + fabs(dd->dev->right - dd->dev->left) * dd->dev->ipr[0] * 2.54; + } + return result; +} + +double toDeviceX(double value, GEUnit from, pGEDevDesc dd) +{ + double result = value; + switch (from) { + case GE_CM: + /* Convert GE_CM to GE_INCHES */ + result = result / 2.54; + case GE_INCHES: + /* Convert GE_INCHES to GE_NDC */ + result = (result / dd->dev->ipr[0]) / fabs(dd->dev->right - dd->dev->left); + case GE_NDC: + /* Convert GE_NDC to Dev */ + result = dd->dev->left + result*(dd->dev->right - dd->dev->left); + case GE_DEVICE: + /* Do nothing */ + break; + } + return result; +} + +double fromDeviceY(double value, GEUnit to, pGEDevDesc dd) +{ + double result = value; + switch (to) { + case GE_DEVICE: + break; + case GE_NDC: + result = (result - dd->dev->bottom) / (dd->dev->top - dd->dev->bottom); + break; + case GE_INCHES: + result = (result - dd->dev->bottom) / (dd->dev->top - dd->dev->bottom) * + fabs(dd->dev->top - dd->dev->bottom) * dd->dev->ipr[1]; + break; + case GE_CM: + result = (result - dd->dev->bottom) / (dd->dev->top - dd->dev->bottom) * + fabs(dd->dev->top - dd->dev->bottom) * dd->dev->ipr[1] * 2.54; + } + return result; +} + +double toDeviceY(double value, GEUnit from, pGEDevDesc dd) +{ + double result = value; + switch (from) { + case GE_CM: + /* Convert GE_CM to GE_INCHES */ + result = result / 2.54; + case GE_INCHES: + /* Convert GE_INCHES to GE_NDC */ + result = (result / dd->dev->ipr[1]) / fabs(dd->dev->top - dd->dev->bottom); + case GE_NDC: + /* Convert GE_NDC to Dev */ + result = dd->dev->bottom + result*(dd->dev->top - dd->dev->bottom); + case GE_DEVICE: + /* Do nothing */ + break; + } + return result; +} + +double fromDeviceWidth(double value, GEUnit to, pGEDevDesc dd) +{ + double result = value; + switch (to) { + case GE_DEVICE: + break; + case GE_NDC: + result = result / (dd->dev->right - dd->dev->left); + break; + case GE_INCHES: + result = result * dd->dev->ipr[0]; + break; + case GE_CM: + result = result * dd->dev->ipr[0] * 2.54; + } + return result; +} + +double toDeviceWidth(double value, GEUnit from, pGEDevDesc dd) +{ + double result = value; + switch (from) { + case GE_CM: + /* Convert GE_CM to GE_INCHES */ + result = result / 2.54; + case GE_INCHES: + /* Convert GE_INCHES to GE_NDC */ + result = (result / dd->dev->ipr[0]) / fabs(dd->dev->right - dd->dev->left); + case GE_NDC: + /* Convert GE_NDC to Dev */ + result = result*(dd->dev->right - dd->dev->left); + case GE_DEVICE: + /* Do nothing */ + break; + } + return result; +} + +double fromDeviceHeight(double value, GEUnit to, pGEDevDesc dd) +{ + double result = value; + switch (to) { + case GE_DEVICE: + break; + case GE_NDC: + result = result / (dd->dev->top - dd->dev->bottom); + break; + case GE_INCHES: + result = result * dd->dev->ipr[1]; + break; + case GE_CM: + result = result * dd->dev->ipr[1] * 2.54; + } + return result; +} + +double toDeviceHeight(double value, GEUnit from, pGEDevDesc dd) +{ + double result = value; + switch (from) { + case GE_CM: + /* Convert GE_CM to GE_INCHES */ + result = result / 2.54; + case GE_INCHES: + /* Convert GE_INCHES to GE_NDC */ + result = (result / dd->dev->ipr[1]) / fabs(dd->dev->top - dd->dev->bottom); + case GE_NDC: + /* Convert GE_NDC to Dev */ + result = result*(dd->dev->top - dd->dev->bottom); + case GE_DEVICE: + /* Do nothing */ + break; + } + return result; +} + +/**************************************************************** + * Code for converting line ends and joins from SEXP to internal + * representation + **************************************************************** + */ +typedef struct { + char *name; + R_GE_lineend end; +} LineEND; + +static LineEND lineend[] = { + { "round", GE_ROUND_CAP }, + { "butt", GE_BUTT_CAP }, + { "square", GE_SQUARE_CAP }, + { NULL, 0 } +}; + +static int nlineend = (sizeof(lineend)/sizeof(LineEND)-2); + +R_GE_lineend GE_LENDpar(SEXP value, int ind) +{ + int i, code; + double rcode; + + if(isString(value)) { + for(i = 0; lineend[i].name; i++) { /* is it the i-th name ? */ + if(!strcmp(CHAR(STRING_ELT(value, ind)), lineend[i].name)) /*ASCII */ + return lineend[i].end; + } + error(_("invalid line end")); /*NOTREACHED, for -Wall : */ return 0; + } + else if(isInteger(value)) { + code = INTEGER(value)[ind]; + if(code == NA_INTEGER || code < 0) + error(_("invalid line end")); + if (code > 0) + code = (code-1) % nlineend + 1; + return lineend[code].end; + } + else if(isReal(value)) { + rcode = REAL(value)[ind]; + if(!R_FINITE(rcode) || rcode < 0) + error(_("invalid line end")); + code = (int) rcode; + if (code > 0) + code = (code-1) % nlineend + 1; + return lineend[code].end; + } + else { + error(_("invalid line end")); /*NOTREACHED, for -Wall : */ return 0; + } +} + +SEXP GE_LENDget(R_GE_lineend lend) +{ + SEXP ans = R_NilValue; + int i; + + for (i = 0; lineend[i].name; i++) { + if(lineend[i].end == lend) + return mkString(lineend[i].name); + } + + error(_("invalid line end")); + /* + * Should never get here + */ + return ans; +} + +typedef struct { + char *name; + R_GE_linejoin join; +} LineJOIN; + +static LineJOIN linejoin[] = { + { "round", GE_ROUND_JOIN }, + { "mitre", GE_MITRE_JOIN }, + { "bevel", GE_BEVEL_JOIN}, + { NULL, 0 } +}; + +static int nlinejoin = (sizeof(linejoin)/sizeof(LineJOIN)-2); + +R_GE_linejoin GE_LJOINpar(SEXP value, int ind) +{ + int i, code; + double rcode; + + if(isString(value)) { + for(i = 0; linejoin[i].name; i++) { /* is it the i-th name ? */ + if(!strcmp(CHAR(STRING_ELT(value, ind)), linejoin[i].name)) /* ASCII */ + return linejoin[i].join; + } + error(_("invalid line join")); /*NOTREACHED, for -Wall : */ return 0; + } + else if(isInteger(value)) { + code = INTEGER(value)[ind]; + if(code == NA_INTEGER || code < 0) + error(_("invalid line join")); + if (code > 0) + code = (code-1) % nlinejoin + 1; + return linejoin[code].join; + } + else if(isReal(value)) { + rcode = REAL(value)[ind]; + if(!R_FINITE(rcode) || rcode < 0) + error(_("invalid line join")); + code = (int) rcode; + if (code > 0) + code = (code-1) % nlinejoin + 1; + return linejoin[code].join; + } + else { + error(_("invalid line join")); /*NOTREACHED, for -Wall : */ return 0; + } +} + +SEXP GE_LJOINget(R_GE_linejoin ljoin) +{ + SEXP ans = R_NilValue; + int i; + + for (i = 0; linejoin[i].name; i++) { + if(linejoin[i].join == ljoin) + return mkString(linejoin[i].name); + } + + error(_("invalid line join")); + /* + * Should never get here + */ + return ans; +} + +/**************************************************************** + * Code to retrieve current clipping rect from device + **************************************************************** + */ + +static void getClipRect(double *x1, double *y1, double *x2, double *y2, + pGEDevDesc dd) +{ + /* Since these are only set by GESetClip they should be in order */ + if (dd->dev->clipLeft < dd->dev->clipRight) { + *x1 = dd->dev->clipLeft; + *x2 = dd->dev->clipRight; + } else { + *x2 = dd->dev->clipLeft; + *x1 = dd->dev->clipRight; + } + if (dd->dev->clipBottom < dd->dev->clipTop) { + *y1 = dd->dev->clipBottom; + *y2 = dd->dev->clipTop; + } else { + *y2 = dd->dev->clipBottom; + *y1 = dd->dev->clipTop; + } +} + +static void getClipRectToDevice(double *x1, double *y1, double *x2, double *y2, + pGEDevDesc dd) +{ + /* Devices can have flipped coord systems */ + if (dd->dev->left < dd->dev->right) { + *x1 = dd->dev->left; + *x2 = dd->dev->right; + } else { + *x2 = dd->dev->left; + *x1 = dd->dev->right; + } + if (dd->dev->bottom < dd->dev->top) { + *y1 = dd->dev->bottom; + *y2 = dd->dev->top; + } else { + *y2 = dd->dev->bottom; + *y1 = dd->dev->top; + } +} + +/**************************************************************** + * GESetClip + **************************************************************** + */ +void GESetClip(double x1, double y1, double x2, double y2, pGEDevDesc dd) +{ + pDevDesc d = dd->dev; + double dx1 = d->left, dx2 = d->right, dy1 = d->bottom, dy2 = d->top; + + /* clip to device region */ + if (dx1 <= dx2) { + x1 = fmax2(x1, dx1); + x2 = fmin2(x2, dx2); + } else { + x1 = fmin2(x1, dx1); + x2 = fmax2(x2, dx2); + } + if (dy1 <= dy2) { + y1 = fmax2(y1, dy1); + y2 = fmin2(y2, dy2); + } else { + y1 = fmin2(y1, dy1); + y2 = fmax2(y2, dy2); + } + d->clip(x1, x2, y1, y2, dd->dev); + /* + * Record the current clip rect settings so that calls to + * getClipRect get the up-to-date values. + */ + d->clipLeft = fmin2(x1, x2); + d->clipRight = fmax2(x1, x2); + d->clipTop = fmax2(y1, y2); + d->clipBottom = fmin2(y1, y2); +} + +/**************************************************************** + * R code for clipping lines + **************************************************************** + */ + +/* Draw Line Segments, Clipping to the Viewport */ +/* Cohen-Sutherland Algorithm */ +/* Unneeded if the device can do the clipping */ + + +#define CS_BOTTOM 001 +#define CS_LEFT 002 +#define CS_TOP 004 +#define CS_RIGHT 010 + +typedef struct { + double xl; + double xr; + double yb; + double yt; +} cliprect; + + +static int clipcode(double x, double y, cliprect *cr) +{ + int c = 0; + if(x < cr->xl) + c |= CS_LEFT; + else if(x > cr->xr) + c |= CS_RIGHT; + if(y < cr->yb) + c |= CS_BOTTOM; + else if(y > cr->yt) + c |= CS_TOP; + return c; +} + +static Rboolean +CSclipline(double *x1, double *y1, double *x2, double *y2, + cliprect *cr, int *clipped1, int *clipped2, + pGEDevDesc dd) +{ + int c, c1, c2; + double x, y, xl, xr, yb, yt; + + *clipped1 = 0; + *clipped2 = 0; + c1 = clipcode(*x1, *y1, cr); + c2 = clipcode(*x2, *y2, cr); + if ( !c1 && !c2 ) + return TRUE; + + xl = cr->xl; + xr = cr->xr; + yb = cr->yb; + yt = cr->yt; + /* Paul took out the code for (dd->dev->gp.xlog || dd->dev->gp.ylog) + * (i) because device holds no state on whether scales are logged + * (ii) it appears to be identical to the code for non-log scales !? + */ + x = xl; /* keep -Wall happy */ + y = yb; /* keep -Wall happy */ + while( c1 || c2 ) { + if(c1 & c2) + return FALSE; + if( c1 ) + c = c1; + else + c = c2; + if( c & CS_LEFT ) { + y = *y1 + (*y2 - *y1) * (xl - *x1) / (*x2 - *x1); + x = xl; + } + else if( c & CS_RIGHT ) { + y = *y1 + (*y2 - *y1) * (xr - *x1) / (*x2 - *x1); + x = xr; + } + else if( c & CS_BOTTOM ) { + x = *x1 + (*x2 - *x1) * (yb - *y1) / (*y2 - *y1); + y = yb; + } + else if( c & CS_TOP ) { + x = *x1 + (*x2 - *x1) * (yt - *y1)/(*y2 - *y1); + y = yt; + } + + if( c==c1 ) { + *x1 = x; + *y1 = y; + *clipped1 = 1; + c1 = clipcode(x, y, cr); + } + else { + *x2 = x; + *y2 = y; + *clipped2 = 1; + c2 = clipcode(x, y, cr); + } + } + return TRUE; +} + + +/* Clip the line + If toDevice = 1, clip to the device extent (i.e., temporarily ignore + dd->dev->gp.xpd) */ +static Rboolean +clipLine(double *x1, double *y1, double *x2, double *y2, + int toDevice, pGEDevDesc dd) +{ + int dummy1, dummy2; + cliprect cr; + + if (toDevice) + getClipRectToDevice(&cr.xl, &cr.yb, &cr.xr, &cr.yt, dd); + else + getClipRect(&cr.xl, &cr.yb, &cr.xr, &cr.yt, dd); + + return CSclipline(x1, y1, x2, y2, &cr, &dummy1, &dummy2, dd); +} + +/**************************************************************** + * GELine + **************************************************************** + */ +/* If the device canClip, R clips line to device extent and + device does all other clipping. */ +void GELine(double x1, double y1, double x2, double y2, + const pGEcontext gc, pGEDevDesc dd) +{ + Rboolean clip_ok; + if (gc->lwd == R_PosInf || gc->lwd < 0.0) + error(_("'lwd' must be non-negative and finite")); + if (ISNAN(gc->lwd) || gc->lty == LTY_BLANK) return; + if (dd->dev->canClip) { + clip_ok = clipLine(&x1, &y1, &x2, &y2, 1, dd); + } + else { + clip_ok = clipLine(&x1, &y1, &x2, &y2, 0, dd); + } + if (clip_ok) + dd->dev->line(x1, y1, x2, y2, gc, dd->dev); +} + +/**************************************************************** + * R code for clipping polylines + **************************************************************** + */ + +static void CScliplines(int n, double *x, double *y, + const pGEcontext gc, int toDevice, pGEDevDesc dd) +{ + int ind1, ind2; + /*int firstPoint = 1;*/ + int count = 0; + int i = 0; + double *xx, *yy; + double x1, y1, x2, y2; + cliprect cr; + const void *vmax = vmaxget(); + + if (toDevice) + getClipRectToDevice(&cr.xl, &cr.yb, &cr.xr, &cr.yt, dd); + else + getClipRect(&cr.xl, &cr.yb, &cr.xr, &cr.yt, dd); + + xx = (double *) R_alloc(n, sizeof(double)); + yy = (double *) R_alloc(n, sizeof(double)); + if (xx == NULL || yy == NULL) + error(_("out of memory while clipping polyline")); + + xx[0] = x1 = x[0]; + yy[0] = y1 = y[0]; + count = 1; + + for (i = 1; i < n; i++) { + x2 = x[i]; + y2 = y[i]; + if (CSclipline(&x1, &y1, &x2, &y2, &cr, &ind1, &ind2, dd)) { + if (ind1 && ind2) { + xx[0] = x1; + yy[0] = y1; + xx[1] = x2; + yy[1] = y2; + dd->dev->polyline(2, xx, yy, gc, dd->dev); + } + else if (ind1) { + xx[0] = x1; + yy[0] = y1; + xx[1] = x2; + yy[1] = y2; + count = 2; + if (i == n - 1) + dd->dev->polyline(count, xx, yy, gc, dd->dev); + } + else if (ind2) { + xx[count] = x2; + yy[count] = y2; + count++; + if (count > 1) + dd->dev->polyline(count, xx, yy, gc, dd->dev); + } + else { + xx[count] = x2; + yy[count] = y2; + count++; + if (i == n - 1 && count > 1) + dd->dev->polyline(count, xx, yy, gc, dd->dev); + } + } + x1 = x[i]; + y1 = y[i]; + } + + vmaxset(vmax); +} + +/**************************************************************** + * GEPolyline + **************************************************************** + */ +/* Clip and draw the polyline. + If clipToDevice = 0, clip according to dd->dev->gp.xpd + If clipToDevice = 1, clip to the device extent */ +static void clipPolyline(int n, double *x, double *y, + const pGEcontext gc, int clipToDevice, pGEDevDesc dd) +{ + CScliplines(n, x, y, gc, clipToDevice, dd); +} + +/* Draw a series of line segments. */ +/* If the device canClip, R clips to the device extent and the device + does all other clipping */ +void GEPolyline(int n, double *x, double *y, const pGEcontext gc, pGEDevDesc dd) +{ + if (gc->lwd == R_PosInf || gc->lwd < 0.0) + error(_("'lwd' must be non-negative and finite")); + if (ISNAN(gc->lwd) || gc->lty == LTY_BLANK) return; + if (dd->dev->canClip) { + clipPolyline(n, x, y, gc, 1, dd); /* clips to device extent + then draws */ + } + else + clipPolyline(n, x, y, gc, 0, dd); +} + +/**************************************************************** + * R code for clipping polygons + **************************************************************** + */ + +typedef enum { + Left = 0, + Right = 1, + Bottom = 2, + Top = 3 +} Edge; + +/* Clipper State Variables */ +typedef struct { + int first; /* true if we have seen the first point */ + double fx; /* x coord of the first point */ + double fy; /* y coord of the first point */ + double sx; /* x coord of the most recent point */ + double sy; /* y coord of the most recent point */ +} +GClipState; + +/* The Clipping Rectangle */ +typedef struct { + double xmin; + double xmax; + double ymin; + double ymax; +} +GClipRect; + +static +int inside (Edge b, double px, double py, GClipRect *clip) +{ + switch (b) { + case Left: if (px < clip->xmin) return 0; break; + case Right: if (px > clip->xmax) return 0; break; + case Bottom: if (py < clip->ymin) return 0; break; + case Top: if (py > clip->ymax) return 0; break; + } + return 1; +} + +static +int cross (Edge b, double x1, double y1, double x2, double y2, + GClipRect *clip) +{ + if (inside (b, x1, y1, clip) == inside (b, x2, y2, clip)) + return 0; + else return 1; +} + +static +void intersect (Edge b, double x1, double y1, double x2, double y2, + double *ix, double *iy, GClipRect *clip) +{ + double m = 0; + + if (x1 != x2) m = (y1 - y2) / (x1 - x2); + switch (b) { + case Left: + *ix = clip->xmin; + *iy = y2 + (clip->xmin - x2) * m; + break; + case Right: + *ix = clip->xmax; + *iy = y2 + (clip->xmax - x2) * m; + break; + case Bottom: + *iy = clip->ymin; + if (x1 != x2) *ix = x2 + (clip->ymin - y2) / m; + else *ix = x2; + break; + case Top: + *iy = clip->ymax; + if (x1 != x2) *ix = x2 + (clip->ymax - y2) / m; + else *ix = x2; + break; + } +} + +static +void clipPoint (Edge b, double x, double y, + double *xout, double *yout, int *cnt, int store, + GClipRect *clip, GClipState *cs) +{ + double ix = 0.0, iy = 0.0 /* -Wall */; + + if (!cs[b].first) { + /* No previous point exists for this edge. */ + /* Save this point. */ + cs[b].first = 1; + cs[b].fx = x; + cs[b].fy = y; + } + else + /* A previous point exists. */ + /* If 'p' and previous point cross edge, find intersection. */ + /* Clip against next boundary, if any. */ + /* If no more edges, add intersection to output list. */ + if (cross (b, x, y, cs[b].sx, cs[b].sy, clip)) { + intersect (b, x, y, cs[b].sx, cs[b].sy, &ix, &iy, clip); + if (b < Top) + clipPoint (b + 1, ix, iy, xout, yout, cnt, store, + clip, cs); + else { + if (store) { + xout[*cnt] = ix; + yout[*cnt] = iy; + } + (*cnt)++; + } + } + + /* Save as most recent point for this edge */ + cs[b].sx = x; + cs[b].sy = y; + + /* For all, if point is 'inside' */ + /* proceed to next clip edge, if any */ + if (inside (b, x, y, clip)) { + if (b < Top) + clipPoint (b + 1, x, y, xout, yout, cnt, store, clip, cs); + else { + if (store) { + xout[*cnt] = x; + yout[*cnt] = y; + } + (*cnt)++; + } + } +} + +static +void closeClip (double *xout, double *yout, int *cnt, int store, + GClipRect *clip, GClipState *cs) +{ + double ix = 0.0, iy = 0.0 /* -Wall */; + Edge b; + + for (b = Left; b <= Top; b++) { + if (cross (b, cs[b].sx, cs[b].sy, cs[b].fx, cs[b].fy, clip)) { + intersect (b, cs[b].sx, cs[b].sy, + cs[b].fx, cs[b].fy, &ix, &iy, clip); + if (b < Top) + clipPoint (b + 1, ix, iy, xout, yout, cnt, store, clip, cs); + else { + if (store) { + xout[*cnt] = ix; + yout[*cnt] = iy; + } + (*cnt)++; + } + } + } +} + +static int clipPoly(double *x, double *y, int n, int store, int toDevice, + double *xout, double *yout, pGEDevDesc dd) +{ + int i, cnt = 0; + GClipState cs[4]; + GClipRect clip; + for (i = 0; i < 4; i++) + cs[i].first = 0; + if (toDevice) + getClipRectToDevice(&clip.xmin, &clip.ymin, &clip.xmax, &clip.ymax, + dd); + else + getClipRect(&clip.xmin, &clip.ymin, &clip.xmax, &clip.ymax, dd); + for (i = 0; i < n; i++) + clipPoint (Left, x[i], y[i], xout, yout, &cnt, store, &clip, cs); + closeClip (xout, yout, &cnt, store, &clip, cs); + return (cnt); +} + +static void clipPolygon(int n, double *x, double *y, + const pGEcontext gc, int toDevice, pGEDevDesc dd) +{ + double *xc = NULL, *yc = NULL; + const void *vmax = vmaxget(); + + /* if bg not specified then draw as polyline rather than polygon + * to avoid drawing line along border of clipping region + * If bg was NA then it has been converted to fully transparent */ + if (R_TRANSPARENT(gc->fill)) { + int i; + xc = (double*) R_alloc(n + 1, sizeof(double)); + yc = (double*) R_alloc(n + 1, sizeof(double)); + for (i=0; i<n; i++) { + xc[i] = x[i]; + yc[i] = y[i]; + } + xc[n] = x[0]; + yc[n] = y[0]; + GEPolyline(n+1, xc, yc, gc, dd); + } + else { + int npts; + xc = yc = 0; /* -Wall */ + npts = clipPoly(x, y, n, 0, toDevice, xc, yc, dd); + if (npts > 1) { + xc = (double*) R_alloc(npts, sizeof(double)); + yc = (double*) R_alloc(npts, sizeof(double)); + npts = clipPoly(x, y, n, 1, toDevice, xc, yc, dd); + dd->dev->polygon(npts, xc, yc, gc, dd->dev); + } + } + vmaxset(vmax); +} + +/**************************************************************** + * GEPolygon + **************************************************************** + */ +void GEPolygon(int n, double *x, double *y, const pGEcontext gc, pGEDevDesc dd) +{ + /* + * Save (and reset below) the heap pointer to clean up + * after any R_alloc's done by functions I call. + */ + const void *vmaxsave = vmaxget(); + if (gc->lwd == R_PosInf || gc->lwd < 0.0) + error(_("'lwd' must be non-negative and finite")); + if (ISNAN(gc->lwd) || gc->lty == LTY_BLANK) + /* "transparent" border */ + gc->col = R_TRANWHITE; + if (dd->dev->canClip) { + /* + * If the device can clip, then we just clip to the device + * boundary and let the device do clipping within that. + * We do this to avoid problems where writing WAY off the + * device can cause problems for, e.g., ghostview + */ + clipPolygon(n, x, y, gc, 1, dd); + } + else + /* + * If the device can't clip, we have to do all the clipping + * ourselves. + */ + clipPolygon(n, x, y, gc, 0, dd); + vmaxset(vmaxsave); +} + + +/**************************************************************** + * R code for clipping circles + **************************************************************** + */ +/* Convert a circle into a polygon with specified number of vertices */ +static void convertCircle(double x, double y, double r, + int numVertices, double *xc, double *yc) +{ + int i; + double theta = 2*M_PI/numVertices; + for (i=0; i<numVertices; i++) { + xc[i] = x + r*sin(theta*i); + yc[i] = y + r*cos(theta*i); + } + xc[numVertices] = x; + yc[numVertices] = y+r; +} + +/* Takes a specification of a circle as input and returns a code indicating + how the circle should be clipped. + The return value will be -1 if the circle is to + be totally clipped out of existence, -2 if the circle is to be + totally left alone, 0 and above if the circle has been converted + into a polygon (in which case, the return value indicates the + number of vertices of the polygon and the function convertCircle() + should be called to obtain the vertices of the polygon). */ +static int clipCircleCode(double x, double y, double r, + int toDevice, pGEDevDesc dd) +{ + int result; + /* determine clipping region */ + double xmin, xmax, ymin, ymax; + if (toDevice) + getClipRectToDevice(&xmin, &ymin, &xmax, &ymax, dd); + else + getClipRect(&xmin, &ymin, &xmax, &ymax, dd); + + /* if circle is all within clipping rect */ + if (x-r > xmin && x+r < xmax && y-r > ymin && y+r < ymax) { + result = -2; + } + /* if circle is all outside clipping rect */ + else { + double distance = r*r; + if (x-r > xmax || x+r < xmin || y-r > ymax || y+r < ymin || + (x < xmin && y < ymin && + ((x-xmin)*(x-xmin)+(y-ymin)*(y-ymin) > distance)) || + (x > xmax && y < ymin && + ((x-xmax)*(x-xmax)+(y-ymin)*(y-ymin) > distance)) || + (x < xmin && y > ymax && + ((x-xmin)*(x-xmin)+(y-ymax)*(y-ymax) > distance)) || + (x > xmax && y > ymax && + ((x-xmax)*(x-xmax)+(y-ymax)*(y-ymax) > distance))) { + result = -1; + } + /* otherwise, convert circle to polygon */ + else { + /* Replace circle with polygon. + + Heuristic for number of vertices is to use theta so + that cos(theta)*r ~ r - 1 in device units. This is + roughly const * sqrt(r) so there'd be little point in + enforcing an upper limit. */ + + result = (r <= 6) ? 10 : (int)(2 * M_PI/acos(1 - 1/r)); + } + } + return result; +} + +/**************************************************************** + * GECircle + **************************************************************** + */ +void GECircle(double x, double y, double radius, const pGEcontext gc, pGEDevDesc dd) +{ + const void *vmax; + double *xc, *yc; + int result; + + /* There is no point in trying to plot a circle of zero radius */ + if (radius <= 0.0) return; + + if (gc->lwd == R_PosInf || gc->lwd < 0.0) + error(_("'lwd' must be non-negative and finite")); + if (ISNAN(gc->lwd) || gc->lty == LTY_BLANK) + /* "transparent" border */ + gc->col = R_TRANWHITE; + /* + * If the device can clip, then we just clip to the device + * boundary and let the device do clipping within that. + * We do this to avoid problems where writing WAY off the + * device can cause problems for, e.g., ghostview + * + * If the device can't clip, we have to do all the clipping + * ourselves. + */ + result = clipCircleCode(x, y, radius, dd->dev->canClip, dd); + + switch (result) { + case -2: /* No clipping; draw all of circle */ + /* + * If we did the clipping, then the circle is entirely + * within the current clipping rect. + * + * If the device can clip then we just clipped to the device + * boundary so the circle is entirely within the device; the + * device will perform the clipping to the current clipping rect. + */ + dd->dev->circle(x, y, radius, gc, dd->dev); + break; + case -1: /* Total clipping; draw nothing */ + /* + * If we did the clipping, then the circle is entirely outside + * the current clipping rect, so there is nothing to draw. + * + * If the device can clip then we just determined that the + * circle is entirely outside the device, so again there is + * nothing to draw + */ + break; + default: /* Partial clipping; draw poly[line|gon] */ + /* + * If we did the clipping this means that the circle + * intersects the current clipping rect and we need to + * convert to a poly[line|gon] and draw that. + * + * If the device can clip then we just determined that the + * circle intersects the device boundary. We assume that the + * circle is not so big that other parts may be WAY off the + * device and just draw a circle. + */ + if (dd->dev->canClip) { + dd->dev->circle(x, y, radius, gc, dd->dev); + } + else { + vmax = vmaxget(); + xc = (double*)R_alloc(result+1, sizeof(double)); + yc = (double*)R_alloc(result+1, sizeof(double)); + convertCircle(x, y, radius, result, xc, yc); + if (R_TRANSPARENT(gc->fill)) { + GEPolyline(result+1, xc, yc, gc, dd); + } + else { + int npts; + double *xcc, *ycc; + xcc = ycc = 0; /* -Wall */ + npts = clipPoly(xc, yc, result, 0, !dd->dev->canClip, + xcc, ycc, dd); + if (npts > 1) { + xcc = (double*)R_alloc(npts, sizeof(double)); + ycc = (double*)R_alloc(npts, sizeof(double)); + npts = clipPoly(xc, yc, result, 1, !dd->dev->canClip, + xcc, ycc, dd); + dd->dev->polygon(npts, xcc, ycc, gc, dd->dev); + } + } + vmaxset(vmax); + } + } +} + +/**************************************************************** + * R code for clipping rectangles + **************************************************************** + */ +/* Return a code indicating how the rectangle should be clipped. + 0 means the rectangle is totally outside the clip region + 1 means the rectangle is totally inside the clip region + 2 means the rectangle intersects the clip region */ +static int clipRectCode(double x0, double y0, double x1, double y1, + int toDevice, pGEDevDesc dd) +{ + int result; + /* determine clipping region */ + double xmin, xmax, ymin, ymax; + if (toDevice) + getClipRectToDevice(&xmin, &ymin, &xmax, &ymax, dd); + else + getClipRect(&xmin, &ymin, &xmax, &ymax, dd); + + if ((x0 < xmin && x1 < xmin) || (x0 > xmax && x1 > xmax) || + (y0 < ymin && y1 < ymin) || (y0 > ymax && y1 > ymax)) + result = 0; + else if ((x0 > xmin && x0 < xmax) && (x1 > xmin && x1 < xmax) && + (y0 > ymin && y0 < ymax) && (y1 > ymin && y1 < ymax)) + result = 1; + else + result = 2; + + return result; +} + +/**************************************************************** + * GERect + **************************************************************** + */ +/* Filled with color fill and outlined with color col */ +/* These may both be fully transparent */ +void GERect(double x0, double y0, double x1, double y1, + const pGEcontext gc, pGEDevDesc dd) +{ + const void *vmax; + double *xc, *yc; + int result; + + if (gc->lwd == R_PosInf || gc->lwd < 0.0) + error(_("'lwd' must be non-negative and finite")); + if (ISNAN(gc->lwd) || gc->lty == LTY_BLANK) + /* "transparent" border */ + gc->col = R_TRANWHITE; + /* + * For clipping logic, see comments in GECircle + */ + result = clipRectCode(x0, y0, x1, y1, dd->dev->canClip, dd); + switch (result) { + case 0: /* rectangle totally clipped; draw nothing */ + break; + case 1: /* rectangle totally inside; draw all */ + dd->dev->rect(x0, y0, x1, y1, gc, dd->dev); + break; + case 2: /* rectangle intersects clip region; use polygon clipping */ + if (dd->dev->canClip) + dd->dev->rect(x0, y0, x1, y1, gc, dd->dev); + else { + vmax = vmaxget(); + xc = (double*)R_alloc(5, sizeof(double)); + yc = (double*)R_alloc(5, sizeof(double)); + xc[0] = x0; yc[0] = y0; + xc[1] = x0; yc[1] = y1; + xc[2] = x1; yc[2] = y1; + xc[3] = x1; yc[3] = y0; + xc[4] = x0; yc[4] = y0; + if (R_TRANSPARENT(gc->fill)) { + GEPolyline(5, xc, yc, gc, dd); + } + else { /* filled rectangle */ + int npts; + double *xcc, *ycc; + xcc = ycc = 0; /* -Wall */ + npts = clipPoly(xc, yc, 4, 0, !dd->dev->canClip, xcc, ycc, dd); + if (npts > 1) { + xcc = (double*)R_alloc(npts, sizeof(double)); + ycc = (double*)R_alloc(npts, sizeof(double)); + npts = clipPoly(xc, yc, 4, 1, !dd->dev->canClip, xcc, ycc, dd); + dd->dev->polygon(npts, xcc, ycc, gc, dd->dev); + } + } + vmaxset(vmax); + } + } +} + +/**************************************************************** + * GEPath + **************************************************************** + */ + +void GEPath(double *x, double *y, + int npoly, int *nper, + Rboolean winding, + const pGEcontext gc, pGEDevDesc dd) +{ + /* safety check: this will be NULL if the device did not set it. */ + if (!dd->dev->path) { + warning(_("path rendering is not implemented for this device")); + return; + } + /* FIXME: what about clipping? (if the device can't) + */ + if (gc->lwd == R_PosInf || gc->lwd < 0.0) + error(_("'lwd' must be non-negative and finite")); + if (ISNAN(gc->lwd) || gc->lty == LTY_BLANK) + gc->col = R_TRANWHITE; + if (npoly > 0) { + int i; + int draw = 1; + for (i=0; i < npoly; i++) { + if (nper[i] < 2) { + draw = 0; + } + } + if (draw) { + dd->dev->path(x, y, npoly, nper, winding, gc, dd->dev); + } else { + error(_("Invalid graphics path")); + } + } +} + +/**************************************************************** + * GERaster + **************************************************************** + */ + +void GERaster(unsigned int *raster, int w, int h, + double x, double y, + double width, double height, + double angle, + Rboolean interpolate, + const pGEcontext gc, pGEDevDesc dd) +{ + /* safety check: this will be NULL if the device did not set it. */ + if (!dd->dev->raster) { + warning(_("raster rendering is not implemented for this device")); + return; + } + + /* FIXME: what about clipping? (if the device can't) + * Maybe not too bad because it is just a matter of shaving off + * some rows and columns from the image? (because R only does + * rectangular clipping regions) */ + + if (width != 0 && height != 0) { + dd->dev->raster(raster, w, h, x, y, width, height, + angle, interpolate, gc, dd->dev); + } +} + +/**************************************************************** + * GERaster + **************************************************************** + */ + +SEXP GECap(pGEDevDesc dd) +{ + /* safety check: this will be NULL if the device did not set it. */ + if (!dd->dev->cap) { + warning(_("raster capture is not available for this device")); + return R_NilValue; + } + return dd->dev->cap(dd->dev); +} + +/**************************************************************** + * R code for clipping text + **************************************************************** + */ + +/* Return a code indicating how the text should be clipped + NOTE that x, y indicate the bottom-left of the text + NOTE also also that this is a bit crude because it actually uses + a bounding box for the entire text to determine the clipping code. + This will mean that in certain (very rare ?) cases, a piece of + text will be characterised as intersecting with the clipping region + when in fact it lies totally outside the clipping region. But + this is not a problem because the final output will still be correct. + 0 means totally outside clip region + 1 means totally inside clip region + 2 means intersects clip region */ +static int clipTextCode(double x, double y, const char *str, cetype_t enc, + double width, double height, double rot, double hadj, + const pGEcontext gc, int toDevice, pGEDevDesc dd) +{ + double x0, x1, x2, x3, y0, y1, y2, y3, left, right, bottom, top; + double length, theta2; + double angle = DEG2RAD * rot; + double theta1 = M_PI/2 - angle; + double widthInches, heightInches, xInches, yInches; + + if (!R_FINITE(width)) width = GEStrWidth(str, enc, gc, dd); + if (!R_FINITE(height)) height = GEStrHeight(str, enc, gc, dd); + + /* Work in inches */ + widthInches = fromDeviceWidth(width, GE_INCHES, dd); + heightInches = fromDeviceHeight(height, GE_INCHES, dd); + xInches = fromDeviceX(x, GE_INCHES, dd); + yInches = fromDeviceY(y, GE_INCHES, dd); + + length = hypot(widthInches, heightInches); + theta2 = angle + atan2(heightInches, widthInches); + + x = xInches - hadj*widthInches*cos(angle); + y = yInches - hadj*widthInches*sin(angle); + x0 = x + heightInches*cos(theta1); + x1 = x; + x2 = x + length*cos(theta2); + x3 = x + widthInches*cos(angle); + y0 = y + heightInches*sin(theta1); + y1 = y; + y2 = y + length*sin(theta2); + y3 = y + widthInches*sin(angle); + left = fmin2(fmin2(x0, x1), fmin2(x2, x3)); + right = fmax2(fmax2(x0, x1), fmax2(x2, x3)); + bottom = fmin2(fmin2(y0, y1), fmin2(y2, y3)); + top = fmax2(fmax2(y0, y1), fmax2(y2, y3)); + return clipRectCode(toDeviceX(left, GE_INCHES, dd), + toDeviceY(bottom, GE_INCHES, dd), + toDeviceX(right, GE_INCHES, dd), + toDeviceY(top, GE_INCHES, dd), + toDevice, dd); +} + +static void clipText(double x, double y, const char *str, cetype_t enc, + double width, double height, double rot, double hadj, + const pGEcontext gc, int toDevice, pGEDevDesc dd) +{ + int result = clipTextCode(x, y, str, enc, width, height, rot, hadj, + gc, toDevice, dd); + void (*textfn)(double x, double y, const char *str, double rot, + double hadj, const pGEcontext gc, pDevDesc dd); + /* This guards against uninitialized values, e.g. devices installed + in earlier versions of R */ + textfn = (dd->dev->hasTextUTF8 ==TRUE) && enc == CE_UTF8 ? + dd->dev->textUTF8 : dd->dev->text; + + switch (result) { + case 0: /* text totally clipped; draw nothing */ + break; + case 1: /* text totally inside; draw all */ + textfn(x, y, str, rot, hadj, gc, dd->dev); + break; + case 2: /* text intersects clip region + act according to value of clipToDevice */ + if (toDevice) /* Device will do clipping */ + textfn(x, y, str, rot, hadj, gc, dd->dev); + else /* don't draw anything; this could be made less crude :) */ + ; + } +} + +/**************************************************************** + * Code for determining when to branch to vfont code from GEText + **************************************************************** + */ + +typedef struct { + char *name; + int minface; + int maxface; +} VFontTab; + +static VFontTab +VFontTable[] = { + { "HersheySerif", 1, 7 }, + /* + HersheySerif + HersheySerif-Italic + HersheySerif-Bold + HersheySerif-BoldItalic + HersheyCyrillic + HersheyCyrillic-Oblique + HersheyEUC + */ + { "HersheySans", 1, 4 }, + /* + HersheySans + HersheySans-Oblique + HersheySans-Bold + HersheySans-BoldOblique + */ + { "HersheyScript", 1, 4 }, + /* + HersheyScript + HersheyScript + HersheyScript-Bold + HersheyScript-Bold + */ + { "HersheyGothicEnglish", 1, 1 }, + { "HersheyGothicGerman", 1, 1 }, + { "HersheyGothicItalian", 1, 1 }, + { "HersheySymbol", 1, 4 }, + /* + HersheySerifSymbol + HersheySerifSymbol-Oblique + HersheySerifSymbol-Bold + HersheySerifSymbol-BoldOblique + */ + { "HersheySansSymbol", 1, 2 }, + /* + HersheySansSymbol + HersheySansSymbol-Oblique + */ + + { NULL, 0, 0 }, +}; + +/* A Hershey family (all of which have names starting with Hershey) may + have had the eighth byte changed to the family code (1...8), so + saving further table lookups. + + (Done by GEText and GEStrWidth/Height, and also set that way in the + graphics package's plot.c for C_text, C_strWidth and C_strheight, + and in plot3d.c for C_contour.) +*/ +static int VFontFamilyCode(char *fontfamily) +{ + if (strlen(fontfamily) > 7) { + unsigned int j = fontfamily[7]; // protect against signed chars + if (!strncmp(fontfamily, "Hershey", 7) && j < 9) return 100 + j; + for (int i = 0; VFontTable[i].minface; i++) + if (!strcmp(fontfamily, VFontTable[i].name)) return i + 1; + } + return -1; +} + +static int VFontFaceCode(int familycode, int fontface) { + int face = fontface; + familycode--; /* Table is 0-based, coding is 1-based */ + /* + * R's "font" par has historically made 2=bold and 3=italic + * These must be switched to correspond to Hershey fontfaces + */ + if (fontface == 2) + face = 3; + else if (fontface == 3) + face = 2; + /* + * If font face is outside supported set of faces for font + * family, either convert or throw and error + */ + if (!(face >= VFontTable[familycode].minface && + face <= VFontTable[familycode].maxface)) { + /* + * Silently convert standard faces to closest match + */ + switch (face) { + /* + * italic becomes plain (gothic only) + */ + case 2: + /* + * bold becomes plain + */ + case 3: + face = 1; + break; + /* + * bold-italic becomes italic for gothic fonts + * and bold for sans symbol font + */ + case 4: + if (familycode == 7) + face = 2; + else + face = 1; + break; + default: + /* + * Other font faces just too wacky so throw an error + */ + error(_("font face %d not supported for font family '%s'"), + fontface, VFontTable[familycode].name); + } + } + return face; +} + +/**************************************************************** + * GEText + **************************************************************** + */ +/* If you want EXACT centering of text (e.g., like in GSymbol) */ +/* then pass NA_REAL for xc and yc */ +void GEText(double x, double y, const char * const str, cetype_t enc, + double xc, double yc, double rot, + const pGEcontext gc, pGEDevDesc dd) +{ + /* + * If the fontfamily is a Hershey font family, call R_GE_VText + */ + int vfontcode = VFontFamilyCode(gc->fontfamily); + if (vfontcode >= 100) { + R_GE_VText(x, y, str, enc, xc, yc, rot, gc, dd); + } else if (vfontcode >= 0) { + gc->fontfamily[7] = (char) vfontcode; + gc->fontface = VFontFaceCode(vfontcode, gc->fontface); + R_GE_VText(x, y, str, enc, xc, yc, rot, gc, dd); + } else { + /* PR#7397: this seemed to reset R_Visible */ + Rboolean savevis = R_Visible; + int noMetricInfo = -1; + char *sbuf = NULL; + if(str && *str) { + const char *s; + char *sb; + int i, n; + cetype_t enc2; + double xoff, yoff, hadj; + double sin_rot, cos_rot;/* sin() & cos() of rot{ation} in radians */ + double xleft, ybottom; + const void *vmax = vmaxget(); + + enc2 = (gc->fontface == 5) ? CE_SYMBOL : enc; + if(enc2 != CE_SYMBOL) + enc2 = (dd->dev->hasTextUTF8 == TRUE) ? CE_UTF8 : CE_NATIVE; + else if(dd->dev->wantSymbolUTF8 == TRUE) enc2 = CE_UTF8; + else if(dd->dev->wantSymbolUTF8 == NA_LOGICAL) { + enc = CE_LATIN1; + enc2 = CE_UTF8; + } + +#ifdef DEBUG_MI + printf("string %s, enc %d, %d\n", str, enc, enc2); +#endif + + /* We work in GE_INCHES */ + x = fromDeviceX(x, GE_INCHES, dd); + y = fromDeviceY(y, GE_INCHES, dd); + /* Count the lines of text */ + n = 1; + for(s = str; *s ; s++) + if (*s == '\n') n++; + /* Allocate a temporary buffer */ + sb = sbuf = (char*) R_alloc(strlen(str) + 1, sizeof(char)); + i = 0; + sin_rot = DEG2RAD * rot; + cos_rot = cos(sin_rot); + sin_rot = sin(sin_rot); + for(s = str; ; s++) { + if (*s == '\n' || *s == '\0') { + double w = NA_REAL, h = NA_REAL; + const char *str; + *sb = '\0'; + /* This may R_alloc, but let's assume that + there are not many lines of text per string */ + str = reEnc(sbuf, enc, enc2, 2); + if (n > 1) { + /* first determine location of THIS line */ + if (!R_FINITE(xc)) + xc = 0.5; + if (!R_FINITE(yc)) + yc = 0.5; + yoff = (1 - yc)*(n - 1) - i; + /* cra is based on the font pointsize at the + * time the device was created. + * Adjust for potentially different current pointsize. + * This is a crude calculation that might be better + * performed using a device call that responds with + * the current font pointsize in device coordinates. + */ + yoff = fromDeviceHeight(yoff * gc->lineheight * + gc->cex * dd->dev->cra[1] * + gc->ps/dd->dev->startps, + GE_INCHES, dd); + xoff = - yoff*sin_rot; + yoff = yoff*cos_rot; + xoff = x + xoff; + yoff = y + yoff; + } else { + xoff = x; + yoff = y; + } + /* now determine bottom-left for THIS line */ + if(xc != 0.0 || yc != 0.0) { + double width, height = 0.0 /* -Wall */; + w = GEStrWidth(str, enc2, gc, dd); + width = fromDeviceWidth(w, GE_INCHES, dd); + if (!R_FINITE(xc)) + xc = 0.5; + if (!R_FINITE(yc)) { + /* "exact" vertical centering */ + /* If font metric info is available AND */ + /* there is only one line, use GMetricInfo & yc=0.5 */ + /* Otherwise use GEStrHeight and fiddle yc */ + double h, d, w; + if (noMetricInfo < 0) { + GEMetricInfo('M', gc, &h, &d, &w, dd); + noMetricInfo = (h == 0 && d == 0 && w == 0) ? 1 : 0; + } + if (n > 1 || noMetricInfo) { + h = GEStrHeight(str, enc2, gc, dd); + height = fromDeviceHeight(h, GE_INCHES, dd); + yc = dd->dev->yCharOffset; + } else { + double maxHeight = 0.0; + double maxDepth = 0.0; + const char *ss = str; + int charNum = 0; + Rboolean done = FALSE; + /* Symbol fonts are not encoded in MBCS ever */ + if(enc2 != CE_SYMBOL && !strIsASCII(ss)) { + if(mbcslocale && enc2 == CE_NATIVE) { + /* FIXME: This assumes that wchar_t is UCS-2/4, + since that is what GEMetricInfo expects */ + size_t n = strlen(ss), used; + wchar_t wc; + mbstate_t mb_st; + mbs_init(&mb_st); + while ((used = mbrtowc(&wc, ss, n, &mb_st)) > 0) { +#ifdef DEBUG_MI + printf(" centring %s aka %d in MBCS\n", ss, wc); +#endif + GEMetricInfo((int) wc, gc, &h, &d, &w, dd); + h = fromDeviceHeight(h, GE_INCHES, dd); + d = fromDeviceHeight(d, GE_INCHES, dd); + if (charNum++ == 0) { + maxHeight = h; + maxDepth = d; + } else { + if (h > maxHeight) maxHeight = h; + if (d > maxDepth) maxDepth = d; + } + ss += used; n -=used; + } + done = TRUE; + } else if (enc2 == CE_UTF8) { + size_t used; + wchar_t wc; + while ((used = utf8toucs(&wc, ss)) > 0) { + GEMetricInfo(-(int) wc, gc, &h, &d, &w, dd); + h = fromDeviceHeight(h, GE_INCHES, dd); + d = fromDeviceHeight(d, GE_INCHES, dd); +#ifdef DEBUG_MI + printf(" centring %s aka %d in UTF-8, %f %f\n", ss, wc, h, d); +#endif + if (charNum++ == 0) { + maxHeight = h; + maxDepth = d; + } else { + if (h > maxHeight) maxHeight = h; + if (d > maxDepth) maxDepth = d; + } + ss += used; + } + done = TRUE; + } + } + if(!done) { + for (ss = str; *ss; ss++) { + GEMetricInfo((unsigned char) *ss, gc, + &h, &d, &w, dd); + h = fromDeviceHeight(h, GE_INCHES, dd); + d = fromDeviceHeight(d, GE_INCHES, dd); +#ifdef DEBUG_MI + printf("metric info for %d, %f %f\n", + (unsigned char) *ss, h, d); +#endif + /* Set maxHeight and maxDepth from height + and depth of first char. + Must NOT set to 0 in case there is + only 1 char and it has negative + height or depth + */ + if (charNum++ == 0) { + maxHeight = h; + maxDepth = d; + } else { + if (h > maxHeight) maxHeight = h; + if (d > maxDepth) maxDepth = d; + } + } + } + height = maxHeight - maxDepth; + yc = 0.5; + } + } else { + h = GEStrHeight(str, CE_NATIVE, gc, dd); + height = fromDeviceHeight(h, GE_INCHES, dd); + } + if (dd->dev->canHAdj == 2) hadj = xc; + else if (dd->dev->canHAdj == 1) { + hadj = 0.5 * floor(2*xc + 0.5); + /* limit to 0, 0.5, 1 */ + hadj = (hadj > 1.0) ? 1.0 :((hadj < 0.0) ? 0.0 : hadj); + } else hadj = 0.0; + xleft = xoff - (xc-hadj)*width*cos_rot + yc*height*sin_rot; + ybottom = yoff - (xc-hadj)*width*sin_rot - + yc*height*cos_rot; + } else { /* xc = yc = 0.0 */ + xleft = xoff; + ybottom = yoff; + hadj = 0.0; + } + /* Convert GE_INCHES back to device. + */ + xleft = toDeviceX(xleft, GE_INCHES, dd); + ybottom = toDeviceY(ybottom, GE_INCHES, dd); + clipText(xleft, ybottom, str, enc2, w, h, rot, hadj, + gc, dd->dev->canClip, dd); + sb = sbuf; + i++; + } + else *sb++ = *s; + if (!*s) break; + } + vmaxset(vmax); + } + R_Visible = savevis; + } +} + +/**************************************************************** + * GEXspline + **************************************************************** + */ + +#include "xspline.c" + +/* + * Draws a "curve" through the specified control points. + * Return the vertices of the line that gets drawn. + + * NB: this works in device coordinates. To make it work correctly + * with non-square 'pixels' we use the x-dimensions only. + */ +SEXP GEXspline(int n, double *x, double *y, double *s, Rboolean open, + Rboolean repEnds, + Rboolean draw, /* May be called just to get points */ + const pGEcontext gc, pGEDevDesc dd) +{ + /* + * Use xspline.c code to generate points to draw + * Draw polygon or polyline from points + */ + SEXP result = R_NilValue; + int i; + double *ipr = dd->dev->ipr, asp = ipr[0]/ipr[1], *ys; + /* + * Save (and reset below) the heap pointer to clean up + * after any R_alloc's done by functions I call. + */ + const void *vmaxsave = vmaxget(); + ys = (double *) R_alloc(n, sizeof(double)); + for (i = 0; i < n; i++) ys[i] = y[i]*asp; + if (open) { + compute_open_spline(n, x, ys, s, repEnds, LOW_PRECISION, dd); + if (draw) { + GEPolyline(npoints, xpoints, ypoints, gc, dd); + } + } else { + compute_closed_spline(n, x, ys, s, LOW_PRECISION, dd); + if (draw) + GEPolygon(npoints, xpoints, ypoints, gc, dd); + } + if (npoints > 1) { + SEXP xpts, ypts; + int i; + PROTECT(xpts = allocVector(REALSXP, npoints)); + PROTECT(ypts = allocVector(REALSXP, npoints)); + for (i = 0; i < npoints; i++) { + REAL(xpts)[i] = xpoints[i]; + REAL(ypts)[i] = ypoints[i]/asp; + } + PROTECT(result = allocVector(VECSXP, 2)); + SET_VECTOR_ELT(result, 0, xpts); + SET_VECTOR_ELT(result, 1, ypts); + UNPROTECT(3); + } + vmaxset(vmaxsave); + return result; +} + + +/**************************************************************** + * GEMode + **************************************************************** + */ +/* Check that everything is initialized : + Interpretation : + mode = 0, graphics off + mode = 1, graphics on + mode = 2, graphical input on (ignored by most drivers) +*/ +void GEMode(int mode, pGEDevDesc dd) +{ + if (NoDevices()) + error(_("no graphics device is active")); + if(dd->dev->mode) dd->dev->mode(mode, dd->dev); +} + +/**************************************************************** + * GESymbol + **************************************************************** + */ +#define SMALL 0.25 +#define RADIUS 0.375 +#define SQRC 0.88622692545275801364 /* sqrt(pi / 4) */ +#define DMDC 1.25331413731550025119 /* sqrt(pi / 4) * sqrt(2) */ +#define TRC0 1.55512030155621416073 /* sqrt(4 * pi/(3 * sqrt(3))) */ +#define TRC1 1.34677368708859836060 /* TRC0 * sqrt(3) / 2 */ +#define TRC2 0.77756015077810708036 /* TRC0 / 2 */ +/* Draw one of the R special symbols. */ +/* "size" is in device coordinates and is assumed to be a width + * rather than a height. + * This could cause a problem for devices which have ipr[0] != ipr[1] + * The problem would be evident where calculations are done on + * angles -- in those cases, a conversion to and from GE_INCHES is done + * to preserve angles. + */ +void GESymbol(double x, double y, int pch, double size, + const pGEcontext gc, pGEDevDesc dd) +{ + double r, xc, yc; + double xx[4], yy[4]; + unsigned int maxchar; + + maxchar = (mbcslocale && gc->fontface != 5) ? 127 : 255; + /* Special cases for plotting pch="." or pch=<character> + */ + if(pch == NA_INTEGER) /* do nothing */; + else if(pch < 0) { + size_t res; + char str[16]; // probably 7 would do + if(gc->fontface == 5) + error("use of negative pch with symbol font is invalid"); + res = ucstoutf8(str, -pch); // throws error if unsuccessful + str[res] = '\0'; + GEText(x, y, str, CE_UTF8, NA_REAL, NA_REAL, 0., gc, dd); + } else if(' ' <= pch && pch <= maxchar) { + if (pch == '.') { + /* + * NOTE: we are *filling* a rect with the current + * colour (we are not drawing the border AND we are + * not using the current fill colour) + */ + gc->fill = gc->col; + gc->col = R_TRANWHITE; + /* + The idea here is to use a 0.01" square, but to be of + at least one device unit in each direction, + assuming that corresponds to pixels. That may be odd if + pixels are not square, but only on low resolution + devices where we can do nothing better. + + For this symbol only, size is cex (see engine.c). + + Prior to 2.1.0 the offsets were always 0.5. + */ + xc = size * fabs(toDeviceWidth(0.005, GE_INCHES, dd)); + yc = size * fabs(toDeviceHeight(0.005, GE_INCHES, dd)); + if(size > 0 && xc < 0.5) xc = 0.5; + if(size > 0 && yc < 0.5) yc = 0.5; + GERect(x-xc, y-yc, x+xc, y+yc, gc, dd); + } else { + char str[2]; + str[0] = (char) pch; + str[1] = '\0'; + GEText(x, y, str, + (gc->fontface == 5) ? CE_SYMBOL : CE_NATIVE, + NA_REAL, NA_REAL, 0., gc, dd); + } + } + else if(pch > maxchar) + warning(_("pch value '%d' is invalid in this locale"), pch); + else { + double GSTR_0 = fromDeviceWidth(size, GE_INCHES, dd); + + switch(pch) { + + case 0: /* S square */ + xc = toDeviceWidth(RADIUS * GSTR_0, GE_INCHES, dd); + yc = toDeviceHeight(RADIUS * GSTR_0, GE_INCHES, dd); + gc->fill = R_TRANWHITE; + GERect(x-xc, y-yc, x+xc, y+yc, gc, dd); + break; + + case 1: /* S octahedron ( circle) */ + xc = RADIUS * size; /* NB: could be zero */ + gc->fill = R_TRANWHITE; + GECircle(x, y, xc, gc, dd); + break; + + case 2: /* S triangle - point up */ + xc = RADIUS * GSTR_0; + r = toDeviceHeight(TRC0 * xc, GE_INCHES, dd); + yc = toDeviceHeight(TRC2 * xc, GE_INCHES, dd); + xc = toDeviceWidth(TRC1 * xc, GE_INCHES, dd); + xx[0] = x; yy[0] = y+r; + xx[1] = x+xc; yy[1] = y-yc; + xx[2] = x-xc; yy[2] = y-yc; + gc->fill = R_TRANWHITE; + GEPolygon(3, xx, yy, gc, dd); + break; + + case 3: /* S plus */ + xc = toDeviceWidth(M_SQRT2*RADIUS*GSTR_0, GE_INCHES, dd); + yc = toDeviceHeight(M_SQRT2*RADIUS*GSTR_0, GE_INCHES, dd); + GELine(x-xc, y, x+xc, y, gc, dd); + GELine(x, y-yc, x, y+yc, gc, dd); + break; + + case 4: /* S times */ + xc = toDeviceWidth(RADIUS * GSTR_0, GE_INCHES, dd); + yc = toDeviceHeight(RADIUS * GSTR_0, GE_INCHES, dd); + GELine(x-xc, y-yc, x+xc, y+yc, gc, dd); + GELine(x-xc, y+yc, x+xc, y-yc, gc, dd); + break; + + case 5: /* S diamond */ + xc = toDeviceWidth(M_SQRT2 * RADIUS * GSTR_0, GE_INCHES, dd); + yc = toDeviceHeight(M_SQRT2 * RADIUS * GSTR_0, GE_INCHES, dd); + xx[0] = x-xc; yy[0] = y; + xx[1] = x; yy[1] = y+yc; + xx[2] = x+xc; yy[2] = y; + xx[3] = x; yy[3] = y-yc; + gc->fill = R_TRANWHITE; + GEPolygon(4, xx, yy, gc, dd); + break; + + case 6: /* S triangle - point down */ + xc = RADIUS * GSTR_0; + r = toDeviceHeight(TRC0 * xc, GE_INCHES, dd); + yc = toDeviceHeight(TRC2 * xc, GE_INCHES, dd); + xc = toDeviceWidth(TRC1 * xc, GE_INCHES, dd); + xx[0] = x; yy[0] = y-r; + xx[1] = x+xc; yy[1] = y+yc; + xx[2] = x-xc; yy[2] = y+yc; + gc->fill = R_TRANWHITE; + GEPolygon(3, xx, yy, gc, dd); + break; + + case 7: /* S square and times superimposed */ + xc = toDeviceWidth(RADIUS * GSTR_0, GE_INCHES, dd); + yc = toDeviceHeight(RADIUS * GSTR_0, GE_INCHES, dd); + gc->fill = R_TRANWHITE; + GERect(x-xc, y-yc, x+xc, y+yc, gc, dd); + GELine(x-xc, y-yc, x+xc, y+yc, gc, dd); + GELine(x-xc, y+yc, x+xc, y-yc, gc, dd); + break; + + case 8: /* S plus and times superimposed */ + xc = toDeviceWidth(RADIUS * GSTR_0, GE_INCHES, dd); + yc = toDeviceHeight(RADIUS * GSTR_0, GE_INCHES, dd); + GELine(x-xc, y-yc, x+xc, y+yc, gc, dd); + GELine(x-xc, y+yc, x+xc, y-yc, gc, dd); + xc = toDeviceWidth(M_SQRT2*RADIUS*GSTR_0, GE_INCHES, dd); + yc = toDeviceHeight(M_SQRT2*RADIUS*GSTR_0, GE_INCHES, dd); + GELine(x-xc, y, x+xc, y, gc, dd); + GELine(x, y-yc, x, y+yc, gc, dd); + break; + + case 9: /* S diamond and plus superimposed */ + xc = toDeviceWidth(M_SQRT2 * RADIUS * GSTR_0, GE_INCHES, dd); + yc = toDeviceHeight(M_SQRT2 * RADIUS * GSTR_0, GE_INCHES, dd); + GELine(x-xc, y, x+xc, y, gc, dd); + GELine(x, y-yc, x, y+yc, gc, dd); + xx[0] = x-xc; yy[0] = y; + xx[1] = x; yy[1] = y+yc; + xx[2] = x+xc; yy[2] = y; + xx[3] = x; yy[3] = y-yc; + gc->fill = R_TRANWHITE; + GEPolygon(4, xx, yy, gc, dd); + break; + + case 10: /* S hexagon (circle) and plus superimposed */ + xc = toDeviceWidth(RADIUS * GSTR_0, GE_INCHES, dd); + yc = toDeviceHeight(RADIUS * GSTR_0, GE_INCHES, dd); + gc->fill = R_TRANWHITE; + GECircle(x, y, xc, gc, dd); + GELine(x-xc, y, x+xc, y, gc, dd); + GELine(x, y-yc, x, y+yc, gc, dd); + break; + + case 11: /* S superimposed triangles */ + xc = RADIUS * GSTR_0; + r = toDeviceHeight(TRC0 * xc, GE_INCHES, dd); + yc = toDeviceHeight(TRC2 * xc, GE_INCHES, dd); + yc = 0.5 * (yc + r); + xc = toDeviceWidth(TRC1 * xc, GE_INCHES, dd); + xx[0] = x; yy[0] = y-r; + xx[1] = x+xc; yy[1] = y+yc; + xx[2] = x-xc; yy[2] = y+yc; + gc->fill = R_TRANWHITE; + GEPolygon(3, xx, yy, gc, dd); + xx[0] = x; yy[0] = y+r; + xx[1] = x+xc; yy[1] = y-yc; + xx[2] = x-xc; yy[2] = y-yc; + GEPolygon(3, xx, yy, gc, dd); + break; + + case 12: /* S square and plus superimposed */ + xc = toDeviceWidth(RADIUS * GSTR_0, GE_INCHES, dd); + yc = toDeviceHeight(RADIUS * GSTR_0, GE_INCHES, dd); + GELine(x-xc, y, x+xc, y, gc, dd); + GELine(x, y-yc, x, y+yc, gc, dd); + gc->fill = R_TRANWHITE; + GERect(x-xc, y-yc, x+xc, y+yc, gc, dd); + break; + + case 13: /* S octagon (circle) and times superimposed */ + xc = RADIUS * size; + gc->fill = R_TRANWHITE; + GECircle(x, y, xc, gc, dd); + xc = toDeviceWidth(RADIUS * GSTR_0, GE_INCHES, dd); + yc = toDeviceHeight(RADIUS * GSTR_0, GE_INCHES, dd); + GELine(x-xc, y-yc, x+xc, y+yc, gc, dd); + GELine(x-xc, y+yc, x+xc, y-yc, gc, dd); + break; + + case 14: /* S square and point-up triangle superimposed */ + xc = toDeviceWidth(RADIUS * GSTR_0, GE_INCHES, dd); + yc = toDeviceHeight(RADIUS * GSTR_0, GE_INCHES, dd); + xx[0] = x; yy[0] = y+yc; + xx[1] = x+xc; yy[1] = y-yc; + xx[2] = x-xc; yy[2] = y-yc; + gc->fill = R_TRANWHITE; + GEPolygon(3, xx, yy, gc, dd); + GERect(x-xc, y-yc, x+xc, y+yc, gc, dd); + break; + + case 15: /* S filled square */ + xc = toDeviceWidth(RADIUS * GSTR_0, GE_INCHES, dd); + yc = toDeviceHeight(RADIUS * GSTR_0, GE_INCHES, dd); + xx[0] = x-xc; yy[0] = y-yc; + xx[1] = x+xc; yy[1] = y-yc; + xx[2] = x+xc; yy[2] = y+yc; + xx[3] = x-xc; yy[3] = y+yc; + gc->fill = gc->col; + gc->col = R_TRANWHITE; + GEPolygon(4, xx, yy, gc, dd); + break; + + case 16: /* S filled octagon (circle) */ + xc = RADIUS * size; + gc->fill = gc->col; + gc->col = R_TRANWHITE; + GECircle(x, y, xc, gc, dd); + break; + + case 17: /* S filled point-up triangle */ + xc = RADIUS * GSTR_0; + r = toDeviceHeight(TRC0 * xc, GE_INCHES, dd); + yc = toDeviceHeight(TRC2 * xc, GE_INCHES, dd); + xc = toDeviceWidth(TRC1 * xc, GE_INCHES, dd); + xx[0] = x; yy[0] = y+r; + xx[1] = x+xc; yy[1] = y-yc; + xx[2] = x-xc; yy[2] = y-yc; + gc->fill = gc->col; + gc->col = R_TRANWHITE; + GEPolygon(3, xx, yy, gc, dd); + break; + + case 18: /* S filled diamond */ + xc = toDeviceWidth(RADIUS * GSTR_0, GE_INCHES, dd); + yc = toDeviceHeight(RADIUS * GSTR_0, GE_INCHES, dd); + xx[0] = x-xc; yy[0] = y; + xx[1] = x; yy[1] = y+yc; + xx[2] = x+xc; yy[2] = y; + xx[3] = x; yy[3] = y-yc; + gc->fill = gc->col; + gc->col = R_TRANWHITE; + GEPolygon(4, xx, yy, gc, dd); + break; + + case 19: /* R filled circle */ + xc = RADIUS * size; + gc->fill = gc->col; + GECircle(x, y, xc, gc, dd); + break; + + + case 20: /* R `Dot' (small circle) */ + xc = SMALL * size; + gc->fill = gc->col; + GECircle(x, y, xc, gc, dd); + break; + + + case 21: /* circles */ + xc = RADIUS * size; + GECircle(x, y, xc, gc, dd); + break; + + case 22: /* squares */ + xc = toDeviceWidth(RADIUS * SQRC * GSTR_0, GE_INCHES, dd); + yc = toDeviceHeight(RADIUS * SQRC * GSTR_0, GE_INCHES, dd); + GERect(x-xc, y-yc, x+xc, y+yc, gc, dd); + break; + + case 23: /* diamonds */ + xc = toDeviceWidth(RADIUS * DMDC * GSTR_0, GE_INCHES, dd); + yc = toDeviceHeight(RADIUS * DMDC * GSTR_0, GE_INCHES, dd); + xx[0] = x ; yy[0] = y-yc; + xx[1] = x+xc; yy[1] = y; + xx[2] = x ; yy[2] = y+yc; + xx[3] = x-xc; yy[3] = y; + GEPolygon(4, xx, yy, gc, dd); + break; + + case 24: /* triangle (point up) */ + xc = RADIUS * GSTR_0; + r = toDeviceHeight(TRC0 * xc, GE_INCHES, dd); + yc = toDeviceHeight(TRC2 * xc, GE_INCHES, dd); + xc = toDeviceWidth(TRC1 * xc, GE_INCHES, dd); + xx[0] = x; yy[0] = y+r; + xx[1] = x+xc; yy[1] = y-yc; + xx[2] = x-xc; yy[2] = y-yc; + GEPolygon(3, xx, yy, gc, dd); + break; + + case 25: /* triangle (point down) */ + xc = RADIUS * GSTR_0; + r = toDeviceHeight(TRC0 * xc, GE_INCHES, dd); + yc = toDeviceHeight(TRC2 * xc, GE_INCHES, dd); + xc = toDeviceWidth(TRC1 * xc, GE_INCHES, dd); + xx[0] = x; yy[0] = y-r; + xx[1] = x+xc; yy[1] = y+yc; + xx[2] = x-xc; yy[2] = y+yc; + GEPolygon(3, xx, yy, gc, dd); + break; + default: + warning(_("unimplemented pch value '%d'"), pch); + } + } +} + +/**************************************************************** + * GEPretty + **************************************************************** + */ +void GEPretty(double *lo, double *up, int *ndiv) +{ +/* Set scale and ticks for linear scales. + * + * Pre: x1 == lo < up == x2 ; ndiv >= 1 + * Post: x1 <= y1 := lo < up =: y2 <= x2; ndiv >= 1 + */ + double unit, ns, nu; + double high_u_fact[2] = { .8, 1.7 }; +#ifdef DEBUG_PLOT + double x1,x2; +#endif + + if(*ndiv <= 0) + error(_("invalid axis extents [GEPretty(.,.,n=%d)"), *ndiv); + if(*lo == R_PosInf || *up == R_PosInf || + *lo == R_NegInf || *up == R_NegInf || + !R_FINITE(*up - *lo)) { + error(_("infinite axis extents [GEPretty(%g,%g,%d)]"), *lo, *up, *ndiv); + return;/*-Wall*/ + } + + ns = *lo; nu = *up; +#ifdef DEBUG_PLOT + x1 = ns; x2 = nu; +#endif + unit = R_pretty(&ns, &nu, ndiv, /* min_n = */ 1, + /* shrink_sml = */ 0.25, + high_u_fact, + 2, /* do eps_correction in any case */ + 0 /* return (ns,nu) in (lo,up) */); + + /* The following is ugly since it kind of happens already in Rpretty0(..): + */ +#define rounding_eps 1e-7 + if(nu >= ns + 1) { + if( ns * unit < *lo - rounding_eps*unit) + ns++; + if(nu > ns + 1 && nu * unit > *up + rounding_eps*unit) + nu--; + *ndiv = (int)(nu - ns); + } + *lo = ns * unit; + *up = nu * unit; +#ifdef non_working_ALTERNATIVE + if(ns * unit > *lo) + *lo = ns * unit; + if(nu * unit < *up) + *up = nu * unit; + if(nu - ns >= 1) + *ndiv = nu - ns; +#endif + +#ifdef DEBUG_PLOT + if(*lo < x1) + warning(_(" .. GEPretty(.): new *lo = %g < %g = x1"), *lo, x1); + if(*up > x2) + warning(_(" .. GEPretty(.): new *up = %g > %g = x2"), *up, x2); +#endif +} + +/**************************************************************** + * GEMetricInfo + **************************************************************** + */ +/* + If c is negative, -c is a Unicode point. + In a MBCS locale, values > 127 are Unicode points (and so really are + values 32 ... 126, 127 being unused). + In a SBCS locale, values 32 ... 255 are the characters in the encoding. + */ +void GEMetricInfo(int c, const pGEcontext gc, + double *ascent, double *descent, double *width, + pGEDevDesc dd) +{ + /* + * If the fontfamily is a Hershey font family, call R_GE_VText + */ + int vfontcode = VFontFamilyCode(gc->fontfamily); + if (vfontcode >= 0) { + /* + * It should be straightforward to figure this out, but + * just haven't got around to it yet + */ + *ascent = 0.0; + *descent = 0.0; + *width = 0.0; + } else { + /* c = 'M' gets called very often, usually to see if there are + any char metrics available but also in plotmath. So we + cache that value. Depends on the context through cex, ps, + fontface, family, and also on the device. + + PAUL 2008-11-27 + The point of checking dd == last_dd is to check for + a different TYPE of device (e.g., PDF vs. PNG). + Checking just the pGEDevDesc pointer is not a good enough + test; it is possible for that to be the same when one + device is closed and a new one is opened (I have seen + it happen!). + So, ALSO compare dd->dev->close function pointer + which really should be different for different devices. + */ + static pGEDevDesc last_dd= NULL; +#if R_USE_PROTOTYPES + static void (*last_close)(pDevDesc dd); +#else + static void (*last_close)(); +#endif + static int last_face = 1; + static double last_cex = 0.0, last_ps = 0.0, + a = 0.0 , d = 0.0, w = 0.0; + static char last_family[201]; + if (dd == last_dd && dd->dev->close == last_close && abs(c) == 77 + && gc->cex == last_cex && gc->ps == last_ps + && gc->fontface == last_face + && streql(gc->fontfamily, last_family)) { + *ascent = a; *descent = d; *width = w; return; + } + dd->dev->metricInfo(c, gc, ascent, descent, width, dd->dev); + if(abs(c) == 77) { + last_dd = dd; last_close = dd->dev->close; + last_cex = gc->cex; last_ps = gc->ps; + last_face = gc->fontface; + strcpy(last_family, gc->fontfamily); + a = *ascent; d = *descent; w = *width; + } + } +} + +/**************************************************************** + * GEStrWidth + **************************************************************** + */ +double GEStrWidth(const char *str, cetype_t enc, const pGEcontext gc, pGEDevDesc dd) +{ + /* + * If the fontfamily is a Hershey font family, call R_GE_VStrWidth + */ + int vfontcode = VFontFamilyCode(gc->fontfamily); + if (vfontcode >= 100) + return R_GE_VStrWidth(str, enc, gc, dd); + else if (vfontcode >= 0) { + gc->fontfamily[7] = (char) vfontcode; + gc->fontface = VFontFaceCode(vfontcode, gc->fontface); + return R_GE_VStrWidth(str, enc, gc, dd); + } else { + double w; + char *sbuf = NULL; + w = 0; + if(str && *str) { + const char *s; + char *sb; + double wdash; + cetype_t enc2; + const void *vmax = vmaxget(); + + enc2 = (gc->fontface == 5) ? CE_SYMBOL : enc; + if(enc2 != CE_SYMBOL) + enc2 = (dd->dev->hasTextUTF8 == TRUE) ? CE_UTF8 : CE_NATIVE; + else if(dd->dev->wantSymbolUTF8 == TRUE) enc2 = CE_UTF8; + + sb = sbuf = (char*) R_alloc(strlen(str) + 1, sizeof(char)); + for(s = str; ; s++) { + if (*s == '\n' || *s == '\0') { + const char *str; + *sb = '\0'; + /* This may R_alloc, but let's assume that + there are not many lines of text per string */ + str = reEnc(sbuf, enc, enc2, 2); + if(dd->dev->hasTextUTF8 == TRUE && enc2 == CE_UTF8) + wdash = dd->dev->strWidthUTF8(str, gc, dd->dev); + else + wdash = dd->dev->strWidth(str, gc, dd->dev); + if (wdash > w) w = wdash; + sb = sbuf; + } + else *sb++ = *s; + if (!*s) break; + } + vmaxset(vmax); + } + return w; + } +} + +/**************************************************************** + * GEStrHeight + **************************************************************** + + * This does not (currently) depend on the encoding. It depends on + * the string only through the number of lines of text (via embedded + * \n) and we assume they are never part of an mbc. + */ +double GEStrHeight(const char *str, cetype_t enc, const pGEcontext gc, pGEDevDesc dd) +{ + /* + * If the fontfamily is a Hershey font family, call R_GE_VStrHeight + */ + int vfontcode = VFontFamilyCode(gc->fontfamily); + if (vfontcode >= 100) + return R_GE_VStrHeight(str, enc, gc, dd); + else if (vfontcode >= 0) { + gc->fontfamily[7] = (char) vfontcode; + gc->fontface = VFontFaceCode(vfontcode, gc->fontface); + return R_GE_VStrHeight(str, enc, gc, dd); + } else { + double h; + const char *s; + double asc, dsc, wid; + int n; + /* Count the lines of text minus one */ + n = 0; + for(s = str; *s ; s++) + if (*s == '\n') + n++; + /* cra is based on the font pointsize at the + * time the device was created. + * Adjust for potentially different current pointsize + * This is a crude calculation that might be better + * performed using a device call that responds with + * the current font pointsize in device coordinates. + */ + h = n * gc->lineheight * gc->cex * dd->dev->cra[1] * + gc->ps/dd->dev->startps; + /* Add in the ascent of the font, if available */ + GEMetricInfo('M', gc, &asc, &dsc, &wid, dd); + if ((asc == 0.0) && (dsc == 0.0) && (wid == 0.0)) + asc = gc->lineheight * gc->cex * dd->dev->cra[1] * + gc->ps/dd->dev->startps; + h += asc; + return h; + } +} + +/**************************************************************** + * GEStrMetric + **************************************************************** + + * Modelled on GEText handling of encodings + */ +void GEStrMetric(const char *str, cetype_t enc, const pGEcontext gc, + double *ascent, double *descent, double *width, + pGEDevDesc dd) +{ + /* + * If the fontfamily is a Hershey font family, call R_GE_VStrHeight + */ + int vfontcode = VFontFamilyCode(gc->fontfamily); + *ascent = 0.0; + *descent = 0.0; + *width = 0.0; + if (vfontcode >= 0) { + /* + * It should be straightforward to figure this out, but + * just haven't got around to it yet + */ + } else { + double h; + const char *s; + double asc, dsc, wid; + /* cra is based on the font pointsize at the + * time the device was created. + * Adjust for potentially different current pointsize + * This is a crude calculation that might be better + * performed using a device call that responds with + * the current font pointsize in device coordinates. + */ + double lineheight = gc->lineheight * gc->cex * dd->dev->cra[1] * + gc->ps/dd->dev->startps; + int n; + char *sb, *sbuf; + cetype_t enc2; + int noMetricInfo; + + const void *vmax = vmaxget(); + + GEMetricInfo('M', gc, &asc, &dsc, &wid, dd); + noMetricInfo = (asc == 0 && dsc == 0 && wid == 0) ? 1 : 0; + + enc2 = (gc->fontface == 5) ? CE_SYMBOL : enc; + if(enc2 != CE_SYMBOL) + enc2 = (dd->dev->hasTextUTF8 == TRUE) ? CE_UTF8 : CE_NATIVE; + else if(dd->dev->wantSymbolUTF8 == TRUE) enc2 = CE_UTF8; + else if(dd->dev->wantSymbolUTF8 == NA_LOGICAL) { + enc = CE_LATIN1; + enc2 = CE_UTF8; + } + + /* Put the first line in a string */ + sb = sbuf = (char*) R_alloc(strlen(str) + 1, sizeof(char)); + s = str; + while (*s != '\n' && *s != '\0') { + *sb++ = *s++; + } + *sb = '\0'; + /* Find the largest ascent for the first line */ + if (noMetricInfo) { + *ascent = GEStrHeight(sbuf, enc2, gc, dd); + } else { + s = reEnc(sbuf, enc, enc2, 2); + if(enc2 != CE_SYMBOL && !strIsASCII(s)) { + if(mbcslocale && enc2 == CE_NATIVE) { + size_t n = strlen(s), used; + wchar_t wc; + mbstate_t mb_st; + mbs_init(&mb_st); + while ((used = mbrtowc(&wc, s, n, &mb_st)) > 0) { + GEMetricInfo((int) wc, gc, &asc, &dsc, &wid, dd); + if (asc > *ascent) + *ascent = asc; + s += used; n -=used; + } + } else if (enc2 == CE_UTF8) { + size_t used; + wchar_t wc; + while ((used = utf8toucs(&wc, s)) > 0) { + GEMetricInfo(-(int) wc, gc, &asc, &dsc, &wid,dd); + if (asc > *ascent) + *ascent = asc; + s += used; + } + } + } else { + while (*s != '\0') { + GEMetricInfo((unsigned char) *s++, gc, + &asc, &dsc, &wid, dd); + if (asc > *ascent) + *ascent = asc; + } + } + } + + /* Count the lines of text minus one */ + n = 0; + for(s = str; *s ; s++) + if (*s == '\n') + n++; + h = n * lineheight; + + /* Where is the start of the last line? */ + if (n > 0) { + while (*s != '\n') + s--; + s++; + } else { + s = str; + } + /* Put the last line in a string */ + sb = sbuf; + while (*s != '\0') { + *sb++ = *s++; + } + *sb = '\0'; + /* Find the largest descent for the last line */ + if (noMetricInfo) { + *descent = 0; + } else { + s = reEnc(sbuf, enc, enc2, 2); + if(enc2 != CE_SYMBOL && !strIsASCII(s)) { + if(mbcslocale && enc2 == CE_NATIVE) { + size_t n = strlen(s), used; + wchar_t wc; + mbstate_t mb_st; + mbs_init(&mb_st); + while ((used = mbrtowc(&wc, s, n, &mb_st)) > 0) { + GEMetricInfo((int) wc, gc, &asc, &dsc, &wid, dd); + if (dsc > *descent) + *descent = dsc; + s += used; n -=used; + } + } else if (enc2 == CE_UTF8) { + size_t used; + wchar_t wc; + while ((used = utf8toucs(&wc, s)) > 0) { + GEMetricInfo(-(int) wc, gc, &asc, &dsc, &wid,dd); + if (dsc > *descent) + *descent = dsc; + s += used; + } + } + } else { + while (*s != '\0') { + GEMetricInfo((unsigned char) *s++, gc, + &asc, &dsc, &wid, dd); + if (dsc > *descent) + *descent = dsc; + } + } + } + + *ascent = *ascent + h; + *width = GEStrWidth(str, enc, gc ,dd); + + vmaxset(vmax); + } +} + +/**************************************************************** + * GENewPage + **************************************************************** + */ + +void GENewPage(const pGEcontext gc, pGEDevDesc dd) +{ + dd->dev->newPage(gc, dd->dev); +} + +/**************************************************************** + * GEdeviceDirty + **************************************************************** + * + * Has the device received output from any graphics system? + */ + +Rboolean GEdeviceDirty(pGEDevDesc dd) +{ + return dd->dirty; +} + +/**************************************************************** + * GEdirtyDevice + **************************************************************** + * + * Indicate that the device has received output from at least one + * graphics system. + */ + +void GEdirtyDevice(pGEDevDesc dd) +{ + dd->dirty = TRUE; +} + +void GEcleanDevice(pGEDevDesc dd) +{ + dd->dirty = FALSE; +} + +/**************************************************************** + * GEcheckState + **************************************************************** + * + * Check whether all registered graphics systems are in a + * "valid" state. + */ + +Rboolean GEcheckState(pGEDevDesc dd) +{ + int i; + Rboolean result = TRUE; + for (i=0; i < MAX_GRAPHICS_SYSTEMS; i++) + if (dd->gesd[i] != NULL) + if (!LOGICAL((dd->gesd[i]->callback)(GE_CheckPlot, dd, + R_NilValue))[0]) + result = FALSE; + return result; +} + +/**************************************************************** + * GErecording + **************************************************************** + */ + +Rboolean GErecording(SEXP call, pGEDevDesc dd) +{ + return (call != R_NilValue && dd->recordGraphics); +} + +/**************************************************************** + * GErecordGraphicOperation + **************************************************************** + */ + +void GErecordGraphicOperation(SEXP op, SEXP args, pGEDevDesc dd) +{ + SEXP lastOperation = dd->DLlastElt; + if (dd->displayListOn) { + SEXP newOperation = list2(op, args); + if (lastOperation == R_NilValue) { + dd->displayList = CONS(newOperation, R_NilValue); + dd->DLlastElt = dd->displayList; + } else { + SETCDR(lastOperation, CONS(newOperation, R_NilValue)); + dd->DLlastElt = CDR(lastOperation); + } + } +} + +/**************************************************************** + * GEinitDisplayList + **************************************************************** + */ + +void GEinitDisplayList(pGEDevDesc dd) +{ + int i; + /* Save the current displayList so that, for example, a device + * can maintain a plot history + */ + dd->savedSnapshot = GEcreateSnapshot(dd); + /* Get each graphics system to save state required for + * replaying the display list + */ + for (i = 0; i < MAX_GRAPHICS_SYSTEMS; i++) + if (dd->gesd[i] != NULL) + (dd->gesd[i]->callback)(GE_SaveState, dd, R_NilValue); + dd->displayList = dd->DLlastElt = R_NilValue; +} + +/**************************************************************** + * GEplayDisplayList + **************************************************************** + */ + +/* from colors.c */ +void savePalette(Rboolean save); + +void GEplayDisplayList(pGEDevDesc dd) +{ + int i, this, savedDevice, plotok; + SEXP theList; + + /* If the device is not registered with the engine (which might + happen in a device callback before it has been registered or + while it is being killed) we might get the null device and + should do nothing. + + Also do nothing if displayList is empty (which should be the + case for the null device). + */ + this = GEdeviceNumber(dd); + if (this == 0) return; + theList = dd->displayList; + if (theList == R_NilValue) return; + + /* Get each graphics system to restore state required for + * replaying the display list + */ + for (i = 0; i < MAX_GRAPHICS_SYSTEMS; i++) + if (dd->gesd[i] != NULL) + (dd->gesd[i]->callback)(GE_RestoreState, dd, theList); + /* Play the display list + */ + PROTECT(theList); + plotok = 1; + if (theList != R_NilValue) { + savePalette(TRUE); + savedDevice = curDevice(); + selectDevice(this); + while (theList != R_NilValue && plotok) { + SEXP theOperation = CAR(theList); + SEXP op = CAR(theOperation); + SEXP args = CADR(theOperation); + if (TYPEOF(op) == BUILTINSXP || TYPEOF(op) == SPECIALSXP) { + PRIMFUN(op) (R_NilValue, op, args, R_NilValue); + /* Check with each graphics system that the plotting went ok + */ + if (!GEcheckState(dd)) { + warning(_("display list redraw incomplete")); + plotok = 0; + } + } else { + warning(_("invalid display list")); + plotok = 0; + } + theList = CDR(theList); + } + selectDevice(savedDevice); + savePalette(FALSE); + } + UNPROTECT(1); +} + + +/**************************************************************** + * GEcopyDisplayList + **************************************************************** + */ + +/* We assume that the device being copied TO is the "current" device + */ +void GEcopyDisplayList(int fromDevice) +{ + SEXP tmp; + pGEDevDesc dd = GEcurrentDevice(), gd = GEgetDevice(fromDevice); + int i; + + tmp = gd->displayList; + if(!isNull(tmp)) tmp = duplicate(tmp); + dd->displayList = tmp; + dd->DLlastElt = lastElt(dd->displayList); + /* Get each registered graphics system to copy system state + * information from the "from" device to the current device + */ + for (i=0; i < MAX_GRAPHICS_SYSTEMS; i++) + if (dd->gesd[i] != NULL) + (dd->gesd[i]->callback)(GE_CopyState, gd, R_NilValue); + GEplayDisplayList(dd); + if (!dd->displayListOn) GEinitDisplayList(dd); +} + +/**************************************************************** + * GEcreateSnapshot + **************************************************************** + */ + +/* Create a recording of the current display, + * including enough information from each registered + * graphics system to be able to recreate the display + * The structure created is an SEXP which nicely hides the + * internals, because noone should be looking in there anyway + * The product of this call can be stored, but should only + * be used in a call to GEplaySnapshot. + */ + +SEXP GEcreateSnapshot(pGEDevDesc dd) +{ + int i; + SEXP snapshot, tmp; + SEXP state; + SEXP engineVersion; + /* Create a list with one spot for the display list + * and one spot each for the registered graphics systems + * to put their graphics state + */ + PROTECT(snapshot = allocVector(VECSXP, 1 + numGraphicsSystems)); + /* The first element of the snapshot is the display list. + */ + if(!isNull(dd->displayList)) { + PROTECT(tmp = duplicate(dd->displayList)); + SET_VECTOR_ELT(snapshot, 0, tmp); + UNPROTECT(1); + } + /* For each registered system, obtain state information, + * and store that in the snapshot. + */ + for (i = 0; i < MAX_GRAPHICS_SYSTEMS; i++) + if (dd->gesd[i] != NULL) { + PROTECT(state = (dd->gesd[i]->callback)(GE_SaveSnapshotState, dd, + R_NilValue)); + SET_VECTOR_ELT(snapshot, i + 1, state); + UNPROTECT(1); + } + PROTECT(engineVersion = allocVector(INTSXP, 1)); + INTEGER(engineVersion)[0] = R_GE_getVersion(); + setAttrib(snapshot, install("engineVersion"), engineVersion); + UNPROTECT(2); + return snapshot; +} + +/**************************************************************** + * GEplaySnapshot + **************************************************************** + */ + +/* Recreate a saved display using the information in a structure + * created by GEcreateSnapshot. + */ + +void GEplaySnapshot(SEXP snapshot, pGEDevDesc dd) +{ + /* Only have to set up information for as many graphics systems + * as were registered when the snapshot was taken. + */ + int i; + /* Check graphics engine version matches. + * If it does not, things still might work, so just a warning. + * NOTE though, that if it does not work, the results could be fatal. + */ + SEXP snapshotEngineVersion; + int engineVersion = R_GE_getVersion(); + PROTECT(snapshotEngineVersion = getAttrib(snapshot, + install("engineVersion"))); + if (isNull(snapshotEngineVersion)) { + warning(_("snapshot recorded with different graphics engine version (pre 11 - this is version %d)"), + engineVersion); + } else if (INTEGER(snapshotEngineVersion)[0] != engineVersion) { + int snapshotVersion = INTEGER(snapshotEngineVersion)[0]; + warning(_("snapshot recorded with different graphics engine version (%d - this is version %d)"), + snapshotVersion, engineVersion); + } + /* "clean" the device + */ + GEcleanDevice(dd); + /* Reset the snapshot state information in each registered + * graphics system. + * This may try to restore state for a system that was NOT + * registered when the snapshot was taken, but the systems + * should protect themselves from that situation. + */ + for (i = 0; i < MAX_GRAPHICS_SYSTEMS; i++) + if (dd->gesd[i] != NULL) + (dd->gesd[i]->callback)(GE_RestoreSnapshotState, dd, snapshot); + /* Replay the display list + */ + dd->displayList = duplicate(VECTOR_ELT(snapshot, 0)); + dd->DLlastElt = lastElt(dd->displayList); + GEplayDisplayList(dd); + if (!dd->displayListOn) GEinitDisplayList(dd); + UNPROTECT(1); +} + +/* recordPlot() */ +SEXP do_getSnapshot(SEXP call, SEXP op, SEXP args, SEXP env) +{ + checkArity(op, args); + return GEcreateSnapshot(GEcurrentDevice()); +} + +/* replayPlot() */ +SEXP do_playSnapshot(SEXP call, SEXP op, SEXP args, SEXP env) +{ + checkArity(op, args); + GEplaySnapshot(CAR(args), GEcurrentDevice()); + return R_NilValue; +} + +/**************************************************************** + * do_recordGraphics + * + * A ".Internal" R function + * + **************************************************************** + */ + +SEXP attribute_hidden do_recordGraphics(SEXP call, SEXP op, SEXP args, SEXP env) +{ + SEXP x, xptr, evalenv, retval; + pGEDevDesc dd = GEcurrentDevice(); + Rboolean record = dd->recordGraphics; + /* + * This function can be run under three conditions: + * + * (i) a top-level call to do_recordGraphics. + * In this case, call != R_NilValue and + * dd->recordGraphics = TRUE + * [so GErecording() returns TRUE] + * + * (ii) a nested call to do_recordGraphics. + * In this case, call != R_NilValue but + * dd->recordGraphics = FALSE + * [so GErecording() returns FALSE] + * + * (iii) a replay of the display list + * In this case, call == R_NilValue and + * dd->recordGraphics = FALSE + * [so GErecording() returns FALSE] + */ + /* + * First arg is an expression, second arg is a list, third arg is an env + */ + + checkArity(op, args); + SEXP code = CAR(args); + SEXP list = CADR(args); + SEXP parentenv = CADDR(args); + if (!isLanguage(code)) + error(_("'expr' argument must be an expression")); + if (TYPEOF(list) != VECSXP) + error(_("'list' argument must be a list")); + if (isNull(parentenv)) { + error(_("use of NULL environment is defunct")); + parentenv = R_BaseEnv; + } else + if (!isEnvironment(parentenv)) + error(_("'env' argument must be an environment")); + /* + * This conversion of list to env taken from do_eval + */ + PROTECT(x = VectorToPairList(list)); + for (xptr = x ; xptr != R_NilValue ; xptr = CDR(xptr)) + SET_NAMED(CAR(xptr) , 2); + /* + * The environment passed in as the third arg is used as + * the parent of the new evaluation environment. + */ + PROTECT(evalenv = NewEnvironment(R_NilValue, x, parentenv)); + dd->recordGraphics = FALSE; + PROTECT(retval = eval(code, evalenv)); + /* + * If there is an error or user-interrupt in the above + * evaluation, dd->recordGraphics is set to TRUE + * on all graphics devices (see GEonExit(); called in errors.c) + */ + dd->recordGraphics = record; + if (GErecording(call, dd)) { + if (!GEcheckState(dd)) + error(_("invalid graphics state")); + GErecordGraphicOperation(op, args, dd); + } + UNPROTECT(3); + return retval; +} + +/**************************************************************** + * GEonExit + * + * Reset some important graphics state on an error/interrupt + **************************************************************** + */ + +void GEonExit() +{ + /* + * Run through all devices and turn graphics recording back on + * in case an error occurred in the middle of a do_recordGraphics + * call. + * Awkward cos device code still in graphics.c + * Can be cleaned up when device code moved here. + */ + int i, devNum; + pGEDevDesc gd; + pDevDesc dd; + i = 1; + if (!NoDevices()) { + devNum = curDevice(); + while (i++ < NumDevices()) { + gd = GEgetDevice(devNum); + gd->recordGraphics = TRUE; + dd = gd->dev; + if (dd->onExit) dd->onExit(dd); + devNum = nextDevice(devNum); + } + } +} + +/* This is also used in grid. It may be used millions of times on the + * same character */ +/* FIXME: should we warn on more than one character here? */ +int GEstring_to_pch(SEXP pch) +{ + int ipch = NA_INTEGER; + static SEXP last_pch = NULL; + static int last_ipch = 0; + + if (pch == NA_STRING) return NA_INTEGER; + if (CHAR(pch)[0] == 0) return NA_INTEGER; /* pch = "" */ + if (pch == last_pch) return last_ipch;/* take advantage of CHARSXP cache */ + ipch = (unsigned char) CHAR(pch)[0]; + if (IS_LATIN1(pch)) { + if (ipch > 127) ipch = -ipch; /* record as Unicode */ + } else if (IS_UTF8(pch) || utf8locale) { + wchar_t wc = 0; + if (ipch > 127) { + if ( (int) utf8toucs(&wc, CHAR(pch)) > 0) ipch = -wc; + else error(_("invalid multibyte char in pch=\"c\"")); + } + } else if(mbcslocale) { + /* Could we safely assume that 7-bit first byte means ASCII? + On Windows this only covers CJK locales, so we could. + */ + unsigned int ucs = 0; + if ( (int) mbtoucs(&ucs, CHAR(pch), MB_CUR_MAX) > 0) ipch = ucs; + else error(_("invalid multibyte char in pch=\"c\"")); + if (ipch > 127) ipch = -ipch; + } + + last_ipch = ipch; last_pch = pch; + return ipch; +} + +/* moved from graphics.c as used by grid */ +/* LINE TEXTURE CODE */ + +/* + * LINE TEXTURE SPECIFICATION + * + * Linetypes are stored internally in integers. An integer + * is interpreted as containing a sequence of 8 4-bit integers + * which give the lengths of up to 8 on-off line segments. + * The lengths are typically interpreted as pixels on a screen + * and as "points" in postscript. + * + * more comments (and LTY_* def.s) in ../include/Rgraphics.h + * ---------------------- + */ + +typedef struct { + char *name; + int pattern; +} LineTYPE; + +static LineTYPE linetype[] = { + { "blank", LTY_BLANK },/* -1 */ + { "solid", LTY_SOLID },/* 1 */ + { "dashed", LTY_DASHED },/* 2 */ + { "dotted", LTY_DOTTED },/* 3 */ + { "dotdash", LTY_DOTDASH },/* 4 */ + { "longdash",LTY_LONGDASH},/* 5 */ + { "twodash", LTY_TWODASH },/* 6 */ + { NULL, 0 }, +}; + +/* Duplicated from graphics.c */ +static char HexDigits[] = "0123456789ABCDEF"; +static unsigned int hexdigit(int digit) +{ + if('0' <= digit && digit <= '9') return digit - '0'; + if('A' <= digit && digit <= 'F') return 10 + digit - 'A'; + if('a' <= digit && digit <= 'f') return 10 + digit - 'a'; + /*else */ error(_("invalid hex digit in 'color' or 'lty'")); + return digit; /* never occurs (-Wall) */ +} + +static int nlinetype = (sizeof(linetype)/sizeof(LineTYPE)-2); + +unsigned int GE_LTYpar(SEXP value, int ind) +{ + const char *p; + int i, code, shift, digit; + double rcode; + + if(isString(value)) { + for(i = 0; linetype[i].name; i++) { /* is it the i-th name ? */ + if(!strcmp(CHAR(STRING_ELT(value, ind)), linetype[i].name)) + return linetype[i].pattern; + } + /* otherwise, a string of hex digits: */ + code = 0; + shift = 0; + p = CHAR(STRING_ELT(value, ind)); + size_t len = strlen(p); + if(len < 2 || len > 8 || len % 2 == 1) + error(_("invalid line type: must be length 2, 4, 6 or 8")); + for(; *p; p++) { + digit = hexdigit(*p); + if(digit == 0) + error(_("invalid line type: zeroes are not allowed")); + code |= (digit<<shift); + shift += 4; + } + return code; + } + else if(isInteger(value)) { + code = INTEGER(value)[ind]; + if(code == NA_INTEGER || code < 0) + error(_("invalid line type")); + if (code > 0) + code = (code-1) % nlinetype + 1; + return linetype[code].pattern; + } + else if(isReal(value)) { + rcode = REAL(value)[ind]; + if(!R_FINITE(rcode) || rcode < 0) + error(_("invalid line type")); + code = (int) rcode; + if (code > 0) + code = (code-1) % nlinetype + 1; + return linetype[code].pattern; + } + else { + error(_("invalid line type")); /*NOTREACHED, for -Wall : */ return 0; + } +} + +SEXP GE_LTYget(unsigned int lty) +{ + int i, ndash; + unsigned char dash[8]; + unsigned int l; + char cbuf[17]; /* 8 hex digits plus nul */ + + for (i = 0; linetype[i].name; i++) + if(linetype[i].pattern == lty) return mkString(linetype[i].name); + + l = lty; ndash = 0; + for (i = 0; i < 8 && l & 15; i++) { + dash[ndash++] = l & 15; + l = l >> 4; + } + for(i = 0 ; i < ndash ; i++) cbuf[i] = HexDigits[dash[i]]; + return mkString(cbuf); +} + +/**************************************************************** + * + * Some functions for operations on raster images + * (for those devices that cannot do these themselves) + **************************************************************** + */ + +/* Some of this code is based on code from the leptonica library + * hence the following notice + */ + +/*====================================================================* +- Copyright (C) 2001 Leptonica. All rights reserved. +- This software is distributed in the hope that it will be +- useful, but with NO WARRANTY OF ANY KIND. +- No author or distributor accepts responsibility to anyone for the +- consequences of using this software, or for whether it serves any +- particular purpose or works at all, unless he or she says so in +- writing. Everyone is granted permission to copy, modify and +- redistribute this source code, for commercial or non-commercial +- purposes, with the following restrictions: (1) the origin of this +- source code must not be misrepresented; (2) modified versions must +- be plainly marked as such; and (3) this notice may not be removed +- or altered from any source or modified source distribution. +*====================================================================*/ + +/* + * Scale a raster image to a desired size using + * nearest-neighbour interpolation + + * draster must be pre-allocated. + */ +void R_GE_rasterScale(unsigned int *sraster, int sw, int sh, + unsigned int *draster, int dw, int dh) { + int i, j; + int sx, sy; + unsigned int pixel; + + /* Iterate over the destination pixels */ + for (i = 0; i < dh; i++) { + for (j = 0; j < dw; j++) { + sy = i * sh / dh; + sx = j * sw / dw; + if ((sx >= 0) && (sx < sw) && (sy >= 0) && sy < sh) { + pixel = sraster[sy * sw + sx]; + } else { + pixel = 0; + } + draster[i * dw + j] = pixel; + } + } +} + +/* + * Scale a raster image to a desired size using + * bilinear interpolation + * Code based on scaleColorLILow() from leptonica library + + * Divide each destination pixel into 16 x 16 sub-pixels. + * Linear interpolation is equivalent to finding the + * fractional area (i.e., number of sub-pixels divided + * by 256) associated with each of the four nearest src pixels, + * and weighting each pixel value by this fractional area. + + * draster must be pre-allocated. + */ +void R_GE_rasterInterpolate(unsigned int *sraster, int sw, int sh, + unsigned int *draster, int dw, int dh) { + int i, j; + double scx, scy; + int wm2, hm2; + int xpm, ypm; /* location in src image, to 1/16 of a pixel */ + int xp, yp, xf, yf; /* src pixel and pixel fraction coordinates */ + int v00r, v01r, v10r, v11r, v00g, v01g, v10g, v11g; + int v00b, v01b, v10b, v11b, v00a, v01a, v10a, v11a; + int area00, area01, area10, area11; + unsigned int pixels1, pixels2, pixels3, pixels4, pixel; + unsigned int *sline, *dline; + + /* (scx, scy) are scaling factors that are applied to the + * dest coords to get the corresponding src coords. + * We need them because we iterate over dest pixels + * and must find the corresponding set of src pixels. */ + scx = (16. * sw) / dw; + scy = (16. * sh) / dh; + + wm2 = sw - 2; + hm2 = sh - 2; + + /* Iterate over the destination pixels */ + for (i = 0; i < dh; i++) { + ypm = (int) fmax2(scy * i - 8, 0); + yp = ypm >> 4; + yf = ypm & 0x0f; + dline = draster + i * dw; + sline = sraster + yp * sw; + for (j = 0; j < dw; j++) { + xpm = (int) fmax2(scx * j - 8, 0); + xp = xpm >> 4; + xf = xpm & 0x0f; + + pixels1 = *(sline + xp); + + if (xp > wm2 || yp > hm2) { + if (yp > hm2 && xp <= wm2) { /* pixels near bottom */ + pixels2 = *(sline + xp + 1); + pixels3 = pixels1; + pixels4 = pixels2; + } + else if (xp > wm2 && yp <= hm2) { /* pixels near right side */ + pixels2 = pixels1; + pixels3 = *(sline + sw + xp); + pixels4 = pixels3; + } + else { /* pixels at LR corner */ + pixels4 = pixels3 = pixels2 = pixels1; + } + } + else { + pixels2 = *(sline + xp + 1); + pixels3 = *(sline + sw + xp); + pixels4 = *(sline + sw + xp + 1); + } + + area00 = (16 - xf) * (16 - yf); + area10 = xf * (16 - yf); + area01 = (16 - xf) * yf; + area11 = xf * yf; + v00r = area00 * R_RED(pixels1); + v00g = area00 * R_GREEN(pixels1); + v00b = area00 * R_BLUE(pixels1); + v00a = area00 * R_ALPHA(pixels1); + v10r = area10 * R_RED(pixels2); + v10g = area10 * R_GREEN(pixels2); + v10b = area10 * R_BLUE(pixels2); + v10a = area10 * R_ALPHA(pixels2); + v01r = area01 * R_RED(pixels3); + v01g = area01 * R_GREEN(pixels3); + v01b = area01 * R_BLUE(pixels3); + v01a = area01 * R_ALPHA(pixels3); + v11r = area11 * R_RED(pixels4); + v11g = area11 * R_GREEN(pixels4); + v11b = area11 * R_BLUE(pixels4); + v11a = area11 * R_ALPHA(pixels4); + pixel = (((v00r + v10r + v01r + v11r + 128) >> 8) & 0x000000ff) | + (((v00g + v10g + v01g + v11g + 128) ) & 0x0000ff00) | + (((v00b + v10b + v01b + v11b + 128) << 8) & 0x00ff0000) | + (((v00a + v10a + v01a + v11a + 128) << 16) & 0xff000000); + *(dline + j) = pixel; + } + } +} + +/* + * Calculate the size needed for rotated image + * + * Rotate top-right and bottom-right corners + * New width/height based on max of rotated corners + */ +void R_GE_rasterRotatedSize(int w, int h, double angle, + int *wnew, int *hnew) { + double diag = sqrt(w*w + h*h); + double theta = atan2((double) h, (double) w); + double trx1 = diag*cos(theta + angle); + double trx2 = diag*cos(theta - angle); + double try1 = diag*sin(theta + angle); + double try2 = diag*sin(angle - theta); + *wnew = (int) (fmax2(fabs(trx1), fabs(trx2)) + 0.5); + *hnew = (int) (fmax2(fabs(try1), fabs(try2)) + 0.5); + /* + * Rotated image may be shorter or thinner than original + */ + *wnew = imax2(w, *wnew); + *hnew = imax2(h, *hnew); +} + +/* + * Calculate offset for (left, bottom) or + * (left, top) of image + * to account for image rotation + */ +void R_GE_rasterRotatedOffset(int w, int h, double angle, + int botleft, + double *xoff, double *yoff) { + double hypot = .5*sqrt(w*w + h*h); + double theta, dw, dh; + if (botleft) { + theta = M_PI + atan2(h, w); + dw = hypot*cos(theta + angle); + dh = hypot*sin(theta + angle); + *xoff = dw + w/2; + *yoff = dh + h/2; + } else { + theta = -M_PI - atan2(h, w); + dw = hypot*cos(theta + angle); + dh = hypot*sin(theta + angle); + *xoff = dw + w/2; + *yoff = dh - h/2; + } +} + +/* + * Copy a raster image into the middle of a larger + * raster image (ready for rotation) + + * newRaster must be pre-allocated. + */ +void R_GE_rasterResizeForRotation(unsigned int *sraster, + int w, int h, + unsigned int *newRaster, + int wnew, int hnew, + const pGEcontext gc) +{ + int i, j, inew, jnew; + int xoff = (wnew - w)/2; + int yoff = (hnew - h)/2; + + for (i=0; i<hnew; i++) { + for (j=0; j<wnew; j++) { + newRaster[i*wnew + j] = gc->fill; + } + } + for (i=0; i<h; i++) { + for (j=0; j<w; j++) { + inew = i+yoff; + jnew = j+xoff; + newRaster[inew*wnew + jnew] = sraster[i*w + j]; + } + + } +} + +/* + * Rotate a raster image + * Code based on rotateAMColorLow() from leptonica library + + * draster must be pre-allocated. + + * smoothAlpha allows alpha channel to vary smoothly based on + * interpolation. If this is FALSE, then alpha values are + * taken from MAX(alpha) of relevant pixels. This means that + * areas of full transparency remain fully transparent, + * areas of opacity remain opaque, edges between anything less than opacity + * and opacity are opaque, and edges between full transparency + * and semitransparency become semitransparent. + */ +void R_GE_rasterRotate(unsigned int *sraster, int w, int h, double angle, + unsigned int *draster, const pGEcontext gc, + Rboolean smoothAlpha) { + int i, j; + int xcen, ycen, wm2, hm2; + int xdif, ydif, xpm, ypm, xp, yp, xf, yf; + int rval, gval, bval, aval; + unsigned int word00, word01, word10, word11; + unsigned int *sline, *dline; + double sina, cosa; + + /* 'angle' in leptonica is clockwise */ + angle = -angle; + + xcen = w / 2; + wm2 = w - 2; + ycen = h / 2; + hm2 = h - 2; + sina = 16. * sin(angle); + cosa = 16. * cos(angle); + + for (i = 0; i < h; i++) { + ydif = ycen - i; + dline = draster + i * w; + for (j = 0; j < w; j++) { + xdif = xcen - j; + xpm = (int) (-xdif * cosa - ydif * sina); + ypm = (int) (-ydif * cosa + xdif * sina); + xp = xcen + (xpm >> 4); + yp = ycen + (ypm >> 4); + xf = xpm & 0x0f; + yf = ypm & 0x0f; + + /* if off the edge, use transparent */ + if (xp < 0 || yp < 0 || xp > wm2 || yp > hm2) { + *(dline + j) = gc->fill; + continue; + } + + sline = sraster + yp * w; + + word00 = *(sline + xp); + word10 = *(sline + xp + 1); + word01 = *(sline + w + xp); + word11 = *(sline + w + xp + 1); + rval = ((16 - xf) * (16 - yf) * R_RED(word00) + + xf * (16 - yf) * R_RED(word10) + + (16 - xf) * yf * R_RED(word01) + + xf * yf * R_RED(word11) + 128) / 256; + gval = ((16 - xf) * (16 - yf) * R_GREEN(word00) + + xf * (16 - yf) * R_GREEN(word10) + + (16 - xf) * yf * R_GREEN(word01) + + xf * yf * R_GREEN(word11) + 128) / 256; + bval = ((16 - xf) * (16 - yf) * R_BLUE(word00) + + xf * (16 - yf) * R_BLUE(word10) + + (16 - xf) * yf * R_BLUE(word01) + + xf * yf * R_BLUE(word11) + 128) / 256; + if (smoothAlpha) { + aval = ((16 - xf) * (16 - yf) * R_ALPHA(word00) + + xf * (16 - yf) * R_ALPHA(word10) + + (16 - xf) * yf * R_ALPHA(word01) + + xf * yf * R_ALPHA(word11) + 128) / 256; + } else { + aval = (int)fmax2(fmax2(R_ALPHA(word00), R_ALPHA(word10)), + fmax2(R_ALPHA(word01), R_ALPHA(word11))); + } + *(dline + j) = R_RGBA(rval, gval, bval, aval); + } + } +} diff --git a/com.oracle.truffle.r.native/gnur/patch/src/main/format.c b/com.oracle.truffle.r.native/gnur/patch/src/main/format.c new file mode 100644 index 0000000000000000000000000000000000000000..8103d9be41c9a2539ad8d28465163e61227c9a06 --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/main/format.c @@ -0,0 +1,567 @@ +/* + * R : A Computer Language for Statistical Data Analysis + * Copyright (C) 1995, 1996 Robert Gentleman and Ross Ihaka + * Copyright (C) 1997--2016 The R Core Team. + * Copyright (C) 2003--2016 The R Foundation + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version. + * + * This program 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 this program; if not, a copy is available at + * https://www.R-project.org/Licenses/ + * + * + * Object Formatting + * + * See ./paste.c for do_paste() , do_format() and do_formatinfo() and + * ./util.c for do_formatC() + * See ./printutils.c for general remarks on Printing and the Encode.. utils. + * See ./print.c for do_printdefault, do_prmatrix, etc. + * + * Exports + * formatString + * formatLogical + * formatInteger + * formatReal + * formatComplex + * + * These formatFOO() functions determine the proper width, digits, etc. + */ + +#ifdef HAVE_CONFIG_H +#include <config.h> +#endif + +#include <Defn.h> +#include <float.h> /* for DBL_EPSILON */ +#include <Rmath.h> +#include <Print.h> + +/* this is just for conformity with other types */ +attribute_hidden +void formatRaw(Rbyte *x, R_xlen_t n, int *fieldwidth) +{ + *fieldwidth = 2; +} + +attribute_hidden +void formatString(SEXP *x, R_xlen_t n, int *fieldwidth, int quote) +{ + int xmax = 0; + int l; + + for (R_xlen_t i = 0; i < n; i++) { + if (x[i] == NA_STRING) { + l = quote ? R_print.na_width : R_print.na_width_noquote; + } else l = Rstrlen(x[i], quote) + (quote ? 2 : 0); + if (l > xmax) xmax = l; + } + *fieldwidth = xmax; +} + +void formatLogical(int *x, R_xlen_t n, int *fieldwidth) +{ + *fieldwidth = 1; + for(R_xlen_t i = 0 ; i < n; i++) { + if (x[i] == NA_LOGICAL) { + if(*fieldwidth < R_print.na_width) + *fieldwidth = R_print.na_width; + } else if (x[i] != 0 && *fieldwidth < 4) { + *fieldwidth = 4; + } else if (x[i] == 0 && *fieldwidth < 5 ) { + *fieldwidth = 5; + break; + /* this is the widest it can be, so stop */ + } + } +} + +void formatInteger(int *x, R_xlen_t n, int *fieldwidth) +{ + int xmin = INT_MAX, xmax = INT_MIN, naflag = 0; + int l; + + for (R_xlen_t i = 0; i < n; i++) { + if (x[i] == NA_INTEGER) + naflag = 1; + else { + if (x[i] < xmin) xmin = x[i]; + if (x[i] > xmax) xmax = x[i]; + } + } + + if (naflag) *fieldwidth = R_print.na_width; + else *fieldwidth = 1; + + if (xmin < 0) { + l = IndexWidth(-xmin) + 1; /* +1 for sign */ + if (l > *fieldwidth) *fieldwidth = l; + } + if (xmax > 0) { + l = IndexWidth(xmax); + if (l > *fieldwidth) *fieldwidth = l; + } +} + +/*--------------------------------------------------------------------------- + * scientific format determination for real numbers. + * This is time-critical code. It is worth optimizing. + * + * nsig digits altogether + * kpower+1 digits to the left of "." + * kpower+1+sgn including sign + * + * Using GLOBAL R_print.digits -- had #define MAXDIG R_print.digits +*/ + +/* long double is C99, so should always be defined but may be slow */ +#if defined(HAVE_LONG_DOUBLE) && (SIZEOF_LONG_DOUBLE > SIZEOF_DOUBLE) +# ifdef HAVE_NEARBYINTL +# define R_nearbyintl nearbyintl +/* Cygwin had rintl but not nearbyintl */ +# elif defined(HAVE_RINTL) +# define R_nearbyintl rintl +# else +# define R_nearbyintl private_nearbyintl +LDOUBLE private_nearbyintl(LDOUBLE x) +{ + LDOUBLE x1; + x1 = - floorl(-x + 0.5); + x = floorl(x + 0.5); + if (x == x1) return(x); + else { + /* FIXME: we should really test for floorl, also C99. + But FreeBSD 7.x does have it, but not nearbyintl */ + if (x/2.0 == floorl(x/2.0)) return(x); else return(x1); + } +} +# endif +# else /* no long double */ +# ifdef HAVE_NEARBYINT +# define R_nearbyint nearbyint +# elif defined(HAVE_RINT) +# define R_nearbyint rint +# else +# define R_nearbyint private_rint +# include "nmath2.h" // for private_rint +# endif +#endif + +#define NB 1000 +static void format_via_sprintf(double r, int d, int *kpower, int *nsig) +{ + static char buff[NB]; + int i; + snprintf(buff, NB, "%#.*e", d - 1, r); + *kpower = (int) strtol(buff + (d + 2), NULL, 10); + for (i = d; i >= 2; i--) + if (buff[i] != '0') break; + *nsig = i; +} + + +#if defined(HAVE_LONG_DOUBLE) && (SIZEOF_LONG_DOUBLE > SIZEOF_DOUBLE) +static const long double tbl[] = +{ + /* Powers exactly representable with 64 bit mantissa (except the first, which is only used with digits=0) */ + 1e-1, + 1e00, 1e01, 1e02, 1e03, 1e04, 1e05, 1e06, 1e07, 1e08, 1e09, + 1e10, 1e11, 1e12, 1e13, 1e14, 1e15, 1e16, 1e17, 1e18, 1e19, + 1e20, 1e21, 1e22, 1e23, 1e24, 1e25, 1e26, 1e27 +}; +#define KP_MAX 27 +#else +static const double tbl[] = +{ + 1e-1, + 1e00, 1e01, 1e02, 1e03, 1e04, 1e05, 1e06, 1e07, 1e08, 1e09, + 1e10, 1e11, 1e12, 1e13, 1e14, 1e15, 1e16, 1e17, 1e18, 1e19, + 1e20, 1e21, 1e22 +}; +#define KP_MAX 22 +#endif + +static void +scientific(double *x, int *neg, int *kpower, int *nsig, Rboolean *roundingwidens) +{ + /* for a number x , determine + * neg = 1_{x < 0} {0/1} + * kpower = Exponent of 10; + * nsig = min(R_print.digits, #{significant digits of alpha}) + * roundingwidens = TRUE iff rounding causes x to increase in width + * + * where |x| = alpha * 10^kpower and 1 <= alpha < 10 + */ + register double alpha; + register double r; + register int kp; + int j; + + if (*x == 0.0) { + *kpower = 0; + *nsig = 1; + *neg = 0; + *roundingwidens = FALSE; + } else { + if(*x < 0.0) { + *neg = 1; r = -*x; + } else { + *neg = 0; r = *x; + } + if (R_print.digits >= DBL_DIG + 1) { + format_via_sprintf(r, R_print.digits, kpower, nsig); + *roundingwidens = FALSE; + return; + } + kp = (int) floor(log10(r)) - R_print.digits + 1;/* r = |x|; 10^(kp + digits - 1) <= r */ +#if defined(HAVE_LONG_DOUBLE) && (SIZEOF_LONG_DOUBLE > SIZEOF_DOUBLE) + long double r_prec = r; + /* use exact scaling factor in long double precision, if possible */ + if (abs(kp) <= 27) { + if (kp > 0) r_prec /= tbl[kp+1]; else if (kp < 0) r_prec *= tbl[ -kp+1]; + } +#ifdef HAVE_POWL + else + r_prec /= powl(10.0, (long double) kp); +#else + else if (kp <= R_dec_min_exponent) + r_prec = (r_prec * 1e+303)/Rexp10((double)(kp+303)); + else + r_prec /= Rexp10((double) kp); +#endif + if (r_prec < tbl[R_print.digits]) { + r_prec *= 10.0; + kp--; + } + /* round alpha to integer, 10^(digits-1) <= alpha <= 10^digits + accuracy limited by double rounding problem, + alpha already rounded to 64 bits */ + alpha = (double) R_nearbyintl(r_prec); +#else + double r_prec = r; + /* use exact scaling factor in double precision, if possible */ + if (abs(kp) <= 22) { + if (kp >= 0) r_prec /= tbl[kp+1]; else r_prec *= tbl[ -kp+1]; + } + /* on IEEE 1e-308 is not representable except by gradual underflow. + Shifting by 303 allows for any potential denormalized numbers x, + and makes the reasonable assumption that R_dec_min_exponent+303 + is in range. Representation of 1e+303 has low error. + */ + else if (kp <= R_dec_min_exponent) + r_prec = (r_prec * 1e+303)/Rexp10((double)(kp+303)); + else + r_prec /= Rexp10((double)kp); + if (r_prec < tbl[R_print.digits]) { + r_prec *= 10.0; + kp--; + } + /* round alpha to integer, 10^(digits-1) <= alpha <= 10^digits */ + /* accuracy limited by double rounding problem, + alpha already rounded to 53 bits */ + alpha = R_nearbyint(r_prec); +#endif + *nsig = R_print.digits; + for (j = 1; j <= R_print.digits; j++) { + alpha /= 10.0; + if (alpha == floor(alpha)) { + (*nsig)--; + } else { + break; + } + } + if (*nsig == 0 && R_print.digits > 0) { + *nsig = 1; + kp += 1; + } + *kpower = kp + R_print.digits - 1; + + /* Scientific format may do more rounding than fixed format, e.g. + 9996 with 3 digits is 1e+04 in scientific, but 9996 in fixed. + This happens when the true value r is less than 10^(kpower+1) + and would not round up to it in fixed format. + Here rgt is the decimal place that will be cut off by rounding */ + + int rgt = R_print.digits - *kpower; + /* bound rgt by 0 and KP_MAX */ + rgt = rgt < 0 ? 0 : rgt > KP_MAX ? KP_MAX : rgt; + double fuzz = 0.5/(double)tbl[1 + rgt]; + // kpower can be bigger than the table. + *roundingwidens = *kpower > 0 && *kpower <= KP_MAX && r < tbl[*kpower + 1] - fuzz; + } +} + +/* + The return values are + w : the required field width + d : use %w.df in fixed format, %#w.de in scientific format + e : use scientific format if != 0, value is number of exp digits - 1 + + nsmall specifies the minimum number of decimal digits in fixed format: + it is 0 except when called from do_format. +*/ + +void formatReal(double *x, R_xlen_t n, int *w, int *d, int *e, int nsmall) +{ + int left, right, sleft; + int mnl, mxl, rgt, mxsl, mxns, wF; + Rboolean roundingwidens; + int neg_i, neg, kpower, nsig; + int naflag, nanflag, posinf, neginf; + + nanflag = 0; + naflag = 0; + posinf = 0; + neginf = 0; + neg = 0; + rgt = mxl = mxsl = mxns = INT_MIN; + mnl = INT_MAX; + + for (R_xlen_t i = 0; i < n; i++) { + if (!R_FINITE(x[i])) { + if(ISNA(x[i])) naflag = 1; + else if(ISNAN(x[i])) nanflag = 1; + else if(x[i] > 0) posinf = 1; + else neginf = 1; + } else { + scientific(&x[i], &neg_i, &kpower, &nsig, &roundingwidens); + + left = kpower + 1; + if (roundingwidens) left--; + + sleft = neg_i + ((left <= 0) ? 1 : left); /* >= 1 */ + right = nsig - left; /* #{digits} right of '.' ( > 0 often)*/ + if (neg_i) neg = 1; /* if any < 0, need extra space for sign */ + + /* Infinite precision "F" Format : */ + if (right > rgt) rgt = right; /* max digits to right of . */ + if (left > mxl) mxl = left; /* max digits to left of . */ + if (left < mnl) mnl = left; /* min digits to left of . */ + if (sleft> mxsl) mxsl = sleft; /* max left including sign(s)*/ + if (nsig > mxns) mxns = nsig; /* max sig digits */ + } + } + /* F Format: use "F" format WHENEVER we use not more space than 'E' + * and still satisfy 'R_print.digits' {but as if nsmall==0 !} + * + * E Format has the form [S]X[.XXX]E+XX[X] + * + * This is indicated by setting *e to non-zero (usually 1) + * If the additional exponent digit is required *e is set to 2 + */ + + /*-- These 'mxsl' & 'rgt' are used in F Format + * AND in the ____ if(.) "F" else "E" ___ below: */ + if (R_print.digits == 0) rgt = 0; + if (mxl < 0) mxsl = 1 + neg; /* we use %#w.dg, so have leading zero */ + + /* use nsmall only *after* comparing "F" vs "E": */ + if (rgt < 0) rgt = 0; + wF = mxsl + rgt + (rgt != 0); /* width for F format */ + + /*-- 'see' how "E" Exponential format would be like : */ + *e = (mxl > 100 || mnl <= -99) ? 2 /* 3 digit exponent */ : 1; + if (mxns != INT_MIN) { + *d = mxns - 1; + *w = neg + (*d > 0) + *d + 4 + *e; /* width for E format */ + if (wF <= *w + R_print.scipen) { /* Fixpoint if it needs less space */ + *e = 0; + if (nsmall > rgt) { + rgt = nsmall; + wF = mxsl + rgt + (rgt != 0); + } + *d = rgt; + *w = wF; + } /* else : "E" Exponential format -- all done above */ + } + else { /* when all x[i] are non-finite */ + *w = 0;/* to be increased */ + *d = 0; + *e = 0; + } + if (naflag && *w < R_print.na_width) + *w = R_print.na_width; + if (nanflag && *w < 3) *w = 3; + if (posinf && *w < 3) *w = 3; + if (neginf && *w < 4) *w = 4; +} + +/* As from 2.2.0 the number of digits applies to real and imaginary parts + together, not separately */ +void z_prec_r(Rcomplex *r, Rcomplex *x, double digits); + +void formatComplex(Rcomplex *x, R_xlen_t n, int *wr, int *dr, int *er, + int *wi, int *di, int *ei, int nsmall) +{ +/* format.info() for x[1..n] for both Re & Im */ + int left, right, sleft; + int rt, mnl, mxl, mxsl, mxns, wF, i_wF; + int i_rt, i_mnl, i_mxl, i_mxsl, i_mxns; + Rboolean roundingwidens; + int neg_i, neg, kpower, nsig; + int naflag, rnanflag, rposinf, rneginf, inanflag, iposinf; + Rcomplex tmp; + Rboolean all_re_zero = TRUE, all_im_zero = TRUE; + + naflag = 0; + rnanflag = 0; + rposinf = 0; + rneginf = 0; + inanflag = 0; + iposinf = 0; + neg = 0; + + rt = mxl = mxsl = mxns = INT_MIN; + i_rt= i_mxl= i_mxsl= i_mxns= INT_MIN; + i_mnl = mnl = INT_MAX; + + for (R_xlen_t i = 0; i < n; i++) { + /* Now round */ + z_prec_r(&tmp, &(x[i]), R_print.digits); + if(ISNA(tmp.r) || ISNA(tmp.i)) { + naflag = 1; + } else { + /* real part */ + + if(!R_FINITE(tmp.r)) { + if (ISNAN(tmp.r)) rnanflag = 1; + else if (tmp.r > 0) rposinf = 1; + else rneginf = 1; + } else { + if(x[i].r != 0) all_re_zero = FALSE; + scientific(&(tmp.r), &neg_i, &kpower, &nsig, &roundingwidens); + + left = kpower + 1; + if (roundingwidens) left--; + sleft = neg_i + ((left <= 0) ? 1 : left); /* >= 1 */ + right = nsig - left; /* #{digits} right of '.' ( > 0 often)*/ + if (neg_i) neg = 1; /* if any < 0, need extra space for sign */ + + if (right > rt) rt = right; /* max digits to right of . */ + if (left > mxl) mxl = left; /* max digits to left of . */ + if (left < mnl) mnl = left; /* min digits to left of . */ + if (sleft> mxsl) mxsl = sleft; /* max left including sign(s) */ + if (nsig > mxns) mxns = nsig; /* max sig digits */ + + } + /* imaginary part */ + + /* this is always unsigned */ + /* we explicitly put the sign in when we print */ + + if(!R_FINITE(tmp.i)) { + if (ISNAN(tmp.i)) inanflag = 1; + else iposinf = 1; + } else { + if(x[i].i != 0) all_im_zero = FALSE; + scientific(&(tmp.i), &neg_i, &kpower, &nsig, &roundingwidens); + + left = kpower + 1; + if (roundingwidens) left--; + sleft = ((left <= 0) ? 1 : left); + right = nsig - left; + + if (right > i_rt) i_rt = right; + if (left > i_mxl) i_mxl = left; + if (left < i_mnl) i_mnl = left; + if (sleft> i_mxsl) i_mxsl = sleft; + if (nsig > i_mxns) i_mxns = nsig; + } + /* done: ; */ + } + } + + /* see comments in formatReal() for details on this */ + + /* overall format for real part */ + + if (R_print.digits == 0) rt = 0; + if (mxl != INT_MIN) { + if (mxl < 0) mxsl = 1 + neg; + if (rt < 0) rt = 0; + wF = mxsl + rt + (rt != 0); + + *er = (mxl > 100 || mnl < -99) ? 2 : 1; + *dr = mxns - 1; + *wr = neg + (*dr > 0) + *dr + 4 + *er; + } else { + *er = 0; + *wr = 0; + *dr = 0; + wF = 0; + } + + /* overall format for imaginary part */ + + if (R_print.digits == 0) i_rt = 0; + if (i_mxl != INT_MIN) { + if (i_mxl < 0) i_mxsl = 1; + if (i_rt < 0) i_rt = 0; + i_wF = i_mxsl + i_rt + (i_rt != 0); + + *ei = (i_mxl > 100 || i_mnl < -99) ? 2 : 1; + *di = i_mxns - 1; + *wi = (*di > 0) + *di + 4 + *ei; + } else { + *ei = 0; + *wi = 0; + *di = 0; + i_wF = 0; + } + + /* Now make the fixed/scientific decision */ + if(all_re_zero) { + *er = *dr = 0; + *wr = wF; + if (i_wF <= *wi + R_print.scipen) { + *ei = 0; + if (nsmall > i_rt) {i_rt = nsmall; i_wF = i_mxsl + i_rt + (i_rt != 0);} + *di = i_rt; + *wi = i_wF; + } + } else if(all_im_zero) { + if (wF <= *wr + R_print.scipen) { + *er = 0; + if (nsmall > rt) {rt = nsmall; wF = mxsl + rt + (rt != 0);} + *dr = rt; + *wr = wF; + } + *ei = *di = 0; + *wi = i_wF; + } else if(wF + i_wF < *wr + *wi + 2*R_print.scipen) { + *er = 0; + if (nsmall > rt) {rt = nsmall; wF = mxsl + rt + (rt != 0);} + *dr = rt; + *wr = wF; + + *ei = 0; + if (nsmall > i_rt) { + i_rt = nsmall; + i_wF = i_mxsl + i_rt + (i_rt != 0); + } + *di = i_rt; + *wi = i_wF; + } /* else scientific for both */ + if(*wr < 0) *wr = 0; + if(*wi < 0) *wi = 0; + + /* Ensure space for Inf and NaN */ + if (rnanflag && *wr < 3) *wr = 3; + if (rposinf && *wr < 3) *wr = 3; + if (rneginf && *wr < 4) *wr = 4; + if (inanflag && *wi < 3) *wi = 3; + if (iposinf && *wi < 3) *wi = 3; + + /* finally, ensure that there is space for NA */ + + if (naflag && *wr+*wi+2 < R_print.na_width) + *wr += (R_print.na_width -(*wr + *wi + 2)); +} diff --git a/com.oracle.truffle.r.native/gnur/patch/src/main/graphics.c b/com.oracle.truffle.r.native/gnur/patch/src/main/graphics.c new file mode 100644 index 0000000000000000000000000000000000000000..04100fa1d0e3733a0f9439e2a11a7b743632c566 --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/main/graphics.c @@ -0,0 +1,131 @@ +/* + * R : A Computer Language for Statistical Data Analysis + * Copyright (C) 1995, 1996 Robert Gentleman and Ross Ihaka + * Copyright (C) 1997--2014 The R Core Team + * Copyright (C) 2002--2011 The R Foundation + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version. + * + * This program 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 this program; if not, a copy is available at + * https://www.R-project.org/Licenses/ + + + * This is an extensive reworking by Paul Murrell of an original + * quick hack by Ross Ihaka designed to give a superset of the + * functionality in the AT&T Bell Laboratories GRZ library. + */ + +#ifdef HAVE_CONFIG_H +#include <config.h> +#endif + +#include <Defn.h> +#include <float.h> /* for DBL_EPSILON etc */ +#include <Graphics.h> +// --> R_ext/GraphicsEngine.h + Rgraphics.h +#include <Rmath.h> /* eg. fmax2() */ + +static void GLPretty(double *ul, double *uh, int *n); + +// used in GScale(), but also grDevices/src/axis_scales.c : +// (usr, log, n_inp) |--> (axp, n_out) : +void GAxisPars(double *min, double *max, int *n, Rboolean log, int axis) +{ +#define EPS_FAC_2 100 + Rboolean swap = *min > *max; + double t_, min_o, max_o; + + if(swap) { /* Feature: in R, something like xlim = c(100,0) just works */ + t_ = *min; *min = *max; *max = t_; + } + /* save only for the extreme case (EPS_FAC_2): */ + min_o = *min; max_o = *max; + + if(log) { + /* Avoid infinities */ + if(*max > 308) *max = 308; + if(*min < -307) *min = -307; + *min = Rexp10(*min); + *max = Rexp10(*max); + GLPretty(min, max, n); + } + else GEPretty(min, max, n); + + double tmp2 = EPS_FAC_2 * DBL_EPSILON;/* << prevent overflow in product below */ + if(fabs(*max - *min) < (t_ = fmax2(fabs(*max), fabs(*min)))* tmp2) { + /* Treat this case somewhat similar to the (min ~= max) case above */ + /* Too much accuracy here just shows machine differences */ + warning(_("relative range of values =%4.0f * EPS, is small (axis %d)") + /*"to compute accurately"*/, + fabs(*max - *min) / (t_*DBL_EPSILON), axis); + + /* No pretty()ing anymore */ + *min = min_o; + *max = max_o; + double eps = .005 * fabs(*max - *min);/* .005: not to go to DBL_MIN/MAX */ + *min += eps; + *max -= eps; + if(log) { + *min = Rexp10(*min); + *max = Rexp10(*max); + } + *n = 1; + } + if(swap) { + t_ = *min; *min = *max; *max = t_; + } +} + +#define LPR_SMALL 2 +#define LPR_MEDIUM 3 + +static void GLPretty(double *ul, double *uh, int *n) +{ +/* Generate pretty tick values -- LOGARITHMIC scale + * __ ul < uh __ + * This only does a very simple setup. + * The real work happens when the axis is drawn. */ + int p1, p2; + double dl = *ul, dh = *uh; + p1 = (int) ceil(log10(dl)); + p2 = (int) floor(log10(dh)); + if(p2 <= p1 && dh/dl > 10.0) { + p1 = (int) ceil(log10(dl) - 0.5); + p2 = (int) floor(log10(dh) + 0.5); + } + + if (p2 <= p1) { /* floor(log10(uh)) <= ceil(log10(ul)) + * <==> log10(uh) - log10(ul) < 2 + * <==> uh / ul < 100 */ + /* Very small range : Use tickmarks from a LINEAR scale + * Splus uses n = 9 here, but that is dumb */ + GPretty(ul, uh, n); + *n = -*n; + } + else { /* extra tickmarks --> CreateAtVector() in ./plot.c */ + /* round to nice "1e<N>" */ + *ul = Rexp10((double)p1); + *uh = Rexp10((double)p2); + if (p2 - p1 <= LPR_SMALL) + *n = 3; /* Small range : Use 1,2,5,10 times 10^k tickmarks */ + else if (p2 - p1 <= LPR_MEDIUM) + *n = 2; /* Medium range : Use 1,5 times 10^k tickmarks */ + else + *n = 1; /* Large range : Use 10^k tickmarks + * But decimate, when there are too many*/ + } +} + +void GPretty(double *lo, double *up, int *ndiv) +{ + GEPretty(lo, up, ndiv); +} diff --git a/com.oracle.truffle.r.native/gnur/patch/src/main/gzio.h b/com.oracle.truffle.r.native/gnur/patch/src/main/gzio.h new file mode 100644 index 0000000000000000000000000000000000000000..281308103d0285ed743b4c2d233ae8418df0b98a --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/main/gzio.h @@ -0,0 +1,548 @@ +/* + Based on gzio.c from zlib 1.2.3, but considerably modified! + + Copyright (C) 1995-2005 Jean-loup Gailly. + For conditions of distribution and use, see copyright notice in zlib.h: + + This software is provided 'as-is', without any express or implied + warranty. In no event will the authors be held liable for any damages + arising from the use of this software. + + Permission is granted to anyone to use this software for any purpose, + including commercial applications, and to alter it and redistribute it + freely, subject to the following restrictions: + + 1. The origin of this software must not be misrepresented; you must not + claim that you wrote the original software. If you use this software + in a product, an acknowledgment in the product documentation would be + appreciated but is not required. + 2. Altered source versions must be plainly marked as such, and must not be + misrepresented as being the original software. + 3. This notice may not be removed or altered from any source distribution. + + Jean-loup Gailly Mark Adler + jloup@gzip.org madler@alumni.caltech.edu + +*/ + + +#ifdef HAVE_CONFIG_H +#include <config.h> /* for Win32, HAVE_OFF_T and HAVE_FSEEKO */ +#endif + +#include <stdio.h> +#include <stdlib.h> +#include <string.h> +#include <errno.h> + +#include "zlib.h" + +#ifdef Win32 +# define OS_CODE 0x06 +#else +# define OS_CODE 0x03 +#endif + +/* R ADDITION */ +#ifdef Win32 +# define Rz_off_t off64_t +#elif defined(HAVE_OFF_T) && defined(HAVE_FSEEKO) +# define Rz_off_t off_t +#else +# define Rz_off_t long +#endif + + +#define Z_BUFSIZE 16384 + +typedef struct gz_stream { + z_stream stream; + int z_err; /* error code for last stream operation */ + int z_eof; /* set if end of input file */ + FILE *file; /* .gz file */ + Byte buffer[Z_BUFSIZE]; /* input or output buffer */ + uLong crc; /* crc32 of uncompressed data */ + int transparent; /* 1 if input file is not compressed */ + char mode; /* 'w' or 'r' */ + Rz_off_t start; /* start of compressed data in file (header skipped) */ + Rz_off_t in; /* bytes into deflate or inflate */ + Rz_off_t out; /* bytes out of deflate or inflate */ +} gz_stream; + + +static int get_byte(gz_stream *s) +{ + if (s->z_eof) return EOF; + if (s->stream.avail_in == 0) { + errno = 0; + s->stream.avail_in = (uInt) fread(s->buffer, 1, Z_BUFSIZE, s->file); + if (s->stream.avail_in == 0) { + s->z_eof = 1; + if (ferror(s->file)) s->z_err = Z_ERRNO; + return EOF; + } + s->stream.next_in = s->buffer; + } + s->stream.avail_in--; + return *(s->stream.next_in)++; +} + +static int destroy (gz_stream *s) +{ + int err = Z_OK; + + if (!s) return Z_STREAM_ERROR; + + if (s->stream.state != NULL) { + if (s->mode == 'w') err = deflateEnd(&(s->stream)); + else if (s->mode == 'r') err = inflateEnd(&(s->stream)); + } + if (s->file != NULL && fclose(s->file)) { +#ifdef ESPIPE + if (errno != ESPIPE) /* fclose is broken for pipes in HP/UX */ +#endif + err = Z_ERRNO; + } + if (s->z_err < 0) err = s->z_err; + + if(s) free(s); + return err; +} + +static int const gz_magic[2] = {0x1f, 0x8b}; /* gzip magic header */ + +/* gzip flag byte */ +#define ASCII_FLAG 0x01 /* bit 0 set: file probably ascii text, unused */ +#define HEAD_CRC 0x02 /* bit 1 set: header CRC present */ +#define EXTRA_FIELD 0x04 /* bit 2 set: extra field present */ +#define ORIG_NAME 0x08 /* bit 3 set: original file name present */ +#define COMMENT 0x10 /* bit 4 set: file comment present */ +#define RESERVED 0xE0 /* bits 5..7: reserved */ + +static void check_header(gz_stream *s) +{ + int method; /* method byte */ + int flags; /* flags byte */ + uInt len; + int c; + + /* Assure two bytes in the buffer so we can peek ahead -- handle case + where first byte of header is at the end of the buffer after the last + gzip segment */ + len = s->stream.avail_in; + if (len < 2) { + if (len) s->buffer[0] = s->stream.next_in[0]; + errno = 0; + len = (uInt) fread(s->buffer + len, 1, Z_BUFSIZE >> len, s->file); + if (len == 0 && ferror(s->file)) s->z_err = Z_ERRNO; + s->stream.avail_in += len; + s->stream.next_in = s->buffer; + if (s->stream.avail_in < 2) { + s->transparent = s->stream.avail_in; + return; + } + } + + /* Peek ahead to check the gzip magic header */ + if (s->stream.next_in[0] != gz_magic[0] || + s->stream.next_in[1] != gz_magic[1]) { + s->transparent = 1; + return; + } + s->stream.avail_in -= 2; + s->stream.next_in += 2; + + /* Check the rest of the gzip header */ + method = get_byte(s); + flags = get_byte(s); + if (method != Z_DEFLATED || (flags & RESERVED) != 0) { + s->z_err = Z_DATA_ERROR; + return; + } + + /* Discard time, xflags and OS code: */ + for (len = 0; len < 6; len++) (void)get_byte(s); + + if ((flags & EXTRA_FIELD) != 0) { /* skip the extra field */ + len = (uInt )get_byte(s); + len += ((uInt) get_byte(s)) << 8; + /* len is garbage if EOF but the loop below will quit anyway */ + while (len-- != 0 && get_byte(s) != EOF) ; + } + if ((flags & ORIG_NAME) != 0) { /* skip the original file name */ + while ((c = get_byte(s)) != 0 && c != EOF) ; + } + if ((flags & COMMENT) != 0) { /* skip the .gz file comment */ + while ((c = get_byte(s)) != 0 && c != EOF) ; + } + if ((flags & HEAD_CRC) != 0) { /* skip the header crc */ + for (len = 0; len < 2; len++) (void) get_byte(s); + } + s->z_err = s->z_eof ? Z_DATA_ERROR : Z_OK; +} + +gzFile R_gzopen (const char *path, const char *mode) +{ + int err; + int level = Z_DEFAULT_COMPRESSION; /* compression level */ + int strategy = Z_DEFAULT_STRATEGY; /* compression strategy */ + char *p = (char *) mode; + gz_stream *s; + char fmode[80]; /* copy of mode, without the compression level */ + char *m = fmode; + + if (!path || !mode) return Z_NULL; + + s = (gz_stream *) malloc(sizeof(gz_stream)); + if (!s) return Z_NULL; + + s->stream.zalloc = (alloc_func) 0; + s->stream.zfree = (free_func) 0; + s->stream.opaque = (voidpf) 0; + s->stream.next_in = s->buffer; + s->stream.next_out = s->buffer; + s->stream.avail_in = s->stream.avail_out = 0; + s->file = NULL; + s->z_err = Z_OK; + s->z_eof = 0; + s->in = 0; + s->out = 0; + s->crc = crc32(0L, Z_NULL, 0); + s->transparent = 0; + s->mode = '\0'; + do { + if (*p == 'r') s->mode = 'r'; + if (*p == 'w' || *p == 'a') s->mode = 'w'; + if (*p >= '0' && *p <= '9') level = *p - '0'; + else if (*p == 'f') strategy = Z_FILTERED; + else if (*p == 'h') strategy = Z_HUFFMAN_ONLY; + else if (*p == 'R') strategy = Z_RLE; + else *m++ = *p; /* copy the mode */ + } while (*p++ && m != fmode + sizeof(fmode)); + if (s->mode == '\0') return destroy(s), (gzFile) Z_NULL; + + if (s->mode == 'w') { + err = deflateInit2(&(s->stream), level, + Z_DEFLATED, -MAX_WBITS, MAX_MEM_LEVEL, strategy); + /* windowBits is passed < 0 to suppress zlib header */ + if (err != Z_OK) return destroy(s), (gzFile) Z_NULL; + } else { + err = inflateInit2(&(s->stream), -MAX_WBITS); + /* windowBits is passed < 0 to tell that there is no zlib header. + * Note that in this case inflate *requires* an extra "dummy" byte + * after the compressed stream in order to complete decompression and + * return Z_STREAM_END. Here the gzip CRC32 ensures that 4 bytes are + * present after the compressed stream. + */ + if (err != Z_OK) return destroy(s), (gzFile) Z_NULL; + } + s->stream.avail_out = Z_BUFSIZE; + + errno = 0; + s->file = fopen(path, fmode); + if (s->file == NULL) return destroy(s), (gzFile) Z_NULL; + + if (s->mode == 'w') { + /* Write a very simple .gz header */ + fprintf(s->file, "%c%c%c%c%c%c%c%c%c%c", gz_magic[0], gz_magic[1], + Z_DEFLATED, 0 /*flags*/, 0,0,0,0 /*time*/, 0 /*xflags*/, + OS_CODE); + s->start = 10L; + } else { + check_header(s); /* skip the .gz header */ + s->start = f_tell(s->file) - s->stream.avail_in; + } + return (gzFile) s; +} + +static void z_putLong (FILE *file, uLong x) +{ + int n; + for (n = 0; n < 4; n++) { + fputc((int) (x & 0xff), file); + x >>= 8; + } +} + +static uLong getLong (gz_stream *s) +{ + uLong x = (uLong) get_byte(s); + int c; + + x += ((uLong) get_byte(s)) << 8; + x += ((uLong) get_byte(s)) << 16; + c = get_byte(s); + if (c == EOF) s->z_err = Z_DATA_ERROR; + x += ((uLong) c) << 24; + return x; +} + +static int R_gzread (gzFile file, voidp buf, unsigned len) +{ + gz_stream *s = (gz_stream*) file; + Bytef *start = (Bytef*) buf; /* starting point for crc computation */ + Byte *next_out; /* == stream.next_out but not forced far (for MSDOS) */ + + if (s == NULL || s->mode != 'r') return Z_STREAM_ERROR; + + if (s->z_err == Z_DATA_ERROR) { + warning("invalid or incomplete compressed data"); + return -1; + } else if(s->z_err == Z_ERRNO) { + warning("error reading the file"); + return -1; + } + if (s->z_err == Z_STREAM_END) return 0; /* EOF */ + + next_out = (Byte*) buf; + s->stream.next_out = (Bytef*) buf; + s->stream.avail_out = len; + + while (s->stream.avail_out != 0) { + + if (s->transparent) { + /* Copy first the lookahead bytes: */ + uInt n = s->stream.avail_in; + if (n > s->stream.avail_out) n = s->stream.avail_out; + if (n > 0) { + memcpy(s->stream.next_out, s->stream.next_in, n); + next_out += n; + s->stream.next_out = next_out; + s->stream.next_in += n; + s->stream.avail_out -= n; + s->stream.avail_in -= n; + } + if (s->stream.avail_out > 0) { + s->stream.avail_out -= + (uInt) fread(next_out, 1, s->stream.avail_out, s->file); + } + len -= s->stream.avail_out; + s->in += len; + s->out += len; + if (len == 0) s->z_eof = 1; + return (int)len; + } + if (s->stream.avail_in == 0 && !s->z_eof) { + errno = 0; + s->stream.avail_in = (uInt) fread(s->buffer, 1, Z_BUFSIZE, s->file); + if (s->stream.avail_in == 0) { + s->z_eof = 1; + if (ferror(s->file)) { + s->z_err = Z_ERRNO; + break; + } + } + s->stream.next_in = s->buffer; + } + s->in += s->stream.avail_in; + s->out += s->stream.avail_out; + s->z_err = inflate(&(s->stream), Z_NO_FLUSH); + s->in -= s->stream.avail_in; + s->out -= s->stream.avail_out; + + if (s->z_err == Z_STREAM_END) { + /* Check CRC and original size */ + s->crc = crc32(s->crc, start, (uInt) (s->stream.next_out - start)); + start = s->stream.next_out; + + if (getLong(s) != s->crc) { + warning("invalid or incomplete compressed data"); + s->z_err = Z_DATA_ERROR; + } else { + (void)getLong(s); + /* The uncompressed length returned by above getlong() may be + * different from s->out in case of concatenated .gz files. + * Check for such files: + */ + check_header(s); + if (s->z_err == Z_OK) { + inflateReset(&(s->stream)); + s->crc = crc32(0L, Z_NULL, 0); + } + } + } + if (s->z_err != Z_OK || s->z_eof) break; + } + s->crc = crc32(s->crc, start, (uInt) (s->stream.next_out - start)); + + if (len == s->stream.avail_out && + (s->z_err == Z_DATA_ERROR || s->z_err == Z_ERRNO)) { + if(s->z_err == Z_DATA_ERROR) + warning("invalid or incomplete compressed data"); + else if(s->z_err == Z_ERRNO) + warning("error reading the file"); + return -1; + } + return (int)(len - s->stream.avail_out); +} + +/* for devPS.c */ +char *R_gzgets(gzFile file, char *buf, int len) +{ + char *b = buf; + if (buf == Z_NULL || len <= 0) return Z_NULL; + + while (--len > 0 && R_gzread(file, buf, 1) == 1 && *buf++ != '\n') ; + *buf = '\0'; + return b == buf && len > 0 ? Z_NULL : b; +} + + +static int R_gzwrite (gzFile file, voidpc buf, unsigned len) +{ + gz_stream *s = (gz_stream*) file; + + if (s == NULL || s->mode != 'w') return Z_STREAM_ERROR; + + s->stream.next_in = (Bytef*) buf; + s->stream.avail_in = len; + + while (s->stream.avail_in != 0) { + if (s->stream.avail_out == 0) { + s->stream.next_out = s->buffer; + if (fwrite(s->buffer, 1, Z_BUFSIZE, s->file) != Z_BUFSIZE) { + s->z_err = Z_ERRNO; + break; + } + s->stream.avail_out = Z_BUFSIZE; + } + s->in += s->stream.avail_in; + s->out += s->stream.avail_out; + s->z_err = deflate(&(s->stream), Z_NO_FLUSH); + s->in -= s->stream.avail_in; + s->out -= s->stream.avail_out; + if (s->z_err != Z_OK) break; + } + s->crc = crc32(s->crc, (const Bytef *) buf, len); + + return (int) (len - s->stream.avail_in); +} + + +static int gz_flush (gzFile file, int flush) +{ + uInt len; + int done = 0; + gz_stream *s = (gz_stream*) file; + + if (s == NULL || s->mode != 'w') return Z_STREAM_ERROR; + + s->stream.avail_in = 0; /* should be zero already anyway */ + + for (;;) { + len = Z_BUFSIZE - s->stream.avail_out; + if (len != 0) { + if ((uInt)fwrite(s->buffer, 1, len, s->file) != len) { + s->z_err = Z_ERRNO; + return Z_ERRNO; + } + s->stream.next_out = s->buffer; + s->stream.avail_out = Z_BUFSIZE; + } + if (done) break; + s->out += s->stream.avail_out; + s->z_err = deflate(&(s->stream), flush); + s->out -= s->stream.avail_out; + + /* Ignore the second of two consecutive flushes: */ + if (len == 0 && s->z_err == Z_BUF_ERROR) s->z_err = Z_OK; + + /* deflate has finished flushing only when it hasn't used up + * all the available space in the output buffer: + */ + done = (s->stream.avail_out != 0 || s->z_err == Z_STREAM_END); + + if (s->z_err != Z_OK && s->z_err != Z_STREAM_END) break; + } + return s->z_err == Z_STREAM_END ? Z_OK : s->z_err; +} + +/* return value 0 for success, 1 for failure */ +static int int_gzrewind (gzFile file) +{ + gz_stream *s = (gz_stream*) file; + + if (s == NULL || s->mode != 'r') return -1; + + s->z_err = Z_OK; + s->z_eof = 0; + s->stream.avail_in = 0; + s->stream.next_in = s->buffer; + s->crc = crc32(0L, Z_NULL, 0); + if (!s->transparent) (void) inflateReset(&s->stream); + s->in = 0; + s->out = 0; + return f_seek(s->file, s->start, SEEK_SET); +} + +static Rz_off_t R_gztell (gzFile file) +{ + gz_stream *s = (gz_stream*) file; + if (s->mode == 'w') return s->in; else return s->out; +} + +/* NB: return value is in line with fseeko, not gzseek */ +static int R_gzseek (gzFile file, Rz_off_t offset, int whence) +{ + gz_stream *s = (gz_stream*) file; + + if (s == NULL || whence == SEEK_END || + s->z_err == Z_ERRNO || s->z_err == Z_DATA_ERROR) return -1; + + if (s->mode == 'w') { + if (whence == SEEK_SET) offset -= s->in; + if (offset < 0) return -1; + + /* At this point, offset is the number of zero bytes to write. */ + memset(s->buffer, 0, Z_BUFSIZE); + while (offset > 0) { + uInt size = Z_BUFSIZE; + if (offset < Z_BUFSIZE) size = (uInt) offset; + size = R_gzwrite(file, s->buffer, size); + if (size == 0) return -1; + offset -= size; + } + return 0; + } + + /* Rest of function is for reading only */ + + /* compute absolute position */ + if (whence == SEEK_CUR) offset += s->out; + if (offset < 0) return -1; + + if (s->transparent) { + s->stream.avail_in = 0; + s->stream.next_in = s->buffer; + if (f_seek(s->file, offset, SEEK_SET) < 0) return -1; + s->in = s->out = offset; + return 0; + } + + /* For a negative seek, rewind and use positive seek */ + if (offset >= s->out) offset -= s->out; + else if (int_gzrewind(file) < 0) return -1; + + /* offset is now the number of bytes to skip. */ + while (offset > 0) { + int size = Z_BUFSIZE; + if (offset < Z_BUFSIZE) size = (int) offset; + size = R_gzread(file, s->buffer, (uInt) size); + if (size <= 0) return -1; + offset -= size; + } + return 0; +} + +int R_gzclose (gzFile file) +{ + gz_stream *s = (gz_stream*) file; + if (s == NULL) return Z_STREAM_ERROR; + if (s->mode == 'w') { + if (gz_flush (file, Z_FINISH) != Z_OK) + return destroy((gz_stream*) file); + z_putLong (s->file, s->crc); + z_putLong (s->file, (uLong) (s->in & 0xffffffff)); + } + return destroy((gz_stream*) file); +} diff --git a/com.oracle.truffle.r.native/gnur/patch/src/main/plot.c b/com.oracle.truffle.r.native/gnur/patch/src/main/plot.c new file mode 100644 index 0000000000000000000000000000000000000000..a1c4d576d04c0977402843cf1868097aff5d2385 --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/main/plot.c @@ -0,0 +1,204 @@ +/* + * R : A Computer Language for Statistical Data Analysis + * Copyright (C) 1995, 1996 Robert Gentleman and Ross Ihaka + * Copyright (C) 1997--2014 The R Core Team + * Copyright (C) 2002--2009 The R Foundation + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version. + * + * This program 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 this program; if not, a copy is available at + * https://www.R-project.org/Licenses/ + */ + +#ifdef HAVE_CONFIG_H +# include <config.h> +#endif + +#include <Defn.h> +#include <float.h> /* for DBL_MAX */ +#include <Graphics.h> +#include <Print.h> +#include <Rmath.h> // for Rexp10, imax2 + +/* used in graphics and grid */ +SEXP CreateAtVector(double *axp, double *usr, int nint, Rboolean logflag) +{ +/* Create an 'at = ...' vector for axis(.) + * i.e., the vector of tick mark locations, + * when none has been specified (= default). + * + * axp[0:2] = (x1, x2, nInt), where x1..x2 are the extreme tick marks + * {unless in log case, where nInt \in {1,2,3 ; -1,-2,....} + * and the `nint' argument is used *instead*.} + + * The resulting REAL vector must have length >= 1, ideally >= 2 + */ + SEXP at = R_NilValue;/* -Wall*/ + double umin, umax, dn, rng, small; + int i, n, ne; + if (!logflag || axp[2] < 0) { /* --- linear axis --- Only use axp[] arg. */ + n = (int)(fabs(axp[2]) + 0.25);/* >= 0 */ + dn = imax2(1, n); + rng = axp[1] - axp[0]; + small = fabs(rng)/(100.*dn); + at = allocVector(REALSXP, n + 1); + for (i = 0; i <= n; i++) { + REAL(at)[i] = axp[0] + (i / dn) * rng; + if (fabs(REAL(at)[i]) < small) + REAL(at)[i] = 0; + } + } + else { /* ------ log axis ----- */ + Rboolean reversed = FALSE; + + n = (int)(axp[2] + 0.5); + /* {xy}axp[2] for 'log': GLpretty() [./graphics.c] sets + n < 0: very small scale ==> linear axis, above, or + n = 1,2,3. see switch() below */ + umin = usr[0]; + umax = usr[1]; + if (umin > umax) { + reversed = (axp[0] > axp[1]); + if (reversed) { + /* have *reversed* log axis -- whereas + * the switch(n) { .. } below assumes *increasing* values + * --> reverse axis direction here, and reverse back at end */ + umin = usr[1]; + umax = usr[0]; + dn = axp[0]; axp[0] = axp[1]; axp[1] = dn; + } + else { + /* can the following still happen... ? */ + warning("CreateAtVector \"log\"(from axis()): " + "usr[0] = %g > %g = usr[1] !", umin, umax); + } + } + /* allow a fuzz since we will do things like 0.2*dn >= umin */ + umin *= 1 - 1e-12; + umax *= 1 + 1e-12; + + dn = axp[0]; + if (dn < DBL_MIN) {/* was 1e-300; now seems too cautious */ + warning("CreateAtVector \"log\"(from axis()): axp[0] = %g !", dn); + if (dn <= 0) /* real trouble (once for Solaris) later on */ + error("CreateAtVector [log-axis()]: axp[0] = %g < 0!", dn); + } + + /* You get the 3 cases below by + * for (y in 1e-5*c(1,2,8)) plot(y, log = "y") + */ + switch(n) { + case 1: /* large range: 1 * 10^k */ + i = (int)(floor(log10(axp[1])) - ceil(log10(axp[0])) + 0.25); + ne = i / nint + 1; +#ifdef DEBUG_axis + REprintf("CreateAtVector [log-axis(), case 1]: (nint, ne) = (%d,%d)\n", + nint, ne); +#endif + if (ne < 1) + error("log - axis(), 'at' creation, _LARGE_ range: " + "ne = %d <= 0 !!\n" + "\t axp[0:1]=(%g,%g) ==> i = %d; nint = %d", + ne, axp[0],axp[1], i, nint); + rng = Rexp10((double)ne); /* >= 10 */ + n = 0; + while (dn < umax) { + n++; + dn *= rng; + } + if (!n) + error("log - axis(), 'at' creation, _LARGE_ range: " + "invalid {xy}axp or par; nint=%d\n" + " axp[0:1]=(%g,%g), usr[0:1]=(%g,%g); i=%d, ni=%d", + nint, axp[0],axp[1], umin,umax, i,ne); + at = allocVector(REALSXP, n); + dn = axp[0]; + n = 0; + while (dn < umax) { + REAL(at)[n++] = dn; + dn *= rng; + } + break; + + case 2: /* medium range: 1, 5 * 10^k */ + n = 0; + if (0.5 * dn >= umin) n++; + for (;;) { + if (dn > umax) break; + n++; + if (5 * dn > umax) break; + n++; + dn *= 10; + } + if (!n) + error("log - axis(), 'at' creation, _MEDIUM_ range: " + "invalid {xy}axp or par;\n" + " axp[0]= %g, usr[0:1]=(%g,%g)", + axp[0], umin,umax); + + at = allocVector(REALSXP, n); + dn = axp[0]; + n = 0; + if (0.5 * dn >= umin) REAL(at)[n++] = 0.5 * dn; + for (;;) { + if (dn > umax) break; REAL(at)[n++] = dn; + if (5 * dn > umax) break; REAL(at)[n++] = 5 * dn; + dn *= 10; + } + break; + + case 3: /* small range: 1,2,5,10 * 10^k */ + n = 0; + if (0.2 * dn >= umin) n++; + if (0.5 * dn >= umin) n++; + for (;;) { + if (dn > umax) break; + n++; + if (2 * dn > umax) break; + n++; + if (5 * dn > umax) break; + n++; + dn *= 10; + } + if (!n) + error("log - axis(), 'at' creation, _SMALL_ range: " + "invalid {xy}axp or par;\n" + " axp[0]= %g, usr[0:1]=(%g,%g)", + axp[0], umin,umax); + at = allocVector(REALSXP, n); + dn = axp[0]; + n = 0; + if (0.2 * dn >= umin) REAL(at)[n++] = 0.2 * dn; + if (0.5 * dn >= umin) REAL(at)[n++] = 0.5 * dn; + for (;;) { + if (dn > umax) break; REAL(at)[n++] = dn; + if (2 * dn > umax) break; REAL(at)[n++] = 2 * dn; + if (5 * dn > umax) break; REAL(at)[n++] = 5 * dn; + dn *= 10; + } + break; + default: + error("log - axis(), 'at' creation: INVALID {xy}axp[3] = %g", + axp[2]); + } + + if (reversed) {/* reverse back again - last assignment was at[n++]= . */ + for (i = 0; i < n/2; i++) { /* swap( at[i], at[n-i-1] ) : */ + dn = REAL(at)[i]; + REAL(at)[i] = REAL(at)[n-i-1]; + REAL(at)[n-i-1] = dn; + } + } + } /* linear / log */ + return at; +} + diff --git a/com.oracle.truffle.r.native/gnur/patch/src/main/plot3d.c b/com.oracle.truffle.r.native/gnur/patch/src/main/plot3d.c new file mode 100644 index 0000000000000000000000000000000000000000..c613353c118bfa9ac5838a2cfcd80522d7b371a0 --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/main/plot3d.c @@ -0,0 +1,288 @@ +/* + * R : A Computer Language for Statistical Data Analysis + * Copyright (C) 1995, 1996 Robert Gentleman and Ross Ihaka + * Copyright (C) 1997--2014 The R Core Team + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version. + * + * This program 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 this program; if not, a copy is available at + * https://www.R-project.org/Licenses/ + */ + + +#ifdef HAVE_CONFIG_H +#include <config.h> +#endif + +#include <Defn.h> +#include <Internal.h> +#include <float.h> /* for DBL_MAX */ +#include <Rmath.h> +#include <Graphics.h> +#include <Print.h> +#include <R_ext/Boolean.h> + +/* filled contours and perspective plots were originally here, + now in graphics/src/plot3d.c . + */ + +#include "contour-common.h" + +#define CONTOUR_LIST_STEP 100 +#define CONTOUR_LIST_LEVEL 0 +#define CONTOUR_LIST_X 1 +#define CONTOUR_LIST_Y 2 + +static SEXP growList(SEXP oldlist) { + int i, len; + SEXP templist; + len = LENGTH(oldlist); + templist = PROTECT(allocVector(VECSXP, len + CONTOUR_LIST_STEP)); + for (i=0; i<len; i++) + SET_VECTOR_ELT(templist, i, VECTOR_ELT(oldlist, i)); + UNPROTECT(1); + return templist; +} + +/* + * Store the list of segments for a single level in the SEXP + * list that will be returned to the user + */ +static +int addContourLines(double *x, int nx, double *y, int ny, + double *z, double zc, double atom, + SEGP* segmentDB, int nlines, SEXP container) +{ + double xend, yend; + int i, ii, j, jj, ns, dir, nc; + SEGP seglist, seg, s, start, end; + SEXP ctr, level, xsxp, ysxp, names; + /* Begin following contours. */ + /* 1. Grab a segment */ + /* 2. Follow its tail */ + /* 3. Follow its head */ + /* 4. Save the contour */ + for (i = 0; i < nx - 1; i++) + for (j = 0; j < ny - 1; j++) { + while ((seglist = segmentDB[i + j * nx])) { + ii = i; jj = j; + start = end = seglist; + segmentDB[i + j * nx] = seglist->next; + xend = seglist->x1; + yend = seglist->y1; + while ((dir = ctr_segdir(xend, yend, x, y, + &ii, &jj, nx, ny))) { + segmentDB[ii + jj * nx] + = ctr_segupdate(xend, yend, dir, TRUE,/* = tail */ + segmentDB[ii + jj * nx], &seg); + if (!seg) break; + end->next = seg; + end = seg; + xend = end->x1; + yend = end->y1; + } + end->next = NULL; /* <<< new for 1.2.3 */ + ii = i; jj = j; + xend = seglist->x0; + yend = seglist->y0; + while ((dir = ctr_segdir(xend, yend, x, y, + &ii, &jj, nx, ny))) { + segmentDB[ii + jj * nx] + = ctr_segupdate(xend, yend, dir, FALSE,/* ie. head */ + segmentDB[ii+jj*nx], &seg); + if (!seg) break; + seg->next = start; + start = seg; + xend = start->x0; + yend = start->y0; + } + + /* ns := #{segments of polyline} -- need to allocate */ + s = start; + ns = 0; + /* max_contour_segments: prevent inf.loop (shouldn't be needed) */ + while (s && ns < max_contour_segments) { + ns++; + s = s->next; + } + if(ns == max_contour_segments) + warning(_("contour(): circular/long seglist -- set %s > %d?"), + "options(\"max.contour.segments\")", max_contour_segments); + /* + * "write" the contour locations into the list of contours + */ + ctr = PROTECT(allocVector(VECSXP, 3)); + level = PROTECT(allocVector(REALSXP, 1)); + xsxp = PROTECT(allocVector(REALSXP, ns + 1)); + ysxp = PROTECT(allocVector(REALSXP, ns + 1)); + REAL(level)[0] = zc; + SET_VECTOR_ELT(ctr, CONTOUR_LIST_LEVEL, level); + s = start; + REAL(xsxp)[0] = s->x0; + REAL(ysxp)[0] = s->y0; + ns = 1; + while (s->next && ns < max_contour_segments) { + s = s->next; + REAL(xsxp)[ns] = s->x0; + REAL(ysxp)[ns++] = s->y0; + } + REAL(xsxp)[ns] = s->x1; + REAL(ysxp)[ns] = s->y1; + SET_VECTOR_ELT(ctr, CONTOUR_LIST_X, xsxp); + SET_VECTOR_ELT(ctr, CONTOUR_LIST_Y, ysxp); + /* + * Set the names attribute for the contour + * So that users can extract components using + * meaningful names + */ + PROTECT(names = allocVector(STRSXP, 3)); + SET_STRING_ELT(names, 0, mkChar("level")); + SET_STRING_ELT(names, 1, mkChar("x")); + SET_STRING_ELT(names, 2, mkChar("y")); + setAttrib(ctr, R_NamesSymbol, names); + /* + * We're about to add another line to the list ... + */ + nlines += 1; + nc = LENGTH(VECTOR_ELT(container, 0)); + if (nlines == nc) + /* Where does this get UNPROTECTed? */ + SET_VECTOR_ELT(container, 0, + growList(VECTOR_ELT(container, 0))); + SET_VECTOR_ELT(VECTOR_ELT(container, 0), nlines - 1, ctr); + UNPROTECT(5); + } + } + return nlines; +} + +/* + * Given nx x values, ny y values, nx*ny z values, + * and nl cut-values in z ... + * ... produce a list of contour lines: + * list of sub-lists + * sub-list = x vector, y vector, and cut-value. + */ +SEXP GEcontourLines(double *x, int nx, double *y, int ny, + double *z, double *levels, int nl) +{ + const void *vmax; + int i, nlines, len; + double atom, zmin, zmax; + SEGP* segmentDB; + SEXP container, mainlist, templist; + /* + * "tie-breaker" values + */ + zmin = DBL_MAX; + zmax = DBL_MIN; + for (i = 0; i < nx * ny; i++) + if (R_FINITE(z[i])) { + if (zmax < z[i]) zmax = z[i]; + if (zmin > z[i]) zmin = z[i]; + } + + if (zmin >= zmax) { + if (zmin == zmax) + warning(_("all z values are equal")); + else + warning(_("all z values are NA")); + return R_NilValue; + } + /* change to 1e-3, reconsidered because of PR#897 + * but 1e-7, and even 2*DBL_EPSILON do not prevent inf.loop in contour(). + * maybe something like 16 * DBL_EPSILON * (..). + * see also max_contour_segments above */ + atom = 1e-3 * (zmax - zmin); + /* + * Create a "container" which is a list with only 1 element. + * The element is the list of lines that will be built up. + * I create the container because this allows me to PROTECT + * the container once here and then UNPROTECT it at the end of + * this function and, as long as I always work with + * VECTOR_ELT(container, 0) and SET_VECTOR_ELT(container, 0) + * in functions called from here, I don't need to worry about + * protectin the list that I am building up. + * Why bother? Because the list I am building can potentially + * grow and it's awkward to get the PROTECTs/UNPROTECTs right + * when you're in a loop and growing a list. + */ + container = PROTECT(allocVector(VECSXP, 1)); + /* + * Create "large" list (will trim excess at the end if necesary) + */ + SET_VECTOR_ELT(container, 0, allocVector(VECSXP, CONTOUR_LIST_STEP)); + nlines = 0; + /* + * Add lines for each contour level + */ + for (i = 0; i < nl; i++) { + /* + * The vmaxget/set is to manage the memory that gets + * R_alloc'ed in the creation of the segmentDB structure + */ + vmax = vmaxget(); + /* + * Generate a segment database + */ + segmentDB = contourLines(x, nx, y, ny, z, levels[i], atom); + /* + * Add lines to the list based on the segment database + */ + nlines = addContourLines(x, nx, y, ny, z, levels[i], + atom, segmentDB, nlines, + container); + vmaxset(vmax); + } + /* + * Trim the list of lines to the appropriate length. + */ + len = LENGTH(VECTOR_ELT(container, 0)); + if (nlines < len) { + mainlist = VECTOR_ELT(container, 0); + templist = PROTECT(allocVector(VECSXP, nlines)); + for (i=0; i<nlines; i++) + SET_VECTOR_ELT(templist, i, VECTOR_ELT(mainlist, i)); + mainlist = templist; + UNPROTECT(1); /* UNPROTECT templist */ + } else + mainlist = VECTOR_ELT(container, 0); + UNPROTECT(1); /* UNPROTECT container */ + return mainlist; +} + +/* This is for contourLines() in package grDevices */ +SEXP do_contourLines(SEXP call, SEXP op, SEXP args, SEXP env) +{ + SEXP c, x, y, z; + int nx, ny, nc; + + x = PROTECT(coerceVector(CAR(args), REALSXP)); + nx = LENGTH(x); + args = CDR(args); + + y = PROTECT(coerceVector(CAR(args), REALSXP)); + ny = LENGTH(y); + args = CDR(args); + + z = PROTECT(coerceVector(CAR(args), REALSXP)); + args = CDR(args); + + /* levels */ + c = PROTECT(coerceVector(CAR(args), REALSXP)); + nc = LENGTH(c); + args = CDR(args); + + SEXP res = GEcontourLines(REAL(x), nx, REAL(y), ny, REAL(z), REAL(c), nc); + UNPROTECT(4); + return res; +} diff --git a/com.oracle.truffle.r.native/gnur/patch/src/main/plotmath.c b/com.oracle.truffle.r.native/gnur/patch/src/main/plotmath.c new file mode 100644 index 0000000000000000000000000000000000000000..ed92e5b1932e888e9147f6e9f044a4b04b10e946 --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/main/plotmath.c @@ -0,0 +1,3227 @@ +/* + * R : A Computer Language for Statistical Data Analysis + * Copyright (C) 1995, 1996, 1997 Robert Gentleman and Ross Ihaka + * Copyright (C) 1998-2015 The R Core Team + * + * This source code module: + * Copyright (C) 1997, 1998 Paul Murrell and Ross Ihaka + * Copyright (C) 1998-2015 The R Core Team + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version. + * + * This program 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 this program; if not, a copy is available at + * https://www.R-project.org/Licenses/ + */ + +#ifdef HAVE_CONFIG_H +#include <config.h> +#endif +#include <Defn.h> + +#include <ctype.h> +#include <rlocale.h> + + +#include <Rmath.h> // provides M_2PI +#include <R_ext/GraphicsEngine.h> + + +/* + * TeX Math Styles + * + * The TeXBook, Appendix G, Page 441. + * + */ + +typedef enum { + STYLE_SS1 = 1, + STYLE_SS = 2, + STYLE_S1 = 3, + STYLE_S = 4, + STYLE_T1 = 5, + STYLE_T = 6, + STYLE_D1 = 7, + STYLE_D = 8 +} STYLE; + +typedef struct { + unsigned int BoxColor; + double BaseCex; + double ReferenceX; + double ReferenceY; + double CurrentX; + double CurrentY; + double CurrentAngle; + double CosAngle; + double SinAngle; + STYLE CurrentStyle; +} mathContext; + +static GEUnit MetricUnit = GE_INCHES; + +/* Font Definitions */ + +typedef enum { + PlainFont = 1, + BoldFont = 2, + ItalicFont = 3, + BoldItalicFont = 4, + SymbolFont = 5 +} FontType; + +/* + * Italic Correction Factor + * + * The correction for a character is computed as ItalicFactor + * times the height (above the baseline) of the character's + * bounding box. + * + */ + +static double ItalicFactor = 0.15; + +/* Drawing basics */ + + +/* Convert CurrentX and CurrentY from */ +/* 0 angle to and CurrentAngle */ + +static double ConvertedX(mathContext *mc, pGEDevDesc dd) +{ + double rotatedX = mc->ReferenceX + + (mc->CurrentX - mc->ReferenceX) * mc->CosAngle - + (mc->CurrentY - mc->ReferenceY) * mc->SinAngle; + return toDeviceX(rotatedX, MetricUnit, dd); +} + +static double ConvertedY(mathContext *mc, pGEDevDesc dd) +{ + double rotatedY = mc->ReferenceY + + (mc->CurrentY - mc->ReferenceY) * mc->CosAngle + + (mc->CurrentX - mc->ReferenceX) * mc->SinAngle; + return toDeviceY(rotatedY, MetricUnit, dd); +} + +static void PMoveAcross(double xamount, mathContext *mc) +{ + mc->CurrentX += xamount; +} + +static void PMoveUp(double yamount, mathContext *mc) +{ + mc->CurrentY += yamount; +} + +static void PMoveTo(double x, double y, mathContext *mc) +{ + mc->CurrentX = x; + mc->CurrentY = y; +} + +/* Basic Font Properties */ + +static double xHeight(pGEcontext gc, pGEDevDesc dd) +{ + double height, depth, width; + GEMetricInfo('x', gc, &height, &depth, &width, dd); + return fromDeviceHeight(height, MetricUnit, dd); +} + +static double XHeight(pGEcontext gc, pGEDevDesc dd) +{ + double height, depth, width; + GEMetricInfo('X', gc, &height, &depth, &width, dd); + return fromDeviceHeight(height, MetricUnit, dd); +} + +static double AxisHeight(pGEcontext gc, pGEDevDesc dd) +{ + double height, depth, width; + GEMetricInfo('+', gc, &height, &depth, &width, dd); + return fromDeviceHeight(0.5 * height, MetricUnit, dd); +} + +static double Quad(pGEcontext gc, pGEDevDesc dd) +{ + double height, depth, width; + GEMetricInfo('M', gc, &height, &depth, &width, dd); + return fromDeviceHeight(width, MetricUnit, dd); +} + +/* The height of digits */ +static double FigHeight(pGEcontext gc, pGEDevDesc dd) +{ + double height, depth, width; + GEMetricInfo('0', gc, &height, &depth, &width, dd); + return fromDeviceHeight(height, MetricUnit, dd); +} + +/* Depth of lower case descenders */ +static double DescDepth(pGEcontext gc, pGEDevDesc dd) +{ + double height, depth, width; + GEMetricInfo('g', gc, &height, &depth, &width, dd); + return fromDeviceHeight(depth, MetricUnit, dd); +} + +/* Thickness of rules */ +static double RuleThickness(void) +{ + return 0.015; +} + +static double ThinSpace(pGEcontext gc, pGEDevDesc dd) +{ + double height, depth, width; + static double OneSixth = 0.16666666666666666666; + GEMetricInfo('M', gc, &height, &depth, &width, dd); + return fromDeviceHeight(OneSixth * width, MetricUnit, dd); +} + +static double MediumSpace(pGEcontext gc, pGEDevDesc dd) +{ + double height, depth, width; + static double TwoNinths = 0.22222222222222222222; + GEMetricInfo('M', gc, &height, &depth, &width, dd); + return fromDeviceHeight(TwoNinths * width, MetricUnit, dd); +} + +static double ThickSpace(pGEcontext gc, pGEDevDesc dd) +{ + double height, depth, width; + static double FiveEighteenths = 0.27777777777777777777; + GEMetricInfo('M', gc, &height, &depth, &width, dd); + return fromDeviceHeight(FiveEighteenths * width, MetricUnit, dd); +} + +static double MuSpace(pGEcontext gc, pGEDevDesc dd) +{ + double height, depth, width; + static double OneEighteenth = 0.05555555555555555555; + GEMetricInfo('M', gc, &height, &depth, &width, dd); + return fromDeviceHeight(OneEighteenth * width, MetricUnit, dd); +} + + +/* + * Mathematics Layout Parameters + * + * The TeXBook, Appendix G, Page 447. + * + * These values are based on an inspection of TeX metafont files + * together with some visual simplification. + * + * Note : The values are ``optimised'' for PostScript. + * + */ + +typedef enum { + sigma2, sigma5, sigma6, sigma8, sigma9, sigma10, sigma11, + sigma12, sigma13, sigma14, sigma15, sigma16, sigma17, sigma18, + sigma19, sigma20, sigma21, sigma22, xi8, xi9, xi10, xi11, xi12, xi13 +} +TEXPAR; + +#define SUBS 0.7 + +static double TeX(TEXPAR which, pGEcontext gc, pGEDevDesc dd) +{ + switch(which) { + case sigma2: /* space */ + case sigma5: /* x_height */ + return xHeight(gc, dd); + + case sigma6: /* quad */ + return Quad(gc, dd); + + case sigma8: /* num1 */ + return AxisHeight(gc, dd) + + 3.51 * RuleThickness() + + 0.15 * XHeight(gc, dd) /* 54/36 * 0.1 */ + + SUBS * DescDepth(gc, dd); + case sigma9: /* num2 */ + return AxisHeight(gc, dd) + + 1.51 * RuleThickness() + + 0.08333333 * XHeight(gc, dd); /* 30/36 * 0.1 */ + case sigma10: /* num3 */ + return AxisHeight(gc, dd) + + 1.51 * RuleThickness() + + 0.1333333 * XHeight(gc, dd); /* 48/36 * 0.1 */ + case sigma11: /* denom1 */ + return - AxisHeight(gc, dd) + + 3.51 * RuleThickness() + + SUBS * FigHeight(gc, dd) + + 0.344444 * XHeight(gc, dd); /* 124/36 * 0.1 */ + case sigma12: /* denom2 */ + return - AxisHeight(gc, dd) + + 1.51 * RuleThickness() + + SUBS * FigHeight(gc, dd) + + 0.08333333 * XHeight(gc, dd); /* 30/36 * 0.1 */ + + case sigma13: /* sup1 */ + return 0.95 * xHeight(gc, dd); + case sigma14: /* sup2 */ + return 0.825 * xHeight(gc, dd); + case sigma15: /* sup3 */ + return 0.7 * xHeight(gc, dd); + + case sigma16: /* sub1 */ + return 0.35 * xHeight(gc, dd); + case sigma17: /* sub2 */ + return 0.45 * XHeight(gc, dd); + + case sigma18: /* sup_drop */ + return 0.3861111 * XHeight(gc, dd); + + case sigma19: /* sub_drop */ + return 0.05 * XHeight(gc, dd); + + case sigma20: /* delim1 */ + return 2.39 * XHeight(gc, dd); + case sigma21: /* delim2 */ + return 1.01 *XHeight(gc, dd); + + case sigma22: /* axis_height */ + return AxisHeight(gc, dd); + + case xi8: /* default_rule_thickness */ + return RuleThickness(); + + case xi9: /* big_op_spacing1 */ + case xi10: /* big_op_spacing2 */ + case xi11: /* big_op_spacing3 */ + case xi12: /* big_op_spacing4 */ + case xi13: /* big_op_spacing5 */ + return 0.15 * XHeight(gc, dd); + default:/* never happens (enum type) */ + error("invalid `which' in C function TeX"); return 0;/*-Wall*/ + } +} + +static STYLE GetStyle(mathContext *mc) +{ + return mc->CurrentStyle; +} + +static void SetStyle(STYLE newstyle, mathContext *mc, pGEcontext gc) +{ + switch (newstyle) { + case STYLE_D: + case STYLE_T: + case STYLE_D1: + case STYLE_T1: + gc->cex = 1.0 * mc->BaseCex; + break; + case STYLE_S: + case STYLE_S1: + gc->cex = 0.7 * mc->BaseCex; + break; + case STYLE_SS: + case STYLE_SS1: + gc->cex = 0.5 * mc->BaseCex; + break; + default: + error(_("invalid math style encountered")); + } + mc->CurrentStyle = newstyle; +} + +static void SetPrimeStyle(STYLE style, mathContext *mc, pGEcontext gc) +{ + switch (style) { + case STYLE_D: + case STYLE_D1: + SetStyle(STYLE_D1, mc, gc); + break; + case STYLE_T: + case STYLE_T1: + SetStyle(STYLE_T1, mc, gc); + break; + case STYLE_S: + case STYLE_S1: + SetStyle(STYLE_S1, mc, gc); + break; + case STYLE_SS: + case STYLE_SS1: + SetStyle(STYLE_SS1, mc, gc); + break; + } +} + +static void SetSupStyle(STYLE style, mathContext *mc, pGEcontext gc) +{ + switch (style) { + case STYLE_D: + case STYLE_T: + SetStyle(STYLE_S, mc, gc); + break; + case STYLE_D1: + case STYLE_T1: + SetStyle(STYLE_S1, mc, gc); + break; + case STYLE_S: + case STYLE_SS: + SetStyle(STYLE_SS, mc, gc); + break; + case STYLE_S1: + case STYLE_SS1: + SetStyle(STYLE_SS1, mc, gc); + break; + } +} + +static void SetSubStyle(STYLE style, mathContext *mc, pGEcontext gc) +{ + switch (style) { + case STYLE_D: + case STYLE_T: + case STYLE_D1: + case STYLE_T1: + SetStyle(STYLE_S1, mc, gc); + break; + case STYLE_S: + case STYLE_SS: + case STYLE_S1: + case STYLE_SS1: + SetStyle(STYLE_SS1, mc, gc); + break; + } +} + +static void SetNumStyle(STYLE style, mathContext *mc, pGEcontext gc) +{ + switch (style) { + case STYLE_D: + SetStyle(STYLE_T, mc, gc); + break; + case STYLE_D1: + SetStyle(STYLE_T1, mc, gc); + break; + default: + SetSupStyle(style, mc, gc); + } +} + +static void SetDenomStyle(STYLE style, mathContext *mc, pGEcontext gc) +{ + if (style > STYLE_T) + SetStyle(STYLE_T1, mc, gc); + else + SetSubStyle(style, mc, gc); +} + +static int IsCompactStyle(STYLE style, mathContext *mc, pGEcontext gc) +{ + switch (style) { + case STYLE_D1: + case STYLE_T1: + case STYLE_S1: + case STYLE_SS1: + return 1; + default: + return 0; + } +} + + +#ifdef max +#undef max +#endif +/* Return maximum of two doubles. */ +static double max(double x, double y) +{ + if (x > y) return x; + else return y; +} + + +/* Bounding Boxes */ +/* These including italic corrections and an */ +/* indication of whether the nucleus was simple. */ + +typedef struct { + double height; + double depth; + double width; + double italic; + int simple; +} BBOX; + + +#define bboxHeight(bbox) bbox.height +#define bboxDepth(bbox) bbox.depth +#define bboxWidth(bbox) bbox.width +#define bboxItalic(bbox) bbox.italic +#define bboxSimple(bbox) bbox.simple + + +static BBOX MakeBBox(double height, double depth, double width) +{ + BBOX bbox; + bboxHeight(bbox) = height; + bboxDepth(bbox) = depth; + bboxWidth(bbox) = width; + bboxItalic(bbox) = 0; + bboxSimple(bbox) = 0; + return bbox; +} + +static BBOX NullBBox(void) +{ + BBOX bbox; + bboxHeight(bbox) = 0; + bboxDepth(bbox) = 0; + bboxWidth(bbox) = 0; + bboxItalic(bbox) = 0; + bboxSimple(bbox) = 0; + return bbox; +} + +static BBOX ShiftBBox(BBOX bbox1, double shiftV) +{ + bboxHeight(bbox1) = bboxHeight(bbox1) + shiftV; + bboxDepth(bbox1) = bboxDepth(bbox1) - shiftV; + bboxWidth(bbox1) = bboxWidth(bbox1); + bboxItalic(bbox1) = bboxItalic(bbox1); + bboxSimple(bbox1) = bboxSimple(bbox1); + return bbox1; +} + +static BBOX EnlargeBBox(BBOX bbox, double deltaHeight, double deltaDepth, + double deltaWidth) +{ + bboxHeight(bbox) += deltaHeight; + bboxDepth(bbox) += deltaDepth; + bboxWidth(bbox) += deltaWidth; + return bbox; +} + +static BBOX CombineBBoxes(BBOX bbox1, BBOX bbox2) +{ + bboxHeight(bbox1) = max(bboxHeight(bbox1), bboxHeight(bbox2)); + bboxDepth(bbox1) = max(bboxDepth(bbox1), bboxDepth(bbox2)); + bboxWidth(bbox1) = bboxWidth(bbox1) + bboxWidth(bbox2); + bboxItalic(bbox1) = bboxItalic(bbox2); + bboxSimple(bbox1) = bboxSimple(bbox2); + return bbox1; +} + +static BBOX CombineAlignedBBoxes(BBOX bbox1, BBOX bbox2) +{ + bboxHeight(bbox1) = max(bboxHeight(bbox1), bboxHeight(bbox2)); + bboxDepth(bbox1) = max(bboxDepth(bbox1), bboxDepth(bbox2)); + bboxWidth(bbox1) = max(bboxWidth(bbox1), bboxWidth(bbox2)); + bboxItalic(bbox1) = 0; + bboxSimple(bbox1) = 0; + return bbox1; +} + +static BBOX CombineOffsetBBoxes(BBOX bbox1, int italic1, + BBOX bbox2, int italic2, + double xoffset, + double yoffset) +{ + double width1 = bboxWidth(bbox1) + (italic1 ? bboxItalic(bbox1) : 0); + double width2 = bboxWidth(bbox2) + (italic2 ? bboxItalic(bbox2) : 0); + bboxWidth(bbox1) = max(width1, width2 + xoffset); + bboxHeight(bbox1) = max(bboxHeight(bbox1), bboxHeight(bbox2) + yoffset); + bboxDepth(bbox1) = max(bboxDepth(bbox1), bboxDepth(bbox2) - yoffset); + bboxItalic(bbox1) = 0; + bboxSimple(bbox1) = 0; + return bbox1; +} + +static double CenterShift(BBOX bbox) +{ + return 0.5 * (bboxHeight(bbox) - bboxDepth(bbox)); +} + + +typedef struct { + char *name; + int code; +} SymTab; + +/* Determine a match between symbol name and string. */ + +static int NameMatch(SEXP expr, const char *aString) +{ + if (!isSymbol(expr)) return 0; + return !strcmp(CHAR(PRINTNAME(expr)), aString); +} + +static int StringMatch(SEXP expr, const char *aString) +{ + return !strcmp(translateChar(STRING_ELT(expr, 0)), aString); +} +/* Code to determine the ascii code corresponding */ +/* to an element of a mathematical expression. */ + +#define A_HAT 94 +#define A_TILDE 126 + +#define S_SPACE 32 +#define S_PARENLEFT 40 +#define S_PARENRIGHT 41 +#define S_ASTERISKMATH 42 +#define S_COMMA 44 +#define S_SLASH 47 +#define S_RADICALEX 96 +#define S_FRACTION 164 +#define S_ELLIPSIS 188 +#define S_INTERSECTION 199 +#define S_UNION 200 +#define S_PRODUCT 213 +#define S_RADICAL 214 +#define S_SUM 229 +#define S_INTEGRAL 242 +#define S_BRACKETLEFTTP 233 +#define S_BRACKETLEFTBT 235 +#define S_BRACKETRIGHTTP 249 +#define S_BRACKETRIGHTBT 251 + +#define N_LIM 1001 +#define N_LIMINF 1002 +#define N_LIMSUP 1003 +#define N_INF 1004 +#define N_SUP 1005 +#define N_MIN 1006 +#define N_MAX 1007 + + +/* The Full Adobe Symbol Font */ + +static SymTab +SymbolTable[] = { + { "space", 32 }, + { "exclam", 33 }, + { "universal", 34 }, + { "numbersign", 35 }, + { "existential", 36 }, + { "percent", 37 }, + { "ampersand", 38 }, + { "suchthat", 39 }, + { "parenleft", 40 }, + { "parenright", 41 }, + { "asteriskmath", 42 }, + { "plus", 43 }, + { "comma", 44 }, + { "minus", 45 }, + { "period", 46 }, + { "slash", 47 }, + { "0", 48 }, + { "1", 49 }, + { "2", 50 }, + { "3", 51 }, + { "4", 52 }, + { "5", 53 }, + { "6", 54 }, + { "7", 55 }, + { "8", 56 }, + { "9", 57 }, + { "colon", 58 }, + { "semicolon", 59 }, + { "less", 60 }, + { "equal", 61 }, + { "greater", 62 }, + { "question", 63 }, + { "congruent", 64 }, + + { "Alpha",/* 0101= */65 }, /* Upper Case Greek Characters */ + { "Beta", 66 }, + { "Chi", 67 }, + { "Delta", 68 }, + { "Epsilon", 69 }, + { "Phi", 70 }, + { "Gamma", 71 }, + { "Eta", 72 }, + { "Iota", 73 }, + { "theta1", 74 }, + { "vartheta", 74 }, + { "Kappa", 75 }, + { "Lambda", 76 }, + { "Mu", 77 }, + { "Nu", 78 }, + { "Omicron", 79 }, + { "Pi", 80 }, + { "Theta", 81 }, + { "Rho", 82 }, + { "Sigma", 83 }, + { "Tau", 84 }, + { "Upsilon", 85 }, + { "sigma1", 86 }, + { "varsigma", 86 }, + { "stigma", 86 }, + { "Omega", 87 }, + { "Xi", 88 }, + { "Psi", 89 }, + { "Zeta",/* 0132 = */90 }, + + { "bracketleft", 91 }, /* Miscellaneous Special Characters */ + { "therefore", 92 }, + { "bracketright", 93 }, + { "perpendicular", 94 }, + { "underscore", 95 }, + { "radicalex", 96 }, + + { "alpha",/* 0141= */97 }, /* Lower Case Greek Characters */ + { "beta", 98 }, + { "chi", 99 }, + { "delta", 100 }, + { "epsilon", 101 }, + { "phi", 102 }, + { "gamma", 103 }, + { "eta", 104 }, + { "iota", 105 }, + { "phi1", 106 }, + { "varphi", 106 }, + { "kappa", 107 }, + { "lambda", 108 }, + { "mu", 109 }, + { "nu", 110 }, + { "omicron", 111 }, + { "pi", 112 }, + { "theta", 113 }, + { "rho", 114 }, + { "sigma", 115 }, + { "tau", 116 }, + { "upsilon", 117 }, + { "omega1", 118 }, + { "omega", 119 }, + { "xi", 120 }, + { "psi", 121 }, + { "zeta",/* 0172= */122 }, + + { "braceleft", 123 }, /* Miscellaneous Special Characters */ + { "bar", 124 }, + { "braceright", 125 }, + { "similar", 126 }, + + { "Upsilon1", 161 }, /* Lone Greek */ + { "minute", 162 }, + { "lessequal", 163 }, + { "fraction", 164 }, + { "infinity", 165 }, + { "florin", 166 }, + { "club", 167 }, + { "diamond", 168 }, + { "heart", 169 }, + { "spade", 170 }, + { "arrowboth", 171 }, + { "arrowleft", 172 }, + { "arrowup", 173 }, + { "arrowright", 174 }, + { "arrowdown", 175 }, + { "degree", 176 }, + { "plusminus", 177 }, + { "second", 178 }, + { "greaterequal", 179 }, + { "multiply", 180 }, + { "proportional", 181 }, + { "partialdiff", 182 }, + { "bullet", 183 }, + { "divide", 184 }, + { "notequal", 185 }, + { "equivalence", 186 }, + { "approxequal", 187 }, + { "ellipsis", 188 }, + { "arrowvertex", 189 }, + { "arrowhorizex", 190 }, + { "carriagereturn", 191 }, + { "aleph", 192 }, + { "Ifraktur", 193 }, + { "Rfraktur", 194 }, + { "weierstrass", 195 }, + { "circlemultiply", 196 }, + { "circleplus", 197 }, + { "emptyset", 198 }, + { "intersection", 199 },/* = 0307 */ + { "union", 200 },/* = 0310 */ + { "propersuperset", 201 }, + { "reflexsuperset", 202 }, + { "notsubset", 203 }, + { "propersubset", 204 }, + { "reflexsubset", 205 }, + { "element", 206 }, + { "notelement", 207 }, + { "angle", 208 }, + { "nabla", 209 },/* = 0321, Adobe name 'gradient' */ + { "registerserif", 210 }, + { "copyrightserif", 211 }, + { "trademarkserif", 212 }, + { "product", 213 }, + { "radical", 214 }, + { "dotmath", 215 }, + { "logicaland", 217 }, + { "logicalor", 218 }, + { "arrowdblboth", 219 }, + { "arrowdblleft", 220 }, + { "arrowdblup", 221 }, + { "arrowdblright", 222 }, + { "arrowdbldown", 223 }, + { "lozenge", 224 }, + { "angleleft", 225 }, + { "registersans", 226 }, + { "copyrightsans", 227 }, + { "trademarksans", 228 }, + { "summation", 229 }, + { "parenlefttp", 230 }, + { "parenleftex", 231 }, + { "parenleftbt", 232 }, + { "bracketlefttp", 233 }, + { "bracketleftex", 234 }, + { "bracketleftbt", 235 }, + { "bracelefttp", 236 }, + { "braceleftmid", 237 }, + { "braceleftbt", 238 }, + { "braceex", 239 }, + { "angleright", 241 }, + { "integral", 242 }, + { "integraltp", 243 }, + { "integralex", 244 }, + { "integralbt", 245 }, + { "parenrighttp", 246 }, + { "parenrightex", 247 }, + { "parenrightbt", 248 }, + { "bracketrighttp", 249 }, + { "bracketrightex", 250 }, + { "bracketrightbt", 251 }, + { "bracerighttp", 252 }, + { "bracerightmid", 253 }, + { "bracerightbt", 254 }, + + { NULL, 0 }, +}; + +static int SymbolCode(SEXP expr) +{ + int i; + for (i = 0; SymbolTable[i].code; i++) + if (NameMatch(expr, SymbolTable[i].name)) + return SymbolTable[i].code; + return 0; +} + +/* this is the one really used: */ +static int TranslatedSymbol(SEXP expr) +{ + int code = SymbolCode(expr); + if ((0101 <= code && code <= 0132) || /* l/c Greek */ + (0141 <= code && code <= 0172) || /* u/c Greek */ + code == 0300 || /* aleph */ + code == 0241 || /* Upsilon1 */ + code == 0242 || /* minute */ + code == 0245 || /* infinity */ + code == 0260 || /* degree */ + code == 0262 || /* second */ + code == 0266 || /* partialdiff */ + code == 0321 || /* nabla */ + 0) + return code; + else // not translated + return 0; +} + +/* Code to determine the nature of an expression. */ + +static int FormulaExpression(SEXP expr) +{ + return (TYPEOF(expr) == LANGSXP); +} + +static int NameAtom(SEXP expr) +{ + return (TYPEOF(expr) == SYMSXP); +} + +static int NumberAtom(SEXP expr) +{ + return ((TYPEOF(expr) == REALSXP) || + (TYPEOF(expr) == INTSXP) || + (TYPEOF(expr) == CPLXSXP)); +} + +static int StringAtom(SEXP expr) +{ + return (TYPEOF(expr) == STRSXP); +} + +/* Code to determine a font from the */ +/* nature of the expression */ + +static FontType GetFont(pGEcontext gc) +{ + return gc->fontface; +} + +static FontType SetFont(FontType font, pGEcontext gc) +{ + FontType prevfont = gc->fontface; + gc->fontface = font; + return prevfont; +} + +static int UsingItalics(pGEcontext gc) +{ + return (gc->fontface == ItalicFont || + gc->fontface == BoldItalicFont); +} + +static BBOX GlyphBBox(int chr, pGEcontext gc, pGEDevDesc dd) +{ + BBOX bbox; + double height, depth, width; + int chr1 = chr; + if(dd->dev->wantSymbolUTF8 && gc->fontface == 5) + chr1 = -Rf_AdobeSymbol2ucs2(chr); + GEMetricInfo(chr1, gc, &height, &depth, &width, dd); + bboxHeight(bbox) = fromDeviceHeight(height, MetricUnit, dd); + bboxDepth(bbox) = fromDeviceHeight(depth, MetricUnit, dd); + bboxWidth(bbox) = fromDeviceHeight(width, MetricUnit, dd); + bboxItalic(bbox) = 0; + bboxSimple(bbox) = 1; + return bbox; +} + +static BBOX RenderElement(SEXP, int, mathContext*, pGEcontext , pGEDevDesc); +static BBOX RenderOffsetElement(SEXP, double, double, int, + mathContext*, pGEcontext , pGEDevDesc); +static BBOX RenderExpression(SEXP, int, mathContext*, pGEcontext , pGEDevDesc); +static BBOX RenderSymbolChar(int, int, mathContext*, pGEcontext , pGEDevDesc); + + +/* Code to Generate Bounding Boxes and Draw Formulae. */ + +static BBOX RenderItalicCorr(BBOX bbox, int draw, mathContext *mc, + pGEcontext gc, pGEDevDesc dd) +{ + if (bboxItalic(bbox) > 0) { + if (draw) + PMoveAcross(bboxItalic(bbox), mc); + bboxWidth(bbox) += bboxItalic(bbox); + bboxItalic(bbox) = 0; + } + return bbox; +} + +static BBOX RenderGap(double gap, int draw, mathContext *mc, + pGEcontext gc, pGEDevDesc dd) +{ + if (draw) + PMoveAcross(gap, mc); + return MakeBBox(0, 0, gap); +} + +/* Draw a Symbol from the Special Font: + this is assumed to be 8-bit encoded in Adobe Symbol. + */ + +static BBOX RenderSymbolChar(int ascii, int draw, mathContext *mc, + pGEcontext gc, pGEDevDesc dd) +{ + FontType prev; + BBOX bbox; + char asciiStr[2]; + if (ascii == A_HAT || ascii == A_TILDE) + prev = SetFont(PlainFont, gc); + else + prev = SetFont(SymbolFont, gc); + bbox = GlyphBBox(ascii, gc, dd); + if (draw) { + asciiStr[0] = (char) ascii; + asciiStr[1] = '\0'; + GEText(ConvertedX(mc ,dd), ConvertedY(mc, dd), asciiStr, + CE_SYMBOL, + 0.0, 0.0, mc->CurrentAngle, gc, + dd); + PMoveAcross(bboxWidth(bbox), mc); + } + SetFont(prev, gc); + return bbox; +} + +/* Draw a Symbol String in "Math Mode" */ +/* This code inserts italic corrections after */ +/* every character. */ + +static BBOX RenderSymbolStr(const char *str, int draw, mathContext *mc, + pGEcontext gc, pGEDevDesc dd) +{ + char chr[7] = ""; + const char *s = str; + BBOX glyphBBox; + BBOX resultBBox = NullBBox(); + double lastItalicCorr = 0; + FontType prevfont = GetFont(gc); + FontType font = prevfont; + + if (str) { + /* Need to advance by character, not byte, except in the symbol font. + The latter would be hard to achieve, but perhaps not impossible. + */ + if(mbcslocale && gc->fontface != 5) { + wchar_t wc; + mbstate_t mb_st; + size_t res; + + mbs_init(&mb_st); + while (*s) { + wc = 0; + res = mbrtowc(&wc, s, MB_LEN_MAX, &mb_st); + if(res == -1) error("invalid multibyte string '%s'", s); + if (iswdigit(wc) && font != PlainFont) { + font = PlainFont; + SetFont(PlainFont, gc); + } + else if (font != prevfont) { + font = prevfont; + SetFont(prevfont, gc); + } + glyphBBox = GlyphBBox((unsigned int) wc, gc, dd); + if (UsingItalics(gc)) + bboxItalic(glyphBBox) = + ItalicFactor * bboxHeight(glyphBBox); + else + bboxItalic(glyphBBox) = 0; + if (draw) { + memset(chr, 0, sizeof(chr)); + /* should not be possible, as we just converted to wc */ + if(wcrtomb(chr, wc, &mb_st) == -1) + error("invalid multibyte string"); + PMoveAcross(lastItalicCorr, mc); + GEText(ConvertedX(mc ,dd), ConvertedY(mc, dd), chr, + CE_NATIVE, + 0.0, 0.0, mc->CurrentAngle, gc, dd); + PMoveAcross(bboxWidth(glyphBBox), mc); + } + bboxWidth(resultBBox) += lastItalicCorr; + resultBBox = CombineBBoxes(resultBBox, glyphBBox); + lastItalicCorr = bboxItalic(glyphBBox); + s += res; + } + } else { + while (*s) { + if (isdigit((int)*s) && font != PlainFont) { + font = PlainFont; + SetFont(PlainFont, gc); + } + else if (font != prevfont) { + font = prevfont; + SetFont(prevfont, gc); + } + glyphBBox = GlyphBBox((unsigned char) *s, gc, dd); + if (UsingItalics(gc)) + bboxItalic(glyphBBox) = + ItalicFactor * bboxHeight(glyphBBox); + else + bboxItalic(glyphBBox) = 0; + if (draw) { + chr[0] = *s; + PMoveAcross(lastItalicCorr, mc); + GEText(ConvertedX(mc ,dd), ConvertedY(mc, dd), chr, + CE_NATIVE, + 0.0, 0.0, mc->CurrentAngle, gc, dd); + PMoveAcross(bboxWidth(glyphBBox), mc); + } + bboxWidth(resultBBox) += lastItalicCorr; + resultBBox = CombineBBoxes(resultBBox, glyphBBox); + lastItalicCorr = bboxItalic(glyphBBox); + s++; + } + } + if (font != prevfont) + SetFont(prevfont, gc); + } + bboxSimple(resultBBox) = 1; + return resultBBox; +} + +/* Code for Character String Atoms. */ + +/* This only gets called from RenderAccent */ +static BBOX RenderChar(int ascii, int draw, mathContext *mc, + pGEcontext gc, pGEDevDesc dd) +{ + BBOX bbox; + char asciiStr[7]; + + bbox = GlyphBBox(ascii, gc, dd); + if (draw) { + memset(asciiStr, 0, sizeof(asciiStr)); + if(mbcslocale) { + size_t res = wcrtomb(asciiStr, ascii, NULL); + if(res == -1) + error("invalid character in current multibyte locale"); + } else + asciiStr[0] = (char) ascii; + GEText(ConvertedX(mc ,dd), ConvertedY(mc, dd), asciiStr, CE_NATIVE, + 0.0, 0.0, mc->CurrentAngle, gc, + dd); + PMoveAcross(bboxWidth(bbox), mc); + } + return bbox; +} + +/* This gets called on strings and PRINTNAMES */ +static BBOX RenderStr(const char *str, int draw, mathContext *mc, + pGEcontext gc, pGEDevDesc dd) +{ + BBOX glyphBBox = NullBBox(); /* might be use do italic corr on str="" */ + BBOX resultBBox = NullBBox(); + int nc = 0; + cetype_t enc = (gc->fontface == 5) ? CE_SYMBOL : CE_NATIVE; + + if (str) { + /* need to advance by character, not byte, except in the symbol font */ + if(mbcslocale && gc->fontface != 5) { + size_t n = strlen(str), used; + wchar_t wc; + const char *p = str; + mbstate_t mb_st; + mbs_init(&mb_st); + while ((used = Mbrtowc(&wc, p, n, &mb_st)) > 0) { + /* On Windows could have sign extension here */ + glyphBBox = GlyphBBox((unsigned int) wc, gc, dd); + resultBBox = CombineBBoxes(resultBBox, glyphBBox); + p += used; n -= used; nc++; + } + } else { + const char *s = str; + while (*s) { + /* Watch for sign extension here - fixed > 2.7.1 */ + glyphBBox = GlyphBBox((unsigned char) *s, gc, dd); + resultBBox = CombineBBoxes(resultBBox, glyphBBox); + s++; nc++; + } + } + if(nc > 1) { + /* Finding the width by adding up boxes is incorrect (kerning) */ + double wd = GEStrWidth(str, enc, gc, dd); + bboxWidth(resultBBox) = fromDeviceHeight(wd, MetricUnit, dd); + } + if (draw) { + GEText(ConvertedX(mc ,dd), ConvertedY(mc, dd), str, enc, + 0.0, 0.0, mc->CurrentAngle, gc, dd); + PMoveAcross(bboxWidth(resultBBox), mc); + } + if (UsingItalics(gc)) + bboxItalic(resultBBox) = ItalicFactor * bboxHeight(glyphBBox); + else + bboxItalic(resultBBox) = 0; + } + bboxSimple(resultBBox) = 1; + return resultBBox; +} + + +/* Code for Symbol Font Atoms */ + +static BBOX RenderSymbol(SEXP expr, int draw, mathContext *mc, + pGEcontext gc, pGEDevDesc dd) +{ + int code; + if ((code = TranslatedSymbol(expr))) + return RenderSymbolChar(code, draw, mc, gc, dd); + else + return RenderSymbolStr(CHAR(PRINTNAME(expr)), draw, mc, gc, dd); +} + +static BBOX RenderSymbolString(SEXP expr, int draw, mathContext *mc, + pGEcontext gc, pGEDevDesc dd) +{ + int code; + if ((code = TranslatedSymbol(expr))) + return RenderSymbolChar(code, draw, mc, gc, dd); + else + return RenderStr(CHAR(PRINTNAME(expr)), draw, mc, gc, dd); +} + + +/* Code for Numeric Atoms */ + +static BBOX RenderNumber(SEXP expr, int draw, mathContext *mc, + pGEcontext gc, pGEDevDesc dd) +{ + BBOX bbox; + FontType prevfont = SetFont(PlainFont, gc); + PrintDefaults(); + bbox = RenderStr(CHAR(asChar(expr)), draw, mc, gc, dd); + SetFont(prevfont, gc); + return bbox; +} + +/* Code for String Atoms */ + +static BBOX RenderString(SEXP expr, int draw, mathContext *mc, + pGEcontext gc, pGEDevDesc dd) +{ + return RenderStr(translateChar(STRING_ELT(expr, 0)), draw, mc, gc, dd); +} + +/* Code for Ellipsis (ldots, cdots, ...) */ + +static int DotsAtom(SEXP expr) +{ + if (NameMatch(expr, "cdots") || + NameMatch(expr, "...") || + NameMatch(expr, "ldots")) + return 1; + return 0; +} + +static BBOX RenderDots(SEXP expr, int draw, mathContext *mc, + pGEcontext gc, pGEDevDesc dd) +{ + BBOX bbox = RenderSymbolChar(S_ELLIPSIS, 0, mc, gc, dd); + if (NameMatch(expr, "cdots") || NameMatch(expr, "...")) { + double shift = AxisHeight(gc, dd) - 0.5 * bboxHeight(bbox); + if (draw) { + PMoveUp(shift, mc); + RenderSymbolChar(S_ELLIPSIS, 1, mc, gc, dd); + PMoveUp(-shift, mc); + } + return ShiftBBox(bbox, shift); + } + else { + if (draw) + RenderSymbolChar(S_ELLIPSIS, 1, mc, gc, dd); + return bbox; + } +} + +/*---------------------------------------------------------------------- + * + * Code for Atoms + * + */ + +static BBOX RenderAtom(SEXP expr, int draw, mathContext *mc, + pGEcontext gc, pGEDevDesc dd) +{ + if (NameAtom(expr)) { + if (DotsAtom(expr)) + return RenderDots(expr, draw, mc, gc, dd); + else + return RenderSymbol(expr, draw, mc, gc, dd); + } + else if (NumberAtom(expr)) + return RenderNumber(expr, draw, mc, gc, dd); + else if (StringAtom(expr)) + return RenderString(expr, draw, mc, gc, dd); + + return NullBBox(); /* -Wall */ +} + + +/*---------------------------------------------------------------------- + * + * Code for Binary / Unary Operators (~, +, -, ... ) + * + * Note that there are unary and binary ~ s. + * + */ + +static int SpaceAtom(SEXP expr) +{ + return NameAtom(expr) && NameMatch(expr, "~"); +} + + +static BBOX RenderSpace(SEXP expr, int draw, mathContext *mc, + pGEcontext gc, pGEDevDesc dd) +{ + + BBOX opBBox, arg1BBox, arg2BBox; + int nexpr = length(expr); + + if (nexpr == 2) { + opBBox = RenderSymbolChar(' ', draw, mc, gc, dd); + arg1BBox = RenderElement(CADR(expr), draw, mc, gc, dd); + return CombineBBoxes(opBBox, arg1BBox); + } + else if (nexpr == 3) { + arg1BBox = RenderElement(CADR(expr), draw, mc, gc, dd); + opBBox = RenderSymbolChar(' ', draw, mc, gc, dd); + arg2BBox = RenderElement(CADDR(expr), draw, mc, gc, dd); + opBBox = CombineBBoxes(arg1BBox, opBBox); + opBBox = CombineBBoxes(opBBox, arg2BBox); + return opBBox; + } + else + error(_("invalid mathematical annotation")); + + return NullBBox(); /* -Wall */ +} + +static SymTab BinTable[] = { + { "*", 052 }, /* Binary Operators */ + { "+", 053 }, + { "-", 055 }, + { "/", 057 }, + { ":", 072 }, + { "%+-%", 0261 }, + { "%*%", 0264 }, + { "%/%", 0270 }, + { "%intersection%", 0307 }, + { "%union%", 0310 }, + { "%.%", 0327 }, /* cdot or dotmath */ + { NULL, 0 } +}; + +static int BinAtom(SEXP expr) +{ + int i; + + for (i = 0; BinTable[i].code; i++) + if (NameMatch(expr, BinTable[i].name)) + return BinTable[i].code; + return 0; +} + +static BBOX RenderSlash(int draw, mathContext *mc, pGEcontext gc, + pGEDevDesc dd) +{ + /* Line Drawing Version */ + double x[2], y[2]; + double depth = 0.5 * TeX(sigma22, gc, dd); + double height = XHeight(gc, dd) + 0.5 * TeX(sigma22, gc, dd); + double width = 0.5 * xHeight(gc, dd); + if (draw) { + int savedlty = gc->lty; + double savedlwd = gc->lwd; + PMoveAcross(0.5 * width, mc); + PMoveUp(-depth, mc); + x[0] = ConvertedX(mc, dd); + y[0] = ConvertedY(mc, dd); + PMoveAcross(width, mc); + PMoveUp(depth + height, mc); + x[1] = ConvertedX(mc, dd); + y[1] = ConvertedY(mc, dd); + PMoveUp(-height, mc); + gc->lty = LTY_SOLID; + if (gc->lwd > 1) + gc->lwd = 1; + GEPolyline(2, x, y, gc, dd); + PMoveAcross(0.5 * width, mc); + gc->lty = savedlty; + gc->lwd = savedlwd; + } + return MakeBBox(height, depth, 2 * width); +} + +static BBOX RenderBin(SEXP expr, int draw, mathContext *mc, + pGEcontext gc, pGEDevDesc dd) +{ + int op = BinAtom(CAR(expr)); + int nexpr = length(expr); + BBOX bbox; + double gap; + + if(nexpr == 3) { + if (op == S_ASTERISKMATH) { + bbox = RenderElement(CADR(expr), draw, mc, gc, dd); + bbox = RenderItalicCorr(bbox, draw, mc, gc, dd); + return CombineBBoxes(bbox, RenderElement(CADDR(expr), draw, + mc, gc, dd)); + } + else if (op == S_SLASH) { + gap = 0; + bbox = RenderElement(CADR(expr), draw, mc, gc, dd); + bbox = RenderItalicCorr(bbox, draw, mc, gc, dd); + bbox = CombineBBoxes(bbox, RenderGap(gap, draw, mc, gc, dd)); + bbox = CombineBBoxes(bbox, RenderSlash(draw, mc, gc, dd)); + bbox = CombineBBoxes(bbox, RenderGap(gap, draw, mc, gc, dd)); + return CombineBBoxes(bbox, RenderElement(CADDR(expr), draw, + mc, gc, dd)); + } + else { + gap = (mc->CurrentStyle > STYLE_S) ? MediumSpace(gc, dd) : 0; + bbox = RenderElement(CADR(expr), draw, mc, gc, dd); + bbox = RenderItalicCorr(bbox, draw, mc, gc, dd); + bbox = CombineBBoxes(bbox, RenderGap(gap, draw, mc, gc, dd)); + bbox = CombineBBoxes(bbox, RenderSymbolChar(op, draw, mc, gc, dd)); + bbox = CombineBBoxes(bbox, RenderGap(gap, draw, mc, gc, dd)); + return CombineBBoxes(bbox, RenderElement(CADDR(expr), draw, + mc, gc, dd)); + } + } + else if(nexpr == 2) { + gap = (mc->CurrentStyle > STYLE_S) ? ThinSpace(gc, dd) : 0; + bbox = RenderSymbolChar(op, draw, mc, gc, dd); + bbox = CombineBBoxes(bbox, RenderGap(gap, draw, mc, gc, dd)); + return CombineBBoxes(bbox, RenderElement(CADR(expr), draw, mc, + gc, dd)); + } + else + error(_("invalid mathematical annotation")); + + return NullBBox(); /* -Wall */ + +} + + +/*---------------------------------------------------------------------- + * + * Code for Subscript and Superscipt Expressions + * + * Rules 18, 18a, ..., 18f of the TeXBook. + * + */ + +static int SuperAtom(SEXP expr) +{ + return NameAtom(expr) && NameMatch(expr, "^"); +} + +static int SubAtom(SEXP expr) +{ + return NameAtom(expr) && NameMatch(expr, "["); +} + +/* Note : If all computations are correct */ +/* We do not need to save and restore the */ +/* current location here. This is paranoia. */ +static BBOX RenderSub(SEXP expr, int draw, mathContext *mc, + pGEcontext gc, pGEDevDesc dd) +{ + BBOX bodyBBox, subBBox; + SEXP body = CADR(expr); + SEXP sub = CADDR(expr); + STYLE style = GetStyle(mc); + double savedX = mc->CurrentX; + double savedY = mc->CurrentY; + double v, s16; + bodyBBox = RenderElement(body, draw, mc, gc, dd); + bodyBBox = RenderItalicCorr(bodyBBox, draw, mc, gc, dd); + v = bboxSimple(bodyBBox) ? 0 : bboxDepth(bodyBBox) + TeX(sigma19, gc, dd); + s16 = TeX(sigma16, gc, dd); + SetSubStyle(style, mc, gc); + subBBox = RenderElement(sub, 0, mc, gc, dd); + v = max(max(v, s16), bboxHeight(subBBox) - 0.8 * sigma5); + subBBox = RenderOffsetElement(sub, 0, -v, draw, mc, gc, dd); + bodyBBox = CombineBBoxes(bodyBBox, subBBox); + SetStyle(style, mc, gc); + if (draw) + PMoveTo(savedX + bboxWidth(bodyBBox), savedY, mc); + return bodyBBox; +} + +static BBOX RenderSup(SEXP expr, int draw, mathContext *mc, + pGEcontext gc, pGEDevDesc dd) +{ + BBOX bodyBBox, subBBox, supBBox; + SEXP body = CADR(expr); + SEXP sup = CADDR(expr); + SEXP sub = R_NilValue; /* -Wall */ + STYLE style = GetStyle(mc); + double savedX = mc->CurrentX; + double savedY = mc->CurrentY; + double theta, delta, width; + double u, p; + double v, s5, s17; + int haveSub; + if (FormulaExpression(body) && SubAtom(CAR(body))) { + sub = CADDR(body); + body = CADR(body); + haveSub = 1; + } + else haveSub = 0; + bodyBBox = RenderElement(body, draw, mc, gc, dd); + delta = bboxItalic(bodyBBox); + bodyBBox = RenderItalicCorr(bodyBBox, draw, mc, gc, dd); + width = bboxWidth(bodyBBox); + if (bboxSimple(bodyBBox)) { + u = 0; + v = 0; + } + else { + u = bboxHeight(bodyBBox) - TeX(sigma18, gc, dd); + v = bboxDepth(bodyBBox) + TeX(sigma19, gc, dd); + } + theta = TeX(xi8, gc, dd); + s5 = TeX(sigma5, gc, dd); + s17 = TeX(sigma17, gc, dd); + if (style == STYLE_D) + p = TeX(sigma13, gc, dd); + else if (IsCompactStyle(style, mc, gc)) + p = TeX(sigma15, gc, dd); + else + p = TeX(sigma14, gc, dd); + SetSupStyle(style, mc, gc); + supBBox = RenderElement(sup, 0, mc, gc, dd); + u = max(max(u, p), bboxDepth(supBBox) + 0.25 * s5); + + if (haveSub) { + SetSubStyle(style, mc, gc); + subBBox = RenderElement(sub, 0, mc, gc, dd); + v = max(v, s17); + if ((u - bboxDepth(supBBox)) - (bboxHeight(subBBox) - v) < 4 * theta) { + double psi = 0.8 * s5 - (u - bboxDepth(supBBox)); + if (psi > 0) { + u += psi; + v -= psi; + } + } + if (draw) + PMoveTo(savedX, savedY, mc); + subBBox = RenderOffsetElement(sub, width, -v, draw, mc, gc, dd); + if (draw) + PMoveTo(savedX, savedY, mc); + SetSupStyle(style, mc, gc); + supBBox = RenderOffsetElement(sup, width + delta, u, draw, mc, gc, dd); + bodyBBox = CombineAlignedBBoxes(bodyBBox, subBBox); + bodyBBox = CombineAlignedBBoxes(bodyBBox, supBBox); + } + else { + supBBox = RenderOffsetElement(sup, 0, u, draw, mc, gc, dd); + bodyBBox = CombineBBoxes(bodyBBox, supBBox); + } + if (draw) + PMoveTo(savedX + bboxWidth(bodyBBox), savedY, mc); + SetStyle(style, mc, gc); + return bodyBBox; +} + + +/*---------------------------------------------------------------------- + * + * Code for Accented Expressions (widehat, bar, widetilde, ...) + * + */ + +#define ACCENT_GAP 0.2 +#define HAT_HEIGHT 0.3 + +#define NTILDE 8 +#define DELTA 0.05 + +static int WideTildeAtom(SEXP expr) +{ + return NameAtom(expr) && NameMatch(expr, "widetilde"); +} + +static BBOX RenderWideTilde(SEXP expr, int draw, mathContext *mc, + pGEcontext gc, pGEDevDesc dd) +{ + double savedX = mc->CurrentX; + double savedY = mc->CurrentY; + BBOX bbox = RenderElement(CADR(expr), draw, mc, gc, dd); + double height = bboxHeight(bbox); + /*double width = bboxWidth(bbox);*/ + double totalwidth = bboxWidth(bbox) + bboxItalic(bbox); + double delta = totalwidth * (1 - 2 * DELTA) / NTILDE; + double start = DELTA * totalwidth; + double accentGap = ACCENT_GAP * XHeight(gc, dd); + double hatHeight = 0.5 * HAT_HEIGHT * XHeight(gc, dd); + double c = M_2PI / NTILDE; + double x[NTILDE + 3], y[NTILDE + 3]; + double baseX, baseY, xval, yval; + int i; + + if (draw) { + int savedlty = gc->lty; + double savedlwd = gc->lwd; + baseX = savedX; + baseY = savedY + height + accentGap; + PMoveTo(baseX, baseY, mc); + x[0] = ConvertedX(mc, dd); + y[0] = ConvertedY(mc, dd); + for (i = 0; i <= NTILDE; i++) { + xval = start + i * delta; + yval = 0.5 * hatHeight * (sin(c * i) + 1); + PMoveTo(baseX + xval, baseY + yval, mc); + x[i + 1] = ConvertedX(mc, dd); + y[i + 1] = ConvertedY(mc, dd); + } + PMoveTo(baseX + totalwidth, baseY + hatHeight, mc); + x[NTILDE + 2] = ConvertedX(mc, dd); + y[NTILDE + 2] = ConvertedY(mc, dd); + gc->lty = LTY_SOLID; + if (gc->lwd > 1) + gc->lwd = 1; + GEPolyline(NTILDE + 3, x, y, gc, dd); + PMoveTo(savedX + totalwidth, savedY, mc); + gc->lty = savedlty; + gc->lwd = savedlwd; + } + return MakeBBox(height + accentGap + hatHeight, + bboxDepth(bbox), totalwidth); +} + +static int WideHatAtom(SEXP expr) +{ + return NameAtom(expr) && NameMatch(expr, "widehat"); +} + +static BBOX RenderWideHat(SEXP expr, int draw, mathContext *mc, + pGEcontext gc, pGEDevDesc dd) +{ + double savedX = mc->CurrentX; + double savedY = mc->CurrentY; + BBOX bbox = RenderElement(CADR(expr), draw, mc, gc, dd); + double accentGap = ACCENT_GAP * XHeight(gc, dd); + double hatHeight = HAT_HEIGHT * XHeight(gc, dd); + double totalwidth = bboxWidth(bbox) + bboxItalic(bbox); + double height = bboxHeight(bbox); + double width = bboxWidth(bbox); + double x[3], y[3]; + + if (draw) { + int savedlty = gc->lty; + double savedlwd = gc->lwd; + PMoveTo(savedX, savedY + height + accentGap, mc); + x[0] = ConvertedX(mc, dd); + y[0] = ConvertedY(mc, dd); + PMoveAcross(0.5 * totalwidth, mc); + PMoveUp(hatHeight, mc); + x[1] = ConvertedX(mc, dd); + y[1] = ConvertedY(mc, dd); + PMoveAcross(0.5 * totalwidth, mc); + PMoveUp(-hatHeight, mc); + x[2] = ConvertedX(mc, dd); + y[2] = ConvertedY(mc, dd); + gc->lty = LTY_SOLID; + if (gc->lwd > 1) + gc->lwd = 1; + GEPolyline(3, x, y, gc, dd); + PMoveTo(savedX + width, savedY, mc); + gc->lty = savedlty; + gc->lwd = savedlwd; + } + return EnlargeBBox(bbox, accentGap + hatHeight, 0, 0); +} + +static int BarAtom(SEXP expr) +{ + return NameAtom(expr) && NameMatch(expr, "bar"); +} + +static BBOX RenderBar(SEXP expr, int draw, mathContext *mc, + pGEcontext gc, pGEDevDesc dd) +{ + double savedX = mc->CurrentX; + double savedY = mc->CurrentY; + BBOX bbox = RenderElement(CADR(expr), draw, mc, gc, dd); + double accentGap = ACCENT_GAP * XHeight(gc, dd); + /*double hatHeight = HAT_HEIGHT * XHeight(gc, dd);*/ + double height = bboxHeight(bbox); + double width = bboxWidth(bbox); + double offset = bboxItalic(bbox); + double x[2], y[2]; + + if (draw) { + int savedlty = gc->lty; + double savedlwd = gc->lwd; + PMoveTo(savedX + offset, savedY + height + accentGap, mc); + x[0] = ConvertedX(mc, dd); + y[0] = ConvertedY(mc, dd); + PMoveAcross(width, mc); + x[1] = ConvertedX(mc, dd); + y[1] = ConvertedY(mc, dd); + gc->lty = LTY_SOLID; + if (gc->lwd > 1) + gc->lwd = 1; + GEPolyline(2, x, y, gc, dd); + PMoveTo(savedX + width, savedY, mc); + gc->lty = savedlty; + gc->lwd = savedlwd; + } + return EnlargeBBox(bbox, accentGap, 0, 0); +} + +static struct { + char *name; + int code; +} +AccentTable[] = { + { "hat", 94 }, + { "ring", 176 }, + { "tilde", 126 }, + { "dot", 215 }, + { NULL, 0 }, +}; + +static int AccentCode(SEXP expr) +{ + int i; + for (i = 0; AccentTable[i].code; i++) + if (NameMatch(expr, AccentTable[i].name)) + return AccentTable[i].code; + return 0; +} + +static int AccentAtom(SEXP expr) +{ + return NameAtom(expr) && (AccentCode(expr) != 0); +} + +static void NORET InvalidAccent(SEXP expr) +{ + errorcall(expr, _("invalid accent")); +} + +static BBOX RenderAccent(SEXP expr, int draw, mathContext *mc, + pGEcontext gc, pGEDevDesc dd) +{ + SEXP body, accent; + double savedX = mc->CurrentX; + double savedY = mc->CurrentY; + BBOX bodyBBox, accentBBox; + double xoffset, yoffset, width, italic; + int code; + if (length(expr) != 2) + InvalidAccent(expr); + accent = CAR(expr); + body = CADR(expr); + code = AccentCode(accent); + if (code == 0) + InvalidAccent(expr); + bodyBBox = RenderElement(body, 0, mc, gc, dd); + italic = bboxItalic(bodyBBox); + if (code == 176 || /* ring (as degree) */ + code == 215) /* dotmath */ + accentBBox = RenderSymbolChar(code, 0, mc, gc, dd); + else + accentBBox = RenderChar(code, 0, mc, gc, dd); + width = max(bboxWidth(bodyBBox) + bboxItalic(bodyBBox), + bboxWidth(accentBBox)); + xoffset = 0.5 *(width - bboxWidth(bodyBBox)); + bodyBBox = RenderGap(xoffset, draw, mc, gc, dd); + bodyBBox = CombineBBoxes(bodyBBox, RenderElement(body, draw, mc, gc, dd)); + bodyBBox = CombineBBoxes(bodyBBox, RenderGap(xoffset, draw, mc, gc, dd)); + PMoveTo(savedX, savedY, mc); + xoffset = 0.5 *(width - bboxWidth(accentBBox)) + + 0.9 * italic; + yoffset = bboxHeight(bodyBBox) + bboxDepth(accentBBox) + + 0.1 * XHeight(gc, dd); + if (draw) { + PMoveTo(savedX + xoffset, savedY + yoffset, mc); + if (code == 176 || /* ring (as degree) */ + code == 215) /* dotmath */ + RenderSymbolChar(code, draw, mc, gc, dd); + else + RenderChar(code, draw, mc, gc, dd); + } + bodyBBox = CombineOffsetBBoxes(bodyBBox, 0, accentBBox, 0, + xoffset, yoffset); + if (draw) + PMoveTo(savedX + width, savedY, mc); + return bodyBBox; +} + + +/*---------------------------------------------------------------------- + * + * Code for Fraction Expressions (over, atop) + * + * Rules 15, 15a, ..., 15e of the TeXBook + * + */ + +static void NumDenomVShift(BBOX numBBox, BBOX denomBBox, + double *u, double *v, + mathContext *mc, pGEcontext gc, pGEDevDesc dd) +{ + double a, delta, phi, theta; + a = TeX(sigma22, gc, dd); + theta = TeX(xi8, gc, dd); + if(mc->CurrentStyle > STYLE_T) { + *u = TeX(sigma8, gc, dd); + *v = TeX(sigma11, gc, dd); + phi = 3 * theta; + } + else { + *u = TeX(sigma9, gc, dd); + *v = TeX(sigma12, gc, dd); + phi = theta; + } + delta = (*u - bboxDepth(numBBox)) - (a + 0.5 * theta); + /* + * Numerators and denominators on fractions appear too far from + * horizontal bar. + * Reread of Knuth suggests removing "+ theta" components below. + */ + if (delta < phi) + *u += (phi - delta); /* + theta; */ + delta = (a + 0.5 * theta) - (bboxHeight(denomBBox) - *v); + if (delta < phi) + *v += (phi - delta); /* + theta; */ +} + +static void NumDenomHShift(BBOX numBBox, BBOX denomBBox, + double *numShift, double *denomShift) +{ + double numWidth = bboxWidth(numBBox); + double denomWidth = bboxWidth(denomBBox); + if (numWidth > denomWidth) { + *numShift = 0; + *denomShift = (numWidth - denomWidth) / 2; + } + else { + *numShift = (denomWidth - numWidth) / 2; + *denomShift = 0; + } +} + +static BBOX RenderFraction(SEXP expr, int rule, int draw, + mathContext *mc, pGEcontext gc, pGEDevDesc dd) +{ + SEXP numerator = CADR(expr); + SEXP denominator = CADDR(expr); + BBOX numBBox, denomBBox; + double nHShift, dHShift; + double nVShift, dVShift; + double width, x[2], y[2]; + double savedX = mc->CurrentX; + double savedY = mc->CurrentY; + STYLE style; + + style = GetStyle(mc); + SetNumStyle(style, mc, gc); + numBBox = RenderItalicCorr(RenderElement(numerator, 0, mc, gc, dd), 0, + mc, gc, dd); + SetDenomStyle(style, mc, gc); + denomBBox = RenderItalicCorr(RenderElement(denominator, 0, mc, gc, dd), 0, + mc, gc, dd); + SetStyle(style, mc, gc); + + width = max(bboxWidth(numBBox), bboxWidth(denomBBox)); + NumDenomHShift(numBBox, denomBBox, &nHShift, &dHShift); + NumDenomVShift(numBBox, denomBBox, &nVShift, &dVShift, mc, gc, dd); + + mc->CurrentX = savedX; + mc->CurrentY = savedY; + SetNumStyle(style, mc, gc); + numBBox = RenderOffsetElement(numerator, nHShift, nVShift, draw, mc, + gc, dd); + + mc->CurrentX = savedX; + mc->CurrentY = savedY; + SetDenomStyle(style, mc, gc); + denomBBox = RenderOffsetElement(denominator, dHShift, -dVShift, draw, + mc, gc, dd); + + SetStyle(style, mc, gc); + + if (draw) { + if (rule) { + int savedlty = gc->lty; + double savedlwd = gc->lwd; + mc->CurrentX = savedX; + mc->CurrentY = savedY; + PMoveUp(AxisHeight(gc, dd), mc); + x[0] = ConvertedX(mc, dd); + y[0] = ConvertedY(mc, dd); + PMoveAcross(width, mc); + x[1] = ConvertedX(mc, dd); + y[1] = ConvertedY(mc, dd); + gc->lty = LTY_SOLID; + if (gc->lwd > 1) + gc->lwd = 1; + GEPolyline(2, x, y, gc, dd); + PMoveUp(-AxisHeight(gc, dd), mc); + gc->lty = savedlty; + gc->lwd = savedlwd; + } + PMoveTo(savedX + width, savedY, mc); + } + return CombineAlignedBBoxes(numBBox, denomBBox); +} + +static BBOX RenderUnderline(SEXP expr, int draw, mathContext *mc, + pGEcontext gc, pGEDevDesc dd) +{ + SEXP body = CADR(expr); + BBOX BBox; + double width, adepth, depth, x[2], y[2]; + double savedX = mc->CurrentX; + double savedY = mc->CurrentY; + + BBox = RenderItalicCorr(RenderElement(body, 0, mc, gc, dd), 0, mc, gc, dd); + width = bboxWidth(BBox); + + mc->CurrentX = savedX; + mc->CurrentY = savedY; + BBox = RenderElement(body, draw, mc, gc, dd); + adepth = 0.1 * XHeight(gc, dd); + depth = bboxDepth(BBox) + adepth; + + if (draw) { + int savedlty = gc->lty; + double savedlwd = gc->lwd; + mc->CurrentX = savedX; + mc->CurrentY = savedY; + PMoveUp(-depth, mc); + x[0] = ConvertedX(mc, dd); + y[0] = ConvertedY(mc, dd); + PMoveAcross(width, mc); + x[1] = ConvertedX(mc, dd); + y[1] = ConvertedY(mc, dd); + gc->lty = LTY_SOLID; + if (gc->lwd > 1) + gc->lwd = 1; + GEPolyline(2, x, y, gc, dd); + PMoveUp(depth, mc); + gc->lty = savedlty; + gc->lwd = savedlwd; + PMoveTo(savedX + width, savedY, mc); + } + return EnlargeBBox(BBox, 0.0, adepth, 0.0); +} + + +static int OverAtom(SEXP expr) +{ + return NameAtom(expr) && + (NameMatch(expr, "over") || NameMatch(expr, "frac")); +} + +static BBOX RenderOver(SEXP expr, int draw, mathContext *mc, + pGEcontext gc, pGEDevDesc dd) +{ + return RenderFraction(expr, 1, draw, mc, gc, dd); +} + +static int UnderlAtom(SEXP expr) +{ + return NameAtom(expr) && NameMatch(expr, "underline"); +} + +static BBOX RenderUnderl(SEXP expr, int draw, mathContext *mc, + pGEcontext gc, pGEDevDesc dd) +{ + return RenderUnderline(expr, draw, mc, gc, dd); +} + + +static int AtopAtom(SEXP expr) +{ + return NameAtom(expr) && NameMatch(expr, "atop"); +} + +static BBOX RenderAtop(SEXP expr, int draw, mathContext *mc, + pGEcontext gc, pGEDevDesc dd) +{ + return RenderFraction(expr, 0, draw, mc, gc, dd); +} + +/*---------------------------------------------------------------------- + * + * Code for Grouped Expressions (e.g. ( ... )) + * + * group(ldelim, body, rdelim) + * + * bgroup(ldelim, body, rdelim) + * + */ + +#define DelimSymbolMag 1.25 + +static int DelimCode(SEXP expr, SEXP head) +{ + int code = 0; + if (NameAtom(head)) { + if (NameMatch(head, "lfloor")) + code = S_BRACKETLEFTBT; + else if (NameMatch(head, "rfloor")) + code = S_BRACKETRIGHTBT; + if (NameMatch(head, "lceil")) + code = S_BRACKETLEFTTP; + else if (NameMatch(head, "rceil")) + code = S_BRACKETRIGHTTP; + } + else if (StringAtom(head) && length(head) > 0) { + if (StringMatch(head, "|")) + code = '|'; + else if (StringMatch(head, "||")) // historical anomaly + code = '|'; + else if (StringMatch(head, "(")) + code = '('; + else if (StringMatch(head, ")")) + code = ')'; + else if (StringMatch(head, "[")) + code = '['; + else if (StringMatch(head, "]")) + code = ']'; + else if (StringMatch(head, "{")) + code = '{'; + else if (StringMatch(head, "}")) + code = '}'; + else if (StringMatch(head, "") || StringMatch(head, ".")) + code = '.'; + } + if (code == 0) + errorcall(expr, _("invalid group delimiter")); + return code; +} + +static BBOX RenderDelimiter(int delim, int draw, mathContext *mc, + pGEcontext gc, pGEDevDesc dd) +{ + BBOX bbox; + double savecex = gc->cex; + gc->cex = DelimSymbolMag * gc->cex; + bbox = RenderSymbolChar(delim, draw, mc, gc, dd); + gc->cex = savecex; + return bbox; +} + +static int GroupAtom(SEXP expr) +{ + return NameAtom(expr) && NameMatch(expr, "group"); +} + +static BBOX RenderGroup(SEXP expr, int draw, mathContext *mc, + pGEcontext gc, pGEDevDesc dd) +{ + double cexSaved = gc->cex; + BBOX bbox; + int code; + if (length(expr) != 4) + errorcall(expr, _("invalid group specification")); + bbox = NullBBox(); + code = DelimCode(expr, CADR(expr)); + gc->cex = DelimSymbolMag * gc->cex; + if (code != '.') + bbox = RenderSymbolChar(code, draw, mc, gc, dd); + gc->cex = cexSaved; + bbox = CombineBBoxes(bbox, RenderElement(CADDR(expr), draw, mc, gc, dd)); + bbox = RenderItalicCorr(bbox, draw, mc, gc, dd); + code = DelimCode(expr, CADDDR(expr)); + gc->cex = DelimSymbolMag * gc->cex; + if (code != '.') + bbox = CombineBBoxes(bbox, RenderSymbolChar(code, draw, mc, gc, dd)); + gc->cex = cexSaved; + return bbox; +} + +static int BGroupAtom(SEXP expr) +{ + return NameAtom(expr) && NameMatch(expr, "bgroup"); +} + +static BBOX RenderDelim(int which, double dist, int draw, mathContext *mc, + pGEcontext gc, pGEDevDesc dd) +{ + double savedX = mc->CurrentX; + double savedY = mc->CurrentY; + FontType prev = SetFont(SymbolFont, gc); + BBOX ansBBox, topBBox, botBBox, extBBox, midBBox; + int top, bot, ext, mid; + int i, n; + double topShift, botShift, extShift, midShift; + double ytop, ybot, extHeight, delta; + double axisHeight = TeX(sigma22, gc, dd); + + switch(which) { + case '.': + SetFont(prev, gc); + return NullBBox(); + break; + case '|': + top = 239; ext = 239; bot = 239; mid = 0; + break; + case '(': + top = 230; ext = 231; bot = 232; mid = 0; + break; + case ')': + top = 246; ext = 247; bot = 248; mid = 0; + break; + case '[': + top = 233; ext = 234; bot = 235; mid = 0; + break; + case ']': + top = 249; ext = 250; bot = 251; mid = 0; + break; + case '{': + top = 236; ext = 239; bot = 238; mid = 237; + break; + case '}': + top = 252; ext = 239; bot = 254; mid = 253; + break; + default: + error(_("group is incomplete")); + return NullBBox();/*never reached*/ + } + topBBox = GlyphBBox(top, gc, dd); + extBBox = GlyphBBox(ext, gc, dd); + botBBox = GlyphBBox(bot, gc, dd); + if (which == '{' || which == '}') { + if (1.2 * (bboxHeight(topBBox) + bboxDepth(topBBox)) > dist) + dist = 1.2 * (bboxHeight(topBBox) + bboxDepth(botBBox)); + } + else { + if (0.8 * (bboxHeight(topBBox) + bboxDepth(topBBox)) > dist) + dist = 0.8 * (bboxHeight(topBBox) + bboxDepth(topBBox)); + } + extHeight = bboxHeight(extBBox) + bboxDepth(extBBox); + topShift = dist - bboxHeight(topBBox) + axisHeight; + botShift = dist - bboxDepth(botBBox) - axisHeight; + extShift = 0.5 * (bboxHeight(extBBox) - bboxDepth(extBBox)); + topBBox = ShiftBBox(topBBox, topShift); + botBBox = ShiftBBox(botBBox, -botShift); + ansBBox = CombineAlignedBBoxes(topBBox, botBBox); + if (which == '{' || which == '}') { + midBBox = GlyphBBox(mid, gc, dd); + midShift = axisHeight + - 0.5 * (bboxHeight(midBBox) - bboxDepth(midBBox)); + midBBox = ShiftBBox(midBBox, midShift); + ansBBox = CombineAlignedBBoxes(ansBBox, midBBox); + if (draw) { + PMoveTo(savedX, savedY + topShift, mc); + RenderSymbolChar(top, draw, mc, gc, dd); + PMoveTo(savedX, savedY + midShift, mc); + RenderSymbolChar(mid, draw, mc, gc, dd); + PMoveTo(savedX, savedY - botShift, mc); + RenderSymbolChar(bot, draw, mc, gc, dd); + PMoveTo(savedX + bboxWidth(ansBBox), savedY, mc); + } + } + else { + if (draw) { + /* draw the top and bottom elements */ + PMoveTo(savedX, savedY + topShift, mc); + RenderSymbolChar(top, draw, mc, gc, dd); + PMoveTo(savedX, savedY - botShift, mc); + RenderSymbolChar(bot, draw, mc, gc, dd); + /* now join with extenders */ + ytop = axisHeight + dist + - (bboxHeight(topBBox) + bboxDepth(topBBox)); + ybot = axisHeight - dist + + (bboxHeight(botBBox) + bboxDepth(botBBox)); + n = (int) ceil((ytop - ybot) / (0.99 * extHeight)); + if (n > 0) { + delta = (ytop - ybot) / n; + for (i = 0; i < n; i++) { + PMoveTo(savedX, savedY + ybot + + (i + 0.5) * delta - extShift, mc); + RenderSymbolChar(ext, draw, mc, gc, dd); + } + } + PMoveTo(savedX + bboxWidth(ansBBox), savedY, mc); + + } + } + SetFont(prev, gc); + return ansBBox; +} + +static BBOX RenderBGroup(SEXP expr, int draw, mathContext *mc, + pGEcontext gc, pGEDevDesc dd) +{ + double dist; + BBOX bbox; + double axisHeight = TeX(sigma22, gc, dd); + double extra = 0.2 * xHeight(gc, dd); + int delim1, delim2; + if (length(expr) != 4) + errorcall(expr, _("invalid group specification")); + bbox = NullBBox(); + delim1 = DelimCode(expr, CADR(expr)); + delim2 = DelimCode(expr, CADDDR(expr)); + bbox = RenderElement(CADDR(expr), 0, mc, gc, dd); + dist = max(bboxHeight(bbox) - axisHeight, bboxDepth(bbox) + axisHeight); + bbox = RenderDelim(delim1, dist + extra, draw, mc, gc, dd); + bbox = CombineBBoxes(bbox, RenderElement(CADDR(expr), draw, mc, gc, dd)); + bbox = RenderItalicCorr(bbox, draw, mc, gc, dd); + bbox = CombineBBoxes(bbox, RenderDelim(delim2, dist + extra, draw, mc, + gc, dd)); + return bbox; +} + +/*---------------------------------------------------------------------- + * + * Code for Parenthetic Expressions (i.e. ( ... )) + * + */ + +static int ParenAtom(SEXP expr) +{ + return NameAtom(expr) && NameMatch(expr, "("); +} + +static BBOX RenderParen(SEXP expr, int draw, mathContext *mc, + pGEcontext gc, pGEDevDesc dd) +{ + BBOX bbox; + bbox = RenderDelimiter(S_PARENLEFT, draw, mc, gc, dd); + bbox = CombineBBoxes(bbox, RenderElement(CADR(expr), draw, mc, gc, dd)); + bbox = RenderItalicCorr(bbox, draw, mc, gc, dd); + return CombineBBoxes(bbox, RenderDelimiter(S_PARENRIGHT, draw, mc, gc, dd)); +} + +/*---------------------------------------------------------------------- + * + * Code for Integral Operators. + * + */ + +static int IntAtom(SEXP expr) +{ + return NameAtom(expr) && NameMatch(expr, "integral"); +} + + +static BBOX RenderIntSymbol(int draw, mathContext *mc, pGEcontext gc, + pGEDevDesc dd) +{ + double savedX = mc->CurrentX; + double savedY = mc->CurrentY; + if (GetStyle(mc) > STYLE_T) { + BBOX bbox1 = RenderSymbolChar(243, 0, mc, gc, dd); + BBOX bbox2 = RenderSymbolChar(245, 0, mc, gc, dd); + double shift; + shift = TeX(sigma22, gc, dd) + 0.99 * bboxDepth(bbox1); + PMoveUp(shift, mc); + bbox1 = ShiftBBox(RenderSymbolChar(243, draw, mc, gc, dd), shift); + mc->CurrentX = savedX; + mc->CurrentY = savedY; + shift = TeX(sigma22, gc, dd) - 0.99 * bboxHeight(bbox2); + PMoveUp(shift, mc); + bbox2 = ShiftBBox(RenderSymbolChar(245, draw, mc, gc, dd), shift); + if (draw) + PMoveTo(savedX + max(bboxWidth(bbox1), bboxWidth(bbox2)), + savedY, mc); + else + PMoveTo(savedX, savedY, mc); + return CombineAlignedBBoxes(bbox1, bbox2); + } + else { + return RenderSymbolChar(0362, draw, mc, gc, dd); + } +} + +static BBOX RenderInt(SEXP expr, int draw, mathContext *mc, + pGEcontext gc, pGEDevDesc dd) +{ + BBOX opBBox, lowerBBox, upperBBox, bodyBBox; + int nexpr = length(expr); + STYLE style = GetStyle(mc); + double savedX = mc->CurrentX; + double savedY = mc->CurrentY; + double hshift, vshift, width; + + opBBox = RenderIntSymbol(draw, mc, gc, dd); + width = bboxWidth(opBBox); + mc->CurrentX = savedX; + mc->CurrentY = savedY; + if (nexpr > 2) { + hshift = 0.5 * width + ThinSpace(gc, dd); + SetSubStyle(style, mc, gc); + lowerBBox = RenderElement(CADDR(expr), 0, mc, gc, dd); + vshift = bboxDepth(opBBox) + CenterShift(lowerBBox); + lowerBBox = RenderOffsetElement(CADDR(expr), hshift, -vshift, draw, + mc, gc, dd); + opBBox = CombineAlignedBBoxes(opBBox, lowerBBox); + SetStyle(style, mc, gc); + mc->CurrentX = savedX; + mc->CurrentY = savedY; + } + if (nexpr > 3) { + hshift = width + ThinSpace(gc, dd); + SetSupStyle(style, mc, gc); + upperBBox = RenderElement(CADDDR(expr), 0, mc, gc, dd); + vshift = bboxHeight(opBBox) - CenterShift(upperBBox); + upperBBox = RenderOffsetElement(CADDDR(expr), hshift, vshift, draw, + mc, gc, dd); + opBBox = CombineAlignedBBoxes(opBBox, upperBBox); + SetStyle(style, mc, gc); + mc->CurrentX = savedX; + mc->CurrentY = savedY; + } + PMoveAcross(bboxWidth(opBBox), mc); + if (nexpr > 1) { + bodyBBox = RenderElement(CADR(expr), draw, mc, gc, dd); + opBBox = CombineBBoxes(opBBox, bodyBBox); + } + return opBBox; +} + + +/*---------------------------------------------------------------------- + * + * Code for Operator Expressions (sum, product, lim, inf, sup, ...) + * + */ + +#define OperatorSymbolMag 1.25 + +static SymTab OpTable[] = { + { "prod", S_PRODUCT }, + { "sum", S_SUM }, + { "union", S_UNION }, + { "intersect", S_INTERSECTION }, + { "lim", N_LIM }, + { "liminf", N_LIMINF }, + { "limsup", N_LIMINF }, + { "inf", N_INF }, + { "sup", N_SUP }, + { "min", N_MIN }, + { "max", N_MAX }, + { NULL, 0 } +}; + +static int OpAtom(SEXP expr) +{ + int i; + for (i = 0; OpTable[i].code; i++) + if (NameMatch(expr, OpTable[i].name)) + return OpTable[i].code; + return 0; +} + +static BBOX RenderOpSymbol(SEXP op, int draw, mathContext *mc, + pGEcontext gc, pGEDevDesc dd) +{ + BBOX bbox; + double cexSaved = gc->cex; + /*double savedX = mc->CurrentX;*/ + /*double savedY = mc->CurrentY;*/ + double shift; + int display = (GetStyle(mc) > STYLE_T); + int opId = OpAtom(op); + + if (opId == S_SUM || opId == S_PRODUCT || + opId == S_UNION || opId == S_INTERSECTION) { + if (display) { + gc->cex = OperatorSymbolMag * gc->cex; + bbox = RenderSymbolChar(OpAtom(op), 0, mc, gc, dd); + shift = 0.5 * (bboxHeight(bbox) - bboxDepth(bbox)) - + TeX(sigma22, gc, dd); + if (draw) { + PMoveUp(-shift, mc); + bbox = RenderSymbolChar(opId, 1, mc, gc, dd); + PMoveUp(shift, mc); + } + gc->cex = cexSaved; + return ShiftBBox(bbox, -shift); + } + else return RenderSymbolChar(opId, draw, mc, gc, dd); + } + else { + FontType prevfont = SetFont(PlainFont, gc); + bbox = RenderStr(CHAR(PRINTNAME(op)), draw, mc, gc, dd); + SetFont(prevfont, gc); + return bbox; + } +} + +static BBOX RenderOp(SEXP expr, int draw, mathContext *mc, + pGEcontext gc, pGEDevDesc dd) +{ + BBOX lowerBBox = NullBBox() /* -Wall */, upperBBox = NullBBox(), bodyBBox; + double savedX = mc->CurrentX; + double savedY = mc->CurrentY; + int nexpr = length(expr); + STYLE style = GetStyle(mc); + BBOX opBBox = RenderOpSymbol(CAR(expr), 0, mc, gc, dd); + double width = bboxWidth(opBBox); + double hshift, lvshift, uvshift; + lvshift = uvshift = 0; /* -Wall */ + if (nexpr > 2) { + SetSubStyle(style, mc, gc); + lowerBBox = RenderElement(CADDR(expr), 0, mc, gc, dd); + SetStyle(style, mc, gc); + width = max(width, bboxWidth(lowerBBox)); + lvshift = max(TeX(xi10, gc, dd), TeX(xi12, gc, dd) - + bboxHeight(lowerBBox)); + lvshift = bboxDepth(opBBox) + bboxHeight(lowerBBox) + lvshift; + } + if (nexpr > 3) { + SetSupStyle(style, mc, gc); + upperBBox = RenderElement(CADDDR(expr), 0, mc, gc, dd); + SetStyle(style, mc, gc); + width = max(width, bboxWidth(upperBBox)); + uvshift = max(TeX(xi9, gc, dd), TeX(xi11, gc, dd) - + bboxDepth(upperBBox)); + uvshift = bboxHeight(opBBox) + bboxDepth(upperBBox) + uvshift; + } + hshift = 0.5 * (width - bboxWidth(opBBox)); + opBBox = RenderGap(hshift, draw, mc, gc, dd); + opBBox = CombineBBoxes(opBBox, + RenderOpSymbol(CAR(expr), draw, mc, gc, dd)); + mc->CurrentX = savedX; + mc->CurrentY = savedY; + if (nexpr > 2) { + SetSubStyle(style, mc, gc); + hshift = 0.5 * (width - bboxWidth(lowerBBox)); + lowerBBox = RenderOffsetElement(CADDR(expr), hshift, -lvshift, draw, + mc, gc, dd); + SetStyle(style, mc, gc); + opBBox = CombineAlignedBBoxes(opBBox, lowerBBox); + mc->CurrentX = savedX; + mc->CurrentY = savedY; + } + if (nexpr > 3) { + SetSupStyle(style, mc, gc); + hshift = 0.5 * (width - bboxWidth(upperBBox)); + upperBBox = RenderOffsetElement(CADDDR(expr), hshift, uvshift, draw, + mc, gc, dd); + SetStyle(style, mc, gc); + opBBox = CombineAlignedBBoxes(opBBox, upperBBox); + mc->CurrentX = savedX; + mc->CurrentY = savedY; + } + opBBox = EnlargeBBox(opBBox, TeX(xi13, gc, dd), TeX(xi13, gc, dd), 0); + if (draw) + PMoveAcross(width, mc); + opBBox = CombineBBoxes(opBBox, + RenderGap(ThinSpace(gc, dd), draw, mc, gc, dd)); + bodyBBox = RenderElement(CADR(expr), draw, mc, gc, dd); + return CombineBBoxes(opBBox, bodyBBox); +} + + +/*---------------------------------------------------------------------- + * + * Code for radical expressions (root, sqrt) + * + * Tunable parameteters : + * + * RADICAL_GAP The gap between the nucleus and the radical extension. + * RADICAL_SPACE Extra space to the left and right of the nucleus. + * + */ + +#define RADICAL_GAP 0.4 +#define RADICAL_SPACE 0.2 + +static int RadicalAtom(SEXP expr) +{ + return NameAtom(expr) && + (NameMatch(expr, "root") || + NameMatch(expr, "sqrt")); +} + +static BBOX RenderScript(SEXP expr, int draw, mathContext *mc, + pGEcontext gc, pGEDevDesc dd) +{ + BBOX bbox; + STYLE style = GetStyle(mc); + SetSupStyle(style, mc, gc); + bbox = RenderElement(expr, draw, mc, gc, dd); + SetStyle(style, mc, gc); + return bbox; +} + +static BBOX RenderRadical(SEXP expr, int draw, mathContext *mc, + pGEcontext gc, pGEDevDesc dd) +{ + SEXP body = CADR(expr); + SEXP order = CADDR(expr); + BBOX bodyBBox, orderBBox; + double radWidth, radHeight; + double leadWidth, leadHeight, twiddleHeight; + double hshift, vshift; + double radGap, radSpace, radTrail; + STYLE style = GetStyle(mc); + double savedX = mc->CurrentX; + double savedY = mc->CurrentY; + double x[5], y[5]; + + radGap = RADICAL_GAP * xHeight(gc, dd); + radSpace = RADICAL_SPACE * xHeight(gc, dd); + radTrail = MuSpace(gc, dd); + SetPrimeStyle(style, mc, gc); + bodyBBox = RenderElement(body, 0, mc, gc, dd); + bodyBBox = RenderItalicCorr(bodyBBox, 0, mc, gc, dd); + + radWidth = 0.6 *XHeight(gc, dd); + radHeight = bboxHeight(bodyBBox) + radGap; + twiddleHeight = CenterShift(bodyBBox); + + leadWidth = radWidth; + leadHeight = radHeight; + if (order != R_NilValue) { + SetSupStyle(style, mc, gc); + orderBBox = RenderScript(order, 0, mc, gc, dd); + leadWidth = max(leadWidth, bboxWidth(orderBBox) + 0.4 * radWidth); + hshift = leadWidth - bboxWidth(orderBBox) - 0.4 * radWidth; + vshift = leadHeight - bboxHeight(orderBBox); + if (vshift - bboxDepth(orderBBox) < twiddleHeight + radGap) + vshift = twiddleHeight + bboxDepth(orderBBox) + radGap; + if (draw) { + PMoveTo(savedX + hshift, savedY + vshift, mc); + orderBBox = RenderScript(order, draw, mc, gc, dd); + } + orderBBox = EnlargeBBox(orderBBox, vshift, 0, hshift); + } + else + orderBBox = NullBBox(); + if (draw) { + int savedlty = gc->lty; + double savedlwd = gc->lwd; + PMoveTo(savedX + leadWidth - radWidth, savedY, mc); + PMoveUp(0.8 * twiddleHeight, mc); + x[0] = ConvertedX(mc, dd); + y[0] = ConvertedY(mc, dd); + PMoveUp(0.2 * twiddleHeight, mc); + PMoveAcross(0.3 * radWidth, mc); + x[1] = ConvertedX(mc, dd); + y[1] = ConvertedY(mc, dd); + PMoveUp(-(twiddleHeight + bboxDepth(bodyBBox)), mc); + PMoveAcross(0.3 * radWidth, mc); + x[2] = ConvertedX(mc, dd); + y[2] = ConvertedY(mc, dd); + PMoveUp(bboxDepth(bodyBBox) + bboxHeight(bodyBBox) + radGap, mc); + PMoveAcross(0.4 * radWidth, mc); + x[3] = ConvertedX(mc, dd); + y[3] = ConvertedY(mc, dd); + PMoveAcross(radSpace + bboxWidth(bodyBBox) + radTrail, mc); + x[4] = ConvertedX(mc, dd); + y[4] = ConvertedY(mc, dd); + gc->lty = LTY_SOLID; + if (gc->lwd > 1) + gc->lwd = 1; + GEPolyline(5, x, y, gc, dd); + PMoveTo(savedX, savedY, mc); + gc->lty = savedlty; + gc->lwd = savedlwd; + } + orderBBox = + CombineAlignedBBoxes(orderBBox, + RenderGap(leadWidth + radSpace, draw, mc, gc, dd)); + SetPrimeStyle(style, mc, gc); + orderBBox = CombineBBoxes(orderBBox, + RenderElement(body, draw, mc, gc, dd)); + orderBBox = CombineBBoxes(orderBBox, + RenderGap(2 * radTrail, draw, mc, gc, dd)); + orderBBox = EnlargeBBox(orderBBox, radGap, 0, 0);/* << fixes PR#1101 */ + SetStyle(style, mc, gc); + return orderBBox; +} + +/*---------------------------------------------------------------------- + * + * Code for Absolute Value Expressions (abs) + * + */ + +static int AbsAtom(SEXP expr) +{ + return NameAtom(expr) && NameMatch(expr, "abs"); +} + +static BBOX RenderAbs(SEXP expr, int draw, mathContext *mc, + pGEcontext gc, pGEDevDesc dd) +{ + BBOX bbox = RenderElement(CADR(expr), 0, mc, gc, dd); + double height = bboxHeight(bbox); + double depth = bboxDepth(bbox); + double x[2], y[2]; + + bbox= RenderGap(MuSpace(gc, dd), draw, mc, gc, dd); + if (draw) { + int savedlty = gc->lty; + double savedlwd = gc->lwd; + PMoveUp(-depth, mc); + x[0] = ConvertedX(mc, dd); + y[0] = ConvertedY(mc, dd); + PMoveUp(depth + height, mc); + x[1] = ConvertedX(mc, dd); + y[1] = ConvertedY(mc, dd); + gc->lty = LTY_SOLID; + if (gc->lwd > 1) + gc->lwd = 1; + GEPolyline(2, x, y, gc, dd); + PMoveUp(-height, mc); + gc->lty = savedlty; + gc->lwd = savedlwd; + } + bbox = CombineBBoxes(bbox, RenderGap(MuSpace(gc, dd), draw, mc, gc, dd)); + bbox = CombineBBoxes(bbox, RenderElement(CADR(expr), draw, mc, gc, dd)); + bbox = RenderItalicCorr(bbox, draw, mc, gc, dd); + bbox = CombineBBoxes(bbox, RenderGap(MuSpace(gc, dd), draw, mc, gc, dd)); + if (draw) { + int savedlty = gc->lty; + double savedlwd = gc->lwd; + PMoveUp(-depth, mc); + x[0] = ConvertedX(mc, dd); + y[0] = ConvertedY(mc, dd); + PMoveUp(depth + height, mc); + x[1] = ConvertedX(mc, dd); + y[1] = ConvertedY(mc, dd); + gc->lty = LTY_SOLID; + if (gc->lwd > 1) + gc->lwd = 1; + GEPolyline(2, x, y, gc, dd); + PMoveUp(-height, mc); + gc->lty = savedlty; + gc->lwd = savedlwd; + } + bbox = CombineBBoxes(bbox, RenderGap(MuSpace(gc, dd), draw, mc, gc, dd)); + return bbox; +} + +/*---------------------------------------------------------------------- + * + * Code for Grouped Expressions (i.e. { ... } ) + * + */ + +static int CurlyAtom(SEXP expr) +{ + return NameAtom(expr) && + NameMatch(expr, "{"); +} + +static BBOX RenderCurly(SEXP expr, int draw, mathContext *mc, + pGEcontext gc, pGEDevDesc dd) +{ + return RenderElement(CADR(expr), draw, mc, gc, dd); +} + + +/*---------------------------------------------------------------------- + * + * Code for Relation Expressions (i.e. ... ==, !=, ...) + * + */ + + /* Binary Relationships */ +static +SymTab RelTable[] = { + { "<", 60 }, /* less */ + { "==", 61 }, /* equal */ + { ">", 62 }, /* greater */ + { "%=~%", 64 }, /* congruent */ + { "!=", 185 }, /* not equal */ + { "<=", 163 }, /* less or equal */ + { ">=", 179 }, /* greater or equal */ + { "%==%", 186 }, /* equivalence */ + { "%~~%", 187 }, /* approxequal */ + { "%prop%", 181 }, /* proportional to */ + { "%~%", 126 }, /* distributed as */ + + { "%<->%", 171 }, /* Arrows */ + { "%<-%", 172 }, + { "%up%", 173 }, + { "%->%", 174 }, + { "%down%", 175 }, + { "%<=>%", 219 }, + { "%<=%", 220 }, + { "%dblup%", 221 }, + { "%=>%", 222 }, + { "%dbldown%", 223 }, + + { "%supset%", 201 }, /* Sets (TeX Names) */ + { "%supseteq%", 202 }, + { "%notsubset%", 203 }, + { "%subset%", 204 }, + { "%subseteq%", 205 }, + { "%in%", 206 }, + { "%notin%", 207 }, + + { NULL, 0 }, +}; + +static int RelAtom(SEXP expr) +{ + int i; + for (i = 0; RelTable[i].code; i++) + if (NameMatch(expr, RelTable[i].name)) + return RelTable[i].code; + return 0; +} + +static BBOX RenderRel(SEXP expr, int draw, mathContext *mc, + pGEcontext gc, pGEDevDesc dd) +{ + int op = RelAtom(CAR(expr)); + int nexpr = length(expr); + BBOX bbox; + double gap; + + if(nexpr == 3) { + gap = (mc->CurrentStyle > STYLE_S) ? ThickSpace(gc, dd) : 0; + bbox = RenderElement(CADR(expr), draw, mc, gc, dd); + bbox = RenderItalicCorr(bbox, draw, mc, gc, dd); + bbox = CombineBBoxes(bbox, RenderGap(gap, draw, mc, gc, dd)); + bbox = CombineBBoxes(bbox, RenderSymbolChar(op, draw, mc, gc, dd)); + bbox = CombineBBoxes(bbox, RenderGap(gap, draw, mc, gc, dd)); + return + CombineBBoxes(bbox, RenderElement(CADDR(expr), draw, mc, gc, dd)); + } + else error(_("invalid mathematical annotation")); + + return NullBBox(); /* -Wall */ +} + + +/*---------------------------------------------------------------------- + * + * Code for Boldface Expressions + * + */ + +static int BoldAtom(SEXP expr) +{ + return NameAtom(expr) && + NameMatch(expr, "bold"); +} + +static BBOX RenderBold(SEXP expr, int draw, mathContext *mc, + pGEcontext gc, pGEDevDesc dd) +{ + BBOX bbox; + FontType prevfont = SetFont(BoldFont, gc); + bbox = RenderElement(CADR(expr), draw, mc, gc, dd); + SetFont(prevfont, gc); + return bbox; +} + +/*---------------------------------------------------------------------- + * + * Code for Italic Expressions + * + */ + +static int ItalicAtom(SEXP expr) +{ + return NameAtom(expr) && + (NameMatch(expr, "italic") || NameMatch(expr, "math")); +} + +static BBOX RenderItalic(SEXP expr, int draw, mathContext *mc, + pGEcontext gc, pGEDevDesc dd) +{ + BBOX bbox; + FontType prevfont = SetFont(ItalicFont, gc); + bbox = RenderElement(CADR(expr), draw, mc, gc, dd); + SetFont(prevfont, gc); + return bbox; +} + +/*---------------------------------------------------------------------- + * + * Code for Plain (i.e. Roman) Expressions + * + */ + +static int PlainAtom(SEXP expr) +{ + return NameAtom(expr) && + NameMatch(expr, "plain"); +} + +static BBOX RenderPlain(SEXP expr, int draw, mathContext *mc, + pGEcontext gc, pGEDevDesc dd) +{ + BBOX bbox; + int prevfont = SetFont(PlainFont, gc); + bbox = RenderElement(CADR(expr), draw, mc, gc, dd); + SetFont(prevfont, gc); + return bbox; +} + +/*---------------------------------------------------------------------- + * + * Code for SymbolFace (i.e. font = 5) Expressions + * + * This makes the default font an Adobe Symbol Encoded font + * (provides access to any character in the Adobe Symbol Font + * encoding via strings like "\042" for the universal ["for all"] + * symbol, without the need for separate special names for each + * of these symbols). + * + */ + +static int SymbolFaceAtom(SEXP expr) +{ + return NameAtom(expr) && + NameMatch(expr, "symbol"); +} + +static BBOX RenderSymbolFace(SEXP expr, int draw, mathContext *mc, + pGEcontext gc, pGEDevDesc dd) +{ + BBOX bbox; + int prevfont = SetFont(SymbolFont, gc); + bbox = RenderElement(CADR(expr), draw, mc, gc, dd); + SetFont(prevfont, gc); + return bbox; +} + +/*---------------------------------------------------------------------- + * + * Code for Bold Italic Expressions + * + */ + +static int BoldItalicAtom(SEXP expr) +{ + return NameAtom(expr) && + (NameMatch(expr, "bolditalic") || NameMatch(expr, "boldmath")); +} + +static BBOX RenderBoldItalic(SEXP expr, int draw, mathContext *mc, + pGEcontext gc, pGEDevDesc dd) +{ + BBOX bbox; + int prevfont = SetFont(BoldItalicFont, gc); + bbox = RenderElement(CADR(expr), draw, mc, gc, dd); + SetFont(prevfont, gc); + return bbox; +} + +/*---------------------------------------------------------------------- + * + * Code for Styles + * + */ + +static int StyleAtom(SEXP expr) +{ + return (NameAtom(expr) && + (NameMatch(expr, "displaystyle") || + NameMatch(expr, "textstyle") || + NameMatch(expr, "scriptstyle") || + NameMatch(expr, "scriptscriptstyle"))); +} + +static BBOX RenderStyle(SEXP expr, int draw, mathContext *mc, + pGEcontext gc, pGEDevDesc dd) +{ + STYLE prevstyle = GetStyle(mc); + BBOX bbox; + if (NameMatch(CAR(expr), "displaystyle")) + SetStyle(STYLE_D, mc, gc); + else if (NameMatch(CAR(expr), "textstyle")) + SetStyle(STYLE_T, mc, gc); + else if (NameMatch(CAR(expr), "scriptstyle")) + SetStyle(STYLE_S, mc, gc); + else if (NameMatch(CAR(expr), "scriptscriptstyle")) + SetStyle(STYLE_SS, mc, gc); + bbox = RenderElement(CADR(expr), draw, mc, gc, dd); + SetStyle(prevstyle, mc, gc); + return bbox; +} + +/*---------------------------------------------------------------------- + * + * Code for Phantom Expressions + * + */ + +static int PhantomAtom(SEXP expr) +{ + return (NameAtom(expr) && + (NameMatch(expr, "phantom") || + NameMatch(expr, "vphantom"))); +} + +static BBOX RenderPhantom(SEXP expr, int draw, mathContext *mc, + pGEcontext gc, pGEDevDesc dd) +{ + BBOX bbox = RenderElement(CADR(expr), 0, mc, gc, dd); + if (NameMatch(CAR(expr), "vphantom")) { + bboxWidth(bbox) = 0; + bboxItalic(bbox) = 0; + } + else RenderGap(bboxWidth(bbox), draw, mc, gc, dd); + return bbox; +} + +/*---------------------------------------------------------------------- + * + * Code for Concatenate Expressions + * + */ + +static int ConcatenateAtom(SEXP expr) +{ + return NameAtom(expr) && NameMatch(expr, "paste"); +} + +static BBOX RenderConcatenate(SEXP expr, int draw, mathContext *mc, + pGEcontext gc, pGEDevDesc dd) +{ + BBOX bbox = NullBBox(); + int i, n; + + expr = CDR(expr); + n = length(expr); + + for (i = 0; i < n; i++) { + bbox = CombineBBoxes(bbox, RenderElement(CAR(expr), draw, mc, gc, dd)); + if (i != n - 1) + bbox = RenderItalicCorr(bbox, draw, mc, gc, dd); + expr = CDR(expr); + } + return bbox; +} + +/*---------------------------------------------------------------------- + * + * Code for Comma-Separated Lists + * + */ + +static BBOX RenderCommaList(SEXP expr, int draw, mathContext *mc, + pGEcontext gc, pGEDevDesc dd) +{ + BBOX bbox = NullBBox(); + double small = 0.4 * ThinSpace(gc, dd); + int i, n; + n = length(expr); + for (i = 0; i < n; i++) { + if (NameAtom(CAR(expr)) && NameMatch(CAR(expr), "...")) { + if (i > 0) { + bbox = CombineBBoxes(bbox, RenderSymbolChar(S_COMMA, draw, + mc, gc, dd)); + bbox = CombineBBoxes(bbox, RenderSymbolChar(S_SPACE, draw, + mc, gc, dd)); + } + bbox = CombineBBoxes(bbox, RenderSymbolChar(S_ELLIPSIS, draw, + mc, gc, dd)); + bbox = CombineBBoxes(bbox, RenderGap(small, draw, mc, gc, dd)); + } + else { + if (i > 0) { + bbox = CombineBBoxes(bbox, RenderSymbolChar(S_COMMA, draw, + mc, gc, dd)); + bbox = CombineBBoxes(bbox, RenderSymbolChar(S_SPACE, draw, + mc, gc, dd)); + } + bbox = CombineBBoxes(bbox, RenderElement(CAR(expr), draw, mc, + gc, dd)); + } + expr = CDR(expr); + } + return bbox; +} + +/*---------------------------------------------------------------------- + * + * Code for General Expressions + * + */ + +static BBOX RenderExpression(SEXP expr, int draw, mathContext *mc, + pGEcontext gc, pGEDevDesc dd) +{ + BBOX bbox; + if (NameAtom(CAR(expr))) + bbox = RenderSymbolString(CAR(expr), draw, mc, gc, dd); + else + bbox = RenderElement(CAR(expr), draw, mc, gc, dd); + bbox = RenderItalicCorr(bbox, draw, mc, gc, dd); + bbox = CombineBBoxes(bbox, RenderDelimiter(S_PARENLEFT, draw, mc, gc, dd)); + bbox = CombineBBoxes(bbox, RenderCommaList(CDR(expr), draw, mc, gc, dd)); + bbox = RenderItalicCorr(bbox, draw, mc, gc, dd); + bbox = CombineBBoxes(bbox, RenderDelimiter(S_PARENRIGHT, draw, mc, gc, dd)); + return bbox; +} + +/*---------------------------------------------------------------------- + * + * Code for Comma Separated List Expressions + * + */ + +static int ListAtom(SEXP expr) +{ + return NameAtom(expr) && NameMatch(expr, "list"); +} + +static BBOX RenderList(SEXP expr, int draw, mathContext *mc, + pGEcontext gc, pGEDevDesc dd) +{ + return RenderCommaList(CDR(expr), draw, mc, gc, dd); +} + +/* Dispatching procedure which determines nature of expression. */ + + +static BBOX RenderFormula(SEXP expr, int draw, mathContext *mc, + pGEcontext gc, pGEDevDesc dd) +{ + SEXP head = CAR(expr); + + if (SpaceAtom(head)) + return RenderSpace(expr, draw, mc, gc, dd); + else if (BinAtom(head)) + return RenderBin(expr, draw, mc, gc, dd); + else if (SuperAtom(head)) + return RenderSup(expr, draw, mc, gc, dd); + else if (SubAtom(head)) + return RenderSub(expr, draw, mc, gc, dd); + else if (WideTildeAtom(head)) + return RenderWideTilde(expr, draw, mc, gc, dd); + else if (WideHatAtom(head)) + return RenderWideHat(expr, draw, mc, gc, dd); + else if (BarAtom(head)) + return RenderBar(expr, draw, mc, gc, dd); + else if (AccentAtom(head)) + return RenderAccent(expr, draw, mc, gc, dd); + else if (OverAtom(head)) + return RenderOver(expr, draw, mc, gc, dd); + else if (UnderlAtom(head)) + return RenderUnderl(expr, draw, mc, gc, dd); + else if (AtopAtom(head)) + return RenderAtop(expr, draw, mc, gc, dd); + else if (ParenAtom(head)) + return RenderParen(expr, draw, mc, gc, dd); + else if (BGroupAtom(head)) + return RenderBGroup(expr, draw, mc, gc, dd); + else if (GroupAtom(head)) + return RenderGroup(expr, draw, mc, gc, dd); + else if (IntAtom(head)) + return RenderInt(expr, draw, mc, gc, dd); + else if (OpAtom(head)) + return RenderOp(expr, draw, mc, gc, dd); + else if (RadicalAtom(head)) + return RenderRadical(expr, draw, mc, gc, dd); + else if (AbsAtom(head)) + return RenderAbs(expr, draw, mc, gc, dd); + else if (CurlyAtom(head)) + return RenderCurly(expr, draw, mc, gc, dd); + else if (RelAtom(head)) + return RenderRel(expr, draw, mc, gc, dd); + else if (BoldAtom(head)) + return RenderBold(expr, draw, mc, gc, dd); + else if (ItalicAtom(head)) + return RenderItalic(expr, draw, mc, gc, dd); + else if (PlainAtom(head)) + return RenderPlain(expr, draw, mc, gc, dd); + else if (SymbolFaceAtom(head)) + return RenderSymbolFace(expr, draw, mc, gc, dd); + else if (BoldItalicAtom(head)) + return RenderBoldItalic(expr, draw, mc, gc, dd); + else if (StyleAtom(head)) + return RenderStyle(expr, draw, mc, gc, dd); + else if (PhantomAtom(head)) + return RenderPhantom(expr, draw, mc, gc, dd); + else if (ConcatenateAtom(head)) + return RenderConcatenate(expr, draw, mc, gc, dd); + else if (ListAtom(head)) + return RenderList(expr, draw, mc, gc, dd); + else + return RenderExpression(expr, draw, mc, gc, dd); +} + + +/* Dispatch on whether atom (symbol, string, number, ...) */ +/* or formula (some sort of expression) */ + +static BBOX RenderElement(SEXP expr, int draw, mathContext *mc, + pGEcontext gc, pGEDevDesc dd) +{ + if (FormulaExpression(expr)) + return RenderFormula(expr, draw, mc, gc, dd); + else + return RenderAtom(expr, draw, mc, gc, dd); +} + +static BBOX RenderOffsetElement(SEXP expr, double x, double y, int draw, + mathContext *mc, pGEcontext gc, + pGEDevDesc dd) +{ + BBOX bbox; + double savedX = mc->CurrentX; + double savedY = mc->CurrentY; + if (draw) { + mc->CurrentX += x; + mc->CurrentY += y; + } + bbox = RenderElement(expr, draw, mc, gc, dd); + bboxWidth(bbox) += x; + bboxHeight(bbox) += y; + bboxDepth(bbox) -= y; + mc->CurrentX = savedX; + mc->CurrentY = savedY; + return bbox; + +} + +/* Functions forming the R API */ + +/* Calculate width of expression */ +/* BBOXes are in INCHES (see MetricUnit) */ + +double GEExpressionWidth(SEXP expr, + pGEcontext gc, + pGEDevDesc dd) +{ + BBOX bbox; + double width; + + /* + * Build a "drawing context" for the current expression + */ + mathContext mc; + mc.BaseCex = gc->cex; + mc.BoxColor = 4291543295U; // name2col("pink"); + mc.CurrentStyle = STYLE_D; + /* + * Some "empty" values. Will be filled in after BBox is calc'ed + */ + mc.ReferenceX = 0; + mc.ReferenceY = 0; + mc.CurrentX = 0; + mc.CurrentY = 0; + mc.CurrentAngle = 0; + mc.CosAngle = 0; + mc.SinAngle = 0; + + SetFont(PlainFont, gc); + bbox = RenderElement(expr, 0, &mc, gc, dd); + width = bboxWidth(bbox); + /* + * NOTE that we do fabs() here in case the device + * runs right-to-left. + * This is so that these calculations match those + * for string widths and heights, where the width + * and height of text is positive no matter how + * the device drawing is oriented. + */ + return fabs(toDeviceWidth(width, GE_INCHES, dd)); +} + +double GEExpressionHeight(SEXP expr, + pGEcontext gc, + pGEDevDesc dd) +{ + BBOX bbox; + double height; + + /* + * Build a "drawing context" for the current expression + */ + mathContext mc; + mc.BaseCex = gc->cex; + mc.BoxColor = 4291543295U; // name2col("pink"); + mc.CurrentStyle = STYLE_D; + /* + * Some "empty" values. Will be filled in after BBox is calc'ed + */ + mc.ReferenceX = 0; + mc.ReferenceY = 0; + mc.CurrentX = 0; + mc.CurrentY = 0; + mc.CurrentAngle = 0; + mc.CosAngle = 0; + mc.SinAngle = 0; + + SetFont(PlainFont, gc); + bbox = RenderElement(expr, 0, &mc, gc, dd); + height = bboxHeight(bbox) + bboxDepth(bbox); + /* NOTE that we do fabs() here in case the device + * draws top-to-bottom (like an X11 window). + * This is so that these calculations match those + * for string widths and heights, where the width + * and height of text is positive no matter how + * the device drawing is oriented. + */ + return fabs(toDeviceHeight(height, GE_INCHES, dd)); +} + +void GEExpressionMetric(SEXP expr, + const pGEcontext gc, + double *ascent, double *descent, double *width, + pGEDevDesc dd) +{ + BBOX bbox; + + /* + * Build a "drawing context" for the current expression + */ + mathContext mc; + mc.BaseCex = gc->cex; + mc.BoxColor = 4291543295U; // name2col("pink"); + mc.CurrentStyle = STYLE_D; + /* + * Some "empty" values. Will be filled in after BBox is calc'ed + */ + mc.ReferenceX = 0; + mc.ReferenceY = 0; + mc.CurrentX = 0; + mc.CurrentY = 0; + mc.CurrentAngle = 0; + mc.CosAngle = 0; + mc.SinAngle = 0; + + SetFont(PlainFont, gc); + bbox = RenderElement(expr, 0, &mc, gc, dd); + /* NOTE that we do fabs() here in case the device + * draws top-to-bottom (like an X11 window). + * This is so that these calculations match those + * for string widths and heights, where the width + * and height of text is positive no matter how + * the device drawing is oriented. + */ + *width = fabs(toDeviceWidth(bboxWidth(bbox), GE_INCHES, dd)); + *ascent = fabs(toDeviceHeight(bboxHeight(bbox), GE_INCHES, dd)); + *descent = fabs(toDeviceHeight(bboxDepth(bbox), GE_INCHES, dd)); +} + +void GEMathText(double x, double y, SEXP expr, + double xc, double yc, double rot, + pGEcontext gc, + pGEDevDesc dd) +{ + BBOX bbox; + mathContext mc; + + /* If font metric information is not available for device + then bail out */ + double ascent, descent, width; + GEMetricInfo('M', gc, &ascent, &descent, &width, dd); + if ((ascent == 0.0) && (descent == 0.0) && (width == 0.0)) + error(_("Metric information not available for this family/device")); + + /* + * Build a "drawing context" for the current expression + */ + mc.BaseCex = gc->cex; + mc.BoxColor = 4291543295U; // name2col("pink"); + mc.CurrentStyle = STYLE_D; + + /* + * Some "empty" values. Will be filled in after BBox is calc'ed + */ + mc.ReferenceX = 0; + mc.ReferenceY = 0; + mc.CurrentX = 0; + mc.CurrentY = 0; + mc.CurrentAngle = 0; + mc.CosAngle = 0; + mc.SinAngle = 0; + + SetFont(PlainFont, gc); + bbox = RenderElement(expr, 0, &mc, gc, dd); + mc.ReferenceX = fromDeviceX(x, GE_INCHES, dd); + mc.ReferenceY = fromDeviceY(y, GE_INCHES, dd); + if (R_FINITE(xc)) + mc.CurrentX = mc.ReferenceX - xc * bboxWidth(bbox); + else + /* Paul 2002-02-11 + * If xc == NA then should centre horizontally. + * Used to left-adjust. + */ + mc.CurrentX = mc.ReferenceX - 0.5 * bboxWidth(bbox); + if (R_FINITE(yc)) + mc.CurrentY = mc.ReferenceY + bboxDepth(bbox) + - yc * (bboxHeight(bbox) + bboxDepth(bbox)); + else + /* Paul 11/2/02 + * If xc == NA then should centre vertically. + * Used to bottom-adjust. + */ + mc.CurrentY = mc.ReferenceY + bboxDepth(bbox) + - 0.5 * (bboxHeight(bbox) + bboxDepth(bbox)); + mc.CurrentAngle = rot; + rot *= M_PI_2 / 90 ;/* radians */ + mc.CosAngle = cos(rot); + mc.SinAngle = sin(rot); + RenderElement(expr, 1, &mc, gc, dd); +}/* GEMathText */ diff --git a/com.oracle.truffle.r.native/gnur/patch/src/main/rlocale.c b/com.oracle.truffle.r.native/gnur/patch/src/main/rlocale.c new file mode 100644 index 0000000000000000000000000000000000000000..4bea8832f6f12aa69efcd0d809ee90ab5b0264b7 --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/main/rlocale.c @@ -0,0 +1,349 @@ +/* + * R : A Computer Language for Statistical Data Analysis + * Copyright (C) 2005-2015 The R Core Team + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version. + * + * This program 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 this program; if not, a copy is available at + * https://www.R-project.org/Licenses/ + */ + +/* The original version of this file was contributed by Ei-ji Nakama. + * See also the comments in ../include/rlocale.h. + * + * It provides replacements for the wctype functions on + * Windows (where they are not correct in e.g. Japanese) + * AIX (missing) + * macOS in CJK (where these just call the ctype functions) + * + * It also provides wc[s]width, where widths of CJK fonts are often + * wrong in vendor-supplied versions and in Markus Kuhn's version + * used for Windows in R 2.[12].x. + */ + + +#ifdef HAVE_CONFIG_H +#include <config.h> +#endif + +#ifdef HAVE_VISIBILITY_ATTRIBUTE +# define attribute_hidden __attribute__ ((visibility ("hidden"))) +#else +# define attribute_hidden +#endif + +#include <string.h> +#include <stdlib.h> + +#define IN_RLOCALE_C 1 /* used in rlocale.h */ +#include <rlocale.h> +#include "rlocale_data.h" + +#include <wctype.h> +#include <wchar.h> +#include <ctype.h> +#include <locale.h> +#include <limits.h> +#include <R_ext/Riconv.h> + +// This seems based on Markus Kuhn's function but with 1-based 'max' +static int wcsearch(int wint, const struct interval *table, int max) +{ + int min = 0; + int mid; + max--; + + if (wint < table[0].first || wint > table[max].last) + return 0; + while (max >= min) { + mid = (min + max) / 2; + if (wint > table[mid].last) + min = mid + 1; + else if (wint < table[mid].first) + max = mid - 1; + else + return 1; + } + return 0; +} + +static int wcwidthsearch(int wint, const struct interval_wcwidth *table, + int max, int locale) +{ + int min = 0; + int mid; + max--; + + /* This quickly gives one for ASCII characters since the table + starts at 0xa0 */ + if (wint < table[0].first || wint > table[max].last) return 1; + while (max >= min) { + mid = (min + max) / 2; + if (wint > table[mid].last) + min = mid + 1; + else if (wint < table[mid].first) + max = mid - 1; + else{ + return(table[mid].mb[locale]); + } + } + return -1; +} + +/* The idea here here has never been explained. + See also the comments in ../include/rlocale.h. + + That does not explain the separate entries for Singapore + (simplified) and Hong Kong/Macau (traditional) where it seems the + Windows system font is not different from PRC/Taiwan respectively, + nor what font was used for non-Windows, nor where the values came + from. + + Except perhaps on macOS, the non-Windows locale names are for the + default MBCS encodings (e.g. GBK, GB1312, BIG5, EUCJP, EUCKR). + There are other non-UTF-8 encodings for those locales, + e.g. ja_JP.SJIS, ko_KR.CP949, zh_CN.eucCN, zh_HK.Big5HKSCS. +*/ + +typedef struct { + char *name; + int locale; +} cjk_locale_name_t; + +static cjk_locale_name_t cjk_locale_name[] = { + // Windows locale names + {"CHINESE(SINGAPORE)_SIGNAPORE", MB_zh_SG}, + {"CHINESE_SIGNAPORE", MB_zh_SG}, + {"CHINESE(PRC)_PEOPLE'S REPUBLIC OF CHINA", MB_zh_CN}, + {"CHINESE_PEOPLE'S REPUBLIC OF CHINA", MB_zh_CN}, + {"CHINESE_MACAU S.A.R.", MB_zh_HK}, + {"CHINESE(PRC)_HONG KONG", MB_zh_HK}, + {"CHINESE_HONG KONG S.A.R.", MB_zh_HK}, + {"CHINESE(TAIWAN)_TAIWAN", MB_zh_TW}, + {"CHINESE_TAIWAN", MB_zh_TW}, + {"CHINESE-S", MB_zh_CN}, + {"CHINESE-T", MB_zh_TW}, + {"JAPANESE_JAPAN", MB_ja_JP}, + {"JAPANESE", MB_ja_JP}, + {"KOREAN_KOREA", MB_ko_KR}, + {"KOREAN", MB_ko_KR}, + // Other OSes, but only in default encodings. + {"ZH_TW", MB_zh_TW}, + {"ZH_CN", MB_zh_CN}, + {"ZH_CN.BIG5", MB_zh_TW}, + {"ZH_HK", MB_zh_HK}, + {"ZH_SG", MB_zh_SG}, + {"JA_JP", MB_ja_JP}, + {"KO_KR", MB_ko_KR}, + {"ZH", MB_zh_CN}, + {"JA", MB_ja_JP}, + {"KO", MB_ko_KR}, + // Default, where all EA Ambiguous characters have width one. + {"", MB_Default}, +}; + +// used in character.c, ../gnuwin32/console.c , ../library/grDevices/src/devP*.c : +int Ri18n_wcwidth(wchar_t c) +{ + char lc_str[128]; + unsigned int i, j; + + static char *lc_cache = ""; + static int lc = 0; + + if (0 != strcmp(setlocale(LC_CTYPE, NULL), lc_cache)) { + strncpy(lc_str, setlocale(LC_CTYPE, NULL), sizeof(lc_str)); + lc_str[sizeof(lc_str) - 1] = '\0'; + for (i = 0, j = (int) strlen(lc_str); i < j && i < sizeof(lc_str); i++) + lc_str[i] = (char) toupper(lc_str[i]); + for (i = 0; i < (sizeof(cjk_locale_name)/sizeof(cjk_locale_name_t)); + i++) { + if (0 == strncmp(cjk_locale_name[i].name, lc_str, + strlen(cjk_locale_name[i].name))) { + lc = cjk_locale_name[i].locale; + break; + } + } + } + + int wd = wcwidthsearch(c, table_wcwidth, + (sizeof(table_wcwidth)/sizeof(struct interval_wcwidth)), + lc); + if (wd >= 0) return wd; // currently all are 1 or 2. + int zw = wcsearch(c, zero_width, zero_width_count); + return zw ? 0 : 1; // assume unknown chars are width one. +} + +/* Used in character.c, errors.c, ../gnuwin32/console.c */ +attribute_hidden +int Ri18n_wcswidth (const wchar_t *s, size_t n) +{ + int rs = 0; + while ((n-- > 0) && (*s != L'\0')) + { + int now = Ri18n_wcwidth (*s); + if (now == -1) return -1; + rs += now; + s++; + } + return rs; +} + +/********************************************************************* + * macOS's wide character type functions are based on FreeBSD + * and only work correctly for Latin-1 characters. + * So we replace them. May also be needed on FreeBSD. + ********************************************************************/ +#if defined(__APPLE__) +/* allow for both PowerPC and Intel platforms */ +#ifdef WORDS_BIGENDIAN +static const char UNICODE[] = "UCS-4BE"; +#else +static const char UNICODE[] = "UCS-4LE"; +#endif + +/* in Defn.h which is not included here */ +extern const char *locale2charset(const char *); + +#define ISWFUNC(ISWNAME) static int Ri18n_isw ## ISWNAME (wint_t wc) \ +{ \ + char mb_buf[MB_LEN_MAX+1]; \ + size_t mb_len; \ + int ucs4_buf[2]; \ + size_t wc_len; \ + void *cd; \ + char fromcode[128]; \ + char *_mb_buf; \ + char *_wc_buf; \ + size_t rc ; \ + \ + strncpy(fromcode, locale2charset(NULL), sizeof(fromcode)); \ + fromcode[sizeof(fromcode) - 1] = '\0'; \ + if(0 == strcmp(fromcode, "UTF-8")) \ + return wcsearch(wc,table_w ## ISWNAME , table_w ## ISWNAME ## _count);\ + memset(mb_buf, 0, sizeof(mb_buf)); \ + memset(ucs4_buf, 0, sizeof(ucs4_buf)); \ + wcrtomb( mb_buf, wc, NULL); \ + if((void *)(-1) != (cd = Riconv_open(UNICODE, fromcode))) { \ + wc_len = sizeof(ucs4_buf); \ + _wc_buf = (char *)ucs4_buf; \ + mb_len = strlen(mb_buf); \ + _mb_buf = (char *)mb_buf; \ + rc = Riconv(cd, (const char **)&_mb_buf, (size_t *)&mb_len, \ + (char **)&_wc_buf, (size_t *)&wc_len); \ + Riconv_close(cd); \ + wc = ucs4_buf[0]; \ + return wcsearch(wc,table_w ## ISWNAME , table_w ## ISWNAME ## _count); \ + } \ + return(-1); \ +} +#endif // __APPLE__ + +/********************************************************************* + * iswalpha etc. does not function correctly for Windows + * iswalpha etc. does not function at all in AIX. + * all locale wchar_t == UNICODE + ********************************************************************/ +#if defined(Win32) || defined(_AIX) +#define ISWFUNC(ISWNAME) static int Ri18n_isw ## ISWNAME (wint_t wc) \ +{ \ + return wcsearch(wc,table_w ## ISWNAME , table_w ## ISWNAME ## _count); \ +} +#endif + +/********************************************************************* + * iswalpha etc. do function correctly for Linux + ********************************************************************/ +#ifndef ISWFUNC +#define ISWFUNC(ISWNAME) static int Ri18n_isw ## ISWNAME (wint_t wc) \ +{ \ + return isw ## ISWNAME (wc); \ +} +/* Solaris 8 was missing iswblank. Its man page was missing iswcntrl, + but the function is there. MinGW used not to have iswblank until + mingw-runtime-3.11. */ +#ifndef HAVE_ISWBLANK +#define iswblank(wc) iswctype(wc, wctype("blank")) +#endif +#endif + +/* These are the functions which C99 and POSIX define. However, + not all are used elsewhere in R, but they are used in Ri18n_iswctype. */ + + ISWFUNC(upper) + ISWFUNC(lower) + ISWFUNC(alpha) + ISWFUNC(digit) + ISWFUNC(xdigit) + ISWFUNC(space) + ISWFUNC(print) + ISWFUNC(graph) + ISWFUNC(blank) + ISWFUNC(cntrl) + ISWFUNC(punct) + /* defined below in terms of digit and alpha + ISWFUNC(alnum) + */ + +wctype_t Ri18n_wctype(const char *); +int Ri18n_iswctype(wint_t, wctype_t); + +static int Ri18n_iswalnum (wint_t wc) +{ + return (Ri18n_iswctype(wc, Ri18n_wctype("digit")) || + Ri18n_iswctype(wc, Ri18n_wctype("alpha")) ); +} + + +/* + * iswctype + */ +typedef struct { + char * name; + wctype_t wctype; + int(*func)(wint_t); +} Ri18n_wctype_func_l ; + +static const Ri18n_wctype_func_l Ri18n_wctype_func[] = { + {"upper", 1<<0, Ri18n_iswupper}, + {"lower", 1<<1, Ri18n_iswlower}, + {"alpha", 1<<2, Ri18n_iswalpha}, + {"digit", 1<<3, Ri18n_iswdigit}, + {"xdigit", 1<<4, Ri18n_iswxdigit}, + {"space", 1<<5, Ri18n_iswspace}, + {"print", 1<<6, Ri18n_iswprint}, + {"graph", 1<<7, Ri18n_iswgraph}, + {"blank", 1<<8, Ri18n_iswblank}, + {"cntrl", 1<<9, Ri18n_iswcntrl}, + {"punct", 1<<10, Ri18n_iswpunct}, + {"alnum", 1<<11, Ri18n_iswalnum}, + {NULL, 0, NULL} +}; + +/* These two used (via macros) in X11 dataentry */ +wctype_t Ri18n_wctype(const char *name) +{ + int i; + + for (i = 0 ; Ri18n_wctype_func[i].name != NULL && + 0 != strcmp(Ri18n_wctype_func[i].name, name) ; i++ ); + return Ri18n_wctype_func[i].wctype; +} + +int Ri18n_iswctype(wint_t wc, wctype_t desc) +{ + int i; + + for (i = 0 ; Ri18n_wctype_func[i].wctype != 0 && + Ri18n_wctype_func[i].wctype != desc ; i++ ); + return (*Ri18n_wctype_func[i].func)(wc); +} diff --git a/com.oracle.truffle.r.native/gnur/patch/src/main/sort.c b/com.oracle.truffle.r.native/gnur/patch/src/main/sort.c new file mode 100644 index 0000000000000000000000000000000000000000..19d4a3f20e5face3228decf4e44fa790949ed526 --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/main/sort.c @@ -0,0 +1,1420 @@ +/* + * R : A Computer Language for Statistical Data Analysis + * Copyright (C) 1995, 1996 Robert Gentleman and Ross Ihaka + * Copyright (C) 1998-2014 The R Core Team + * Copyright (C) 2004 The R Foundation + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version. + * + * This program 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 this program; if not, a copy is available at + * https://www.R-project.org/Licenses/ + */ + +#ifdef HAVE_CONFIG_H +#include <config.h> +#endif + +#include <Defn.h> /* => Utils.h with the protos from here; Rinternals.h */ +#include <Internal.h> +#include <Rmath.h> +#include <R_ext/RS.h> /* for Calloc/Free */ + + /*--- Part I: Comparison Utilities ---*/ + +static int icmp(int x, int y, Rboolean nalast) +{ + if (x == NA_INTEGER && y == NA_INTEGER) return 0; + if (x == NA_INTEGER)return nalast ? 1 : -1; + if (y == NA_INTEGER)return nalast ? -1 : 1; + if (x < y) return -1; + if (x > y) return 1; + return 0; +} + +static int rcmp(double x, double y, Rboolean nalast) +{ + int nax = ISNAN(x), nay = ISNAN(y); + if (nax && nay) return 0; + if (nax) return nalast ? 1 : -1; + if (nay) return nalast ? -1 : 1; + if (x < y) return -1; + if (x > y) return 1; + return 0; +} + +static int ccmp(Rcomplex x, Rcomplex y, Rboolean nalast) +{ + int nax = ISNAN(x.r), nay = ISNAN(y.r); + /* compare real parts */ + if (nax && nay) return 0; + if (nax) return nalast ? 1 : -1; + if (nay) return nalast ? -1 : 1; + if (x.r < y.r) return -1; + if (x.r > y.r) return 1; + /* compare complex parts */ + nax = ISNAN(x.i); nay = ISNAN(y.i); + if (nax && nay) return 0; + if (nax) return nalast ? 1 : -1; + if (nay) return nalast ? -1 : 1; + if (x.i < y.i) return -1; + if (x.i > y.i) return 1; + + return 0; /* equal */ +} + +static int scmp(SEXP x, SEXP y, Rboolean nalast) +{ + if (x == NA_STRING && y == NA_STRING) return 0; + if (x == NA_STRING) return nalast ? 1 : -1; + if (y == NA_STRING) return nalast ? -1 : 1; + if (x == y) return 0; /* same string in cache */ + return Scollate(x, y); +} + +Rboolean isUnsorted(SEXP x, Rboolean strictly) +{ + R_xlen_t n, i; + + if (!isVectorAtomic(x)) + error(_("only atomic vectors can be tested to be sorted")); + n = XLENGTH(x); + if(n >= 2) + switch (TYPEOF(x)) { + + /* NOTE: x must have no NAs {is.na(.) in R}; + hence be faster than `rcmp()', `icmp()' for these two cases */ + + /* The only difference between strictly and not is '>' vs '>=' + but we want the if() outside the loop */ + case LGLSXP: + case INTSXP: + if(strictly) { + for(i = 0; i+1 < n ; i++) + if(INTEGER(x)[i] >= INTEGER(x)[i+1]) + return TRUE; + + } else { + for(i = 0; i+1 < n ; i++) + if(INTEGER(x)[i] > INTEGER(x)[i+1]) + return TRUE; + } + break; + case REALSXP: + if(strictly) { + for(i = 0; i+1 < n ; i++) + if(REAL(x)[i] >= REAL(x)[i+1]) + return TRUE; + } else { + for(i = 0; i+1 < n ; i++) + if(REAL(x)[i] > REAL(x)[i+1]) + return TRUE; + } + break; + case CPLXSXP: + if(strictly) { + for(i = 0; i+1 < n ; i++) + if(ccmp(COMPLEX(x)[i], COMPLEX(x)[i+1], TRUE) >= 0) + return TRUE; + } else { + for(i = 0; i+1 < n ; i++) + if(ccmp(COMPLEX(x)[i], COMPLEX(x)[i+1], TRUE) > 0) + return TRUE; + } + break; + case STRSXP: + if(strictly) { + for(i = 0; i+1 < n ; i++) + if(scmp(STRING_ELT(x, i ), + STRING_ELT(x,i+1), TRUE) >= 0) + return TRUE; + } else { + for(i = 0; i+1 < n ; i++) + if(scmp(STRING_ELT(x, i ), + STRING_ELT(x,i+1), TRUE) > 0) + return TRUE; + } + break; + case RAWSXP: // being compatible with raw_relop() in ./relop.c + if(strictly) { + for(i = 0; i+1 < n ; i++) + if(RAW(x)[i] >= RAW(x)[i+1]) + return TRUE; + + } else { + for(i = 0; i+1 < n ; i++) + if(RAW(x)[i] > RAW(x)[i+1]) + return TRUE; + } + break; + default: + UNIMPLEMENTED_TYPE("isUnsorted", x); + } + return FALSE;/* sorted */ +} // isUnsorted() + +SEXP attribute_hidden do_isunsorted(SEXP call, SEXP op, SEXP args, SEXP rho) +{ + checkArity(op, args); + + SEXP ans, x = CAR(args); + if(DispatchOrEval(call, op, "is.unsorted", args, rho, &ans, 0, 1)) + return ans; + PROTECT(args = ans); // args evaluated now + + int strictly = asLogical(CADR(args)); + if(strictly == NA_LOGICAL) + error(_("invalid '%s' argument"), "strictly"); + if(isVectorAtomic(x)) { + UNPROTECT(1); + return (xlength(x) < 2) ? ScalarLogical(FALSE) : + ScalarLogical(isUnsorted(x, strictly)); + } + if(isObject(x)) { + SEXP call; + PROTECT(call = // R> .gtn(x, strictly) : + lang3(install(".gtn"), x, CADR(args))); + ans = eval(call, rho); + UNPROTECT(2); + return ans; + } // else + UNPROTECT(1); + return ScalarLogical(NA_LOGICAL); +} + + + /*--- Part II: Complete (non-partial) Sorting ---*/ + + +/* SHELLsort -- corrected from R. Sedgewick `Algorithms in C' + * (version of BDR's lqs():*/ +#define sort_body \ + Rboolean nalast=TRUE; \ + int i, j, h; \ + \ + for (h = 1; h <= n / 9; h = 3 * h + 1); \ + for (; h > 0; h /= 3) \ + for (i = h; i < n; i++) { \ + v = x[i]; \ + j = i; \ + while (j >= h && TYPE_CMP(x[j - h], v, nalast) > 0) \ + { x[j] = x[j - h]; j -= h; } \ + x[j] = v; \ + } + +void R_isort(int *x, int n) +{ + int v; +#define TYPE_CMP icmp + sort_body +#undef TYPE_CMP +} + +void R_rsort(double *x, int n) +{ + double v; +#define TYPE_CMP rcmp + sort_body +#undef TYPE_CMP +} + +void R_csort(Rcomplex *x, int n) +{ + Rcomplex v; +#define TYPE_CMP ccmp + sort_body +#undef TYPE_CMP +} + + +/* used in platform.c */ +void attribute_hidden ssort(SEXP *x, int n) +{ + SEXP v; +#define TYPE_CMP scmp + sort_body +#undef TYPE_CMP +} + +void rsort_with_index(double *x, int *indx, int n) +{ + double v; + int i, j, h, iv; + + for (h = 1; h <= n / 9; h = 3 * h + 1); + for (; h > 0; h /= 3) + for (i = h; i < n; i++) { + v = x[i]; iv = indx[i]; + j = i; + while (j >= h && rcmp(x[j - h], v, TRUE) > 0) + { x[j] = x[j - h]; indx[j] = indx[j-h]; j -= h; } + x[j] = v; indx[j] = iv; + } +} + +void revsort(double *a, int *ib, int n) +{ +/* Sort a[] into descending order by "heapsort"; + * sort ib[] alongside; + * if initially, ib[] = 1...n, it will contain the permutation finally + */ + + int l, j, ir, i; + double ra; + int ii; + + if (n <= 1) return; + + a--; ib--; + + l = (n >> 1) + 1; + ir = n; + + for (;;) { + if (l > 1) { + l = l - 1; + ra = a[l]; + ii = ib[l]; + } + else { + ra = a[ir]; + ii = ib[ir]; + a[ir] = a[1]; + ib[ir] = ib[1]; + if (--ir == 1) { + a[1] = ra; + ib[1] = ii; + return; + } + } + i = l; + j = l << 1; + while (j <= ir) { + if (j < ir && a[j] > a[j + 1]) ++j; + if (ra > a[j]) { + a[i] = a[j]; + ib[i] = ib[j]; + j += (i = j); + } + else + j = ir + 1; + } + a[i] = ra; + ib[i] = ii; + } +} + + +SEXP attribute_hidden do_sort(SEXP call, SEXP op, SEXP args, SEXP rho) +{ + SEXP ans; + Rboolean decreasing; + + checkArity(op, args); + + decreasing = asLogical(CADR(args)); + if(decreasing == NA_LOGICAL) + error(_("'decreasing' must be TRUE or FALSE")); + if(CAR(args) == R_NilValue) return R_NilValue; + if(!isVectorAtomic(CAR(args))) + error(_("only atomic vectors can be sorted")); + if(TYPEOF(CAR(args)) == RAWSXP) + error(_("raw vectors cannot be sorted")); + /* we need consistent behaviour here, including dropping attibutes, + so as from 2.3.0 we always duplicate. */ + PROTECT(ans = duplicate(CAR(args))); + SET_ATTRIB(ans, R_NilValue); /* this is never called with names */ + SET_OBJECT(ans, 0); /* we may have just stripped off the class */ + sortVector(ans, decreasing); + UNPROTECT(1); + return(ans); +} + +/* faster versions of shellsort, following Sedgewick (1986) */ + +/* c(1, 4^k +3*2^(k-1)+1) */ +#ifdef LONG_VECTOR_SUPPORT +// This goes up to 2^38: extend eventually. +#define NI 20 +static const R_xlen_t incs[NI + 1] = { + 274878693377L, 68719869953L, 17180065793L, 4295065601L, + 1073790977L, 268460033L, 67121153L, 16783361L, 4197377L, 1050113L, + 262913L, 65921L, 16577L, 4193L, 1073L, 281L, 77L, 23L, 8L, 1L, 0L +}; +#else +#define NI 16 +static const int incs[NI + 1] = { + 1073790977, 268460033, 67121153, 16783361, 4197377, 1050113, + 262913, 65921, 16577, 4193, 1073, 281, 77, 23, 8, 1, 0 +}; +#endif + +#define sort2_body \ + for (h = incs[t]; t < NI; h = incs[++t]) \ + for (i = h; i < n; i++) { \ + v = x[i]; \ + j = i; \ + while (j >= h && x[j - h] less v) { x[j] = x[j - h]; j -= h; } \ + x[j] = v; \ + } + +/* These are only called with n >= 2 */ +static void R_isort2(int *x, R_xlen_t n, Rboolean decreasing) +{ + int v; + R_xlen_t i, j, h, t; + + if (n < 2) error("'n >= 2' is required"); + for (t = 0; incs[t] > n; t++); + if(decreasing) +#define less < + sort2_body +#undef less + else +#define less > + sort2_body +#undef less +} + +static void R_rsort2(double *x, R_xlen_t n, Rboolean decreasing) +{ + double v; + R_xlen_t i, j, h, t; + + if (n < 2) error("'n >= 2' is required"); + for (t = 0; incs[t] > n; t++); + if(decreasing) +#define less < + sort2_body +#undef less + else +#define less > + sort2_body +#undef less +} + +static void R_csort2(Rcomplex *x, R_xlen_t n, Rboolean decreasing) +{ + Rcomplex v; + R_xlen_t i, j, h, t; + + if (n < 2) error("'n >= 2' is required"); + for (t = 0; incs[t] > n; t++); + for (h = incs[t]; t < NI; h = incs[++t]) + for (i = h; i < n; i++) { + v = x[i]; + j = i; + if(decreasing) + while (j >= h && (x[j - h].r < v.r || + (x[j - h].r == v.r && x[j - h].i < v.i))) + { x[j] = x[j - h]; j -= h; } + else + while (j >= h && (x[j - h].r > v.r || + (x[j - h].r == v.r && x[j - h].i > v.i))) + { x[j] = x[j - h]; j -= h; } + x[j] = v; + } +} + +static void ssort2(SEXP *x, R_xlen_t n, Rboolean decreasing) +{ + SEXP v; + R_xlen_t i, j, h, t; + + if (n < 2) error("'n >= 2' is required"); + for (t = 0; incs[t] > n; t++); + for (h = incs[t]; t < NI; h = incs[++t]) + for (i = h; i < n; i++) { + v = x[i]; + j = i; + if(decreasing) + while (j >= h && scmp(x[j - h], v, TRUE) < 0) + { x[j] = x[j - h]; j -= h; } + else + while (j >= h && scmp(x[j - h], v, TRUE) > 0) + { x[j] = x[j - h]; j -= h; } + x[j] = v; + } +} + +/* The meat of sort.int() */ +void sortVector(SEXP s, Rboolean decreasing) +{ + R_xlen_t n = XLENGTH(s); + if (n >= 2 && (decreasing || isUnsorted(s, FALSE))) + switch (TYPEOF(s)) { + case LGLSXP: + case INTSXP: + R_isort2(INTEGER(s), n, decreasing); + break; + case REALSXP: + R_rsort2(REAL(s), n, decreasing); + break; + case CPLXSXP: + R_csort2(COMPLEX(s), n, decreasing); + break; + case STRSXP: + ssort2(STRING_PTR(s), n, decreasing); + break; + default: + UNIMPLEMENTED_TYPE("sortVector", s); + } +} + + + /*--- Part III: Partial Sorting ---*/ + +/* + Partial sort so that x[k] is in the correct place, smaller to left, + larger to right + + NOTA BENE: k < n required, and *not* checked here but in do_psort(); + ----- infinite loop possible otherwise! + */ +#define psort_body \ + Rboolean nalast=TRUE; \ + R_xlen_t L, R, i, j; \ + \ + for (L = lo, R = hi; L < R; ) { \ + v = x[k]; \ + for(i = L, j = R; i <= j;) { \ + while (TYPE_CMP(x[i], v, nalast) < 0) i++; \ + while (TYPE_CMP(v, x[j], nalast) < 0) j--; \ + if (i <= j) { w = x[i]; x[i++] = x[j]; x[j--] = w; }\ + } \ + if (j < k) L = i; \ + if (k < i) R = j; \ + } + + +static void iPsort2(int *x, R_xlen_t lo, R_xlen_t hi, R_xlen_t k) +{ + int v, w; +#define TYPE_CMP icmp + psort_body +#undef TYPE_CMP +} + +static void rPsort2(double *x, R_xlen_t lo, R_xlen_t hi, R_xlen_t k) +{ + double v, w; +#define TYPE_CMP rcmp + psort_body +#undef TYPE_CMP +} + +static void cPsort2(Rcomplex *x, R_xlen_t lo, R_xlen_t hi, R_xlen_t k) +{ + Rcomplex v, w; +#define TYPE_CMP ccmp + psort_body +#undef TYPE_CMP +} + + +static void sPsort2(SEXP *x, R_xlen_t lo, R_xlen_t hi, R_xlen_t k) +{ + SEXP v, w; +#define TYPE_CMP scmp + psort_body +#undef TYPE_CMP +} + + +/* Needed for mistaken decision to put these in the API */ +void iPsort(int *x, int n, int k) +{ + iPsort2(x, 0, n-1, k); +} + +void rPsort(double *x, int n, int k) +{ + rPsort2(x, 0, n-1, k); +} + +void cPsort(Rcomplex *x, int n, int k) +{ + cPsort2(x, 0, n-1, k); +} + +/* lo, hi, k are 0-based */ +static void Psort(SEXP x, R_xlen_t lo, R_xlen_t hi, R_xlen_t k) +{ + /* Rprintf("looking for index %d in (%d, %d)\n", k, lo, hi);*/ + switch (TYPEOF(x)) { + case LGLSXP: + case INTSXP: + iPsort2(INTEGER(x), lo, hi, k); + break; + case REALSXP: + rPsort2(REAL(x), lo, hi, k); + break; + case CPLXSXP: + cPsort2(COMPLEX(x), lo, hi, k); + break; + case STRSXP: + sPsort2(STRING_PTR(x), lo, hi, k); + break; + default: + UNIMPLEMENTED_TYPE("Psort", x); + } +} + + +/* Here ind are 1-based indices passed from R */ +static void +Psort0(SEXP x, R_xlen_t lo, R_xlen_t hi, R_xlen_t *ind, int nind) +{ + if(nind < 1 || hi - lo < 1) return; + if(nind <= 1) + Psort(x, lo, hi, ind[0] - 1); + else { + /* Look for index nearest the centre of the range */ + int This = 0; + R_xlen_t mid = (lo+hi)/2, z; + for(int i = 0; i < nind; i++) if(ind[i] - 1 <= mid) This = i; + z = ind[This] - 1; + Psort(x, lo, hi, z); + Psort0(x, lo, z-1, ind, This); + Psort0(x, z+1, hi, ind + This + 1, nind - This -1); + } +} + + +/* FUNCTION psort(x, indices) */ +SEXP attribute_hidden do_psort(SEXP call, SEXP op, SEXP args, SEXP rho) +{ + checkArity(op, args); + SEXP x = CAR(args), p = CADR(args); + + if (!isVectorAtomic(x)) + error(_("only atomic vectors can be sorted")); + if(TYPEOF(x) == RAWSXP) + error(_("raw vectors cannot be sorted")); + R_xlen_t n = XLENGTH(x); +#ifdef LONG_VECTOR_SUPPORT + if(!IS_LONG_VEC(x) || TYPEOF(p) != REALSXP) + SETCADR(args, coerceVector(p, INTSXP)); + p = CADR(args); + int nind = LENGTH(p); + R_xlen_t *l = (R_xlen_t *) R_alloc(nind, sizeof(R_xlen_t)); + if (TYPEOF(p) == REALSXP) { + double *rl = REAL(p); + for (int i = 0; i < nind; i++) { + if (!R_FINITE(rl[i])) error(_("NA or infinite index")); + l[i] = (R_xlen_t) rl[i]; + if (l[i] < 1 || l[i] > n) + error(_("index %ld outside bounds"), l[i]); + } + } else { + int *il = INTEGER(p); + for (int i = 0; i < nind; i++) { + if (il[i] == NA_INTEGER) error(_("NA index")); + if (il[i] < 1 || il[i] > n) + error(_("index %d outside bounds"), il[i]); + l[i] = il[i]; + } + } +#else + SETCADR(args, coerceVector(p, INTSXP)); + p = CADR(args); + int nind = LENGTH(p); + int *l = INTEGER(p); + for (int i = 0; i < nind; i++) { + if (l[i] == NA_INTEGER) + error(_("NA index")); + if (l[i] < 1 || l[i] > n) + error(_("index %d outside bounds"), l[i]); + } +#endif + SETCAR(args, duplicate(x)); + SET_ATTRIB(CAR(args), R_NilValue); /* remove all attributes */ + SET_OBJECT(CAR(args), 0); /* and the object bit */ + Psort0(CAR(args), 0, n - 1, l, nind); + return CAR(args); +} + + + /*--- Part IV : Rank & Order ---*/ + +static int equal(R_xlen_t i, R_xlen_t j, SEXP x, Rboolean nalast, SEXP rho) +{ + int c = -1; + + if (isObject(x) && !isNull(rho)) { /* so never any NAs */ + /* evaluate .gt(x, i, j) */ + SEXP si, sj, call; + PROTECT(si = ScalarInteger((int)i+1)); + PROTECT(sj = ScalarInteger((int)j+1)); + PROTECT(call = lang4(install(".gt"), x, si, sj)); + c = asInteger(eval(call, rho)); + UNPROTECT(3); + } else { + switch (TYPEOF(x)) { + case LGLSXP: + case INTSXP: + c = icmp(INTEGER(x)[i], INTEGER(x)[j], nalast); + break; + case REALSXP: + c = rcmp(REAL(x)[i], REAL(x)[j], nalast); + break; + case CPLXSXP: + c = ccmp(COMPLEX(x)[i], COMPLEX(x)[j], nalast); + break; + case STRSXP: + c = scmp(STRING_ELT(x, i), STRING_ELT(x, j), nalast); + break; + default: + UNIMPLEMENTED_TYPE("equal", x); + break; + } + } + if (c == 0) + return 1; + return 0; +} + +static int greater(R_xlen_t i, R_xlen_t j, SEXP x, Rboolean nalast, + Rboolean decreasing, SEXP rho) +{ + int c = -1; + + if (isObject(x) && !isNull(rho)) { /* so never any NAs */ + /* evaluate .gt(x, i, j) */ + SEXP si, sj, call; + PROTECT(si = ScalarInteger((int)i+1)); + PROTECT(sj = ScalarInteger((int)j+1)); + PROTECT(call = lang4(install(".gt"), x, si, sj)); + c = asInteger(eval(call, rho)); + UNPROTECT(3); + } else { + switch (TYPEOF(x)) { + case LGLSXP: + case INTSXP: + c = icmp(INTEGER(x)[i], INTEGER(x)[j], nalast); + break; + case REALSXP: + c = rcmp(REAL(x)[i], REAL(x)[j], nalast); + break; + case CPLXSXP: + c = ccmp(COMPLEX(x)[i], COMPLEX(x)[j], nalast); + break; + case STRSXP: + c = scmp(STRING_ELT(x, i), STRING_ELT(x, j), nalast); + break; + default: + UNIMPLEMENTED_TYPE("greater", x); + break; + } + } + if (decreasing) c = -c; + if (c > 0 || (c == 0 && j < i)) return 1; else return 0; +} + +/* listgreater(): used as greater_sub in orderVector() in do_order(...) */ +static int listgreater(int i, int j, SEXP key, Rboolean nalast, + Rboolean decreasing) +{ + SEXP x; + int c = -1; + + while (key != R_NilValue) { + x = CAR(key); + switch (TYPEOF(x)) { + case LGLSXP: + case INTSXP: + c = icmp(INTEGER(x)[i], INTEGER(x)[j], nalast); + break; + case REALSXP: + c = rcmp(REAL(x)[i], REAL(x)[j], nalast); + break; + case CPLXSXP: + c = ccmp(COMPLEX(x)[i], COMPLEX(x)[j], nalast); + break; + case STRSXP: + c = scmp(STRING_ELT(x, i), STRING_ELT(x, j), nalast); + break; + default: + UNIMPLEMENTED_TYPE("listgreater", x); + } + if (decreasing) c = -c; + if (c > 0) + return 1; + if (c < 0) + return 0; + key = CDR(key); + } + if (c == 0 && i < j) return 0; else return 1; +} + + +#define GREATER_2_SUB_DEF(FNAME, TYPE_1, TYPE_2, CMP_FN_1, CMP_FN_2) \ +static int FNAME(int i, int j, \ + TYPE_1 *x, TYPE_2 *y, \ + Rboolean nalast, Rboolean decreasing) \ +{ \ + int CMP_FN_1(TYPE_1, TYPE_1, Rboolean); \ + int CMP_FN_2(TYPE_2, TYPE_2, Rboolean); \ + \ + int c = CMP_FN_1(x[i], x[j], nalast); \ + if(c) { \ + if (decreasing) c = -c; \ + if (c > 0) return 1; \ + /* else: (c < 0) */ return 0; \ + } \ + else {/* have a tie in x -- use y[]: */ \ + c = CMP_FN_2(y[i], y[j], nalast); \ + if(c) { \ + if (decreasing) c = -c; \ + if (c > 0) return 1; \ + /* else: (c < 0) */ return 0; \ + } \ + else { /* tie in both x[] and y[] : */ \ + if (i < j) return 0; \ + /* else */ return 1; \ + } \ + } \ +} + +static const int sincs[17] = { + 1073790977, 268460033, 67121153, 16783361, 4197377, 1050113, + 262913, 65921, 16577, 4193, 1073, 281, 77, 23, 8, 1, 0 +}; + +// Needs indx set to 0:(n-1) initially : +static void +orderVector(int *indx, int n, SEXP key, Rboolean nalast, + Rboolean decreasing, + int greater_sub(int, int, SEXP, Rboolean, Rboolean)) +{ + int i, j, h, t; + int itmp; + + if (n < 2) return; + for (t = 0; sincs[t] > n; t++); + for (h = sincs[t]; t < 16; h = sincs[++t]) { + R_CheckUserInterrupt(); + for (i = h; i < n; i++) { + itmp = indx[i]; + j = i; + while (j >= h && + greater_sub(indx[j - h], itmp, key, nalast^decreasing, + decreasing)) { + indx[j] = indx[j - h]; + j -= h; + } + indx[j] = itmp; + } + } +} + +#ifdef LONG_VECTOR_SUPPORT +static int listgreaterl(R_xlen_t i, R_xlen_t j, SEXP key, Rboolean nalast, + Rboolean decreasing) +{ + SEXP x; + int c = -1; + + while (key != R_NilValue) { + x = CAR(key); + switch (TYPEOF(x)) { + case LGLSXP: + case INTSXP: + c = icmp(INTEGER(x)[i], INTEGER(x)[j], nalast); + break; + case REALSXP: + c = rcmp(REAL(x)[i], REAL(x)[j], nalast); + break; + case CPLXSXP: + c = ccmp(COMPLEX(x)[i], COMPLEX(x)[j], nalast); + break; + case STRSXP: + c = scmp(STRING_ELT(x, i), STRING_ELT(x, j), nalast); + break; + default: + UNIMPLEMENTED_TYPE("listgreater", x); + } + if (decreasing) c = -c; + if (c > 0) + return 1; + if (c < 0) + return 0; + key = CDR(key); + } + if (c == 0 && i < j) return 0; else return 1; +} + +static void +orderVectorl(R_xlen_t *indx, R_xlen_t n, SEXP key, Rboolean nalast, + Rboolean decreasing, + int greater_sub(R_xlen_t, R_xlen_t, SEXP, Rboolean, Rboolean)) +{ + int t; + R_xlen_t i, j, h; + R_xlen_t itmp; + + if (n < 2) return; + for (t = 0; incs[t] > n; t++); + for (h = incs[t]; t < NI; h = incs[++t]) { + R_CheckUserInterrupt(); + for (i = h; i < n; i++) { + itmp = indx[i]; + j = i; + while (j >= h && + greater_sub(indx[j - h], itmp, key, nalast^decreasing, + decreasing)) { + indx[j] = indx[j - h]; + j -= h; + } + indx[j] = itmp; + } + } +} +#endif + +#ifdef UNUSED +#define ORD_2_BODY(FNAME, TYPE_1, TYPE_2, GREATER_2_SUB) \ + void FNAME(int *indx, int n, TYPE_1 *x, TYPE_2 *y, \ + Rboolean nalast, Rboolean decreasing) \ +{ \ + int t; \ + for(t = 0; t < n; t++) indx[t] = t; /* indx[] <- 0:(n-1) */ \ + if (n < 2) return; \ + for(t = 0; sincs[t] > n; t++); \ + for (int h = sincs[t]; t < 16; h = sincs[++t]) \ + for (int i = h; i < n; i++) { \ + int itmp = indx[i], j = i; \ + while (j >= h && \ + GREATER_2_SUB(indx[j - h], itmp, x, y, \ + nalast^decreasing, decreasing)) { \ + indx[j] = indx[j - h]; \ + j -= h; \ + } \ + indx[j] = itmp; \ + } \ +} + +ORD_2_BODY(R_order2double , double, double, double2greater) +ORD_2_BODY(R_order2int , int, int, int2greater) +ORD_2_BODY(R_order2dbl_int, double, int, dblint2greater) +ORD_2_BODY(R_order2int_dbl, int, double, intdbl2greater) + + +GREATER_2_SUB_DEF(double2greater, double, double, rcmp, rcmp) +GREATER_2_SUB_DEF(int2greater, int, int, icmp, icmp) +GREATER_2_SUB_DEF(dblint2greater, double, int, rcmp, icmp) +GREATER_2_SUB_DEF(intdbl2greater, int, double, icmp, rcmp) +#endif + +#define sort2_with_index \ + for (h = sincs[t]; t < 16; h = sincs[++t]) { \ + R_CheckUserInterrupt(); \ + for (i = lo + h; i <= hi; i++) { \ + itmp = indx[i]; \ + j = i; \ + while (j >= lo + h && less(indx[j - h], itmp)) { \ + indx[j] = indx[j - h]; j -= h; } \ + indx[j] = itmp; \ + } \ + } + + +/* TODO: once LONG_VECTOR_SUPPORT and R_xlen_t belong to the R API, + * ---- also add "long" versions, say, + * R_orderVectorl (R_xlen_t *indx, R_xlen_t n, SEXP arglist, ...) + * R_orderVector1l(R_xlen_t *indx, R_xlen_t n, SEXP arg, ...) + * to the API */ + +// Usage: R_orderVector(indx, n, Rf_lang2(x,y), nalast, decreasing) +void R_orderVector(int *indx, // must be pre-allocated to length >= n + int n, + SEXP arglist, // <- e.g. Rf_lang2(x,y) + Rboolean nalast, Rboolean decreasing) +{ + // idx[] <- 0:(n-1) : + for(int i = 0; i < n; i++) indx[i] = i; + orderVector(indx, n, arglist, nalast, decreasing, listgreater); + return; +} + +// Fast version of 1-argument case of R_orderVector() +void R_orderVector1(int *indx, int n, SEXP x, + Rboolean nalast, Rboolean decreasing) +{ + for(int i = 0; i < n; i++) indx[i] = i; + orderVector1(indx, n, x, nalast, decreasing, R_NilValue); +} + + + +/* Needs indx set to 0:(n-1) initially. + Also used by do_options and ../gnuwin32/extra.c + Called with rho != R_NilValue only from do_rank, when NAs are not involved. + */ +void attribute_hidden +orderVector1(int *indx, int n, SEXP key, Rboolean nalast, Rboolean decreasing, + SEXP rho) +{ + int c, i, j, h, t, lo = 0, hi = n-1; + int itmp, *isna = NULL, numna = 0; + int *ix = NULL /* -Wall */; + double *x = NULL /* -Wall */; + Rcomplex *cx = NULL /* -Wall */; + SEXP *sx = NULL /* -Wall */; + + if (n < 2) return; + switch (TYPEOF(key)) { + case LGLSXP: + case INTSXP: + ix = INTEGER(key); + break; + case REALSXP: + x = REAL(key); + break; + case STRSXP: + sx = STRING_PTR(key); + break; + case CPLXSXP: + cx = COMPLEX(key); + break; + } + + if(isNull(rho)) { + /* First sort NAs to one end */ + isna = Calloc(n, int); + switch (TYPEOF(key)) { + case LGLSXP: + case INTSXP: + for (i = 0; i < n; i++) isna[i] = (ix[i] == NA_INTEGER); + break; + case REALSXP: + for (i = 0; i < n; i++) isna[i] = ISNAN(x[i]); + break; + case STRSXP: + for (i = 0; i < n; i++) isna[i] = (sx[i] == NA_STRING); + break; + case CPLXSXP: + for (i = 0; i < n; i++) isna[i] = ISNAN(cx[i].r) || ISNAN(cx[i].i); + break; + default: + UNIMPLEMENTED_TYPE("orderVector1", key); + } + for (i = 0; i < n; i++) numna += isna[i]; + + if(numna) + switch (TYPEOF(key)) { + case LGLSXP: + case INTSXP: + case REALSXP: + case STRSXP: + case CPLXSXP: + if (!nalast) for (i = 0; i < n; i++) isna[i] = !isna[i]; + for (t = 0; sincs[t] > n; t++); +#define less(a, b) (isna[a] > isna[b] || (isna[a] == isna[b] && a > b)) + sort2_with_index +#undef less + if (n - numna < 2) { + Free(isna); + return; + } + if (nalast) hi -= numna; else lo += numna; + } + } + + /* Shell sort isn't stable, so add test on index */ + + for (t = 0; sincs[t] > hi-lo+1; t++); + + if (isObject(key) && !isNull(rho)) { +/* only reached from do_rank */ +#define less(a, b) greater(a, b, key, nalast^decreasing, decreasing, rho) + sort2_with_index +#undef less + } else { + switch (TYPEOF(key)) { + case LGLSXP: + case INTSXP: + if (decreasing) { +#define less(a, b) (ix[a] < ix[b] || (ix[a] == ix[b] && a > b)) + sort2_with_index +#undef less + } else { +#define less(a, b) (ix[a] > ix[b] || (ix[a] == ix[b] && a > b)) + sort2_with_index +#undef less + } + break; + case REALSXP: + if (decreasing) { +#define less(a, b) (x[a] < x[b] || (x[a] == x[b] && a > b)) + sort2_with_index +#undef less + } else { +#define less(a, b) (x[a] > x[b] || (x[a] == x[b] && a > b)) + sort2_with_index +#undef less + } + break; + case CPLXSXP: + if (decreasing) { +#define less(a, b) (ccmp(cx[a], cx[b], 0) < 0 || (cx[a].r == cx[b].r && cx[a].i == cx[b].i && a > b)) + sort2_with_index +#undef less + } else { +#define less(a, b) (ccmp(cx[a], cx[b], 0) > 0 || (cx[a].r == cx[b].r && cx[a].i == cx[b].i && a > b)) + sort2_with_index +#undef less + } + break; + case STRSXP: + if (decreasing) +#define less(a, b) (c = Scollate(sx[a], sx[b]), c < 0 || (c == 0 && a > b)) + sort2_with_index +#undef less + else +#define less(a, b) (c = Scollate(sx[a], sx[b]), c > 0 || (c == 0 && a > b)) + sort2_with_index +#undef less + break; + default: /* only reached from do_rank */ +#define less(a, b) greater(a, b, key, nalast^decreasing, decreasing, rho) + sort2_with_index +#undef less + } + } + if(isna) Free(isna); +} + +/* version for long vectors */ +#ifdef LONG_VECTOR_SUPPORT +static void +orderVector1l(R_xlen_t *indx, R_xlen_t n, SEXP key, Rboolean nalast, + Rboolean decreasing, SEXP rho) +{ + R_xlen_t c, i, j, h, t, lo = 0, hi = n-1; + int *isna = NULL, numna = 0; + int *ix = NULL /* -Wall */; + double *x = NULL /* -Wall */; + Rcomplex *cx = NULL /* -Wall */; + SEXP *sx = NULL /* -Wall */; + R_xlen_t itmp; + + if (n < 2) return; + switch (TYPEOF(key)) { + case LGLSXP: + case INTSXP: + ix = INTEGER(key); + break; + case REALSXP: + x = REAL(key); + break; + case STRSXP: + sx = STRING_PTR(key); + break; + case CPLXSXP: + cx = COMPLEX(key); + break; + } + + if(isNull(rho)) { + /* First sort NAs to one end */ + isna = Calloc(n, int); + switch (TYPEOF(key)) { + case LGLSXP: + case INTSXP: + for (i = 0; i < n; i++) isna[i] = (ix[i] == NA_INTEGER); + break; + case REALSXP: + for (i = 0; i < n; i++) isna[i] = ISNAN(x[i]); + break; + case STRSXP: + for (i = 0; i < n; i++) isna[i] = (sx[i] == NA_STRING); + break; + case CPLXSXP: + for (i = 0; i < n; i++) isna[i] = ISNAN(cx[i].r) || ISNAN(cx[i].i); + break; + default: + UNIMPLEMENTED_TYPE("orderVector1", key); + } + for (i = 0; i < n; i++) numna += isna[i]; + + if(numna) + switch (TYPEOF(key)) { + case LGLSXP: + case INTSXP: + case REALSXP: + case STRSXP: + case CPLXSXP: + if (!nalast) for (i = 0; i < n; i++) isna[i] = !isna[i]; + for (t = 0; sincs[t] > n; t++); +#define less(a, b) (isna[a] > isna[b] || (isna[a] == isna[b] && a > b)) + sort2_with_index +#undef less + if (n - numna < 2) { + Free(isna); + return; + } + if (nalast) hi -= numna; else lo += numna; + } + } + + /* Shell sort isn't stable, so add test on index */ + + for (t = 0; sincs[t] > hi-lo+1; t++); + + if (isObject(key) && !isNull(rho)) { +/* only reached from do_rank */ +#define less(a, b) greater(a, b, key, nalast^decreasing, decreasing, rho) + sort2_with_index +#undef less + } else { + switch (TYPEOF(key)) { + case LGLSXP: + case INTSXP: + if (decreasing) { +#define less(a, b) (ix[a] < ix[b] || (ix[a] == ix[b] && a > b)) + sort2_with_index +#undef less + } else { +#define less(a, b) (ix[a] > ix[b] || (ix[a] == ix[b] && a > b)) + sort2_with_index +#undef less + } + break; + case REALSXP: + if (decreasing) { +#define less(a, b) (x[a] < x[b] || (x[a] == x[b] && a > b)) + sort2_with_index +#undef less + } else { +#define less(a, b) (x[a] > x[b] || (x[a] == x[b] && a > b)) + sort2_with_index +#undef less + } + break; + case CPLXSXP: + if (decreasing) { +#define less(a, b) (ccmp(cx[a], cx[b], 0) < 0 || (cx[a].r == cx[b].r && cx[a].i == cx[b].i && a > b)) + sort2_with_index +#undef less + } else { +#define less(a, b) (ccmp(cx[a], cx[b], 0) > 0 || (cx[a].r == cx[b].r && cx[a].i == cx[b].i && a > b)) + sort2_with_index +#undef less + } + break; + case STRSXP: + if (decreasing) +#define less(a, b) (c=Scollate(sx[a], sx[b]), c < 0 || (c == 0 && a > b)) + sort2_with_index +#undef less + else +#define less(a, b) (c=Scollate(sx[a], sx[b]), c > 0 || (c == 0 && a > b)) + sort2_with_index +#undef less + break; + default: /* only reached from do_rank */ +#define less(a, b) greater(a, b, key, nalast^decreasing, decreasing, rho) + sort2_with_index +#undef less + } + } + if(isna) Free(isna); +} +#endif + +/* FUNCTION order(...) */ +SEXP attribute_hidden do_order(SEXP call, SEXP op, SEXP args, SEXP rho) +{ + SEXP ap, ans = R_NilValue /* -Wall */; + int narg = 0; + R_xlen_t n = -1; + Rboolean nalast, decreasing; + + nalast = asLogical(CAR(args)); + if(nalast == NA_LOGICAL) + error(_("invalid '%s' value"), "na.last"); + args = CDR(args); + decreasing = asLogical(CAR(args)); + if(decreasing == NA_LOGICAL) + error(_("'decreasing' must be TRUE or FALSE")); + args = CDR(args); + if (args == R_NilValue) + return R_NilValue; + + if (isVector(CAR(args))) + n = XLENGTH(CAR(args)); + for (ap = args; ap != R_NilValue; ap = CDR(ap), narg++) { + if (!isVector(CAR(ap))) + error(_("argument %d is not a vector"), narg + 1); + if (XLENGTH(CAR(ap)) != n) + error(_("argument lengths differ")); + } + /* NB: collation functions such as Scollate might allocate */ + if (n != 0) { + if(narg == 1) { +#ifdef LONG_VECTOR_SUPPORT + if (n > INT_MAX) { + PROTECT(ans = allocVector(REALSXP, n)); + R_xlen_t *in = (R_xlen_t *) R_alloc(n, sizeof(R_xlen_t)); + for (R_xlen_t i = 0; i < n; i++) in[i] = i; + orderVector1l(in, n, CAR(args), nalast, decreasing, + R_NilValue); + for (R_xlen_t i = 0; i < n; i++) REAL(ans)[i] = in[i] + 1; + } else +#endif + { + PROTECT(ans = allocVector(INTSXP, n)); + for (R_xlen_t i = 0; i < n; i++) INTEGER(ans)[i] = (int) i; + orderVector1(INTEGER(ans), (int)n, CAR(args), nalast, + decreasing, R_NilValue); + for (R_xlen_t i = 0; i < n; i++) INTEGER(ans)[i]++; + } + } else { +#ifdef LONG_VECTOR_SUPPORT + if (n > INT_MAX) { + PROTECT(ans = allocVector(REALSXP, n)); + R_xlen_t *in = (R_xlen_t *) R_alloc(n, sizeof(R_xlen_t)); + for (R_xlen_t i = 0; i < n; i++) in[i] = i; + orderVectorl(in, n, CAR(args), nalast, decreasing, + listgreaterl); + for (R_xlen_t i = 0; i < n; i++) REAL(ans)[i] = in[i] + 1; + } else +#endif + { + PROTECT(ans = allocVector(INTSXP, n)); + for (R_xlen_t i = 0; i < n; i++) INTEGER(ans)[i] = (int) i; + orderVector(INTEGER(ans), (int) n, args, nalast, + decreasing, listgreater); + for (R_xlen_t i = 0; i < n; i++) INTEGER(ans)[i]++; + } + } + UNPROTECT(1); + return ans; + } else return allocVector(INTSXP, 0); +} + +/* FUNCTION: rank(x, length, ties.method) */ +SEXP attribute_hidden do_rank(SEXP call, SEXP op, SEXP args, SEXP rho) +{ + SEXP rank, x; + int *ik = NULL /* -Wall */; + double *rk = NULL /* -Wall */; + enum {AVERAGE, MAX, MIN} ties_kind = AVERAGE; + Rboolean isLong = FALSE; + + checkArity(op, args); + x = CAR(args); + if(TYPEOF(x) == RAWSXP) + error(_("raw vectors cannot be sorted")); +#ifdef LONG_VECTOR_SUPPORT + SEXP sn = CADR(args); + R_xlen_t n; + if (TYPEOF(sn) == REALSXP) { + double d = REAL(x)[0]; + if(ISNAN(d)) error(_("vector size cannot be NA/NaN")); + if(!R_FINITE(d)) error(_("vector size cannot be infinite")); + if(d > R_XLEN_T_MAX) error(_("vector size specified is too large")); + n = (R_xlen_t) d; + if (n < 0) error(_("invalid '%s' value"), "length(xx)"); + } else { + int nn = asInteger(sn); + if (nn == NA_INTEGER || nn < 0) + error(_("invalid '%s' value"), "length(xx)"); + n = nn; + } + isLong = n > INT_MAX; +#else + int n = asInteger(CADR(args)); + if (n == NA_INTEGER || n < 0) + error(_("invalid '%s' value"), "length(xx)"); +#endif + const char *ties_str = CHAR(asChar(CADDR(args))); + if(!strcmp(ties_str, "average")) ties_kind = AVERAGE; + else if(!strcmp(ties_str, "max")) ties_kind = MAX; + else if(!strcmp(ties_str, "min")) ties_kind = MIN; + else error(_("invalid ties.method for rank() [should never happen]")); + if (ties_kind == AVERAGE || isLong) { + PROTECT(rank = allocVector(REALSXP, n)); + rk = REAL(rank); + } else { + PROTECT(rank = allocVector(INTSXP, n)); + ik = INTEGER(rank); + } + if (n > 0) { +#ifdef LONG_VECTOR_SUPPORT + if(isLong) { + R_xlen_t i, j, k; + R_xlen_t *in = (R_xlen_t *) R_alloc(n, sizeof(R_xlen_t)); + for (i = 0; i < n; i++) in[i] = i; + orderVector1l(in, n, x, TRUE, FALSE, rho); + for (i = 0; i < n; i = j+1) { + j = i; + while ((j < n - 1) && equal(in[j], in[j + 1], x, TRUE, rho)) j++; + switch(ties_kind) { + case AVERAGE: + for (k = i; k <= j; k++) + rk[in[k]] = (i + j + 2) / 2.; + break; + case MAX: + for (k = i; k <= j; k++) rk[in[k]] = j+1; + break; + case MIN: + for (k = i; k <= j; k++) rk[in[k]] = i+1; + break; + } + } + } else +#endif + { + int i, j, k; + int *in = (int *) R_alloc(n, sizeof(int)); + for (i = 0; i < n; i++) in[i] = i; + orderVector1(in, (int) n, x, TRUE, FALSE, rho); + for (i = 0; i < n; i = j+1) { + j = i; + while ((j < n - 1) && equal(in[j], in[j + 1], x, TRUE, rho)) j++; + switch(ties_kind) { + case AVERAGE: + for (k = i; k <= j; k++) + rk[in[k]] = (i + j + 2) / 2.; + break; + case MAX: + for (k = i; k <= j; k++) ik[in[k]] = j+1; + break; + case MIN: + for (k = i; k <= j; k++) ik[in[k]] = i+1; + break; + } + } + } + } + UNPROTECT(1); + return rank; +} + +SEXP attribute_hidden do_xtfrm(SEXP call, SEXP op, SEXP args, SEXP rho) +{ + SEXP fn, prargs, ans; + + checkArity(op, args); + check1arg(args, call, "x"); + + if(DispatchOrEval(call, op, "xtfrm", args, rho, &ans, 0, 1)) return ans; + /* otherwise dispatch the default method */ + PROTECT(fn = findFun(install("xtfrm.default"), rho)); + PROTECT(prargs = promiseArgs(args, R_GlobalEnv)); + SET_PRVALUE(CAR(prargs), CAR(args)); + ans = applyClosure(call, fn, prargs, rho, R_NilValue); + UNPROTECT(2); + return ans; + +} diff --git a/com.oracle.truffle.r.native/gnur/patch/src/nmath/nmath.h b/com.oracle.truffle.r.native/gnur/patch/src/nmath/nmath.h new file mode 100644 index 0000000000000000000000000000000000000000..759b361a9c7ca0dc923a39d4b351492c5923e125 --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/nmath/nmath.h @@ -0,0 +1,231 @@ +/* + * Mathlib : A C Library of Special Functions + * Copyright (C) 1998-2016 The R Core Team + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version. + * + * This program 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 this program; if not, a copy is available at + * https://www.R-project.org/Licenses/ + */ + +/* Private header file for use during compilation of Mathlib */ +#ifndef MATHLIB_PRIVATE_H +#define MATHLIB_PRIVATE_H + +#ifdef HAVE_CONFIG_H +# include <config.h> +#endif + +/* Required by C99 but might be slow */ +#ifdef HAVE_LONG_DOUBLE +# define LDOUBLE long double +#else +# define LDOUBLE double +#endif + +/* To ensure atanpi, cospi, sinpi, tanpi are defined */ +# ifndef __STDC_WANT_IEC_60559_FUNCS_EXT__ +# define __STDC_WANT_IEC_60559_FUNCS_EXT__ 1 +# endif + +#include <math.h> +#include <float.h> /* DBL_MIN etc */ + +#include <Rconfig.h> +#include <Rmath.h> + +/* Used internally only */ +double Rf_d1mach(int); +double Rf_gamma_cody(double); + +#include <R_ext/RS.h> + +/* possibly needed for debugging */ +#include <R_ext/Print.h> + +/* moved from dpq.h */ +#ifdef HAVE_NEARYINT +# define R_forceint(x) nearbyint() +#else +# define R_forceint(x) round(x) +#endif +//R >= 3.1.0: # define R_nonint(x) (fabs((x) - R_forceint(x)) > 1e-7) +# define R_nonint(x) (fabs((x) - R_forceint(x)) > 1e-7*fmax2(1., fabs(x))) + +#ifndef MATHLIB_STANDALONE + +#include <R_ext/Error.h> +# define MATHLIB_ERROR(fmt,x) error(fmt,x); +# define MATHLIB_WARNING(fmt,x) warning(fmt,x) +# define MATHLIB_WARNING2(fmt,x,x2) warning(fmt,x,x2) +# define MATHLIB_WARNING3(fmt,x,x2,x3) warning(fmt,x,x2,x3) +# define MATHLIB_WARNING4(fmt,x,x2,x3,x4) warning(fmt,x,x2,x3,x4) +# define MATHLIB_WARNING5(fmt,x,x2,x3,x4,x5) warning(fmt,x,x2,x3,x4,x5) + +#include <R_ext/Arith.h> +#define ML_POSINF R_PosInf +#define ML_NEGINF R_NegInf +#define ML_NAN R_NaN + + +void R_CheckUserInterrupt(void); +/* Ei-ji Nakama reported that AIX 5.2 has calloc as a macro and objected + to redefining it. Tests added for 2.2.1 */ +#ifdef calloc +# undef calloc +#endif +#define calloc R_chk_calloc +#ifdef free +# undef free +#endif +#define free R_chk_free + +#ifdef ENABLE_NLS +#include <libintl.h> +#define _(String) gettext (String) +#else +#define _(String) (String) +#endif + +#else +/* Mathlib standalone */ + +#include <stdio.h> +#include <stdlib.h> /* for exit */ +#define MATHLIB_ERROR(fmt,x) { printf(fmt,x); exit(1); } +#define MATHLIB_WARNING(fmt,x) printf(fmt,x) +#define MATHLIB_WARNING2(fmt,x,x2) printf(fmt,x,x2) +#define MATHLIB_WARNING3(fmt,x,x2,x3) printf(fmt,x,x2,x3) +#define MATHLIB_WARNING4(fmt,x,x2,x3,x4) printf(fmt,x,x2,x3,x4) +#define MATHLIB_WARNING5(fmt,x,x2,x3,x4,x5) printf(fmt,x,x2,x3,x4,x5) + +#define ISNAN(x) (isnan(x)!=0) +// Arith.h defines it +#ifndef R_FINITE +#ifdef HAVE_WORKING_ISFINITE +/* isfinite is defined in <math.h> according to C99 */ +# define R_FINITE(x) isfinite(x) +#else +# define R_FINITE(x) R_finite(x) +#endif +#endif +int R_finite(double); + +#define ML_POSINF (1.0 / 0.0) +#define ML_NEGINF ((-1.0) / 0.0) +#define ML_NAN (0.0 / 0.0) + +#define _(String) String +#endif /* standalone */ + +#define ML_VALID(x) (!ISNAN(x)) + +#define ME_NONE 0 +/* no error */ +#define ME_DOMAIN 1 +/* argument out of domain */ +#define ME_RANGE 2 +/* value out of range */ +#define ME_NOCONV 4 +/* process did not converge */ +#define ME_PRECISION 8 +/* does not have "full" precision */ +#define ME_UNDERFLOW 16 +/* and underflow occured (important for IEEE)*/ + +#define ML_ERR_return_NAN { ML_ERROR(ME_DOMAIN, ""); return ML_NAN; } + +/* For a long time prior to R 2.3.0 ML_ERROR did nothing. + We don't report ME_DOMAIN errors as the callers collect ML_NANs into + a single warning. + */ +#define ML_ERROR(x, s) { \ + if(x > ME_DOMAIN) { \ + char *msg = ""; \ + switch(x) { \ + case ME_DOMAIN: \ + msg = _("argument out of domain in '%s'\n"); \ + break; \ + case ME_RANGE: \ + msg = _("value out of range in '%s'\n"); \ + break; \ + case ME_NOCONV: \ + msg = _("convergence failed in '%s'\n"); \ + break; \ + case ME_PRECISION: \ + msg = _("full precision may not have been achieved in '%s'\n"); \ + break; \ + case ME_UNDERFLOW: \ + msg = _("underflow occurred in '%s'\n"); \ + break; \ + } \ + MATHLIB_WARNING(msg, s); \ + } \ +} + +/* Wilcoxon Rank Sum Distribution */ + +#define WILCOX_MAX 50 + +#ifdef HAVE_VISIBILITY_ATTRIBUTE +# define attribute_hidden __attribute__ ((visibility ("hidden"))) +#else +# define attribute_hidden +#endif + +/* Formerly private part of Mathlib.h */ + +/* always remap internal functions */ +#define bd0 Rf_bd0 +#define chebyshev_eval Rf_chebyshev_eval +#define chebyshev_init Rf_chebyshev_init +#define gammalims Rf_gammalims +#define lfastchoose Rf_lfastchoose +#define lgammacor Rf_lgammacor +#define stirlerr Rf_stirlerr +#define pnchisq_raw Rf_pnchisq_raw +#define pgamma_raw Rf_pgamma_raw +#define pnbeta_raw Rf_pnbeta_raw +#define pnbeta2 Rf_pnbeta2 +#define bratio Rf_bratio + + /* Chebyshev Series */ + +int attribute_hidden chebyshev_init(double*, int, double); +double attribute_hidden chebyshev_eval(double, const double *, const int); + + /* Gamma and Related Functions */ + +void attribute_hidden gammalims(double*, double*); +double attribute_hidden lgammacor(double); /* log(gamma) correction */ +double attribute_hidden stirlerr(double); /* Stirling expansion "error" */ + +double attribute_hidden lfastchoose(double, double); + +double attribute_hidden bd0(double, double); + +double attribute_hidden pnchisq_raw(double, double, double, double, double, + int, Rboolean, Rboolean); +double attribute_hidden pgamma_raw(double, double, int, int); +double attribute_hidden pbeta_raw(double, double, double, int, int); +double attribute_hidden qchisq_appr(double, double, double, int, int, double tol); +LDOUBLE attribute_hidden pnbeta_raw(double, double, double, double, double); +double attribute_hidden pnbeta2(double, double, double, double, double, int, int); + +int Rf_i1mach(int); + +/* From toms708.c */ +void attribute_hidden bratio(double a, double b, double x, double y, + double *w, double *w1, int *ierr, int log_p); + + +#endif /* MATHLIB_PRIVATE_H */ diff --git a/com.oracle.truffle.r.native/gnur/patch/src/scripts/mkinstalldirs.in b/com.oracle.truffle.r.native/gnur/patch/src/scripts/mkinstalldirs.in new file mode 100644 index 0000000000000000000000000000000000000000..33ae187c3ea19295e230b7e209f7ac54b8dc96e1 --- /dev/null +++ b/com.oracle.truffle.r.native/gnur/patch/src/scripts/mkinstalldirs.in @@ -0,0 +1,161 @@ +#!@R_SHELL@ +# mkinstalldirs --- make directory hierarchy + +scriptversion=2008-11-05.08 + +# Original author: Noah Friedman <friedman@prep.ai.mit.edu> +# Created: 1993-05-16 +# Public domain. +# +# This file is maintained in Automake, please report +# bugs to <bug-automake@gnu.org> or send patches to +# <automake-patches@gnu.org>. + +nl=' +' +IFS=" "" $nl" +errstatus=0 +dirmode= + +usage="\ +Usage: mkinstalldirs [-h] [--help] [--version] [-m MODE] DIR ... + +Create each directory DIR (with mode MODE, if specified), including all +leading file name components. + +Report bugs to <bug-automake@gnu.org>." + +# process command line arguments +while test $# -gt 0 ; do + case $1 in + -h | --help | --h*) # -h for help + echo "$usage" + exit $? + ;; + -m) # -m PERM arg + shift + test $# -eq 0 && { echo "$usage" 1>&2; exit 1; } + dirmode=$1 + shift + ;; + --version) + echo "$0 $scriptversion" + exit $? + ;; + --) # stop option processing + shift + break + ;; + -*) # unknown option + echo "$usage" 1>&2 + exit 1 + ;; + *) # first non-opt arg + break + ;; + esac +done + +for file +do + if test -d "$file"; then + shift + else + break + fi +done + +case $# in + 0) exit 0 ;; +esac + +# Solaris 8's mkdir -p isn't thread-safe. If you mkdir -p a/b and +# mkdir -p a/c at the same time, both will detect that a is missing, +# one will create a, then the other will try to create a and die with +# a "File exists" error. This is a problem when calling mkinstalldirs +# from a parallel make. We use --version in the probe to restrict +# ourselves to GNU mkdir, which is thread-safe. +case $dirmode in + '') + if mkdir -p --version . >/dev/null 2>&1 && test ! -d ./--version; then + echo "mkdir -p -- $*" + exec mkdir -p -- "$@" + else + # On NextStep and OpenStep, the `mkdir' command does not + # recognize any option. It will interpret all options as + # directories to create, and then abort because `.' already + # exists. + test -d ./-p && rmdir ./-p + test -d ./--version && rmdir ./--version + fi + ;; + *) + if mkdir -m "$dirmode" -p --version . >/dev/null 2>&1 && + test ! -d ./--version; then + echo "mkdir -m $dirmode -p -- $*" + exec mkdir -m "$dirmode" -p -- "$@" + else + # Clean up after NextStep and OpenStep mkdir. + for d in ./-m ./-p ./--version "./$dirmode"; + do + test -d $d && rmdir $d + done + fi + ;; +esac + +for file +do + case $file in + /*) pathcomp=/ ;; + *) pathcomp= ;; + esac + oIFS=$IFS + IFS=/ + set fnord $file + shift + IFS=$oIFS + + for d + do + test "x$d" = x && continue + + pathcomp=$pathcomp$d + case $pathcomp in + -*) pathcomp=./$pathcomp ;; + esac + + if test ! -d "$pathcomp"; then + echo "mkdir $pathcomp" + + mkdir "$pathcomp" || lasterr=$? + + if test ! -d "$pathcomp"; then + errstatus=$lasterr + else + if test ! -z "$dirmode"; then + echo "chmod $dirmode $pathcomp" + lasterr= + chmod "$dirmode" "$pathcomp" || lasterr=$? + + if test ! -z "$lasterr"; then + errstatus=$lasterr + fi + fi + fi + fi + + pathcomp=$pathcomp/ + done +done + +exit $errstatus + +# Local Variables: +# mode: shell-script +# sh-indentation: 2 +# eval: (add-hook 'write-file-hooks 'time-stamp) +# time-stamp-start: "scriptversion=" +# time-stamp-format: "%:y-%02m-%02d.%02H" +# time-stamp-end: "$" +# End: diff --git a/documentation/dev/build-process.md b/documentation/dev/build-process.md index 8b0f4f48036c7730412acc4ab6afa4965e8d6e29..98864394effbb7f82fe8a020f34322903c3cb1d7 100644 --- a/documentation/dev/build-process.md +++ b/documentation/dev/build-process.md @@ -8,7 +8,7 @@ See also [building](building.md), [release](../../com.oracle.truffle.r.release/R ## `mx build` - * locates the module definition in `fastr/mx.fastr` + * locates the module definition in `$(FASTR_R_HOME)/mx.fastr` * possibly loads the `env` file from `mx.fastr` (there is none, by default) * sets up binary suites, if any * discovers suites (fastr as primary, truffle) @@ -28,7 +28,7 @@ See also [building](building.md), [release](../../com.oracle.truffle.r.release/R * building native projects: an instance of `mx.NativeProject` creates an instance `mx.NativeBuildTask`, * method `_build_run_args` creates the command line for `make`, such as: * `['make', '-f', '/Users/zslajchrt/work/tests/graal/truffle/src/com.oracle.truffle.nfi.native/Makefile', '-j', '8']` - * `['make']` for the patched GNUR in `fastr/com.oracle.truffle.r.native` + * `['make']` for the patched GNUR in `$(FASTR_R_HOME)/com.oracle.truffle.r.native` ## Integrating GNUR @@ -60,9 +60,8 @@ See also [building](building.md), [release](../../com.oracle.truffle.r.release/R _Patched files_: - * `$(GNUR_HOME)/Makeconf` using `edMakeconf` - - + * The generated `$(GNUR_HOME)/Makeconf` using `edMakeconf` + #### `Makefile.platform` It extracts relevant parts of the generated GnuR `Makeconf` file into FastR's `platform.mk`. @@ -104,12 +103,15 @@ and other header files, symbolic links are created pointing to their originals i The file `linked` is just a sentinel file indicating that the links have been made. -The contents of the patched `include` directory is copied later by `run/Makefile` to `fastr/include`. +The contents of the patched `include` directory is copied later by `run/Makefile` to `$(FASTR_R_HOME)/include`. _Patched files_: - * `Rinternals.h`, `Rinterface.h`, `Rconfig.h` and `R_ext/GraphicsEngine.h` using `mx.fastr/mx_fastr_edinclude.py` + * `Rinternals.h`, `Rinterface.h`, `Rconfig.h` (generated) and `R_ext/GraphicsEngine.h` using `mx.fastr/mx_fastr_edinclude.py` + +_Other required sources_: + * `$(GNUR_HOME)/include/*.h`, `$(GNUR_HOME)/include/R_ext/*.h` ### Building `fficall` @@ -128,7 +130,7 @@ The `FASTR_RFFI` variable controls which version of FFI is build: `managed` (i.e The `common` part is built (see `common/Makefile`) prior to handing over the control to the corresponding FFI subdirectory (except the `managed` FFI). -Then the dynamic library `libR` is built from the artifacts created in the previous steps. +Then the dynamic library `libR` is built from the object files made in the previous step, which are stored into `lib`. The `libjniboot` is built only when `FASTR_RFFI` is `jni` by invoking `jniboot/Makefile`. @@ -137,7 +139,7 @@ using `install_name_tool`. Also the paths of `libpcre` and `libz` are updated us #### Building `common` FFI -This builds selected GNUR files and local overrides (*.c and *.f): +This builds selected GNUR files and local overrides (`*.c` and `*.f`): * compiles the selected `main` and `appl` C sources in `$(GNUR_HOME)/src/main` and `$(GNUR_HOME)/src/appl` * main: `colors.c devices.c engine.c format.c graphics.c plot.c plot3d.c plotmath.c rlocale.c sort.c` @@ -150,6 +152,11 @@ just copied from GNUR. The subset is selected using the pattern `$(GNUR_APPL_SRC * `../include/gnurheaders.mk` is included to define `GNUR_HEADER_DEFS` consisting of headers that we refer to indirectly * all objects are compiled into `../../lib` (i.e. `fficall/lib`) +_Other required sources_: + + * From `$(GNUR_HOME)/src/main`: `colors.c, devices.c, engine.c, format.c, graphics.c, plot.c, plot3d.c, plotmath.c, rlocale.c, sort.c` + * From `$(GNUR_HOME)/src/appl`: `pretty.c, interv.c, d*.f` (currently not built, just copied the corresponding object files) + #### Building `llvm` FFI It does pretty much the same thing as the `common` FFI build. In addition to that it: @@ -176,7 +183,7 @@ Analogous to the `llvm` and `nfi` builds, except it: The functions in `jniboot` sources, while defined in `JNI_Base` are stored in a seperate library, `jniboot`, in order to be able to bootstrap the system as `libR` has to be loaded using these functions. -* `dlopen, dlsym, dlclose` +* Exported functions: `dlopen, dlsym, dlclose` ### Building `library` @@ -186,47 +193,111 @@ The `Makefile` just delegates the process to the individual subdirectories. The `lib.mk` file is included into the package makefiles. It contains the common logic for all subordinate package builds. This common logic consists of copying the original -GNUR library files to the FastR library directory. It also defines a couple of extension targets +GNUR library (binary) files to the FastR library directory. It also defines a couple of extension targets `LIB_PKG_PRE`, `LIB_PKG` and `LIB_PKG_POST`, `CLEAN_PKG` that are overridden by the package makefiles. +Individual packages may define their own source files in the package home directory as well as select some sources from the original +GNUR package (via `GNUR_C_OBJECTS` and `GNUR_C_OBJECTS` variables). Those sources are then compiled and linked into the corresponding dynamic library (`<package>.so`). +Finally and optionally (Darwin, non-LLVM), the library is installed using the system tools. #### Package `base` +In the pre-build stage, it changes GnuR's build script `makebasedb.R` so that it does not +compress the lazy load database, then it (re)builds GnuR. The original `makebasedb.R` is +saved to `makebasedb.R.tmp`, which is reused in the post-build stage. + +In the post-build stage, the R script `$(FASTR_R_HOME)R/base` is patched and `makebasedb.R` +is restored from the copy (`$(GNUR_HOME)/src/library/base/makebasedb.R`). Then, the GNUR +is rebuilt to undo the changes made by the auxiliary GNUR build in the pre-build stage. + _Patched files_: * `$(GNUR_HOME)/src/library/base/makebasedb.R` using `sed 's|compress = TRUE|compress = FALSE|g'` * the generated file `R/base.R` +#### Package `graphics` + +_Other required sources_: + + * The headers reachable from `$(GNUR_HOME)/src/library/graphics` + * C sources from `$(GNUR_HOME)/src/library/graphics/src`: `base.c, graphics.c, init.c, par.c, plot.c, plot3d.c, stem.c` + * The headers defined in `fficall/src/include/gnurheaders.mk` + +#### Package `grDevices` + +_Other required sources_: + + * The header files reachable from `$(GNUR_HOME)/src/library/grDevices` + * `$(GNUR_HOME)/src/main/gzio.h` + * All Cairo C sources: `$(GNUR_HOME)/src/library/grDevices/src/cairo/*.c` + * Other C sources from `$(GNUR_HOME)/src/library/grDevices/src`: `axis_scales.c, chull.c, colors.c, devCairo.c, devPS.c, devPicTeX.c, devQuartz.c, devices.c, init.c, stubs.c` + * The headers defined in `fficall/src/include/gnurheaders.mk` + #### Package `grid` _Patched files_: * `grid.c`, `state.c` using sed (`sed_grid`, `sed_state`) +_Other required sources_: + + * `grid.h` + * `gpar.c, just.c, layout.c, matrix.c, register.c, unit.c, util.c, viewport.c` + +#### Package `methods` + +_Other required sources_: + + * `init.c` + * `methods.h` + #### Package `parallel` _Patched files_: * `glpi.h`, `rngstream.c` maintained in git +_Other required sources_: + + * `init.c` + * `parallel.h` + #### Package `splines` _Patched files_: * `splines.c` maintained in git -#### Building `stats` +#### Package `stats` _Patched files_: * `fft.c` using `ed_fft` * `modreg.h`, `nls.h`, `port.h`, `stats.h`, `ts.h` maintained in git -#### Building `tools` +_Other required sources_: + + * Fortan sources: `bsplvd.f, bvalue.f, bvalus.f, eureka.f, hclust.f, kmns.f, lminfl.f, loessf.f, ppr.f, qsbart.f, sgram.f, sinerp.f, sslvrg.f, stl.f, stxwx.f` + * C sources: `init.c, isoreg.c, kmeans.c, loessc.c, monoSpl.c, sbart.c` + * All headers + +#### Package `tools` _Patched files_: * `gramRd.c` using `mx.fastr/mx_fastr_mkgramrd.py` +_Other required sources_: + + * `init.c` + * `tools.h` + +#### Package `utils` + +_Other required sources_: + + * `init.c` + * `utils.h` + ### Building `run` This build prepares the FastR directory structure mimicking that of GNUR. It creates and @@ -242,16 +313,27 @@ See `run/Makefile` for more info. _Patched files_: - * `$(GNUR_HOME)/bin/R`, `$(GNUR_HOME)/etc/Renviron`, `$(GNUR_HOME)/etc/Makeconf` + * `$(GNUR_HOME)/bin/R`, `$(GNUR_HOME)/etc/Renviron`, `$(GNUR_HOME)/etc/Makeconf` (all generated) -## Building recommended packages +_Other required sources_: + + * `$(GNUR_HOME)/etc/Makeconf` (generated by `configure`) (becomes local `Makeconf.etc`) + * `$(GNUR_HOME)/etc/javaconf` (generated by `configure`) + * `$(GNUR_HOME)/etc/repositories` (generated by `configure`) + * `$(GNUR_HOME)/etc/ldpaths` (generated by `configure`) + * `$(GNUR_HOME)/doc/*` (processed by `configure`) + * From `$(GNUR_HOME)/share/`: directories `R, Rd, make, java, encodings` + +## Installing recommended packages Note: This build resides in a separate project: `com.oracle.truffle.r.native.recommended`. -It builds the `recommended` packages that are bundled with GNU R. It has to be built separately +It installs the `recommended` packages that are bundled with GNU R. It has to be built separately from the native project that contains the packages because that is built first and before FastR is completely built. +The command used to install a package: `$(FASTR_R_HOME)/bin/R CMD INSTALL --library=$(FASTR_R_HOME)/library $$pkgtar;` + As this takes quite a while the building is conditional on the `FASTR_RELEASE` environment variable. N.B. this flag is not set for "normal" FastR gate builds defined in `ci.hocon`. It is set only in the post-merge "stories" build defined in `ci.overlays/fastr.hocon` @@ -261,6 +343,24 @@ N.B. this flag is not set for "normal" FastR gate builds defined in `ci.hocon`. *Â `$(NATIVE_PROJECT_DIR)/platform.mk` is included * Weak symbol refs used (i.e. `-undefined dynamic_lookup`) so that `libR.dylib` (which loads the package libraries) does not have to be specified when building the package +## Refactoring of the build process + +The pre-generated `configure` script must be patched to include only the following targets: + + * `ac_config_files="Makeconf doc/Makefile doc/html/Makefile doc/manual/Makefile etc/Makefile etc/Makeconf etc/Renviron etc/javaconf etc/ldpaths src/include/Makefile src/include/Rmath.h0 src/include/R_ext/Makefile src/scripts/mkinstalldirs share/Makefile"` + +#### Making the R includes: + * Run `configure` + * Run `make -C src/include` + +TODO: + +_Other required sources_: + + * The pre-generated `$(GNUR_HOME)/configure` + * `$(GNUR_HOME)/src/include`, `$(GNUR_HOME)/tools`, `$(GNUR_HOME)/etc`, `$(GNUR_HOME)/tools`, `$(GNUR_HOME)/doc`, `$(GNUR_HOME)/share` + * `$(GNUR_HOME)/VERSION`, `$(GNUR_HOME)/SVN-VERSION`, `$(GNUR_HOME)/VERSION-NICK` + ## Notes on building GNUR on Darwin: * export `PKG_LDFLAGS_OVERRIDE="-L/usr/local/lib -L/usr/local/opt/zlib/lib"` * needed to create the symbolic link `gcc_s`: `ln -s /usr/local/gfortran/lib/libgcc_s_x86_64.1.dylib /usr/local/lib/libgcc_s.dylib`