This is the mail archive of the gcc-patches@gcc.gnu.org mailing list for the GCC project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]
Other format: [Raw text]

[gfortran, committed] Backport f2c calling conventions to 4.0


I've committed the patch for f2c calling conventions together with the
followup fix from <http://gcc.gnu.org/ml/fortran/2005-05/msg00116.html> to the
4.0 branch.  I had intended to wait for the approval of the patch from
<http://gcc.gnu.org/ml/fortran/2005-05/msg00117.html>, but since the first
4.0.1 prerelease is scheduled for Friday (*) I decided to commit this
important functionality even though it's not in its cleanest form this way.
The patch for the remaining cleanup has been waiting for review long enough
that I assume that noone considers it important.

Bubblestrapped and regtested on i686-pc-linux, diff attached.

- Tobi

(*) http://gcc.gnu.org/ml/gcc/2005-05/msg01466.html
? build
? gcc/semantic.cache
? gcc/fortran/head.diff
? gcc/fortran/semantic.cache
? libgfortran/head.diff
? libgfortran/io/semantic.cache
Index: gcc/fortran/ChangeLog
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/ChangeLog,v
retrieving revision 1.335.2.61
diff -c -3 -p -r1.335.2.61 ChangeLog
*** gcc/fortran/ChangeLog	1 Jun 2005 10:13:19 -0000	1.335.2.61
--- gcc/fortran/ChangeLog	1 Jun 2005 22:43:14 -0000
***************
*** 1,3 ****
--- 1,36 ----
+ 2005-06-01  Tobias Schl"uter  <tobias.schlueter@physik.uni-muenchen.de>
+ 
+ 	* 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 and -fno-second-underscore.
+ 	(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.
+ 
+ 	* resolve.c (resolve_symbol): Copy 'pointer' and 'dimension'
+ 	attribute from result symbol to function symbol.
+ 	* trans-expr.c (gfc_conv_function_call): Check sym for attribute
+ 	'dimension' instead of sym->result.
+ 
  2005-06-01  Jakub Jelinek  <jakub@redhat.com>
  
  	PR fortran/21729
Index: gcc/fortran/gfortran.h
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/gfortran.h,v
retrieving revision 1.58.2.6
diff -c -3 -p -r1.58.2.6 gfortran.h
*** gcc/fortran/gfortran.h	29 Apr 2005 16:01:11 -0000	1.58.2.6
--- gcc/fortran/gfortran.h	1 Jun 2005 22:43:14 -0000
*************** typedef struct
*** 1419,1424 ****
--- 1419,1425 ----
    int flag_no_backend;
    int flag_pack_derived;
    int flag_repack_arrays;
+   int flag_f2c;
  
    int q_kind;
  
Index: gcc/fortran/invoke.texi
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/invoke.texi,v
retrieving revision 1.7.18.4
diff -c -3 -p -r1.7.18.4 invoke.texi
*** gcc/fortran/invoke.texi	12 Apr 2005 21:38:14 -0000	1.7.18.4
--- gcc/fortran/invoke.texi	1 Jun 2005 22:43:14 -0000
*************** by type.  Explanations are in the follow
*** 156,162 ****
  @item Code Generation Options
  @xref{Code Gen Options,,Options for Code Generation Conventions}.
  @gccoptlist{
! -fno-underscoring  -fno-second-underscore @gol
  -fbounds-check  -fmax-stack-var-size=@var{n} @gol
  -fpackderived  -frepack-arrays}
  @end table
--- 156,162 ----
  @item Code Generation Options
  @xref{Code Gen Options,,Options for Code Generation Conventions}.
  @gccoptlist{
! -ff2c -fno-underscoring  -fsecond-underscore @gol
  -fbounds-check  -fmax-stack-var-size=@var{n} @gol
  -fpackderived  -frepack-arrays}
  @end table
*************** it.
*** 521,528 ****
  
  
  @table @gcctabopt
! @cindex -fno-underscoring option
! @cindex options, -fno-underscoring
  @item -fno-underscoring
  @cindex underscore
  @cindex symbol names, underscores
--- 521,563 ----
  
  
  @table @gcctabopt
! @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 @option{-fsecond-underscore}
! option, unless @option{-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
*************** it.
*** 531,546 ****
  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.)
  
  This is done to ensure compatibility with code produced by many
! UNIX Fortran compilers, including @command{f2c} which perform the
! same transformations.
  
  Use of @option{-fno-underscoring} is not recommended unless you are
  experimenting with issues such as integration of (GNU) Fortran into
--- 566,582 ----
  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 one
! underscore to external names with no underscores.
  
  This is done to ensure compatibility with code produced by many
! 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
*************** in the source, even if the names as seen
*** 596,617 ****
  prevent accidental linking between procedures with incompatible
  interfaces.
  
! @cindex -fno-second-underscore option
! @cindex options, -fno-second-underscore
! @item -fno-second-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.
  
  This option has no effect if @option{-fno-underscoring} is
! in effect.
  
  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__}.
  
  
  @cindex -fbounds-check option
