add getrlimit and setrlimit wrappers

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

diff --git a/libguile/posix.c b/libguile/posix.c
index 3e23348..78fd295 100644 (file)
--- a/libguile/posix.c
+++ b/libguile/posix.c
@@ -1,63 +1,45 @@
-/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 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 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,
- * Boston, MA 02111-1307 USA
- *
- * As a special exception, the Free Software Foundation gives permission
- * for additional uses of the text contained in its release of GUILE.
- *
- * The exception is that, if you link the GUILE library with other files
- * to produce an executable, this does not by itself cause the
- * resulting executable to be covered by the GNU General Public License.
- * Your use of that executable is in no way restricted on account of
- * linking the GUILE library code into it.
+ * This library is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU Lesser General Public
+ * License as published by the Free Software Foundation; either
+ * version 2.1 of the License, or (at your option) any later version.

  *
  *

- * This exception does not however invalidate any other reasons why
- * the executable file might be covered by the GNU General Public License.
- *
- * This exception applies only to the code released by the
- * Free Software Foundation under the name GUILE.  If you copy
- * code from other Free Software Foundation releases into a copy of
- * GUILE, as the General Public License permits, the exception does
- * not apply to the code that you add in this way.  To avoid misleading
- * anyone as to the status of such modified files, you must delete
- * this exception notice from them.
+ * This library 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
+ * Lesser General Public License for more details.

  *
  *

- * If you write modifications of your own for GUILE, it is your choice
- * whether to permit this exception to apply to your modifications.
- * If you do not wish that, delete this exception notice.  */
+ * You should have received a copy of the GNU Lesser General Public
+ * License along with this library; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ */

 
 
 \f
 
 
 \f

-
-/* Make GNU/Linux libc declare everything it has. */
-#define _GNU_SOURCE
+#ifdef HAVE_CONFIG_H
+#  include <config.h>
+#endif

 
 #include <stdio.h>
 #include <errno.h>
 
 #include "libguile/_scm.h"
 
 #include <stdio.h>
 #include <errno.h>
 
 #include "libguile/_scm.h"

+#include "libguile/dynwind.h"

 #include "libguile/fports.h"
 #include "libguile/scmsigs.h"
 #include "libguile/feature.h"
 #include "libguile/strings.h"
 #include "libguile/fports.h"
 #include "libguile/scmsigs.h"
 #include "libguile/feature.h"
 #include "libguile/strings.h"

+#include "libguile/srfi-13.h"
+#include "libguile/srfi-14.h"

 #include "libguile/vectors.h"
 #include "libguile/vectors.h"

+#include "libguile/values.h"

 #include "libguile/lang.h"
 
 #include "libguile/validate.h"
 #include "libguile/posix.h"
 #include "libguile/lang.h"
 
 #include "libguile/validate.h"
 #include "libguile/posix.h"

+#include "libguile/gettext.h"
+#include "libguile/threads.h"

 \f
 
 #ifdef HAVE_STRING_H
 \f
 
 #ifdef HAVE_STRING_H


@@ -131,10 +113,26 @@ extern char ** environ;
 #include <locale.h>
 #endif
 
 #include <locale.h>
 #endif
 

-#if HAVE_LIBCRYPT && HAVE_CRYPT_H
+#if (defined HAVE_NEWLOCALE) && (defined HAVE_STRCOLL_L)
+# define USE_GNU_LOCALE_API
+#endif
+
+#if (defined USE_GNU_LOCALE_API) && (defined HAVE_XLOCALE_H)
+# include <xlocale.h>
+#endif
+
+#if HAVE_CRYPT_H

 #  include <crypt.h>
 #endif
 
 #  include <crypt.h>
 #endif
 

+#ifdef HAVE_NETDB_H
+#include <netdb.h>      /* for MAXHOSTNAMELEN on Solaris */
+#endif
+
+#ifdef HAVE_SYS_PARAM_H
+#include <sys/param.h>  /* for MAXHOSTNAMELEN */
+#endif
+

 #if HAVE_SYS_RESOURCE_H
 #  include <sys/resource.h>
 #endif
 #if HAVE_SYS_RESOURCE_H
 #  include <sys/resource.h>
 #endif


@@ -143,6 +141,10 @@ extern char ** environ;
 # include <sys/file.h>
 #endif
 
 # include <sys/file.h>
 #endif
 

+#if HAVE_CRT_EXTERNS_H
+#include <crt_externs.h>  /* for Darwin _NSGetEnviron */
+#endif
+

 /* Some Unix systems don't define these.  CPP hair is dangerous, but
    this seems safe enough... */
 #ifndef R_OK
 /* Some Unix systems don't define these.  CPP hair is dangerous, but
    this seems safe enough... */
 #ifndef R_OK


@@ -161,6 +163,12 @@ extern char ** environ;
 #define F_OK 0
 #endif
 
 #define F_OK 0
 #endif
 

+/* No prototype for this on Solaris 10.  The man page says it's in
+   <unistd.h> ... but it lies. */
+#if ! HAVE_DECL_SETHOSTNAME
+int sethostname (char *name, size_t namelen);
+#endif
+

 /* On NextStep, <utime.h> doesn't define struct utime, unless we
    #define _POSIX_SOURCE before #including it.  I think this is less
    of a kludge than defining struct utimbuf ourselves.  */
 /* On NextStep, <utime.h> doesn't define struct utime, unless we
    #define _POSIX_SOURCE before #including it.  I think this is less
    of a kludge than defining struct utimbuf ourselves.  */


@@ -178,7 +186,44 @@ extern char ** environ;
 
 /* Please don't add any more #includes or #defines here.  The hack
    above means that _POSIX_SOURCE may be #defined, which will
 
 /* Please don't add any more #includes or #defines here.  The hack
    above means that _POSIX_SOURCE may be #defined, which will

-   encourage header files to do strange things.  */
+   encourage header files to do strange things.
+
+   FIXME: Maybe should undef _POSIX_SOURCE after it's done its job.
+
+   FIXME: Probably should do all the includes first, then all the fallback
+   declarations and defines, in case things are not in the header we
+   imagine.  */
+
+
+
+
+/* On Apple Darwin in a shared library there's no "environ" to access
+   directly, instead the address of that variable must be obtained with
+   _NSGetEnviron().  */
+#if HAVE__NSGETENVIRON && defined (PIC)
+#define environ (*_NSGetEnviron())
+#endif
+
+\f
+
+/* Two often used patterns
+ */
+
+#define WITH_STRING(str,cstr,code)             \
+  do {                                         \
+    char *cstr = scm_to_locale_string (str);   \
+    code;                                      \
+    free (cstr);                               \
+  } while (0)
+
+#define STRING_SYSCALL(str,cstr,code)        \
+  do {                                       \
+    int eno;                                 \
+    char *cstr = scm_to_locale_string (str); \
+    SCM_SYSCALL (code);                      \
+    eno = errno; free (cstr); errno = eno;   \
+  } while (0)
+

 
 \f
 SCM_SYMBOL (sym_read_pipe, "read pipe");
 
 \f
 SCM_SYMBOL (sym_read_pipe, "read pipe");


@@ -222,7 +267,7 @@ SCM_DEFINE (scm_getgroups, "getgroups", 0, 0, 0,
            "supplementary group IDs.")
 #define FUNC_NAME s_scm_getgroups
 {
            "supplementary group IDs.")
 #define FUNC_NAME s_scm_getgroups
 {

-  SCM ans;
+  SCM result;

   int ngroups;
   size_t size;
   GETGROUPS_T *groups;
   int ngroups;
   size_t size;
   GETGROUPS_T *groups;


@@ -233,18 +278,69 @@ SCM_DEFINE (scm_getgroups, "getgroups", 0, 0, 0,
 
   size = ngroups * sizeof (GETGROUPS_T);
   groups = scm_malloc (size);
 
   size = ngroups * sizeof (GETGROUPS_T);
   groups = scm_malloc (size);

-  getgroups (ngroups, groups);
+  ngroups = getgroups (ngroups, groups);

 
 

-  ans = scm_c_make_vector (ngroups, SCM_UNDEFINED);
+  result = scm_c_make_vector (ngroups, SCM_BOOL_F);

   while (--ngroups >= 0) 
   while (--ngroups >= 0) 

-    SCM_VELTS (ans) [ngroups] = SCM_MAKINUM (groups [ngroups]);
+    SCM_SIMPLE_VECTOR_SET (result, ngroups, scm_from_ulong (groups[ngroups]));

 
   free (groups);
 
   free (groups);

-  return ans;
+  return result;

 }
 #undef FUNC_NAME  
 #endif
 
 }
 #undef FUNC_NAME  
 #endif
 

