Include "libguile/async.h" for SCM_CRITICAL_SECTION_START/END.
[bpt/guile.git] / libguile / stime.c
index 32b58f4..fcd02f4 100644 (file)
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2003, 2004 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2003, 2004, 2005 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public
 
 \f
 
+/* _POSIX_C_SOURCE is not defined always, because it causes problems on some
+   systems, notably
+
+       - FreeBSD loses all BSD and XOPEN defines.
+       - glibc loses some things like CLK_TCK.
+       - On MINGW it conflicts with the pthread headers.
+
+   But on HP-UX _POSIX_C_SOURCE is needed, as noted, for gmtime_r.
+
+   Perhaps a configure test could figure out what _POSIX_C_SOURCE gives and
+   what it takes away, and decide from that whether to use it, instead of
+   hard coding __hpux.  */
+
 #define _GNU_SOURCE  /* ask glibc for everything, in particular strptime */
-#ifndef __MINGW32__
+#ifdef __hpux
 #define _POSIX_C_SOURCE 199506L  /* for gmtime_r prototype */
 #endif
 
@@ -31,6 +44,7 @@
 #include <errno.h>
 
 #include "libguile/_scm.h"
+#include "libguile/async.h"
 #include "libguile/feature.h"
 #include "libguile/strings.h"
 #include "libguile/vectors.h"
@@ -173,11 +187,11 @@ SCM_DEFINE (scm_times, "times", 0, 0, 0,
   rv = times (&t);
   if (rv == -1)
     SCM_SYSERROR;
-  SCM_VECTOR_SET (result, 0, scm_from_long (rv));
-  SCM_VECTOR_SET (result, 1, scm_from_long (t.tms_utime));
-  SCM_VECTOR_SET (result, 2, scm_from_long (t.tms_stime));
-  SCM_VECTOR_SET (result ,3, scm_from_long (t.tms_cutime));
-  SCM_VECTOR_SET (result, 4, scm_from_long (t.tms_cstime));
+  SCM_SIMPLE_VECTOR_SET (result, 0, scm_from_long (rv));
+  SCM_SIMPLE_VECTOR_SET (result, 1, scm_from_long (t.tms_utime));
+  SCM_SIMPLE_VECTOR_SET (result, 2, scm_from_long (t.tms_stime));
+  SCM_SIMPLE_VECTOR_SET (result ,3, scm_from_long (t.tms_cutime));
+  SCM_SIMPLE_VECTOR_SET (result, 4, scm_from_long (t.tms_cstime));
   return result;
 }
 #undef FUNC_NAME
