summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--gcc/fortran/ChangeLog23
-rw-r--r--gcc/fortran/check.c4
-rw-r--r--gcc/fortran/intrinsic.c14
-rw-r--r--gcc/fortran/intrinsic.h5
-rw-r--r--gcc/fortran/intrinsic.texi23
-rw-r--r--gcc/fortran/iresolve.c10
-rw-r--r--gcc/fortran/trans-intrinsic.c1
-rw-r--r--libgfortran/ChangeLog14
-rw-r--r--libgfortran/Makefile.am1
-rw-r--r--libgfortran/Makefile.in17
-rwxr-xr-xlibgfortran/configure6
-rw-r--r--libgfortran/gfortran.map2
-rw-r--r--libgfortran/intrinsics/cpu_time.c92
-rw-r--r--libgfortran/intrinsics/dtime.c86
-rw-r--r--libgfortran/intrinsics/etime.c31
-rw-r--r--libgfortran/intrinsics/time_1.h142
16 files changed, 349 insertions, 122 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 9db44b24da5..7ffa51d1516 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -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
diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c
index 9cc4d8570de..ba7bcf295bd 100644
--- a/gcc/fortran/check.c
+++ b/gcc/fortran/check.c
@@ -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;
diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c
index 039e2288cd6..227c5ec1c6e 100644
--- a/gcc/fortran/intrinsic.c
+++ b/gcc/fortran/intrinsic.c
@@ -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,
diff --git a/gcc/fortran/intrinsic.h b/gcc/fortran/intrinsic.h
index 59cdfb14eeb..dc544890e49 100644
--- a/gcc/fortran/intrinsic.h
+++ b/gcc/fortran/intrinsic.h
@@ -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 *);
diff --git a/gcc/fortran/intrinsic.texi b/gcc/fortran/intrinsic.texi
index f31ca25a11c..8b177087080 100644
--- a/gcc/fortran/intrinsic.texi
+++ b/gcc/fortran/intrinsic.texi
@@ -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
diff --git a/gcc/fortran/iresolve.c b/gcc/fortran/iresolve.c
index cdc4ac176dd..8a09efcfcb5 100644
--- a/gcc/fortran/iresolve.c
+++ b/gcc/fortran/iresolve.c
@@ -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)
diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index 63c56040eb2..c10d44a1410 100644
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -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:
diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog
index 8f32ca04d7c..0db6850733c 100644
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -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
diff --git a/libgfortran/Makefile.am b/libgfortran/Makefile.am
index 16fcd1f9da3..9721db2c880 100644
--- a/libgfortran/Makefile.am
+++ b/libgfortran/Makefile.am
@@ -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 \
diff --git a/libgfortran/Makefile.in b/libgfortran/Makefile.in
index ebc8a4bc2bd..a58916ba661 100644
--- a/libgfortran/Makefile.in
+++ b/libgfortran/Makefile.in
@@ -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
diff --git a/libgfortran/configure b/libgfortran/configure
index f33516db47f..b1431357d0a 100755
--- a/libgfortran/configure
+++ b/libgfortran/configure
@@ -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%'`
diff --git a/libgfortran/gfortran.map b/libgfortran/gfortran.map
index 92d2aac3ccf..149d29bdca2 100644
--- a/libgfortran/gfortran.map
+++ b/libgfortran/gfortran.map
@@ -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;
diff --git a/libgfortran/intrinsics/cpu_time.c b/libgfortran/intrinsics/cpu_time.c
index add3507df68..c1020dcca40 100644
--- a/libgfortran/intrinsics/cpu_time.c
+++ b/libgfortran/intrinsics/cpu_time.c
@@ -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
index 00000000000..52be4913869
--- /dev/null
+++ b/libgfortran/intrinsics/dtime.c
@@ -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;
+}
diff --git a/libgfortran/intrinsics/etime.c b/libgfortran/intrinsics/etime.c
index c4d25c4160a..0ecba26359a 100644
--- a/libgfortran/intrinsics/etime.c
+++ b/libgfortran/intrinsics/etime.c
@@ -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
index 00000000000..43e6d8960c1
--- /dev/null
+++ b/libgfortran/intrinsics/time_1.h
@@ -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 */
OpenPOWER on IntegriCloud