libguile/posix.c

   1 /*      Copyright (C) 1995, 1996, 1997, 1998 Free Software Foundation, Inc.
   2  *
   3  * This program is free software; you can redistribute it and/or modify
   4  * it under the terms of the GNU General Public License as published by
   5  * the Free Software Foundation; either version 2, or (at your option)
   6  * any later version.
   7  *
   8  * This program is distributed in the hope that it will be useful,
   9  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  10  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  11  * GNU General Public License for more details.
  12  *
  13  * You should have received a copy of the GNU General Public License
  14  * along with this software; see the file COPYING.  If not, write to
  15  * the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
  16  * Boston, MA 02111-1307 USA
  17  *
  18  * As a special exception, the Free Software Foundation gives permission
  19  * for additional uses of the text contained in its release of GUILE.
  20  *
  21  * The exception is that, if you link the GUILE library with other files
  22  * to produce an executable, this does not by itself cause the
  23  * resulting executable to be covered by the GNU General Public License.
  24  * Your use of that executable is in no way restricted on account of
  25  * linking the GUILE library code into it.
  26  *
  27  * This exception does not however invalidate any other reasons why
  28  * the executable file might be covered by the GNU General Public License.
  29  *
  30  * This exception applies only to the code released by the
  31  * Free Software Foundation under the name GUILE.  If you copy
  32  * code from other Free Software Foundation releases into a copy of
  33  * GUILE, as the General Public License permits, the exception does
  34  * not apply to the code that you add in this way.  To avoid misleading
  35  * anyone as to the status of such modified files, you must delete
  36  * this exception notice from them.
  37  *
  38  * If you write modifications of your own for GUILE, it is your choice
  39  * whether to permit this exception to apply to your modifications.
  40  * If you do not wish that, delete this exception notice.  */
  41
  42 /* Software engineering face-lift by Greg J. Badros, 11-Dec-1999,
  43    gjb@cs.washington.edu, http://www.cs.washington.edu/homes/gjb */
  44
  45 \f
  46
  47 #include <stdio.h>
  48 #include "_scm.h"
  49 #include "fports.h"
  50 #include "scmsigs.h"
  51 #include "feature.h"
  52
  53 #include "scm_validate.h"
  54 #include "posix.h"
  55 \f
  56
  57 #ifdef HAVE_STRING_H
  58 #include <string.h>
  59 #endif
  60 #ifdef TIME_WITH_SYS_TIME
  61 # include <sys/time.h>
  62 # include <time.h>
  63 #else
  64 # if HAVE_SYS_TIME_H
  65 #  include <sys/time.h>
  66 # else
  67 #  include <time.h>
  68 # endif
  69 #endif
  70
  71 #ifdef HAVE_UNISTD_H
  72 #include <unistd.h>
  73 #else
  74 #ifndef ttyname
  75 extern char *ttyname();
  76 #endif
  77 #endif
  78
  79 #ifdef LIBC_H_WITH_UNISTD_H
  80 #include <libc.h>
  81 #endif
  82
  83 #include <sys/types.h>
  84 #include <sys/stat.h>
  85 #include <fcntl.h>
  86
  87 #include <pwd.h>
  88
  89 #if HAVE_SYS_WAIT_H
  90 # include <sys/wait.h>
  91 #endif
  92 #ifndef WEXITSTATUS
  93 # define WEXITSTATUS(stat_val) ((unsigned)(stat_val) >> 8)
  94 #endif
  95 #ifndef WIFEXITED
  96 # define WIFEXITED(stat_val) (((stat_val) & 255) == 0)
  97 #endif
  98
  99 #include <signal.h>
 100
 101 extern FILE *popen ();
 102 extern char ** environ;
 103
 104 #include <grp.h>
 105 #include <sys/utsname.h>
 106
 107 #if HAVE_DIRENT_H
 108 # include <dirent.h>
 109 # define NAMLEN(dirent) strlen((dirent)->d_name)
 110 #else
 111 # define dirent direct
 112 # define NAMLEN(dirent) (dirent)->d_namlen
 113 # if HAVE_SYS_NDIR_H
 114 #  include <sys/ndir.h>
 115 # endif
 116 # if HAVE_SYS_DIR_H
 117 #  include <sys/dir.h>
 118 # endif
 119 # if HAVE_NDIR_H
 120 #  include <ndir.h>
 121 # endif
 122 #endif
 123
 124 #ifdef HAVE_SETLOCALE
 125 #include <locale.h>
 126 #endif
 127
 128 /* Some Unix systems don't define these.  CPP hair is dangerous, but
 129    this seems safe enough... */
 130 #ifndef R_OK
 131 #define R_OK 4
 132 #endif
 133
 134 #ifndef W_OK
 135 #define W_OK 2
 136 #endif
 137
 138 #ifndef X_OK
 139 #define X_OK 1
 140 #endif
 141
 142 #ifndef F_OK
 143 #define F_OK 0
 144 #endif
 145
 146 /* On NextStep, <utime.h> doesn't define struct utime, unless we
 147    #define _POSIX_SOURCE before #including it.  I think this is less
 148    of a kludge than defining struct utimbuf ourselves.  */
 149 #ifdef UTIMBUF_NEEDS_POSIX
 150 #define _POSIX_SOURCE
 151 #endif
 152
 153 #ifdef HAVE_SYS_UTIME_H
 154 #include <sys/utime.h>
 155 #endif
 156
 157 #ifdef HAVE_UTIME_H
 158 #include <utime.h>
 159 #endif
 160
 161 /* Please don't add any more #includes or #defines here.  The hack
 162    above means that _POSIX_SOURCE may be #defined, which will
 163    encourage header files to do strange things.  */
 164
 165 \f
 166 SCM_SYMBOL (sym_read_pipe, "read pipe");
 167 SCM_SYMBOL (sym_write_pipe, "write pipe");
 168
 169 GUILE_PROC (scm_pipe, "pipe", 0, 0, 0,
 170             (),
 171 "Creates a pipe which can be used for communication.  The return value
 172 is a pair in which the CAR contains an input port and the CDR an
 173 output port.  Data written to the output port can be read from the
 174 input port.  Note that both ports are buffered so it may be necessary
 175 to flush the output port before data will actually be sent across the pipe.
 176 Alternatively a buffer can be added to the port using @code{setvbuf}
 177 (see below).")
 178 #define FUNC_NAME s_scm_pipe
 179 {
 180   int fd[2], rv;
 181   SCM p_rd, p_wt;
 182
 183   rv = pipe (fd);
 184   if (rv)
 185     SCM_SYSERROR;
 186
 187   p_rd = scm_fdes_to_port (fd[0], "r", sym_read_pipe);
 188   p_wt = scm_fdes_to_port (fd[1], "w", sym_write_pipe);
 189   return scm_cons (p_rd, p_wt);
 190 }
 191 #undef FUNC_NAME
 192
 193
 194 #ifdef HAVE_GETGROUPS
 195 GUILE_PROC (scm_getgroups, "getgroups", 0, 0, 0,
 196             (),
 197 "Returns a vector of integers representing the current supplimentary group IDs.")
 198 #define FUNC_NAME s_scm_getgroups
 199 {
 200   SCM grps, ans;
 201   int ngroups = getgroups (0, NULL);
 202   if (!ngroups)
 203     SCM_SYSERROR;
 204   SCM_NEWCELL(grps);
 205   SCM_DEFER_INTS;
 206   {
 207     GETGROUPS_T *groups;
 208     int val;
 209
 210     groups = SCM_MUST_MALLOC_TYPE_NUM(GETGROUPS_T,ngroups);
 211     val = getgroups(ngroups, groups);
 212     if (val < 0)
 213       {
 214         int en = errno;
 215         scm_must_free((char *)groups);
 216         errno = en;
 217         SCM_SYSERROR;
 218       }
 219     SCM_SETCHARS(grps, groups); /* set up grps as a GC protect */
 220     SCM_SETLENGTH(grps, 0L + ngroups * sizeof(GETGROUPS_T), scm_tc7_string);
 221     ans = scm_make_vector (SCM_MAKINUM(ngroups), SCM_UNDEFINED);
 222     while (--ngroups >= 0) SCM_VELTS(ans)[ngroups] = SCM_MAKINUM(groups[ngroups]);
 223     SCM_SETCHARS(grps, groups); /* to make sure grps stays around. */
 224     SCM_ALLOW_INTS;
 225     return ans;
 226   }
 227 }
 228 #undef FUNC_NAME
 229 #endif
 230
 231
 232 GUILE_PROC (scm_getpwuid, "getpw", 0, 1, 0,
 233             (SCM user),
 234 "Look up an entry in the user database.  @var{obj} can be an integer,
 235 a string, or omitted, giving the behaviour of getpwuid, getpwnam
 236 or getpwent respectively.")
 237 #define FUNC_NAME s_scm_getpwuid
 238 {
 239   SCM result;
 240   struct passwd *entry;
 241   SCM *ve;
 242
 243   result = scm_make_vector (SCM_MAKINUM (7), SCM_UNSPECIFIED);
 244   ve = SCM_VELTS (result);
 245   if (SCM_UNBNDP (user) || SCM_FALSEP (user))
 246     {
 247       SCM_SYSCALL (entry = getpwent ());
 248       if (! entry)
 249         {
 250           return SCM_BOOL_F;
 251         }
 252     }
 253   else if (SCM_INUMP (user))
 254     {
 255       entry = getpwuid (SCM_INUM (user));
 256     }
 257   else
 258     {
 259       SCM_VALIDATE_ROSTRING(1,user);
 260       if (SCM_SUBSTRP (user))
 261         user = scm_makfromstr (SCM_ROCHARS (user), SCM_ROLENGTH (user), 0);
 262       entry = getpwnam (SCM_ROCHARS (user));
 263     }
 264   if (!entry)
 265     SCM_MISC_ERROR ("entry not found", SCM_EOL);
 266
 267   ve[0] = scm_makfrom0str (entry->pw_name);
 268   ve[1] = scm_makfrom0str (entry->pw_passwd);
 269   ve[2] = scm_ulong2num ((unsigned long) entry->pw_uid);
 270   ve[3] = scm_ulong2num ((unsigned long) entry->pw_gid);
 271   ve[4] = scm_makfrom0str (entry->pw_gecos);
 272   if (!entry->pw_dir)
 273     ve[5] = scm_makfrom0str ("");
 274   else
 275     ve[5] = scm_makfrom0str (entry->pw_dir);
 276   if (!entry->pw_shell)
 277     ve[6] = scm_makfrom0str ("");
 278   else
 279     ve[6] = scm_makfrom0str (entry->pw_shell);
 280   return result;
 281 }
 282 #undef FUNC_NAME
 283
 284
 285 #ifdef HAVE_SETPWENT
 286 GUILE_PROC (scm_setpwent, "setpw", 0, 1, 0,
 287             (SCM arg),
 288 "If called with a true argument, initialize or reset the password data
 289 stream.  Otherwise, close the stream.  The @code{setpwent} and
 290 @code{endpwent} procedures are implemented on top of this.")
 291 #define FUNC_NAME s_scm_setpwent
 292 {
 293   if (SCM_UNBNDP (arg) || SCM_FALSEP (arg))
 294     endpwent ();
 295   else
 296     setpwent ();
 297   return SCM_UNSPECIFIED;
 298 }
 299 #undef FUNC_NAME
 300 #endif
 301
 302
 303
 304 /* Combines getgrgid and getgrnam.  */
 305 GUILE_PROC (scm_getgrgid, "getgr", 0, 1, 0,
 306             (SCM name),
 307 "Look up an entry in the group database.  @var{obj} can be an integer,
 308 a string, or omitted, giving the behaviour of getgrgid, getgrnam
 309 or getgrent respectively.")
 310 #define FUNC_NAME s_scm_getgrgid
 311 {
 312   SCM result;
 313   struct group *entry;
 314   SCM *ve;
 315   result = scm_make_vector (SCM_MAKINUM (4), SCM_UNSPECIFIED);
 316   ve = SCM_VELTS (result);
 317   if (SCM_UNBNDP (name) || (name == SCM_BOOL_F))
 318     {
 319       SCM_SYSCALL (entry = getgrent ());
 320       if (! entry)
 321         {
 322           return SCM_BOOL_F;
 323         }
 324     }
 325   else if (SCM_INUMP (name))
 326     SCM_SYSCALL (entry = getgrgid (SCM_INUM (name)));
 327   else
 328     {
 329       SCM_VALIDATE_ROSTRING(1,name);
 330       SCM_COERCE_SUBSTR (name);
 331       SCM_SYSCALL (entry = getgrnam (SCM_ROCHARS (name)));
 332     }
 333   if (!entry)
 334     SCM_SYSERROR;
 335
 336   ve[0] = scm_makfrom0str (entry->gr_name);
 337   ve[1] = scm_makfrom0str (entry->gr_passwd);
 338   ve[2] = scm_ulong2num ((unsigned long) entry->gr_gid);
 339   ve[3] = scm_makfromstrs (-1, entry->gr_mem);
 340   return result;
 341 }
 342 #undef FUNC_NAME
 343
 344
 345
 346 GUILE_PROC (scm_setgrent, "setgr", 0, 1, 0,
 347             (SCM arg),
 348 "If called with a true argument, initialize or reset the group data
 349 stream.  Otherwise, close the stream.  The @code{setgrent} and
 350 @code{endgrent} procedures are implemented on top of this.")
 351 #define FUNC_NAME s_scm_setgrent
 352 {
 353   if (SCM_UNBNDP (arg) || SCM_FALSEP (arg))
 354     endgrent ();
 355   else
 356     setgrent ();
 357   return SCM_UNSPECIFIED;
 358 }
 359 #undef FUNC_NAME
 360
 361
 362
 363 GUILE_PROC (scm_kill, "kill", 2, 0, 0,
 364             (SCM pid, SCM sig),
 365 "Sends a signal to the specified process or group of processes.
 366
 367 @var{pid} specifies the processes to which the signal is sent:
 368
 369 @table @r
 370 @item @var{pid} greater than 0
 371 The process whose identifier is @var{pid}.
 372 @item @var{pid} equal to 0
 373 All processes in the current process group.
 374 @item @var{pid} less than -1
 375 The process group whose identifier is -@var{pid}
 376 @item @var{pid} equal to -1
 377 If the process is privileged, all processes except for some special
 378 system processes.  Otherwise, all processes with the current effective
 379 user ID.
 380 @end table
 381
 382 @var{sig} should be specified using a variable corresponding to
 383 the Unix symbolic name, e.g.,
 384
 385 @defvar SIGHUP
 386 Hang-up signal.
 387 @end defvar
 388
 389 @defvar SIGINT
 390 Interrupt signal.
 391 @end defvar")
 392 #define FUNC_NAME s_scm_kill
 393 {
 394   SCM_VALIDATE_INUM(1,pid);
 395   SCM_VALIDATE_INUM(2,sig);
 396   /* Signal values are interned in scm_init_posix().  */
 397   if (kill ((int) SCM_INUM (pid), (int) SCM_INUM (sig)) != 0)
 398     SCM_SYSERROR;
 399   return SCM_UNSPECIFIED;
 400 }
 401 #undef FUNC_NAME
 402
 403 #ifdef HAVE_WAITPID
 404 GUILE_PROC (scm_waitpid, "waitpid", 1, 1, 0,
 405             (SCM pid, SCM options),
 406 "This procedure collects status information from a child process which
 407 has terminated or (optionally) stopped.  Normally it will
 408 suspend the calling process until this can be done.  If more than one
 409 child process is eligible then one will be chosen by the operating system.
 410
 411 The value of @var{pid} determines the behaviour:
 412
 413 @table @r
 414 @item @var{pid} greater than 0
 415 Request status information from the specified child process.
 416 @item @var{pid} equal to -1 or WAIT_ANY
 417 Request status information for any child process.
 418 @item @var{pid} equal to 0 or WAIT_MYPGRP
 419 Request status information for any child process in the current process
 420 group.
 421 @item @var{pid} less than -1
 422 Request status information for any child process whose process group ID
 423 is -@var{PID}.
 424 @end table
 425
 426 The @var{options} argument, if supplied, should be the bitwise OR of the
 427 values of zero or more of the following variables:
 428
 429 @defvar WNOHANG
 430 Return immediately even if there are no child processes to be collected.
 431 @end defvar
 432
 433 @defvar WUNTRACED
 434 Report status information for stopped processes as well as terminated
 435 processes.
 436 @end defvar
 437
 438 The return value is a pair containing:
 439
 440 @enumerate
 441 @item
 442 The process ID of the child process, or 0 if @code{WNOHANG} was
 443 specified and no process was collected.
 444 @item
 445 The integer status value.
 446 @end enumerate")
 447 #define FUNC_NAME s_scm_waitpid
 448 {
 449   int i;
 450   int status;
 451   int ioptions;
 452   SCM_VALIDATE_INUM(1,pid);
 453   if (SCM_UNBNDP (options))
 454     ioptions = 0;
 455   else
 456     {
 457       SCM_VALIDATE_INUM(2,options);
 458       /* Flags are interned in scm_init_posix.  */
 459       ioptions = SCM_INUM (options);
 460     }
 461   SCM_SYSCALL (i = waitpid (SCM_INUM (pid), &status, ioptions));
 462   if (i == -1)
 463     SCM_SYSERROR;
 464   return scm_cons (SCM_MAKINUM (0L + i), SCM_MAKINUM (0L + status));
 465 }
 466 #undef FUNC_NAME
 467 #endif /* HAVE_WAITPID */
 468
 469 GUILE_PROC (scm_status_exit_val, "status:exit-val", 1, 0, 0,
 470             (SCM status),
 471 "Returns the exit status value, as would be
 472 set if a process ended normally through a
 473 call to @code{exit} or @code{_exit}, if any, otherwise @code{#f}.")
 474 #define FUNC_NAME s_scm_status_exit_val
 475 {
 476   int lstatus;
 477
 478   SCM_VALIDATE_INUM(1,status);
 479
 480   /* On Ultrix, the WIF... macros assume their argument is an lvalue;
 481      go figure.  SCM_INUM does not yield an lvalue.  */
 482   lstatus = SCM_INUM (status);
 483   if (WIFEXITED (lstatus))
 484     return (SCM_MAKINUM (WEXITSTATUS (lstatus)));
 485   else
 486     return SCM_BOOL_F;
 487 }
 488 #undef FUNC_NAME
 489
 490 GUILE_PROC (scm_status_term_sig, "status:term-sig", 1, 0, 0,
 491             (SCM status),
 492 "Returns the signal number which terminated the
 493 process, if any, otherwise @code{#f}.")
 494 #define FUNC_NAME s_scm_status_term_sig
 495 {
 496   int lstatus;
 497
 498   SCM_VALIDATE_INUM(1,status);
 499
 500   lstatus = SCM_INUM (status);
 501   if (WIFSIGNALED (lstatus))
 502     return SCM_MAKINUM (WTERMSIG (lstatus));
 503   else
 504     return SCM_BOOL_F;
 505 }
 506 #undef FUNC_NAME
 507
 508 GUILE_PROC (scm_status_stop_sig, "status:stop-sig", 1, 0, 0,
 509             (SCM status),
 510 "Returns the signal number which stopped the
 511 process, if any, otherwise @code{#f}.")
 512 #define FUNC_NAME s_scm_status_stop_sig
 513 {
 514   int lstatus;
 515
 516   SCM_VALIDATE_INUM(1,status);
 517
 518   lstatus = SCM_INUM (status);
 519   if (WIFSTOPPED (lstatus))
 520     return SCM_MAKINUM (WSTOPSIG (lstatus));
 521   else
 522     return SCM_BOOL_F;
 523 }
 524 #undef FUNC_NAME
 525
 526 GUILE_PROC (scm_getppid, "getppid", 0, 0, 0,
 527             (),
 528 "Returns an integer representing the process ID of the parent process.")
 529 #define FUNC_NAME s_scm_getppid
 530 {
 531   return SCM_MAKINUM (0L + getppid ());
 532 }
 533 #undef FUNC_NAME
 534
 535
 536
 537 GUILE_PROC (scm_getuid, "getuid", 0, 0, 0,
 538             (),
 539 "Returns an integer representing the current real user ID.")
 540 #define FUNC_NAME s_scm_getuid
 541 {
 542   return SCM_MAKINUM (0L + getuid ());
 543 }
 544 #undef FUNC_NAME
 545
 546
 547
 548 GUILE_PROC (scm_getgid, "getgid", 0, 0, 0,
 549             (),
 550 "Returns an integer representing the current real group ID.")
 551 #define FUNC_NAME s_scm_getgid
 552 {
 553   return SCM_MAKINUM (0L + getgid ());
 554 }
 555 #undef FUNC_NAME
 556
 557
 558
 559 GUILE_PROC (scm_geteuid, "geteuid", 0, 0, 0,
 560             (),
 561 "Returns an integer representing the current effective user ID.
 562 If the system does not support effective IDs, then the real ID
 563 is returned.  @code{(feature? 'EIDs)} reports whether the system
 564 supports effective IDs.")
 565 #define FUNC_NAME s_scm_geteuid
 566 {
 567 #ifdef HAVE_GETEUID
 568   return SCM_MAKINUM (0L + geteuid ());
 569 #else
 570   return SCM_MAKINUM (0L + getuid ());
 571 #endif
 572 }
 573 #undef FUNC_NAME
 574
 575
 576
 577 GUILE_PROC (scm_getegid, "getegid", 0, 0, 0,
 578             (),
 579 "Returns an integer representing the current effective group ID.
 580 If the system does not support effective IDs, then the real ID
 581 is returned.  @code{(feature? 'EIDs)} reports whether the system
 582 supports effective IDs.")
 583 #define FUNC_NAME s_scm_getegid
 584 {
 585 #ifdef HAVE_GETEUID
 586   return SCM_MAKINUM (0L + getegid ());
 587 #else
 588   return SCM_MAKINUM (0L + getgid ());
 589 #endif
 590 }
 591 #undef FUNC_NAME
 592
 593
 594 GUILE_PROC (scm_setuid, "setuid", 1, 0, 0,
 595             (SCM id),
 596 "Sets both the real and effective user IDs to the integer @var{id}, provided
 597 the process has appropriate privileges.
 598 The return value is unspecified.")
 599 #define FUNC_NAME s_scm_setuid
 600 {
 601   SCM_VALIDATE_INUM(1,id);
 602   if (setuid (SCM_INUM (id)) != 0)
 603     SCM_SYSERROR;
 604   return SCM_UNSPECIFIED;
 605 }
 606 #undef FUNC_NAME
 607
 608 GUILE_PROC (scm_setgid, "setgid", 1, 0, 0,
 609             (SCM id),
 610 "Sets both the real and effective group IDs to the integer @var{id}, provided
 611 the process has appropriate privileges.
 612 The return value is unspecified.")
 613 #define FUNC_NAME s_scm_setgid
 614 {
 615   SCM_VALIDATE_INUM(1,id);
 616   if (setgid (SCM_INUM (id)) != 0)
 617     SCM_SYSERROR;
 618   return SCM_UNSPECIFIED;
 619 }
 620 #undef FUNC_NAME
 621
 622 GUILE_PROC (scm_seteuid, "seteuid", 1, 0, 0,
 623             (SCM id),
 624 "Sets the effective user ID to the integer @var{id}, provided the process
 625 has appropriate privileges.  If effective IDs are not supported, the
 626 real ID is set instead -- @code{(feature? 'EIDs)} reports whether the
 627 system supports effective IDs.
 628 The return value is unspecified.")
 629 #define FUNC_NAME s_scm_seteuid
 630 {
 631   int rv;
 632
 633   SCM_VALIDATE_INUM(1,id);
 634 #ifdef HAVE_SETEUID
 635   rv = seteuid (SCM_INUM (id));
 636 #else
 637   rv = setuid (SCM_INUM (id));
 638 #endif
 639   if (rv != 0)
 640     SCM_SYSERROR;
 641   return SCM_UNSPECIFIED;
 642 }
 643 #undef FUNC_NAME
 644
 645 #ifdef HAVE_SETEGID
 646 GUILE_PROC (scm_setegid, "setegid", 1, 0, 0,
 647             (SCM id),
 648 "Sets the effective group ID to the integer @var{id}, provided the process
 649 has appropriate privileges.  If effective IDs are not supported, the
 650 real ID is set instead -- @code{(feature? 'EIDs)} reports whether the
 651 system supports effective IDs.
 652 The return value is unspecified.")
 653 #define FUNC_NAME s_scm_setegid
 654 {
 655   int rv;
 656
 657   SCM_VALIDATE_INUM(1,id);
 658 #ifdef HAVE_SETEUID
 659   rv = setegid (SCM_INUM (id));
 660 #else
 661   rv = setgid (SCM_INUM (id));
 662 #endif
 663   if (rv != 0)
 664     SCM_SYSERROR;
 665   return SCM_UNSPECIFIED;
 666
 667 }
 668 #undef FUNC_NAME
 669 #endif
 670
 671 GUILE_PROC (scm_getpgrp, "getpgrp", 0, 0, 0,
 672             (),
 673 "Returns an integer representing the current process group ID.
 674 This is the POSIX definition, not BSD.")
 675 #define FUNC_NAME s_scm_getpgrp
 676 {
 677   int (*fn)();
 678   fn = (int (*) ()) getpgrp;
 679   return SCM_MAKINUM (fn (0));
 680 }
 681 #undef FUNC_NAME
 682
 683 GUILE_PROC (scm_setpgid, "setpgid", 2, 0, 0,
 684             (SCM pid, SCM pgid),
 685 "Move the process @var{pid} into the process group @var{pgid}.  @var{pid} or
 686 @var{pgid} must be integers: they can be zero to indicate the ID of the
 687 current process.
 688 Fails on systems that do not support job control.
 689 The return value is unspecified.")
 690 #define FUNC_NAME s_scm_setpgid
 691 {
 692 #ifdef HAVE_SETPGID
 693   SCM_VALIDATE_INUM(1,pid);
 694   SCM_VALIDATE_INUM(2,pgid);
 695   /* FIXME(?): may be known as setpgrp.  */
 696   if (setpgid (SCM_INUM (pid), SCM_INUM (pgid)) != 0)
 697     SCM_SYSERROR;
 698   return SCM_UNSPECIFIED;
 699 #else
 700   SCM_SYSMISSING;
 701   /* not reached.  */
 702   return SCM_BOOL_F;
 703 #endif
 704 }
 705 #undef FUNC_NAME
 706
 707 GUILE_PROC (scm_setsid, "setsid", 0, 0, 0,
 708             (),
 709 "Creates a new session.  The current process becomes the session leader
 710 and is put in a new process group.  The process will be detached
 711 from its controlling terminal if it has one.
 712 The return value is an integer representing the new process group ID.")
 713 #define FUNC_NAME s_scm_setsid
 714 {
 715 #ifdef HAVE_SETSID
 716   pid_t sid = setsid ();
 717   if (sid == -1)
 718     SCM_SYSERROR;
 719   return SCM_UNSPECIFIED;
 720 #else
 721   SCM_SYSMISSING;
 722   /* not reached.  */
 723   return SCM_BOOL_F;
 724 #endif
 725 }
 726 #undef FUNC_NAME
 727
 728 GUILE_PROC (scm_ttyname, "ttyname", 1, 0, 0,
 729             (SCM port),
 730 "Returns a string with the name of the serial terminal device underlying
 731 @var{port}.")
 732 #define FUNC_NAME s_scm_ttyname
 733 {
 734   char *ans;
 735   int fd;
 736
 737   port = SCM_COERCE_OUTPORT (port);
 738   SCM_VALIDATE_OPPORT(1,port);
 739   if (scm_tc16_fport != SCM_TYP16 (port))
 740     return SCM_BOOL_F;
 741   fd = SCM_FPORT_FDES (port);
 742   SCM_SYSCALL (ans = ttyname (fd));
 743   if (!ans)
 744     SCM_SYSERROR;
 745   /* ans could be overwritten by another call to ttyname */
 746   return (scm_makfrom0str (ans));
 747 }
 748 #undef FUNC_NAME
 749
 750
 751 GUILE_PROC (scm_ctermid, "ctermid", 0, 0, 0,
 752             (),
 753 "Returns a string containing the file name of the controlling terminal
 754 for the current process.")
 755 #define FUNC_NAME s_scm_ctermid
 756 {
 757 #ifdef HAVE_CTERMID
 758   char *result = ctermid (NULL);
 759   if (*result == '\0')
 760     SCM_SYSERROR;
 761   return scm_makfrom0str (result);
 762 #else
 763   SCM_SYSMISSING;
 764   /* not reached.  */
 765   return SCM_BOOL_F;
 766 #endif
 767 }
 768 #undef FUNC_NAME
 769
 770 GUILE_PROC (scm_tcgetpgrp, "tcgetpgrp", 1, 0, 0,
 771             (SCM port),
 772 "Returns the process group ID of the foreground
 773 process group associated with the terminal open on the file descriptor
 774 underlying @var{port}.
 775
 776 If there is no foreground process group, the return value is a
 777 number greater than 1 that does not match the process group ID
 778 of any existing process group.  This can happen if all of the
 779 processes in the job that was formerly the foreground job have
 780 terminated, and no other job has yet been moved into the
 781 foreground.")
 782 #define FUNC_NAME s_scm_tcgetpgrp
 783 {
 784 #ifdef HAVE_TCGETPGRP
 785   int fd;
 786   pid_t pgid;
 787
 788   port = SCM_COERCE_OUTPORT (port);
 789
 790   SCM_VALIDATE_OPFPORT(1,port);
 791   fd = SCM_FPORT_FDES (port);
 792   if ((pgid = tcgetpgrp (fd)) == -1)
 793     SCM_SYSERROR;
 794   return SCM_MAKINUM (pgid);
 795 #else
 796   SCM_SYSMISSING;
 797   /* not reached.  */
 798   return SCM_BOOL_F;
 799 #endif
 800 }
 801 #undef FUNC_NAME
 802
 803 GUILE_PROC (scm_tcsetpgrp, "tcsetpgrp", 2, 0, 0,
 804             (SCM port, SCM pgid),
 805 "Set the foreground process group ID for the terminal used by the file
 806 descriptor underlying @var{port} to the integer @var{pgid}.
 807 The calling process
 808 must be a member of the same session as @var{pgid} and must have the same
 809 controlling terminal.  The return value is unspecified.")
 810 #define FUNC_NAME s_scm_tcsetpgrp
 811 {
 812 #ifdef HAVE_TCSETPGRP
 813   int fd;
 814
 815   port = SCM_COERCE_OUTPORT (port);
 816
 817   SCM_VALIDATE_OPFPORT(1,port);
 818   SCM_VALIDATE_INUM(2,pgid);
 819   fd = SCM_FPORT_FDES (port);
 820   if (tcsetpgrp (fd, SCM_INUM (pgid)) == -1)
 821     SCM_SYSERROR;
 822   return SCM_UNSPECIFIED;
 823 #else
 824   SCM_SYSMISSING;
 825   /* not reached.  */
 826   return SCM_BOOL_F;
 827 #endif
 828 }
 829 #undef FUNC_NAME
 830
 831
 832 /* Copy exec args from an SCM vector into a new C array.  */
 833
 834 static char **
 835 scm_convert_exec_args (SCM args, int pos, const char *subr)
 836 {
 837   char **execargv;
 838   int num_args;
 839   int i;
 840
 841   SCM_ASSERT (SCM_NULLP (args)
 842               || (SCM_CONSP (args)),
 843               args, pos, subr);
 844   num_args = scm_ilength (args);
 845   execargv = (char **)
 846     scm_must_malloc ((num_args + 1) * sizeof (char *), subr);
 847   for (i = 0; SCM_NNULLP (args); args = SCM_CDR (args), ++i)
 848     {
 849       scm_sizet len;
 850       char *dst;
 851       char *src;
 852       SCM_ASSERT (SCM_ROSTRINGP (SCM_CAR (args)),
 853                   SCM_CAR (args), SCM_ARGn, subr);
 854       len = 1 + SCM_ROLENGTH (SCM_CAR (args));
 855       dst = (char *) scm_must_malloc ((long) len, subr);
 856       src = SCM_ROCHARS (SCM_CAR (args));
 857       while (len--)
 858         dst[len] = src[len];
 859       execargv[i] = dst;
 860     }
 861   execargv[i] = 0;
 862   return execargv;
 863 }
 864
 865 GUILE_PROC (scm_execl, "execl", 1, 0, 1,
 866             (SCM filename, SCM args),
 867 "Executes the file named by @var{path} as a new process image.
 868 The remaining arguments are supplied to the process; from a C program
 869 they are accessable as the @code{argv} argument to @code{main}.
 870 Conventionally the first @var{arg} is the same as @var{path}.
 871 All arguments must be strings.
 872
 873 If @var{arg} is missing, @var{path} is executed with a null
 874 argument list, which may have system-dependent side-effects.
 875
 876 This procedure is currently implemented using the @code{execv} system
 877 call, but we call it @code{execl} because of its Scheme calling interface.")
 878 #define FUNC_NAME s_scm_execl
 879 {
 880   char **execargv;
 881   SCM_VALIDATE_ROSTRING(1,filename);
 882   SCM_COERCE_SUBSTR (filename);
 883   execargv = scm_convert_exec_args (args, SCM_ARG2, FUNC_NAME);
 884   execv (SCM_ROCHARS (filename), execargv);
 885   SCM_SYSERROR;
 886   /* not reached.  */
 887   return SCM_BOOL_F;
 888 }
 889 #undef FUNC_NAME
 890
 891 GUILE_PROC (scm_execlp, "execlp", 1, 0, 1,
 892             (SCM filename, SCM args),
 893 "Similar to @code{execl}, however if
 894 @var{filename} does not contain a slash
 895 then the file to execute will be located by searching the
 896 directories listed in the @code{PATH} environment variable.
 897
 898 This procedure is currently implemented using the @code{execlv} system
 899 call, but we call it @code{execlp} because of its Scheme calling interface.")
 900 #define FUNC_NAME s_scm_execlp
 901 {
 902   char **execargv;
 903   SCM_VALIDATE_ROSTRING(1,filename);
 904   SCM_COERCE_SUBSTR (filename);
 905   execargv = scm_convert_exec_args (args, SCM_ARG2, FUNC_NAME);
 906   execvp (SCM_ROCHARS (filename), execargv);
 907   SCM_SYSERROR;
 908   /* not reached.  */
 909   return SCM_BOOL_F;
 910 }
 911 #undef FUNC_NAME
 912
 913 static char **
 914 environ_list_to_c (SCM envlist, int arg, const char *proc)
 915 {
 916   int num_strings;
 917   char **result;
 918   int i = 0;
 919
 920   SCM_ASSERT (SCM_NULLP (envlist) || SCM_CONSP (envlist),
 921               envlist, arg, proc);
 922   num_strings = scm_ilength (envlist);
 923   result = (char **) malloc ((num_strings + 1) * sizeof (char *));
 924   if (result == NULL)
 925     scm_memory_error (proc);
 926   while (SCM_NNULLP (envlist))
 927     {
 928       int len;
 929       char *src;
 930
 931       SCM_ASSERT (SCM_ROSTRINGP (SCM_CAR (envlist)),
 932                   envlist, arg, proc);
 933       len = 1 + SCM_ROLENGTH (SCM_CAR (envlist));
 934       result[i] = malloc ((long) len);
 935       if (result[i] == NULL)
 936         scm_memory_error (proc);
 937       src = SCM_ROCHARS (SCM_CAR (envlist));
 938       while (len--)
 939         result[i][len] = src[len];
 940       envlist = SCM_CDR (envlist);
 941       i++;
 942     }
 943   result[i] = 0;
 944   return result;
 945 }
 946
 947 GUILE_PROC (scm_execle, "execle", 2, 0, 1,
 948             (SCM filename, SCM env, SCM args),
 949 "Similar to @code{execl}, but the environment of the new process is
 950 specified by @var{env}, which must be a list of strings as returned by the
 951 @code{environ} procedure.
 952
 953 This procedure is currently implemented using the @code{execve} system
 954 call, but we call it @code{execle} because of its Scheme calling interface.")
 955 #define FUNC_NAME s_scm_execle
 956 {
 957   char **execargv;
 958   char **exec_env;
 959
 960   SCM_VALIDATE_ROSTRING(1,filename);
 961   SCM_COERCE_SUBSTR (filename);
 962
 963   execargv = scm_convert_exec_args (args, SCM_ARG1, FUNC_NAME);
 964   exec_env = environ_list_to_c (env, SCM_ARG2, FUNC_NAME);
 965   execve (SCM_ROCHARS (filename), execargv, exec_env);
 966   SCM_SYSERROR;
 967   /* not reached.  */
 968   return SCM_BOOL_F;
 969 }
 970 #undef FUNC_NAME
 971
 972 GUILE_PROC (scm_fork, "primitive-fork", 0, 0, 0,
 973             (),
 974 "Creates a new \"child\" process by duplicating the current \"parent\" process.
 975 In the child the return value is 0.  In the parent the return value is
 976 the integer process ID of the child.
 977
 978 This procedure has been renamed from @code{fork} to avoid a naming conflict
 979 with the scsh fork.")
 980 #define FUNC_NAME s_scm_fork
 981 {
 982   int pid;
 983   pid = fork ();
 984   if (pid == -1)
 985     SCM_SYSERROR;
 986   return SCM_MAKINUM (0L+pid);
 987 }
 988 #undef FUNC_NAME
 989
 990
 991 GUILE_PROC (scm_uname, "uname", 0, 0, 0,
 992             (),
 993 "Returns an object with some information about the computer system the
 994 program is running on.")
 995 #define FUNC_NAME s_scm_uname
 996 {
 997 #ifdef HAVE_UNAME
 998   struct utsname buf;
 999   SCM ans = scm_make_vector (SCM_MAKINUM(5), SCM_UNSPECIFIED);
1000   SCM *ve = SCM_VELTS (ans);
1001   if (uname (&buf) < 0)
1002     SCM_SYSERROR;
1003   ve[0] = scm_makfrom0str (buf.sysname);
1004   ve[1] = scm_makfrom0str (buf.nodename);
1005   ve[2] = scm_makfrom0str (buf.release);
1006   ve[3] = scm_makfrom0str (buf.version);
1007   ve[4] = scm_makfrom0str (buf.machine);
1008 /*
1009    a linux special?
1010   ve[5] = scm_makfrom0str (buf.domainname);
1011 */
1012   return ans;
1013 #else
1014   SCM_SYSMISSING;
1015   /* not reached.  */
1016   return SCM_BOOL_F;
1017 #endif
1018 }
1019 #undef FUNC_NAME
1020
1021 GUILE_PROC (scm_environ, "environ", 0, 1, 0,
1022             (SCM env),
1023 "If @var{env} is omitted, returns the current environment as a list of strings.
1024 Otherwise it sets the current environment, which is also the
1025 default environment for child processes, to the supplied list of strings.
1026 Each member of @var{env} should be of the form
1027 @code{NAME=VALUE} and values of @code{NAME} should not be duplicated.
1028 If @var{env} is supplied then the return value is unspecified.")
1029 #define FUNC_NAME s_scm_environ
1030 {
1031   if (SCM_UNBNDP (env))
1032     return scm_makfromstrs (-1, environ);
1033   else
1034     {
1035       char **new_environ;
1036
1037       new_environ = environ_list_to_c (env, SCM_ARG1, FUNC_NAME);
1038       /* Free the old environment, except when called for the first
1039        * time.
1040        */
1041       {
1042         char **ep;
1043         static int first = 1;
1044         if (!first)
1045           {
1046             for (ep = environ; *ep != NULL; ep++)
1047               free (*ep);
1048             free ((char *) environ);
1049           }
1050         first = 0;
1051       }
1052       environ = new_environ;
1053       return SCM_UNSPECIFIED;
1054     }
1055 }
1056 #undef FUNC_NAME
1057
1058 #ifdef L_tmpnam
1059
1060 GUILE_PROC (scm_tmpnam, "tmpnam", 0, 0, 0,
1061             (),
1062 "Create a new file in the file system with a unique name.  The return
1063 value is the name of the new file.  This function is implemented with
1064 the @code{tmpnam} function in the system libraries.")
1065 #define FUNC_NAME s_scm_tmpnam
1066 {
1067   char name[L_tmpnam];
1068   SCM_SYSCALL (tmpnam (name););
1069   return scm_makfrom0str (name);
1070 }
1071 #undef FUNC_NAME;
1072
1073 #endif
1074
1075 GUILE_PROC (scm_utime, "utime", 1, 2, 0,
1076             (SCM pathname, SCM actime, SCM modtime),
1077 "@code{utime} sets the access and modification times for
1078 the file named by @var{path}.  If @var{actime} or @var{modtime}
1079 is not supplied, then the current time is used.
1080 @var{actime} and @var{modtime}
1081 must be integer time values as returned by the @code{current-time}
1082 procedure.
1083
1084 E.g.,
1085
1086 @smalllisp
1087 (utime \"foo\" (- (current-time) 3600))
1088 @end smalllisp
1089
1090 will set the access time to one hour in the past and the modification
1091 time to the current time.")
1092 #define FUNC_NAME s_scm_utime
1093 {
1094   int rv;
1095   struct utimbuf utm_tmp;
1096
1097   SCM_VALIDATE_ROSTRING(1,pathname);
1098   SCM_COERCE_SUBSTR (pathname);
1099   if (SCM_UNBNDP (actime))
1100     SCM_SYSCALL (time (&utm_tmp.actime));
1101   else
1102     utm_tmp.actime = SCM_NUM2ULONG (2,actime);
1103
1104   if (SCM_UNBNDP (modtime))
1105     SCM_SYSCALL (time (&utm_tmp.modtime));
1106   else
1107     utm_tmp.modtime = SCM_NUM2ULONG (3,modtime);
1108
1109   SCM_SYSCALL (rv = utime (SCM_ROCHARS (pathname), &utm_tmp));
1110   if (rv != 0)
1111     SCM_SYSERROR;
1112   return SCM_UNSPECIFIED;
1113 }
1114 #undef FUNC_NAME
1115
1116 GUILE_PROC (scm_access, "access?", 2, 0, 0,
1117             (SCM path, SCM how),
1118 "Returns @code{#t} if @var{path} corresponds to an existing
1119 file and the current process
1120 has the type of access specified by @var{how}, otherwise
1121 @code{#f}.
1122 @var{how} should be specified
1123 using the values of the variables listed below.  Multiple values can
1124 be combined using a bitwise or, in which case @code{#t} will only
1125 be returned if all accesses are granted.
1126
1127 Permissions are checked using the real id of the current process,
1128 not the effective id, although it's the effective id which determines
1129 whether the access would actually be granted.
1130
1131 @defvar R_OK
1132 test for read permission.
1133 @end defvar
1134 @defvar W_OK
1135 test for write permission.
1136 @end defvar
1137 @defvar X_OK
1138 test for execute permission.
1139 @end defvar
1140 @defvar F_OK
1141 test for existence of the file.
1142 @end defvar")
1143 #define FUNC_NAME s_scm_access
1144 {
1145   int rv;
1146
1147   SCM_VALIDATE_ROSTRING(1,path);
1148   if (SCM_SUBSTRP (path))
1149     path = scm_makfromstr (SCM_ROCHARS (path), SCM_ROLENGTH (path), 0);
1150   SCM_VALIDATE_INUM(2,how);
1151   rv = access (SCM_ROCHARS (path), SCM_INUM (how));
1152   return SCM_NEGATE_BOOL(rv);
1153 }
1154 #undef FUNC_NAME
1155
1156 GUILE_PROC (scm_getpid, "getpid", 0, 0, 0,
1157             (),
1158 "Returns an integer representing the current process ID.")
1159 #define FUNC_NAME s_scm_getpid
1160 {
1161   return SCM_MAKINUM ((unsigned long) getpid ());
1162 }
1163 #undef FUNC_NAME
1164
1165 GUILE_PROC (scm_putenv, "putenv", 1, 0, 0,
1166             (SCM str),
1167 "Modifies the environment of the current process, which is
1168 also the default environment inherited by child processes.
1169
1170 If @var{string} is of the form @code{NAME=VALUE} then it will be written
1171 directly into the environment, replacing any existing environment string
1172 with
1173 name matching @code{NAME}.  If @var{string} does not contain an equal
1174 sign, then any existing string with name matching @var{string} will
1175 be removed.
1176
1177 The return value is unspecified.")
1178 #define FUNC_NAME s_scm_putenv
1179 {
1180   int rv;
1181   char *ptr;
1182
1183   SCM_VALIDATE_ROSTRING(1,str);
1184   /* must make a new copy to be left in the environment, safe from gc.  */
1185   ptr = malloc (SCM_LENGTH (str) + 1);
1186   if (ptr == NULL)
1187     SCM_MEMORY_ERROR;
1188   strncpy (ptr, SCM_ROCHARS (str), SCM_LENGTH (str));
1189   ptr[SCM_LENGTH(str)] = 0;
1190   rv = putenv (ptr);
1191   if (rv < 0)
1192     SCM_SYSERROR;
1193   return SCM_UNSPECIFIED;
1194 }
1195 #undef FUNC_NAME
1196
1197 GUILE_PROC (scm_setlocale, "setlocale", 1, 1, 0,
1198             (SCM category, SCM locale),
1199 "If @var{locale} is omitted, returns the current value of the specified
1200 locale category
1201 as a system-dependent string.
1202 @var{category} should be specified using the values @code{LC_COLLATE},
1203 @code{LC_ALL} etc.
1204
1205 Otherwise the specified locale category is set to
1206 the string @var{locale}
1207 and the new value is returned as a system-dependent string.  If @var{locale}
1208 is an empty string, the locale will be set using envirionment variables.")
1209 #define FUNC_NAME s_scm_setlocale
1210 {
1211 #ifdef HAVE_SETLOCALE
1212   char *clocale;
1213   char *rv;
1214
1215   SCM_VALIDATE_INUM(1,category);
1216   if (SCM_UNBNDP (locale))
1217     {
1218       clocale = NULL;
1219     }
1220   else
1221     {
1222       SCM_VALIDATE_ROSTRING(2,locale);
1223       SCM_COERCE_SUBSTR (locale);
1224       clocale = SCM_ROCHARS (locale);
1225     }
1226
1227   rv = setlocale (SCM_INUM (category), clocale);
1228   if (rv == NULL)
1229     SCM_SYSERROR;
1230   return scm_makfrom0str (rv);
1231 #else
1232   SCM_SYSMISSING;
1233   /* not reached.  */
1234   return SCM_BOOL_F;
1235 #endif
1236 }
1237 #undef FUNC_NAME
1238
1239 GUILE_PROC (scm_mknod, "mknod", 4, 0, 0,
1240             (SCM path, SCM type, SCM perms, SCM dev),
1241 "Creates a new special file, such as a file corresponding to a device.
1242 @var{path} specifies the name of the file.  @var{type} should
1243 be one of the following symbols:
1244 regular, directory, symlink, block-special, char-special,
1245 fifo, or socket.  @var{perms} (an integer) specifies the file permissions.
1246 @var{dev} (an integer) specifies which device the special file refers
1247 to.  Its exact interpretation depends on the kind of special file
1248 being created.
1249
1250 E.g.,
1251 @example
1252 (mknod "/dev/fd0" 'block-special #o660 (+ (* 2 256) 2))
1253 @end example
1254
1255 The return value is unspecified.")
1256 #define FUNC_NAME s_scm_mknod
1257 {
1258 #ifdef HAVE_MKNOD
1259   int val;
1260   char *p;
1261   int ctype = 0;
1262
1263   SCM_VALIDATE_ROSTRING(1,path);
1264   SCM_VALIDATE_SYMBOL(2,type);
1265   SCM_VALIDATE_INUM(3,perms);
1266   SCM_VALIDATE_INUM(4,dev);
1267   SCM_COERCE_SUBSTR (path);
1268
1269   p = SCM_CHARS (type);
1270   if (strcmp (p, "regular") == 0)
1271     ctype = S_IFREG;
1272   else if (strcmp (p, "directory") == 0)
1273     ctype = S_IFDIR;
1274   else if (strcmp (p, "symlink") == 0)
1275     ctype = S_IFLNK;
1276   else if (strcmp (p, "block-special") == 0)
1277     ctype = S_IFBLK;
1278   else if (strcmp (p, "char-special") == 0)
1279     ctype = S_IFCHR;
1280   else if (strcmp (p, "fifo") == 0)
1281     ctype = S_IFIFO;
1282   else if (strcmp (p, "socket") == 0)
1283     ctype = S_IFSOCK;
1284   else
1285     SCM_OUT_OF_RANGE (2,type);
1286
1287   SCM_SYSCALL (val = mknod(SCM_ROCHARS(path), ctype | SCM_INUM (perms),
1288                            SCM_INUM (dev)));
1289   if (val != 0)
1290     SCM_SYSERROR;
1291   return SCM_UNSPECIFIED;
1292 #else
1293   SCM_SYSMISSING;
1294   /* not reached.  */
1295   return SCM_BOOL_F;
1296 #endif
1297 }
1298 #undef FUNC_NAME
1299
1300
1301 GUILE_PROC (scm_nice, "nice", 1, 0, 0,
1302             (SCM incr),
1303 "Increment the priority of the current process by @var{incr}.  A higher
1304 priority value means that the process runs less often.
1305 The return value is unspecified.")
1306 #define FUNC_NAME s_scm_nice
1307 {
1308 #ifdef HAVE_NICE
1309   SCM_VALIDATE_INUM(1,incr);
1310   if (nice(SCM_INUM(incr)) != 0)
1311     SCM_SYSERROR;
1312   return SCM_UNSPECIFIED;
1313 #else
1314   SCM_SYSMISSING;
1315   /* not reached.  */
1316   return SCM_BOOL_F;
1317 #endif
1318 }
1319 #undef FUNC_NAME
1320
1321
1322 GUILE_PROC (scm_sync, "sync", 0, 0, 0,
1323             (),
1324 "Flush the operating system disk buffers.
1325 The return value is unspecified.")
1326 #define FUNC_NAME s_scm_sync
1327 {
1328 #ifdef HAVE_SYNC
1329   sync();
1330 #else
1331   SCM_SYSMISSING;
1332   /* not reached.  */
1333 #endif
1334   return SCM_UNSPECIFIED;
1335 }
1336 #undef FUNC_NAME
1337
1338 void
1339 scm_init_posix ()
1340 {
1341   scm_add_feature ("posix");
1342 #ifdef HAVE_GETEUID
1343   scm_add_feature ("EIDs");
1344 #endif
1345 #ifdef WAIT_ANY
1346   scm_sysintern ("WAIT_ANY", SCM_MAKINUM (WAIT_ANY));
1347 #endif
1348 #ifdef WAIT_MYPGRP
1349   scm_sysintern ("WAIT_MYPGRP", SCM_MAKINUM (WAIT_MYPGRP));
1350 #endif
1351 #ifdef WNOHANG
1352   scm_sysintern ("WNOHANG", SCM_MAKINUM (WNOHANG));
1353 #endif
1354 #ifdef WUNTRACED
1355   scm_sysintern ("WUNTRACED", SCM_MAKINUM (WUNTRACED));
1356 #endif
1357
1358   /* access() symbols.  */
1359   scm_sysintern ("R_OK", SCM_MAKINUM (R_OK));
1360   scm_sysintern ("W_OK", SCM_MAKINUM (W_OK));
1361   scm_sysintern ("X_OK", SCM_MAKINUM (X_OK));
1362   scm_sysintern ("F_OK", SCM_MAKINUM (F_OK));
1363
1364 #ifdef LC_COLLATE
1365   scm_sysintern ("LC_COLLATE", SCM_MAKINUM (LC_COLLATE));
1366 #endif
1367 #ifdef LC_CTYPE
1368   scm_sysintern ("LC_CTYPE", SCM_MAKINUM (LC_CTYPE));
1369 #endif
1370 #ifdef LC_MONETARY
1371   scm_sysintern ("LC_MONETARY", SCM_MAKINUM (LC_MONETARY));
1372 #endif
1373 #ifdef LC_NUMERIC
1374   scm_sysintern ("LC_NUMERIC", SCM_MAKINUM (LC_NUMERIC));
1375 #endif
1376 #ifdef LC_TIME
1377   scm_sysintern ("LC_TIME", SCM_MAKINUM (LC_TIME));
1378 #endif
1379 #ifdef LC_MESSAGES
1380   scm_sysintern ("LC_MESSAGES", SCM_MAKINUM (LC_MESSAGES));
1381 #endif
1382 #ifdef LC_ALL
1383   scm_sysintern ("LC_ALL", SCM_MAKINUM (LC_ALL));
1384 #endif
1385 #include "cpp_sig_symbols.c"
1386 #include "posix.x"
1387 }