libguile/stime.c

   1 /* Copyright (C) 1995,1996,1997,1998, 1999 Free Software Foundation, Inc.
   2  *
   3  * This program is free software; you can redistribute it and/or modify
   4  * it under the terms of the GNU General Public License as published by
   5  * the Free Software Foundation; either version 2, or (at your option)
   6  * any later version.
   7  *
   8  * This program is distributed in the hope that it will be useful,
   9  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  10  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  11  * GNU General Public License for more details.
  12  *
  13  * You should have received a copy of the GNU General Public License
  14  * along with this software; see the file COPYING.  If not, write to
  15  * the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
  16  * Boston, MA 02111-1307 USA
  17  *
  18  * As a special exception, the Free Software Foundation gives permission
  19  * for additional uses of the text contained in its release of GUILE.
  20  *
  21  * The exception is that, if you link the GUILE library with other files
  22  * to produce an executable, this does not by itself cause the
  23  * resulting executable to be covered by the GNU General Public License.
  24  * Your use of that executable is in no way restricted on account of
  25  * linking the GUILE library code into it.
  26  *
  27  * This exception does not however invalidate any other reasons why
  28  * the executable file might be covered by the GNU General Public License.
  29  *
  30  * This exception applies only to the code released by the
  31  * Free Software Foundation under the name GUILE.  If you copy
  32  * code from other Free Software Foundation releases into a copy of
  33  * GUILE, as the General Public License permits, the exception does
  34  * not apply to the code that you add in this way.  To avoid misleading
  35  * anyone as to the status of such modified files, you must delete
  36  * this exception notice from them.
  37  *
  38  * If you write modifications of your own for GUILE, it is your choice
  39  * whether to permit this exception to apply to your modifications.
  40  * If you do not wish that, delete this exception notice.  */
  41
  42 /* Software engineering face-lift by Greg J. Badros, 11-Dec-1999,
  43    gjb@cs.washington.edu, http://www.cs.washington.edu/homes/gjb */
  44
  45 \f
  46
  47 #include <stdio.h>
  48 #include "_scm.h"
  49 #include "feature.h"
  50
  51 #include "scm_validate.h"
  52 #include "stime.h"
  53
  54 #ifdef HAVE_UNISTD_H
  55 #include <unistd.h>
  56 #endif
  57
  58 \f
  59 # ifdef HAVE_SYS_TYPES_H
  60 #  include <sys/types.h>
  61 # endif
  62
  63 # ifdef TIME_WITH_SYS_TIME
  64 #  include <sys/time.h>
  65 #  include <time.h>
  66 # else
  67 #  ifdef HAVE_SYS_TIME_H
  68 #   include <sys/time.h>
  69 #  else
  70 #   ifdef HAVE_TIME_H
  71 #    include <time.h>
  72 #   endif
  73 #  endif
  74 # endif
  75
  76 #ifdef HAVE_SYS_TIMES_H
  77 # include <sys/times.h>
  78 #endif
  79
  80 #ifdef HAVE_SYS_TIMEB_H
  81 # include <sys/timeb.h>
  82 #endif
  83
  84 #ifndef tzname /* For SGI.  */
  85 extern char *tzname[]; /* RS6000 and others reject char **tzname.  */
  86 #endif
  87
  88 #ifdef MISSING_STRPTIME_DECL
  89 extern char *strptime ();
  90 #endif
  91
  92 /* This should be figured out by autoconf.  */
  93 #if ! defined(CLKTCK) && defined(CLK_TCK)
  94 #  define CLKTCK CLK_TCK
  95 #endif
  96 #if ! defined(CLKTCK) && defined(CLOCKS_PER_SEC)
  97 #  define CLKTCK CLOCKS_PER_SEC
  98 #endif
  99 #if ! defined(CLKTCK)
 100 #  define CLKTCK 60
 101 #endif
 102
 103
 104 #ifdef __STDC__
 105 # define timet time_t
 106 #else
 107 # define timet long
 108 #endif
 109
 110 #ifdef HAVE_TIMES
 111 static
 112 long mytime()
 113 {
 114   struct tms time_buffer;
 115   times(&time_buffer);
 116   return time_buffer.tms_utime + time_buffer.tms_stime;
 117 }
 118 #else
 119 # ifdef LACK_CLOCK
 120 #    define mytime() ((time((timet*)0) - scm_your_base) * CLKTCK)
 121 # else
 122 #  define mytime clock
 123 # endif
 124 #endif
 125
 126 extern int errno;
 127
 128 #ifdef HAVE_FTIME
 129
 130 struct timeb scm_your_base = {0};
 131
 132 GUILE_PROC(scm_get_internal_real_time, "get-internal-real-time", 0, 0, 0,
 133            (),
 134 "Returns the number of time units since the interpreter was started.")
 135 #define FUNC_NAME s_scm_get_internal_real_time
 136 {
 137   struct timeb time_buffer;
 138
 139   SCM tmp;
 140   ftime (&time_buffer);
 141   time_buffer.time -= scm_your_base.time;
 142   tmp = scm_long2num (time_buffer.millitm - scm_your_base.millitm);
 143   tmp = scm_sum (tmp,
 144                  scm_product (SCM_MAKINUM (1000),
 145                               SCM_MAKINUM (time_buffer.time)));
 146   return scm_quotient (scm_product (tmp, SCM_MAKINUM (CLKTCK)),
 147                        SCM_MAKINUM (1000));
 148 }
 149 #undef FUNC_NAME
 150
 151
 152 #else
 153
 154 timet scm_your_base = 0;
 155
 156 GUILE_PROC(scm_get_internal_real_time, "get-internal-real-time", 0, 0, 0,
 157            (),
 158 "")
 159 #define FUNC_NAME s_scm_get_internal_real_time
 160 {
 161   return scm_long2num((time((timet*)0) - scm_your_base) * (int)CLKTCK);
 162 }
 163 #undef FUNC_NAME
 164
 165 #endif
 166
 167 GUILE_PROC (scm_times, "times", 0, 0, 0,
 168             (void),
 169 "Returns an object with information about real and processor time.
 170 The following procedures accept such an object as an argument and
 171 return a selected component:
 172
 173 @table @code
 174 @item tms:clock
 175 The current real time, expressed as time units relative to an
 176 arbitrary base.
 177 @item tms:utime
 178 The CPU time units used by the calling process.
 179 @item tms:stime
 180 The CPU time units used by the system on behalf of the calling process.
 181 @item tms:cutime
 182 The CPU time units used by terminated child processes of the calling
 183 process, whose status has been collected (e.g., using @code{waitpid}).
 184 @item tms:cstime
 185 Similarly, the CPU times units used by the system on behalf of
 186 terminated child processes.
 187 @end table")
 188 #define FUNC_NAME s_scm_times
 189 {
 190 #ifdef HAVE_TIMES
 191   struct tms t;
 192   clock_t rv;
 193
 194   SCM result = scm_make_vector (SCM_MAKINUM(5), SCM_UNDEFINED);
 195   rv = times (&t);
 196   if (rv == -1)
 197     SCM_SYSERROR;
 198   SCM_VELTS (result)[0] = scm_long2num (rv);
 199   SCM_VELTS (result)[1] = scm_long2num (t.tms_utime);
 200   SCM_VELTS (result)[2] = scm_long2num (t.tms_stime);
 201   SCM_VELTS (result)[3] = scm_long2num (t.tms_cutime);
 202   SCM_VELTS (result)[4] = scm_long2num (t.tms_cstime);
 203   return result;
 204 #else
 205   SCM_SYSMISSING;
 206 #endif
 207 }
 208 #undef FUNC_NAME
 209
 210 #ifndef HAVE_TZSET
 211 /* GNU-WIN32's cygwin.dll doesn't have this. */
 212 #define tzset()
 213 #endif
 214
 215
 216 static long scm_my_base = 0;
 217
 218 GUILE_PROC(scm_get_internal_run_time, "get-internal-run-time", 0, 0, 0,
 219            (void),
 220 "Returns the number of time units of processor time used by the interpreter.
 221 Both "system" and "user" time
 222 are included but subprocesses are not.")
 223 #define FUNC_NAME s_scm_get_internal_run_time
 224 {
 225   return scm_long2num(mytime()-scm_my_base);
 226 }
 227 #undef FUNC_NAME
 228
 229 GUILE_PROC(scm_current_time, "current-time", 0, 0, 0,
 230            (void),
 231 "Returns the number of seconds since 1970-01-01 00:00:00 UTC, excluding
 232 leap seconds.")
 233 #define FUNC_NAME s_scm_current_time
 234 {
 235   timet timv;
 236
 237   SCM_DEFER_INTS;
 238   if ((timv = time (0)) == -1)
 239     SCM_SYSERROR;
 240   SCM_ALLOW_INTS;
 241   return scm_long2num((long) timv);
 242 }
 243 #undef FUNC_NAME
 244
 245 GUILE_PROC (scm_gettimeofday, "gettimeofday", 0, 0, 0,
 246             (void),
 247 "Returns a pair containing the number of seconds and microseconds since
 248 1970-01-01 00:00:00 UTC, excluding leap seconds.  Note: whether true
 249 microsecond resolution is available depends on the operating system.")
 250 #define FUNC_NAME s_scm_gettimeofday
 251 {
 252 #ifdef HAVE_GETTIMEOFDAY
 253   struct timeval time;
 254
 255   SCM_DEFER_INTS;
 256   if (gettimeofday (&time, NULL) == -1)
 257     SCM_SYSERROR;
 258   SCM_ALLOW_INTS;
 259   return scm_cons (scm_long2num ((long) time.tv_sec),
 260                    scm_long2num ((long) time.tv_usec));
 261 #else
 262 # ifdef HAVE_FTIME
 263   struct timeb time;
 264
 265   ftime(&time);
 266   return scm_cons (scm_long2num ((long) time.time),
 267                    SCM_MAKINUM (time.millitm * 1000));
 268 # else
 269   timet timv;
 270
 271   SCM_DEFER_INTS;
 272   if ((timv = time (0)) == -1)
 273     SCM_SYSERROR;
 274   SCM_ALLOW_INTS;
 275   return scm_cons (scm_long2num (timv), SCM_MAKINUM (0));
 276 # endif
 277 #endif
 278 }
 279 #undef FUNC_NAME
 280
 281 static SCM
 282 filltime (struct tm *bd_time, int zoff, char *zname)
 283 {
 284   SCM result = scm_make_vector (SCM_MAKINUM(11), SCM_UNDEFINED);
 285
 286   SCM_VELTS (result)[0] = SCM_MAKINUM (bd_time->tm_sec);
 287   SCM_VELTS (result)[1] = SCM_MAKINUM (bd_time->tm_min);
 288   SCM_VELTS (result)[2] = SCM_MAKINUM (bd_time->tm_hour);
 289   SCM_VELTS (result)[3] = SCM_MAKINUM (bd_time->tm_mday);
 290   SCM_VELTS (result)[4] = SCM_MAKINUM (bd_time->tm_mon);
 291   SCM_VELTS (result)[5] = SCM_MAKINUM (bd_time->tm_year);
 292   SCM_VELTS (result)[6] = SCM_MAKINUM (bd_time->tm_wday);
 293   SCM_VELTS (result)[7] = SCM_MAKINUM (bd_time->tm_yday);
 294   SCM_VELTS (result)[8] = SCM_MAKINUM (bd_time->tm_isdst);
 295   SCM_VELTS (result)[9] = SCM_MAKINUM (zoff);
 296   SCM_VELTS (result)[10] = zname ? scm_makfrom0str (zname) : SCM_BOOL_F;
 297   return result;
 298 }
 299
 300 static char tzvar[3] = "TZ";
 301 extern char ** environ;
 302
 303 static char **
 304 setzone (SCM zone, int pos, const char *subr)
 305 {
 306   char **oldenv = 0;
 307
 308   if (!SCM_UNBNDP (zone))
 309     {
 310       static char *tmpenv[2];
 311       char *buf;
 312
 313       /* if zone was supplied, set the environment temporarily.  */
 314       SCM_ASSERT (SCM_NIMP (zone) && SCM_ROSTRINGP (zone), zone, pos, subr);
 315       SCM_COERCE_SUBSTR (zone);
 316       buf = scm_must_malloc (SCM_LENGTH (zone) + sizeof (tzvar) + 1,
 317                              subr);
 318       sprintf (buf, "%s=%s", tzvar, SCM_ROCHARS (zone));
 319       oldenv = environ;
 320       tmpenv[0] = buf;
 321       tmpenv[1] = 0;
 322       environ = tmpenv;
 323       tzset();
 324     }
 325   return oldenv;
 326 }
 327
 328 static void
 329 restorezone (SCM zone, char **oldenv, const char *subr)
 330 {
 331   if (!SCM_UNBNDP (zone))
 332     {
 333       scm_must_free (environ[0]);
 334       environ = oldenv;
 335       tzset();
 336     }
 337 }
 338
 339
 340 GUILE_PROC (scm_localtime, "localtime", 1, 1, 0,
 341             (SCM time, SCM zone),
 342 "Returns an object representing the broken down components of @var{time},
 343 an integer like the one returned by @code{current-time}.  The time zone
 344 for the calculation is optionally specified by @var{zone} (a string),
 345 otherwise the @code{TZ} environment variable or the system default is
 346 used.")
 347 #define FUNC_NAME s_scm_localtime
 348 {
 349   timet itime;
 350   struct tm *ltptr, lt, *utc;
 351   SCM result;
 352   int zoff;
 353   char *zname = 0;
 354   char **oldenv;
 355   int err;
 356
 357   itime = SCM_NUM2LONG (1,time);
 358   SCM_DEFER_INTS;
 359   oldenv = setzone (zone, SCM_ARG2, FUNC_NAME);
 360   ltptr = localtime (&itime);
 361   err = errno;
 362   if (ltptr)
 363     {
 364       const char *ptr;
 365
 366       /* copy zone name before calling gmtime or tzset.  */
 367 #ifdef HAVE_TM_ZONE
 368       ptr = ltptr->tm_zone;
 369 #else
 370 # ifdef HAVE_TZNAME
 371       ptr = tzname[ (ltptr->tm_isdst == 1) ? 1 : 0 ];
 372 # else
 373       SCM_MISC_ERROR ("Not fully implemented on this platform",_EOL);
 374 # endif
 375 #endif
 376       zname = SCM_MUST_MALLOC (strlen (ptr) + 1);
 377       strcpy (zname, ptr);
 378     }
 379   /* the struct is copied in case localtime and gmtime share a buffer.  */
 380   if (ltptr)
 381     lt = *ltptr;
 382   utc = gmtime (&itime);
 383   if (utc == NULL)
 384     err = errno;
 385   restorezone (zone, oldenv, FUNC_NAME);
 386   /* delayed until zone has been restored.  */
 387   errno = err;
 388   if (utc == NULL || ltptr == NULL)
 389     SCM_SYSERROR;
 390
 391   /* calculate timezone offset in seconds west of UTC.  */
 392   zoff = (utc->tm_hour - lt.tm_hour) * 3600 + (utc->tm_min - lt.tm_min) * 60
 393     + utc->tm_sec - lt.tm_sec;
 394   if (utc->tm_year < lt.tm_year)
 395     zoff -= 24 * 60 * 60;
 396   else if (utc->tm_year > lt.tm_year)
 397     zoff += 24 * 60 * 60;
 398   else if (utc->tm_yday < lt.tm_yday)
 399     zoff -= 24 * 60 * 60;
 400   else if (utc->tm_yday > lt.tm_yday)
 401     zoff += 24 * 60 * 60;
 402
 403   result = filltime (&lt, zoff, zname);
 404   SCM_ALLOW_INTS;
 405   scm_must_free (zname);
 406   return result;
 407 }
 408 #undef FUNC_NAME
 409
 410 GUILE_PROC (scm_gmtime, "gmtime", 1, 0, 0,
 411             (SCM time),
 412 "Returns an object representing the broken down components of @var{time},
 413 an integer like the one returned by @code{current-time}.  The values
 414 are calculated for UTC.")
 415 #define FUNC_NAME s_scm_gmtime
 416 {
 417   timet itime;
 418   struct tm *bd_time;
 419   SCM result;
 420
 421   itime = SCM_NUM2LONG (1,time);
 422   SCM_DEFER_INTS;
 423   bd_time = gmtime (&itime);
 424   if (bd_time == NULL)
 425     SCM_SYSERROR;
 426   result = filltime (bd_time, 0, "GMT");
 427   SCM_ALLOW_INTS;
 428   return result;
 429 }
 430 #undef FUNC_NAME
 431
 432 /* copy time components from a Scheme object to a struct tm.  */
 433 static void
 434 bdtime2c (SCM sbd_time, struct tm *lt, int pos, const char *subr)
 435 {
 436   SCM *velts;
 437   int i;
 438
 439   SCM_ASSERT (SCM_NIMP (sbd_time) && SCM_VECTORP (sbd_time)
 440               && SCM_LENGTH (sbd_time) == 11,
 441               sbd_time, pos, subr);
 442   velts = SCM_VELTS (sbd_time);
 443   for (i = 0; i < 10; i++)
 444     {
 445       SCM_ASSERT (SCM_INUMP (velts[i]), sbd_time, pos, subr);
 446     }
 447   SCM_ASSERT (SCM_FALSEP (velts[10])
 448               || (SCM_NIMP (velts[10]) && SCM_STRINGP (velts[10])),
 449               sbd_time, pos, subr);
 450
 451   lt->tm_sec = SCM_INUM (velts[0]);
 452   lt->tm_min = SCM_INUM (velts[1]);
 453   lt->tm_hour = SCM_INUM (velts[2]);
 454   lt->tm_mday = SCM_INUM (velts[3]);
 455   lt->tm_mon = SCM_INUM (velts[4]);
 456   lt->tm_year = SCM_INUM (velts[5]);
 457   lt->tm_wday = SCM_INUM (velts[6]);
 458   lt->tm_yday = SCM_INUM (velts[7]);
 459   lt->tm_isdst = SCM_INUM (velts[8]);
 460 #ifdef HAVE_TM_ZONE
 461   lt->tm_gmtoff = SCM_INUM (velts[9]);
 462   if (SCM_FALSEP (velts[10]))
 463     lt->tm_zone = NULL;
 464   else
 465     lt->tm_zone  = SCM_CHARS (velts[10]);
 466 #endif
 467 }
 468
 469 GUILE_PROC (scm_mktime, "mktime", 1, 1, 0,
 470             (SCM sbd_time, SCM zone),
 471 "@var{bd-time} is an object representing broken down time and @code{zone}
 472 is an optional time zone specifier (otherwise the TZ environment variable
 473 or the system default is used).
 474
 475 Returns a pair: the CAR is a corresponding
 476 integer time value like that returned
 477 by @code{current-time}; the CDR is a broken down time object, similar to
 478 as @var{bd-time} but with normalized values.")
 479 #define FUNC_NAME s_scm_mktime
 480 {
 481   timet itime;
 482   struct tm lt, *utc;
 483   SCM result;
 484   int zoff;
 485   char *zname = 0;
 486   char **oldenv;
 487   int err;
 488
 489   bdtime2c (sbd_time, &lt, SCM_ARG1, FUNC_NAME);
 490
 491   SCM_DEFER_INTS;
 492   oldenv = setzone (zone, SCM_ARG2, FUNC_NAME);
 493   itime = mktime (&lt);
 494   err = errno;
 495
 496   if (itime != -1)
 497     {
 498       const char *ptr;
 499
 500       /* copy zone name before calling gmtime or tzset.  */
 501 #ifdef HAVE_TM_ZONE
 502       ptr = lt.tm_zone;
 503 #else
 504 # ifdef HAVE_TZNAME
 505       ptr = tzname[ (lt.tm_isdst == 1) ? 1 : 0 ];
 506 # else
 507       scm_misc_error (s_mktime, "Not fully implemented on this platform",
 508                       SCM_EOL);
 509 # endif
 510 #endif
 511       zname = SCM_MUST_MALLOC (strlen (ptr) + 1);
 512       strcpy (zname, ptr);
 513     }
 514
 515   /* get timezone offset in seconds west of UTC.  */
 516   utc = gmtime (&itime);
 517   if (utc == NULL)
 518     err = errno;
 519
 520   restorezone (zone, oldenv, FUNC_NAME);
 521   /* delayed until zone has been restored.  */
 522   errno = err;
 523   if (utc == NULL || itime == -1)
 524     SCM_SYSERROR;
 525
 526   zoff = (utc->tm_hour - lt.tm_hour) * 3600 + (utc->tm_min - lt.tm_min) * 60
 527     + utc->tm_sec - lt.tm_sec;
 528   if (utc->tm_year < lt.tm_year)
 529     zoff -= 24 * 60 * 60;
 530   else if (utc->tm_year > lt.tm_year)
 531     zoff += 24 * 60 * 60;
 532   else if (utc->tm_yday < lt.tm_yday)
 533     zoff -= 24 * 60 * 60;
 534   else if (utc->tm_yday > lt.tm_yday)
 535     zoff += 24 * 60 * 60;
 536
 537   result = scm_cons (scm_long2num ((long) itime),
 538                      filltime (&lt, zoff, zname));
 539   SCM_ALLOW_INTS;
 540   scm_must_free (zname);
 541   return result;
 542 }
 543 #undef FUNC_NAME
 544
 545 GUILE_PROC (scm_tzset, "tzset", 0, 0, 0,
 546             (void),
 547 "Initialize the timezone from the TZ environment variable or the system
 548 default.  Usually this is done automatically by other procedures which
 549 use the time zone, but this procedure may need to be used if TZ
 550 is changed.")
 551 #define FUNC_NAME s_scm_tzset
 552 {
 553   tzset();
 554   return SCM_UNSPECIFIED;
 555 }
 556 #undef FUNC_NAME
 557
 558 GUILE_PROC (scm_strftime, "strftime", 2, 0, 0,
 559             (SCM format, SCM stime),
 560 "Formats a time specification @var{time} using @var{template}.  @var{time}
 561 is an object with time components in the form returned by @code{localtime}
 562 or @code{gmtime}.  @var{template} is a string which can include formatting
 563 specifications introduced by a @code{%} character.  The formatting of
 564 month and day names is dependent on the current locale.  The value returned
 565 is the formatted string.
 566 @xref{Formatting Date and Time, , , libc, The GNU C Library Reference Manual}.)")
 567 #define FUNC_NAME s_scm_strftime
 568 {
 569   struct tm t;
 570
 571   char *tbuf;
 572   int size = 50;
 573   char *fmt;
 574   int len;
 575   SCM result;
 576
 577   SCM_VALIDATE_ROSTRING(1,format);
 578   bdtime2c (stime, &t, SCM_ARG2, FUNC_NAME);
 579
 580   SCM_COERCE_SUBSTR (format);
 581   fmt = SCM_ROCHARS (format);
 582   len = SCM_ROLENGTH (format);
 583
 584   tbuf = SCM_MUST_MALLOC (size);
 585   while ((len = strftime (tbuf, size, fmt, &t)) == size)
 586     {
 587       scm_must_free (tbuf);
 588       size *= 2;
 589       tbuf = SCM_MUST_MALLOC (size);
 590     }
 591   result = scm_makfromstr (tbuf, len, 0);
 592   scm_must_free (tbuf);
 593   return result;
 594 }
 595 #undef FUNC_NAME
 596
 597 GUILE_PROC (scm_strptime, "strptime", 2, 0, 0,
 598             (SCM format, SCM string),
 599 "Performs the reverse action to @code{strftime}, parsing @var{string}
 600 according to the specification supplied in @var{template}.  The
 601 interpretation of month and day names is dependent on the current
 602 locale.  The
 603 value returned is a pair.  The CAR has an object with time components
 604 in the form returned by @code{localtime} or @code{gmtime},
 605 but the time zone components
 606 are not usefully set.
 607 The CDR reports the number of characters from @var{string} which
 608 were used for the conversion.")
 609 #define FUNC_NAME s_scm_strptime
 610 {
 611 #ifdef HAVE_STRPTIME
 612   struct tm t;
 613   char *fmt, *str, *rest;
 614
 615   SCM_VALIDATE_ROSTRING(1,format);
 616   SCM_VALIDATE_ROSTRING(2,string);
 617
 618   SCM_COERCE_SUBSTR (format);
 619   SCM_COERCE_SUBSTR (string);
 620   fmt = SCM_ROCHARS (format);
 621   str = SCM_ROCHARS (string);
 622
 623   /* initialize the struct tm */
 624 #define tm_init(field) t.field = 0
 625   tm_init (tm_sec);
 626   tm_init (tm_min);
 627   tm_init (tm_hour);
 628   tm_init (tm_mday);
 629   tm_init (tm_mon);
 630   tm_init (tm_year);
 631   tm_init (tm_wday);
 632   tm_init (tm_yday);
 633 #undef tm_init
 634
 635   t.tm_isdst = -1;
 636   SCM_DEFER_INTS;
 637   if ((rest = strptime (str, fmt, &t)) == NULL)
 638     SCM_SYSERROR;
 639
 640   SCM_ALLOW_INTS;
 641   return scm_cons (filltime (&t, 0, NULL),  SCM_MAKINUM (rest - str));
 642
 643 #else
 644   SCM_SYSMISSING;
 645 #endif
 646 }
 647 #undef FUNC_NAME
 648
 649 void
 650 scm_init_stime()
 651 {
 652   scm_sysintern("internal-time-units-per-second",
 653                 scm_long2num((long)CLKTCK));
 654
 655 #ifdef HAVE_FTIME
 656   if (!scm_your_base.time) ftime(&scm_your_base);
 657 #else
 658   if (!scm_your_base) time(&scm_your_base);
 659 #endif
 660
 661   if (!scm_my_base) scm_my_base = mytime();
 662
 663   scm_add_feature ("current-time");
 664 #include "stime.x"
 665 }
 666