@@ -217,9 +231,9 @@ SCM_DEFINE (scm_current_time, "current-time", 0, 0, 0,
 {
   timet timv;
 
-  SCM_DEFER_INTS;
+  SCM_CRITICAL_SECTION_START;
   timv = time (NULL);
-  SCM_ALLOW_INTS;
+  SCM_CRITICAL_SECTION_END;
   if (timv == -1)
     SCM_MISC_ERROR ("current time not available", SCM_EOL);
   return scm_from_long (timv);
@@ -238,10 +252,10 @@ SCM_DEFINE (scm_gettimeofday, "gettimeofday", 0, 0, 0,
   struct timeval time;
   int ret, err;
 
-  SCM_DEFER_INTS;
+  SCM_CRITICAL_SECTION_START;
   ret = gettimeofday (&time, NULL);
   err = errno;
-  SCM_ALLOW_INTS;
+  SCM_CRITICAL_SECTION_END;
   if (ret == -1)
     {
       errno = err;
@@ -260,10 +274,10 @@ SCM_DEFINE (scm_gettimeofday, "gettimeofday", 0, 0, 0,
   timet timv;
   int err;
 
-  SCM_DEFER_INTS;
+  SCM_CRITICAL_SECTION_START;
   timv = time (NULL);
   err = errno;
-  SCM_ALLOW_INTS;
+  SCM_CRITICAL_SECTION_END;
   if (timv == -1)
     {
       errno = err;
@@ -280,19 +294,19 @@ filltime (struct tm *bd_time, int zoff, const char *zname)
 {
   SCM result = scm_c_make_vector (11, SCM_UNDEFINED);
 
-  SCM_VECTOR_SET (result,0, scm_from_int (bd_time->tm_sec));
-  SCM_VECTOR_SET (result,1, scm_from_int (bd_time->tm_min));
-  SCM_VECTOR_SET (result,2, scm_from_int (bd_time->tm_hour));
-  SCM_VECTOR_SET (result,3, scm_from_int (bd_time->tm_mday));
-  SCM_VECTOR_SET (result,4, scm_from_int (bd_time->tm_mon));
-  SCM_VECTOR_SET (result,5, scm_from_int (bd_time->tm_year));
-  SCM_VECTOR_SET (result,6, scm_from_int (bd_time->tm_wday));
-  SCM_VECTOR_SET (result,7, scm_from_int (bd_time->tm_yday));
-  SCM_VECTOR_SET (result,8, scm_from_int (bd_time->tm_isdst));
-  SCM_VECTOR_SET (result,9, scm_from_int (zoff));
-  SCM_VECTOR_SET (result,10, (zname 
-                             ? scm_from_locale_string (zname)
-                             : SCM_BOOL_F));
+  SCM_SIMPLE_VECTOR_SET (result,0, scm_from_int (bd_time->tm_sec));
+  SCM_SIMPLE_VECTOR_SET (result,1, scm_from_int (bd_time->tm_min));
+  SCM_SIMPLE_VECTOR_SET (result,2, scm_from_int (bd_time->tm_hour));
+  SCM_SIMPLE_VECTOR_SET (result,3, scm_from_int (bd_time->tm_mday));
+  SCM_SIMPLE_VECTOR_SET (result,4, scm_from_int (bd_time->tm_mon));
+  SCM_SIMPLE_VECTOR_SET (result,5, scm_from_int (bd_time->tm_year));
+  SCM_SIMPLE_VECTOR_SET (result,6, scm_from_int (bd_time->tm_wday));
+  SCM_SIMPLE_VECTOR_SET (result,7, scm_from_int (bd_time->tm_yday));
+  SCM_SIMPLE_VECTOR_SET (result,8, scm_from_int (bd_time->tm_isdst));
+  SCM_SIMPLE_VECTOR_SET (result,9, scm_from_int (zoff));
+  SCM_SIMPLE_VECTOR_SET (result,10, (zname 
+                                    ? scm_from_locale_string (zname)
+                                    : SCM_BOOL_F));
   return result;
 }
 
@@ -362,7 +376,7 @@ SCM_DEFINE (scm_localtime, "localtime", 1, 1, 0,
 
   /* deferring interupts is essential since a) setzone may install a temporary
      environment b) localtime uses a static buffer.  */
-  SCM_DEFER_INTS;
+  SCM_CRITICAL_SECTION_START;
   oldenv = setzone (zone, SCM_ARG2, FUNC_NAME);
 #ifdef LOCALTIME_CACHE
   tzset ();
@@ -415,7 +429,7 @@ SCM_DEFINE (scm_localtime, "localtime", 1, 1, 0,
     zoff += 24 * 60 * 60;
 
   result = filltime (&lt, zoff, zname);
-  SCM_ALLOW_INTS;
+  SCM_CRITICAL_SECTION_END;
   if (zname)
     free (zname);
   return result;
@@ -448,11 +462,11 @@ SCM_DEFINE (scm_gmtime, "gmtime", 1, 0, 0,
 #if HAVE_GMTIME_R
   bd_time = gmtime_r (&itime, &bd_buf);
 #else
-  SCM_DEFER_INTS;
+  SCM_CRITICAL_SECTION_START;
   bd_time = gmtime (&itime);
   if (bd_time != NULL)
     bd_buf = *bd_time;
-  SCM_ALLOW_INTS;
+  SCM_CRITICAL_SECTION_END;
 #endif
   if (bd_time == NULL)
     SCM_SYSERROR;
@@ -470,35 +484,25 @@ SCM_DEFINE (scm_gmtime, "gmtime", 1, 0, 0,
 static void
 bdtime2c (SCM sbd_time, struct tm *lt, int pos, const char *subr)
 {
-  SCM const *velts;
-  int i;
-
-  SCM_ASSERT (SCM_VECTORP (sbd_time)
-             && SCM_VECTOR_LENGTH (sbd_time) == 11,
-             sbd_time, pos, subr);
-  velts = SCM_VELTS (sbd_time);
-  for (i = 0; i < 10; i++)
-    {
-      SCM_ASSERT (scm_is_integer (velts[i]), sbd_time, pos, subr);
-    }
-  SCM_ASSERT (scm_is_false (velts[10]) || scm_is_string (velts[10]),
+  SCM_ASSERT (scm_is_simple_vector (sbd_time)
+             && SCM_SIMPLE_VECTOR_LENGTH (sbd_time) == 11,
              sbd_time, pos, subr);
 
-  lt->tm_sec = scm_to_int (velts[0]);
-  lt->tm_min = scm_to_int (velts[1]);
-  lt->tm_hour = scm_to_int (velts[2]);
-  lt->tm_mday = scm_to_int (velts[3]);
-  lt->tm_mon = scm_to_int (velts[4]);
-  lt->tm_year = scm_to_int (velts[5]);
-  lt->tm_wday = scm_to_int (velts[6]);
-  lt->tm_yday = scm_to_int (velts[7]);
-  lt->tm_isdst = scm_to_int (velts[8]);
+  lt->tm_sec = scm_to_int (SCM_SIMPLE_VECTOR_REF (sbd_time, 0));
+  lt->tm_min = scm_to_int (SCM_SIMPLE_VECTOR_REF (sbd_time, 1));
+  lt->tm_hour = scm_to_int (SCM_SIMPLE_VECTOR_REF (sbd_time, 2));
+  lt->tm_mday = scm_to_int (SCM_SIMPLE_VECTOR_REF (sbd_time, 3));
+  lt->tm_mon = scm_to_int (SCM_SIMPLE_VECTOR_REF (sbd_time, 4));
+  lt->tm_year = scm_to_int (SCM_SIMPLE_VECTOR_REF (sbd_time, 5));
+  lt->tm_wday = scm_to_int (SCM_SIMPLE_VECTOR_REF (sbd_time, 6));
+  lt->tm_yday = scm_to_int (SCM_SIMPLE_VECTOR_REF (sbd_time, 7));
+  lt->tm_isdst = scm_to_int (SCM_SIMPLE_VECTOR_REF (sbd_time, 8));
 #ifdef HAVE_TM_ZONE
-  lt->tm_gmtoff = scm_to_int (velts[9]);
-  if (scm_is_false (velts[10]))
+  lt->tm_gmtoff = scm_to_int (SCM_SIMPLE_VECTOR_REF (sbd_time, 9));
+  if (scm_is_false (SCM_SIMPLE_VECTOR_REF (sbd_time, 10)))
     lt->tm_zone = NULL;
   else
-    lt->tm_zone  = scm_to_locale_string (velts[10]);
+    lt->tm_zone  = scm_to_locale_string (SCM_SIMPLE_VECTOR_REF (sbd_time, 10));
 #endif
 }
 
@@ -528,7 +532,7 @@ SCM_DEFINE (scm_mktime, "mktime", 1, 1, 0,
   scm_frame_free ((char *)lt.tm_zone);
 #endif
 
-  SCM_DEFER_INTS;
+  SCM_CRITICAL_SECTION_START;
   oldenv = setzone (zone, SCM_ARG2, FUNC_NAME);
 #ifdef LOCALTIME_CACHE
   tzset ();
@@ -557,6 +561,7 @@ SCM_DEFINE (scm_mktime, "mktime", 1, 1, 0,
   /* get timezone offset in seconds west of UTC.  */
   /* POSIX says gmtime sets errno, but C99 doesn't say that.
      Give a sensible default value in case gmtime doesn't set it.  */
+  errno = EINVAL;
   utc = gmtime (&itime);
   if (utc == NULL)
     err = errno;
@@ -580,7 +585,7 @@ SCM_DEFINE (scm_mktime, "mktime", 1, 1, 0,
 
   result = scm_cons (scm_from_long (itime),
                     filltime (&lt, zoff, zname));
-  SCM_ALLOW_INTS;
+  SCM_CRITICAL_SECTION_END;
   if (zname)
     free (zname);
 
@@ -663,7 +668,7 @@ SCM_DEFINE (scm_strftime, "strftime", 2, 0, 0,
                                                 SCM_EOL)));
 
        have_zone = 1;
-       SCM_DEFER_INTS;
+       SCM_CRITICAL_SECTION_START;
        oldenv = setzone (zone, SCM_ARG2, FUNC_NAME);
       }
 #endif
@@ -686,7 +691,7 @@ SCM_DEFINE (scm_strftime, "strftime", 2, 0, 0,
     if (have_zone)
       {
        restorezone (velts[10], oldenv, FUNC_NAME);
-       SCM_ALLOW_INTS;
+       SCM_CRITICAL_SECTION_END;
       }
 #endif
     }
@@ -694,6 +699,9 @@ SCM_DEFINE (scm_strftime, "strftime", 2, 0, 0,
   result = scm_from_locale_stringn (tbuf + 1, len - 1);
   free (tbuf);
   free (myfmt);
+#if HAVE_STRUCT_TM_TM_ZONE
+  free ((char *) t.tm_zone);
+#endif
   return result;
 }
 #undef FUNC_NAME
@@ -736,11 +744,11 @@ SCM_DEFINE (scm_strptime, "strptime", 2, 0, 0,
 
   /* GNU glibc strptime() "%s" is affected by the current timezone, since it
      reads a UTC time_t value and converts with localtime_r() to set the tm
-     fields, hence the use of SCM_DEFER_INTS.  */
+     fields, hence the use of SCM_CRITICAL_SECTION_START.  */
   t.tm_isdst = -1;
-  SCM_DEFER_INTS;
+  SCM_CRITICAL_SECTION_START;
   rest = strptime (str, fmt, &t);
-  SCM_ALLOW_INTS;
+  SCM_CRITICAL_SECTION_END;
   if (rest == NULL)
     {
       /* POSIX doesn't say strptime sets errno, and on glibc 2.3.2 for