* threads.h, threads.c: Moved futures to their own file.
[bpt/guile.git] / libguile / stime.c
index f99656d..12c5a1b 100644 (file)
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2003 Free Software Foundation, Inc.
  *
  * This program is free software; you can redistribute it and/or modify
  * it under the terms of the GNU General Public License as published by
@@ -39,8 +39,6 @@
  * whether to permit this exception to apply to your modifications.
  * If you do not wish that, delete this exception notice.  */
 
-/* Software engineering face-lift by Greg J. Badros, 11-Dec-1999,
-   gjb@cs.washington.edu, http://www.cs.washington.edu/homes/gjb */
 
 \f
 
 #include <string.h>
 #endif
 
-# ifdef TIME_WITH_SYS_TIME
-#  include <sys/time.h>
-#  include <time.h>
-# else
-#  ifdef HAVE_SYS_TIME_H
-#   include <sys/time.h>
-#  else
-#   ifdef HAVE_TIME_H
-#    include <time.h>
-#   endif
-#  endif
-# endif
-
 #ifdef HAVE_SYS_TIMES_H
 # include <sys/times.h>
 #endif
 #ifndef tzname /* For SGI.  */
 extern char *tzname[]; /* RS6000 and others reject char **tzname.  */
 #endif
+#if defined (__MINGW32__)
+# define tzname _tzname
+#endif
 
 #ifdef MISSING_STRPTIME_DECL
 extern char *strptime ();
 #endif
 
-/* This should be figured out by autoconf.  */
-#if ! defined(CLKTCK) && defined(CLK_TCK)
-#  define CLKTCK CLK_TCK
-#endif
-#if ! defined(CLKTCK) && defined(CLOCKS_PER_SEC)
-#  define CLKTCK CLOCKS_PER_SEC
-#endif
-#if ! defined(CLKTCK)
-#  define CLKTCK 60
-#endif
-
 #ifdef __STDC__
 # define timet time_t
 #else
@@ -124,7 +101,7 @@ timet mytime()
 }
 #else
 # ifdef LACK_CLOCK
-#    define mytime() ((time((timet*)0) - scm_your_base) * CLKTCK)
+#    define mytime() ((time((timet*)0) - scm_your_base) * SCM_TIME_UNITS_PER_SECOND)
 # else
 #  define mytime clock
 # endif
@@ -152,10 +129,10 @@ SCM_DEFINE (scm_get_internal_real_time, "get-internal-real-time", 0, 0, 0,
   tmp = scm_sum (tmp,
                 scm_product (SCM_MAKINUM (1000),
                              SCM_MAKINUM (time_buffer.time)));
-  return scm_quotient (scm_product (tmp, SCM_MAKINUM (CLKTCK)),
+  return scm_quotient (scm_product (tmp, SCM_MAKINUM (SCM_TIME_UNITS_PER_SECOND)),
                       SCM_MAKINUM (1000));
 #else
-  return scm_long2num((time((timet*)0) - scm_your_base) * (int)CLKTCK);
+  return scm_long2num((time((timet*)0) - scm_your_base) * (int)SCM_TIME_UNITS_PER_SECOND);
 #endif /* HAVE_FTIME */
 }
 #undef FUNC_NAME
@@ -194,11 +171,11 @@ SCM_DEFINE (scm_times, "times", 0, 0, 0,
   rv = times (&t);
   if (rv == -1)
     SCM_SYSERROR;
-  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);
+  SCM_VECTOR_SET (result, 0, scm_long2num (rv));
+  SCM_VECTOR_SET (result, 1, scm_long2num (t.tms_utime));
+  SCM_VECTOR_SET (result, 2, scm_long2num (t.tms_stime));
+  SCM_VECTOR_SET (result ,3, scm_long2num (t.tms_cutime));
+  SCM_VECTOR_SET (result, 4, scm_long2num (t.tms_cstime));
   return result;
 }
 #undef FUNC_NAME