--- 632,662 ----
  prevent accidental linking between procedures with incompatible
  interfaces.
  
! @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
! @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.  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_}.  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
Index: gcc/fortran/lang.opt
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/lang.opt,v
retrieving revision 1.8.20.1
diff -c -3 -p -r1.8.20.1 lang.opt
*** gcc/fortran/lang.opt	30 Mar 2005 01:40:14 -0000	1.8.20.1
--- gcc/fortran/lang.opt	1 Jun 2005 22:43:14 -0000
*************** fdump-parse-tree
*** 89,94 ****
--- 89,98 ----
  F95
  Display the code tree after parsing.
  
+ ff2c
+ F95
+ Use f2c calling convention.
+ 
  ffixed-form
  F95
  Assume that the source file is fixed form
Index: gcc/fortran/options.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/options.c,v
retrieving revision 1.17.8.1
diff -c -3 -p -r1.17.8.1 options.c
*** gcc/fortran/options.c	30 Mar 2005 01:40:14 -0000	1.17.8.1
--- gcc/fortran/options.c	1 Jun 2005 22:43:14 -0000
*************** gfc_init_options (unsigned int argc ATTR
*** 62,68 ****
    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_implicit_none = 0;
    gfc_option.flag_max_stack_var_size = 32768;
    gfc_option.flag_module_access_private = 0;
--- 62,69 ----
    gfc_option.flag_default_real = 0;
    gfc_option.flag_dollar_ok = 0;
    gfc_option.flag_underscoring = 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;
*************** gfc_post_options (const char **pfilename
*** 113,118 ****
--- 114,125 ----
    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_handle_option (size_t scode, const c
*** 214,219 ****
--- 221,230 ----
        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;
Index: gcc/fortran/resolve.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/resolve.c,v
retrieving revision 1.34.2.9
diff -c -3 -p -r1.34.2.9 resolve.c
*** gcc/fortran/resolve.c	1 Jun 2005 10:13:19 -0000	1.34.2.9
--- gcc/fortran/resolve.c	1 Jun 2005 22:43:16 -0000
*************** resolve_symbol (gfc_symbol * sym)
*** 4068,4073 ****
--- 4068,4075 ----
  
  	      sym->ts = sym->result->ts;
  	      sym->as = gfc_copy_array_spec (sym->result->as);
+               sym->attr.dimension = sym->result->attr.dimension;
+               sym->attr.pointer = sym->result->attr.pointer;
  	    }
  	}
      }
