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_INT(1,pid);
 395   SCM_VALIDATE_INT(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
 404
 405 GUILE_PROC (scm_waitpid, "waitpid", 1, 1, 0,
 406             (SCM pid, SCM options),
 407 "This procedure collects status information from a child process which
 408 has terminated or (optionally) stopped.  Normally it will
 409 suspend the calling process until this can be done.  If more than one
 410 child process is eligible then one will be chosen by the operating system.
 411
 412 The value of @var{pid} determines the behaviour:
 413
 414 @table @r
 415 @item @var{pid} greater than 0
 416 Request status information from the specified child process.
 417 @item @var{pid} equal to -1 or WAIT_ANY
 418 Request status information for any child process.
 419 @item @var{pid} equal to 0 or WAIT_MYPGRP
 420 Request status information for any child process in the current process
 421 group.
 422 @item @var{pid} less than -1
 423 Request status information for any child process whose process group ID
 424 is -@var{PID}.
 425 @end table
 426
 427 The @var{options} argument, if supplied, should be the bitwise OR of the
 428 values of zero or more of the following variables:
 429
 430 @defvar WNOHANG
 431 Return immediately even if there are no child processes to be collected.
 432 @end defvar
 433
 434 @defvar WUNTRACED
 435 Report status information for stopped processes as well as terminated
 436 processes.
 437 @end defvar
 438
 439 The return value is a pair containing:
 440
 441 @enumerate
 442 @item
 443 The process ID of the child process, or 0 if @code{WNOHANG} was
 444 specified and no process was collected.
 445 @item
 446 The integer status value.
 447 @end enumerate")
 448 #define FUNC_NAME s_scm_waitpid
 449 {
 450 #ifdef HAVE_WAITPID
 451   int i;
 452   int status;
 453   int ioptions;
 454   SCM_VALIDATE_INT(1,pid);
 455   if (SCM_UNBNDP (options))
 456     ioptions = 0;
 457   else
 458     {
 459       SCM_VALIDATE_INT(2,options);
 460       /* Flags are interned in scm_init_posix.  */
 461       ioptions = SCM_INUM (options);
 462     }
 463   SCM_SYSCALL (i = waitpid (SCM_INUM (pid), &status, ioptions));
 464   if (i == -1)
 465     SCM_SYSERROR;
 466   return scm_cons (SCM_MAKINUM (0L + i), SCM_MAKINUM (0L + status));
 467 #else
 468   SCM_SYSMISSING;
 469   /* not reached.  */
 470   return SCM_BOOL_F;
 471 #endif
 472 }
 473 #undef FUNC_NAME
 474
 475 GUILE_PROC (scm_status_exit_val, "status:exit-val", 1, 0, 0,
 476             (SCM status),
 477 "Returns the exit status value, as would be
 478 set if a process ended normally through a
 479 call to @code{exit} or @code{_exit}, if any, otherwise @code{#f}.")
 480 #define FUNC_NAME s_scm_status_exit_val
 481 {
 482   int lstatus;
 483
 484   SCM_VALIDATE_INT(1,status);
 485
 486   /* On Ultrix, the WIF... macros assume their argument is an lvalue;
 487      go figure.  SCM_INUM does not yield an lvalue.  */
 488   lstatus = SCM_INUM (status);
 489   if (WIFEXITED (lstatus))
 490     return (SCM_MAKINUM (WEXITSTATUS (lstatus)));
 491   else
 492     return SCM_BOOL_F;
 493 }
 494 #undef FUNC_NAME
 495
 496 GUILE_PROC (scm_status_term_sig, "status:term-sig", 1, 0, 0,
 497             (SCM status),
 498 "Returns the signal number which terminated the
 499 process, if any, otherwise @code{#f}.")
 500 #define FUNC_NAME s_scm_status_term_sig
 501 {
 502   int lstatus;
 503
 504   SCM_VALIDATE_INT(1,status);
 505
 506   lstatus = SCM_INUM (status);
 507   if (WIFSIGNALED (lstatus))
 508     return SCM_MAKINUM (WTERMSIG (lstatus));
 509   else
 510     return SCM_BOOL_F;
 511 }
 512 #undef FUNC_NAME
 513
 514 GUILE_PROC (scm_status_stop_sig, "status:stop-sig", 1, 0, 0,
 515             (SCM status),
 516 "Returns the signal number which stopped the
 517 process, if any, otherwise @code{#f}.")
 518 #define FUNC_NAME s_scm_status_stop_sig
 519 {
 520   int lstatus;
 521
 522   SCM_VALIDATE_INT(1,status);
 523
 524   lstatus = SCM_INUM (status);
 525   if (WIFSTOPPED (lstatus))
 526     return SCM_MAKINUM (WSTOPSIG (lstatus));
 527   else
 528     return SCM_BOOL_F;
 529 }
 530 #undef FUNC_NAME
 531
 532 GUILE_PROC (scm_getppid, "getppid", 0, 0, 0,
 533             (),
 534 "Returns an integer representing the process ID of the parent process.")
 535 #define FUNC_NAME s_scm_getppid
 536 {
 537   return SCM_MAKINUM (0L + getppid ());
 538 }
 539 #undef FUNC_NAME
 540
 541
 542
 543 GUILE_PROC (scm_getuid, "getuid", 0, 0, 0,
 544             (),
 545 "Returns an integer representing the current real user ID.")
 546 #define FUNC_NAME s_scm_getuid
 547 {
 548   return SCM_MAKINUM (0L + getuid ());
 549 }
 550 #undef FUNC_NAME
 551
 552
 553
 554 GUILE_PROC (scm_getgid, "getgid", 0, 0, 0,
 555             (),
 556 "Returns an integer representing the current real group ID.")
 557 #define FUNC_NAME s_scm_getgid
 558 {
 559   return SCM_MAKINUM (0L + getgid ());
 560 }
 561 #undef FUNC_NAME
 562
 563
 564
 565 GUILE_PROC (scm_geteuid, "geteuid", 0, 0, 0,
 566             (),
 567 "Returns an integer representing the current effective user ID.
 568 If the system does not support effective IDs, then the real ID
 569 is returned.  @code{(feature? 'EIDs)} reports whether the system
 570 supports effective IDs.")
 571 #define FUNC_NAME s_scm_geteuid
 572 {
 573 #ifdef HAVE_GETEUID
 574   return SCM_MAKINUM (0L + geteuid ());
 575 #else
 576   return SCM_MAKINUM (0L + getuid ());
 577 #endif
 578 }
 579 #undef FUNC_NAME
 580
 581
 582
 583 GUILE_PROC (scm_getegid, "getegid", 0, 0, 0,
 584             (),
 585 "Returns an integer representing the current effective group ID.
 586 If the system does not support effective IDs, then the real ID
 587 is returned.  @code{(feature? 'EIDs)} reports whether the system
 588 supports effective IDs.")
 589 #define FUNC_NAME s_scm_getegid
 590 {
 591 #ifdef HAVE_GETEUID
 592   return SCM_MAKINUM (0L + getegid ());
 593 #else
 594   return SCM_MAKINUM (0L + getgid ());
 595 #endif
 596 }
 597 #undef FUNC_NAME
 598
 599
 600 GUILE_PROC (scm_setuid, "setuid", 1, 0, 0,
 601             (SCM id),
 602 "Sets both the real and effective user IDs to the integer @var{id}, provided
 603 the process has appropriate privileges.
 604 The return value is unspecified.")
 605 #define FUNC_NAME s_scm_setuid
 606 {
 607   SCM_VALIDATE_INT(1,id);
 608   if (setuid (SCM_INUM (id)) != 0)
 609     SCM_SYSERROR;
 610   return SCM_UNSPECIFIED;
 611 }
 612 #undef FUNC_NAME
 613
 614 GUILE_PROC (scm_setgid, "setgid", 1, 0, 0,
 615             (SCM id),
 616 "Sets both the real and effective group IDs to the integer @var{id}, provided
 617 the process has appropriate privileges.
 618 The return value is unspecified.")
 619 #define FUNC_NAME s_scm_setgid
 620 {
 621   SCM_VALIDATE_INT(1,id);
 622   if (setgid (SCM_INUM (id)) != 0)
 623     SCM_SYSERROR;
 624   return SCM_UNSPECIFIED;
 625 }
 626 #undef FUNC_NAME
 627
 628 GUILE_PROC (scm_seteuid, "seteuid", 1, 0, 0,
 629             (SCM id),
 630 "Sets the effective user ID to the integer @var{id}, provided the process
 631 has appropriate privileges.  If effective IDs are not supported, the
 632 real ID is set instead -- @code{(feature? 'EIDs)} reports whether the
 633 system supports effective IDs.
 634 The return value is unspecified.")
 635 #define FUNC_NAME s_scm_seteuid
 636 {
 637   int rv;
 638
 639   SCM_VALIDATE_INT(1,id);
 640 #ifdef HAVE_SETEUID
 641   rv = seteuid (SCM_INUM (id));
 642 #else
 643   rv = setuid (SCM_INUM (id));
 644 #endif
 645   if (rv != 0)
 646     SCM_SYSERROR;
 647   return SCM_UNSPECIFIED;
 648 }
 649 #undef FUNC_NAME
 650
 651 #ifdef HAVE_SETEGID
 652 GUILE_PROC (scm_setegid, "setegid", 1, 0, 0,
 653             (SCM id),
 654 "Sets the effective group ID to the integer @var{id}, provided the process
 655 has appropriate privileges.  If effective IDs are not supported, the
 656 real ID is set instead -- @code{(feature? 'EIDs)} reports whether the
 657 system supports effective IDs.
 658 The return value is unspecified.")
 659 #define FUNC_NAME s_scm_setegid
 660 {
 661   int rv;
 662
 663   SCM_VALIDATE_INT(1,id);
 664 #ifdef HAVE_SETEUID
 665   rv = setegid (SCM_INUM (id));
 666 #else
 667   rv = setgid (SCM_INUM (id));
 668 #endif
 669   if (rv != 0)
 670     SCM_SYSERROR;
 671   return SCM_UNSPECIFIED;
 672
 673 }
 674 #undef FUNC_NAME
 675 #endif
 676
 677 GUILE_PROC (scm_getpgrp, "getpgrp", 0, 0, 0,
 678             (),
 679 "Returns an integer representing the current process group ID.
 680 This is the POSIX definition, not BSD.")
 681 #define FUNC_NAME s_scm_getpgrp
 682 {
 683   int (*fn)();
 684   fn = (int (*) ()) getpgrp;
 685   return SCM_MAKINUM (fn (0));
 686 }
 687 #undef FUNC_NAME
 688
 689 GUILE_PROC (scm_setpgid, "setpgid", 2, 0, 0,
 690             (SCM pid, SCM pgid),
 691 "Move the process @var{pid} into the process group @var{pgid}.  @var{pid} or
 692 @var{pgid} must be integers: they can be zero to indicate the ID of the
 693 current process.
 694 Fails on systems that do not support job control.
 695 The return value is unspecified.")
 696 #define FUNC_NAME s_scm_setpgid
 697 {
 698 #ifdef HAVE_SETPGID
 699   SCM_VALIDATE_INT(1,pid);
 700   SCM_VALIDATE_INT(2,pgid);
 701   /* FIXME(?): may be known as setpgrp.  */
 702   if (setpgid (SCM_INUM (pid), SCM_INUM (pgid)) != 0)
 703     SCM_SYSERROR;
 704   return SCM_UNSPECIFIED;
 705 #else
 706   SCM_SYSMISSING;
 707   /* not reached.  */
 708   return SCM_BOOL_F;
 709 #endif
 710 }
 711 #undef FUNC_NAME
 712
 713 GUILE_PROC (scm_setsid, "setsid", 0, 0, 0,
 714             (),
 715 "Creates a new session.  The current process becomes the session leader
 716 and is put in a new process group.  The process will be detached
 717 from its controlling terminal if it has one.
 718 The return value is an integer representing the new process group ID.")
 719 #define FUNC_NAME s_scm_setsid
 720 {
 721 #ifdef HAVE_SETSID
 722   pid_t sid = setsid ();
 723   if (sid == -1)
 724     SCM_SYSERROR;
 725   return SCM_UNSPECIFIED;
 726 #else
 727   SCM_SYSMISSING;
 728   /* not reached.  */
 729   return SCM_BOOL_F;
 730 #endif
 731 }
 732 #undef FUNC_NAME
 733
 734 GUILE_PROC (scm_ttyname, "ttyname", 1, 0, 0,
 735             (SCM port),
 736 "Returns a string with the name of the serial terminal device underlying
 737 @var{port}.")
 738 #define FUNC_NAME s_scm_ttyname
 739 {
 740   char *ans;
 741   int fd;
 742
 743   port = SCM_COERCE_OUTPORT (port);
 744   SCM_VALIDATE_OPPORT(1,port);
 745   if (scm_tc16_fport != SCM_TYP16 (port))
 746     return SCM_BOOL_F;
 747   fd = SCM_FPORT_FDES (port);
 748   SCM_SYSCALL (ans = ttyname (fd));
 749   if (!ans)
 750     SCM_SYSERROR;
 751   /* ans could be overwritten by another call to ttyname */
 752   return (scm_makfrom0str (ans));
 753 }
 754 #undef FUNC_NAME
 755
 756
 757 GUILE_PROC (scm_ctermid, "ctermid", 0, 0, 0,
 758             (),
 759 "Returns a string containing the file name of the controlling terminal
 760 for the current process.")
 761 #define FUNC_NAME s_scm_ctermid
 762 {
 763 #ifdef HAVE_CTERMID
 764   char *result = ctermid (NULL);
 765   if (*result == '\0')
 766     SCM_SYSERROR;
 767   return scm_makfrom0str (result);
 768 #else
 769   SCM_SYSMISSING;
 770   /* not reached.  */
 771   return SCM_BOOL_F;
 772 #endif
 773 }
 774 #undef FUNC_NAME
 775
 776 GUILE_PROC (scm_tcgetpgrp, "tcgetpgrp", 1, 0, 0,
 777             (SCM port),
 778 "Returns the process group ID of the foreground
 779 process group associated with the terminal open on the file descriptor
 780 underlying @var{port}.
 781
 782 If there is no foreground process group, the return value is a
 783 number greater than 1 that does not match the process group ID
 784 of any existing process group.  This can happen if all of the
 785 processes in the job that was formerly the foreground job have
 786 terminated, and no other job has yet been moved into the
 787 foreground.")
 788 #define FUNC_NAME s_scm_tcgetpgrp
 789 {
 790 #ifdef HAVE_TCGETPGRP
 791   int fd;
 792   pid_t pgid;
 793
 794   port = SCM_COERCE_OUTPORT (port);
 795
 796   SCM_VALIDATE_OPFPORT(1,port);
 797   fd = SCM_FPORT_FDES (port);
 798   if ((pgid = tcgetpgrp (fd)) == -1)
 799     SCM_SYSERROR;
 800   return SCM_MAKINUM (pgid);
 801 #else
 802   SCM_SYSMISSING;
 803   /* not reached.  */
 804   return SCM_BOOL_F;
 805 #endif
 806 }
 807 #undef FUNC_NAME
 808
 809 GUILE_PROC (scm_tcsetpgrp, "tcsetpgrp", 2, 0, 0,
 810             (SCM port, SCM pgid),
 811 "Set the foreground process group ID for the terminal used by the file
 812 descriptor underlying @var{port} to the integer @var{pgid}.
 813 The calling process
 814 must be a member of the same session as @var{pgid} and must have the same
 815 controlling terminal.  The return value is unspecified.")
 816 #define FUNC_NAME s_scm_tcsetpgrp
 817 {
 818 #ifdef HAVE_TCSETPGRP
 819   int fd;
 820
 821   port = SCM_COERCE_OUTPORT (port);
 822
 823   SCM_VALIDATE_OPFPORT(1,port);
 824   SCM_VALIDATE_INT(2,pgid);
 825   fd = SCM_FPORT_FDES (port);
 826   if (tcsetpgrp (fd, SCM_INUM (pgid)) == -1)
 827     SCM_SYSERROR;
 828   return SCM_UNSPECIFIED;
 829 #else
 830   SCM_SYSMISSING;
 831   /* not reached.  */
 832   return SCM_BOOL_F;
 833 #endif
 834 }
 835 #undef FUNC_NAME
 836
 837
 838 /* Copy exec args from an SCM vector into a new C array.  */
 839
 840 static char **
 841 scm_convert_exec_args (SCM args, int pos, const char *subr)
 842 {
 843   char **execargv;
 844   int num_args;
 845   int i;
 846
 847   SCM_ASSERT (SCM_NULLP (args)
 848               || (SCM_CONSP (args)),
 849               args, pos, subr);
 850   num_args = scm_ilength (args);
 851   execargv = (char **)
 852     scm_must_malloc ((num_args + 1) * sizeof (char *), subr);
 853   for (i = 0; SCM_NNULLP (args); args = SCM_CDR (args), ++i)
 854     {
 855       scm_sizet len;
 856       char *dst;
 857       char *src;
 858       SCM_ASSERT (SCM_ROSTRINGP (SCM_CAR (args)),
 859                   SCM_CAR (args), SCM_ARGn, subr);
 860       len = 1 + SCM_ROLENGTH (SCM_CAR (args));
 861       dst = (char *) scm_must_malloc ((long) len, subr);
 862       src = SCM_ROCHARS (SCM_CAR (args));
 863       while (len--)
 864         dst[len] = src[len];
 865       execargv[i] = dst;
 866     }
 867   execargv[i] = 0;
 868   return execargv;
 869 }
 870
 871 GUILE_PROC (scm_execl, "execl", 1, 0, 1,
 872             (SCM filename, SCM args),
 873 "Executes the file named by @var{path} as a new process image.
 874 The remaining arguments are supplied to the process; from a C program
 875 they are accessable as the @code{argv} argument to @code{main}.
 876 Conventionally the first @var{arg} is the same as @var{path}.
 877 All arguments must be strings.
 878
 879 If @var{arg} is missing, @var{path} is executed with a null
 880 argument list, which may have system-dependent side-effects.
 881
 882 This procedure is currently implemented using the @code{execv} system
 883 call, but we call it @code{execl} because of its Scheme calling interface.")
 884 #define FUNC_NAME s_scm_execl
 885 {
 886   char **execargv;
 887   SCM_VALIDATE_ROSTRING(1,filename);
 888   SCM_COERCE_SUBSTR (filename);
 889   execargv = scm_convert_exec_args (args, SCM_ARG2, FUNC_NAME);
 890   execv (SCM_ROCHARS (filename), execargv);
 891   SCM_SYSERROR;
 892   /* not reached.  */
 893   return SCM_BOOL_F;
 894 }
 895 #undef FUNC_NAME
 896
 897 GUILE_PROC (scm_execlp, "execlp", 1, 0, 1,
 898             (SCM filename, SCM args),
 899 "Similar to @code{execl}, however if
 900 @var{filename} does not contain a slash
 901 then the file to execute will be located by searching the
 902 directories listed in the @code{PATH} environment variable.
 903
 904 This procedure is currently implemented using the @code{execlv} system
 905 call, but we call it @code{execlp} because of its Scheme calling interface.")
 906 #define FUNC_NAME s_scm_execlp
 907 {
 908   char **execargv;
 909   SCM_VALIDATE_ROSTRING(1,filename);
 910   SCM_COERCE_SUBSTR (filename);
 911   execargv = scm_convert_exec_args (args, SCM_ARG2, FUNC_NAME);
 912   execvp (SCM_ROCHARS (filename), execargv);
 913   SCM_SYSERROR;
 914   /* not reached.  */
 915   return SCM_BOOL_F;
 916 }
 917 #undef FUNC_NAME
 918
 919 static char **
 920 environ_list_to_c (SCM envlist, int arg, const char *proc)
 921 {
 922   int num_strings;
 923   char **result;
 924   int i = 0;
 925
 926   SCM_ASSERT (SCM_NULLP (envlist) || SCM_CONSP (envlist),
 927               envlist, arg, proc);
 928   num_strings = scm_ilength (envlist);
 929   result = (char **) malloc ((num_strings + 1) * sizeof (char *));
 930   if (result == NULL)
 931     scm_memory_error (proc);
 932   while (SCM_NNULLP (envlist))
 933     {
 934       int len;
 935       char *src;
 936
 937       SCM_ASSERT (SCM_NIMP (SCM_CAR (envlist))
 938                   && SCM_ROSTRINGP (SCM_CAR (envlist)),
 939                   envlist, arg, proc);
 940       len = 1 + SCM_ROLENGTH (SCM_CAR (envlist));
 941       result[i] = malloc ((long) len);
 942       if (result[i] == NULL)
 943         scm_memory_error (proc);
 944       src = SCM_ROCHARS (SCM_CAR (envlist));
 945       while (len--)
 946         result[i][len] = src[len];
 947       envlist = SCM_CDR (envlist);
 948       i++;
 949     }
 950   result[i] = 0;
 951   return result;
 952 }
 953
 954 GUILE_PROC (scm_execle, "execle", 2, 0, 1,
 955             (SCM filename, SCM env, SCM args),
 956 "Similar to @code{execl}, but the environment of the new process is
 957 specified by @var{env}, which must be a list of strings as returned by the
 958 @code{environ} procedure.
 959
 960 This procedure is currently implemented using the @code{execve} system
 961 call, but we call it @code{execle} because of its Scheme calling interface.")
 962 #define FUNC_NAME s_scm_execle
 963 {
 964   char **execargv;
 965   char **exec_env;
 966
 967   SCM_VALIDATE_ROSTRING(1,filename);
 968   SCM_COERCE_SUBSTR (filename);
 969
 970   execargv = scm_convert_exec_args (args, SCM_ARG1, FUNC_NAME);
 971   exec_env = environ_list_to_c (env, SCM_ARG2, FUNC_NAME);
 972   execve (SCM_ROCHARS (filename), execargv, exec_env);
 973   SCM_SYSERROR;
 974   /* not reached.  */
 975   return SCM_BOOL_F;
 976 }
 977 #undef FUNC_NAME
 978
 979 GUILE_PROC (scm_fork, "primitive-fork", 0, 0, 0,
 980             (),
 981 "Creates a new \"child\" process by duplicating the current \"parent\" process.
 982 In the child the return value is 0.  In the parent the return value is
 983 the integer process ID of the child.
 984
 985 This procedure has been renamed from @code{fork} to avoid a naming conflict
 986 with the scsh fork.")
 987 #define FUNC_NAME s_scm_fork
 988 {
 989   int pid;
 990   pid = fork ();
 991   if (pid == -1)
 992     SCM_SYSERROR;
 993   return SCM_MAKINUM (0L+pid);
 994 }
 995 #undef FUNC_NAME
 996
 997
 998 GUILE_PROC (scm_uname, "uname", 0, 0, 0,
 999             (),
1000 "Returns an object with some information about the computer system the
1001 program is running on.")
1002 #define FUNC_NAME s_scm_uname
1003 {
1004 #ifdef HAVE_UNAME
1005   struct utsname buf;
1006   SCM ans = scm_make_vector (SCM_MAKINUM(5), SCM_UNSPECIFIED);
1007   SCM *ve = SCM_VELTS (ans);
1008   if (uname (&buf) < 0)
1009     SCM_SYSERROR;
1010   ve[0] = scm_makfrom0str (buf.sysname);
1011   ve[1] = scm_makfrom0str (buf.nodename);
1012   ve[2] = scm_makfrom0str (buf.release);
1013   ve[3] = scm_makfrom0str (buf.version);
1014   ve[4] = scm_makfrom0str (buf.machine);
1015 /*
1016    a linux special?
1017   ve[5] = scm_makfrom0str (buf.domainname);
1018 */
1019   return ans;
1020 #else
1021   SCM_SYSMISSING;
1022   /* not reached.  */
1023   return SCM_BOOL_F;
1024 #endif
1025 }
1026 #undef FUNC_NAME
1027
1028 GUILE_PROC (scm_environ, "environ", 0, 1, 0,
1029             (SCM env),
1030 "If @var{env} is omitted, returns the current environment as a list of strings.
1031 Otherwise it sets the current environment, which is also the
1032 default environment for child processes, to the supplied list of strings.
1033 Each member of @var{env} should be of the form
1034 @code{NAME=VALUE} and values of @code{NAME} should not be duplicated.
1035 If @var{env} is supplied then the return value is unspecified.")
1036 #define FUNC_NAME s_scm_environ
1037 {
1038   if (SCM_UNBNDP (env))
1039     return scm_makfromstrs (-1, environ);
1040   else
1041     {
1042       char **new_environ;
1043
1044       new_environ = environ_list_to_c (env, SCM_ARG1, FUNC_NAME);
1045       /* Free the old environment, except when called for the first
1046        * time.
1047        */
1048       {
1049         char **ep;
1050         static int first = 1;
1051         if (!first)
1052           {
1053             for (ep = environ; *ep != NULL; ep++)
1054               free (*ep);
1055             free ((char *) environ);
1056           }
1057         first = 0;
1058       }
1059       environ = new_environ;
1060       return SCM_UNSPECIFIED;
1061     }
1062 }
1063 #undef FUNC_NAME
1064
1065 #ifdef L_tmpnam
1066
1067 GUILE_PROC (scm_tmpnam, "tmpnam", 0, 0, 0,
1068             (),
1069 "Create a new file in the file system with a unique name.  The return
1070 value is the name of the new file.  This function is implemented with
1071 the @code{tmpnam} function in the system libraries.")
1072 #define FUNC_NAME s_scm_tmpnam
1073 {
1074   char name[L_tmpnam];
1075   SCM_SYSCALL (tmpnam (name););
1076   return scm_makfrom0str (name);
1077 }
1078 #undef FUNC_NAME;
1079
1080 #endif
1081
1082 GUILE_PROC (scm_utime, "utime", 1, 2, 0,
1083             (SCM pathname, SCM actime, SCM modtime),
1084 "@code{utime} sets the access and modification times for
1085 the file named by @var{path}.  If @var{actime} or @var{modtime}
1086 is not supplied, then the current time is used.
1087 @var{actime} and @var{modtime}
1088 must be integer time values as returned by the @code{current-time}
1089 procedure.
1090
1091 E.g.,
1092
1093 @smalllisp
1094 (utime \"foo\" (- (current-time) 3600))
1095 @end smalllisp
1096
1097 will set the access time to one hour in the past and the modification
1098 time to the current time.")
1099 #define FUNC_NAME s_scm_utime
1100 {
1101   int rv;
1102   struct utimbuf utm_tmp;
1103
1104   SCM_VALIDATE_ROSTRING(1,pathname);
1105   SCM_COERCE_SUBSTR (pathname);
1106   if (SCM_UNBNDP (actime))
1107     SCM_SYSCALL (time (&utm_tmp.actime));
1108   else
1109     utm_tmp.actime = SCM_NUM2ULONG (2,actime);
1110
1111   if (SCM_UNBNDP (modtime))
1112     SCM_SYSCALL (time (&utm_tmp.modtime));
1113   else
1114     utm_tmp.modtime = SCM_NUM2ULONG (3,modtime);
1115
1116   SCM_SYSCALL (rv = utime (SCM_ROCHARS (pathname), &utm_tmp));
1117   if (rv != 0)
1118     SCM_SYSERROR;
1119   return SCM_UNSPECIFIED;
1120 }
1121 #undef FUNC_NAME
1122
1123 GUILE_PROC (scm_access, "access?", 2, 0, 0,
1124             (SCM path, SCM how),
1125 "Returns @code{#t} if @var{path} corresponds to an existing
1126 file and the current process
1127 has the type of access specified by @var{how}, otherwise
1128 @code{#f}.
1129 @var{how} should be specified
1130 using the values of the variables listed below.  Multiple values can
1131 be combined using a bitwise or, in which case @code{#t} will only
1132 be returned if all accesses are granted.
1133
1134 Permissions are checked using the real id of the current process,
1135 not the effective id, although it's the effective id which determines
1136 whether the access would actually be granted.
1137
1138 @defvar R_OK
1139 test for read permission.
1140 @end defvar
1141 @defvar W_OK
1142 test for write permission.
1143 @end defvar
1144 @defvar X_OK
1145 test for execute permission.
1146 @end defvar
1147 @defvar F_OK
1148 test for existence of the file.
1149 @end defvar")
1150 #define FUNC_NAME s_scm_access
1151 {
1152   int rv;
1153
1154   SCM_VALIDATE_ROSTRING(1,path);
1155   if (SCM_SUBSTRP (path))
1156     path = scm_makfromstr (SCM_ROCHARS (path), SCM_ROLENGTH (path), 0);
1157   SCM_VALIDATE_INT(2,how);
1158   rv = access (SCM_ROCHARS (path), SCM_INUM (how));
1159   return SCM_NEGATE_BOOL(rv);
1160 }
1161 #undef FUNC_NAME
1162
1163 GUILE_PROC (scm_getpid, "getpid", 0, 0, 0,
1164             (),
1165 "Returns an integer representing the current process ID.")
1166 #define FUNC_NAME s_scm_getpid
1167 {
1168   return SCM_MAKINUM ((unsigned long) getpid ());
1169 }
1170 #undef FUNC_NAME
1171
1172 GUILE_PROC (scm_putenv, "putenv", 1, 0, 0,
1173             (SCM str),
1174 "Modifies the environment of the current process, which is
1175 also the default environment inherited by child processes.
1176
1177 If @var{string} is of the form @code{NAME=VALUE} then it will be written
1178 directly into the environment, replacing any existing environment string
1179 with
1180 name matching @code{NAME}.  If @var{string} does not contain an equal
1181 sign, then any existing string with name matching @var{string} will
1182 be removed.
1183
1184 The return value is unspecified.")
1185 #define FUNC_NAME s_scm_putenv
1186 {
1187   int rv;
1188   char *ptr;
1189
1190   SCM_VALIDATE_ROSTRING(1,str);
1191   /* must make a new copy to be left in the environment, safe from gc.  */
1192   ptr = malloc (SCM_LENGTH (str) + 1);
1193   if (ptr == NULL)
1194     SCM_MEMORY_ERROR;
1195   strncpy (ptr, SCM_ROCHARS (str), SCM_LENGTH (str));
1196   ptr[SCM_LENGTH(str)] = 0;
1197   rv = putenv (ptr);
1198   if (rv < 0)
1199     SCM_SYSERROR;
1200   return SCM_UNSPECIFIED;
1201 }
1202 #undef FUNC_NAME
1203
1204 GUILE_PROC (scm_setlocale, "setlocale", 1, 1, 0,
1205             (SCM category, SCM locale),
1206 "If @var{locale} is omitted, returns the current value of the specified
1207 locale category
1208 as a system-dependent string.
1209 @var{category} should be specified using the values @code{LC_COLLATE},
1210 @code{LC_ALL} etc.
1211
1212 Otherwise the specified locale category is set to
1213 the string @var{locale}
1214 and the new value is returned as a system-dependent string.  If @var{locale}
1215 is an empty string, the locale will be set using envirionment variables.")
1216 #define FUNC_NAME s_scm_setlocale
1217 {
1218 #ifdef HAVE_SETLOCALE
1219   char *clocale;
1220   char *rv;
1221
1222   SCM_VALIDATE_INT(1,category);
1223   if (SCM_UNBNDP (locale))
1224     {
1225       clocale = NULL;
1226     }
1227   else
1228     {
1229       SCM_VALIDATE_ROSTRING(2,locale);
1230       SCM_COERCE_SUBSTR (locale);
1231       clocale = SCM_ROCHARS (locale);
1232     }
1233
1234   rv = setlocale (SCM_INUM (category), clocale);
1235   if (rv == NULL)
1236     SCM_SYSERROR;
1237   return scm_makfrom0str (rv);
1238 #else
1239   SCM_SYSMISSING;
1240   /* not reached.  */
1241   return SCM_BOOL_F;
1242 #endif
1243 }
1244 #undef FUNC_NAME
1245
1246 GUILE_PROC (scm_mknod, "mknod", 4, 0, 0,
1247             (SCM path, SCM type, SCM perms, SCM dev),
1248 "Creates a new special file, such as a file corresponding to a device.
1249 @var{path} specifies the name of the file.  @var{type} should
1250 be one of the following symbols:
1251 regular, directory, symlink, block-special, char-special,
1252 fifo, or socket.  @var{perms} (an integer) specifies the file permissions.
1253 @var{dev} (an integer) specifies which device the special file refers
1254 to.  Its exact interpretation depends on the kind of special file
1255 being created.
1256
1257 E.g.,
1258 @example
1259 (mknod "/dev/fd0" 'block-special #o660 (+ (* 2 256) 2))
1260 @end example
1261
1262 The return value is unspecified.")
1263 #define FUNC_NAME s_scm_mknod
1264 {
1265 #ifdef HAVE_MKNOD
1266   int val;
1267   char *p;
1268   int ctype = 0;
1269
1270   SCM_VALIDATE_ROSTRING(1,path);
1271   SCM_VALIDATE_SYMBOL(2,type);
1272   SCM_VALIDATE_INT(3,perms);
1273   SCM_VALIDATE_INT(4,dev);
1274   SCM_COERCE_SUBSTR (path);
1275
1276   p = SCM_CHARS (type);
1277   if (strcmp (p, "regular") == 0)
1278     ctype = S_IFREG;
1279   else if (strcmp (p, "directory") == 0)
1280     ctype = S_IFDIR;
1281   else if (strcmp (p, "symlink") == 0)
1282     ctype = S_IFLNK;
1283   else if (strcmp (p, "block-special") == 0)
1284     ctype = S_IFBLK;
1285   else if (strcmp (p, "char-special") == 0)
1286     ctype = S_IFCHR;
1287   else if (strcmp (p, "fifo") == 0)
1288     ctype = S_IFIFO;
1289   else if (strcmp (p, "socket") == 0)
1290     ctype = S_IFSOCK;
1291   else
1292     SCM_OUT_OF_RANGE (2,type);
1293
1294   SCM_SYSCALL (val = mknod(SCM_ROCHARS(path), ctype | SCM_INUM (perms),
1295                            SCM_INUM (dev)));
1296   if (val != 0)
1297     SCM_SYSERROR;
1298   return SCM_UNSPECIFIED;
1299 #else
1300   SCM_SYSMISSING;
1301   /* not reached.  */
1302   return SCM_BOOL_F;
1303 #endif
1304 }
1305 #undef FUNC_NAME
1306
1307
1308 GUILE_PROC (scm_nice, "nice", 1, 0, 0,
1309             (SCM incr),
1310 "Increment the priority of the current process by @var{incr}.  A higher
1311 priority value means that the process runs less often.
1312 The return value is unspecified.")
1313 #define FUNC_NAME s_scm_nice
1314 {
1315 #ifdef HAVE_NICE
1316   SCM_VALIDATE_INT(1,incr);
1317   if (nice(SCM_INUM(incr)) != 0)
1318     SCM_SYSERROR;
1319   return SCM_UNSPECIFIED;
1320 #else
1321   SCM_SYSMISSING;
1322   /* not reached.  */
1323   return SCM_BOOL_F;
1324 #endif
1325 }
1326 #undef FUNC_NAME
1327
1328
1329 GUILE_PROC (scm_sync, "sync", 0, 0, 0,
1330             (),
1331 "Flush the operating system disk buffers.
1332 The return value is unspecified.")
1333 #define FUNC_NAME s_scm_sync
1334 {
1335 #ifdef HAVE_SYNC
1336   sync();
1337 #else
1338   SCM_SYSMISSING;
1339   /* not reached.  */
1340 #endif
1341   return SCM_UNSPECIFIED;
1342 }
1343 #undef FUNC_NAME
1344
1345 void
1346 scm_init_posix ()
1347 {
1348   scm_add_feature ("posix");
1349 #ifdef HAVE_GETEUID
1350   scm_add_feature ("EIDs");
1351 #endif
1352 #ifdef WAIT_ANY
1353   scm_sysintern ("WAIT_ANY", SCM_MAKINUM (WAIT_ANY));
1354 #endif
1355 #ifdef WAIT_MYPGRP
1356   scm_sysintern ("WAIT_MYPGRP", SCM_MAKINUM (WAIT_MYPGRP));
1357 #endif
1358 #ifdef WNOHANG
1359   scm_sysintern ("WNOHANG", SCM_MAKINUM (WNOHANG));
1360 #endif
1361 #ifdef WUNTRACED
1362   scm_sysintern ("WUNTRACED", SCM_MAKINUM (WUNTRACED));
1363 #endif
1364
1365   /* access() symbols.  */
1366   scm_sysintern ("R_OK", SCM_MAKINUM (R_OK));
1367   scm_sysintern ("W_OK", SCM_MAKINUM (W_OK));
1368   scm_sysintern ("X_OK", SCM_MAKINUM (X_OK));
1369   scm_sysintern ("F_OK", SCM_MAKINUM (F_OK));
1370
1371 #ifdef LC_COLLATE
1372   scm_sysintern ("LC_COLLATE", SCM_MAKINUM (LC_COLLATE));
1373 #endif
1374 #ifdef LC_CTYPE
1375   scm_sysintern ("LC_CTYPE", SCM_MAKINUM (LC_CTYPE));
1376 #endif
1377 #ifdef LC_MONETARY
1378   scm_sysintern ("LC_MONETARY", SCM_MAKINUM (LC_MONETARY));
1379 #endif
1380 #ifdef LC_NUMERIC
1381   scm_sysintern ("LC_NUMERIC", SCM_MAKINUM (LC_NUMERIC));
1382 #endif
1383 #ifdef LC_TIME
1384   scm_sysintern ("LC_TIME", SCM_MAKINUM (LC_TIME));
1385 #endif
1386 #ifdef LC_MESSAGES
1387   scm_sysintern ("LC_MESSAGES", SCM_MAKINUM (LC_MESSAGES));
1388 #endif
1389 #ifdef LC_ALL
1390   scm_sysintern ("LC_ALL", SCM_MAKINUM (LC_ALL));
1391 #endif
1392 #include "cpp_sig_symbols.c"
1393 #include "posix.x"
1394 }