*** empty log message ***

[bpt/guile.git] / libguile / stime.c

diff --git a/libguile/stime.c b/libguile/stime.c
index c408dd4..a8ba26b 100644 (file)
--- a/libguile/stime.c
+++ b/libguile/stime.c
@@ -1,15 +1,15 @@
-/* Copyright (C) 1995,1996,1997,1998, 1999 Free Software Foundation, Inc.
- * 
+/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001 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
  * the Free Software Foundation; either version 2, or (at your option)
  * any later version.
  * 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
  * the Free Software Foundation; either version 2, or (at your option)
  * any later version.

- * 
+ *

  * This program is distributed in the hope that it will be useful,
  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  * GNU General Public License for more details.
  * This program is distributed in the hope that it will be useful,
  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  * GNU General Public License for more details.

- * 
+ *

  * You should have received a copy of the GNU General Public License
  * along with this software; see the file COPYING.  If not, write to
  * the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
  * You should have received a copy of the GNU General Public License
  * along with this software; see the file COPYING.  If not, write to
  * the Free Software Foundation, Inc., 59 Temple Place, Suite 330,


@@ -39,19 +39,19 @@
  * whether to permit this exception to apply to your modifications.
  * If you do not wish that, delete this exception notice.  */
 
  * whether to permit this exception to apply to your modifications.
  * If you do not wish that, delete this exception notice.  */
 

-/* Software engineering face-lift by Greg J. Badros, 11-Dec-1999,
-   gjb@cs.washington.edu, http://www.cs.washington.edu/homes/gjb */

 
 \f
 
 #include <stdio.h>
 
 \f
 
 #include <stdio.h>

-#include "_scm.h"
-#include "feature.h"
-#include "strings.h"
-#include "vectors.h"
+#include <errno.h>

 
 

-#include "validate.h"
-#include "stime.h"
+#include "libguile/_scm.h"
+#include "libguile/feature.h"
+#include "libguile/strings.h"
+#include "libguile/vectors.h"
+
+#include "libguile/validate.h"
+#include "libguile/stime.h"

 
 #ifdef HAVE_UNISTD_H
 #include <unistd.h>
 
 #ifdef HAVE_UNISTD_H
 #include <unistd.h>


@@ -62,6 +62,10 @@
 #  include <sys/types.h>
 # endif
 
 #  include <sys/types.h>
 # endif
 

+#ifdef HAVE_STRING_H
+#include <string.h>
+#endif
+

 # ifdef TIME_WITH_SYS_TIME
 #  include <sys/time.h>
 #  include <time.h>
 # ifdef TIME_WITH_SYS_TIME
 #  include <sys/time.h>
 #  include <time.h>


@@ -86,6 +90,9 @@
 #ifndef tzname /* For SGI.  */
 extern char *tzname[]; /* RS6000 and others reject char **tzname.  */
 #endif
 #ifndef tzname /* For SGI.  */
 extern char *tzname[]; /* RS6000 and others reject char **tzname.  */
 #endif

+#if defined (__MINGW32__)
+# define tzname _tzname
+#endif

 
 #ifdef MISSING_STRPTIME_DECL
 extern char *strptime ();
 
 #ifdef MISSING_STRPTIME_DECL
 extern char *strptime ();


@@ -93,16 +100,15 @@ extern char *strptime ();
 
 /* This should be figured out by autoconf.  */
 #if ! defined(CLKTCK) && defined(CLK_TCK)
 
 /* This should be figured out by autoconf.  */
 #if ! defined(CLKTCK) && defined(CLK_TCK)

-#  define CLKTCK CLK_TCK
+#  define CLKTCK ((int) CLK_TCK)

 #endif
 #if ! defined(CLKTCK) && defined(CLOCKS_PER_SEC)
 #endif
 #if ! defined(CLKTCK) && defined(CLOCKS_PER_SEC)