@@ -281,17 +258,17 @@ filltime (struct tm *bd_time, int zoff, char *zname)
 {
   SCM result = scm_c_make_vector (11, SCM_UNDEFINED);
 
-  SCM_VELTS (result)[0] = SCM_MAKINUM (bd_time->tm_sec);
-  SCM_VELTS (result)[1] = SCM_MAKINUM (bd_time->tm_min);
-  SCM_VELTS (result)[2] = SCM_MAKINUM (bd_time->tm_hour);
-  SCM_VELTS (result)[3] = SCM_MAKINUM (bd_time->tm_mday);
-  SCM_VELTS (result)[4] = SCM_MAKINUM (bd_time->tm_mon);
-  SCM_VELTS (result)[5] = SCM_MAKINUM (bd_time->tm_year);
-  SCM_VELTS (result)[6] = SCM_MAKINUM (bd_time->tm_wday);
-  SCM_VELTS (result)[7] = SCM_MAKINUM (bd_time->tm_yday);
-  SCM_VELTS (result)[8] = SCM_MAKINUM (bd_time->tm_isdst);
-  SCM_VELTS (result)[9] = SCM_MAKINUM (zoff);
-  SCM_VELTS (result)[10] = zname ? scm_makfrom0str (zname) : SCM_BOOL_F;
+  SCM_VECTOR_SET (result,0, SCM_MAKINUM (bd_time->tm_sec));
+  SCM_VECTOR_SET (result,1, SCM_MAKINUM (bd_time->tm_min));
+  SCM_VECTOR_SET (result,2, SCM_MAKINUM (bd_time->tm_hour));
+  SCM_VECTOR_SET (result,3, SCM_MAKINUM (bd_time->tm_mday));
+  SCM_VECTOR_SET (result,4, SCM_MAKINUM (bd_time->tm_mon));
+  SCM_VECTOR_SET (result,5, SCM_MAKINUM (bd_time->tm_year));
+  SCM_VECTOR_SET (result,6, SCM_MAKINUM (bd_time->tm_wday));
+  SCM_VECTOR_SET (result,7, SCM_MAKINUM (bd_time->tm_yday));
+  SCM_VECTOR_SET (result,8, SCM_MAKINUM (bd_time->tm_isdst));
+  SCM_VECTOR_SET (result,9, SCM_MAKINUM (zoff));
+  SCM_VECTOR_SET (result,10, zname ? scm_makfrom0str (zname) : SCM_BOOL_F);
   return result;
 }
 
@@ -313,8 +290,7 @@ setzone (SCM zone, int pos, const char *subr)
       char *buf;
 
       SCM_ASSERT (SCM_STRINGP (zone), zone, pos, subr);
-      SCM_STRING_COERCE_0TERMINATION_X (zone);
-      buf = scm_must_malloc (SCM_STRING_LENGTH (zone) + sizeof (tzvar) + 1, subr);
+      buf = scm_malloc (SCM_STRING_LENGTH (zone) + sizeof (tzvar) + 1);
       sprintf (buf, "%s=%s", tzvar, SCM_STRING_CHARS (zone));
       oldenv = environ;
       tmpenv[0] = buf;
