* stime.h: prototype for scm_times.
[bpt/guile.git] / libguile / stime.c
index 2847c04..fa29192 100644 (file)
@@ -12,7 +12,8 @@
  * 
  * You should have received a copy of the GNU General Public License
  * along with this software; see the file COPYING.  If not, write to
- * the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+ * the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
+ * Boston, MA 02111-1307 USA
  *
  * As a special exception, the Free Software Foundation gives permission
  * for additional uses of the text contained in its release of GUILE.
@@ -36,8 +37,7 @@
  *
  * If you write modifications of your own for GUILE, it is your choice
  * whether to permit this exception to apply to your modifications.
- * If you do not wish that, delete this exception notice.  
- */
+ * If you do not wish that, delete this exception notice.  */
 \f
 
 #include <stdio.h>
 #  endif
 # endif
 
-# ifdef HAVE_SYS_TIMES_H
-#  include <sys/times.h>
-# else
-#  ifdef HAVE_SYS_TIMEB_H
-#   include <sys/timeb.h>
-#  endif
-# endif
+#ifdef HAVE_SYS_TIMES_H
+# include <sys/times.h>
+#endif
+
+#ifdef HAVE_SYS_TIMEB_H
+# include <sys/timeb.h>
+#endif
 
 #ifndef tzname /* For SGI.  */
 extern char *tzname[]; /* RS6000 and others reject char **tzname.  */
@@ -105,12 +105,6 @@ char *strptime ();
 # endif
 #endif
 
-
-# ifdef HAVE_FTIME
-#   include <sys/timeb.h>
-# endif
-
-
 #ifdef __STDC__
 # define timet time_t
 #else
@@ -166,6 +160,33 @@ scm_get_internal_real_time()
 }
 #endif
 
+SCM_PROC (s_times, "times", 0, 0, 0, scm_times);
+SCM
+scm_times (void)
+{
+#ifdef HAVE_TIMES
+  struct tms t;
+  clock_t rv;
+
+  SCM result = scm_make_vector (SCM_MAKINUM(5), SCM_UNDEFINED, SCM_UNDEFINED);
+  rv = times (&t);
+  if (rv == -1)
+    scm_syserror (s_times);
+  SCM_VELTS (result)[0] = scm_long2num (rv);
+  SCM_VELTS (result)[1] = scm_long2num (t.tms_utime);
+  SCM_VELTS (result)[2] = scm_long2num (t.tms_stime);
+  SCM_VELTS (result)[3] = scm_long2num (t.tms_cutime);
+  SCM_VELTS (result)[4] = scm_long2num (t.tms_cstime);
+  return result;
+#else
+  scm_sysmissing (s_times);
+#endif
+}
+
+#ifndef HAVE_TZSET
+/* GNU-WIN32's cygwin.dll doesn't have this. */
+#define tzset()
+#endif
 
 
 static long scm_my_base = 0;
@@ -251,14 +272,15 @@ setzone (SCM zone, int pos, char *subr)
       char *buf;
 
       /* if zone was supplied, set the environment variable TZ temporarily.  */
-      SCM_ASSERT (SCM_NIMP (zone) && SCM_STRINGP (zone), zone, pos, subr);
+      SCM_ASSERT (SCM_NIMP (zone) && SCM_ROSTRINGP (zone), zone, pos, subr);
+      SCM_COERCE_SUBSTR (zone);
       buf = malloc (SCM_LENGTH (zone) + 4);
       if (buf == 0)
        scm_memory_error (subr);
       oldtz = getenv ("TZ");
       if (oldtz != NULL)
        oldtz = oldtz - 3;
-      sprintf (buf, "TZ=%s", SCM_CHARS (zone));
+      sprintf (buf, "TZ=%s", SCM_ROCHARS (zone));
       if (putenv (buf) < 0)
        scm_syserror (subr);
       tzset();
