-/* 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, 2006 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
*
* 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
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
*/
\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 */
+#ifdef __hpux
#define _POSIX_C_SOURCE 199506L /* for gmtime_r prototype */
+#endif
#if HAVE_CONFIG_H
# include <config.h>
#include <errno.h>
#include "libguile/_scm.h"
+#include "libguile/async.h"
#include "libguile/feature.h"
#include "libguile/strings.h"
#include "libguile/vectors.h"
+#include "libguile/dynwind.h"
#include "libguile/validate.h"
#include "libguile/stime.h"
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_I_MAKINUM (1000),
- SCM_I_MAKINUM (time_buffer.time)));
- return scm_quotient (scm_product (tmp, SCM_I_MAKINUM (SCM_TIME_UNITS_PER_SECOND)),
- SCM_I_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_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
"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
{
timet timv;
- SCM_DEFER_INTS;
- if ((timv = time (0)) == -1)
+ SCM_CRITICAL_SECTION_START;
+ timv = time (NULL);
+ SCM_CRITICAL_SECTION_END;
+ if (timv == -1)
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
{
#ifdef HAVE_GETTIMEOFDAY
struct timeval time;
+ int ret, err;
- SCM_DEFER_INTS;
- 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));
+ SCM_CRITICAL_SECTION_START;
+ ret = gettimeofday (&time, NULL);
+ err = errno;
+ SCM_CRITICAL_SECTION_END;
+ 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_I_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;
- SCM_ALLOW_INTS;
- return scm_cons (scm_long2num (timv), SCM_I_MAKINUM (0));
+ SCM_CRITICAL_SECTION_START;
+ timv = time (NULL);
+ err = errno;
+ SCM_CRITICAL_SECTION_END;
+ if (timv == -1)
+ {
+ errno = err;
+ SCM_SYSERROR;
+ }
+ return scm_cons (scm_from_long (timv), scm_from_int (0));
# endif
#endif
}
{
SCM result = scm_c_make_vector (11, SCM_UNDEFINED);
- SCM_VECTOR_SET (result,0, SCM_I_MAKINUM (bd_time->tm_sec));
- SCM_VECTOR_SET (result,1, SCM_I_MAKINUM (bd_time->tm_min));
- SCM_VECTOR_SET (result,2, SCM_I_MAKINUM (bd_time->tm_hour));
- SCM_VECTOR_SET (result,3, SCM_I_MAKINUM (bd_time->tm_mday));
- SCM_VECTOR_SET (result,4, SCM_I_MAKINUM (bd_time->tm_mon));
- SCM_VECTOR_SET (result,5, SCM_I_MAKINUM (bd_time->tm_year));
- SCM_VECTOR_SET (result,6, SCM_I_MAKINUM (bd_time->tm_wday));
- SCM_VECTOR_SET (result,7, SCM_I_MAKINUM (bd_time->tm_yday));
- SCM_VECTOR_SET (result,8, SCM_I_MAKINUM (bd_time->tm_isdst));
- SCM_VECTOR_SET (result,9, SCM_I_MAKINUM (zoff));
- SCM_VECTOR_SET (result,10, zname ? scm_makfrom0str (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;
}
{
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;
/* 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 ();
zoff += 24 * 60 * 60;
result = filltime (<, zoff, zname);
- SCM_ALLOW_INTS;
+ SCM_CRITICAL_SECTION_END;
if (zname)
free (zname);
return result;
#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;
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_INUMP (velts[i]), sbd_time, pos, subr);
- }
- SCM_ASSERT (scm_is_false (velts[10]) || SCM_STRINGP (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_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 (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_INUM (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_STRING_CHARS (velts[10]);
+ lt->tm_zone = scm_to_locale_string (SCM_SIMPLE_VECTOR_REF (sbd_time, 10));
#endif
}
char **oldenv;
int err;
+ scm_dynwind_begin (0);
+
bdtime2c (sbd_time, <, SCM_ARG1, FUNC_NAME);
+#if HAVE_STRUCT_TM_TM_ZONE
+ scm_dynwind_free ((char *)lt.tm_zone);
+#endif
+
+ scm_dynwind_critical_section (SCM_BOOL_F);
- SCM_DEFER_INTS;
oldenv = setzone (zone, SCM_ARG2, FUNC_NAME);
#ifdef LOCALTIME_CACHE
tzset ();
/* 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;
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_dynwind_end ();
return result;
}
#undef FUNC_NAME
SCM_DEFINE (scm_strftime, "strftime", 2, 0, 0,
(SCM format, SCM stime),
- "Formats a time specification @var{time} using @var{template}. @var{time}\n"
- "is an object with time components in the form returned by @code{localtime}\n"
- "or @code{gmtime}. @var{template} is a string which can include formatting\n"
- "specifications introduced by a @code{%} character. The formatting of\n"
- "month and day names is dependent on the current locale. The value returned\n"
- "is the formatted string.\n"
- "@xref{Formatting Date and Time, , , libc, The GNU C Library Reference Manual}.)")
+ "Return a string which is broken-down time structure @var{stime}\n"
+ "formatted according to the given @var{format} string.\n"
+ "\n"
+ "@var{format} contains field specifications introduced by a\n"
+ "@samp{%} character. See @ref{Formatting Calendar Time,,, libc,\n"
+ "The GNU C Library Reference Manual}, or @samp{man 3 strftime},\n"
+ "for the available formatting.\n"
+ "\n"
+ "@lisp\n"
+ "(strftime \"%c\" (localtime (current-time)))\n"
+ "@result{} \"Mon Mar 11 20:17:43 2002\"\n"
+ "@end lisp\n"
+ "\n"
+ "If @code{setlocale} has been called (@pxref{Locales}), month\n"
+ "and day names are from the current locale and in the locale\n"
+ "character set.")
#define FUNC_NAME s_scm_strftime
{
struct tm t;
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
environment. interrupts and thread switching must be deferred
until TZ is restored. */
char **oldenv = NULL;
- SCM *velts = (SCM *) SCM_VELTS (stime);
+ SCM zone_spec = SCM_SIMPLE_VECTOR_REF (stime, 10);
int have_zone = 0;
- if (scm_is_true (velts[10]) && *SCM_STRING_CHARS (velts[10]) != 0)
+ if (scm_is_true (zone_spec) && scm_c_string_length (zone_spec) > 0)
{
/* it's not required that the TZ setting be correct, just that
it has the right name. so try something like TZ=EST0.
using only TZ=EST would be simpler but it doesn't work on
some OSs, e.g., Solaris. */
SCM zone =
- scm_string_append (scm_cons (velts[10],
- scm_cons (scm_makfrom0str ("0"),
- SCM_EOL)));
+ scm_string_append (scm_list_2 (zone_spec,
+ scm_from_locale_string ("0")));
have_zone = 1;
- SCM_DEFER_INTS;
+ SCM_CRITICAL_SECTION_START;
oldenv = setzone (zone, SCM_ARG2, FUNC_NAME);
}
#endif
#if !defined (HAVE_TM_ZONE)
if (have_zone)
{
- restorezone (velts[10], oldenv, FUNC_NAME);
- SCM_ALLOW_INTS;
+ restorezone (zone_spec, oldenv, FUNC_NAME);
+ SCM_CRITICAL_SECTION_END;
}
#endif
}
- result = scm_mem2string (tbuf + 1, len - 1);
+ 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
#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
/* 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;
- if ((rest = strptime (str, fmt, &t)) == NULL)
+ SCM_CRITICAL_SECTION_START;
+ rest = strptime (str, fmt, &t);
+ SCM_CRITICAL_SECTION_END;
+ 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
SCM_SYSERROR;
}
- SCM_ALLOW_INTS;
- return scm_cons (filltime (&t, 0, NULL), SCM_I_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