+2005-05-10 Tobias Schl"uter <tobias.schlueter@physik.uni-muenchen.de>
+
+ PR fortran/20178
+ * gfortran.h (gfc_option): Add flag_f2c.
+ * invoke.texi: Document '-ff2c' command line option. Adapt
+ documentation for '-fno-second-underscore' and '-fno-underscoring'.
+ * lang.opt (ff2c): New entry.
+ * options.c (gfc-init_options): Set default calling convention
+ to -fno-f2c. Mark -fsecond-underscore unset.
+ (gfc_post_options): Set -fsecond-underscore if not explicitly set
+ by user.
+ (handle_options): Set gfc_option.flag_f2c according to requested
+ calling convention.
+ * trans-decl.c (gfc_get_extern_function_decl): Use special f2c
+ intrinsics where necessary.
+ (gfc_trans_deferred_vars): Change todo error to assertion.
+ * trans-expr.c (gfc_conv_variable): Dereference access
+ to hidden result argument.
+ (gfc_conv_function_call): Add hidden result argument to argument
+ list if f2c calling conventions requested. Slightly restructure
+ tests. Convert result of default REAL function to requested type
+ if f2c calling conventions are used. Dereference COMPLEX result
+ if f2c cc are used.
+ * trans-types.c (gfc_sym_type): Return double for default REAL
+ function if f2c cc are used.
+ (gfc_return_by_reference): Slightly restructure logic. Return
+ COMPLEX by reference depending on calling conventions.
+ (gfc_get_function_type): Correctly make hidden result argument a
+ pass-by-reference argument for COMPLEX. Remove old code which does
+ this for derived types.
+
2005-05-09 Tobias Schl"uter <tobias.schlueter@physik.uni-muenchen.de>
* match.c (gfc_match_return): Only require space after keyword when
int flag_no_backend;
int flag_pack_derived;
int flag_repack_arrays;
+ int flag_f2c;
int q_kind;
@item Code Generation Options
@xref{Code Gen Options,,Options for Code Generation Conventions}.
@gccoptlist{
--fno-underscoring -fno-second-underscore @gol
+-ff2c -fno-underscoring -fsecond-underscore @gol
-fbounds-check -fmax-stack-var-size=@var{n} @gol
-fpackderived -frepack-arrays}
@end table
@table @gcctabopt
-@cindex -fno-underscoring option
-@cindex options, -fno-underscoring
+@cindex @option{-ff2c} option
+@cindex options, @option{-ff2c}
+@item -ff2c
+@cindex calling convention
+@cindex @command{f2c} calling convention
+@cindex @command{g77} calling convention
+@cindex libf2c calling convention
+Generate code designed to be compatible with code generated
+by @command{g77} and @command{f2c}.
+
+The calling conventions used by @command{g77} (originally implemented
+in @command{f2c}) require functions that return type
+default @code{REAL} to actually return the C type @code{double}, and
+functions that return type @code{COMPLEX} to return the values via an
+extra argument in the calling sequence that points to where to
+store the return value. Under the default GNU calling conventions, such
+functions simply return their results as they would in GNU
+C -- default @code{REAL} functions return the C type @code{float}, and
+@code{COMPLEX} functions return the GNU C type @code{complex}.
+Additionally, this option implies the @options{-fsecond-underscore}
+option, unless @options{-fno-second-underscore} is explicitly requested.
+
+This does not affect the generation of code that interfaces with
+the @command{libgfortran} library.
+
+@emph{Caution:} It is not a good idea to mix Fortran code compiled
+with @code{-ff2c} with code compiled with the default @code{-fno-f2c}
+calling conventions as, calling @code{COMPLEX} or default @code{REAL}
+functions between program parts which were compiled with different
+calling conventions will break at execution time.
+
+@emph{Caution:} This will break code which passes intrinsic functions
+of type default @code{REAL} or @code{COMPLEX} as actual arguments, as
+the library implementations use the @command{-fno-f2c} calling conventions.
+
+@cindex @option{-fno-underscoring option}
+@cindex options, @option{-fno-underscoring}
@item -fno-underscoring
@cindex underscore
@cindex symbol names, underscores
Do not transform names of entities specified in the Fortran
source file by appending underscores to them.
-With @option{-funderscoring} in effect, @command{gfortran} appends two
-underscores to names with underscores and one underscore to external names
-with no underscores. (@command{gfortran} also appends two underscores to
-internal names with underscores to avoid naming collisions with external
-names. The @option{-fno-second-underscore} option disables appending of the
-second underscore in all cases.)
+With @option{-funderscoring} in effect, @command{gfortran} appends one
+underscore to external names with no underscores.
This is done to ensure compatibility with code produced by many
-UNIX Fortran compilers, including @command{f2c} which perform the
-same transformations.
+UNIX Fortran compilers.
+
+@emph{Caution}: The default behavior of @command{gfortran} is
+incompatible with @command{f2c} and @command{g77}, please use the
+@option{-ff2c} and @option{-fsecond-underscore} options if you want
+object files compiled with @option{gfortran} to be compatible with
+object code created with these tools.
Use of @option{-fno-underscoring} is not recommended unless you are
experimenting with issues such as integration of (GNU) Fortran into
prevent accidental linking between procedures with incompatible
interfaces.
-@cindex -fno-second-underscore option
-@cindex options, -fno-second-underscore
-@item -fno-second-underscore
+@cindex @option{-fsecond-underscore option}
+@cindex options, @option{-fsecond-underscore}
+@item -fsecond-underscore
@cindex underscore
@cindex symbol names, underscores
@cindex transforming symbol names
@cindex symbol names, transforming
-Do not append a second underscore to names of entities specified
-in the Fortran source file.
+@cindex @command{f2c} calling convention
+@cindex @command{g77} calling convention
+@cindex libf2c calling convention
+By default, @command{gfortran} appends an underscore to external
+names. If this option is used @command{gfortran} appends two
+underscores to names with underscores and one underscore to external names
+with no underscores. (@command{gfortran} also appends two underscores to
+internal names with underscores to avoid naming collisions with external
+names.
This option has no effect if @option{-fno-underscoring} is
-in effect.
+in effect. It is implied by the @option{-ff2c} option.
Otherwise, with this option, an external name such as @samp{MAX_COUNT}
is implemented as a reference to the link-time external symbol
-@samp{max_count_}, instead of @samp{max_count__}.
+@samp{max_count__}, instead of @samp{max_count_}. This is required
+for compatibility with @command{g77} and @command{f2c}, and is implied
+by use of the @option{-ff2c} option.
@cindex -fbounds-check option
F95
Display the code tree after parsing.
+ff2c
+F95
+Use f2c calling convention.
+
ffixed-form
F95
Assume that the source file is fixed form
gfc_option.flag_default_real = 0;
gfc_option.flag_dollar_ok = 0;
gfc_option.flag_underscoring = 1;
- gfc_option.flag_second_underscore = 1;
+ gfc_option.flag_f2c = 0;
+ gfc_option.flag_second_underscore = -1;
gfc_option.flag_implicit_none = 0;
gfc_option.flag_max_stack_var_size = 32768;
gfc_option.flag_module_access_private = 0;
if (pedantic && (gfc_option.allow_std & GFC_STD_GNU) != 0)
gfc_option.warn_std |= GFC_STD_GNU;
+ /* If the user didn't explicitly specify -f(no)-second-underscore we
+ use it if we're trying to be compatible with f2c, and not
+ otherwise. */
+ if (gfc_option.flag_second_underscore == -1)
+ gfc_option.flag_second_underscore = gfc_option.flag_f2c;
+
return false;
}
gfc_option.warn_unused_labels = value;
break;
+ case OPT_ff2c:
+ gfc_option.flag_f2c = value;
+ break;
+
case OPT_fdollar_ok:
gfc_option.flag_dollar_ok = value;
break;
gfc_expr e;
gfc_intrinsic_sym *isym;
gfc_expr argexpr;
- char s[GFC_MAX_SYMBOL_LEN];
+ char s[GFC_MAX_SYMBOL_LEN + 13]; /* "f2c_specific" and '\0'. */
tree name;
tree mangled_name;
gcc_assert (isym->formal->next->next == NULL);
isym->resolve.f2 (&e, &argexpr, NULL);
}
- sprintf (s, "specific%s", e.value.function.name);
+
+ if (gfc_option.flag_f2c
+ && ((e.ts.type == BT_REAL && e.ts.kind == gfc_default_real_kind)
+ || e.ts.type == BT_COMPLEX))
+ {
+ /* Specific which needs a different implementation if f2c
+ calling conventions are used. */
+ sprintf (s, "f2c_specific%s", e.value.function.name);
+ }
+ else
+ sprintf (s, "specific%s", e.value.function.name);
+
name = get_identifier (s);
mangled_name = name;
}
fnbody = gfc_trans_dummy_character (proc_sym->ts.cl, fnbody);
}
else
- gfc_todo_error ("Deferred non-array return by reference");
+ gcc_assert (gfc_option.flag_f2c
+ && proc_sym->ts.type == BT_COMPLEX);
}
for (sym = proc_sym->tlink; sym != proc_sym; sym = sym->tlink)
&& !sym->attr.dimension)
se->expr = gfc_build_indirect_ref (se->expr);
+ /* Dereference scalar hidden result. */
+ if (gfc_option.flag_f2c
+ && (sym->attr.function || sym->attr.result)
+ && sym->ts.type == BT_COMPLEX
+ && !sym->attr.dimension)
+ se->expr = gfc_build_indirect_ref (se->expr);
+
/* Dereference pointer variables. */
if ((sym->attr.pointer || sym->attr.allocatable)
&& (sym->attr.dummy
convert (gfc_charlen_type_node, len));
}
else
- gcc_unreachable ();
+ {
+ gcc_assert (gfc_option.flag_f2c && sym->ts.type == BT_COMPLEX);
+
+ type = gfc_get_complex_type (sym->ts.kind);
+ var = gfc_build_addr_expr (NULL, gfc_create_var (type, "cmplx"));
+ arglist = gfc_chainon_list (arglist, var);
+ }
}
formal = sym->formal;
se->expr = build3 (CALL_EXPR, TREE_TYPE (fntype), se->expr,
arglist, NULL_TREE);
+ if (sym->result)
+ sym = sym->result;
+
/* If we have a pointer function, but we don't want a pointer, e.g.
something like
x = f()
where f is pointer valued, we have to dereference the result. */
- if (!se->want_pointer && !byref
- && (sym->attr.pointer || (sym->result && sym->result->attr.pointer)))
+ if (!se->want_pointer && !byref && sym->attr.pointer)
se->expr = gfc_build_indirect_ref (se->expr);
+ /* f2c calling conventions require a scalar default real function to
+ return a double precision result. Convert this back to default
+ real. We only care about the cases that can happen in Fortran 77.
+ */
+ if (gfc_option.flag_f2c && sym->ts.type == BT_REAL
+ && sym->ts.kind == gfc_default_real_kind
+ && !sym->attr.always_explicit)
+ se->expr = fold_convert (gfc_get_real_type (sym->ts.kind), se->expr);
+
/* A pure function may still have side-effects - it may modify its
parameters. */
TREE_SIDE_EFFECTS (se->expr) = 1;
se->string_length = len;
}
else
- gcc_unreachable ();
+ {
+ gcc_assert (sym->ts.type == BT_COMPLEX && gfc_option.flag_f2c);
+ se->expr = gfc_build_indirect_ref (var);
+ }
}
}
}
sym = sym->result;
type = gfc_typenode_for_spec (&sym->ts);
+ if (gfc_option.flag_f2c
+ && sym->attr.function
+ && sym->ts.type == BT_REAL
+ && sym->ts.kind == gfc_default_real_kind
+ && !sym->attr.always_explicit)
+ {
+ /* Special case: f2c calling conventions require that (scalar)
+ default REAL functions return the C type double instead. */
+ sym->ts.kind = gfc_default_double_kind;
+ type = gfc_typenode_for_spec (&sym->ts);
+ sym->ts.kind = gfc_default_real_kind;
+ }
if (sym->attr.dummy && !sym->attr.function)
byref = 1;
int
gfc_return_by_reference (gfc_symbol * sym)
{
+ gfc_symbol *result;
+
if (!sym->attr.function)
return 0;
- if (sym->result)
- sym = sym->result;
+ result = sym->result ? sym->result : sym;
- if (sym->attr.dimension)
+ if (result->attr.dimension)
return 1;
- if (sym->ts.type == BT_CHARACTER)
+ if (result->ts.type == BT_CHARACTER)
return 1;
- /* Possibly return complex numbers by reference for g77 compatibility. */
+ /* Possibly return complex numbers by reference for g77 compatibility.
+ We don't do this for calls to intrinsics (as the library uses the
+ -fno-f2c calling convention), nor for calls to functions which always
+ require an explicit interface, as no compatibility problems can
+ arise there. */
+ if (gfc_option.flag_f2c
+ && result->ts.type == BT_COMPLEX
+ && !sym->attr.intrinsic && !sym->attr.always_explicit)
+ return 1;
+
return 0;
}
\f
gfc_conv_const_charlen (arg->ts.cl);
type = gfc_sym_type (arg);
- if (arg->ts.type == BT_DERIVED
+ if (arg->ts.type == BT_COMPLEX
|| arg->attr.dimension
|| arg->ts.type == BT_CHARACTER)
type = build_reference_type (type);
+2005-05-10 Tobias Schl"uter <tobias.schlueter@physik.uni-muenchen.de>
+
+ PR fortran/20178
+ * gfortran.dg/f2c_1.f90, gfortran.dg/f2c_2.f90,
+ gfortran.dg/f2c_3.f90: New tests.
+
2005-05-10 Diego Novillo <dnovillo@redhat.com>
* gcc.c-torture/compile/20050510-1.c: New test.
--- /dev/null
+! Make sure the f2c calling conventions work
+! { dg-do run }
+! { dg-options "-ff2c" }
+
+function f(x)
+ f = x
+end function f
+
+complex function c(a,b)
+ c = cmplx (a,b)
+end function c
+
+double complex function d(e,f)
+ double precision e, f
+ d = cmplx (e, f, kind(d))
+end function d
+
+subroutine test_with_interface()
+ interface
+ real function f(x)
+ real::x
+ end function f
+ end interface
+
+ interface
+ complex function c(a,b)
+ real::a,b
+ end function c
+ end interface
+
+ interface
+ double complex function d(e,f)
+ double precision::e,f
+ end function d
+ end interface
+
+ double precision z, w
+
+ x = 8.625
+ if (x /= f(x)) call abort ()
+ y = f(x)
+ if (x /= y) call abort ()
+
+ a = 1.
+ b = -1.
+ if (c(a,b) /= cmplx(a,b)) call abort ()
+
+ z = 1.
+ w = -1.
+ if (d(z,w) /= cmplx(z,w, kind(z))) call abort ()
+end subroutine test_with_interface
+
+external f, c, d
+real f
+complex c
+double complex d
+double precision z, w
+
+x = 8.625
+if (x /= f(x)) call abort ()
+y = f(x)
+if (x /= y) call abort ()
+
+a = 1.
+b = -1.
+if (c(a,b) /= cmplx(a,b)) call abort ()
+
+z = 1.
+w = -1.
+if (d(z,w) /= cmplx(z,w, kind(z))) call abort ()
+
+call test_with_interface ()
+end
--- /dev/null
+! Some basic testing that calls to the library still work correctly with
+! -ff2c
+!
+! Once the library has support for f2c calling conventions (i.e. passing
+! a REAL*4 or COMPLEX-valued intrinsic as procedure argument works), we
+! can simply add -ff2c to the list of options to cycle through, and get
+! complete coverage. As of 2005-03-05 this doesn't work.
+! { dg-do run }
+! { dg-options "-ff2c" }
+
+complex c
+double complex d
+
+x = 2.
+if ((sqrt(x) - 1.41)**2 > 1.e-4) call abort ()
+x = 1.
+if ((atan(x) - 3.14/4) ** 2 > 1.e-4) call abort ()
+c = (-1.,0.)
+if (sqrt(c) /= (0., 1.)) call abort ()
+d = c
+if (sqrt(d) /= (0._8, 1._8)) call abort ()
+end
+
--- /dev/null
+! { dg-do run }
+! { dg-options "-ff2c" }
+! Verifies that internal functions are not broken by f2c calling conventions
+program test
+ real, target :: f
+ real, pointer :: q
+ real :: g
+ f = 1.0
+ q=>f
+ g = foo(q)
+ if (g .ne. 1.0) call abort
+contains
+function foo (p)
+ real, pointer :: foo
+ real, pointer :: p
+ foo => p
+end function
+end program
+2005-05-10 Tobias Schl"uter <tobias.schlueter@physik.uni-muenchen.de>
+
+ PR fortran/20178
+ * Makefile.am (gfor_specific_src): Add 'intrinsics/f2c_intrinsics.F90'
+ to dependencies.
+ * Makefile.in: Regenerate.
+ * intrinsics/f2c_specific.F90: New file.
+
2005-05-10 Francois-Xavier Coudert <coudert@clipper.ens.fr>
PR libfortran/20788
gfor_specific_src= \
$(gfor_built_specific_src) \
$(gfor_built_specific2_src) \
-intrinsics/dprod_r8.f90
+intrinsics/dprod_r8.f90 \
+intrinsics/f2c_specifics.F90
gfor_cmath_src= $(gfor_math_trig_c) $(gfor_math_exp_c) $(gfor_math_hyp_c)
gfor_cmath_obj= $(gfor_math_trig_obj) $(gfor_math_exp_obj) \
-# Makefile.in generated by automake 1.9.4 from Makefile.am.
+# Makefile.in generated by automake 1.9.2 from Makefile.am.
# @configure_input@
# Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002,
build_triplet = @build@
host_triplet = @host@
target_triplet = @target@
-DIST_COMMON = README $(am__configure_deps) $(srcdir)/../config.guess \
+DIST_COMMON = $(am__configure_deps) $(srcdir)/../config.guess \
$(srcdir)/../config.sub $(srcdir)/../install-sh \
$(srcdir)/../ltmain.sh $(srcdir)/../missing \
$(srcdir)/../mkinstalldirs $(srcdir)/Makefile.am \
$(srcdir)/Makefile.in $(srcdir)/config.h.in \
- $(top_srcdir)/configure AUTHORS COPYING ChangeLog INSTALL NEWS
+ $(top_srcdir)/configure ChangeLog
subdir = .
ACLOCAL_M4 = $(top_srcdir)/aclocal.m4
am__aclocal_m4_deps = $(top_srcdir)/acinclude.m4 \
am__objects_36 = _sign_i4.lo _sign_i8.lo _sign_r4.lo _sign_r8.lo \
_dim_i4.lo _dim_i8.lo _dim_r4.lo _dim_r8.lo _atan2_r4.lo \
_atan2_r8.lo _mod_i4.lo _mod_i8.lo _mod_r4.lo _mod_r8.lo
-am__objects_37 = $(am__objects_35) $(am__objects_36) dprod_r8.lo
+am__objects_37 = $(am__objects_35) $(am__objects_36) dprod_r8.lo \
+ f2c_specifics.lo
am_libgfortran_la_OBJECTS = $(am__objects_1) $(am__objects_31) \
$(am__objects_32) $(am__objects_33) $(am__objects_34) \
$(am__objects_37)
DEFAULT_INCLUDES = -I. -I$(srcdir) -I.
depcomp =
am__depfiles_maybe =
+PPFCCOMPILE = $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) \
+ $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS)
+LTPPFCCOMPILE = $(LIBTOOL) --mode=compile $(FC) $(DEFS) \
+ $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) \
+ $(AM_FCFLAGS) $(FCFLAGS)
+FCLD = $(FC)
+FCLINK = $(LIBTOOL) --mode=link $(FCLD) $(AM_FFLAGS) $(FCFLAGS) \
+ $(AM_LDFLAGS) $(LDFLAGS) -o $@
COMPILE = $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) \
$(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS)
LTCOMPILE = $(LIBTOOL) --mode=compile $(CC) $(DEFS) \
$(AM_LDFLAGS) $(LDFLAGS) -o $@
FCCOMPILE = $(FC) $(AM_FCFLAGS) $(FCFLAGS)
LTFCCOMPILE = $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS)
-FCLD = $(FC)
-FCLINK = $(LIBTOOL) --mode=link $(FCLD) $(AM_FCFLAGS) $(FCFLAGS) \
- $(AM_LDFLAGS) $(LDFLAGS) -o $@
SOURCES = $(libgfortran_la_SOURCES) $(EXTRA_libgfortran_la_SOURCES) \
$(libgfortranbegin_la_SOURCES)
DIST_SOURCES = $(libgfortran_la_SOURCES) \
gfor_specific_src = \
$(gfor_built_specific_src) \
$(gfor_built_specific2_src) \
-intrinsics/dprod_r8.f90
+intrinsics/dprod_r8.f90 \
+intrinsics/f2c_specifics.F90
gfor_cmath_src = $(gfor_math_trig_c) $(gfor_math_exp_c) $(gfor_math_hyp_c)
gfor_cmath_obj = $(gfor_math_trig_obj) $(gfor_math_exp_obj) \
$(MAKE) $(AM_MAKEFLAGS) all-am
.SUFFIXES:
-.SUFFIXES: .c .f90 .lo .o .obj
+.SUFFIXES: .F90 .c .f90 .lo .o .obj
am--refresh:
@:
$(srcdir)/Makefile.in: @MAINTAINER_MODE_TRUE@ $(srcdir)/Makefile.am $(am__configure_deps)
distclean-compile:
-rm -f *.tab.c
+.F90.o:
+ $(PPFCCOMPILE) -c -o $@ $<
+
+.F90.obj:
+ $(PPFCCOMPILE) -c -o $@ `$(CYGPATH_W) '$<'`
+
+.F90.lo:
+ $(LTPPFCCOMPILE) -c -o $@ $<
+
+f2c_specifics.lo: intrinsics/f2c_specifics.F90
+ $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o f2c_specifics.lo `test -f 'intrinsics/f2c_specifics.F90' || echo '$(srcdir)/'`intrinsics/f2c_specifics.F90
+
.c.o:
$(COMPILE) -c $<
-# generated automatically by aclocal 1.9.4 -*- Autoconf -*-
+# generated automatically by aclocal 1.9.2 -*- Autoconf -*-
# Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004
# Free Software Foundation, Inc.
# Call AM_AUTOMAKE_VERSION so it can be traced.
# This function is AC_REQUIREd by AC_INIT_AUTOMAKE.
AC_DEFUN([AM_SET_CURRENT_AUTOMAKE_VERSION],
- [AM_AUTOMAKE_VERSION([1.9.4])])
+ [AM_AUTOMAKE_VERSION([1.9.2])])
# AM_AUX_DIR_EXPAND
--- /dev/null
+! Copyright 2002, 2005 Free Software Foundation, Inc.
+! Contributed by Tobias Schl"uter
+!
+!This file is part of the GNU Fortran 95 runtime library (libgfortran).
+!
+!GNU libgfortran is free software; you can redistribute it and/or
+!modify it under the terms of the GNU General Public
+!License as published by the Free Software Foundation; either
+!version 2 of the License, or (at your option) any later version.
+
+!In addition to the permissions in the GNU General Public License, the
+!Free Software Foundation gives you unlimited permission to link the
+!compiled version of this file into combinations with other programs,
+!and to distribute those combinations without any restriction coming
+!from the use of this file. (The General Public License restrictions
+!do apply in other respects; for example, they cover modification of
+!the file, and distribution when not linked into a combine
+!executable.)
+!
+!GNU libgfortran is distributed in the hope that it will be useful,
+!but WITHOUT ANY WARRANTY; without even the implied warranty of
+!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+!GNU General Public License for more details.
+!
+!You should have received a copy of the GNU General Public
+!License along with libgfortran; see the file COPYING. If not,
+!write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+!Boston, MA 02111-1307, USA.
+!
+! Specifics for the intrinsics whose calling conventions change if
+! -ff2c is used.
+!
+! There are two annoyances WRT the preprocessor:
+! - we're using -traditional-cpp, so we can't use the ## operator.
+! - macros expand to a single line, and Fortran lines can't be wider
+! than 132 characters, therefore we use two macros to split the lines
+!
+! The cases we need to implement are functions returning default REAL
+! or COMPLEX. The former need to return DOUBLE PRECISION instead of REAL,
+! the latter become subroutines returning via a hidden first argument.
+
+! one argument functions
+#define REAL_HEAD(NAME) \
+elemental function f2c_specific__/**/NAME/**/_r4 (parm) result(res);
+
+#define REAL_BODY(NAME) \
+ REAL, intent (in) :: parm; \
+ DOUBLE PRECISION :: res; \
+ res = NAME (parm); \
+end function
+
+#define COMPLEX_HEAD(NAME) \
+subroutine f2c_specific__/**/NAME/**/_c4 (res, parm);
+
+#define COMPLEX_BODY(NAME) \
+ COMPLEX, intent (in) :: parm; \
+ COMPLEX, intent (out) :: res; \
+ res = NAME (parm); \
+end subroutine
+
+#define DCOMPLEX_HEAD(NAME) \
+subroutine f2c_specific__/**/NAME/**/_c8 (res, parm);
+
+#define DCOMPLEX_BODY(NAME) \
+ DOUBLE COMPLEX, intent (in) :: parm; \
+ DOUBLE COMPLEX, intent (out) :: res; \
+ res = NAME (parm); \
+end subroutine
+
+REAL_HEAD(abs)
+REAL_BODY(abs)
+! abs is special in that the result is real
+elemental function f2c_specific__abs_c4 (parm) result (res)
+ COMPLEX, intent(in) :: parm
+ DOUBLE PRECISION :: res
+ res = abs(parm)
+end function
+
+REAL_HEAD(exp)
+REAL_BODY(exp)
+COMPLEX_HEAD(exp)
+COMPLEX_BODY(exp)
+DCOMPLEX_HEAD(exp)
+DCOMPLEX_BODY(exp)
+
+REAL_HEAD(log)
+REAL_BODY(log)
+COMPLEX_HEAD(log)
+COMPLEX_BODY(log)
+DCOMPLEX_HEAD(log)
+DCOMPLEX_BODY(log)
+
+REAL_HEAD(log10)
+REAL_BODY(log10)
+
+REAL_HEAD(sqrt)
+REAL_BODY(sqrt)
+COMPLEX_HEAD(sqrt)
+COMPLEX_BODY(sqrt)
+DCOMPLEX_HEAD(sqrt)
+DCOMPLEX_BODY(sqrt)
+
+REAL_HEAD(asin)
+REAL_BODY(asin)
+
+REAL_HEAD(acos)
+REAL_BODY(acos)
+
+REAL_HEAD(atan)
+REAL_BODY(atan)
+
+REAL_HEAD(sin)
+REAL_BODY(sin)
+COMPLEX_HEAD(sin)
+COMPLEX_BODY(sin)
+DCOMPLEX_HEAD(sin)
+DCOMPLEX_BODY(sin)
+
+REAL_HEAD(cos)
+REAL_BODY(cos)
+COMPLEX_HEAD(cos)
+COMPLEX_BODY(cos)
+DCOMPLEX_HEAD(cos)
+DCOMPLEX_BODY(cos)
+
+REAL_HEAD(tan)
+REAL_BODY(tan)
+
+REAL_HEAD(sinh)
+REAL_BODY(sinh)
+
+REAL_HEAD(cosh)
+REAL_BODY(cosh)
+
+REAL_HEAD(tanh)
+REAL_BODY(tanh)
+
+COMPLEX_HEAD(conjg)
+COMPLEX_BODY(conjg)
+DCOMPLEX_HEAD(conjg)
+DCOMPLEX_BODY(conjg)
+
+REAL_HEAD(aint)
+REAL_BODY(aint)
+
+REAL_HEAD(anint)
+REAL_BODY(anint)
+
+! two argument functions
+#define REAL2_HEAD(NAME) \
+elemental function f2c_specific__/**/NAME/**/_r4 (p1, p2) result(res);
+
+#define REAL2_BODY(NAME) \
+ REAL, intent (in) :: p1, p2; \
+ DOUBLE PRECISION :: res; \
+ res = NAME (p1, p2); \
+end function
+
+REAL2_HEAD(sign)
+REAL2_BODY(sign)
+
+REAL2_HEAD(dim)
+REAL2_BODY(dim)
+
+REAL2_HEAD(atan2)
+REAL2_BODY(atan2)
+
+REAL2_HEAD(mod)
+REAL2_BODY(mod)
OSDN Git Service
