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_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_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]) || SCM_STRINGP (velts[10]),
 448               sbd_time, pos, subr);
 449
 450   lt->tm_sec = SCM_INUM (velts[0]);
 451   lt->tm_min = SCM_INUM (velts[1]);
 452   lt->tm_hour = SCM_INUM (velts[2]);
 453   lt->tm_mday = SCM_INUM (velts[3]);
 454   lt->tm_mon = SCM_INUM (velts[4]);
 455   lt->tm_year = SCM_INUM (velts[5]);
 456   lt->tm_wday = SCM_INUM (velts[6]);
 457   lt->tm_yday = SCM_INUM (velts[7]);
 458   lt->tm_isdst = SCM_INUM (velts[8]);
 459 #ifdef HAVE_TM_ZONE
 460   lt->tm_gmtoff = SCM_INUM (velts[9]);
 461   if (SCM_FALSEP (velts[10]))
 462     lt->tm_zone = NULL;
 463   else
 464     lt->tm_zone  = SCM_CHARS (velts[10]);
 465 #endif
 466 }
 467
 468 GUILE_PROC (scm_mktime, "mktime", 1, 1, 0,
 469             (SCM sbd_time, SCM zone),
 470 "@var{bd-time} is an object representing broken down time and @code{zone}
 471 is an optional time zone specifier (otherwise the TZ environment variable
 472 or the system default is used).
 473
 474 Returns a pair: the CAR is a corresponding
 475 integer time value like that returned
 476 by @code{current-time}; the CDR is a broken down time object, similar to
 477 as @var{bd-time} but with normalized values.")
 478 #define FUNC_NAME s_scm_mktime
 479 {
 480   timet itime;
 481   struct tm lt, *utc;
 482   SCM result;
 483   int zoff;
 484   char *zname = 0;
 485   char **oldenv;
 486   int err;
 487
 488   bdtime2c (sbd_time, &lt, SCM_ARG1, FUNC_NAME);
 489
 490   SCM_DEFER_INTS;
 491   oldenv = setzone (zone, SCM_ARG2, FUNC_NAME);
 492   itime = mktime (&lt);
 493   err = errno;
 494
 495   if (itime != -1)
 496     {
 497       const char *ptr;
 498
 499       /* copy zone name before calling gmtime or tzset.  */
 500 #ifdef HAVE_TM_ZONE
 501       ptr = lt.tm_zone;
 502 #else
 503 # ifdef HAVE_TZNAME
 504       ptr = tzname[ (lt.tm_isdst == 1) ? 1 : 0 ];
 505 # else
 506       scm_misc_error (s_mktime, "Not fully implemented on this platform",
 507                       SCM_EOL);
 508 # endif
 509 #endif
 510       zname = SCM_MUST_MALLOC (strlen (ptr) + 1);
 511       strcpy (zname, ptr);
 512     }
 513
 514   /* get timezone offset in seconds west of UTC.  */
 515   utc = gmtime (&itime);
 516   if (utc == NULL)
 517     err = errno;
 518
 519   restorezone (zone, oldenv, FUNC_NAME);
 520   /* delayed until zone has been restored.  */
 521   errno = err;
 522   if (utc == NULL || itime == -1)
 523     SCM_SYSERROR;
 524
 525   zoff = (utc->tm_hour - lt.tm_hour) * 3600 + (utc->tm_min - lt.tm_min) * 60
 526     + utc->tm_sec - lt.tm_sec;
 527   if (utc->tm_year < lt.tm_year)
 528     zoff -= 24 * 60 * 60;
 529   else if (utc->tm_year > lt.tm_year)
 530     zoff += 24 * 60 * 60;
 531   else if (utc->tm_yday < lt.tm_yday)
 532     zoff -= 24 * 60 * 60;
 533   else if (utc->tm_yday > lt.tm_yday)
 534     zoff += 24 * 60 * 60;
 535
 536   result = scm_cons (scm_long2num ((long) itime),
 537                      filltime (&lt, zoff, zname));
 538   SCM_ALLOW_INTS;
 539   scm_must_free (zname);
 540   return result;
 541 }
 542 #undef FUNC_NAME
 543
 544 GUILE_PROC (scm_tzset, "tzset", 0, 0, 0,
 545             (void),
 546 "Initialize the timezone from the TZ environment variable or the system
 547 default.  Usually this is done automatically by other procedures which
 548 use the time zone, but this procedure may need to be used if TZ
 549 is changed.")
 550 #define FUNC_NAME s_scm_tzset
 551 {
 552   tzset();
 553   return SCM_UNSPECIFIED;
 554 }
 555 #undef FUNC_NAME
 556
 557 GUILE_PROC (scm_strftime, "strftime", 2, 0, 0,
 558             (SCM format, SCM stime),
 559 "Formats a time specification @var{time} using @var{template}.  @var{time}
 560 is an object with time components in the form returned by @code{localtime}
 561 or @code{gmtime}.  @var{template} is a string which can include formatting
 562 specifications introduced by a @code{%} character.  The formatting of
 563 month and day names is dependent on the current locale.  The value returned
 564 is the formatted string.
 565 @xref{Formatting Date and Time, , , libc, The GNU C Library Reference Manual}.)")
 566 #define FUNC_NAME s_scm_strftime
 567 {
 568   struct tm t;
 569
 570   char *tbuf;
 571   int size = 50;
 572   char *fmt;
 573   int len;
 574   SCM result;
 575
 576   SCM_VALIDATE_ROSTRING(1,format);
 577   bdtime2c (stime, &t, SCM_ARG2, FUNC_NAME);
 578
 579   SCM_COERCE_SUBSTR (format);
 580   fmt = SCM_ROCHARS (format);
 581   len = SCM_ROLENGTH (format);
 582
 583   tbuf = SCM_MUST_MALLOC (size);
 584   while ((len = strftime (tbuf, size, fmt, &t)) == size)
 585     {
 586       scm_must_free (tbuf);
 587       size *= 2;
 588       tbuf = SCM_MUST_MALLOC (size);
 589     }
 590   result = scm_makfromstr (tbuf, len, 0);
 591   scm_must_free (tbuf);
 592   return result;
 593 }
 594 #undef FUNC_NAME
 595
 596 GUILE_PROC (scm_strptime, "strptime", 2, 0, 0,
 597             (SCM format, SCM string),
 598 "Performs the reverse action to @code{strftime}, parsing @var{string}
 599 according to the specification supplied in @var{template}.  The
 600 interpretation of month and day names is dependent on the current
 601 locale.  The
 602 value returned is a pair.  The CAR has an object with time components
 603 in the form returned by @code{localtime} or @code{gmtime},
 604 but the time zone components
 605 are not usefully set.
 606 The CDR reports the number of characters from @var{string} which
 607 were used for the conversion.")
 608 #define FUNC_NAME s_scm_strptime
 609 {
 610 #ifdef HAVE_STRPTIME
 611   struct tm t;
 612   char *fmt, *str, *rest;
 613
 614   SCM_VALIDATE_ROSTRING(1,format);
 615   SCM_VALIDATE_ROSTRING(2,string);
 616
 617   SCM_COERCE_SUBSTR (format);
 618   SCM_COERCE_SUBSTR (string);
 619   fmt = SCM_ROCHARS (format);
 620   str = SCM_ROCHARS (string);
 621
 622   /* initialize the struct tm */
 623 #define tm_init(field) t.field = 0
 624   tm_init (tm_sec);
 625   tm_init (tm_min);
 626   tm_init (tm_hour);
 627   tm_init (tm_mday);
 628   tm_init (tm_mon);
 629   tm_init (tm_year);
 630   tm_init (tm_wday);
 631   tm_init (tm_yday);
 632 #undef tm_init
 633
 634   t.tm_isdst = -1;
 635   SCM_DEFER_INTS;
 636   if ((rest = strptime (str, fmt, &t)) == NULL)
 637     SCM_SYSERROR;
 638
 639   SCM_ALLOW_INTS;
 640   return scm_cons (filltime (&t, 0, NULL),  SCM_MAKINUM (rest - str));
 641
 642 #else
 643   SCM_SYSMISSING;
 644 #endif
 645 }
 646 #undef FUNC_NAME
 647
 648 void
 649 scm_init_stime()
 650 {
 651   scm_sysintern("internal-time-units-per-second",
 652                 scm_long2num((long)CLKTCK));
 653
 654 #ifdef HAVE_FTIME
 655   if (!scm_your_base.time) ftime(&scm_your_base);
 656 #else
 657   if (!scm_your_base) time(&scm_your_base);
 658 #endif
 659
 660   if (!scm_my_base) scm_my_base = mytime();
 661
 662   scm_add_feature ("current-time");
 663 #include "stime.x"
 664 }
 665