X-Git-Url: https://git.hcoop.net/bpt/guile.git/blobdiff_plain/1e6808ea204cef454e41af1e2f309100ab99e9e1..d6d9e957467ab5ef0b48b66645ef2433c9a28695:/libguile/stime.c diff --git a/libguile/stime.c b/libguile/stime.c index ce1e6006e..0b70920d2 100644 --- a/libguile/stime.c +++ b/libguile/stime.c @@ -1,49 +1,27 @@ -/* Copyright (C) 1995,1996,1997,1998, 1999, 2000, 2001 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2003, 2004 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 - * the Free Software Foundation; either version 2, or (at your option) - * any later version. + * This library is free software; you can redistribute it and/or + * modify it under the terms of the GNU Lesser General Public + * License as published by the Free Software Foundation; either + * version 2.1 of the License, or (at your option) any later version. * - * This program is distributed in the hope that it will be useful, + * This library 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. + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + * Lesser General Public License for more details. * - * 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, 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. - * - * The exception is that, if you link the GUILE library with other files - * to produce an executable, this does not by itself cause the - * resulting executable to be covered by the GNU General Public License. - * Your use of that executable is in no way restricted on account of - * linking the GUILE library code into it. - * - * This exception does not however invalidate any other reasons why - * the executable file might be covered by the GNU General Public License. - * - * This exception applies only to the code released by the - * Free Software Foundation under the name GUILE. If you copy - * code from other Free Software Foundation releases into a copy of - * GUILE, as the General Public License permits, the exception does - * not apply to the code that you add in this way. To avoid misleading - * anyone as to the status of such modified files, you must delete - * this exception notice from them. - * - * 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. */ + * You should have received a copy of the GNU Lesser General Public + * License along with this library; if not, write to the Free Software + * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + */ -/* Software engineering face-lift by Greg J. Badros, 11-Dec-1999, - gjb@cs.washington.edu, http://www.cs.washington.edu/homes/gjb */ +#if HAVE_CONFIG_H +# include +#endif + #include #include @@ -68,19 +46,6 @@ #include #endif -# ifdef TIME_WITH_SYS_TIME -# include -# include -# else -# ifdef HAVE_SYS_TIME_H -# include -# else -# ifdef HAVE_TIME_H -# include -# endif -# endif -# endif - #ifdef HAVE_SYS_TIMES_H # include #endif @@ -89,31 +54,37 @@ # include #endif +#if HAVE_CRT_EXTERNS_H +#include /* for Darwin _NSGetEnviron */ +#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 # define timet long #endif +extern char ** environ; + +/* On Apple Darwin in a shared library there's no "environ" to access + directly, instead the address of that variable must be obtained with + _NSGetEnviron(). */ +#if HAVE__NSGETENVIRON && defined (PIC) +#define environ (*_NSGetEnviron()) +#endif + + #ifdef HAVE_TIMES static timet mytime() @@ -124,7 +95,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 +123,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 +165,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 @@ -223,6 +194,13 @@ SCM_DEFINE (scm_get_internal_run_time, "get-internal-run-time", 0, 0, 0, } #undef FUNC_NAME +/* For reference, note that current-time and gettimeofday both should be + protected against setzone/restorezone changes in another thread, since on + DOS the system time is normally kept as local time, which means TZ + affects the return from current-time and gettimeofday. Not sure if DJGPP + etc actually has concurrent multi-threading, but it seems prudent not to + make assumptions about this. */ + SCM_DEFINE (scm_current_time, "current-time", 0, 0, 0, (void), "Return the number of seconds since 1970-01-01 00:00:00 UTC,\n" @@ -233,7 +211,7 @@ SCM_DEFINE (scm_current_time, "current-time", 0, 0, 0, SCM_DEFER_INTS; if ((timv = time (0)) == -1) - SCM_SYSERROR; + SCM_MISC_ERROR ("current time not available", SCM_EOL); SCM_ALLOW_INTS; return scm_long2num((long) timv); } @@ -277,26 +255,25 @@ SCM_DEFINE (scm_gettimeofday, "gettimeofday", 0, 0, 0, #undef FUNC_NAME static SCM -filltime (struct tm *bd_time, int zoff, char *zname) +filltime (struct tm *bd_time, int zoff, const 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; } static char tzvar[3] = "TZ"; -extern char ** environ; /* if zone is set, create a temporary environment with only a TZ string. other threads or interrupt handlers shouldn't be allowed @@ -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; @@ -325,11 +301,11 @@ setzone (SCM zone, int pos, const char *subr) } static void -restorezone (SCM zone, char **oldenv, const char *subr) +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. */ @@ -355,7 +331,7 @@ SCM_DEFINE (scm_localtime, "localtime", 1, 1, 0, char **oldenv; int err; - itime = SCM_NUM2LONG (1,time); + itime = SCM_NUM2LONG (1, time); /* deferring interupts is essential since a) setzone may install a temporary environment b) localtime uses a static buffer. */ @@ -364,6 +340,9 @@ SCM_DEFINE (scm_localtime, "localtime", 1, 1, 0, #ifdef LOCALTIME_CACHE tzset (); #endif + /* POSIX says localtime sets errno, but C99 doesn't say that. + Give a sensible default value in case localtime doesn't set it. */ + errno = EINVAL; ltptr = localtime (&itime); err = errno; if (ltptr) @@ -378,12 +357,15 @@ 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. */ if (ltptr) lt = *ltptr; + /* 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; @@ -407,7 +389,8 @@ SCM_DEFINE (scm_localtime, "localtime", 1, 1, 0, result = filltime (<, zoff, zname); SCM_ALLOW_INTS; - scm_must_free (zname); + if (zname) + free (zname); return result; } #undef FUNC_NAME @@ -422,13 +405,22 @@ SCM_DEFINE (scm_gmtime, "gmtime", 1, 0, 0, timet itime; struct tm *bd_time; SCM result; + const char *zname; - itime = SCM_NUM2LONG (1,time); + itime = SCM_NUM2LONG (1, time); SCM_DEFER_INTS; + /* 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; bd_time = gmtime (&itime); if (bd_time == NULL) SCM_SYSERROR; - result = filltime (bd_time, 0, "GMT"); +#if HAVE_STRUCT_TM_TM_ZONE + zname = bd_time->tm_zone; +#else + zname = "GMT"; +#endif + result = filltime (bd_time, 0, zname); SCM_ALLOW_INTS; return result; } @@ -438,7 +430,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) @@ -497,7 +489,9 @@ SCM_DEFINE (scm_mktime, "mktime", 1, 1, 0, tzset (); #endif itime = mktime (<); - err = errno; + /* POSIX doesn't say mktime sets errno, and on glibc 2.3.2 for instance it + doesn't. Force a sensible value for our error message. */ + err = EINVAL; if (itime != -1) { @@ -511,11 +505,13 @@ 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); } /* 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. */ utc = gmtime (&itime); if (utc == NULL) err = errno; @@ -540,7 +536,8 @@ SCM_DEFINE (scm_mktime, "mktime", 1, 1, 0, result = scm_cons (scm_long2num ((long) itime), filltime (<, zoff, zname)); SCM_ALLOW_INTS; - scm_must_free (zname); + if (zname) + free (zname); return result; } #undef FUNC_NAME @@ -582,7 +579,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 +587,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 @@ -604,10 +600,10 @@ SCM_DEFINE (scm_strftime, "strftime", 2, 0, 0, environment. interrupts and thread switching must be deferred until TZ is restored. */ char **oldenv = NULL; - SCM *velts = SCM_VELTS (stime); + SCM *velts = (SCM *) 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 +629,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 +643,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 +671,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); @@ -692,10 +686,19 @@ SCM_DEFINE (scm_strptime, "strptime", 2, 0, 0, tm_init (tm_yday); #undef tm_init + /* 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. */ t.tm_isdst = -1; SCM_DEFER_INTS; if ((rest = strptime (str, fmt, &t)) == NULL) - SCM_SYSERROR; + { + /* POSIX doesn't say strptime sets errno, and on glibc 2.3.2 for + instance it doesn't. Force a sensible value for our error + message. */ + errno = EINVAL; + SCM_SYSERROR; + } SCM_ALLOW_INTS; return scm_cons (filltime (&t, 0, NULL), SCM_MAKINUM (rest - str)); @@ -706,8 +709,8 @@ SCM_DEFINE (scm_strptime, "strptime", 2, 0, 0, void scm_init_stime() { - scm_sysintern("internal-time-units-per-second", - scm_long2num((long)CLKTCK)); + scm_c_define ("internal-time-units-per-second", + scm_long2num((long) SCM_TIME_UNITS_PER_SECOND)); #ifdef HAVE_FTIME if (!scm_your_base.time) ftime(&scm_your_base); @@ -718,9 +721,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 }