Index: gcc/fortran/trans-decl.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/trans-decl.c,v
retrieving revision 1.54.2.2
diff -c -3 -p -r1.54.2.2 trans-decl.c
*** gcc/fortran/trans-decl.c	29 Apr 2005 16:01:12 -0000	1.54.2.2
--- gcc/fortran/trans-decl.c	1 Jun 2005 22:43:16 -0000
*************** gfc_get_extern_function_decl (gfc_symbol
*** 901,907 ****
    gfc_expr e;
    gfc_intrinsic_sym *isym;
    gfc_expr argexpr;
!   char s[GFC_MAX_SYMBOL_LEN];
    tree name;
    tree mangled_name;
  
--- 901,907 ----
    gfc_expr e;
    gfc_intrinsic_sym *isym;
    gfc_expr argexpr;
!   char s[GFC_MAX_SYMBOL_LEN + 13]; /* "f2c_specific" and '\0'.  */
    tree name;
    tree mangled_name;
  
*************** gfc_get_extern_function_decl (gfc_symbol
*** 937,943 ****
  	  gcc_assert (isym->formal->next->next == NULL);
  	  isym->resolve.f2 (&e, &argexpr, NULL);
  	}
!       sprintf (s, "specific%s", e.value.function.name);
        name = get_identifier (s);
        mangled_name = name;
      }
--- 937,954 ----
  	  gcc_assert (isym->formal->next->next == NULL);
  	  isym->resolve.f2 (&e, &argexpr, NULL);
  	}
! 
!       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;
      }
*************** gfc_trans_deferred_vars (gfc_symbol * pr
*** 2030,2036 ****
  	    fnbody = gfc_trans_dummy_character (proc_sym->ts.cl, fnbody);
  	}
        else
! 	gfc_todo_error ("Deferred non-array return by reference");
      }
  
    for (sym = proc_sym->tlink; sym != proc_sym; sym = sym->tlink)
--- 2041,2048 ----
  	    fnbody = gfc_trans_dummy_character (proc_sym->ts.cl, fnbody);
  	}
        else
! 	gcc_assert (gfc_option.flag_f2c
! 		    && proc_sym->ts.type == BT_COMPLEX);
      }
  
    for (sym = proc_sym->tlink; sym != proc_sym; sym = sym->tlink)
Index: gcc/fortran/trans-expr.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/trans-expr.c,v
retrieving revision 1.38.2.3
diff -c -3 -p -r1.38.2.3 trans-expr.c
*** gcc/fortran/trans-expr.c	29 Apr 2005 16:01:10 -0000	1.38.2.3
--- gcc/fortran/trans-expr.c	1 Jun 2005 22:43:17 -0000
*************** gfc_conv_variable (gfc_se * se, gfc_expr
*** 362,367 ****
--- 362,374 ----
  	  && !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
*************** gfc_conv_function_call (gfc_se * se, gfc
*** 1139,1145 ****
  				      convert (gfc_charlen_type_node, len));
  	}
        else
! 	gcc_unreachable ();
      }
  
    formal = sym->formal;
--- 1146,1158 ----
  				      convert (gfc_charlen_type_node, len));
  	}
        else
