-/* 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 library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public
\f
+#define _GNU_SOURCE /* ask glibc for everything, in particular strptime */
+#define _POSIX_C_SOURCE 199506L /* for gmtime_r prototype */
+
#if HAVE_CONFIG_H
# include <config.h>
#endif
# include <sys/timeb.h>
#endif
+#if HAVE_CRT_EXTERNS_H
+#include <crt_externs.h> /* for Darwin _NSGetEnviron */
+#endif
+
#ifndef tzname /* For SGI. */
extern char *tzname[]; /* RS6000 and others reject char **tzname. */
#endif
# define tzname _tzname
#endif
-#ifdef MISSING_STRPTIME_DECL
+#if ! HAVE_DECL_STRPTIME
extern char *strptime ();
#endif
# 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()
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
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
"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"
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);
+ return scm_from_long (timv);
}
#undef FUNC_NAME
if (gettimeofday (&time, NULL) == -1)
SCM_SYSERROR;
SCM_ALLOW_INTS;
- return scm_cons (scm_long2num ((long) time.tv_sec),
- scm_long2num ((long) time.tv_usec));
+ 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;
if ((timv = time (0)) == -1)
SCM_SYSERROR;
SCM_ALLOW_INTS;
- return scm_cons (scm_long2num (timv), SCM_MAKINUM (0));
+ 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,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_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
{
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;
#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)
/* 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;
}
#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"
#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
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]);
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)
{
}
/* 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;
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)
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.
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));
+ return scm_cons (filltime (&t, 0, NULL),
+ scm_from_signed_integer (rest - str));
}
#undef FUNC_NAME
#endif /* HAVE_STRPTIME */
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);
HCoop / bpt / guile.git / blobdiff