diff options
author | dfranke <dfranke@138bc75d-0d04-0410-961f-82ee72b054a4> | 2007-12-25 10:41:44 +0000 |
---|---|---|
committer | dfranke <dfranke@138bc75d-0d04-0410-961f-82ee72b054a4> | 2007-12-25 10:41:44 +0000 |
commit | dd6c1457b279f399a5cbecbce067851a494e954f (patch) | |
tree | 4b9ff08a07e57806321780593e88a8b23ebe3846 /libgfortran/intrinsics/dtime.c | |
parent | 83fc1a28ee38afd5df7e7c87939d5a32e17fee96 (diff) | |
download | ppe42-gcc-dd6c1457b279f399a5cbecbce067851a494e954f.tar.gz ppe42-gcc-dd6c1457b279f399a5cbecbce067851a494e954f.zip |
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.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@131168 138bc75d-0d04-0410-961f-82ee72b054a4
Diffstat (limited to 'libgfortran/intrinsics/dtime.c')
-rw-r--r-- | libgfortran/intrinsics/dtime.c | 86 |
1 files changed, 86 insertions, 0 deletions
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; +} |