+#ifdef HAVE_SETGROUPS
+SCM_DEFINE (scm_setgroups, "setgroups", 1, 0, 0,
+            (SCM group_vec),
+           "Set the current set of supplementary group IDs to the integers\n"
+           "in the given vector @var{vec}.  The return value is\n"
+           "unspecified.\n"
+           "\n"
+           "Generally only the superuser can set the process group IDs.")
+#define FUNC_NAME s_scm_setgroups
+{
+  size_t ngroups;
+  size_t size;
+  size_t i;
+  int result;
+  int save_errno;
+  GETGROUPS_T *groups;
+
+  SCM_VALIDATE_VECTOR (SCM_ARG1, group_vec);
+
+  ngroups = SCM_SIMPLE_VECTOR_LENGTH (group_vec);
+
+  /* validate before allocating, so we don't have to worry about leaks */
+  for (i = 0; i < ngroups; i++)
+    {
+      unsigned long ulong_gid;
+      GETGROUPS_T gid;
+      SCM_VALIDATE_ULONG_COPY (1, SCM_SIMPLE_VECTOR_REF (group_vec, i),
+                              ulong_gid);
+      gid = ulong_gid;
+      if (gid != ulong_gid)
+       SCM_OUT_OF_RANGE (1, SCM_SIMPLE_VECTOR_REF (group_vec, i));
+    }
+
+  size = ngroups * sizeof (GETGROUPS_T);
+  if (size / sizeof (GETGROUPS_T) != ngroups)
+    SCM_OUT_OF_RANGE (SCM_ARG1, scm_from_int (ngroups));
+  groups = scm_malloc (size);
+  for(i = 0; i < ngroups; i++)
+    groups [i] = SCM_NUM2ULONG (1, SCM_SIMPLE_VECTOR_REF (group_vec, i));
+
+  result = setgroups (ngroups, groups);
+  save_errno = errno; /* don't let free() touch errno */
+  free (groups);
+  errno = save_errno;
+  if (result < 0)
+    SCM_SYSERROR;
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+#endif
+

 #ifdef HAVE_GETPWENT
 SCM_DEFINE (scm_getpwuid, "getpw", 0, 1, 0,
             (SCM user),
 #ifdef HAVE_GETPWENT
 SCM_DEFINE (scm_getpwuid, "getpw", 0, 1, 0,
             (SCM user),


@@ -253,13 +349,10 @@ SCM_DEFINE (scm_getpwuid, "getpw", 0, 1, 0,
            "or getpwent respectively.")
 #define FUNC_NAME s_scm_getpwuid
 {
            "or getpwent respectively.")
 #define FUNC_NAME s_scm_getpwuid
 {

-  SCM result;

   struct passwd *entry;
   struct passwd *entry;

-  SCM *ve;

 
 

-  result = scm_c_make_vector (7, SCM_UNSPECIFIED);
-  ve = SCM_VELTS (result);
-  if (SCM_UNBNDP (user) || SCM_FALSEP (user))
+  SCM result = scm_c_make_vector (7, SCM_UNSPECIFIED);
+  if (SCM_UNBNDP (user) || scm_is_false (user))

     {
       SCM_SYSCALL (entry = getpwent ());
       if (! entry)
     {
       SCM_SYSCALL (entry = getpwent ());
       if (! entry)


@@ -267,31 +360,31 @@ SCM_DEFINE (scm_getpwuid, "getpw", 0, 1, 0,
          return SCM_BOOL_F;
        }
     }
          return SCM_BOOL_F;
        }
     }

-  else if (SCM_INUMP (user))
+  else if (scm_is_integer (user))

     {
     {

-      entry = getpwuid (SCM_INUM (user));
+      entry = getpwuid (scm_to_int (user));

     }
   else
     {
     }
   else
     {

-      SCM_VALIDATE_STRING (1, user);
-      entry = getpwnam (SCM_STRING_CHARS (user));
+      WITH_STRING (user, c_user,
+                  entry = getpwnam (c_user));

     }
   if (!entry)
     SCM_MISC_ERROR ("entry not found", SCM_EOL);
 
     }
   if (!entry)
     SCM_MISC_ERROR ("entry not found", SCM_EOL);
 

-  ve[0] = scm_makfrom0str (entry->pw_name);
-  ve[1] = scm_makfrom0str (entry->pw_passwd);
-  ve[2] = scm_ulong2num ((unsigned long) entry->pw_uid);
-  ve[3] = scm_ulong2num ((unsigned long) entry->pw_gid);
-  ve[4] = scm_makfrom0str (entry->pw_gecos);
+  SCM_SIMPLE_VECTOR_SET(result, 0, scm_from_locale_string (entry->pw_name));
+  SCM_SIMPLE_VECTOR_SET(result, 1, scm_from_locale_string (entry->pw_passwd));
+  SCM_SIMPLE_VECTOR_SET(result, 2, scm_from_ulong (entry->pw_uid));
+  SCM_SIMPLE_VECTOR_SET(result, 3, scm_from_ulong (entry->pw_gid));
+  SCM_SIMPLE_VECTOR_SET(result, 4, scm_from_locale_string (entry->pw_gecos));

   if (!entry->pw_dir)
   if (!entry->pw_dir)

-    ve[5] = scm_makfrom0str ("");
+    SCM_SIMPLE_VECTOR_SET(result, 5, scm_from_locale_string (""));

   else
   else

-    ve[5] = scm_makfrom0str (entry->pw_dir);
+    SCM_SIMPLE_VECTOR_SET(result, 5, scm_from_locale_string (entry->pw_dir));

   if (!entry->pw_shell)
   if (!entry->pw_shell)

-    ve[6] = scm_makfrom0str ("");
+    SCM_SIMPLE_VECTOR_SET(result, 6, scm_from_locale_string (""));

   else
   else

-    ve[6] = scm_makfrom0str (entry->pw_shell);
+    SCM_SIMPLE_VECTOR_SET(result, 6, scm_from_locale_string (entry->pw_shell));

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


@@ -306,7 +399,7 @@ SCM_DEFINE (scm_setpwent, "setpw", 0, 1, 0,
            "@code{endpwent} procedures are implemented on top of this.")
 #define FUNC_NAME s_scm_setpwent
 {
            "@code{endpwent} procedures are implemented on top of this.")
 #define FUNC_NAME s_scm_setpwent
 {

-  if (SCM_UNBNDP (arg) || SCM_FALSEP (arg))
+  if (SCM_UNBNDP (arg) || scm_is_false (arg))

     endpwent ();
   else
     setpwent ();
     endpwent ();
   else
     setpwent ();


@@ -325,12 +418,10 @@ SCM_DEFINE (scm_getgrgid, "getgr", 0, 1, 0,
            "or getgrent respectively.")
 #define FUNC_NAME s_scm_getgrgid
 {
            "or getgrent respectively.")
 #define FUNC_NAME s_scm_getgrgid
 {

-  SCM result;

   struct group *entry;
   struct group *entry;

-  SCM *ve;
-  result = scm_c_make_vector (4, SCM_UNSPECIFIED);
-  ve = SCM_VELTS (result);
-  if (SCM_UNBNDP (name) || SCM_FALSEP (name))
+  SCM result = scm_c_make_vector (4, SCM_UNSPECIFIED);
+
+  if (SCM_UNBNDP (name) || scm_is_false (name))

     {
       SCM_SYSCALL (entry = getgrent ());
       if (! entry)
     {
       SCM_SYSCALL (entry = getgrent ());
       if (! entry)


@@ -338,20 +429,18 @@ SCM_DEFINE (scm_getgrgid, "getgr", 0, 1, 0,
          return SCM_BOOL_F;
        }
     }
          return SCM_BOOL_F;
        }
     }

-  else if (SCM_INUMP (name))
-    SCM_SYSCALL (entry = getgrgid (SCM_INUM (name)));
+  else if (scm_is_integer (name))
+    SCM_SYSCALL (entry = getgrgid (scm_to_int (name)));

   else
   else

-    {
-      SCM_VALIDATE_STRING (1, name);
-      SCM_SYSCALL (entry = getgrnam (SCM_STRING_CHARS (name)));
-    }
+    STRING_SYSCALL (name, c_name,
+                   entry = getgrnam (c_name));

   if (!entry)
     SCM_SYSERROR;
 
   if (!entry)
     SCM_SYSERROR;
 

-  ve[0] = scm_makfrom0str (entry->gr_name);
-  ve[1] = scm_makfrom0str (entry->gr_passwd);
-  ve[2] = scm_ulong2num ((unsigned long) entry->gr_gid);
-  ve[3] = scm_makfromstrs (-1, entry->gr_mem);
+  SCM_SIMPLE_VECTOR_SET(result, 0, scm_from_locale_string (entry->gr_name));
+  SCM_SIMPLE_VECTOR_SET(result, 1, scm_from_locale_string (entry->gr_passwd));
+  SCM_SIMPLE_VECTOR_SET(result, 2, scm_from_ulong  (entry->gr_gid));
+  SCM_SIMPLE_VECTOR_SET(result, 3, scm_makfromstrs (-1, entry->gr_mem));

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


@@ -365,7 +454,7 @@ SCM_DEFINE (scm_setgrent, "setgr", 0, 1, 0,
            "@code{endgrent} procedures are implemented on top of this.")
 #define FUNC_NAME s_scm_setgrent
 {
            "@code{endgrent} procedures are implemented on top of this.")
 #define FUNC_NAME s_scm_setgrent
 {

-  if (SCM_UNBNDP (arg) || SCM_FALSEP (arg))
+  if (SCM_UNBNDP (arg) || scm_is_false (arg))

     endgrent ();
   else
     setgrent ();
     endgrent ();
   else
     setgrent ();


@@ -375,6 +464,179 @@ SCM_DEFINE (scm_setgrent, "setgr", 0, 1, 0,
 #endif /* HAVE_GETGRENT */
 
 
 #endif /* HAVE_GETGRENT */
 
 

+#ifdef HAVE_GETRLIMIT
+#ifdef RLIMIT_AS
+SCM_SYMBOL (sym_as, "as");
+#endif
+#ifdef RLIMIT_CORE
+SCM_SYMBOL (sym_core, "core");
+#endif
+#ifdef RLIMIT_CPU
+SCM_SYMBOL (sym_cpu, "cpu");
+#endif
+#ifdef RLIMIT_DATA
+SCM_SYMBOL (sym_data, "data");
+#endif
+#ifdef RLIMIT_FSIZE
+SCM_SYMBOL (sym_fsize, "fsize");
+#endif
+#ifdef RLIMIT_MEMLOCK
+SCM_SYMBOL (sym_memlock, "memlock");
+#endif
+#ifdef RLIMIT_MSGQUEUE
+SCM_SYMBOL (sym_msgqueue, "msgqueue");
+#endif
+#ifdef RLIMIT_NICE
+SCM_SYMBOL (sym_nice, "nice");
+#endif
+#ifdef RLIMIT_NOFILE
+SCM_SYMBOL (sym_nofile, "nofile");
+#endif
+#ifdef RLIMIT_NPROC
+SCM_SYMBOL (sym_nproc, "nproc");
+#endif
+#ifdef RLIMIT_RSS
+SCM_SYMBOL (sym_rss, "rss");
+#endif
+#ifdef RLIMIT_RTPRIO
+SCM_SYMBOL (sym_rtprio, "rtprio");
+#endif
+#ifdef RLIMIT_RTPRIO
+SCM_SYMBOL (sym_rttime, "rttime");
+#endif
+#ifdef RLIMIT_SIGPENDING
+SCM_SYMBOL (sym_sigpending, "sigpending");
+#endif
+#ifdef RLIMIT_STACK
+SCM_SYMBOL (sym_stack, "stack");
+#endif
+
+static int
+scm_to_resource (SCM s, const char *func, int pos)
+{
+  if (scm_is_number (s))
+    return scm_to_int (s);
+  
+  SCM_ASSERT_TYPE (scm_is_symbol (s), s, pos, func, "symbol");
+
+#ifdef RLIMIT_AS
+  if (s == sym_as)
+    return RLIMIT_AS;
+#endif
+#ifdef RLIMIT_CORE
+  if (s == sym_core)
+    return RLIMIT_CORE;
+#endif
+#ifdef RLIMIT_CPU
+  if (s == sym_cpu)
+    return RLIMIT_CPU;
+#endif
+#ifdef RLIMIT_DATA
+  if (s == sym_data)
+    return RLIMIT_DATA;
+#endif
+#ifdef RLIMIT_FSIZE
+  if (s == sym_fsize)
+    return RLIMIT_FSIZE;
+#endif
+#ifdef RLIMIT_MEMLOCK
+  if (s == sym_memlock)
+    return RLIMIT_MEMLOCK;
+#endif
+#ifdef RLIMIT_MSGQUEUE
+  if (s == sym_msgqueue)
+    return RLIMIT_MSGQUEUE;
+#endif
+#ifdef RLIMIT_NICE
+  if (s == sym_nice)
+    return RLIMIT_NICE;
+#endif
+#ifdef RLIMIT_NOFILE
+  if (s == sym_nofile)
+    return RLIMIT_NOFILE;
+#endif
+#ifdef RLIMIT_NPROC
+  if (s == sym_nproc)
+    return RLIMIT_NPROC;
+#endif
+#ifdef RLIMIT_RSS
+  if (s == sym_rss)
+    return RLIMIT_RSS;
+#endif
+#ifdef RLIMIT_RTPRIO
+  if (s == sym_rtprio)
+    return RLIMIT_RTPRIO;
+#endif
+#ifdef RLIMIT_RTPRIO
+  if (s == sym_rttime)
+    return RLIMIT_RTPRIO;
+#endif
+#ifdef RLIMIT_SIGPENDING
+  if (s == sym_sigpending)
+    return RLIMIT_SIGPENDING;
+#endif
+#ifdef RLIMIT_STACK
+  if (s == sym_stack)
+    return RLIMIT_STACK;
+#endif
+
+  scm_misc_error (func, "invalid rlimit resource ~A", scm_list_1 (s));
+  return 0;
+}
+  
+SCM_DEFINE (scm_getrlimit, "getrlimit", 1, 0, 0,
+            (SCM resource),
+           "Get a resource limit for this process. @var{resource} identifies the resource,\n"
+            "either as an integer or as a symbol. For example, @code{(getrlimit 'stack)}\n"
+            "gets the limits associated with @code{RLIMIT_STACK}.\n\n"
+           "@code{getrlimit} returns two values, the soft and the hard limit. If no\n"
+            "limit is set for the resource in question, the returned limit will be @code{#f}.")
+#define FUNC_NAME s_scm_getrlimit
+{
+  int iresource;
+  struct rlimit lim = { 0, 0 };
+  
+  iresource = scm_to_resource (resource, FUNC_NAME, 1);
+  
+  if (getrlimit (iresource, &lim) != 0)
+    scm_syserror (FUNC_NAME);
+
+  return scm_values (scm_list_2 ((lim.rlim_cur == RLIM_INFINITY) ? SCM_BOOL_F
+                                 : scm_from_long (lim.rlim_cur),
+                                 (lim.rlim_max == RLIM_INFINITY) ? SCM_BOOL_F
+                                 : scm_from_long (lim.rlim_max)));
+}
+#undef FUNC_NAME
+
+
+#ifdef HAVE_SETRLIMIT
+SCM_DEFINE (scm_setrlimit, "setrlimit", 3, 0, 0,
+            (SCM resource, SCM soft, SCM hard),
+           "Set a resource limit for this process. @var{resource} identifies the resource,\n"
+            "either as an integer or as a symbol. @var{soft} and @var{hard} should be integers,\n"
+            "or @code{#f} to indicate no limit (i.e., @code{RLIM_INFINITY}).\n\n"
+            "For example, @code{(setrlimit 'stack 150000 300000)} sets the @code{RLIMIT_STACK}\n"
+            "limit to 150 kilobytes, with a hard limit of 300 kB.")
+#define FUNC_NAME s_scm_setrlimit
+{
+  int iresource;
+  struct rlimit lim = { 0, 0 };
+  
+  iresource = scm_to_resource (resource, FUNC_NAME, 1);
+  
+  lim.rlim_cur = (soft == SCM_BOOL_F) ? RLIM_INFINITY : scm_to_long (soft);
+  lim.rlim_max = (hard == SCM_BOOL_F) ? RLIM_INFINITY : scm_to_long (hard);
+
+  if (setrlimit (iresource, &lim) != 0)
+    scm_syserror (FUNC_NAME);
+
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+#endif /* HAVE_SETRLIMIT */
+#endif /* HAVE_GETRLIMIT */
+
+

 SCM_DEFINE (scm_kill, "kill", 2, 0, 0,
             (SCM pid, SCM sig),
            "Sends a signal to the specified process or group of processes.\n\n"
 SCM_DEFINE (scm_kill, "kill", 2, 0, 0,
             (SCM pid, SCM sig),
            "Sends a signal to the specified process or group of processes.\n\n"


@@ -401,16 +663,28 @@ SCM_DEFINE (scm_kill, "kill", 2, 0, 0,
            "@end defvar")
 #define FUNC_NAME s_scm_kill
 {
            "@end defvar")
 #define FUNC_NAME s_scm_kill
 {

-  SCM_VALIDATE_INUM (1,pid);
-  SCM_VALIDATE_INUM (2,sig);

   /* Signal values are interned in scm_init_posix().  */
 #ifdef HAVE_KILL
   /* Signal values are interned in scm_init_posix().  */
 #ifdef HAVE_KILL

-  if (kill ((int) SCM_INUM (pid), (int) SCM_INUM (sig)) != 0)
+  if (kill (scm_to_int (pid), scm_to_int  (sig)) != 0)
+    SCM_SYSERROR;

 #else
 #else

-  if ((int) SCM_INUM (pid) == getpid ())
-    if (raise ((int) SCM_INUM (sig)) != 0)
+  /* Mingw has raise(), but not kill().  (Other raw DOS environments might
+     be similar.)  Use raise() when the requested pid is our own process,
+     otherwise bomb.  */
+  if (scm_to_int (pid) == getpid ())
+    {
+      if (raise (scm_to_int (sig)) != 0)
+        {
+        err:
+          SCM_SYSERROR;
+        }
+      else
+        {
+          errno = ENOSYS;
+          goto err;
+        }
+    }

 #endif
 #endif

-      SCM_SYSERROR;

   return SCM_UNSPECIFIED;
 }
 #undef FUNC_NAME
   return SCM_UNSPECIFIED;
 }
 #undef FUNC_NAME


@@ -457,19 +731,17 @@ SCM_DEFINE (scm_waitpid, "waitpid", 1, 1, 0,
   int i;
   int status;
   int ioptions;
   int i;
   int status;
   int ioptions;

-  SCM_VALIDATE_INUM (1,pid);

   if (SCM_UNBNDP (options))
     ioptions = 0;
   else
     {
   if (SCM_UNBNDP (options))
     ioptions = 0;
   else
     {

-      SCM_VALIDATE_INUM (2,options);

       /* Flags are interned in scm_init_posix.  */
       /* Flags are interned in scm_init_posix.  */

-      ioptions = SCM_INUM (options);
+      ioptions = scm_to_int (options);

     }
     }

-  SCM_SYSCALL (i = waitpid (SCM_INUM (pid), &status, ioptions));
+  SCM_SYSCALL (i = waitpid (scm_to_int (pid), &status, ioptions));

   if (i == -1)
     SCM_SYSERROR;
   if (i == -1)
     SCM_SYSERROR;

-  return scm_cons (SCM_MAKINUM (0L + i), SCM_MAKINUM (0L + status));
+  return scm_cons (scm_from_int (i), scm_from_int (status));

 }
 #undef FUNC_NAME
 #endif /* HAVE_WAITPID */
 }
 #undef FUNC_NAME
 #endif /* HAVE_WAITPID */


@@ -484,13 +756,11 @@ SCM_DEFINE (scm_status_exit_val, "status:exit-val", 1, 0, 0,
 {
   int lstatus;
 
 {
   int lstatus;
 

-  SCM_VALIDATE_INUM (1,status);
-

   /* On Ultrix, the WIF... macros assume their argument is an lvalue;
   /* On Ultrix, the WIF... macros assume their argument is an lvalue;

-     go figure.  SCM_INUM does not yield an lvalue.  */
-  lstatus = SCM_INUM (status);
+     go figure.  */
+  lstatus = scm_to_int (status);

   if (WIFEXITED (lstatus))
   if (WIFEXITED (lstatus))

-    return (SCM_MAKINUM (WEXITSTATUS (lstatus)));
+    return (scm_from_int (WEXITSTATUS (lstatus)));

   else
     return SCM_BOOL_F;
 }
   else
     return SCM_BOOL_F;
 }


@@ -504,11 +774,9 @@ SCM_DEFINE (scm_status_term_sig, "status:term-sig", 1, 0, 0,
 {
   int lstatus;
 
 {
   int lstatus;
 

-  SCM_VALIDATE_INUM (1,status);
-
-  lstatus = SCM_INUM (status);
+  lstatus = scm_to_int (status);

   if (WIFSIGNALED (lstatus))
   if (WIFSIGNALED (lstatus))

-    return SCM_MAKINUM (WTERMSIG (lstatus));
+    return scm_from_int (WTERMSIG (lstatus));

   else
     return SCM_BOOL_F;
 }
   else
     return SCM_BOOL_F;
 }


@@ -522,11 +790,9 @@ SCM_DEFINE (scm_status_stop_sig, "status:stop-sig", 1, 0, 0,
 {
   int lstatus;
 
 {
   int lstatus;
 

-  SCM_VALIDATE_INUM (1,status);
-
-  lstatus = SCM_INUM (status);
+  lstatus = scm_to_int (status);

   if (WIFSTOPPED (lstatus))
   if (WIFSTOPPED (lstatus))

-    return SCM_MAKINUM (WSTOPSIG (lstatus));
+    return scm_from_int (WSTOPSIG (lstatus));

   else
     return SCM_BOOL_F;
 }
   else
     return SCM_BOOL_F;
 }


@@ -540,7 +806,7 @@ SCM_DEFINE (scm_getppid, "getppid", 0, 0, 0,
            "process.")
 #define FUNC_NAME s_scm_getppid
 {
            "process.")
 #define FUNC_NAME s_scm_getppid
 {

-  return SCM_MAKINUM (0L + getppid ());
+  return scm_from_int (getppid ());

 }
 #undef FUNC_NAME
 #endif /* HAVE_GETPPID */
 }
 #undef FUNC_NAME
 #endif /* HAVE_GETPPID */


@@ -552,7 +818,7 @@ SCM_DEFINE (scm_getuid, "getuid", 0, 0, 0,
            "Return an integer representing the current real user ID.")
 #define FUNC_NAME s_scm_getuid
 {
            "Return an integer representing the current real user ID.")
 #define FUNC_NAME s_scm_getuid
 {

-  return SCM_MAKINUM (0L + getuid ());
+  return scm_from_int (getuid ());

 }
 #undef FUNC_NAME
 
 }
 #undef FUNC_NAME
 


@@ -563,7 +829,7 @@ SCM_DEFINE (scm_getgid, "getgid", 0, 0, 0,
            "Return an integer representing the current real group ID.")
 #define FUNC_NAME s_scm_getgid
 {
            "Return an integer representing the current real group ID.")
 #define FUNC_NAME s_scm_getgid
 {

-  return SCM_MAKINUM (0L + getgid ());
+  return scm_from_int (getgid ());

 }
 #undef FUNC_NAME
 
 }
 #undef FUNC_NAME
 


@@ -573,14 +839,14 @@ SCM_DEFINE (scm_geteuid, "geteuid", 0, 0, 0,
             (),
            "Return an integer representing the current effective user ID.\n"
            "If the system does not support effective IDs, then the real ID\n"
             (),
            "Return an integer representing the current effective user ID.\n"
            "If the system does not support effective IDs, then the real ID\n"

-           "is returned.  @code{(feature? 'EIDs)} reports whether the\n"
+           "is returned.  @code{(provided? 'EIDs)} reports whether the\n"

            "system supports effective IDs.")
 #define FUNC_NAME s_scm_geteuid
 {
 #ifdef HAVE_GETEUID
            "system supports effective IDs.")
 #define FUNC_NAME s_scm_geteuid
 {
 #ifdef HAVE_GETEUID

-  return SCM_MAKINUM (0L + geteuid ());
+  return scm_from_int (geteuid ());

 #else
 #else

-  return SCM_MAKINUM (0L + getuid ());
+  return scm_from_int (getuid ());

 #endif
 }
 #undef FUNC_NAME
 #endif
 }
 #undef FUNC_NAME


@@ -590,14 +856,14 @@ SCM_DEFINE (scm_getegid, "getegid", 0, 0, 0,
             (),
            "Return an integer representing the current effective group ID.\n"
            "If the system does not support effective IDs, then the real ID\n"
             (),
            "Return an integer representing the current effective group ID.\n"
            "If the system does not support effective IDs, then the real ID\n"

-           "is returned.  @code{(feature? 'EIDs)} reports whether the\n"
+           "is returned.  @code{(provided? 'EIDs)} reports whether the\n"

            "system supports effective IDs.")
 #define FUNC_NAME s_scm_getegid
 {
 #ifdef HAVE_GETEUID
            "system supports effective IDs.")
 #define FUNC_NAME s_scm_getegid
 {
 #ifdef HAVE_GETEUID

-  return SCM_MAKINUM (0L + getegid ());
+  return scm_from_int (getegid ());

 #else
 #else

-  return SCM_MAKINUM (0L + getgid ());
+  return scm_from_int (getgid ());

 #endif
 }
 #undef FUNC_NAME
 #endif
 }
 #undef FUNC_NAME


@@ -610,8 +876,7 @@ SCM_DEFINE (scm_setuid, "setuid", 1, 0, 0,
            "The return value is unspecified.")
 #define FUNC_NAME s_scm_setuid
 {
            "The return value is unspecified.")
 #define FUNC_NAME s_scm_setuid
 {

-  SCM_VALIDATE_INUM (1,id);
-  if (setuid (SCM_INUM (id)) != 0)
+  if (setuid (scm_to_int (id)) != 0)

     SCM_SYSERROR;
   return SCM_UNSPECIFIED;
 }
     SCM_SYSERROR;
   return SCM_UNSPECIFIED;
 }


@@ -624,8 +889,7 @@ SCM_DEFINE (scm_setgid, "setgid", 1, 0, 0,
            "The return value is unspecified.")
 #define FUNC_NAME s_scm_setgid
 {
            "The return value is unspecified.")
 #define FUNC_NAME s_scm_setgid
 {

-  SCM_VALIDATE_INUM (1,id);
-  if (setgid (SCM_INUM (id)) != 0)
+  if (setgid (scm_to_int (id)) != 0)

     SCM_SYSERROR;
   return SCM_UNSPECIFIED;
 }
     SCM_SYSERROR;
   return SCM_UNSPECIFIED;
 }


@@ -635,18 +899,17 @@ SCM_DEFINE (scm_seteuid, "seteuid", 1, 0, 0,
             (SCM id),
            "Sets the effective user ID to the integer @var{id}, provided the process\n"
            "has appropriate privileges.  If effective IDs are not supported, the\n"
             (SCM id),
            "Sets the effective user ID to the integer @var{id}, provided the process\n"
            "has appropriate privileges.  If effective IDs are not supported, the\n"

-           "real ID is set instead -- @code{(feature? 'EIDs)} reports whether the\n"
+           "real ID is set instead -- @code{(provided? 'EIDs)} reports whether the\n"

            "system supports effective IDs.\n"
            "The return value is unspecified.")
 #define FUNC_NAME s_scm_seteuid
 {
   int rv;
 
            "system supports effective IDs.\n"
            "The return value is unspecified.")
 #define FUNC_NAME s_scm_seteuid
 {
   int rv;
 

-  SCM_VALIDATE_INUM (1,id);

 #ifdef HAVE_SETEUID
 #ifdef HAVE_SETEUID

-  rv = seteuid (SCM_INUM (id));
+  rv = seteuid (scm_to_int (id));

 #else
 #else

-  rv = setuid (SCM_INUM (id));
+  rv = setuid (scm_to_int (id));

 #endif
   if (rv != 0)
     SCM_SYSERROR;
 #endif
   if (rv != 0)
     SCM_SYSERROR;


@@ -661,18 +924,17 @@ SCM_DEFINE (scm_setegid, "setegid", 1, 0, 0,
             (SCM id),
            "Sets the effective group ID to the integer @var{id}, provided the process\n"
            "has appropriate privileges.  If effective IDs are not supported, the\n"
             (SCM id),
            "Sets the effective group ID to the integer @var{id}, provided the process\n"
            "has appropriate privileges.  If effective IDs are not supported, the\n"

-           "real ID is set instead -- @code{(feature? 'EIDs)} reports whether the\n"
+           "real ID is set instead -- @code{(provided? 'EIDs)} reports whether the\n"

            "system supports effective IDs.\n"
            "The return value is unspecified.")
 #define FUNC_NAME s_scm_setegid
 {
   int rv;
 
            "system supports effective IDs.\n"
            "The return value is unspecified.")
 #define FUNC_NAME s_scm_setegid
 {
   int rv;
 

-  SCM_VALIDATE_INUM (1,id);

 #ifdef HAVE_SETEUID
 #ifdef HAVE_SETEUID

-  rv = setegid (SCM_INUM (id));
+  rv = setegid (scm_to_int (id));

 #else
 #else

-  rv = setgid (SCM_INUM (id));
+  rv = setgid (scm_to_int (id));

 #endif
   if (rv != 0)
     SCM_SYSERROR;
 #endif
   if (rv != 0)
     SCM_SYSERROR;


@@ -692,7 +954,7 @@ SCM_DEFINE (scm_getpgrp, "getpgrp", 0, 0, 0,
 {
   int (*fn)();
   fn = (int (*) ()) getpgrp;
 {
   int (*fn)();
   fn = (int (*) ()) getpgrp;

-  return SCM_MAKINUM (fn (0));
+  return scm_from_int (fn (0));

 }
 #undef FUNC_NAME
 #endif /* HAVE_GETPGRP */
 }
 #undef FUNC_NAME
 #endif /* HAVE_GETPGRP */


@@ -708,10 +970,8 @@ SCM_DEFINE (scm_setpgid, "setpgid", 2, 0, 0,
            "The return value is unspecified.")
 #define FUNC_NAME s_scm_setpgid
 {
            "The return value is unspecified.")
 #define FUNC_NAME s_scm_setpgid
 {

-  SCM_VALIDATE_INUM (1,pid);
-  SCM_VALIDATE_INUM (2,pgid);

   /* FIXME(?): may be known as setpgrp.  */
   /* FIXME(?): may be known as setpgrp.  */

-  if (setpgid (SCM_INUM (pid), SCM_INUM (pgid)) != 0)
+  if (setpgid (scm_to_int (pid), scm_to_int (pgid)) != 0)

     SCM_SYSERROR;
   return SCM_UNSPECIFIED;
 }
     SCM_SYSERROR;
   return SCM_UNSPECIFIED;
 }


@@ -735,6 +995,15 @@ SCM_DEFINE (scm_setsid, "setsid", 0, 0, 0,
 #undef FUNC_NAME
 #endif /* HAVE_SETSID */
 
 #undef FUNC_NAME
 #endif /* HAVE_SETSID */
 

+
+/* ttyname returns its result in a single static buffer, hence
+   scm_i_misc_mutex for thread safety.  In glibc 2.3.2 two threads
+   continuously calling ttyname will otherwise get an overwrite quite
+   easily.
+
+   ttyname_r (when available) could be used instead of scm_i_misc_mutex, but
+   there's probably little to be gained in either speed or parallelism.  */
+

 #ifdef HAVE_TTYNAME
 SCM_DEFINE (scm_ttyname, "ttyname", 1, 0, 0, 
             (SCM port),
 #ifdef HAVE_TTYNAME
 SCM_DEFINE (scm_ttyname, "ttyname", 1, 0, 0, 
             (SCM port),


@@ -742,23 +1011,44 @@ SCM_DEFINE (scm_ttyname, "ttyname", 1, 0, 0,
            "underlying @var{port}.")
 #define FUNC_NAME s_scm_ttyname
 {
            "underlying @var{port}.")
 #define FUNC_NAME s_scm_ttyname
 {

-  char *ans;
-  int fd;
+  char *result;
+  int fd, err;
+  SCM ret = SCM_BOOL_F;

 
   port = SCM_COERCE_OUTPORT (port);
 
   port = SCM_COERCE_OUTPORT (port);

-  SCM_VALIDATE_OPPORT (1,port);
+  SCM_VALIDATE_OPPORT (1, port);

   if (!SCM_FPORTP (port))
     return SCM_BOOL_F;
   fd = SCM_FPORT_FDES (port);
   if (!SCM_FPORTP (port))
     return SCM_BOOL_F;
   fd = SCM_FPORT_FDES (port);

-  SCM_SYSCALL (ans = ttyname (fd));
-  if (!ans)
-    SCM_SYSERROR;
-  /* ans could be overwritten by another call to ttyname */
-  return (scm_makfrom0str (ans));
+
+  scm_i_scm_pthread_mutex_lock (&scm_i_misc_mutex);
+
+  SCM_SYSCALL (result = ttyname (fd));
+  err = errno;
+  if (result != NULL)
+    result = strdup (result);
+
+  scm_i_pthread_mutex_unlock (&scm_i_misc_mutex);
+
+  if (!result)
+    {
+      errno = err;
+      SCM_SYSERROR;
+    }
+  else
+    ret = scm_take_locale_string (result);
+
+  return ret;

 }
 #undef FUNC_NAME
 #endif /* HAVE_TTYNAME */
 
 }
 #undef FUNC_NAME
 #endif /* HAVE_TTYNAME */
 

+
+/* For thread safety "buf" is used instead of NULL for the ctermid static
+   buffer.  Actually it's unlikely the controlling terminal will change
+   during program execution, and indeed on glibc (2.3.2) it's always just
+   "/dev/tty", but L_ctermid on the stack is easy and fast and guarantees
+   safety everywhere.  */

 #ifdef HAVE_CTERMID
 SCM_DEFINE (scm_ctermid, "ctermid", 0, 0, 0,
             (),
 #ifdef HAVE_CTERMID
 SCM_DEFINE (scm_ctermid, "ctermid", 0, 0, 0,
             (),


@@ -766,10 +1056,11 @@ SCM_DEFINE (scm_ctermid, "ctermid", 0, 0, 0,
            "terminal for the current process.")
 #define FUNC_NAME s_scm_ctermid
 {
            "terminal for the current process.")
 #define FUNC_NAME s_scm_ctermid
 {

-  char *result = ctermid (NULL);
+  char buf[L_ctermid];
+  char *result = ctermid (buf);

   if (*result == '\0')
     SCM_SYSERROR;
   if (*result == '\0')
     SCM_SYSERROR;

-  return scm_makfrom0str (result);
+  return scm_from_locale_string (result);

 }
 #undef FUNC_NAME
 #endif /* HAVE_CTERMID */
 }
 #undef FUNC_NAME
 #endif /* HAVE_CTERMID */


@@ -794,11 +1085,11 @@ SCM_DEFINE (scm_tcgetpgrp, "tcgetpgrp", 1, 0, 0,
 
   port = SCM_COERCE_OUTPORT (port);
 
 
   port = SCM_COERCE_OUTPORT (port);
 

-  SCM_VALIDATE_OPFPORT (1,port);
+  SCM_VALIDATE_OPFPORT (1, port);

   fd = SCM_FPORT_FDES (port);
   if ((pgid = tcgetpgrp (fd)) == -1)
     SCM_SYSERROR;
   fd = SCM_FPORT_FDES (port);
   if ((pgid = tcgetpgrp (fd)) == -1)
     SCM_SYSERROR;

-  return SCM_MAKINUM (pgid);
+  return scm_from_int (pgid);

 }
 #undef FUNC_NAME    
 #endif /* HAVE_TCGETPGRP */
 }
 #undef FUNC_NAME    
 #endif /* HAVE_TCGETPGRP */


@@ -817,47 +1108,19 @@ SCM_DEFINE (scm_tcsetpgrp, "tcsetpgrp", 2, 0, 0,
 
   port = SCM_COERCE_OUTPORT (port);
 
 
   port = SCM_COERCE_OUTPORT (port);
 

-  SCM_VALIDATE_OPFPORT (1,port);
-  SCM_VALIDATE_INUM (2,pgid);
+  SCM_VALIDATE_OPFPORT (1, port);

   fd = SCM_FPORT_FDES (port);
   fd = SCM_FPORT_FDES (port);

-  if (tcsetpgrp (fd, SCM_INUM (pgid)) == -1)
+  if (tcsetpgrp (fd, scm_to_int (pgid)) == -1)

     SCM_SYSERROR;
   return SCM_UNSPECIFIED;
 }
 #undef FUNC_NAME
 #endif /* HAVE_TCSETPGRP */
 
     SCM_SYSERROR;
   return SCM_UNSPECIFIED;
 }
 #undef FUNC_NAME
 #endif /* HAVE_TCSETPGRP */
 

-/* Create a new C argv array from a scheme list of strings. */
-/* Dirk:FIXME:: A quite similar function is implemented in dynl.c */
-/* Dirk:FIXME:: In case of assertion errors, we get memory leaks */
-
-static char **
-scm_convert_exec_args (SCM args, int argn, const char *subr)
+static void
+free_string_pointers (void *data)

 {
 {

-  char **argv;
-  int argc;
-  int i;
-
-  argc = scm_ilength (args);
-  SCM_ASSERT (argc >= 0, args, argn, subr);
-  argv = (char **) scm_malloc ((argc + 1) * sizeof (char *));
-  for (i = 0; !SCM_NULLP (args); args = SCM_CDR (args), ++i)
-    {
-      SCM arg = SCM_CAR (args);
-      size_t len;
-      char *dst;
-      char *src;
-
-      SCM_ASSERT (SCM_STRINGP (arg), args, argn, subr);
-      len = SCM_STRING_LENGTH (arg);
-      src = SCM_STRING_CHARS (arg);
-      dst = (char *) scm_malloc (len + 1);
-      memcpy (dst, src, len);
-      dst[len] = 0;
-      argv[i] = dst;
-    }
-  argv[i] = 0;
-  return argv;
+  scm_i_free_string_pointers ((char **)data);

 }
 
 SCM_DEFINE (scm_execl, "execl", 1, 0, 1, 
 }
 
 SCM_DEFINE (scm_execl, "execl", 1, 0, 1, 


@@ -873,12 +1136,28 @@ SCM_DEFINE (scm_execl, "execl", 1, 0, 1,
            "call, but we call it @code{execl} because of its Scheme calling interface.")
 #define FUNC_NAME s_scm_execl
 {
            "call, but we call it @code{execl} because of its Scheme calling interface.")
 #define FUNC_NAME s_scm_execl
 {

-  char **execargv;
-  SCM_VALIDATE_STRING (1, filename);
-  execargv = scm_convert_exec_args (args, SCM_ARG2, FUNC_NAME);
-  execv (SCM_STRING_CHARS (filename), execargv);
+  char *exec_file;
+  char **exec_argv;
+
+  scm_dynwind_begin (0);
+
+  exec_file = scm_to_locale_string (filename);
+  scm_dynwind_free (exec_file);
+
+  exec_argv = scm_i_allocate_string_pointers (args);
+  scm_dynwind_unwind_handler (free_string_pointers, exec_argv, 
+                           SCM_F_WIND_EXPLICITLY);
+
+  execv (exec_file,
+#ifdef __MINGW32__
+         /* extra "const" in mingw formals, provokes warning from gcc */
+         (const char * const *)
+#endif
+         exec_argv);

   SCM_SYSERROR;
   SCM_SYSERROR;

+

   /* not reached.  */
   /* not reached.  */

+  scm_dynwind_end ();

   return SCM_BOOL_F;
 }
 #undef FUNC_NAME
   return SCM_BOOL_F;
 }
 #undef FUNC_NAME


@@ -893,46 +1172,35 @@ SCM_DEFINE (scm_execlp, "execlp", 1, 0, 1,
            "call, but we call it @code{execlp} because of its Scheme calling interface.")
 #define FUNC_NAME s_scm_execlp
 {
            "call, but we call it @code{execlp} because of its Scheme calling interface.")
 #define FUNC_NAME s_scm_execlp
 {

-  char **execargv;
-  SCM_VALIDATE_STRING (1, filename);
-  execargv = scm_convert_exec_args (args, SCM_ARG2, FUNC_NAME);
-  execvp (SCM_STRING_CHARS (filename), execargv);
+  char *exec_file;
+  char **exec_argv;
+
+  scm_dynwind_begin (0);
+
+  exec_file = scm_to_locale_string (filename);
+  scm_dynwind_free (exec_file);
+
+  exec_argv = scm_i_allocate_string_pointers (args);
+  scm_dynwind_unwind_handler (free_string_pointers, exec_argv, 
+                           SCM_F_WIND_EXPLICITLY);
+
+  execvp (exec_file,
+#ifdef __MINGW32__
+          /* extra "const" in mingw formals, provokes warning from gcc */
+          (const char * const *)
+#endif
+          exec_argv);

   SCM_SYSERROR;
   SCM_SYSERROR;

+

   /* not reached.  */
   /* not reached.  */

+  scm_dynwind_end ();

   return SCM_BOOL_F;
 }
 #undef FUNC_NAME
 
   return SCM_BOOL_F;
 }
 #undef FUNC_NAME
 

-static char **
-environ_list_to_c (SCM envlist, int arg, const char *proc)
-{
-  int num_strings;
-  char **result;
-  int i;

 
 

-  num_strings = scm_ilength (envlist);
-  SCM_ASSERT (num_strings >= 0, envlist, arg, proc);
-  result = (char **) malloc ((num_strings + 1) * sizeof (char *));
-  if (result == NULL)
-    scm_memory_error (proc);
-  for (i = 0; !SCM_NULL_OR_NIL_P (envlist); ++i, envlist = SCM_CDR (envlist))
-    {
-      SCM str = SCM_CAR (envlist);
-      int len;
-      char *src;
-
-      SCM_ASSERT (SCM_STRINGP (str), envlist, arg, proc);
-      len = SCM_STRING_LENGTH (str);
-      src = SCM_STRING_CHARS (str);
-      result[i] = malloc (len + 1);
-      if (result[i] == NULL)
-       scm_memory_error (proc);
-      memcpy (result[i], src, len);
-      result[i][len] = 0;
-    }
-  result[i] = 0;
-  return result;
-}
+/* OPTIMIZE-ME: scm_execle doesn't need malloced copies of the environment
+   list strings the way environ_list_to_c gives.  */

 
 SCM_DEFINE (scm_execle, "execle", 2, 0, 1, 
             (SCM filename, SCM env, SCM args),
 
 SCM_DEFINE (scm_execle, "execle", 2, 0, 1, 
             (SCM filename, SCM env, SCM args),


@@ -943,16 +1211,38 @@ SCM_DEFINE (scm_execle, "execle", 2, 0, 1,
            "call, but we call it @code{execle} because of its Scheme calling interface.")
 #define FUNC_NAME s_scm_execle
 {
            "call, but we call it @code{execle} because of its Scheme calling interface.")
 #define FUNC_NAME s_scm_execle
 {

-  char **execargv;
+  char **exec_argv;

   char **exec_env;
   char **exec_env;

+  char *exec_file;

 
 

-  SCM_VALIDATE_STRING (1, filename);
-  
-  execargv = scm_convert_exec_args (args, SCM_ARG1, FUNC_NAME);
-  exec_env = environ_list_to_c (env, SCM_ARG2, FUNC_NAME);
-  execve (SCM_STRING_CHARS (filename), execargv, exec_env);
+  scm_dynwind_begin (0);
+
+  exec_file = scm_to_locale_string (filename);
+  scm_dynwind_free (exec_file);
+
+  exec_argv = scm_i_allocate_string_pointers (args);
+  scm_dynwind_unwind_handler (free_string_pointers, exec_argv,
+                           SCM_F_WIND_EXPLICITLY);
+
+  exec_env = scm_i_allocate_string_pointers (env);
+  scm_dynwind_unwind_handler (free_string_pointers, exec_env,
+                           SCM_F_WIND_EXPLICITLY);
+
+  execve (exec_file,
+#ifdef __MINGW32__
+          /* extra "const" in mingw formals, provokes warning from gcc */
+          (const char * const *)
+#endif
+          exec_argv,
+#ifdef __MINGW32__
+          /* extra "const" in mingw formals, provokes warning from gcc */
+          (const char * const *)
+#endif
+          exec_env);

   SCM_SYSERROR;
   SCM_SYSERROR;

+

   /* not reached.  */
   /* not reached.  */

+  scm_dynwind_end ();

   return SCM_BOOL_F;
 }
 #undef FUNC_NAME
   return SCM_BOOL_F;
 }
 #undef FUNC_NAME


@@ -971,7 +1261,7 @@ SCM_DEFINE (scm_fork, "primitive-fork", 0, 0, 0,
   pid = fork ();
   if (pid == -1)
     SCM_SYSERROR;
   pid = fork ();
   if (pid == -1)
     SCM_SYSERROR;

-  return SCM_MAKINUM (0L+pid);
+  return scm_from_int (pid);

 }
 #undef FUNC_NAME
 #endif /* HAVE_FORK */
 }
 #undef FUNC_NAME
 #endif /* HAVE_FORK */


@@ -988,20 +1278,19 @@ SCM_DEFINE (scm_uname, "uname", 0, 0, 0,
 #define FUNC_NAME s_scm_uname
 {
   struct utsname buf;
 #define FUNC_NAME s_scm_uname
 {
   struct utsname buf;

-  SCM ans = scm_c_make_vector (5, SCM_UNSPECIFIED);
-  SCM *ve = SCM_VELTS (ans);
+  SCM result = scm_c_make_vector (5, SCM_UNSPECIFIED);

   if (uname (&buf) < 0)
     SCM_SYSERROR;
   if (uname (&buf) < 0)
     SCM_SYSERROR;

-  ve[0] = scm_makfrom0str (buf.sysname);
-  ve[1] = scm_makfrom0str (buf.nodename);
-  ve[2] = scm_makfrom0str (buf.release);
-  ve[3] = scm_makfrom0str (buf.version);
-  ve[4] = scm_makfrom0str (buf.machine);
+  SCM_SIMPLE_VECTOR_SET(result, 0, scm_from_locale_string (buf.sysname));
+  SCM_SIMPLE_VECTOR_SET(result, 1, scm_from_locale_string (buf.nodename));
+  SCM_SIMPLE_VECTOR_SET(result, 2, scm_from_locale_string (buf.release));
+  SCM_SIMPLE_VECTOR_SET(result, 3, scm_from_locale_string (buf.version));
+  SCM_SIMPLE_VECTOR_SET(result, 4, scm_from_locale_string (buf.machine));

 /* 
    a linux special?
 /* 
    a linux special?

-  ve[5] = scm_makfrom0str (buf.domainname);
+  SCM_SIMPLE_VECTOR_SET(result, 5, scm_from_locale_string (buf.domainname));

 */
 */

-  return ans;
+  return result;

 }
 #undef FUNC_NAME
 #endif /* HAVE_UNAME */
 }
 #undef FUNC_NAME
 #endif /* HAVE_UNAME */


@@ -1023,19 +1312,14 @@ SCM_DEFINE (scm_environ, "environ", 0, 1, 0,
     {
       char **new_environ;
 
     {
       char **new_environ;
 

-      new_environ = environ_list_to_c (env, SCM_ARG1, FUNC_NAME);
+      new_environ = scm_i_allocate_string_pointers (env);

       /* Free the old environment, except when called for the first
        * time.
        */
       {
       /* Free the old environment, except when called for the first
        * time.
        */
       {

-       char **ep;

        static int first = 1;
        if (!first)
        static int first = 1;
        if (!first)

-         {
-           for (ep = environ; *ep != NULL; ep++)
-             free (*ep);
-           free ((char *) environ);
-         }
+         scm_i_free_string_pointers (environ);

        first = 0;
       }
       environ = new_environ;
        first = 0;
       }
       environ = new_environ;


@@ -1062,7 +1346,7 @@ SCM_DEFINE (scm_tmpnam, "tmpnam", 0, 0, 0,
   if (rv == NULL)
     /* not SCM_SYSERROR since errno probably not set.  */
     SCM_MISC_ERROR ("tmpnam failed", SCM_EOL);
   if (rv == NULL)
     /* not SCM_SYSERROR since errno probably not set.  */
     SCM_MISC_ERROR ("tmpnam failed", SCM_EOL);

-  return scm_makfrom0str (name);
+  return scm_from_locale_string (name);

 }
 #undef FUNC_NAME
 
 }
 #undef FUNC_NAME
 


@@ -1074,20 +1358,44 @@ extern int mkstemp (char *);
 
 SCM_DEFINE (scm_mkstemp, "mkstemp!", 1, 0, 0,
            (SCM tmpl),
 
 SCM_DEFINE (scm_mkstemp, "mkstemp!", 1, 0, 0,
            (SCM tmpl),

-           "Create a new unique file in the file system and returns a new\n"
+           "Create a new unique file in the file system and return a new\n"

            "buffered port open for reading and writing to the file.\n"
            "buffered port open for reading and writing to the file.\n"

+           "\n"

            "@var{tmpl} is a string specifying where the file should be\n"
            "@var{tmpl} is a string specifying where the file should be\n"

-           "created: it must end with @code{XXXXXX} and will be changed in\n"
-           "place to return the name of the temporary file.")
+           "created: it must end with @samp{XXXXXX} and those @samp{X}s\n"
+           "will be changed in the string to return the name of the file.\n"
+           "(@code{port-filename} on the port also gives the name.)\n"
+           "\n"
+           "POSIX doesn't specify the permissions mode of the file, on GNU\n"
+           "and most systems it's @code{#o600}.  An application can use\n"
+           "@code{chmod} to relax that if desired.  For example\n"
+           "@code{#o666} less @code{umask}, which is usual for ordinary\n"
+           "file creation,\n"
+           "\n"
+           "@example\n"
+           "(let ((port (mkstemp! (string-copy \"/tmp/myfile-XXXXXX\"))))\n"
+           "  (chmod port (logand #o666 (lognot (umask))))\n"
+           "  ...)\n"
+           "@end example")

 #define FUNC_NAME s_scm_mkstemp
 {
   char *c_tmpl;
   int rv;
   
 #define FUNC_NAME s_scm_mkstemp
 {
   char *c_tmpl;
   int rv;
   

-  SCM_VALIDATE_STRING_COPY (1, tmpl, c_tmpl);
+  scm_dynwind_begin (0);
+
+  c_tmpl = scm_to_locale_string (tmpl);
+  scm_dynwind_free (c_tmpl);
+

   SCM_SYSCALL (rv = mkstemp (c_tmpl));
   if (rv == -1)
     SCM_SYSERROR;
   SCM_SYSCALL (rv = mkstemp (c_tmpl));
   if (rv == -1)
     SCM_SYSERROR;

+
+  scm_substring_move_x (scm_from_locale_string (c_tmpl),
+                       SCM_INUM0, scm_string_length (tmpl),
+                       tmpl, SCM_INUM0);
+
+  scm_dynwind_end ();

   return scm_fdes_to_port (rv, "w+", tmpl);
 }
 #undef FUNC_NAME
   return scm_fdes_to_port (rv, "w+", tmpl);
 }
 #undef FUNC_NAME


@@ -1109,7 +1417,6 @@ SCM_DEFINE (scm_utime, "utime", 1, 2, 0,
   int rv;
   struct utimbuf utm_tmp;
 
   int rv;
   struct utimbuf utm_tmp;
 

-  SCM_VALIDATE_STRING (1, pathname);

   if (SCM_UNBNDP (actime))
     SCM_SYSCALL (time (&utm_tmp.actime));
   else
   if (SCM_UNBNDP (actime))
     SCM_SYSCALL (time (&utm_tmp.actime));
   else


@@ -1120,7 +1427,8 @@ SCM_DEFINE (scm_utime, "utime", 1, 2, 0,
   else
     utm_tmp.modtime = SCM_NUM2ULONG (3, modtime);
 
   else
     utm_tmp.modtime = SCM_NUM2ULONG (3, modtime);
 

-  SCM_SYSCALL (rv = utime (SCM_STRING_CHARS (pathname), &utm_tmp));
+  STRING_SYSCALL (pathname, c_pathname,
+                 rv = utime (c_pathname, &utm_tmp));

   if (rv != 0)
     SCM_SYSERROR;
   return SCM_UNSPECIFIED;
   if (rv != 0)
     SCM_SYSERROR;
   return SCM_UNSPECIFIED;


@@ -1129,37 +1437,53 @@ SCM_DEFINE (scm_utime, "utime", 1, 2, 0,
 
 SCM_DEFINE (scm_access, "access?", 2, 0, 0,
             (SCM path, SCM how),
 
 SCM_DEFINE (scm_access, "access?", 2, 0, 0,
             (SCM path, SCM how),

-           "Return @code{#t} if @var{path} corresponds to an existing file\n"
-           "and the current process has the type of access specified by\n"
-           "@var{how}, otherwise @code{#f}.  @var{how} should be specified\n"
-           "using the values of the variables listed below.  Multiple\n"
-           "values can be combined using a bitwise or, in which case\n"
-           "@code{#t} will only be returned if all accesses are granted.\n"
+           "Test accessibility of a file under the real UID and GID of the\n"
+           "calling process.  The return is @code{#t} if @var{path} exists\n"
+           "and the permissions requested by @var{how} are all allowed, or\n"
+           "@code{#f} if not.\n"

            "\n"
            "\n"

-           "Permissions are checked using the real id of the current\n"
-           "process, not the effective id, although it's the effective id\n"
-           "which determines whether the access would actually be granted.\n"
+           "@var{how} is an integer which is one of the following values,\n"
+           "or a bitwise-OR (@code{logior}) of multiple values.\n"

            "\n"
            "@defvar R_OK\n"
            "\n"
            "@defvar R_OK\n"

-           "test for read permission.\n"
+           "Test for read permission.\n"

            "@end defvar\n"
            "@defvar W_OK\n"
            "@end defvar\n"
            "@defvar W_OK\n"

-           "test for write permission.\n"
+           "Test for write permission.\n"

            "@end defvar\n"
            "@defvar X_OK\n"
            "@end defvar\n"
            "@defvar X_OK\n"

-           "test for execute permission.\n"
+           "Test for execute permission.\n"

            "@end defvar\n"
            "@defvar F_OK\n"
            "@end defvar\n"
            "@defvar F_OK\n"

-           "test for existence of the file.\n"
-           "@end defvar")
+           "Test for existence of the file.  This is implied by each of the\n"
+           "other tests, so there's no need to combine it with them.\n"
+           "@end defvar\n"
+           "\n"
+           "It's important to note that @code{access?} does not simply\n"
+           "indicate what will happen on attempting to read or write a\n"
+           "file.  In normal circumstances it does, but in a set-UID or\n"
+           "set-GID program it doesn't because @code{access?} tests the\n"
+           "real ID, whereas an open or execute attempt uses the effective\n"
+           "ID.\n"
+           "\n"
+           "A program which will never run set-UID/GID can ignore the\n"
+           "difference between real and effective IDs, but for maximum\n"
+           "generality, especially in library functions, it's best not to\n"
+           "use @code{access?} to predict the result of an open or execute,\n"
+           "instead simply attempt that and catch any exception.\n"
+           "\n"
+           "The main use for @code{access?} is to let a set-UID/GID program\n"
+           "determine what the invoking user would have been allowed to do,\n"
+           "without the greater (or perhaps lesser) privileges afforded by\n"
+           "the effective ID.  For more on this, see ``Testing File\n"
+           "Access'' in The GNU C Library Reference Manual.")

 #define FUNC_NAME s_scm_access
 {
   int rv;
 
 #define FUNC_NAME s_scm_access
 {
   int rv;
 

-  SCM_VALIDATE_STRING (1, path);
-  SCM_VALIDATE_INUM (2, how);
-  rv = access (SCM_STRING_CHARS (path), SCM_INUM (how));
-  return SCM_NEGATE_BOOL(rv);
+  WITH_STRING (path, c_path,
+              rv = access (c_path, scm_to_int (how)));
+  return scm_from_bool (!rv);

 }
 #undef FUNC_NAME
 
 }
 #undef FUNC_NAME
 


@@ -1168,7 +1492,7 @@ SCM_DEFINE (scm_getpid, "getpid", 0, 0, 0,
            "Return an integer representing the current process ID.")
 #define FUNC_NAME s_scm_getpid
 {
            "Return an integer representing the current process ID.")
 #define FUNC_NAME s_scm_getpid
 {

-  return SCM_MAKINUM ((unsigned long) getpid ());
+  return scm_from_ulong (getpid ());

 }
 #undef FUNC_NAME
 
 }
 #undef FUNC_NAME
 


@@ -1186,26 +1510,97 @@ SCM_DEFINE (scm_putenv, "putenv", 1, 0, 0,
 #define FUNC_NAME s_scm_putenv
 {
   int rv;
 #define FUNC_NAME s_scm_putenv
 {
   int rv;

-  char *ptr;
-
-  SCM_VALIDATE_STRING (1, str);
+  char *c_str = scm_to_locale_string (str);

 
 

-  if (strchr (SCM_STRING_CHARS (str), '=') == NULL)
+  if (strchr (c_str, '=') == NULL)

     {
     {

-      /* No '=' in argument means we should remove the variable from
-        the environment.  Not all putenvs understand this.  To be
-        safe, we do it explicitely using unsetenv. */
-      unsetenv (SCM_STRING_CHARS (str));
+      /* We want no "=" in the argument to mean remove the variable from the
+        environment, but not all putenv()s understand this, for example
+        FreeBSD 4.8 doesn't.  Getting it happening everywhere is a bit
+        painful.  What unsetenv() exists, we use that, of course.
+
+         Traditionally putenv("NAME") removes a variable, for example that's
+         what we have to do on Solaris 9 (it doesn't have an unsetenv).
+
+         But on DOS and on that DOS overlay manager thing called W-whatever,
+         putenv("NAME=") must be used (it too doesn't have an unsetenv).
+
+         Supposedly on AIX a putenv("NAME") could cause a segfault, but also
+         supposedly AIX 5.3 and up has unsetenv() available so should be ok
+         with the latter there.
+
+         For the moment we hard code the DOS putenv("NAME=") style under
+         __MINGW32__ and do the traditional everywhere else.  Such
+         system-name tests are bad, of course.  It'd be possible to use a
+         configure test when doing a a native build.  For example GNU R has
+         such a test (see R_PUTENV_AS_UNSETENV in
+         https://svn.r-project.org/R/trunk/m4/R.m4).  But when cross
+         compiling there'd want to be a guess, one probably based on the
+         system name (ie. mingw or not), thus landing back in basically the
+         present hard-coded situation.  Another possibility for a cross
+         build would be to try "NAME" then "NAME=" at runtime, if that's not
+         too much like overkill.  */
+
+#if HAVE_UNSETENV
+      /* when unsetenv() exists then we use it */
+      unsetenv (c_str);
+      free (c_str);
+#elif defined (__MINGW32__)
+      /* otherwise putenv("NAME=") on DOS */
+      int e;
+      size_t len = strlen (c_str);
+      char *ptr = scm_malloc (len + 2);
+      strcpy (ptr, c_str);
+      strcpy (ptr+len, "=");
+      rv = putenv (ptr);
+      e = errno; free (ptr); free (c_str); errno = e;
+      if (rv < 0)
+       SCM_SYSERROR;
+#else
+      /* otherwise traditional putenv("NAME") */
+      rv = putenv (c_str);
+      if (rv < 0)
+       SCM_SYSERROR;
+#endif

     }
   else
     {
     }
   else
     {

-      /* must make a new copy to be left in the environment, safe from gc.  */
-      ptr = malloc (SCM_STRING_LENGTH (str) + 1);
-      if (ptr == NULL)
-       SCM_MEMORY_ERROR;
-      strncpy (ptr, SCM_STRING_CHARS (str), SCM_STRING_LENGTH (str));
-      ptr[SCM_STRING_LENGTH (str)] = 0;
-      rv = putenv (ptr);
+#ifdef __MINGW32__
+      /* If str is "FOO=", ie. attempting to set an empty string, then
+         we need to see if it's been successful.  On MINGW, "FOO="
+         means remove FOO from the environment.  As a workaround, we
+         set "FOO= ", ie. a space, and then modify the string returned
+         by getenv.  It's not enough just to modify the string we set,
+         because MINGW putenv copies it.  */
+
+      {
+        size_t len = strlen (c_str);
+        if (c_str[len-1] == '=')
+          {
+            char *ptr = scm_malloc (len+2);
+            strcpy (ptr, c_str);
+            strcpy (ptr+len, " ");
+            rv = putenv (ptr);
+            if (rv < 0)
+              {
+                int eno = errno;
+                free (c_str);
+                errno = eno;
+                SCM_SYSERROR;
+              }
+            /* truncate to just the name */
+            c_str[len-1] = '\0';
+            ptr = getenv (c_str);
+            if (ptr)
+              ptr[0] = '\0';
+            return SCM_UNSPECIFIED;
+          }
+      }
+#endif /* __MINGW32__ */
+
+      /* Leave c_str in the environment.  */
+
+      rv = putenv (c_str);

       if (rv < 0)
        SCM_SYSERROR;
     }
       if (rv < 0)
        SCM_SYSERROR;
     }


@@ -1213,7 +1608,14 @@ SCM_DEFINE (scm_putenv, "putenv", 1, 0, 0,
 }
 #undef FUNC_NAME
 
 }
 #undef FUNC_NAME
 

+/* This mutex is used to serialize invocations of `setlocale ()' on non-GNU
+   systems (i.e., systems where a reentrant locale API is not available).  It
+   is also acquired before calls to `nl_langinfo ()'.  See `i18n.c' for
+   details.  */
+scm_i_pthread_mutex_t scm_i_locale_mutex = SCM_I_PTHREAD_MUTEX_INITIALIZER;
+

 #ifdef HAVE_SETLOCALE
 #ifdef HAVE_SETLOCALE

+

 SCM_DEFINE (scm_setlocale, "setlocale", 1, 1, 0,
             (SCM category, SCM locale),
            "If @var{locale} is omitted, return the current value of the\n"
 SCM_DEFINE (scm_setlocale, "setlocale", 1, 1, 0,
             (SCM category, SCM locale),
            "If @var{locale} is omitted, return the current value of the\n"


@@ -1227,24 +1629,43 @@ SCM_DEFINE (scm_setlocale, "setlocale", 1, 1, 0,
            "the locale will be set using environment variables.")
 #define FUNC_NAME s_scm_setlocale
 {
            "the locale will be set using environment variables.")
 #define FUNC_NAME s_scm_setlocale
 {

+  int c_category;

   char *clocale;
   char *rv;
 
   char *clocale;
   char *rv;
 

-  SCM_VALIDATE_INUM (1,category);
+  scm_dynwind_begin (0);
+

   if (SCM_UNBNDP (locale))
     {
       clocale = NULL;
     }
   else
     {
   if (SCM_UNBNDP (locale))
     {
       clocale = NULL;
     }
   else
     {

-      SCM_VALIDATE_STRING (2, locale);
-      clocale = SCM_STRING_CHARS (locale);
+      clocale = scm_to_locale_string (locale);
+      scm_dynwind_free (clocale);

     }
 
     }
 

-  rv = setlocale (SCM_INUM (category), clocale);
+  c_category = scm_i_to_lc_category (category, 1);
+
+  scm_i_pthread_mutex_lock (&scm_i_locale_mutex);
+  rv = setlocale (c_category, clocale);
+  scm_i_pthread_mutex_unlock (&scm_i_locale_mutex);
+

   if (rv == NULL)
   if (rv == NULL)

-    SCM_SYSERROR;
-  return scm_makfrom0str (rv);
+    {
+      /* POSIX and C99 don't say anything about setlocale setting errno, so
+         force a sensible value here.  glibc leaves ENOENT, which would be
+         fine, but it's not a documented feature.  */
+      errno = EINVAL;
+      SCM_SYSERROR;
+    }
+
+  /* Recompute the standard SRFI-14 character sets in a locale-dependent
+     (actually charset-dependent) way.  */
+  scm_srfi_14_compute_char_sets ();
+
+  scm_dynwind_end ();
+  return scm_from_locale_string (rv);

 }
 #undef FUNC_NAME
 #endif /* HAVE_SETLOCALE */
 }
 #undef FUNC_NAME
 #endif /* HAVE_SETLOCALE */


@@ -1268,21 +1689,22 @@ SCM_DEFINE (scm_mknod, "mknod", 4, 0, 0,
 #define FUNC_NAME s_scm_mknod
 {
   int val;
 #define FUNC_NAME s_scm_mknod
 {
   int val;

-  char *p;
+  const char *p;

   int ctype = 0;
 
   SCM_VALIDATE_STRING (1, path);
   int ctype = 0;
 
   SCM_VALIDATE_STRING (1, path);

-  SCM_VALIDATE_SYMBOL (2,type);
-  SCM_VALIDATE_INUM (3,perms);
-  SCM_VALIDATE_INUM (4,dev);
+  SCM_VALIDATE_SYMBOL (2, type);

 
 

-  p = SCM_SYMBOL_CHARS (type);
+  p = scm_i_symbol_chars (type);

   if (strcmp (p, "regular") == 0)
     ctype = S_IFREG;
   else if (strcmp (p, "directory") == 0)
     ctype = S_IFDIR;
   if (strcmp (p, "regular") == 0)
     ctype = S_IFREG;
   else if (strcmp (p, "directory") == 0)
     ctype = S_IFDIR;

+#ifdef S_IFLNK
+  /* systems without symlinks probably don't have S_IFLNK defined */

   else if (strcmp (p, "symlink") == 0)
     ctype = S_IFLNK;
   else if (strcmp (p, "symlink") == 0)
     ctype = S_IFLNK;

+#endif

   else if (strcmp (p, "block-special") == 0)
     ctype = S_IFBLK;
   else if (strcmp (p, "char-special") == 0)
   else if (strcmp (p, "block-special") == 0)
     ctype = S_IFBLK;
   else if (strcmp (p, "char-special") == 0)


@@ -1294,10 +1716,12 @@ SCM_DEFINE (scm_mknod, "mknod", 4, 0, 0,
     ctype = S_IFSOCK;
 #endif
   else
     ctype = S_IFSOCK;
 #endif
   else

-    SCM_OUT_OF_RANGE (2,type);
+    SCM_OUT_OF_RANGE (2, type);

 
 

-  SCM_SYSCALL (val = mknod (SCM_STRING_CHARS (path), ctype | SCM_INUM (perms),
-                           SCM_INUM (dev)));
+  STRING_SYSCALL (path, c_path,
+                 val = mknod (c_path,
+                              ctype | scm_to_int (perms),
+                              scm_to_int (dev)));

   if (val != 0)
     SCM_SYSERROR;
   return SCM_UNSPECIFIED;
   if (val != 0)
     SCM_SYSERROR;
   return SCM_UNSPECIFIED;


@@ -1313,9 +1737,15 @@ SCM_DEFINE (scm_nice, "nice", 1, 0, 0,
            "The return value is unspecified.")
 #define FUNC_NAME s_scm_nice
 {
            "The return value is unspecified.")
 #define FUNC_NAME s_scm_nice
 {

-  SCM_VALIDATE_INUM (1,incr);
-  if (nice(SCM_INUM(incr)) != 0)
+  int nice_value;
+
+  /* nice() returns "prio-NZERO" on success or -1 on error, but -1 can arise
+     from "prio-NZERO", so an error must be detected from errno changed */
+  errno = 0;
+  nice_value = nice (scm_to_int (incr));
+  if (errno != 0)

     SCM_SYSERROR;
     SCM_SYSERROR;

+

   return SCM_UNSPECIFIED;
 }
 #undef FUNC_NAME
   return SCM_UNSPECIFIED;
 }
 #undef FUNC_NAME


@@ -1334,23 +1764,55 @@ SCM_DEFINE (scm_sync, "sync", 0, 0, 0,
 #undef FUNC_NAME
 #endif /* HAVE_SYNC */
 
 #undef FUNC_NAME
 #endif /* HAVE_SYNC */
 

-#if HAVE_LIBCRYPT && HAVE_CRYPT_H
-SCM_DEFINE (scm_crypt, "crypt", 2, 0, 0, 
+
+/* crypt() returns a pointer to a static buffer, so we use scm_i_misc_mutex
+   to avoid another thread overwriting it.  A test program running crypt
+   continuously in two threads can be quickly seen tripping this problem.
+   crypt() is pretty slow normally, so a mutex shouldn't add much overhead.
+
+   glibc has a thread-safe crypt_r, but (in version 2.3.2) it runs a lot
+   slower (about 5x) than plain crypt if you pass an uninitialized data
+   block each time.  Presumably there's some one-time setups.  The best way
+   to use crypt_r for parallel execution in multiple threads would probably
+   be to maintain a little pool of initialized crypt_data structures, take
+   one and use it, then return it to the pool.  That pool could be garbage
+   collected so it didn't add permanently to memory use if only a few crypt
+   calls are made.  But we expect crypt will be used rarely, and even more
+   rarely will there be any desire for lots of parallel execution on
+   multiple cpus.  So for now we don't bother with anything fancy, just
+   ensure it works.  */
+
+#if HAVE_CRYPT
+SCM_DEFINE (scm_crypt, "crypt", 2, 0, 0,

             (SCM key, SCM salt),
            "Encrypt @var{key} using @var{salt} as the salt value to the\n"
            "crypt(3) library call.")
 #define FUNC_NAME s_scm_crypt
 {
             (SCM key, SCM salt),
            "Encrypt @var{key} using @var{salt} as the salt value to the\n"
            "crypt(3) library call.")
 #define FUNC_NAME s_scm_crypt
 {

-  char * p;
-
-  SCM_VALIDATE_STRING (1, key);
-  SCM_VALIDATE_STRING (2, salt);
+  SCM ret;
+  char *c_key, *c_salt, *c_ret;
+
+  scm_dynwind_begin (0);
+  scm_i_dynwind_pthread_mutex_lock (&scm_i_misc_mutex);
+
+  c_key = scm_to_locale_string (key);
+  scm_dynwind_free (c_key);
+  c_salt = scm_to_locale_string (salt);
+  scm_dynwind_free (c_salt);
+
+  /* The Linux crypt(3) man page says crypt will return NULL and set errno
+     on error.  (Eg. ENOSYS if legal restrictions mean it cannot be
+     implemented).  */
+  c_ret = crypt (c_key, c_salt);
+  if (c_ret == NULL)
+    SCM_SYSERROR;

 
 

-  p = crypt (SCM_STRING_CHARS (key), SCM_STRING_CHARS (salt));
-  return scm_makfrom0str (p);
+  ret = scm_from_locale_string (c_ret);
+  scm_dynwind_end ();
+  return ret;

 }
 #undef FUNC_NAME
 }
 #undef FUNC_NAME

-#endif /* HAVE_LIBCRYPT && HAVE_CRYPT_H */
+#endif /* HAVE_CRYPT */

 
 #if HAVE_CHROOT
 SCM_DEFINE (scm_chroot, "chroot", 1, 0, 0, 
 
 #if HAVE_CHROOT
 SCM_DEFINE (scm_chroot, "chroot", 1, 0, 0, 


@@ -1362,9 +1824,11 @@ SCM_DEFINE (scm_chroot, "chroot", 1, 0, 0,
            "root directory.")
 #define FUNC_NAME s_scm_chroot
 {
            "root directory.")
 #define FUNC_NAME s_scm_chroot
 {

-  SCM_VALIDATE_STRING (1, path);
+  int rv;

 
 

-  if (chroot (SCM_STRING_CHARS (path)) == -1)
+  WITH_STRING (path, c_path,
+              rv = chroot (c_path));
+  if (rv == -1)

     SCM_SYSERROR;
   return SCM_UNSPECIFIED;
 }
     SCM_SYSERROR;
   return SCM_UNSPECIFIED;
 }


@@ -1399,7 +1863,7 @@ SCM_DEFINE (scm_getlogin, "getlogin", 0, 0, 0,
   p = getlogin ();
   if (!p || !*p)
     return SCM_BOOL_F;
   p = getlogin ();
   if (!p || !*p)
     return SCM_BOOL_F;

-  return scm_makfrom0str (p);
+  return scm_from_locale_string (p);

 }
 #undef FUNC_NAME
 #endif /* HAVE_GETLOGIN */
 }
 #undef FUNC_NAME
 #endif /* HAVE_GETLOGIN */


@@ -1412,12 +1876,13 @@ SCM_DEFINE (scm_cuserid, "cuserid", 0, 0, 0,
            "information cannot be obtained.")
 #define FUNC_NAME s_scm_cuserid
 {
            "information cannot be obtained.")
 #define FUNC_NAME s_scm_cuserid
 {

+  char buf[L_cuserid];

   char * p;
 
   char * p;
 

-  p = cuserid (NULL);
+  p = cuserid (buf);

   if (!p || !*p)
     return SCM_BOOL_F;
   if (!p || !*p)
     return SCM_BOOL_F;

-  return scm_makfrom0str (p);
+  return scm_from_locale_string (p);

 }
 #undef FUNC_NAME
 #endif /* HAVE_CUSERID */
 }
 #undef FUNC_NAME
 #endif /* HAVE_CUSERID */


@@ -1439,8 +1904,8 @@ SCM_DEFINE (scm_getpriority, "getpriority", 2, 0, 0,
 {
   int cwhich, cwho, ret;
 
 {
   int cwhich, cwho, ret;
 

-  SCM_VALIDATE_INUM_COPY (1, which, cwhich);
-  SCM_VALIDATE_INUM_COPY (2, who, cwho);
+  cwhich = scm_to_int (which);
+  cwho = scm_to_int (who);

 
   /* We have to clear errno and examine it later, because -1 is a
      legal return value for getpriority().  */
 
   /* We have to clear errno and examine it later, because -1 is a
      legal return value for getpriority().  */


@@ -1448,7 +1913,7 @@ SCM_DEFINE (scm_getpriority, "getpriority", 2, 0, 0,
   ret = getpriority (cwhich, cwho);
   if (errno != 0)
     SCM_SYSERROR;
   ret = getpriority (cwhich, cwho);
   if (errno != 0)
     SCM_SYSERROR;

-  return SCM_MAKINUM (ret);
+  return scm_from_int (ret);

 }
 #undef FUNC_NAME
 #endif /* HAVE_GETPRIORITY */
 }
 #undef FUNC_NAME
 #endif /* HAVE_GETPRIORITY */


@@ -1473,9 +1938,9 @@ SCM_DEFINE (scm_setpriority, "setpriority", 3, 0, 0,
 {
   int cwhich, cwho, cprio;
 
 {
   int cwhich, cwho, cprio;
 

-  SCM_VALIDATE_INUM_COPY (1, which, cwhich);
-  SCM_VALIDATE_INUM_COPY (2, who, cwho);
-  SCM_VALIDATE_INUM_COPY (3, prio, cprio);
+  cwhich = scm_to_int (which);
+  cwho = scm_to_int (who);
+  cprio = scm_to_int (prio);

 
   if (setpriority (cwhich, cwho, cprio) == -1)
     SCM_SYSERROR;
 
   if (setpriority (cwhich, cwho, cprio) == -1)
     SCM_SYSERROR;


@@ -1501,8 +1966,9 @@ SCM_DEFINE (scm_getpass, "getpass", 1, 0, 0,
 
   SCM_VALIDATE_STRING (1, prompt);
 
 
   SCM_VALIDATE_STRING (1, prompt);
 

-  p = getpass(SCM_STRING_CHARS (prompt));
-  passwd = scm_makfrom0str (p);
+  WITH_STRING (prompt, c_prompt, 
+              p = getpass(c_prompt));
+  passwd = scm_from_locale_string (p);

 
   /* Clear out the password in the static buffer.  */
   memset (p, 0, strlen (p));
 
   /* Clear out the password in the static buffer.  */
   memset (p, 0, strlen (p));


@@ -1583,35 +2049,41 @@ SCM_DEFINE (scm_flock, "flock", 2, 0, 0,
             (SCM file, SCM operation),
            "Apply or remove an advisory lock on an open file.\n"
            "@var{operation} specifies the action to be done:\n"
             (SCM file, SCM operation),
            "Apply or remove an advisory lock on an open file.\n"
            "@var{operation} specifies the action to be done:\n"

-           "@table @code\n"
-           "@item LOCK_SH\n"
+           "\n"
+           "@defvar LOCK_SH\n"

            "Shared lock.  More than one process may hold a shared lock\n"
            "for a given file at a given time.\n"
            "Shared lock.  More than one process may hold a shared lock\n"
            "for a given file at a given time.\n"

-           "@item LOCK_EX\n"
+           "@end defvar\n"
+           "@defvar LOCK_EX\n"

            "Exclusive lock.  Only one process may hold an exclusive lock\n"
            "for a given file at a given time.\n"
            "Exclusive lock.  Only one process may hold an exclusive lock\n"
            "for a given file at a given time.\n"

-           "@item LOCK_UN\n"
+           "@end defvar\n"
+           "@defvar LOCK_UN\n"

            "Unlock the file.\n"
            "Unlock the file.\n"

-           "@item LOCK_NB\n"
-           "Don't block when locking.  May be specified by bitwise OR'ing\n"
-           "it to one of the other operations.\n"
-           "@end table\n"
+           "@end defvar\n"
+           "@defvar LOCK_NB\n"
+           "Don't block when locking.  This is combined with one of the\n"
+           "other operations using @code{logior}.  If @code{flock} would\n"
+           "block an @code{EWOULDBLOCK} error is thrown.\n"
+           "@end defvar\n"
+           "\n"

            "The return value is not specified. @var{file} may be an open\n"
            "The return value is not specified. @var{file} may be an open\n"

-           "file descriptor or an open file descriptor port.")
+           "file descriptor or an open file descriptor port.\n"
+           "\n"
+           "Note that @code{flock} does not lock files across NFS.")

 #define FUNC_NAME s_scm_flock
 {
 #define FUNC_NAME s_scm_flock
 {

-  int coperation, fdes;
+  int fdes;

 
 

-  if (SCM_INUMP (file))
-    fdes = SCM_INUM (file);
+  if (scm_is_integer (file))
+    fdes = scm_to_int (file);

   else
     {
       SCM_VALIDATE_OPFPORT (2, file);
 
       fdes = SCM_FPORT_FDES (file);
     }
   else
     {
       SCM_VALIDATE_OPFPORT (2, file);
 
       fdes = SCM_FPORT_FDES (file);
     }

-  SCM_VALIDATE_INUM_COPY (2, operation, coperation);
-  if (flock (fdes, coperation) == -1)
+  if (flock (fdes, scm_to_int (operation)) == -1)

     SCM_SYSERROR;
   return SCM_UNSPECIFIED;
 }
     SCM_SYSERROR;
   return SCM_UNSPECIFIED;
 }


@@ -1626,47 +2098,102 @@ SCM_DEFINE (scm_sethostname, "sethostname", 1, 0, 0,
            "specified.")
 #define FUNC_NAME s_scm_sethostname
 {
            "specified.")
 #define FUNC_NAME s_scm_sethostname
 {

-  SCM_VALIDATE_STRING (1, name);
+  int rv;

 
 

-  if (sethostname (SCM_STRING_CHARS (name), SCM_STRING_LENGTH (name)) == -1)
+  WITH_STRING (name, c_name,
+              rv = sethostname (c_name, strlen(c_name)));
+  if (rv == -1)

     SCM_SYSERROR;
   return SCM_UNSPECIFIED;
 }
 #undef FUNC_NAME
 #endif /* HAVE_SETHOSTNAME */
 
     SCM_SYSERROR;
   return SCM_UNSPECIFIED;
 }
 #undef FUNC_NAME
 #endif /* HAVE_SETHOSTNAME */
 

+

 #if HAVE_GETHOSTNAME
 SCM_DEFINE (scm_gethostname, "gethostname", 0, 0, 0, 
             (void),
            "Return the host name of the current processor.")
 #define FUNC_NAME s_scm_gethostname
 {
 #if HAVE_GETHOSTNAME
 SCM_DEFINE (scm_gethostname, "gethostname", 0, 0, 0, 
             (void),
            "Return the host name of the current processor.")
 #define FUNC_NAME s_scm_gethostname
 {

-  /* 256 is for Solaris, under Linux ENAMETOOLONG is returned if not
-     large enough.  */
-  int len = 256, res;
-  char *p = scm_malloc (len);
-  SCM name;
+#ifdef MAXHOSTNAMELEN
+
+  /* Various systems define MAXHOSTNAMELEN (including Solaris in fact).
+   * On GNU/Linux this doesn't include the terminating '\0', hence "+ 1".  */
+  const int len = MAXHOSTNAMELEN + 1;
+  char *const p = scm_malloc (len);
+  const int res = gethostname (p, len);
+
+  scm_dynwind_begin (0);
+  scm_dynwind_unwind_handler (free, p, 0);
+
+#else
+
+  /* Default 256 is for Solaris, under Linux ENAMETOOLONG is returned if not
+   * large enough.  SUSv2 specifies 255 maximum too, apparently.  */
+  int len = 256;
+  int res;
+  char *p;
+
+#  if HAVE_SYSCONF && defined (_SC_HOST_NAME_MAX)
+
+  /* POSIX specifies the HOST_NAME_MAX system parameter for the max size,
+   * which may reflect a particular kernel configuration.
+   * Must watch out for this existing but giving -1, as happens for instance
+   * in gnu/linux glibc 2.3.2.  */
+  {
+    const long int n = sysconf (_SC_HOST_NAME_MAX);
+    if (n != -1L)
+      len = n;
+  }
+
+#  endif
+
+  p = scm_malloc (len);
+
+  scm_dynwind_begin (0);
+  scm_dynwind_unwind_handler (free, p, 0);

 
   res = gethostname (p, len);
   while (res == -1 && errno == ENAMETOOLONG)
     {
 
   res = gethostname (p, len);
   while (res == -1 && errno == ENAMETOOLONG)
     {

-      p = scm_realloc (p, len * 2);

       len *= 2;
       len *= 2;

+
+      /* scm_realloc may throw an exception.  */
+      p = scm_realloc (p, len);

       res = gethostname (p, len);
     }
       res = gethostname (p, len);
     }

+
+#endif
+

   if (res == -1)
     {
   if (res == -1)
     {

+      const int save_errno = errno;
+
+      /* No guile exceptions can occur before we have freed p's memory. */
+      scm_dynwind_end ();

       free (p);
       free (p);

+
+      errno = save_errno;

       SCM_SYSERROR;
     }
       SCM_SYSERROR;
     }

-  name = scm_makfrom0str (p);
-  free (p);
-  return name;
+  else
+    {
+      /* scm_from_locale_string may throw an exception.  */
+      const SCM name = scm_from_locale_string (p);
+
+      /* No guile exceptions can occur before we have freed p's memory. */
+      scm_dynwind_end ();
+      free (p);
+
+      return name;
+    }

 }
 #undef FUNC_NAME
 #endif /* HAVE_GETHOSTNAME */
 
 }
 #undef FUNC_NAME
 #endif /* HAVE_GETHOSTNAME */
 

-void 
+
+void

 scm_init_posix ()
 {
   scm_add_feature ("posix");
 scm_init_posix ()
 {
   scm_add_feature ("posix");


@@ -1674,70 +2201,88 @@ scm_init_posix ()
   scm_add_feature ("EIDs");
 #endif
 #ifdef WAIT_ANY
   scm_add_feature ("EIDs");
 #endif
 #ifdef WAIT_ANY

-  scm_c_define ("WAIT_ANY", SCM_MAKINUM (WAIT_ANY));
+  scm_c_define ("WAIT_ANY", scm_from_int (WAIT_ANY));

 #endif
 #ifdef WAIT_MYPGRP
 #endif
 #ifdef WAIT_MYPGRP

-  scm_c_define ("WAIT_MYPGRP", SCM_MAKINUM (WAIT_MYPGRP));
+  scm_c_define ("WAIT_MYPGRP", scm_from_int (WAIT_MYPGRP));

 #endif
 #ifdef WNOHANG
 #endif
 #ifdef WNOHANG

-  scm_c_define ("WNOHANG", SCM_MAKINUM (WNOHANG));
+  scm_c_define ("WNOHANG", scm_from_int (WNOHANG));

 #endif
 #ifdef WUNTRACED
 #endif
 #ifdef WUNTRACED

-  scm_c_define ("WUNTRACED", SCM_MAKINUM (WUNTRACED));
+  scm_c_define ("WUNTRACED", scm_from_int (WUNTRACED));

 #endif
 
   /* access() symbols.  */
 #endif
 
   /* access() symbols.  */

-  scm_c_define ("R_OK", SCM_MAKINUM (R_OK));
-  scm_c_define ("W_OK", SCM_MAKINUM (W_OK));
-  scm_c_define ("X_OK", SCM_MAKINUM (X_OK));
-  scm_c_define ("F_OK", SCM_MAKINUM (F_OK));
+  scm_c_define ("R_OK", scm_from_int (R_OK));
+  scm_c_define ("W_OK", scm_from_int (W_OK));
+  scm_c_define ("X_OK", scm_from_int (X_OK));
+  scm_c_define ("F_OK", scm_from_int (F_OK));

 
 #ifdef LC_COLLATE
 
 #ifdef LC_COLLATE

-  scm_c_define ("LC_COLLATE", SCM_MAKINUM (LC_COLLATE));
+  scm_c_define ("LC_COLLATE", scm_from_int (LC_COLLATE));

 #endif
 #ifdef LC_CTYPE
 #endif
 #ifdef LC_CTYPE

-  scm_c_define ("LC_CTYPE", SCM_MAKINUM (LC_CTYPE));
+  scm_c_define ("LC_CTYPE", scm_from_int (LC_CTYPE));

 #endif
 #ifdef LC_MONETARY
 #endif
 #ifdef LC_MONETARY

-  scm_c_define ("LC_MONETARY", SCM_MAKINUM (LC_MONETARY));
+  scm_c_define ("LC_MONETARY", scm_from_int (LC_MONETARY));

 #endif
 #ifdef LC_NUMERIC
 #endif
 #ifdef LC_NUMERIC

-  scm_c_define ("LC_NUMERIC", SCM_MAKINUM (LC_NUMERIC));
+  scm_c_define ("LC_NUMERIC", scm_from_int (LC_NUMERIC));

 #endif
 #ifdef LC_TIME
 #endif
 #ifdef LC_TIME

-  scm_c_define ("LC_TIME", SCM_MAKINUM (LC_TIME));
+  scm_c_define ("LC_TIME", scm_from_int (LC_TIME));

 #endif
 #ifdef LC_MESSAGES
 #endif
 #ifdef LC_MESSAGES

-  scm_c_define ("LC_MESSAGES", SCM_MAKINUM (LC_MESSAGES));
+  scm_c_define ("LC_MESSAGES", scm_from_int (LC_MESSAGES));

 #endif
 #ifdef LC_ALL
 #endif
 #ifdef LC_ALL

-  scm_c_define ("LC_ALL", SCM_MAKINUM (LC_ALL));
+  scm_c_define ("LC_ALL", scm_from_int (LC_ALL));
+#endif
+#ifdef LC_PAPER
+  scm_c_define ("LC_PAPER", scm_from_int (LC_PAPER));
+#endif
+#ifdef LC_NAME
+  scm_c_define ("LC_NAME", scm_from_int (LC_NAME));
+#endif
+#ifdef LC_ADDRESS
+  scm_c_define ("LC_ADDRESS", scm_from_int (LC_ADDRESS));
+#endif
+#ifdef LC_TELEPHONE
+  scm_c_define ("LC_TELEPHONE", scm_from_int (LC_TELEPHONE));
+#endif
+#ifdef LC_MEASUREMENT
+  scm_c_define ("LC_MEASUREMENT", scm_from_int (LC_MEASUREMENT));
+#endif
+#ifdef LC_IDENTIFICATION
+  scm_c_define ("LC_IDENTIFICATION", scm_from_int (LC_IDENTIFICATION));

 #endif
 #ifdef PIPE_BUF
 #endif
 #ifdef PIPE_BUF

-  scm_c_define ("PIPE_BUF", scm_long2num (PIPE_BUF));
+  scm_c_define ("PIPE_BUF", scm_from_long (PIPE_BUF));

 #endif
 
 #ifdef PRIO_PROCESS
 #endif
 
 #ifdef PRIO_PROCESS

-  scm_c_define ("PRIO_PROCESS", SCM_MAKINUM (PRIO_PROCESS));
+  scm_c_define ("PRIO_PROCESS", scm_from_int (PRIO_PROCESS));

 #endif
 #ifdef PRIO_PGRP
 #endif
 #ifdef PRIO_PGRP

-  scm_c_define ("PRIO_PGRP", SCM_MAKINUM (PRIO_PGRP));
+  scm_c_define ("PRIO_PGRP", scm_from_int (PRIO_PGRP));

 #endif
 #ifdef PRIO_USER
 #endif
 #ifdef PRIO_USER

-  scm_c_define ("PRIO_USER", SCM_MAKINUM (PRIO_USER));
+  scm_c_define ("PRIO_USER", scm_from_int (PRIO_USER));

 #endif
 
 #ifdef LOCK_SH
 #endif
 
 #ifdef LOCK_SH

-  scm_c_define ("LOCK_SH", SCM_MAKINUM (LOCK_SH));
+  scm_c_define ("LOCK_SH", scm_from_int (LOCK_SH));

 #endif
 #ifdef LOCK_EX
 #endif
 #ifdef LOCK_EX

-  scm_c_define ("LOCK_EX", SCM_MAKINUM (LOCK_EX));
+  scm_c_define ("LOCK_EX", scm_from_int (LOCK_EX));

 #endif
 #ifdef LOCK_UN
 #endif
 #ifdef LOCK_UN

-  scm_c_define ("LOCK_UN", SCM_MAKINUM (LOCK_UN));
+  scm_c_define ("LOCK_UN", scm_from_int (LOCK_UN));

 #endif
 #ifdef LOCK_NB
 #endif
 #ifdef LOCK_NB

-  scm_c_define ("LOCK_NB", SCM_MAKINUM (LOCK_NB));
+  scm_c_define ("LOCK_NB", scm_from_int (LOCK_NB));

 #endif
 
 #include "libguile/cpp_sig_symbols.c"
 #endif
 
 #include "libguile/cpp_sig_symbols.c"