X-Git-Url: https://git.hcoop.net/bpt/guile.git/blobdiff_plain/e0e4ffd234bbd967664c744a650592518ff33580..b074884f06a05025e8ce1ef87b4387ccd313d1ac:/libguile/stime.c diff --git a/libguile/stime.c b/libguile/stime.c index 65dbc7aa3..80d3d5d68 100644 --- a/libguile/stime.c +++ b/libguile/stime.c @@ -1,4 +1,4 @@ -/* 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 @@ -80,30 +80,22 @@ 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 -# 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 @@ -130,23 +122,23 @@ extern int errno; #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 @@ -167,7 +159,7 @@ scm_times (void) 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); @@ -245,7 +237,7 @@ scm_gettimeofday (void) 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); @@ -261,45 +253,41 @@ filltime (struct tm *bd_time, int zoff, char *zname) 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(); } } @@ -314,38 +302,39 @@ scm_localtime (SCM time, SCM zone) 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) @@ -365,6 +354,7 @@ scm_localtime (SCM time, SCM zone) result = filltime (<, zoff, zname); SCM_ALLOW_INTS; + scm_must_free (zname); return result; } @@ -388,10 +378,10 @@ scm_gmtime (SCM time) /* 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]) @@ -400,7 +390,8 @@ bdtime2c (SCM sbd_time, struct tm *lt, int pos, char *subr) && 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]); @@ -411,6 +402,10 @@ bdtime2c (SCM sbd_time, struct tm *lt, int pos, char *subr) 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); @@ -422,7 +417,7 @@ scm_mktime (SCM sbd_time, SCM zone) 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, @@ -430,33 +425,35 @@ scm_mktime (SCM sbd_time, SCM zone) 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) @@ -476,6 +473,7 @@ scm_mktime (SCM sbd_time, SCM zone) result = scm_cons (scm_long2num ((long) itime), filltime (<, zoff, zname)); SCM_ALLOW_INTS; + scm_must_free (zname); return result; } @@ -500,6 +498,7 @@ scm_strftime (format, stime) int size = 50; char *fmt; int len; + SCM result; SCM_ASSERT (SCM_NIMP (format) && SCM_ROSTRINGP (format), format, SCM_ARG1, s_strftime); @@ -516,7 +515,9 @@ scm_strftime (format, stime) 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);