re PR fortran/34533 (DTIME returns total process time and not since last invocation)
gcc/fortran: 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. From-SVN: r131168
This commit is contained in:
Daniel Franke
Daniel Franke
parent
54a838424e
commit
a1ba31ced9
@ -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
|
||||
|
||||
@ -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;
|
||||
|
||||
@ -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,
|
||||
|
||||
@ -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 *);
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -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:
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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 \
|
||||
|
||||
@ -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
|
||||
|
||||
6
libgfortran/configure
vendored
6
libgfortran/configure
vendored
@ -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%'`
|
||||
|
||||
@ -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;
|
||||
|
||||
@ -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);
|
||||
|
||||
86
libgfortran/intrinsics/dtime.c
Normal file
86
libgfortran/intrinsics/dtime.c
Normal file
@ -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;
|
||||
}
|
||||
@ -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;
|
||||
|
||||
|
||||
142
libgfortran/intrinsics/time_1.h
Normal file
142
libgfortran/intrinsics/time_1.h
Normal file
@ -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 */
|
||||
Loading…
Reference in New Issue
Block a user