OSDN Git Service

gcc/fortran:
authordfranke <dfranke@138bc75d-0d04-0410-961f-82ee72b054a4>
Tue, 25 Dec 2007 10:41:44 +0000 (10:41 +0000)
committerdfranke <dfranke@138bc75d-0d04-0410-961f-82ee72b054a4>
Tue, 25 Dec 2007 10:41:44 +0000 (10:41 +0000)
2007-12-25  Daniel Franke  <franke.daniel@gmail.com>

PR fortran/34533
* intrinsic.h (gfc_check_etime): Renamed to ...
(gfc_check_dtime_etime): ... this.
(gfc_check_etime_sub): Renamed to ...
(gfc_check_dtime_etime_sub): ... this.
(gfc_resolve_dtime_sub): New prototype.
* check.c (gfc_check_etime): Renamed to ...
(gfc_check_dtime_etime): ... this.
(gfc_check_etime_sub): Renamed to ...
(gfc_check_dtime_etime_sub): ... this.
* iresolve.c (gfc_resolve_dtime_sub): New implementation.
* intrinsic.c (add_functions): Removed alias from ETIME to DTIME,
added stand-alone intrinsic DTIME.
(add_subroutines): Adjusted check and resolve function names for
DTIME and ETIME.
* trans-intrinsic.c (gfc_conv_intrinsic_function): Added DTIME
to known functions in switch.
* intrinsic.texi (DTIME): Added paragraph about thread-safety,
fixed return value section.
(CPU_TIME): Clarified intent and added implementation notes.

libgfortran:
2007-12-25  Daniel Franke  <franke.daniel@gmail.com>

PR fortran/34533
* intrinsics/cpu_time.c: Moved code commonly usable for CPU_TIME,
DTIME and ETIME to ...
* intrinsics/time_1.h: ... here.
* intrinsics/dtime.c: New file.
* intrinsics/etime.c: Newly implemented using the common
time-aquisition function from time_1.h.
* gfortran.map (_gfortran_dtime, _gfortran_dtime_sub): New.
* Makefile.am: Added new file.
* Makefile.in: Regenerated.
* configure: Regenerated.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@131168 138bc75d-0d04-0410-961f-82ee72b054a4

16 files changed:
gcc/fortran/ChangeLog
gcc/fortran/check.c
gcc/fortran/intrinsic.c
gcc/fortran/intrinsic.h
gcc/fortran/intrinsic.texi
gcc/fortran/iresolve.c
gcc/fortran/trans-intrinsic.c
libgfortran/ChangeLog
libgfortran/Makefile.am
libgfortran/Makefile.in
libgfortran/configure
libgfortran/gfortran.map
libgfortran/intrinsics/cpu_time.c
libgfortran/intrinsics/dtime.c [new file with mode: 0644]
libgfortran/intrinsics/etime.c
libgfortran/intrinsics/time_1.h [new file with mode: 0644]

index 9db44b2..7ffa51d 100644 (file)
@@ -1,3 +1,26 @@
+2007-12-25  Daniel Franke  <franke.daniel@gmail.com>
+
+       PR fortran/34533
+       * intrinsic.h (gfc_check_etime): Renamed to ...
+       (gfc_check_dtime_etime): ... this.
+       (gfc_check_etime_sub): Renamed to ...
+       (gfc_check_dtime_etime_sub): ... this.
+       (gfc_resolve_dtime_sub): New prototype.
+       * check.c (gfc_check_etime): Renamed to ...
+       (gfc_check_dtime_etime): ... this.
+       (gfc_check_etime_sub): Renamed to ...
+       (gfc_check_dtime_etime_sub): ... this.
+       * iresolve.c (gfc_resolve_dtime_sub): New implementation.
+       * intrinsic.c (add_functions): Removed alias from ETIME to DTIME,
+       added stand-alone intrinsic DTIME.
+       (add_subroutines): Adjusted check and resolve function names for
+       DTIME and ETIME.
+       * trans-intrinsic.c (gfc_conv_intrinsic_function): Added DTIME
+       to known functions in switch.
+       * intrinsic.texi (DTIME): Added paragraph about thread-safety,
+       fixed return value section.
+       (CPU_TIME): Clarified intent and added implementation notes.
+
 2007-12-23  Tobias Burnus  <burnus@net-b.de>
 
        PR fortran/34421