! 	{
! 	  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;
*************** gfc_conv_function_call (gfc_se * se, gfc
*** 1241,1254 ****
    se->expr = build3 (CALL_EXPR, TREE_TYPE (fntype), se->expr,
  		     arglist, NULL_TREE);
  
    /* 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)))
      se->expr = gfc_build_indirect_ref (se->expr);
  
    /* A pure function may still have side-effects - it may modify its
       parameters.  */
    TREE_SIDE_EFFECTS (se->expr) = 1;
--- 1254,1278 ----
    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)
      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;
*************** gfc_conv_function_call (gfc_se * se, gfc
*** 1265,1271 ****
  
        if (!se->direct_byref)
  	{
! 	  if (sym->result->attr.dimension)
  	    {
  	      if (flag_bounds_check)
  		{
--- 1289,1295 ----
  
        if (!se->direct_byref)
  	{
! 	  if (sym->attr.dimension)
  	    {
  	      if (flag_bounds_check)
  		{
*************** gfc_conv_function_call (gfc_se * se, gfc
*** 1283,1289 ****
  	      se->string_length = len;
  	    }
  	  else
! 	    gcc_unreachable ();
  	}
      }
  }
--- 1307,1316 ----
  	      se->string_length = len;
  	    }
  	  else
! 	    {
! 	      gcc_assert (sym->ts.type == BT_COMPLEX && gfc_option.flag_f2c);
! 	      se->expr = gfc_build_indirect_ref (var);
! 	    }
  	}
      }
  }
Index: gcc/fortran/trans-types.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/trans-types.c,v
retrieving revision 1.37.10.4
diff -c -3 -p -r1.37.10.4 trans-types.c
*** gcc/fortran/trans-types.c	12 May 2005 18:26:44 -0000	1.37.10.4
--- gcc/fortran/trans-types.c	1 Jun 2005 22:43:17 -0000
*************** gfc_sym_type (gfc_symbol * sym)
*** 1269,1274 ****
--- 1269,1286 ----
      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;
*************** gfc_get_derived_type (gfc_symbol * deriv
*** 1450,1468 ****
  int
  gfc_return_by_reference (gfc_symbol * sym)
  {
    if (!sym->attr.function)
      return 0;
  
!   if (sym->result)
!     sym = sym->result;
  
!   if (sym->attr.dimension)
      return 1;
  
!   if (sym->ts.type == BT_CHARACTER)
      return 1;
  
!   /* Possibly return complex numbers by reference for g77 compatibility.  */
    return 0;
  }
  
--- 1462,1490 ----
  int
  gfc_return_by_reference (gfc_symbol * sym)
  {
+   gfc_symbol *result;
+ 
    if (!sym->attr.function)
      return 0;
  
!   result = sym->result ? sym->result : sym;
  
!   if (result->attr.dimension)
      return 1;
  
!   if (result->ts.type == BT_CHARACTER)
      return 1;
  
!   /* 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;
  }
  
*************** gfc_get_function_type (gfc_symbol * sym)
*** 1548,1554 ****
  	gfc_conv_const_charlen (arg->ts.cl);
  
        type = gfc_sym_type (arg);
!       if (arg->ts.type == BT_DERIVED
  	  || arg->attr.dimension
  	  || arg->ts.type == BT_CHARACTER)
  	type = build_reference_type (type);
--- 1570,1576 ----
  	gfc_conv_const_charlen (arg->ts.cl);
  
        type = gfc_sym_type (arg);
!       if (arg->ts.type == BT_COMPLEX
  	  || arg->attr.dimension
  	  || arg->ts.type == BT_CHARACTER)
  	type = build_reference_type (type);
Index: gcc/testsuite/ChangeLog
===================================================================
RCS file: /cvs/gcc/gcc/gcc/testsuite/ChangeLog,v
retrieving revision 1.5084.2.218
diff -c -3 -p -r1.5084.2.218 ChangeLog
*** gcc/testsuite/ChangeLog	1 Jun 2005 14:47:00 -0000	1.5084.2.218
--- gcc/testsuite/ChangeLog	1 Jun 2005 22:43:22 -0000
***************
*** 1,3 ****
--- 1,9 ----
+ 2005-06-01  Tobias Schl"uter  <tobias.schlueter@physik.uni-muenchen.de>
+ 
+ 	* gfortran.dg/f2c_1.f90, gfortran.dg/f2c_2.f90,
+ 	gfortran.dg/f2c_3.f90, gfortran.dg/func_result_2.f90:
+ 	New tests.
+ 
  2005-06-01  Nathan Sidwell  <nathan@codesourcery.com>
  
  	PR c++/20350
Index: gcc/testsuite/gfortran.dg/f2c_1.f90
===================================================================
RCS file: gcc/testsuite/gfortran.dg/f2c_1.f90
diff -N gcc/testsuite/gfortran.dg/f2c_1.f90
*** /dev/null	1 Jan 1970 00:00:00 -0000
--- gcc/testsuite/gfortran.dg/f2c_1.f90	1 Jun 2005 22:43:25 -0000
***************
*** 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
Index: gcc/testsuite/gfortran.dg/f2c_2.f90
===================================================================
RCS file: gcc/testsuite/gfortran.dg/f2c_2.f90
diff -N gcc/testsuite/gfortran.dg/f2c_2.f90
*** /dev/null	1 Jan 1970 00:00:00 -0000
--- gcc/testsuite/gfortran.dg/f2c_2.f90	1 Jun 2005 22:43:25 -0000
***************
*** 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
+  
Index: gcc/testsuite/gfortran.dg/f2c_3.f90
===================================================================
RCS file: gcc/testsuite/gfortran.dg/f2c_3.f90
diff -N gcc/testsuite/gfortran.dg/f2c_3.f90
*** /dev/null	1 Jan 1970 00:00:00 -0000
--- gcc/testsuite/gfortran.dg/f2c_3.f90	1 Jun 2005 22:43:25 -0000
***************
*** 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
Index: gcc/testsuite/gfortran.dg/func_result_2.f90
===================================================================
RCS file: gcc/testsuite/gfortran.dg/func_result_2.f90
diff -N gcc/testsuite/gfortran.dg/func_result_2.f90
*** /dev/null	1 Jan 1970 00:00:00 -0000
--- gcc/testsuite/gfortran.dg/func_result_2.f90	1 Jun 2005 22:43:25 -0000
***************
*** 0 ****
--- 1,10 ----
+ ! { dg-do run }
+ ! Character functions with a result clause were broken
+ program testch
+   if (ch().ne."hello     ") call abort()
+ contains
+   function ch result(str)
+     character(len = 10)  :: str
+     str ="hello"
+   end function ch
+ end program testch
Index: libgfortran/ChangeLog
===================================================================
RCS file: /cvs/gcc/gcc/libgfortran/ChangeLog,v
retrieving revision 1.163.2.46
diff -c -3 -p -r1.163.2.46 ChangeLog
*** libgfortran/ChangeLog	30 May 2005 07:42:37 -0000	1.163.2.46
--- libgfortran/ChangeLog	1 Jun 2005 22:43:26 -0000
***************
*** 1,3 ****
--- 1,11 ----
+ 2005-06-01  Tobias Schl"uter  <tobias.schlueter@physik.uni-muenchen.de>
+ 
+ 	* Makefile.am (gfor_specific_src): Add 'intrinsics/f2c_intrinsics.F90'
+ 	to dependencies.
+ 	* aclocal.m4: Regenerate.
+ 	* Makefile.in: Regenerate.
+ 	* intrinsics/f2c_specific.F90: New file.
+ 
  2005-05-30  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
  
  	PR libfortran/20179
Index: libgfortran/Makefile.am
===================================================================
RCS file: /cvs/gcc/gcc/libgfortran/Makefile.am,v
retrieving revision 1.29.10.4
diff -c -3 -p -r1.29.10.4 Makefile.am
*** libgfortran/Makefile.am	19 May 2005 22:06:33 -0000	1.29.10.4
--- libgfortran/Makefile.am	1 Jun 2005 22:43:26 -0000
*************** foo
*** 391,397 ****
  gfor_specific_src= \
  $(gfor_built_specific_src) \
  $(gfor_built_specific2_src) \
! intrinsics/dprod_r8.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) \
--- 391,398 ----
  gfor_specific_src= \
  $(gfor_built_specific_src) \
  $(gfor_built_specific2_src) \
! 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) \
Index: libgfortran/intrinsics/f2c_specifics.F90
===================================================================
RCS file: libgfortran/intrinsics/f2c_specifics.F90
diff -N libgfortran/intrinsics/f2c_specifics.F90
*** /dev/null	1 Jan 1970 00:00:00 -0000
--- libgfortran/intrinsics/f2c_specifics.F90	1 Jun 2005 22:43:29 -0000
***************
*** 0 ****
--- 1,169 ----
+ !   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)

Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]