-/* Copyright (C) 1995,1996,1997 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1998, 1999 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
extern char *tzname[]; /* RS6000 and others reject char **tzname. */
#endif
-char *strptime ();
+#ifdef MISSING_STRPTIME_DECL
+extern char *strptime ();
+#endif
/* This should be figured out by autoconf. */
-#ifdef CLK_TCK
-# define CLKTCK CLK_TCK
-# ifdef CLOCKS_PER_SEC
-# if defined (unix) || defined (__unix)
-# ifndef ARM_ULIB
-# include <sys/times.h>
-# endif
-# define LACK_CLOCK
- /* This is because clock() might be POSIX rather than ANSI.
- This occurs on HP-UX machines */
-# endif
-# endif
-#else
-# ifdef CLOCKS_PER_SEC
+#if ! defined(CLKTCK) && defined(CLK_TCK)
+# define CLKTCK CLK_TCK
+#endif
+#if ! defined(CLKTCK) && defined(CLOCKS_PER_SEC)
# define CLKTCK CLOCKS_PER_SEC
-# else
-# define LACK_CLOCK
+#endif
+#if ! defined(CLKTCK)
# define CLKTCK 60
-# endif
#endif
+
#ifdef __STDC__
# define timet time_t
#else
#ifdef HAVE_FTIME
-extern int ftime (struct timeb *);
-
struct timeb scm_your_base = {0};
SCM_PROC(s_get_internal_real_time, "get-internal-real-time", 0, 0, 0, scm_get_internal_real_time);
SCM
scm_get_internal_real_time()
{
struct timeb time_buffer;
- long tmp;
- ftime(&time_buffer);
+
+ SCM tmp;
+ ftime (&time_buffer);
time_buffer.time -= scm_your_base.time;
- tmp = time_buffer.millitm - scm_your_base.millitm;
- tmp = time_buffer.time*1000L + tmp;
- tmp *= CLKTCK;
- tmp /= 1000;
- return scm_long2num (tmp);
-}
+ tmp = scm_long2num (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 (CLKTCK)),
+ SCM_MAKINUM (1000));
+};
#else
struct tms t;
clock_t rv;
- SCM result = scm_make_vector (SCM_MAKINUM(5), SCM_UNDEFINED, SCM_UNDEFINED);
+ SCM result = scm_make_vector (SCM_MAKINUM(5), SCM_UNDEFINED);
rv = times (&t);
if (rv == -1)
scm_syserror (s_times);
static SCM
filltime (struct tm *bd_time, int zoff, char *zname)
{
- SCM result = scm_make_vector(SCM_MAKINUM(11), SCM_UNDEFINED, SCM_UNDEFINED);
+ SCM result = scm_make_vector (SCM_MAKINUM(11), SCM_UNDEFINED);
SCM_VELTS (result)[0] = SCM_MAKINUM (bd_time->tm_sec);
SCM_VELTS (result)[1] = SCM_MAKINUM (bd_time->tm_min);
return result;
}
-static char *
-setzone (SCM zone, int pos, char *subr)
+static char tzvar[3] = "TZ";
+extern char ** environ;
+
+static char **
+setzone (SCM zone, int pos, const char *subr)
{
- char *oldtz = 0;
+ char **oldenv = 0;
if (!SCM_UNBNDP (zone))
{
+ static char *tmpenv[2];
char *buf;
- /* if zone was supplied, set the environment variable TZ temporarily. */
+ /* if zone was supplied, set the environment temporarily. */
SCM_ASSERT (SCM_NIMP (zone) && SCM_ROSTRINGP (zone), zone, pos, subr);
SCM_COERCE_SUBSTR (zone);
- buf = malloc (SCM_LENGTH (zone) + 4);
- if (buf == 0)
- scm_memory_error (subr);
- oldtz = getenv ("TZ");
- if (oldtz != NULL)
- oldtz = oldtz - 3;
- sprintf (buf, "TZ=%s", SCM_ROCHARS (zone));
- if (putenv (buf) < 0)
- scm_syserror (subr);
+ buf = scm_must_malloc (SCM_LENGTH (zone) + sizeof (tzvar) + 1,
+ subr);
+ sprintf (buf, "%s=%s", tzvar, SCM_ROCHARS (zone));
+ oldenv = environ;
+ tmpenv[0] = buf;
+ tmpenv[1] = 0;
+ environ = tmpenv;
tzset();
}
- return oldtz;
+ return oldenv;
}
static void
-restorezone (SCM zone, char *oldzone)
+restorezone (SCM zone, char **oldenv, const char *subr)
{
if (!SCM_UNBNDP (zone))
{
- int rv;
-
- if (oldzone)
- rv = putenv (oldzone);
- else
- rv = putenv ("TZ");
- if (rv < 0)
- scm_syserror ("restorezone");
+ scm_must_free (environ[0]);
+ environ = oldenv;
tzset();
}
}
SCM result;
int zoff;
char *zname = 0;
- char *oldtz;
+ char **oldenv;
int err;
itime = scm_num2long (time, (char *) SCM_ARG1, s_localtime);
SCM_DEFER_INTS;
- oldtz = setzone (zone, SCM_ARG2, s_localtime);
+ oldenv = setzone (zone, SCM_ARG2, s_localtime);
ltptr = localtime (&itime);
err = errno;
- /* copied in case localtime and gmtime share a buffer. */
- if (ltptr)
- lt = *ltptr;
- utc = gmtime (&itime);
- if (utc == NULL)
- err = errno;
if (ltptr)
{
+ const char *ptr;
+
+ /* copy zone name before calling gmtime or tzset. */
#ifdef HAVE_TM_ZONE
- zname = lt.tm_zone;
+ ptr = ltptr->tm_zone;
#else
# ifdef HAVE_TZNAME
- /* must be copied before calling tzset again. */
- char *ptr = tzname[ (lt.tm_isdst == 1) ? 1 : 0 ];
-
- zname = scm_must_malloc (strlen (ptr) + 1, s_localtime);
- strcpy (zname, ptr);
+ ptr = tzname[ (ltptr->tm_isdst == 1) ? 1 : 0 ];
# else
scm_misc_error (s_localtime, "Not fully implemented on this platform",
SCM_EOL);
# endif
#endif
+ zname = scm_must_malloc (strlen (ptr) + 1, s_localtime);
+ strcpy (zname, ptr);
}
- restorezone (zone, oldtz);
+ /* the struct is copied in case localtime and gmtime share a buffer. */
+ if (ltptr)
+ lt = *ltptr;
+ utc = gmtime (&itime);
+ if (utc == NULL)
+ err = errno;
+ restorezone (zone, oldenv, s_localtime);
/* delayed until zone has been restored. */
errno = err;
if (utc == NULL || ltptr == NULL)
result = filltime (<, zoff, zname);
SCM_ALLOW_INTS;
+ scm_must_free (zname);
return result;
}
/* copy time components from a Scheme object to a struct tm. */
static void
-bdtime2c (SCM sbd_time, struct tm *lt, int pos, char *subr)
+bdtime2c (SCM sbd_time, struct tm *lt, int pos, const char *subr)
{
SCM_ASSERT (SCM_NIMP (sbd_time) && SCM_VECTORP (sbd_time)
- && scm_vector_length (sbd_time) == 11
+ && SCM_LENGTH (sbd_time) == 11
&& SCM_INUMP (SCM_VELTS (sbd_time)[0])
&& SCM_INUMP (SCM_VELTS (sbd_time)[1])
&& SCM_INUMP (SCM_VELTS (sbd_time)[2])
&& SCM_INUMP (SCM_VELTS (sbd_time)[5])
&& SCM_INUMP (SCM_VELTS (sbd_time)[6])
&& SCM_INUMP (SCM_VELTS (sbd_time)[7])
- && SCM_INUMP (SCM_VELTS (sbd_time)[8]),
+ && SCM_INUMP (SCM_VELTS (sbd_time)[8])
+ && SCM_STRINGP (SCM_VELTS (sbd_time)[10]),
sbd_time, pos, subr);
lt->tm_sec = SCM_INUM (SCM_VELTS (sbd_time)[0]);
lt->tm_min = SCM_INUM (SCM_VELTS (sbd_time)[1]);
lt->tm_wday = SCM_INUM (SCM_VELTS (sbd_time)[6]);
lt->tm_yday = SCM_INUM (SCM_VELTS (sbd_time)[7]);
lt->tm_isdst = SCM_INUM (SCM_VELTS (sbd_time)[8]);
+#ifdef HAVE_TM_ZONE
+ lt->tm_gmtoff = SCM_INUM (SCM_VELTS (sbd_time)[9]);
+ lt->tm_zone = SCM_CHARS (SCM_VELTS (sbd_time)[10]);
+#endif
}
SCM_PROC (s_mktime, "mktime", 1, 1, 0, scm_mktime);
SCM result;
int zoff;
char *zname = 0;
- char *oldtz = 0;
+ char **oldenv;
int err;
SCM_ASSERT (SCM_NIMP (sbd_time) && SCM_VECTORP (sbd_time), sbd_time,
bdtime2c (sbd_time, <, SCM_ARG1, s_mktime);
SCM_DEFER_INTS;
- oldtz = setzone (zone, SCM_ARG2, s_mktime);
+ oldenv = setzone (zone, SCM_ARG2, s_mktime);
itime = mktime (<);
err = errno;
- /* timezone offset in seconds west of UTC. */
- utc = gmtime (&itime);
- if (utc == NULL)
- err = errno;
-
if (itime != -1)
{
+ const char *ptr;
+
+ /* copy zone name before calling gmtime or tzset. */
#ifdef HAVE_TM_ZONE
- zname = lt.tm_zone;
+ ptr = lt.tm_zone;
#else
# ifdef HAVE_TZNAME
- /* must be copied before calling tzset again. */
- char *ptr = tzname[ (lt.tm_isdst == 1) ? 1 : 0 ];
-
- zname = scm_must_malloc (strlen (ptr) + 1, s_mktime);
- strcpy (zname, ptr);
+ ptr = tzname[ (lt.tm_isdst == 1) ? 1 : 0 ];
# else
- scm_misc_error (s_localtime, "Not fully implemented on this platform",
+ scm_misc_error (s_mktime, "Not fully implemented on this platform",
SCM_EOL);
# endif
#endif
+ zname = scm_must_malloc (strlen (ptr) + 1, s_mktime);
+ strcpy (zname, ptr);
}
- restorezone (zone, oldtz);
+
+ /* get timezone offset in seconds west of UTC. */
+ utc = gmtime (&itime);
+ if (utc == NULL)
+ err = errno;
+
+ restorezone (zone, oldenv, s_mktime);
/* delayed until zone has been restored. */
errno = err;
if (utc == NULL || itime == -1)
result = scm_cons (scm_long2num ((long) itime),
filltime (<, zoff, zname));
SCM_ALLOW_INTS;
+ scm_must_free (zname);
return result;
}
int size = 50;
char *fmt;
int len;
+ SCM result;
SCM_ASSERT (SCM_NIMP (format) && SCM_ROSTRINGP (format), format, SCM_ARG1,
s_strftime);
size *= 2;
tbuf = scm_must_malloc (size, s_strftime);
}
- return scm_makfromstr (tbuf, len, 0);
+ result = scm_makfromstr (tbuf, len, 0);
+ scm_must_free (tbuf);
+ return result;
}
SCM_PROC (s_strptime, "strptime", 2, 0, 0, scm_strptime);
HCoop / bpt / guile.git / blobdiff