@@ -289,7 +311,7 @@ SCM
 scm_localtime (SCM time, SCM zone)
 {
   timet itime;
-  struct tm *lt, *utc;
+  struct tm *ltptr, lt, *utc;
   SCM result;
   int zoff;
   char *zname = 0;
@@ -299,44 +321,50 @@ scm_localtime (SCM time, SCM zone)
   itime = scm_num2long (time, (char *) SCM_ARG1, s_localtime);
   SCM_DEFER_INTS;
   oldtz = setzone (zone, SCM_ARG2, s_localtime);
-  lt = localtime (&itime);
+  ltptr = localtime (&itime);
   err = errno;
+  /* copied in case localtime and gmtime share a buffer.  */
+  if (ltptr)
+    lt = *ltptr;
   utc = gmtime (&itime);
   if (utc == NULL)
     err = errno;
-  if (lt)
+  if (ltptr)
     {
 #ifdef HAVE_TM_ZONE
-      zname = lt->tm_zone;
+      zname = lt.tm_zone;
 #else
 # ifdef HAVE_TZNAME
       /* must be copied before calling tzset again.  */
-      char *ptr = tzname[ (lt->tm_isdst == 1) ? 1 : 0 ];
+      char *ptr = tzname[ (lt.tm_isdst == 1) ? 1 : 0 ];
 
       zname = scm_must_malloc (strlen (ptr) + 1, s_localtime);
       strcpy (zname, ptr);
-#endif
+# else
+      scm_misc_error (s_localtime, "Not fully implemented on this platform",
+                     SCM_EOL);
+# endif
 #endif
     }
   restorezone (zone, oldtz);
   /* delayed until zone has been restored.  */
   errno = err;
-  if (utc == NULL || lt == NULL)
+  if (utc == NULL || ltptr == NULL)
     scm_syserror (s_localtime);
 
   /* calculate timezone offset in seconds west of UTC.  */
-  zoff = (utc->tm_hour - lt->tm_hour) * 3600 + (utc->tm_min - lt->tm_min) * 60
-    + utc->tm_sec - lt->tm_sec;
-  if (utc->tm_year < lt->tm_year)
+  zoff = (utc->tm_hour - lt.tm_hour) * 3600 + (utc->tm_min - lt.tm_min) * 60
+    + utc->tm_sec - lt.tm_sec;
+  if (utc->tm_year < lt.tm_year)
     zoff -= 24 * 60 * 60;
-  else if (utc->tm_year > lt->tm_year)
+  else if (utc->tm_year > lt.tm_year)
     zoff += 24 * 60 * 60;
-  else if (utc->tm_yday < lt->tm_yday)
+  else if (utc->tm_yday < lt.tm_yday)
     zoff -= 24 * 60 * 60;
-  else if (utc->tm_yday > lt->tm_yday)
+  else if (utc->tm_yday > lt.tm_yday)
     zoff += 24 * 60 * 60;
   
-  result = filltime (lt, zoff, zname);
+  result = filltime (&lt, zoff, zname);
   SCM_ALLOW_INTS;
   return result;
 }
@@ -423,7 +451,10 @@ scm_mktime (SCM sbd_time, SCM zone)
 
       zname = scm_must_malloc (strlen (ptr) + 1, s_mktime);
       strcpy (zname, ptr);
-#endif
+# else
+      scm_misc_error (s_localtime, "Not fully implemented on this platform",
+                     SCM_EOL);
+# endif
 #endif
     }
   restorezone (zone, oldtz);
@@ -471,10 +502,11 @@ scm_strftime (format, stime)
   char *fmt;
   int len;
 
-  SCM_ASSERT (SCM_NIMP (format) && SCM_STRINGP (format), format, SCM_ARG1,
+  SCM_ASSERT (SCM_NIMP (format) && SCM_ROSTRINGP (format), format, SCM_ARG1,
              s_strftime);
   bdtime2c (stime, &t, SCM_ARG2, s_strftime);
 
+  SCM_COERCE_SUBSTR (format);
   fmt = SCM_ROCHARS (format);
   len = SCM_ROLENGTH (format);
 
@@ -504,6 +536,8 @@ scm_strptime (format, string)
   SCM_ASSERT (SCM_NIMP (string) && SCM_ROSTRINGP (string), string, SCM_ARG2,
              s_strptime);
 
+  SCM_COERCE_SUBSTR (format);
+  SCM_COERCE_SUBSTR (string);
   fmt = SCM_ROCHARS (format);
   str = SCM_ROCHARS (string);