index 9cc4d85..ba7bcf2 100644 (file)
@@ -3230,7 +3230,7 @@ gfc_check_ctime_sub (gfc_expr *time, gfc_expr *result)
 
 
 try
-gfc_check_etime (gfc_expr *x)
+gfc_check_dtime_etime (gfc_expr *x)
 {
   if (array_check (x, 0) == FAILURE)
     return FAILURE;
@@ -3252,7 +3252,7 @@ gfc_check_etime (gfc_expr *x)
 
 
 try
-gfc_check_etime_sub (gfc_expr *values, gfc_expr *time)
+gfc_check_dtime_etime_sub (gfc_expr *values, gfc_expr *time)
 {
   if (array_check (values, 0) == FAILURE)
     return FAILURE;
index 039e228..227c5ec 100644 (file)
@@ -1360,11 +1360,15 @@ add_functions (void)
   make_generic ("erfc", GFC_ISYM_ERFC, GFC_STD_GNU);
 
   /* G77 compatibility */
-  add_sym_1 ("etime", GFC_ISYM_ETIME, NO_CLASS, ACTUAL_NO, BT_REAL, 4,  GFC_STD_GNU,
-            gfc_check_etime, NULL, NULL,
+  add_sym_1 ("dtime", GFC_ISYM_DTIME, NO_CLASS, ACTUAL_NO, BT_REAL, 4,  GFC_STD_GNU,
+            gfc_check_dtime_etime, NULL, NULL,
             x, BT_REAL, 4, REQUIRED);
 
-  make_alias ("dtime", GFC_STD_GNU);
+  make_generic ("dtime", GFC_ISYM_DTIME, GFC_STD_GNU);
+
+  add_sym_1 ("etime", GFC_ISYM_ETIME, NO_CLASS, ACTUAL_NO, BT_REAL, 4,  GFC_STD_GNU,
+            gfc_check_dtime_etime, NULL, NULL,
+            x, BT_REAL, 4, REQUIRED);
 
   make_generic ("etime", GFC_ISYM_ETIME, GFC_STD_GNU);
 
@@ -2437,11 +2441,11 @@ add_subroutines (void)
 
   /* More G77 compatibility garbage.  */
   add_sym_2s ("etime", GFC_ISYM_ETIME, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
-             gfc_check_etime_sub, NULL, gfc_resolve_etime_sub,
+             gfc_check_dtime_etime_sub, NULL, gfc_resolve_etime_sub,
              vl, BT_REAL, 4, REQUIRED, tm, BT_REAL, 4, REQUIRED);
 
   add_sym_2s ("dtime", GFC_ISYM_DTIME, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
-             gfc_check_etime_sub, NULL, gfc_resolve_etime_sub,
+             gfc_check_dtime_etime_sub, NULL, gfc_resolve_dtime_sub,
              vl, BT_REAL, 4, REQUIRED, tm, BT_REAL, 4, REQUIRED);
 
   add_sym_1s ("fdate", GFC_ISYM_FDATE, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
index 59cdfb1..dc54489 100644 (file)
@@ -55,7 +55,7 @@ try gfc_check_digits (gfc_expr *);
 try gfc_check_dot_product (gfc_expr *, gfc_expr *);
 try gfc_check_dprod (gfc_expr *, gfc_expr *);
 try gfc_check_eoshift (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
-try gfc_check_etime (gfc_expr *);
+try gfc_check_dtime_etime (gfc_expr *);
 try gfc_check_fgetputc (gfc_expr *, gfc_expr *);
 try gfc_check_fgetput (gfc_expr *);
 try gfc_check_fstat (gfc_expr *, gfc_expr *);
@@ -165,7 +165,7 @@ try gfc_check_mvbits (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *,
                      gfc_expr *);
 try gfc_check_random_number (gfc_expr *);
 try gfc_check_random_seed (gfc_expr *, gfc_expr *, gfc_expr *);
-try gfc_check_etime_sub (gfc_expr *, gfc_expr *);
+try gfc_check_dtime_etime_sub (gfc_expr *, gfc_expr *);
 try gfc_check_fgetputc_sub (gfc_expr *, gfc_expr *, gfc_expr *);
 try gfc_check_fgetput_sub (gfc_expr *, gfc_expr *);
 try gfc_check_fseek_sub (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
@@ -345,6 +345,7 @@ void gfc_resolve_dble (gfc_expr *, gfc_expr *);
 void gfc_resolve_dim (gfc_expr *, gfc_expr *, gfc_expr *);
 void gfc_resolve_dot_product (gfc_expr *, gfc_expr *, gfc_expr *);
 void gfc_resolve_dprod (gfc_expr *, gfc_expr *, gfc_expr *);
+void gfc_resolve_dtime_sub (gfc_code *);
 void gfc_resolve_eoshift (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *,
                          gfc_expr *);
 void gfc_resolve_etime_sub (gfc_code *);
index f31ca25..8b17708 100644 (file)
@@ -2717,6 +2717,16 @@ Returns a @code{REAL(*)} value representing the elapsed CPU time in
 seconds.  This is useful for testing segments of code to determine
 execution time.
 
+If a time source is available, time will be reported with microsecond
+resolution. If no time source is available, @var{TIME} is set to
+@code{-1.0}.
+
+Note that @var{TIME} may contain a, system dependent, arbitrary offset
+and may not start with @code{0.0}. For @code{CPU_TIME}, the absolute
+value is meaningless, only differences between subsequent calls to
+this subroutine, as shown in the example below, should be used.
+
+
 @item @emph{Standard}:
 F95 and later
 
@@ -3321,6 +3331,12 @@ sufficiently small limits that overflows (wrap around) are possible, such as
 become, negative, or numerically less than previous values, during a single
 run of the compiled program.
 
+Please note, that this implementation is thread safe if used within OpenMP
+directives, i. e. its state will be consistent while called from multiple
+threads. However, if @code{DTIME} is called from multiple threads, the result
+is still the time since the last invocation. This may not give the intended
+results. If possible, use @code{CPU_TIME} instead.
+
 This intrinsic is provided in both subroutine and function forms; however,
 only one form can be used in any given program unit.
 
@@ -3351,7 +3367,8 @@ Subroutine, function
 @end multitable
 
 @item @emph{Return value}:
-Elapsed time in seconds since the start of program execution.
+Elapsed time in seconds since the last invocation or since the start of program
+execution if not called before.
 
 @item @emph{Example}:
 @smallexample
@@ -3372,6 +3389,10 @@ program test_dtime
     print *, tarray(2)
 end program test_dtime
 @end smallexample
+
+@item @emph{See also}:
+@ref{CPU_TIME}
+
 @end table
 
 
index cdc4ac1..8a09efc 100644 (file)
@@ -2676,7 +2676,15 @@ gfc_resolve_symlnk_sub (gfc_code *c)
 }
 
 
-/* G77 compatibility subroutines etime() and dtime().  */
+/* G77 compatibility subroutines dtime() and etime().  */
+
+void
+gfc_resolve_dtime_sub (gfc_code *c)
+{
+  const char *name;
+  name = gfc_get_string (PREFIX ("dtime_sub"));
+  c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
+}
 
 void
 gfc_resolve_etime_sub (gfc_code *c)
index 63c5604..c10d44a 100644 (file)
@@ -4097,6 +4097,7 @@ gfc_conv_intrinsic_function (gfc_se * se, gfc_expr * expr)
     case GFC_ISYM_ACCESS:
     case GFC_ISYM_CHDIR:
     case GFC_ISYM_CHMOD:
+    case GFC_ISYM_DTIME:
     case GFC_ISYM_ETIME:
     case GFC_ISYM_FGET:
     case GFC_ISYM_FGETC:
index 8f32ca0..0db6850 100644 (file)
@@ -1,3 +1,17 @@
+2007-12-25  Daniel Franke  <franke.daniel@gmail.com>
+
+       PR fortran/34533
+       * intrinsics/cpu_time.c: Moved code commonly usable for CPU_TIME,
+       DTIME and ETIME to ...
+       * intrinsics/time_1.h: ... here.
+       * intrinsics/dtime.c: New file.
+       * intrinsics/etime.c: Newly implemented using the common 
+       time-aquisition function from time_1.h.
+       * gfortran.map (_gfortran_dtime, _gfortran_dtime_sub): New.
+       * Makefile.am: Added new file.
+       * Makefile.in: Regenerated.
+       * configure: Regenerated.
+
 2007-12-25  Thomas Koenig  <tkoenig@gcc.gnu.org>
 
        PR libfortran/34566
index 16fcd1f..9721db2 100644 (file)
@@ -60,6 +60,7 @@ intrinsics/cpu_time.c \
 intrinsics/cshift0.c \
 intrinsics/ctime.c \
 intrinsics/date_and_time.c \
+intrinsics/dtime.c \
 intrinsics/env.c \
 intrinsics/eoshift0.c \
 intrinsics/eoshift2.c \
index ebc8a4b..a58916b 100644 (file)
@@ -362,7 +362,7 @@ am__libgfortran_la_SOURCES_DIST = runtime/backtrace.c \
        intrinsics/c99_functions.c intrinsics/chdir.c \
        intrinsics/chmod.c intrinsics/clock.c intrinsics/cpu_time.c \
        intrinsics/cshift0.c intrinsics/ctime.c \
-       intrinsics/date_and_time.c intrinsics/env.c \
+       intrinsics/date_and_time.c intrinsics/dtime.c intrinsics/env.c \
        intrinsics/eoshift0.c intrinsics/eoshift2.c intrinsics/etime.c \
        intrinsics/exit.c intrinsics/fnum.c intrinsics/gerror.c \
        intrinsics/getcwd.c intrinsics/getlog.c intrinsics/getXid.c \
@@ -633,9 +633,9 @@ am__objects_31 = close.lo file_pos.lo format.lo inquire.lo \
        size_from_kind.lo transfer.lo unit.lo unix.lo write.lo
 am__objects_32 = associated.lo abort.lo access.lo args.lo \
        c99_functions.lo chdir.lo chmod.lo clock.lo cpu_time.lo \
-       cshift0.lo ctime.lo date_and_time.lo env.lo eoshift0.lo \
-       eoshift2.lo etime.lo exit.lo fnum.lo gerror.lo getcwd.lo \
-       getlog.lo getXid.lo hostnm.lo ierrno.lo ishftc.lo \
+       cshift0.lo ctime.lo date_and_time.lo dtime.lo env.lo \
+       eoshift0.lo eoshift2.lo etime.lo exit.lo fnum.lo gerror.lo \
+       getcwd.lo getlog.lo getXid.lo hostnm.lo ierrno.lo ishftc.lo \
        iso_c_generated_procs.lo iso_c_binding.lo kill.lo link.lo \
        malloc.lo mvbits.lo move_alloc.lo pack_generic.lo perror.lo \
        signal.lo size.lo sleep.lo spread_generic.lo \
@@ -899,6 +899,7 @@ intrinsics/cpu_time.c \
 intrinsics/cshift0.c \
 intrinsics/ctime.c \
 intrinsics/date_and_time.c \
+intrinsics/dtime.c \
 intrinsics/env.c \
 intrinsics/eoshift0.c \
 intrinsics/eoshift2.c \
@@ -1645,6 +1646,7 @@ distclean-compile:
 @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/cshift1_8.Plo@am__quote@
 @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/ctime.Plo@am__quote@
 @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/date_and_time.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/dtime.Plo@am__quote@
 @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/env.Plo@am__quote@
 @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/environ.Plo@am__quote@
 @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/eoshift0.Plo@am__quote@
@@ -4670,6 +4672,13 @@ date_and_time.lo: intrinsics/date_and_time.c
 @AMDEP_TRUE@@am__fastdepCC_FALSE@      DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
 @am__fastdepCC_FALSE@  $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o date_and_time.lo `test -f 'intrinsics/date_and_time.c' || echo '$(srcdir)/'`intrinsics/date_and_time.c
 
+dtime.lo: intrinsics/dtime.c
+@am__fastdepCC_TRUE@   if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT dtime.lo -MD -MP -MF "$(DEPDIR)/dtime.Tpo" -c -o dtime.lo `test -f 'intrinsics/dtime.c' || echo '$(srcdir)/'`intrinsics/dtime.c; \
+@am__fastdepCC_TRUE@   then mv -f "$(DEPDIR)/dtime.Tpo" "$(DEPDIR)/dtime.Plo"; else rm -f "$(DEPDIR)/dtime.Tpo"; exit 1; fi
+@AMDEP_TRUE@@am__fastdepCC_FALSE@      source='intrinsics/dtime.c' object='dtime.lo' libtool=yes @AMDEPBACKSLASH@
+@AMDEP_TRUE@@am__fastdepCC_FALSE@      DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
+@am__fastdepCC_FALSE@  $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o dtime.lo `test -f 'intrinsics/dtime.c' || echo '$(srcdir)/'`intrinsics/dtime.c
+
 env.lo: intrinsics/env.c
 @am__fastdepCC_TRUE@   if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT env.lo -MD -MP -MF "$(DEPDIR)/env.Tpo" -c -o env.lo `test -f 'intrinsics/env.c' || echo '$(srcdir)/'`intrinsics/env.c; \
 @am__fastdepCC_TRUE@   then mv -f "$(DEPDIR)/env.Tpo" "$(DEPDIR)/env.Plo"; else rm -f "$(DEPDIR)/env.Tpo"; exit 1; fi
index f33516d..b143135 100755 (executable)
@@ -867,13 +867,13 @@ echo X"$0" |
          /^X\(\/\).*/{ s//\1/; q; }
          s/.*/./; q'`
   srcdir=$ac_confdir
-  if test ! -r $srcdir/$ac_unique_file; then
+  if test ! -r "$srcdir/$ac_unique_file"; then
     srcdir=..
   fi
 else
   ac_srcdir_defaulted=no
 fi
-if test ! -r $srcdir/$ac_unique_file; then
+if test ! -r "$srcdir/$ac_unique_file"; then
   if test "$ac_srcdir_defaulted" = yes; then
     { echo "$as_me: error: cannot find sources ($ac_unique_file) in $ac_confdir or .." >&2
    { (exit 1); exit 1; }; }
@@ -882,7 +882,7 @@ if test ! -r $srcdir/$ac_unique_file; then
    { (exit 1); exit 1; }; }
   fi
 fi
-(cd $srcdir && test -r ./$ac_unique_file) 2>/dev/null ||
+(cd $srcdir && test -r "./$ac_unique_file") 2>/dev/null ||
   { echo "$as_me: error: sources are in $srcdir, but \`cd $srcdir' does not work" >&2
    { (exit 1); exit 1; }; }
 srcdir=`echo "$srcdir" | sed 's%\([^\\/]\)[\\/]*$%\1%'`
index 92d2aac..149d29b 100644 (file)
@@ -58,6 +58,8 @@ GFORTRAN_1.0 {
     _gfortran_ctime;
     _gfortran_ctime_sub;
     _gfortran_date_and_time;
+    _gfortran_dtime;
+    _gfortran_dtime_sub;
     _gfortran_eoshift0_1;
     _gfortran_eoshift0_1_char;
     _gfortran_eoshift0_2;
index add3507..c1020dc 100644 (file)
@@ -28,37 +28,11 @@ write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
 Boston, MA 02110-1301, USA.  */
 
 #include "libgfortran.h"
-
-#ifdef HAVE_UNISTD_H
-#include <unistd.h>
-#endif
-
-/* The CPU_TIME intrinsic to "compare different algorithms on the same
-   computer or discover which parts are the most expensive", so we
-   need a way to get the CPU time with the finest resolution possible.
-   We can only be accurate up to microseconds.
-
-   As usual with UNIX systems, unfortunately no single way is
-   available for all systems.  */
-
-#ifdef TIME_WITH_SYS_TIME
-#  include <sys/time.h>
-#  include <time.h>
-#else
-#  if HAVE_SYS_TIME_H
-#    include <sys/time.h>
-#  else
-#    ifdef HAVE_TIME_H
-#      include <time.h>
-#    endif
-#  endif
-#endif
+#include "time_1.h"
 
 /* The most accurate way to get the CPU time is getrusage ().
    If we have times(), that's good enough, too.  */
-#if defined (HAVE_GETRUSAGE) && defined (HAVE_SYS_RESOURCE_H)
-#  include <sys/resource.h>
-#else
+#if !defined (HAVE_GETRUSAGE) || !defined (HAVE_SYS_RESOURCE_H)
 /* For times(), we _must_ know the number of clock ticks per second.  */
 #  if defined (HAVE_TIMES) && (defined (HZ) || defined (_SC_CLK_TCK) || defined (CLK_TCK))
 #    ifdef HAVE_SYS_PARAM_H
@@ -75,65 +49,18 @@ Boston, MA 02110-1301, USA.  */
 #      endif
 #    endif
 #  endif  /* HAVE_TIMES etc.  */
-#endif  /* HAVE_GETRUSAGE && HAVE_SYS_RESOURCE_H  */
-
-#if defined (__GNUC__) && (__GNUC__ >= 3)
-#  define ATTRIBUTE_ALWAYS_INLINE __attribute__ ((__always_inline__))
-#else
-#  define ATTRIBUTE_ALWAYS_INLINE
-#endif
+#endif  /* !HAVE_GETRUSAGE || !HAVE_SYS_RESOURCE_H  */
 
 static inline void __cpu_time_1 (long *, long *) ATTRIBUTE_ALWAYS_INLINE;
 
-/* Helper function for the actual implementation of the CPU_TIME
-   intrinsic.  Returns a CPU time in microseconds or -1 if no CPU time
-   could be computed.  */
-
-#ifdef __MINGW32__
-
-#define WIN32_LEAN_AND_MEAN
-#include <windows.h>
-
-static void
-__cpu_time_1 (long *sec, long *usec)
-{
-  union {
-    FILETIME ft;
-    unsigned long long ulltime;
-  } kernel_time,  user_time;
-
-  FILETIME unused1, unused2;
-  unsigned long long total_time;
-
-  /* No support for Win9x.  The high order bit of the DWORD
-     returned by GetVersion is 0 for NT and higher. */
-  if (GetVersion () >= 0x80000000)
-    {
-      *sec = -1;
-      *usec = 0;
-      return;
-    }
-
-  /* The FILETIME structs filled in by GetProcessTimes represent
-     time in 100 nanosecond units. */
-  GetProcessTimes (GetCurrentProcess (), &unused1, &unused2,
-                  &kernel_time.ft, &user_time.ft);
-      
-  total_time = (kernel_time.ulltime + user_time.ulltime)/10; 
-  *sec = total_time / 1000000;
-  *usec = total_time % 1000000;
-}
-
-#else
-
 static inline void
 __cpu_time_1 (long *sec, long *usec)
 {
-#if defined (HAVE_GETRUSAGE) && defined (HAVE_SYS_RESOURCE_H)
-  struct rusage usage;
-  getrusage (0, &usage);
-  *sec = usage.ru_utime.tv_sec + usage.ru_stime.tv_sec;
-  *usec = usage.ru_utime.tv_usec + usage.ru_stime.tv_usec;
+#if defined(__MINGW32__) || defined (HAVE_GETRUSAGE) && defined (HAVE_SYS_RESOURCE_H)
+  long user_sec, user_usec, system_sec, system_usec;
+  __time_1 (&user_sec, &user_usec, &system_sec, &system_usec);
+  *sec = user_sec + system_sec;
+  *usec = user_usec + system_usec;
 #else /* ! HAVE_GETRUSAGE || ! HAVE_SYS_RESOURCE_H  */
 #ifdef HAVE_TIMES
   struct tms buf;
@@ -145,10 +72,9 @@ __cpu_time_1 (long *sec, long *usec)
   *sec = -1;
   *usec = 0;
 #endif  /* HAVE_TIMES */
-#endif  /* HAVE_GETRUSAGE */
+#endif  /* __MINGW32__ || HAVE_GETRUSAGE */
 }
 
-#endif
 
 extern void cpu_time_4 (GFC_REAL_4 *);
 iexport_proto(cpu_time_4);
diff --git a/libgfortran/intrinsics/dtime.c b/libgfortran/intrinsics/dtime.c
new file mode 100644 (file)
index 0000000..52be491
--- /dev/null
@@ -0,0 +1,86 @@
+/* Implementation of the dtime intrinsic.
+   Copyright (C) 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+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.)
+
+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., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "libgfortran.h"
+#include "time_1.h"
+#include <gthr.h>
+
+#ifdef __GTHREAD_MUTEX_INIT
+static __gthread_mutex_t dtime_update_lock = __GTHREAD_MUTEX_INIT;
+#else
+static __gthread_mutex_t dtime_update_lock;
+#endif
+
+extern void dtime_sub (gfc_array_r4 *t, GFC_REAL_4 *result);
+iexport_proto(dtime_sub);
+
+void
+dtime_sub (gfc_array_r4 *t, GFC_REAL_4 *result)
+{
+  static GFC_REAL_4 tu = 0.0, ts = 0.0, tt = 0.0;
+  GFC_REAL_4 *tp;
+  long user_sec, user_usec, system_sec, system_usec;
+
+  if (((t->dim[0].ubound + 1 - t->dim[0].lbound)) < 2)
+    runtime_error ("Insufficient number of elements in TARRAY.");
+
+  __gthread_mutex_lock (&dtime_update_lock);
+  if (__time_1 (&user_sec, &user_usec, &system_sec, &system_usec) == 0)
+    {
+      tu = (GFC_REAL_4)(user_sec + 1.e-6 * user_usec) - tu;
+      ts = (GFC_REAL_4)(system_sec + 1.e-6 * system_usec) - ts;
+      tt = tu + ts;
+    }
+  else
+    {
+      tu = (GFC_REAL_4)-1.0;
+      ts = (GFC_REAL_4)-1.0;
+      tt = (GFC_REAL_4)-1.0;
+    }
+
+  tp = t->data;
+
+  *tp = tu;
+  tp += t->dim[0].stride;
+  *tp = ts;
+  *result = tt;
+  __gthread_mutex_unlock (&dtime_update_lock);
+}
+iexport(dtime_sub);
+
+extern GFC_REAL_4 dtime (gfc_array_r4 *t);
+export_proto(dtime);
+
+GFC_REAL_4
+dtime (gfc_array_r4 *t)
+{
+  GFC_REAL_4 val;
+  dtime_sub (t, &val);
+  return val;
+}
index c4d25c4..0ecba26 100644 (file)
@@ -29,11 +29,7 @@ write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
 Boston, MA 02110-1301, USA.  */
 
 #include "libgfortran.h"
-
-#if defined (HAVE_SYS_TIME_H) && defined (HAVE_SYS_RESOURCE_H)
-#include <sys/time.h>
-#include <sys/resource.h>
-#endif
+#include "time_1.h"
 
 extern void etime_sub (gfc_array_r4 *t, GFC_REAL_4 *result);
 iexport_proto(etime_sub);
@@ -42,30 +38,23 @@ void
 etime_sub (gfc_array_r4 *t, GFC_REAL_4 *result)
 {
   GFC_REAL_4 tu, ts, tt, *tp;
+  long user_sec, user_usec, system_sec, system_usec;
 
-#if defined(HAVE_SYS_TIME_H) && defined(HAVE_SYS_RESOURCE_H)
-  struct rusage rt;
+  if (((t->dim[0].ubound + 1 - t->dim[0].lbound)) < 2)
+    runtime_error ("Insufficient number of elements in TARRAY.");
 
-  if (getrusage(RUSAGE_SELF, &rt) == 0)
+  if (__time_1 (&user_sec, &user_usec, &system_sec, &system_usec) == 0)
     {
-      tu = (GFC_REAL_4)(rt.ru_utime.tv_sec + 1.e-6 * rt.ru_utime.tv_usec);
-      ts = (GFC_REAL_4)(rt.ru_stime.tv_sec + 1.e-6 * rt.ru_stime.tv_usec);
+      tu = (GFC_REAL_4)(user_sec + 1.e-6 * user_usec);
+      ts = (GFC_REAL_4)(system_sec + 1.e-6 * system_usec);
       tt = tu + ts;
     }
   else
     {
-      tu = -1.;
-      ts = -1.;
-      tt = -1.;
+      tu = (GFC_REAL_4)-1.0;
+      ts = (GFC_REAL_4)-1.0;
+      tt = (GFC_REAL_4)-1.0;
     }
-#else
-  tu = -1.;
-  ts = -1.;
-  tt = -1.;
-#endif
-
-  if (((t->dim[0].ubound + 1 - t->dim[0].lbound)) < 2)
-    runtime_error ("Insufficient number of elements in TARRAY.");
 
   tp = t->data;
 
diff --git a/libgfortran/intrinsics/time_1.h b/libgfortran/intrinsics/time_1.h
new file mode 100644 (file)
index 0000000..43e6d89
--- /dev/null
@@ -0,0 +1,142 @@
+/* Implementation of the CPU_TIME intrinsic.
+   Copyright (C) 2003, 2007 Free Software Foundation, Inc.
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+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.)
+
+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., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#ifndef LIBGFORTRAN_TIME_H
+#define LIBGFORTRAN_TIME_H
+
+#ifdef HAVE_UNISTD_H
+#include <unistd.h>
+#endif
+
+/* The time related intrinsics (DTIME, ETIME, CPU_TIME) to "compare
+   different algorithms on the same computer or discover which parts
+   are the most expensive", need a way to get the CPU time with the
+   finest resolution possible. We can only be accurate up to
+   microseconds.
+
+   As usual with UNIX systems, unfortunately no single way is
+   available for all systems.  */
+
+#ifdef TIME_WITH_SYS_TIME
+#  include <sys/time.h>
+#  include <time.h>
+#else
+#  if HAVE_SYS_TIME_H
+#    include <sys/time.h>
+#  else
+#    ifdef HAVE_TIME_H
+#      include <time.h>
+#    endif
+#  endif
+#endif
+
+/* The most accurate way to get the CPU time is getrusage (). */
+#if defined (HAVE_GETRUSAGE) && defined (HAVE_SYS_RESOURCE_H)
+#  include <sys/resource.h>
+#endif  /* HAVE_GETRUSAGE && HAVE_SYS_RESOURCE_H  */
+
+#if defined (__GNUC__) && (__GNUC__ >= 3)
+#  define ATTRIBUTE_ALWAYS_INLINE __attribute__ ((__always_inline__))
+#else
+#  define ATTRIBUTE_ALWAYS_INLINE
+#endif
+
+static inline int __time_1 (long *, long *, long *, long *) ATTRIBUTE_ALWAYS_INLINE;
+
+/* Helper function for the actual implementation of the DTIME, ETIME and
+   CPU_TIME intrinsics.  Returns a CPU time in microseconds or -1 if no
+   CPU time could be computed.  */
+
+#ifdef __MINGW32__
+
+#define WIN32_LEAN_AND_MEAN
+#include <windows.h>
+
+static int
+__time_1 (long *user_sec, long *user_usec, long *system_sec, long *system_usec)
+{
+  union {
+    FILETIME ft;
+    unsigned long long ulltime;
+  } kernel_time,  user_time;
+
+  FILETIME unused1, unused2;
+  unsigned long long total_time;
+
+  /* No support for Win9x.  The high order bit of the DWORD
+     returned by GetVersion is 0 for NT and higher. */
+  if (GetVersion () >= 0x80000000)
+    {
+      *user_sec = *system_sec = 0;
+      *user_usec = *system_usec = 0;
+      return -1;
+    }
+
+  /* The FILETIME structs filled in by GetProcessTimes represent
+     time in 100 nanosecond units. */
+  GetProcessTimes (GetCurrentProcess (), &unused1, &unused2,
+                  &kernel_time.ft, &user_time.ft);
+
+  *user_sec = user_time.ulltime / 10000000;
+  *user_usec = user_time.ulltime % 10000000;
+
+  *system_sec = kernel_time.ulltime / 10000000;
+  *system_usec = kernel_time.ulltime % 10000000;
+  return 0;
+}
+
+#else
+
+static inline int
+__time_1 (long *user_sec, long *user_usec, long *system_sec, long *system_usec)
+{
+#if defined (HAVE_GETRUSAGE) && defined (HAVE_SYS_RESOURCE_H)
+  struct rusage usage;
+  getrusage (0, &usage);
+
+  *user_sec = usage.ru_utime.tv_sec;
+  *user_usec = usage.ru_utime.tv_usec;
+  *system_sec = usage.ru_stime.tv_sec;
+  *system_usec = usage.ru_stime.tv_usec;
+  return 0;
+
+#else /* ! HAVE_GETRUSAGE || ! HAVE_SYS_RESOURCE_H  */
+
+  /* We have nothing to go on.  Return -1.  */
+  *user_sec = *system_sec = 0;
+  *user_usec = *system_usec = 0;
+  return -1;
+
+#endif
+}
+
+#endif
+
+
+#endif /* LIBGFORTRAN_TIME_H */