@@ -329,7 +305,7 @@ restorezone (SCM zone, char **oldenv, const char *subr SCM_UNUSED)
 {
   if (!SCM_UNBNDP (zone))
     {
-      scm_must_free (environ[0]);
+      free (environ[0]);
       environ = oldenv;
 #ifdef HAVE_TZSET
       /* for the possible benefit of user code linked with libguile.  */
@@ -378,7 +354,7 @@ SCM_DEFINE (scm_localtime, "localtime", 1, 1, 0,
 #else
       ptr = "";
 #endif
-      zname = SCM_MUST_MALLOC (strlen (ptr) + 1);
+      zname = scm_malloc (strlen (ptr) + 1);
       strcpy (zname, ptr);
     }
   /* the struct is copied in case localtime and gmtime share a buffer.  */
@@ -407,7 +383,8 @@ SCM_DEFINE (scm_localtime, "localtime", 1, 1, 0,
 
   result = filltime (&lt, zoff, zname);
   SCM_ALLOW_INTS;
-  scm_must_free (zname);
+  if (zname)
+    free (zname);
   return result;
 }
 #undef FUNC_NAME
@@ -438,7 +415,7 @@ SCM_DEFINE (scm_gmtime, "gmtime", 1, 0, 0,
 static void
 bdtime2c (SCM sbd_time, struct tm *lt, int pos, const char *subr)
 {
-  SCM *velts;
+  SCM const *velts;
   int i;
 
   SCM_ASSERT (SCM_VECTORP (sbd_time)
@@ -511,7 +488,7 @@ SCM_DEFINE (scm_mktime, "mktime", 1, 1, 0,
 #else
       ptr = "";
 #endif
-      zname = SCM_MUST_MALLOC (strlen (ptr) + 1);
+      zname = scm_malloc (strlen (ptr) + 1);
       strcpy (zname, ptr);
     }
 
@@ -540,7 +517,8 @@ SCM_DEFINE (scm_mktime, "mktime", 1, 1, 0,
   result = scm_cons (scm_long2num ((long) itime),
                     filltime (&lt, zoff, zname));
   SCM_ALLOW_INTS;
-  scm_must_free (zname);
+  if (zname)
+    free (zname);
   return result;
 }
 #undef FUNC_NAME
@@ -582,7 +560,6 @@ SCM_DEFINE (scm_strftime, "strftime", 2, 0, 0,
   SCM_VALIDATE_STRING (1, format);
   bdtime2c (stime, &t, SCM_ARG2, FUNC_NAME);
 
-  SCM_STRING_COERCE_0TERMINATION_X (format);
   fmt = SCM_STRING_CHARS (format);
   len = SCM_STRING_LENGTH (format);
 
@@ -591,12 +568,12 @@ SCM_DEFINE (scm_strftime, "strftime", 2, 0, 0,
      a zero-byte output string!  Workaround is to prepend a junk
      character to the format string, so that valid returns are always
      nonzero. */
-  myfmt = SCM_MUST_MALLOC (len+2);
+  myfmt = scm_malloc (len+2);
   *myfmt = 'x';
   strncpy(myfmt+1, fmt, len);
   myfmt[len+1] = 0;
 
-  tbuf = SCM_MUST_MALLOC (size);
+  tbuf = scm_malloc (size);
   {
 #if !defined (HAVE_TM_ZONE)
     /* it seems the only way to tell non-GNU versions of strftime what
@@ -607,7 +584,7 @@ SCM_DEFINE (scm_strftime, "strftime", 2, 0, 0,
     SCM *velts = SCM_VELTS (stime);
     int have_zone = 0;
 
-    if (SCM_NFALSEP (velts[10]) && *SCM_STRING_CHARS (velts[10]) != 0)
+    if (!SCM_FALSEP (velts[10]) && *SCM_STRING_CHARS (velts[10]) != 0)
       {
        /* it's not required that the TZ setting be correct, just that
           it has the right name.  so try something like TZ=EST0.
@@ -633,9 +610,9 @@ SCM_DEFINE (scm_strftime, "strftime", 2, 0, 0,
        case. */
     while ((len = strftime (tbuf, size, myfmt, &t)) == 0 || len == size)
       {
-       scm_must_free (tbuf);
+       free (tbuf);
        size *= 2;
-       tbuf = SCM_MUST_MALLOC (size);
+       tbuf = scm_malloc (size);
       }
 
 #if !defined (HAVE_TM_ZONE)
@@ -647,9 +624,9 @@ SCM_DEFINE (scm_strftime, "strftime", 2, 0, 0,
 #endif
     }
 
-  result = scm_makfromstr (tbuf+1, len-1, 0);
-  scm_must_free (tbuf);
-  scm_must_free(myfmt);
+  result = scm_mem2string (tbuf + 1, len - 1);
+  free (tbuf);
+  free (myfmt);
   return result;
 }
 #undef FUNC_NAME
@@ -675,8 +652,6 @@ SCM_DEFINE (scm_strptime, "strptime", 2, 0, 0,
   SCM_VALIDATE_STRING (1, format);
   SCM_VALIDATE_STRING (2, string);
 
-  SCM_STRING_COERCE_0TERMINATION_X (format);
-  SCM_STRING_COERCE_0TERMINATION_X (string);
   fmt = SCM_STRING_CHARS (format);
   str = SCM_STRING_CHARS (string);
 
@@ -707,7 +682,7 @@ void
 scm_init_stime()
 {
   scm_c_define ("internal-time-units-per-second",
-               scm_long2num((long)CLKTCK));
+               scm_long2num((long) SCM_TIME_UNITS_PER_SECOND));
 
 #ifdef HAVE_FTIME
   if (!scm_your_base.time) ftime(&scm_your_base);
@@ -718,9 +693,7 @@ scm_init_stime()
   if (!scm_my_base) scm_my_base = mytime();
 
   scm_add_feature ("current-time");
-#ifndef SCM_MAGIC_SNARFER
 #include "libguile/stime.x"
-#endif
 }