[gfortran] Allow EXTERNAL declaration of ETIME

[Tobias Schlüter <tobias dot schlueter at physik dot uni-muenchen dot de>]

ETIME is declared EXTERNAL in LAPACK. g77 calls the intrinsic nonetheless, so
we have to fix this. example code looks like this:

François-Xavier Coudert wrote:
> Here is a minimal example, working well with g77.
> 
> pc31 ~ $ cat sec.f
>        PROGRAM MAIN
> 
>        REAL SECOND
>        REAL               T1
>        REAL               TARRAY( 2 )
>        REAL               ETIME
>        EXTERNAL           ETIME
> 
>        T1 = ETIME( TARRAY )
>        SECOND = TARRAY( 1 )
> 
>        END

We use different calling ocnventions for intrinsics and extrernal functions
(because we want to evade copying of arrays where possible), so I propose this
workaround.

I assume that g77 works with most of its intrinsics declared EXTERNAL, but
instead of trying to fix all of them, I suggest fixing them one at a time as
they appear. If we want to fix all at a time, we should have a field
indicating "this intrinsic takes its arguments in the g77 way", and not use
prefix on their implementations.

Anyway, patch below. Built and verified that it works as expected.

- Tobi

2004-09-24  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>

	* etime.c (etime_): New function.

Index: etime.c
===================================================================
RCS file: /cvs/gcc/gcc/libgfortran/intrinsics/etime.c,v
retrieving revision 1.2
diff -u -p -r1.2 etime.c
--- etime.c     21 Jun 2004 22:25:12 -0000      1.2
+++ etime.c     24 Sep 2004 12:07:38 -0000
@@ -78,3 +78,22 @@ prefix(etime) (gfc_array_r4 *t)
   prefix(etime_sub) (t, &val);
   return val;
 }
+
+/* LAPACK's test programs declares ETIME external, therefore we
+   need this.  */
+
+GFC_REAL_4
+etime_ (GFC_REAL_4 *t)
+{
+  gfc_array_r4 desc;
+  GFC_REAL_4 val;
+
+  /* We only fill in the fields that are used in etime_sub.  */
+  desc.dim[0].lbound = 0;
+  desc.dim[0].ubound = 1;
+  desc.dim[0].stride = 1;
+  desc.data = t;
+
+  prefix(etime_sub) (&desc, &val);
+  return val;
+}