PR 82869 Introduce logical_type_node and use it
[gcc.git] / libgfortran / intrinsics / dtime.c
index 40028a689c20d27834f56bd22a4c3b5650128cb8..befff1a90d4949bd0b5c3fc00267e5306b8afa9e 100644 (file)
@@ -1,7 +1,7 @@
 /* Implementation of the dtime intrinsic.
-   Copyright (C) 2004, 2005, 2006, 2007, 2009 Free Software Foundation, Inc.
+   Copyright (C) 2004-2017 Free Software Foundation, Inc.
 
-This file is part of the GNU Fortran 95 runtime library (libgfortran).
+This file is part of the GNU Fortran runtime library (libgfortran).
 
 Libgfortran is free software; you can redistribute it and/or
 modify it under the terms of the GNU General Public
@@ -38,31 +38,36 @@ 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;
+  static long us = 0, uu = 0, ss = 0 , su = 0;
+  GFC_REAL_4 tu, ts, tt;
 
-  if (((t->dim[0].ubound + 1 - t->dim[0].lbound)) < 2)
+  if (((GFC_DESCRIPTOR_EXTENT(t,0))) < 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)
+  if (gf_cputime (&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;
+      tu = (GFC_REAL_4) ((user_sec - us) + 1.e-6 * (user_usec - uu));
+      ts = (GFC_REAL_4) ((system_sec - ss) + 1.e-6 * (system_usec - su));
       tt = tu + ts;
+      us = user_sec;
+      uu = user_usec;
+      ss = system_sec;
+      su = system_usec;
     }
   else
     {
-      tu = (GFC_REAL_4)-1.0;
-      ts = (GFC_REAL_4)-1.0;
-      tt = (GFC_REAL_4)-1.0;
+      tu = -1;
+      ts = -1;
+      tt = -1;
     }
 
-  tp = t->data;
+  tp = t->base_addr;
 
   *tp = tu;
-  tp += t->dim[0].stride;
+  tp += GFC_DESCRIPTOR_STRIDE(t,0);
   *tp = ts;
   *result = tt;
   __gthread_mutex_unlock (&dtime_update_lock);