X-Git-Url: http://git.hcoop.net/bpt/guile.git/blobdiff_plain/756414cf2c781aee4207de3961d7c7e678931a70..77c2594f2f88fc8c2ec79126c9f04c9eb8b2d057:/libguile/stime.c diff --git a/libguile/stime.c b/libguile/stime.c index 12c5a1b46..dce728053 100644 --- a/libguile/stime.c +++ b/libguile/stime.c @@ -1,47 +1,45 @@ -/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2003 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 + */ +/* _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 */ +#ifdef __hpux +#define _POSIX_C_SOURCE 199506L /* for gmtime_r prototype */ +#endif + +#if HAVE_CONFIG_H +# include +#endif + #include #include @@ -49,6 +47,7 @@ #include "libguile/feature.h" #include "libguile/strings.h" #include "libguile/vectors.h" +#include "libguile/dynwind.h" #include "libguile/validate.h" #include "libguile/stime.h" @@ -74,6 +73,10 @@ # 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 @@ -81,7 +84,7 @@ extern char *tzname[]; /* RS6000 and others reject char **tzname. */ # define tzname _tzname #endif -#ifdef MISSING_STRPTIME_DECL +#if ! HAVE_DECL_STRPTIME extern char *strptime (); #endif @@ -91,6 +94,16 @@ extern char *strptime (); # 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() @@ -125,14 +138,16 @@ SCM_DEFINE (scm_get_internal_real_time, "get-internal-real-time", 0, 0, 0, SCM tmp; ftime (&time_buffer); time_buffer.time -= scm_your_base.time; - tmp = scm_long2num (time_buffer.millitm - scm_your_base.millitm); + tmp = scm_from_long (time_buffer.millitm - scm_your_base.millitm); tmp = scm_sum (tmp, - scm_product (SCM_MAKINUM (1000), - SCM_MAKINUM (time_buffer.time))); - return scm_quotient (scm_product (tmp, SCM_MAKINUM (SCM_TIME_UNITS_PER_SECOND)), - SCM_MAKINUM (1000)); + scm_product (scm_from_int (1000), + scm_from_int (time_buffer.time))); + return scm_quotient (scm_product (tmp, + scm_from_int (SCM_TIME_UNITS_PER_SECOND)), + scm_from_int (1000)); #else - return scm_long2num((time((timet*)0) - scm_your_base) * (int)SCM_TIME_UNITS_PER_SECOND); + return scm_from_long ((time((timet*)0) - scm_your_base) + * (int)SCM_TIME_UNITS_PER_SECOND); #endif /* HAVE_FTIME */ } #undef FUNC_NAME @@ -171,11 +186,11 @@ SCM_DEFINE (scm_times, "times", 0, 0, 0, rv = times (&t); if (rv == -1) SCM_SYSERROR; - 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)); + 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)); return result; } #undef FUNC_NAME @@ -196,10 +211,17 @@ SCM_DEFINE (scm_get_internal_run_time, "get-internal-run-time", 0, 0, 0, "included but subprocesses are not.") #define FUNC_NAME s_scm_get_internal_run_time { - return scm_long2num (scm_c_get_internal_run_time ()); + return scm_from_long (scm_c_get_internal_run_time ()); } #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" @@ -209,10 +231,11 @@ SCM_DEFINE (scm_current_time, "current-time", 0, 0, 0, timet timv; SCM_DEFER_INTS; - if ((timv = time (0)) == -1) - SCM_SYSERROR; + timv = time (NULL); SCM_ALLOW_INTS; - return scm_long2num((long) timv); + if (timv == -1) + SCM_MISC_ERROR ("current time not available", SCM_EOL); + return scm_from_long (timv); } #undef FUNC_NAME @@ -226,54 +249,67 @@ SCM_DEFINE (scm_gettimeofday, "gettimeofday", 0, 0, 0, { #ifdef HAVE_GETTIMEOFDAY struct timeval time; + int ret, err; SCM_DEFER_INTS; - if (gettimeofday (&time, NULL) == -1) - SCM_SYSERROR; + ret = gettimeofday (&time, NULL); + err = errno; SCM_ALLOW_INTS; - return scm_cons (scm_long2num ((long) time.tv_sec), - scm_long2num ((long) time.tv_usec)); + if (ret == -1) + { + errno = err; + SCM_SYSERROR; + } + return scm_cons (scm_from_long (time.tv_sec), + scm_from_long (time.tv_usec)); #else # ifdef HAVE_FTIME struct timeb time; ftime(&time); - return scm_cons (scm_long2num ((long) time.time), - SCM_MAKINUM (time.millitm * 1000)); + return scm_cons (scm_from_long (time.time), + scm_from_int (time.millitm * 1000)); # else timet timv; + int err; SCM_DEFER_INTS; - if ((timv = time (0)) == -1) - SCM_SYSERROR; + timv = time (NULL); + err = errno; SCM_ALLOW_INTS; - return scm_cons (scm_long2num (timv), SCM_MAKINUM (0)); + if (timv == -1) + { + errno = err; + SCM_SYSERROR; + } + return scm_cons (scm_from_long (timv), scm_from_int (0)); # endif #endif } #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_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); + 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)); 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 @@ -288,10 +324,14 @@ setzone (SCM zone, int pos, const char *subr) { static char *tmpenv[2]; char *buf; - - SCM_ASSERT (SCM_STRINGP (zone), zone, pos, subr); - buf = scm_malloc (SCM_STRING_LENGTH (zone) + sizeof (tzvar) + 1); - sprintf (buf, "%s=%s", tzvar, SCM_STRING_CHARS (zone)); + size_t zone_len; + + zone_len = scm_to_locale_stringbuf (zone, NULL, 0); + buf = scm_malloc (zone_len + sizeof (tzvar) + 1); + strcpy (buf, tzvar); + buf[sizeof(tzvar)-1] = '='; + scm_to_locale_stringbuf (zone, buf+sizeof(tzvar), zone_len); + buf[sizeof(tzvar)+zone_len] = '\0'; oldenv = environ; tmpenv[0] = buf; tmpenv[1] = 0; @@ -340,6 +380,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) @@ -360,6 +403,9 @@ SCM_DEFINE (scm_localtime, "localtime", 1, 1, 0, /* 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; @@ -389,6 +435,12 @@ SCM_DEFINE (scm_localtime, "localtime", 1, 1, 0, } #undef FUNC_NAME +/* tm_zone is normally a pointer, not an array within struct tm, so we might + have to worry about the lifespan of what it points to. The posix specs + don't seem to say anything about this, let's assume here that tm_zone + will be a constant and therefore no protection or anything is needed + until we copy it in filltime(). */ + SCM_DEFINE (scm_gmtime, "gmtime", 1, 0, 0, (SCM time), "Return an object representing the broken down components of\n" @@ -397,17 +449,33 @@ SCM_DEFINE (scm_gmtime, "gmtime", 1, 0, 0, #define FUNC_NAME s_scm_gmtime { timet itime; - struct tm *bd_time; - SCM result; + struct tm bd_buf, *bd_time; + const char *zname; itime = SCM_NUM2LONG (1, time); + + /* 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; + +#if HAVE_GMTIME_R + bd_time = gmtime_r (&itime, &bd_buf); +#else SCM_DEFER_INTS; bd_time = gmtime (&itime); + if (bd_time != NULL) + bd_buf = *bd_time; + SCM_ALLOW_INTS; +#endif if (bd_time == NULL) SCM_SYSERROR; - result = filltime (bd_time, 0, "GMT"); - SCM_ALLOW_INTS; - return result; + +#if HAVE_STRUCT_TM_TM_ZONE + zname = bd_buf.tm_zone; +#else + zname = "GMT"; +#endif + return filltime (&bd_buf, 0, zname); } #undef FUNC_NAME @@ -424,26 +492,26 @@ bdtime2c (SCM sbd_time, struct tm *lt, int pos, const char *subr) velts = SCM_VELTS (sbd_time); for (i = 0; i < 10; i++) { - SCM_ASSERT (SCM_INUMP (velts[i]), sbd_time, pos, subr); + SCM_ASSERT (scm_is_integer (velts[i]), sbd_time, pos, subr); } - SCM_ASSERT (SCM_FALSEP (velts[10]) || SCM_STRINGP (velts[10]), + SCM_ASSERT (scm_is_false (velts[10]) || scm_is_string (velts[10]), sbd_time, pos, subr); - lt->tm_sec = SCM_INUM (velts[0]); - lt->tm_min = SCM_INUM (velts[1]); - lt->tm_hour = SCM_INUM (velts[2]); - lt->tm_mday = SCM_INUM (velts[3]); - lt->tm_mon = SCM_INUM (velts[4]); - lt->tm_year = SCM_INUM (velts[5]); - lt->tm_wday = SCM_INUM (velts[6]); - lt->tm_yday = SCM_INUM (velts[7]); - lt->tm_isdst = SCM_INUM (velts[8]); + 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]); #ifdef HAVE_TM_ZONE - lt->tm_gmtoff = SCM_INUM (velts[9]); - if (SCM_FALSEP (velts[10])) + lt->tm_gmtoff = scm_to_int (velts[9]); + if (scm_is_false (velts[10])) lt->tm_zone = NULL; else - lt->tm_zone = SCM_STRING_CHARS (velts[10]); + lt->tm_zone = scm_to_locale_string (velts[10]); #endif } @@ -466,7 +534,12 @@ SCM_DEFINE (scm_mktime, "mktime", 1, 1, 0, char **oldenv; int err; + scm_frame_begin (0); + bdtime2c (sbd_time, <, SCM_ARG1, FUNC_NAME); +#if HAVE_STRUCT_TM_TM_ZONE + scm_frame_free ((char *)lt.tm_zone); +#endif SCM_DEFER_INTS; oldenv = setzone (zone, SCM_ARG2, FUNC_NAME); @@ -474,7 +547,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) { @@ -493,6 +568,8 @@ 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. */ utc = gmtime (&itime); if (utc == NULL) err = errno; @@ -514,11 +591,13 @@ SCM_DEFINE (scm_mktime, "mktime", 1, 1, 0, else if (utc->tm_yday > lt.tm_yday) zoff += 24 * 60 * 60; - result = scm_cons (scm_long2num ((long) itime), + result = scm_cons (scm_from_long (itime), filltime (<, zoff, zname)); SCM_ALLOW_INTS; if (zname) free (zname); + + scm_frame_end (); return result; } #undef FUNC_NAME @@ -553,15 +632,16 @@ SCM_DEFINE (scm_strftime, "strftime", 2, 0, 0, char *tbuf; int size = 50; - char *fmt, *myfmt; + const char *fmt; + char *myfmt; int len; SCM result; SCM_VALIDATE_STRING (1, format); bdtime2c (stime, &t, SCM_ARG2, FUNC_NAME); - fmt = SCM_STRING_CHARS (format); - len = SCM_STRING_LENGTH (format); + fmt = scm_i_string_chars (format); + len = scm_i_string_length (format); /* Ugly hack: strftime can return 0 if its buffer is too small, but some valid time strings (e.g. "%p") can sometimes produce @@ -581,10 +661,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_FALSEP (velts[10]) && *SCM_STRING_CHARS (velts[10]) != 0) + if (scm_is_true (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. @@ -592,7 +672,7 @@ SCM_DEFINE (scm_strftime, "strftime", 2, 0, 0, some OSs, e.g., Solaris. */ SCM zone = scm_string_append (scm_cons (velts[10], - scm_cons (scm_makfrom0str ("0"), + scm_cons (scm_from_locale_string ("0"), SCM_EOL))); have_zone = 1; @@ -624,7 +704,7 @@ SCM_DEFINE (scm_strftime, "strftime", 2, 0, 0, #endif } - result = scm_mem2string (tbuf + 1, len - 1); + result = scm_from_locale_stringn (tbuf + 1, len - 1); free (tbuf); free (myfmt); return result; @@ -647,13 +727,13 @@ SCM_DEFINE (scm_strptime, "strptime", 2, 0, 0, #define FUNC_NAME s_scm_strptime { struct tm t; - char *fmt, *str, *rest; + const char *fmt, *str, *rest; SCM_VALIDATE_STRING (1, format); SCM_VALIDATE_STRING (2, string); - fmt = SCM_STRING_CHARS (format); - str = SCM_STRING_CHARS (string); + fmt = scm_i_string_chars (format); + str = scm_i_string_chars (string); /* initialize the struct tm */ #define tm_init(field) t.field = 0 @@ -667,13 +747,24 @@ 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; - + rest = strptime (str, fmt, &t); SCM_ALLOW_INTS; - return scm_cons (filltime (&t, 0, NULL), SCM_MAKINUM (rest - str)); + if (rest == NULL) + { + /* 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; + } + + return scm_cons (filltime (&t, 0, NULL), + scm_from_signed_integer (rest - str)); } #undef FUNC_NAME #endif /* HAVE_STRPTIME */ @@ -682,7 +773,7 @@ void scm_init_stime() { scm_c_define ("internal-time-units-per-second", - scm_long2num((long) SCM_TIME_UNITS_PER_SECOND)); + scm_from_long (SCM_TIME_UNITS_PER_SECOND)); #ifdef HAVE_FTIME if (!scm_your_base.time) ftime(&scm_your_base);