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
 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
 
 
 try
-gfc_check_etime (gfc_expr *x)
+gfc_check_dtime_etime (gfc_expr *x)
 {
   if (array_check (x, 0) == FAILURE)
     return FAILURE;
 {
   if (array_check (x, 0) == FAILURE)
     return FAILURE;
@@ -3252,7 +3252,7 @@ gfc_check_etime (gfc_expr *x)
 
 
 try
 
 
 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;
 {
   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 */
   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);
 
             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);
 
 
   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,
 
   /* 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,
              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,
              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_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 *);
 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 *);
                      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 *);
 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_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 *);
 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.
 
 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
 
 @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.
 
 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.
 
 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}:
 @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
 
 @item @emph{Example}:
 @smallexample
@@ -3372,6 +3389,10 @@ program test_dtime
     print *, tarray(2)
 end program test_dtime
 @end smallexample
     print *, tarray(2)
 end program test_dtime
 @end smallexample
+
+@item @emph{See also}:
+@ref{CPU_TIME}
+
 @end table
 
 
 @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)
 
 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_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:
     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
 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/cshift0.c \
 intrinsics/ctime.c \
 intrinsics/date_and_time.c \
+intrinsics/dtime.c \
 intrinsics/env.c \
 intrinsics/eoshift0.c \
 intrinsics/eoshift2.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/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 \
        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 \
        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 \
        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/cshift0.c \
 intrinsics/ctime.c \
 intrinsics/date_and_time.c \
+intrinsics/dtime.c \
 intrinsics/env.c \
 intrinsics/eoshift0.c \
 intrinsics/eoshift2.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)/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@
 @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
 
 @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
 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
          /^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
     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; }; }
   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
    { (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%'`
   { 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_ctime;
     _gfortran_ctime_sub;
     _gfortran_date_and_time;
+    _gfortran_dtime;
+    _gfortran_dtime_sub;
     _gfortran_eoshift0_1;
     _gfortran_eoshift0_1_char;
     _gfortran_eoshift0_2;
     _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"
 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.  */
 
 /* 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
 /* 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
 #    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;
 
 
 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)
 {
 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;
 #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 */
   *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);
 
 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"
 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);
 
 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;
 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
     {
       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;
 
 
   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 */