aboutsummaryrefslogtreecommitdiff
path: root/gcc
diff options
context:
space:
mode:
Diffstat (limited to 'gcc')
-rw-r--r--gcc/fortran/ChangeLog31
-rw-r--r--gcc/fortran/gfortran.h1
-rw-r--r--gcc/fortran/invoke.texi81
-rw-r--r--gcc/fortran/lang.opt4
-rw-r--r--gcc/fortran/options.c13
-rw-r--r--gcc/fortran/trans-decl.c18
-rw-r--r--gcc/fortran/trans-expr.c35
-rw-r--r--gcc/fortran/trans-types.c34
-rw-r--r--gcc/testsuite/ChangeLog6
-rw-r--r--gcc/testsuite/gfortran.dg/f2c_1.f9073
-rw-r--r--gcc/testsuite/gfortran.dg/f2c_2.f9023
-rw-r--r--gcc/testsuite/gfortran.dg/f2c_3.f9018
12 files changed, 305 insertions, 32 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 1210aab..ee08d1f 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,34 @@
+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
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 641e492..d17f388 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -1419,6 +1419,7 @@ typedef struct
int flag_no_backend;
int flag_pack_derived;
int flag_repack_arrays;
+ int flag_f2c;
int q_kind;
diff --git a/gcc/fortran/invoke.texi b/gcc/fortran/invoke.texi
index 22f20dc..5385bba 100644
--- a/gcc/fortran/invoke.texi
+++ b/gcc/fortran/invoke.texi
@@ -143,7 +143,7 @@ by type. Explanations are in the following sections.
@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
@@ -518,8 +518,43 @@ it.
@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
@@ -528,16 +563,17 @@ it.
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
@@ -593,22 +629,31 @@ in the source, even if the names as seen by the linker are mangled to
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
diff --git a/gcc/fortran/lang.opt b/gcc/fortran/lang.opt
index 645b3e9..d1ca5f0 100644
--- a/gcc/fortran/lang.opt
+++ b/gcc/fortran/lang.opt
@@ -89,6 +89,10 @@ fdump-parse-tree
F95
Display the code tree after parsing.
+ff2c
+F95
+Use f2c calling convention.
+
ffixed-form
F95
Assume that the source file is fixed form
diff --git a/gcc/fortran/options.c b/gcc/fortran/options.c
index 21fb0a8..2603caa 100644
--- a/gcc/fortran/options.c
+++ b/gcc/fortran/options.c
@@ -62,7 +62,8 @@ gfc_init_options (unsigned int argc ATTRIBUTE_UNUSED,
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;
@@ -113,6 +114,12 @@ gfc_post_options (const char **pfilename)
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;
}
@@ -214,6 +221,10 @@ gfc_handle_option (size_t scode, const char *arg, int value)
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;
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index d5075b9..3d89eff 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -901,7 +901,7 @@ gfc_get_extern_function_decl (gfc_symbol * sym)
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;
@@ -937,7 +937,18 @@ gfc_get_extern_function_decl (gfc_symbol * sym)
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;
}
@@ -2030,7 +2041,8 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, tree fnbody)
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)
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index caf3d75..35c3f12 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -362,6 +362,13 @@ gfc_conv_variable (gfc_se * se, gfc_expr * expr)
&& !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
@@ -1138,7 +1145,13 @@ gfc_conv_function_call (gfc_se * se, gfc_symbol * sym,
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;
@@ -1240,14 +1253,25 @@ gfc_conv_function_call (gfc_se * se, gfc_symbol * sym,
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;
@@ -1282,7 +1306,10 @@ gfc_conv_function_call (gfc_se * se, gfc_symbol * sym,
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);
+ }
}
}
}
diff --git a/gcc/fortran/trans-types.c b/gcc/fortran/trans-types.c
index d63917a..b2c5169 100644
--- a/gcc/fortran/trans-types.c
+++ b/gcc/fortran/trans-types.c
@@ -1272,6 +1272,18 @@ gfc_sym_type (gfc_symbol * sym)
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;
@@ -1453,19 +1465,29 @@ gfc_get_derived_type (gfc_symbol * derived)
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;
}
@@ -1551,7 +1573,7 @@ gfc_get_function_type (gfc_symbol * sym)
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);
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 55363ea..7065773 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,9 @@
+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.
diff --git a/gcc/testsuite/gfortran.dg/f2c_1.f90 b/gcc/testsuite/gfortran.dg/f2c_1.f90
new file mode 100644
index 0000000..9f45d05
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/f2c_1.f90
@@ -0,0 +1,73 @@
+! 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
diff --git a/gcc/testsuite/gfortran.dg/f2c_2.f90 b/gcc/testsuite/gfortran.dg/f2c_2.f90
new file mode 100644
index 0000000..82ab5f0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/f2c_2.f90
@@ -0,0 +1,23 @@
+! 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
+
diff --git a/gcc/testsuite/gfortran.dg/f2c_3.f90 b/gcc/testsuite/gfortran.dg/f2c_3.f90
new file mode 100644
index 0000000..6854457
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/f2c_3.f90
@@ -0,0 +1,18 @@
+! { 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
generated by cgit v1.1 at 2025-06-04 13:12:10 +0000