-#  define CLKTCK CLOCKS_PER_SEC
+#  define CLKTCK ((int) CLOCKS_PER_SEC)

 #endif
 #if ! defined(CLKTCK)
 #  define CLKTCK 60
 #endif
 
 #endif
 #if ! defined(CLKTCK)
 #  define CLKTCK 60
 #endif
 

-

 #ifdef __STDC__
 # define timet time_t
 #else
 #ifdef __STDC__
 # define timet time_t
 #else


@@ -111,7 +117,7 @@ extern char *strptime ();
 
 #ifdef HAVE_TIMES
 static
 
 #ifdef HAVE_TIMES
 static

-long mytime()
+timet mytime()

 {
   struct tms time_buffer;
   times(&time_buffer);
 {
   struct tms time_buffer;
   times(&time_buffer);


@@ -125,17 +131,16 @@ long mytime()
 # endif
 #endif
 
 # endif
 #endif
 

-extern int errno;
-

 #ifdef HAVE_FTIME
 struct timeb scm_your_base = {0};
 #else
 timet scm_your_base = 0;
 #endif
 
 #ifdef HAVE_FTIME
 struct timeb scm_your_base = {0};
 #else
 timet scm_your_base = 0;
 #endif
 

-SCM_DEFINE (scm_get_internal_real_time, "get-internal-real-time", 0, 0, 0, 
+SCM_DEFINE (scm_get_internal_real_time, "get-internal-real-time", 0, 0, 0,

            (),
            (),

-           "Returns the number of time units since the interpreter was started.")
+           "Return the number of time units since the interpreter was\n"
+           "started.")

 #define FUNC_NAME s_scm_get_internal_real_time
 {
 #ifdef HAVE_FTIME
 #define FUNC_NAME s_scm_get_internal_real_time
 {
 #ifdef HAVE_FTIME


@@ -158,11 +163,12 @@ SCM_DEFINE (scm_get_internal_real_time, "get-internal-real-time", 0, 0, 0,
 
 
 #ifdef HAVE_TIMES
 
 
 #ifdef HAVE_TIMES

-SCM_DEFINE (scm_times, "times", 0, 0, 0, 
+SCM_DEFINE (scm_times, "times", 0, 0, 0,

             (void),
             (void),

-           "Returns an object with information about real and processor time.\n"
-           "The following procedures accept such an object as an argument and\n"
-           "return a selected component:\n\n"
+           "Return an object with information about real and processor\n"
+           "time.  The following procedures accept such an object as an\n"
+           "argument and return a selected component:\n"
+           "\n"

            "@table @code\n"
            "@item tms:clock\n"
            "The current real time, expressed as time units relative to an\n"
            "@table @code\n"
            "@item tms:clock\n"
            "The current real time, expressed as time units relative to an\n"


@@ -170,12 +176,14 @@ SCM_DEFINE (scm_times, "times", 0, 0, 0,
            "@item tms:utime\n"
            "The CPU time units used by the calling process.\n"
            "@item tms:stime\n"
            "@item tms:utime\n"
            "The CPU time units used by the calling process.\n"
            "@item tms:stime\n"

-           "The CPU time units used by the system on behalf of the calling process.\n"
+           "The CPU time units used by the system on behalf of the calling\n"
+           "process.\n"

            "@item tms:cutime\n"
            "@item tms:cutime\n"

-           "The CPU time units used by terminated child processes of the calling\n"
-           "process, whose status has been collected (e.g., using @code{waitpid}).\n"
+           "The CPU time units used by terminated child processes of the\n"
+           "calling process, whose status has been collected (e.g., using\n"
+           "@code{waitpid}).\n"

            "@item tms:cstime\n"
            "@item tms:cstime\n"

-           "Similarly, the CPU times units used by the system on behalf of \n"
+           "Similarly, the CPU times units used by the system on behalf of\n"

            "terminated child processes.\n"
            "@end table")
 #define FUNC_NAME s_scm_times
            "terminated child processes.\n"
            "@end table")
 #define FUNC_NAME s_scm_times


@@ -183,7 +191,7 @@ SCM_DEFINE (scm_times, "times", 0, 0, 0,
   struct tms t;
   clock_t rv;
 
   struct tms t;
   clock_t rv;
 

-  SCM result = scm_make_vector (SCM_MAKINUM(5), SCM_UNDEFINED);
+  SCM result = scm_c_make_vector (5, SCM_UNDEFINED);

   rv = times (&t);
   if (rv == -1)
     SCM_SYSERROR;
   rv = times (&t);
   if (rv == -1)
     SCM_SYSERROR;


@@ -199,19 +207,27 @@ SCM_DEFINE (scm_times, "times", 0, 0, 0,
 
 static long scm_my_base = 0;
 
 
 static long scm_my_base = 0;
 

-SCM_DEFINE (scm_get_internal_run_time, "get-internal-run-time", 0, 0, 0, 
+long
+scm_c_get_internal_run_time ()
+{
+  return mytime () - scm_my_base;
+}
+
+SCM_DEFINE (scm_get_internal_run_time, "get-internal-run-time", 0, 0, 0,

            (void),
            (void),

-           "Returns the number of time units of processor time used by the interpreter.\n"
-           "Both \"system\" and \"user\" time are included but subprocesses are not.")
+           "Return the number of time units of processor time used by the\n"
+           "interpreter.  Both @emph{system} and @emph{user} time are\n"
+           "included but subprocesses are not.")

 #define FUNC_NAME s_scm_get_internal_run_time
 {
 #define FUNC_NAME s_scm_get_internal_run_time
 {

-  return scm_long2num(mytime()-scm_my_base);
+  return scm_long2num (scm_c_get_internal_run_time ());

 }
 #undef FUNC_NAME
 
 }
 #undef FUNC_NAME
 

-SCM_DEFINE (scm_current_time, "current-time", 0, 0, 0, 
+SCM_DEFINE (scm_current_time, "current-time", 0, 0, 0,

            (void),
            (void),

-           "Returns the number of seconds since 1970-01-01 00:00:00 UTC, excludingleap seconds.")
+           "Return the number of seconds since 1970-01-01 00:00:00 UTC,\n"
+           "excluding leap seconds.")

 #define FUNC_NAME s_scm_current_time
 {
   timet timv;
 #define FUNC_NAME s_scm_current_time
 {
   timet timv;


@@ -224,11 +240,12 @@ SCM_DEFINE (scm_current_time, "current-time", 0, 0, 0,
 }
 #undef FUNC_NAME
 
 }
 #undef FUNC_NAME
 

-SCM_DEFINE (scm_gettimeofday, "gettimeofday", 0, 0, 0, 
+SCM_DEFINE (scm_gettimeofday, "gettimeofday", 0, 0, 0,

             (void),
             (void),

-           "Returns a pair containing the number of seconds and microseconds since\n"
-           "1970-01-01 00:00:00 UTC, excluding leap seconds.  Note: whether true\n"
-           "microsecond resolution is available depends on the operating system.")
+           "Return a pair containing the number of seconds and microseconds\n"
+           "since 1970-01-01 00:00:00 UTC, excluding leap seconds.  Note:\n"
+           "whether true microsecond resolution is available depends on the\n"
+           "operating system.")

 #define FUNC_NAME s_scm_gettimeofday
 {
 #ifdef HAVE_GETTIMEOFDAY
 #define FUNC_NAME s_scm_gettimeofday
 {
 #ifdef HAVE_GETTIMEOFDAY


@@ -245,11 +262,11 @@ SCM_DEFINE (scm_gettimeofday, "gettimeofday", 0, 0, 0,
   struct timeb time;
 
   ftime(&time);
   struct timeb time;
 
   ftime(&time);

-  return scm_cons (scm_long2num ((long) time.time), 
+  return scm_cons (scm_long2num ((long) time.time),

                   SCM_MAKINUM (time.millitm * 1000));
 # else
   timet timv;
                   SCM_MAKINUM (time.millitm * 1000));
 # else
   timet timv;

-  
+

   SCM_DEFER_INTS;
   if ((timv = time (0)) == -1)
     SCM_SYSERROR;
   SCM_DEFER_INTS;
   if ((timv = time (0)) == -1)
     SCM_SYSERROR;


@@ -263,7 +280,7 @@ SCM_DEFINE (scm_gettimeofday, "gettimeofday", 0, 0, 0,
 static SCM
 filltime (struct tm *bd_time, int zoff, char *zname)
 {
 static SCM
 filltime (struct tm *bd_time, int zoff, char *zname)
 {

-  SCM result = scm_make_vector (SCM_MAKINUM(11), SCM_UNDEFINED);
+  SCM result = scm_c_make_vector (11, SCM_UNDEFINED);

 
   SCM_VELTS (result)[0] = SCM_MAKINUM (bd_time->tm_sec);
   SCM_VELTS (result)[1] = SCM_MAKINUM (bd_time->tm_min);
 
   SCM_VELTS (result)[0] = SCM_MAKINUM (bd_time->tm_sec);
   SCM_VELTS (result)[1] = SCM_MAKINUM (bd_time->tm_min);


@@ -296,11 +313,9 @@ setzone (SCM zone, int pos, const char *subr)
       static char *tmpenv[2];
       char *buf;
 
       static char *tmpenv[2];
       char *buf;
 

-      SCM_ASSERT (SCM_ROSTRINGP (zone), zone, pos, subr);
-      SCM_COERCE_SUBSTR (zone);
-      buf = scm_must_malloc (SCM_LENGTH (zone) + sizeof (tzvar) + 1,
-                            subr);
-      sprintf (buf, "%s=%s", tzvar, SCM_ROCHARS (zone));
+      SCM_ASSERT (SCM_STRINGP (zone), zone, pos, subr);
+      buf = scm_must_malloc (SCM_STRING_LENGTH (zone) + sizeof (tzvar) + 1, subr);
+      sprintf (buf, "%s=%s", tzvar, SCM_STRING_CHARS (zone));

       oldenv = environ;
       tmpenv[0] = buf;
       tmpenv[1] = 0;
       oldenv = environ;
       tmpenv[0] = buf;
       tmpenv[1] = 0;


@@ -310,7 +325,7 @@ setzone (SCM zone, int pos, const char *subr)
 }
 
 static void
 }
 
 static void

-restorezone (SCM zone, char **oldenv, const char *subr)
+restorezone (SCM zone, char **oldenv, const char *subr SCM_UNUSED)

 {
   if (!SCM_UNBNDP (zone))
     {
 {
   if (!SCM_UNBNDP (zone))
     {


@@ -323,13 +338,13 @@ restorezone (SCM zone, char **oldenv, const char *subr)
     }
 }
 
     }
 }
 

-SCM_DEFINE (scm_localtime, "localtime", 1, 1, 0, 
+SCM_DEFINE (scm_localtime, "localtime", 1, 1, 0,

             (SCM time, SCM zone),
             (SCM time, SCM zone),

-           "Returns an object representing the broken down components of @var{time},\n"
-           "an integer like the one returned by @code{current-time}.  The time zone\n"
-           "for the calculation is optionally specified by @var{zone} (a string),\n"
-           "otherwise the @code{TZ} environment variable or the system default is\n"
-           "used.")
+           "Return an object representing the broken down components of\n"
+           "@var{time}, an integer like the one returned by\n"
+           "@code{current-time}.  The time zone for the calculation is\n"
+           "optionally specified by @var{zone} (a string), otherwise the\n"
+           "@code{TZ} environment variable or the system default is used.")

 #define FUNC_NAME s_scm_localtime
 {
   timet itime;
 #define FUNC_NAME s_scm_localtime
 {
   timet itime;


@@ -340,7 +355,7 @@ SCM_DEFINE (scm_localtime, "localtime", 1, 1, 0,
   char **oldenv;
   int err;
 
   char **oldenv;
   int err;
 

-  itime = SCM_NUM2LONG (1,time);
+  itime = SCM_NUM2LONG (1, time);

 
   /* deferring interupts is essential since a) setzone may install a temporary
      environment b) localtime uses a static buffer.  */
 
   /* deferring interupts is essential since a) setzone may install a temporary
      environment b) localtime uses a static buffer.  */


@@ -389,7 +404,7 @@ SCM_DEFINE (scm_localtime, "localtime", 1, 1, 0,
     zoff -= 24 * 60 * 60;
   else if (utc->tm_yday > lt.tm_yday)
     zoff += 24 * 60 * 60;
     zoff -= 24 * 60 * 60;
   else if (utc->tm_yday > lt.tm_yday)
     zoff += 24 * 60 * 60;

-  
+

   result = filltime (&lt, zoff, zname);
   SCM_ALLOW_INTS;
   scm_must_free (zname);
   result = filltime (&lt, zoff, zname);
   SCM_ALLOW_INTS;
   scm_must_free (zname);


@@ -397,18 +412,18 @@ SCM_DEFINE (scm_localtime, "localtime", 1, 1, 0,
 }
 #undef FUNC_NAME
 
 }
 #undef FUNC_NAME
 

-SCM_DEFINE (scm_gmtime, "gmtime", 1, 0, 0, 
+SCM_DEFINE (scm_gmtime, "gmtime", 1, 0, 0,

             (SCM time),
             (SCM time),

-           "Returns an object representing the broken down components of @var{time},\n"
-           "an integer like the one returned by @code{current-time}.  The values\n"
-           "are calculated for UTC.")
+           "Return an object representing the broken down components of\n"
+           "@var{time}, an integer like the one returned by\n"
+           "@code{current-time}.  The values are calculated for UTC.")

 #define FUNC_NAME s_scm_gmtime
 {
   timet itime;
   struct tm *bd_time;
   SCM result;
 
 #define FUNC_NAME s_scm_gmtime
 {
   timet itime;
   struct tm *bd_time;
   SCM result;
 

-  itime = SCM_NUM2LONG (1,time);
+  itime = SCM_NUM2LONG (1, time);

   SCM_DEFER_INTS;
   bd_time = gmtime (&itime);
   if (bd_time == NULL)
   SCM_DEFER_INTS;
   bd_time = gmtime (&itime);
   if (bd_time == NULL)


@@ -427,7 +442,7 @@ bdtime2c (SCM sbd_time, struct tm *lt, int pos, const char *subr)
   int i;
 
   SCM_ASSERT (SCM_VECTORP (sbd_time)
   int i;
 
   SCM_ASSERT (SCM_VECTORP (sbd_time)

-             && SCM_LENGTH (sbd_time) == 11,
+             && SCM_VECTOR_LENGTH (sbd_time) == 11,

              sbd_time, pos, subr);
   velts = SCM_VELTS (sbd_time);
   for (i = 0; i < 10; i++)
              sbd_time, pos, subr);
   velts = SCM_VELTS (sbd_time);
   for (i = 0; i < 10; i++)


@@ -451,18 +466,18 @@ bdtime2c (SCM sbd_time, struct tm *lt, int pos, const char *subr)
   if (SCM_FALSEP (velts[10]))
     lt->tm_zone = NULL;
   else
   if (SCM_FALSEP (velts[10]))
     lt->tm_zone = NULL;
   else

-    lt->tm_zone  = SCM_CHARS (velts[10]);
+    lt->tm_zone  = SCM_STRING_CHARS (velts[10]);

 #endif
 }
 
 #endif
 }
 

-SCM_DEFINE (scm_mktime, "mktime", 1, 1, 0, 
+SCM_DEFINE (scm_mktime, "mktime", 1, 1, 0,

             (SCM sbd_time, SCM zone),
            "@var{bd-time} is an object representing broken down time and @code{zone}\n"
            "is an optional time zone specifier (otherwise the TZ environment variable\n"
            "or the system default is used).\n\n"
             (SCM sbd_time, SCM zone),
            "@var{bd-time} is an object representing broken down time and @code{zone}\n"
            "is an optional time zone specifier (otherwise the TZ environment variable\n"
            "or the system default is used).\n\n"

-           "Returns a pair: the CAR is a corresponding\n"
+           "Returns a pair: the car is a corresponding\n"

            "integer time value like that returned\n"
            "integer time value like that returned\n"

-           "by @code{current-time}; the CDR is a broken down time object, similar to\n"
+           "by @code{current-time}; the cdr is a broken down time object, similar to\n"

            "as @var{bd-time} but with normalized values.")
 #define FUNC_NAME s_scm_mktime
 {
            "as @var{bd-time} but with normalized values.")
 #define FUNC_NAME s_scm_mktime
 {


@@ -531,7 +546,7 @@ SCM_DEFINE (scm_mktime, "mktime", 1, 1, 0,
 #undef FUNC_NAME
 
 #ifdef HAVE_TZSET
 #undef FUNC_NAME
 
 #ifdef HAVE_TZSET

-SCM_DEFINE (scm_tzset, "tzset", 0, 0, 0, 
+SCM_DEFINE (scm_tzset, "tzset", 0, 0, 0,

             (void),
            "Initialize the timezone from the TZ environment variable\n"
            "or the system default.  It's not usually necessary to call this procedure\n"
             (void),
            "Initialize the timezone from the TZ environment variable\n"
            "or the system default.  It's not usually necessary to call this procedure\n"


@@ -560,29 +575,80 @@ SCM_DEFINE (scm_strftime, "strftime", 2, 0, 0,
 
   char *tbuf;
   int size = 50;
 
   char *tbuf;
   int size = 50;

-  char *fmt;
+  char *fmt, *myfmt;

   int len;
   SCM result;
 
   int len;
   SCM result;
 

-  SCM_VALIDATE_ROSTRING (1,format);
+  SCM_VALIDATE_STRING (1, format);

   bdtime2c (stime, &t, SCM_ARG2, FUNC_NAME);
 
   bdtime2c (stime, &t, SCM_ARG2, FUNC_NAME);
 

-  SCM_COERCE_SUBSTR (format);
-  fmt = SCM_ROCHARS (format);
-  len = SCM_ROLENGTH (format);
+  fmt = SCM_STRING_CHARS (format);
+  len = SCM_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
+     a zero-byte output string!  Workaround is to prepend a junk
+     character to the format string, so that valid returns are always
+     nonzero. */
+  myfmt = SCM_MUST_MALLOC (len+2);
+  *myfmt = 'x';
+  strncpy(myfmt+1, fmt, len);
+  myfmt[len+1] = 0;

 
   tbuf = SCM_MUST_MALLOC (size);
 
   tbuf = SCM_MUST_MALLOC (size);

+  {
+#if !defined (HAVE_TM_ZONE)
+    /* it seems the only way to tell non-GNU versions of strftime what
+       zone to use (for the %Z format) is to set TZ in the
+       environment.  interrupts and thread switching must be deferred
+       until TZ is restored.  */
+    char **oldenv = NULL;
+    SCM *velts = SCM_VELTS (stime);
+    int have_zone = 0;
+
+    if (!SCM_FALSEP (velts[10]) && *SCM_STRING_CHARS (velts[10]) != 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)));
+
+       have_zone = 1;
+       SCM_DEFER_INTS;
+       oldenv = setzone (zone, SCM_ARG2, FUNC_NAME);
+      }
+#endif
+

 #ifdef LOCALTIME_CACHE
 #ifdef LOCALTIME_CACHE

-  tzset ();
+    tzset ();
+#endif
+
+    /* POSIX says strftime returns 0 on buffer overrun, but old
+       systems (i.e. libc 4 on GNU/Linux) might return `size' in that
+       case. */
+    while ((len = strftime (tbuf, size, myfmt, &t)) == 0 || len == size)
+      {
+       scm_must_free (tbuf);
+       size *= 2;
+       tbuf = SCM_MUST_MALLOC (size);
+      }
+
+#if !defined (HAVE_TM_ZONE)
+    if (have_zone)
+      {
+       restorezone (velts[10], oldenv, FUNC_NAME);
+       SCM_ALLOW_INTS;
+      }

 #endif
 #endif

-  while ((len = strftime (tbuf, size, fmt, &t)) == size)
-    {
-      scm_must_free (tbuf);
-      size *= 2;
-      tbuf = SCM_MUST_MALLOC (size);

     }
     }

-  result = scm_makfromstr (tbuf, len, 0);
+
+  result = scm_mem2string (tbuf + 1, len - 1);

   scm_must_free (tbuf);
   scm_must_free (tbuf);

+  scm_must_free(myfmt);

   return result;
 }
 #undef FUNC_NAME
   return result;
 }
 #undef FUNC_NAME


@@ -590,28 +656,26 @@ SCM_DEFINE (scm_strftime, "strftime", 2, 0, 0,
 #ifdef HAVE_STRPTIME
 SCM_DEFINE (scm_strptime, "strptime", 2, 0, 0,
             (SCM format, SCM string),
 #ifdef HAVE_STRPTIME
 SCM_DEFINE (scm_strptime, "strptime", 2, 0, 0,
             (SCM format, SCM string),

-           "Performs the reverse action to @code{strftime}, parsing @var{string}\n"
-           "according to the specification supplied in @var{template}.  The\n"
-           "interpretation of month and day names is dependent on the current\n"
-           "locale.  The\n"
-           "value returned is a pair.  The CAR has an object with time components \n"
+           "Performs the reverse action to @code{strftime}, parsing\n"
+           "@var{string} according to the specification supplied in\n"
+           "@var{template}.  The interpretation of month and day names is\n"
+           "dependent on the current locale.  The value returned is a pair.\n"
+           "The car has an object with time components\n"

            "in the form returned by @code{localtime} or @code{gmtime},\n"
            "but the time zone components\n"
            "are not usefully set.\n"
            "in the form returned by @code{localtime} or @code{gmtime},\n"
            "but the time zone components\n"
            "are not usefully set.\n"

-           "The CDR reports the number of characters from @var{string} which\n"
-           "vwere used for the conversion.")
+           "The cdr reports the number of characters from @var{string}\n"
+           "which were used for the conversion.")

 #define FUNC_NAME s_scm_strptime
 {
   struct tm t;
   char *fmt, *str, *rest;
 
 #define FUNC_NAME s_scm_strptime
 {
   struct tm t;
   char *fmt, *str, *rest;
 

-  SCM_VALIDATE_ROSTRING (1,format);
-  SCM_VALIDATE_ROSTRING (2,string);
+  SCM_VALIDATE_STRING (1, format);
+  SCM_VALIDATE_STRING (2, string);

 
 

-  SCM_COERCE_SUBSTR (format);
-  SCM_COERCE_SUBSTR (string);
-  fmt = SCM_ROCHARS (format);
-  str = SCM_ROCHARS (string);
+  fmt = SCM_STRING_CHARS (format);
+  str = SCM_STRING_CHARS (string);

 
   /* initialize the struct tm */
 #define tm_init(field) t.field = 0
 
   /* initialize the struct tm */
 #define tm_init(field) t.field = 0


@@ -639,7 +703,7 @@ SCM_DEFINE (scm_strptime, "strptime", 2, 0, 0,
 void
 scm_init_stime()
 {
 void
 scm_init_stime()
 {

-  scm_sysintern("internal-time-units-per-second",
+  scm_c_define ("internal-time-units-per-second",

                scm_long2num((long)CLKTCK));
 
 #ifdef HAVE_FTIME
                scm_long2num((long)CLKTCK));
 
 #ifdef HAVE_FTIME


@@ -651,7 +715,9 @@ scm_init_stime()
   if (!scm_my_base) scm_my_base = mytime();
 
   scm_add_feature ("current-time");
   if (!scm_my_base) scm_my_base = mytime();
 
   scm_add_feature ("current-time");

-#include "stime.x"
+#ifndef SCM_MAGIC_SNARFER
+#include "libguile/stime.x"
+#endif

 }
 
 
 }