libguile/posix.c

   1 /*      Copyright (C) 1995, 1996 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, 675 Mass Ave, Cambridge, MA 02139, USA.
  16  *
  17  * As a special exception, the Free Software Foundation gives permission
  18  * for additional uses of the text contained in its release of GUILE.
  19  *
  20  * The exception is that, if you link the GUILE library with other files
  21  * to produce an executable, this does not by itself cause the
  22  * resulting executable to be covered by the GNU General Public License.
  23  * Your use of that executable is in no way restricted on account of
  24  * linking the GUILE library code into it.
  25  *
  26  * This exception does not however invalidate any other reasons why
  27  * the executable file might be covered by the GNU General Public License.
  28  *
  29  * This exception applies only to the code released by the
  30  * Free Software Foundation under the name GUILE.  If you copy
  31  * code from other Free Software Foundation releases into a copy of
  32  * GUILE, as the General Public License permits, the exception does
  33  * not apply to the code that you add in this way.  To avoid misleading
  34  * anyone as to the status of such modified files, you must delete
  35  * this exception notice from them.
  36  *
  37  * If you write modifications of your own for GUILE, it is your choice
  38  * whether to permit this exception to apply to your modifications.
  39  * If you do not wish that, delete this exception notice.
  40  */
  41 \f
  42
  43 #include <stdio.h>
  44 #include "_scm.h"
  45
  46 \f
  47
  48 #ifdef TIME_WITH_SYS_TIME
  49 # include <sys/time.h>
  50 # include <time.h>
  51 #else
  52 # if HAVE_SYS_TIME_H
  53 #  include <sys/time.h>
  54 # else
  55 #  include <time.h>
  56 # endif
  57 #endif
  58
  59 #ifdef HAVE_UNISTD_H
  60 #include <unistd.h>
  61 #endif
  62
  63 #ifdef HAVE_SYS_SELECT_H
  64 #include <sys/select.h>
  65 #endif
  66
  67 #include <sys/types.h>
  68 #include <sys/stat.h>
  69 #include <fcntl.h>
  70
  71 #include <pwd.h>
  72
  73 #if HAVE_SYS_WAIT_H
  74 # include <sys/wait.h>
  75 #endif
  76 #ifndef WEXITSTATUS
  77 # define WEXITSTATUS(stat_val) ((unsigned)(stat_val) >> 8)
  78 #endif
  79 #ifndef WIFEXITED
  80 # define WIFEXITED(stat_val) (((stat_val) & 255) == 0)
  81 #endif
  82
  83 #include <signal.h>
  84
  85 #ifdef FD_SET
  86
  87 #define SELECT_TYPE fd_set
  88 #define SELECT_SET_SIZE FD_SETSIZE
  89
  90 #else /* no FD_SET */
  91
  92 /* Define the macros to access a single-int bitmap of descriptors.  */
  93 #define SELECT_SET_SIZE 32
  94 #define SELECT_TYPE int
  95 #define FD_SET(n, p) (*(p) |= (1 << (n)))
  96 #define FD_CLR(n, p) (*(p) &= ~(1 << (n)))
  97 #define FD_ISSET(n, p) (*(p) & (1 << (n)))
  98 #define FD_ZERO(p) (*(p) = 0)
  99
 100 #endif /* no FD_SET */
 101
 102 extern char *ttyname ();
 103 extern FILE *popen ();
 104 extern char ** environ;
 105
 106 #include <grp.h>
 107 #include <sys/utsname.h>
 108
 109 #if HAVE_DIRENT_H
 110 # include <dirent.h>
 111 # define NAMLEN(dirent) strlen((dirent)->d_name)
 112 #else
 113 # define dirent direct
 114 # define NAMLEN(dirent) (dirent)->d_namlen
 115 # if HAVE_SYS_NDIR_H
 116 #  include <sys/ndir.h>
 117 # endif
 118 # if HAVE_SYS_DIR_H
 119 #  include <sys/dir.h>
 120 # endif
 121 # if HAVE_NDIR_H
 122 #  include <ndir.h>
 123 # endif
 124 #endif
 125
 126 char *strptime ();
 127
 128 #ifdef HAVE_SETLOCALE
 129 #include <locale.h>
 130 #endif
 131
 132
 133 \f
 134
 135
 136 SCM_PROC (s_sys_pipe, "%pipe", 0, 0, 0, scm_sys_pipe);
 137 #ifdef __STDC__
 138 SCM
 139 scm_sys_pipe (void)
 140 #else
 141 SCM
 142 scm_sys_pipe ()
 143 #endif
 144 {
 145   int fd[2], rv;
 146   FILE *f_rd, *f_wt;
 147   SCM p_rd, p_wt;
 148   SCM_NEWCELL (p_rd);
 149   SCM_NEWCELL (p_wt);
 150   rv = pipe (fd);
 151   if (rv)
 152     {
 153       SCM_ALLOW_INTS;
 154       return SCM_BOOL_F;
 155     }
 156   f_rd = fdopen (fd[0], "r");
 157   if (!f_rd)
 158     {
 159       SCM_SYSCALL (close (fd[0]));
 160       SCM_SYSCALL (close (fd[1]));
 161       SCM_ALLOW_INTS;
 162       return SCM_BOOL_F;
 163     }
 164   f_wt = fdopen (fd[1], "w");
 165   if (!f_wt)
 166     {
 167       int en;
 168       en = errno;
 169       fclose (f_rd);
 170       SCM_SYSCALL (close (fd[1]));
 171       SCM_ALLOW_INTS;
 172       return SCM_MAKINUM (en);
 173     }
 174     {
 175       struct scm_port_table * ptr;
 176       struct scm_port_table * ptw;
 177
 178       ptr = scm_add_to_port_table (p_rd);
 179       ptw = scm_add_to_port_table (p_wt);
 180       SCM_SETPTAB_ENTRY (p_rd, ptr);
 181       SCM_SETPTAB_ENTRY (p_wt, ptw);
 182       SCM_CAR (p_rd) = scm_tc16_fport | scm_mode_bits ("r");
 183       SCM_CAR (p_wt) = scm_tc16_fport | scm_mode_bits ("w");
 184       SCM_SETSTREAM (p_rd, (SCM)f_rd);
 185       SCM_SETSTREAM (p_wt, (SCM)f_wt);
 186     }
 187   SCM_ALLOW_INTS;
 188   return scm_cons (p_rd, p_wt);
 189 }
 190
 191
 192
 193 SCM_PROC (s_sys_getgroups, "%getgroups", 0, 0, 0, scm_sys_getgroups);
 194 #ifdef __STDC__
 195 SCM
 196 scm_sys_getgroups(void)
 197 #else
 198 SCM
 199 scm_sys_getgroups()
 200 #endif
 201 {
 202   SCM grps, ans;
 203   int ngroups = getgroups (0, NULL);
 204   if (!ngroups) return SCM_BOOL_F;
 205   SCM_NEWCELL(grps);
 206   SCM_DEFER_INTS;
 207   {
 208     GETGROUPS_T *groups;
 209     int val;
 210
 211     groups = (gid_t *)scm_must_malloc(ngroups * sizeof(GETGROUPS_T),
 212                                       s_sys_getgroups);
 213     val = getgroups(ngroups, groups);
 214     if (val < 0)
 215       {
 216         scm_must_free((char *)groups);
 217         SCM_ALLOW_INTS;
 218         return SCM_MAKINUM (errno);
 219       }
 220     SCM_SETCHARS(grps, groups); /* set up grps as a GC protect */
 221     SCM_SETLENGTH(grps, 0L + ngroups * sizeof(GETGROUPS_T), scm_tc7_string);
 222     SCM_ALLOW_INTS;
 223     ans = scm_make_vector(SCM_MAKINUM(ngroups), SCM_UNDEFINED, SCM_BOOL_F);
 224     while (--ngroups >= 0) SCM_VELTS(ans)[ngroups] = SCM_MAKINUM(groups[ngroups]);
 225     SCM_SETCHARS(grps, groups); /* to make sure grps stays around. */
 226     return ans;
 227   }
 228 }
 229
 230
 231
 232 SCM_PROC (s_sys_getpwuid, "%getpw", 0, 1, 0, scm_sys_getpwuid);
 233 #ifdef __STDC__
 234 SCM
 235 scm_sys_getpwuid (SCM user)
 236 #else
 237 SCM
 238 scm_sys_getpwuid (user)
 239      SCM user;
 240 #endif
 241 {
 242   SCM result;
 243   struct passwd *entry;
 244   SCM *ve;
 245
 246   result = scm_make_vector (SCM_MAKINUM (7), SCM_UNSPECIFIED, SCM_BOOL_F);
 247   ve = SCM_VELTS (result);
 248   if (SCM_UNBNDP (user) || SCM_FALSEP (user))
 249     {
 250       SCM_DEFER_INTS;
 251       SCM_SYSCALL (entry = getpwent ());
 252     }
 253   else if (SCM_INUMP (user))
 254     {
 255       SCM_DEFER_INTS;
 256       entry = getpwuid (SCM_INUM (user));
 257     }
 258   else
 259     {
 260       SCM_ASSERT (SCM_NIMP (user) && SCM_ROSTRINGP (user), user, SCM_ARG1, s_sys_getpwuid);
 261       if (SCM_SUBSTRP (user))
 262         user = scm_makfromstr (SCM_ROCHARS (user), SCM_ROLENGTH (user), 0);
 263       SCM_DEFER_INTS;
 264       entry = getpwnam (SCM_ROCHARS (user));
 265     }
 266   if (!entry)
 267     {
 268       SCM_ALLOW_INTS;
 269       return SCM_BOOL_F;
 270     }
 271   ve[0] = scm_makfrom0str (entry->pw_name);
 272   ve[1] = scm_makfrom0str (entry->pw_passwd);
 273   ve[2] = scm_ulong2num ((unsigned long) entry->pw_uid);
 274   ve[3] = scm_ulong2num ((unsigned long) entry->pw_gid);
 275   ve[4] = scm_makfrom0str (entry->pw_gecos);
 276   if (!entry->pw_dir)
 277     ve[5] = scm_makfrom0str ("");
 278   else
 279     ve[5] = scm_makfrom0str (entry->pw_dir);
 280   if (!entry->pw_shell)
 281     ve[6] = scm_makfrom0str ("");
 282   else
 283     ve[6] = scm_makfrom0str (entry->pw_shell);
 284   SCM_ALLOW_INTS;
 285   return result;
 286 }
 287
 288
 289
 290 SCM_PROC (s_setpwent, "setpw", 0, 1, 0, scm_setpwent);
 291 #ifdef __STDC__
 292 SCM
 293 scm_setpwent (SCM arg)
 294 #else
 295 SCM
 296 scm_setpwent (arg)
 297      SCM arg;
 298 #endif
 299 {
 300   if (SCM_UNBNDP (arg) || SCM_FALSEP (arg))
 301     endpwent ();
 302   else
 303     setpwent ();
 304   return SCM_UNSPECIFIED;
 305 }
 306
 307
 308
 309 /* Combines getgrgid and getgrnam.  */
 310 SCM_PROC (s_sys_getgrgid, "%getgr", 0, 1, 0, scm_sys_getgrgid);
 311 #ifdef __STDC__
 312 SCM
 313 scm_sys_getgrgid (SCM name)
 314 #else
 315 SCM
 316 scm_sys_getgrgid (name)
 317      SCM name;
 318 #endif
 319 {
 320   SCM result;
 321   struct group *entry;
 322   SCM *ve;
 323   result = scm_make_vector (SCM_MAKINUM (4), SCM_UNSPECIFIED, SCM_BOOL_F);
 324   ve = SCM_VELTS (result);
 325   SCM_DEFER_INTS;
 326   if (SCM_UNBNDP (name) || (name == SCM_BOOL_F))
 327     SCM_SYSCALL (entry = getgrent ());
 328   else if (SCM_INUMP (name))
 329     SCM_SYSCALL (entry = getgrgid (SCM_INUM (name)));
 330   else
 331     {
 332       SCM_ASSERT (SCM_NIMP (name) && SCM_STRINGP (name), name, SCM_ARG1, s_sys_getgrgid);
 333       if (SCM_SUBSTRP (name))
 334         name = scm_makfromstr (SCM_ROCHARS (name), SCM_ROLENGTH (name), 0);
 335       SCM_SYSCALL (entry = getgrnam (SCM_CHARS (name)));
 336     }
 337   if (!entry)
 338     {
 339       SCM_ALLOW_INTS;
 340       return SCM_MAKINUM (errno);
 341     }
 342   ve[0] = scm_makfrom0str (entry->gr_name);
 343   ve[1] = scm_makfrom0str (entry->gr_passwd);
 344   ve[2] = scm_ulong2num ((unsigned long) entry->gr_gid);
 345   ve[3] = scm_makfromstrs (-1, entry->gr_mem);
 346   SCM_ALLOW_INTS;
 347   return result;
 348 }
 349
 350
 351
 352 SCM_PROC (s_setgrent, "setgr", 0, 1, 0, scm_setgrent);
 353 #ifdef __STDC__
 354 SCM
 355 scm_setgrent (SCM arg)
 356 #else
 357 SCM
 358 scm_setgrent (arg)
 359      SCM arg;
 360 #endif
 361 {
 362   if (SCM_UNBNDP (arg) || SCM_FALSEP (arg))
 363     endgrent ();
 364   else
 365     setgrent ();
 366   return SCM_UNSPECIFIED;
 367 }
 368
 369
 370
 371 SCM_PROC (s_sys_kill, "%kill", 2, 0, 0, scm_sys_kill);
 372 #ifdef __STDC__
 373 SCM
 374 scm_sys_kill (SCM pid, SCM sig)
 375 #else
 376 SCM
 377 scm_sys_kill (pid, sig)
 378      SCM pid;
 379      SCM sig;
 380 #endif
 381 {
 382   int i;
 383   SCM_ASSERT (SCM_INUMP (pid), pid, SCM_ARG1, s_sys_kill);
 384   SCM_ASSERT (SCM_INUMP (sig), sig, SCM_ARG2, s_sys_kill);
 385   /* Signal values are interned in scm_init_posix().  */
 386   SCM_SYSCALL (i = kill ((int) SCM_INUM (pid), (int) SCM_INUM (sig)));
 387   return i ? SCM_MAKINUM (errno) : SCM_BOOL_T;
 388 }
 389
 390
 391
 392 SCM_PROC (s_sys_waitpid, "%waitpid", 1, 1, 0, scm_sys_waitpid);
 393 #ifdef __STDC__
 394 SCM
 395 scm_sys_waitpid (SCM pid, SCM options)
 396 #else
 397 SCM
 398 scm_sys_waitpid (pid, options)
 399      SCM pid;
 400      SCM options;
 401 #endif
 402 {
 403   int i;
 404   int status;
 405   int ioptions;
 406   SCM_ASSERT (SCM_INUMP (pid), pid, SCM_ARG1, s_sys_waitpid);
 407   if (SCM_UNBNDP (options))
 408     ioptions = 0;
 409   else
 410     {
 411       SCM_ASSERT (SCM_INUMP (options), options, SCM_ARG2, s_sys_waitpid);
 412       /* Flags are interned in scm_init_posix.  */
 413       ioptions = SCM_INUM (options);
 414     }
 415   SCM_SYSCALL (i = waitpid (SCM_INUM (pid), &status, ioptions));
 416   return ((i == -1)
 417           ? SCM_MAKINUM (errno)
 418           : scm_cons (SCM_MAKINUM (0L + i), SCM_MAKINUM (0L + status)));
 419 }
 420
 421
 422
 423 SCM_PROC (s_getppid, "getppid", 0, 0, 0, scm_getppid);
 424 #ifdef __STDC__
 425 SCM
 426 scm_getppid (void)
 427 #else
 428 SCM
 429 scm_getppid ()
 430 #endif
 431 {
 432   return SCM_MAKINUM (0L + getppid ());
 433 }
 434
 435
 436
 437 SCM_PROC (s_getuid, "getuid", 0, 0, 0, scm_getuid);
 438 #ifdef __STDC__
 439 SCM
 440 scm_getuid (void)
 441 #else
 442 SCM
 443 scm_getuid ()
 444 #endif
 445 {
 446   return SCM_MAKINUM (0L + getuid ());
 447 }
 448
 449
 450
 451 SCM_PROC (s_getgid, "getgid", 0, 0, 0, scm_getgid);
 452 #ifdef __STDC__
 453 SCM
 454 scm_getgid (void)
 455 #else
 456 SCM
 457 scm_getgid ()
 458 #endif
 459 {
 460   return SCM_MAKINUM (0L + getgid ());
 461 }
 462
 463
 464
 465 SCM_PROC (s_geteuid, "geteuid", 0, 0, 0, scm_geteuid);
 466 #ifdef __STDC__
 467 SCM
 468 scm_geteuid (void)
 469 #else
 470 SCM
 471 scm_geteuid ()
 472 #endif
 473 {
 474 #ifdef HAVE_GETEUID
 475   return SCM_MAKINUM (0L + geteuid ());
 476 #else
 477   return SCM_MAKINUM (0L + getuid ());
 478 #endif
 479 }
 480
 481
 482
 483 SCM_PROC (s_getegid, "getegid", 0, 0, 0, scm_getegid);
 484 #ifdef __STDC__
 485 SCM
 486 scm_getegid (void)
 487 #else
 488 SCM
 489 scm_getegid ()
 490 #endif
 491 {
 492 #ifdef HAVE_GETEUID
 493   return SCM_MAKINUM (0L + getegid ());
 494 #else
 495   return SCM_MAKINUM (0L + getgid ());
 496 #endif
 497 }
 498
 499
 500 SCM_PROC (s_sys_setuid, "%setuid", 1, 0, 0, scm_sys_setuid);
 501 #ifdef __STDC__
 502 SCM
 503 scm_sys_setuid (SCM id)
 504 #else
 505 SCM
 506 scm_sys_setuid (id)
 507      SCM id;
 508 #endif
 509 {
 510   SCM_ASSERT (SCM_INUMP (id), id, SCM_ARG1, s_sys_setuid);
 511   return setuid (SCM_INUM (id)) ? SCM_MAKINUM (errno) : SCM_BOOL_T;
 512 }
 513
 514 SCM_PROC (s_sys_setgid, "%setgid", 1, 0, 0, scm_sys_setgid);
 515 #ifdef __STDC__
 516 SCM
 517 scm_sys_setgid (SCM id)
 518 #else
 519 SCM
 520 scm_sys_setgid (id)
 521      SCM id;
 522 #endif
 523 {
 524   SCM_ASSERT (SCM_INUMP (id), id, SCM_ARG1, s_sys_setgid);
 525   return setgid (SCM_INUM (id)) ? SCM_MAKINUM (errno) : SCM_BOOL_T;
 526 }
 527
 528 SCM_PROC (s_sys_seteuid, "%seteuid", 1, 0, 0, scm_sys_seteuid);
 529 #ifdef __STDC__
 530 SCM
 531 scm_sys_seteuid (SCM id)
 532 #else
 533 SCM
 534 scm_sys_seteuid (id)
 535      SCM id;
 536 #endif
 537 {
 538   SCM_ASSERT (SCM_INUMP (id), id, SCM_ARG1, s_sys_seteuid);
 539 #ifdef HAVE_SETEUID
 540   return seteuid (SCM_INUM (id)) ? SCM_MAKINUM (errno) : SCM_BOOL_T;
 541 #else
 542   return setuid (SCM_INUM (id)) ? SCM_MAKINUM (errno) : SCM_BOOL_T;
 543 #endif
 544 }
 545
 546 SCM_PROC (s_sys_setegid, "%setegid", 1, 0, 0, scm_sys_setegid);
 547 #ifdef __STDC__
 548 SCM
 549 scm_sys_setegid (SCM id)
 550 #else
 551 SCM
 552 scm_sys_setegid (id)
 553      SCM id;
 554 #endif
 555 {
 556   SCM_ASSERT (SCM_INUMP (id), id, SCM_ARG1, s_sys_setegid);
 557 #ifdef HAVE_SETEUID
 558   return setegid (SCM_INUM (id)) ? SCM_MAKINUM (errno) : SCM_BOOL_T;
 559 #else
 560   return setgid (SCM_INUM (id)) ? SCM_MAKINUM (errno) : SCM_BOOL_T;
 561 #endif
 562 }
 563
 564 SCM_PROC (s_getpgrp, "getpgrp", 0, 0, 0, scm_getpgrp);
 565 SCM
 566 scm_getpgrp ()
 567 {
 568   int (*fn)();
 569   fn = getpgrp;
 570   return SCM_MAKINUM (fn (0));
 571 }
 572
 573 SCM_PROC (s_setpgid, "%setpgid", 2, 0, 0, scm_setpgid);
 574 SCM
 575 scm_setpgid (pid, pgid)
 576      SCM pid, pgid;
 577 {
 578   SCM_ASSERT (SCM_INUMP (pid), pid, SCM_ARG1, s_setpgid);
 579   SCM_ASSERT (SCM_INUMP (pgid), pgid, SCM_ARG2, s_setpgid);
 580   /* This may be known as setpgrp, from BSD.  */
 581   return setpgid (SCM_INUM (pid), SCM_INUM (pgid)) ? SCM_MAKINUM (errno) : SCM_BOOL_T;
 582 }
 583
 584 SCM_PROC (s_setsid, "%setsid", 0, 0, 0, scm_setsid);
 585 SCM
 586 scm_setsid ()
 587 {
 588   pid_t sid = setsid ();
 589   return (sid == -1) ? SCM_BOOL_F : SCM_MAKINUM (sid);
 590 }
 591
 592 #ifndef ttyname
 593 extern char * ttyname();
 594 #endif
 595
 596 SCM_PROC (s_ttyname, "%ttyname", 1, 0, 0, scm_ttyname);
 597 #ifdef __STDC__
 598 SCM
 599 scm_ttyname (SCM port)
 600 #else
 601 SCM
 602 scm_ttyname (port)
 603      SCM port;
 604 #endif
 605 {
 606   char *ans;
 607   int fd;
 608   SCM_ASSERT (SCM_NIMP (port) && SCM_OPPORTP (port), port, SCM_ARG1, s_ttyname);
 609   if (scm_tc16_fport != SCM_TYP16 (port))
 610     return SCM_BOOL_F;
 611   fd = fileno ((FILE *)SCM_STREAM (port));
 612   if (fd != -1)
 613     SCM_SYSCALL (ans = ttyname (fd));
 614   /* ans could be overwritten by another call to ttyname */
 615   return (((fd != -1) && ans)
 616           ? scm_makfrom0str (ans)
 617           : SCM_MAKINUM (errno));
 618 }
 619
 620
 621 SCM_PROC (s_ctermid, "%ctermid", 0, 0, 0, scm_ctermid);
 622 SCM
 623 scm_ctermid ()
 624 {
 625   char *result = ctermid (NULL);
 626   return *result == '\0' ? SCM_BOOL_F : scm_makfrom0str (result);
 627 }
 628
 629 SCM_PROC (s_tcgetpgrp, "%tcgetpgrp", 1, 0, 0, scm_tcgetpgrp);
 630 SCM
 631 scm_tcgetpgrp (port)
 632      SCM port;
 633 {
 634   int fd;
 635   pid_t pgid;
 636   SCM_ASSERT (SCM_NIMP (port) && SCM_OPFPORTP (port), port, SCM_ARG1, s_tcgetpgrp);
 637   fd = fileno ((FILE *)SCM_STREAM (port));
 638   if (fd == -1 || (pgid = tcgetpgrp (fd)) == -1)
 639     return SCM_BOOL_F;
 640   else
 641     return SCM_MAKINUM (pgid);
 642 }
 643
 644 SCM_PROC (s_tcsetpgrp, "%tcsetpgrp", 2, 0, 0, scm_tcsetpgrp);
 645 SCM
 646 scm_tcsetpgrp (port, pgid)
 647      SCM port, pgid;
 648 {
 649   int fd;
 650   SCM_ASSERT (SCM_NIMP (port) && SCM_OPFPORTP (port), port, SCM_ARG1, s_tcsetpgrp);
 651   SCM_ASSERT (SCM_INUMP (pgid), pgid, SCM_ARG2, s_tcsetpgrp);
 652   fd = fileno ((FILE *)SCM_STREAM (port));
 653   if (fd == -1 || tcsetpgrp (fd, SCM_INUM (pgid)) == -1)
 654     return SCM_BOOL_F;
 655   else
 656     return SCM_BOOL_T;
 657 }
 658
 659 /* Copy exec args from an SCM vector into a new C array.  */
 660 #ifdef __STDC__
 661 static char **
 662 scm_convert_exec_args (SCM args)
 663 #else
 664 static char **
 665 scm_convert_exec_args (args)
 666      SCM args;
 667 #endif
 668 {
 669   char **execargv;
 670   int num_args;
 671   int i;
 672   SCM_DEFER_INTS;
 673   num_args = scm_ilength (args);
 674   execargv = (char **)
 675     scm_must_malloc ((num_args + 1) * sizeof (char *), s_ttyname);
 676   for (i = 0; SCM_NNULLP (args); args = SCM_CDR (args), ++i)
 677     {
 678       scm_sizet len;
 679       char *dst;
 680       char *src;
 681       SCM_ASSERT (SCM_NIMP (SCM_CAR (args)) && SCM_ROSTRINGP (SCM_CAR (args)), SCM_CAR (args),
 682               "wrong type in SCM_ARG", "exec arg");
 683       len = 1 + SCM_ROLENGTH (SCM_CAR (args));
 684       dst = (char *) scm_must_malloc ((long) len, s_ttyname);
 685       src = SCM_ROCHARS (SCM_CAR (args));
 686       while (len--)
 687         dst[len] = src[len];
 688       execargv[i] = dst;
 689     }
 690   execargv[i] = 0;
 691   SCM_ALLOW_INTS;
 692   return execargv;
 693 }
 694
 695 SCM_PROC (s_sys_execl, "%execl", 0, 0, 1, scm_sys_execl);
 696 #ifdef __STDC__
 697 SCM
 698 scm_sys_execl (SCM args)
 699 #else
 700 SCM
 701 scm_sys_execl (args)
 702      SCM args;
 703 #endif
 704 {
 705   char **execargv;
 706   SCM filename = SCM_CAR (args);
 707   SCM_ASSERT (SCM_NIMP (filename) && SCM_ROSTRINGP (filename), filename, SCM_ARG1, s_sys_execl);
 708   if (SCM_SUBSTRP (filename))
 709     filename = scm_makfromstr (SCM_ROCHARS (filename), SCM_ROLENGTH (filename), 0);
 710   args = SCM_CDR (args);
 711   execargv = scm_convert_exec_args (args);
 712   execv (SCM_ROCHARS (filename), execargv);
 713   return SCM_MAKINUM (errno);
 714 }
 715
 716 SCM_PROC (s_sys_execlp, "%execlp", 0, 0, 1, scm_sys_execlp);
 717 #ifdef __STDC__
 718 SCM
 719 scm_sys_execlp (SCM args)
 720 #else
 721 SCM
 722 scm_sys_execlp (args)
 723      SCM args;
 724 #endif
 725 {
 726   char **execargv;
 727   SCM filename = SCM_CAR (args);
 728   SCM_ASSERT (SCM_NIMP (filename) && SCM_ROSTRINGP (filename), filename, SCM_ARG1, s_sys_execlp);
 729   if (SCM_SUBSTRP (filename))
 730     filename = scm_makfromstr (SCM_ROCHARS (filename), SCM_ROLENGTH (filename), 0);
 731   args = SCM_CDR (args);
 732   execargv = scm_convert_exec_args (args);
 733   execvp (SCM_ROCHARS (filename), execargv);
 734   return SCM_MAKINUM (errno);
 735 }
 736
 737 /* Flushing streams etc., is not done here.  */
 738 SCM_PROC (s_sys_fork, "%fork", 0, 0, 0, scm_sys_fork);
 739 #ifdef __STDC__
 740 SCM
 741 scm_sys_fork(void)
 742 #else
 743 SCM
 744 scm_sys_fork()
 745 #endif
 746 {
 747   pid_t pid;
 748   pid = fork ();
 749   if (pid == -1)
 750     return SCM_BOOL_F;
 751   else
 752     return SCM_MAKINUM (0L+pid);
 753 }
 754
 755
 756 SCM_PROC (s_sys_uname, "%uname", 0, 0, 0, scm_sys_uname);
 757 #ifdef __STDC__
 758 SCM
 759 scm_sys_uname (void)
 760 #else
 761 SCM
 762 scm_sys_uname ()
 763 #endif
 764 {
 765 #ifdef HAVE_UNAME
 766   struct utsname buf;
 767   SCM ans = scm_make_vector(SCM_MAKINUM(5), SCM_UNSPECIFIED, SCM_BOOL_F);
 768   SCM *ve = SCM_VELTS (ans);
 769   if (uname (&buf))
 770     return SCM_MAKINUM (errno);
 771   ve[0] = scm_makfrom0str (buf.sysname);
 772   ve[1] = scm_makfrom0str (buf.nodename);
 773   ve[2] = scm_makfrom0str (buf.release);
 774   ve[3] = scm_makfrom0str (buf.version);
 775   ve[4] = scm_makfrom0str (buf.machine);
 776 /*
 777   FIXME
 778   ve[5] = scm_makfrom0str (buf.domainname);
 779 */
 780   return ans;
 781 #else
 782   return SCM_MAKINUM (ENOSYS);
 783 #endif
 784 }
 785
 786 SCM_PROC (s_environ, "environ", 0, 1, 0, scm_environ);
 787 #ifdef __STDC__
 788 SCM
 789 scm_environ (SCM env)
 790 #else
 791 SCM
 792 scm_environ (env)
 793      SCM env;
 794 #endif
 795 {
 796   if (SCM_UNBNDP (env))
 797     return scm_makfromstrs (-1, environ);
 798   else
 799     {
 800       int num_strings;
 801       char **new_environ;
 802       int i = 0;
 803       SCM_ASSERT (SCM_NULLP (env) || (SCM_NIMP (env) && SCM_CONSP (env)),
 804               env, SCM_ARG1, s_environ);
 805       num_strings = scm_ilength (env);
 806       new_environ = (char **) scm_must_malloc ((num_strings + 1)
 807                                                * sizeof (char *),
 808                                                s_environ);
 809       while (SCM_NNULLP (env))
 810         {
 811           int len;
 812           char *src;
 813           SCM_ASSERT (SCM_NIMP (SCM_CAR (env)) && SCM_ROSTRINGP (SCM_CAR (env)), env, SCM_ARG1,
 814                   s_environ);
 815           len = 1 + SCM_ROLENGTH (SCM_CAR (env));
 816           new_environ[i] = scm_must_malloc ((long) len, s_environ);
 817           src = SCM_ROCHARS (SCM_CAR (env));
 818           while (len--)
 819             new_environ[i][len] = src[len];
 820           env = SCM_CDR (env);
 821           i++;
 822         }
 823       new_environ[i] = 0;
 824       /* Free the old environment, except when called for the first
 825        * time.
 826        */
 827       {
 828         char **ep;
 829         static int first = 1;
 830         if (!first)
 831           {
 832             for (ep = environ; *ep != NULL; ep++)
 833               scm_must_free (*ep);
 834             scm_must_free ((char *) environ);
 835           }
 836         first = 0;
 837       }
 838       environ = new_environ;
 839       return SCM_UNSPECIFIED;
 840     }
 841 }
 842
 843
 844 SCM_PROC (s_open_pipe, "open-pipe", 2, 0, 0, scm_open_pipe);
 845 #ifdef __STDC__
 846 SCM
 847 scm_open_pipe (SCM pipestr, SCM modes)
 848 #else
 849 SCM
 850 scm_open_pipe (pipestr, modes)
 851      SCM pipestr;
 852      SCM modes;
 853 #endif
 854 {
 855   FILE *f;
 856   register SCM z;
 857   SCM_ASSERT (SCM_NIMP (pipestr) && SCM_ROSTRINGP (pipestr), pipestr, SCM_ARG1, s_open_pipe);
 858   if (SCM_SUBSTRP (pipestr))
 859     pipestr = scm_makfromstr (SCM_ROCHARS (pipestr), SCM_ROLENGTH (pipestr), 0);
 860   SCM_ASSERT (SCM_NIMP (modes) && SCM_ROSTRINGP (modes), modes, SCM_ARG2, s_open_pipe);
 861   if (SCM_SUBSTRP (modes))
 862     modes = scm_makfromstr (SCM_ROCHARS (modes), SCM_ROLENGTH (modes), 0);
 863   SCM_NEWCELL (z);
 864   SCM_DEFER_INTS;
 865   scm_ignore_signals ();
 866   SCM_SYSCALL (f = popen (SCM_ROCHARS (pipestr), SCM_ROCHARS (modes)));
 867   scm_unignore_signals ();
 868   if (!f)
 869     z = SCM_BOOL_F;
 870   else
 871     {
 872       struct scm_port_table * pt;
 873       pt = scm_add_to_port_table (z);
 874       SCM_SETPTAB_ENTRY (z, pt);
 875       SCM_CAR (z) = scm_tc16_pipe | SCM_OPN | (strchr (SCM_ROCHARS (modes), 'r') ? SCM_RDNG : SCM_WRTNG);
 876       SCM_SETSTREAM (z, (SCM)f);
 877     }
 878   SCM_ALLOW_INTS;
 879   return z;
 880 }
 881
 882
 883 SCM_PROC (s_open_input_pipe, "open-input-pipe", 1, 0, 0, scm_open_input_pipe);
 884 #ifdef __STDC__
 885 SCM
 886 scm_open_input_pipe(SCM pipestr)
 887 #else
 888 SCM
 889 scm_open_input_pipe(pipestr)
 890      SCM pipestr;
 891 #endif
 892 {
 893   return scm_open_pipe(pipestr, scm_makfromstr("r", (sizeof "r")-1, 0));
 894 }
 895
 896 SCM_PROC (s_open_output_pipe, "open-output-pipe", 1, 0, 0, scm_open_output_pipe);
 897 #ifdef __STDC__
 898 SCM
 899 scm_open_output_pipe(SCM pipestr)
 900 #else
 901 SCM
 902 scm_open_output_pipe(pipestr)
 903      SCM pipestr;
 904 #endif
 905 {
 906   return scm_open_pipe(pipestr, scm_makfromstr("w", (sizeof "w")-1, 0));
 907 }
 908
 909
 910 #ifdef __EMX__
 911 #include <sys/utime.h>
 912 #else
 913 #include <utime.h>
 914 #endif
 915
 916 SCM_PROC (s_sys_utime, "%utime", 1, 2, 0, scm_sys_utime);
 917 #ifdef __STDC__
 918 SCM
 919 scm_sys_utime (SCM pathname, SCM actime, SCM modtime)
 920 #else
 921 SCM
 922 scm_sys_utime (pathname, actime, modtime)
 923      SCM pathname;
 924      SCM actime;
 925      SCM modtime;
 926 #endif
 927 {
 928   int rv;
 929   struct utimbuf utm_tmp;
 930
 931   SCM_ASSERT (SCM_NIMP (pathname) && SCM_STRINGP (pathname), pathname, SCM_ARG1, s_sys_utime);
 932
 933   if (SCM_UNBNDP (actime))
 934     SCM_SYSCALL (time (&utm_tmp.actime));
 935   else
 936     utm_tmp.actime = scm_num2ulong (actime, (char *) SCM_ARG2, s_sys_utime);
 937
 938   if (SCM_UNBNDP (modtime))
 939     SCM_SYSCALL (time (&utm_tmp.modtime));
 940   else
 941     utm_tmp.modtime = scm_num2ulong (modtime, (char *) SCM_ARG3, s_sys_utime);
 942
 943   SCM_SYSCALL (rv = utime (SCM_CHARS (pathname), &utm_tmp));
 944   return rv ? SCM_MAKINUM (errno) : SCM_BOOL_T;
 945 }
 946
 947
 948
 949
 950
 951 SCM_PROC (s_sys_access, "access?", 2, 0, 0, scm_sys_access);
 952 #ifdef __STDC__
 953 SCM
 954 scm_sys_access (SCM path, SCM how)
 955 #else
 956 SCM
 957 scm_sys_access (path, how)
 958      SCM path;
 959      SCM how;
 960 #endif
 961 {
 962   int rv;
 963
 964   SCM_ASSERT (SCM_NIMP (path) && SCM_ROSTRINGP (path), path, SCM_ARG1, s_sys_access);
 965   if (SCM_SUBSTRP (path))
 966     path = scm_makfromstr (SCM_ROCHARS (path), SCM_ROLENGTH (path), 0);
 967   SCM_ASSERT (SCM_INUMP (how), how, SCM_ARG2, s_sys_access);
 968   rv = access (SCM_ROCHARS (path), SCM_INUM (how));
 969   return rv ? SCM_BOOL_F : SCM_BOOL_T;
 970 }
 971
 972
 973
 974 SCM_PROC (s_getpid, "getpid", 0, 0, 0, scm_getpid);
 975 #ifdef __STDC__
 976 SCM
 977 scm_getpid (void)
 978 #else
 979 SCM
 980 scm_getpid ()
 981 #endif
 982 {
 983   return SCM_MAKINUM ((unsigned long) getpid ());
 984 }
 985
 986
 987 SCM_PROC (s_sys_putenv, "%putenv", 1, 0, 0, scm_sys_putenv);
 988 #ifdef __STDC__
 989 SCM
 990 scm_sys_putenv (SCM str)
 991 #else
 992 SCM
 993 scm_sys_putenv (str)
 994      SCM str;
 995 #endif
 996 {
 997 #ifdef HAVE_PUTENV
 998   SCM_ASSERT (SCM_NIMP (str) && SCM_STRINGP (str), str, SCM_ARG1, s_sys_putenv);
 999   return putenv (SCM_CHARS (str)) ? SCM_MAKINUM (errno) : SCM_BOOL_T;
1000 #else
1001   return SCM_MAKINUM (ENOSYS);
1002 #endif
1003 }
1004
1005
1006 SCM_PROC (s_read_line, "read-line", 0, 2, 0, scm_read_line);
1007 #ifdef __STDC__
1008 SCM
1009 scm_read_line (SCM port, SCM include_terminator)
1010 #else
1011 SCM
1012 scm_read_line (port, include_terminator)
1013      SCM port;
1014      SCM include_terminator;
1015 #endif
1016 {
1017   register int c;
1018   register int j = 0;
1019   scm_sizet len = 30;
1020   SCM tok_buf;
1021   register char *p;
1022   int include;
1023
1024   tok_buf = scm_makstr ((long) len, 0);
1025   p = SCM_CHARS (tok_buf);
1026   if (SCM_UNBNDP (port))
1027     port = scm_cur_inp;
1028   else
1029     SCM_ASSERT (SCM_NIMP (port) && SCM_OPINPORTP (port), port, SCM_ARG1, s_read_line);
1030
1031   if (SCM_UNBNDP (include_terminator))
1032     include = 0;
1033   else
1034     include = SCM_NFALSEP (include_terminator);
1035
1036   if (EOF == (c = scm_gen_getc (port)))
1037     return SCM_EOF_VAL;
1038   while (1)
1039     {
1040       switch (c)
1041         {
1042         case SCM_LINE_INCREMENTORS:
1043           if (j >= len)
1044             {
1045               p = scm_grow_tok_buf (&tok_buf);
1046               len = SCM_LENGTH (tok_buf);
1047             }
1048           p[j++] = c;
1049           /* fallthrough */
1050         case EOF:
1051           if (len == j)
1052             return tok_buf;
1053           return scm_vector_set_length_x (tok_buf, (SCM) SCM_MAKINUM (j));
1054
1055         default:
1056           if (j >= len)
1057             {
1058               p = scm_grow_tok_buf (&tok_buf);
1059               len = SCM_LENGTH (tok_buf);
1060             }
1061           p[j++] = c;
1062           c = scm_gen_getc (port);
1063           break;
1064         }
1065     }
1066 }
1067
1068
1069
1070 SCM_PROC (s_read_line_x, "read-line!", 1, 1, 0, scm_read_line_x);
1071 #ifdef __STDC__
1072 SCM
1073 scm_read_line_x (SCM str, SCM port)
1074 #else
1075 SCM
1076 scm_read_line_x (str, port)
1077      SCM str;
1078      SCM port;
1079 #endif
1080 {
1081   register int c;
1082   register int j = 0;
1083   register char *p;
1084   scm_sizet len;
1085   SCM_ASSERT (SCM_NIMP (str) && SCM_STRINGP (str), str, SCM_ARG1, s_read_line_x);
1086   p = SCM_CHARS (str);
1087   len = SCM_LENGTH (str);
1088   if SCM_UNBNDP
1089     (port) port = scm_cur_inp;
1090   else
1091     SCM_ASSERT (SCM_NIMP (port) && SCM_OPINPORTP (port), port, SCM_ARG2, s_read_line_x);
1092   c = scm_gen_getc (port);
1093   if (EOF == c)
1094     return SCM_EOF_VAL;
1095   while (1)
1096     {
1097       switch (c)
1098         {
1099         case SCM_LINE_INCREMENTORS:
1100         case EOF:
1101           return SCM_MAKINUM (j);
1102         default:
1103           if (j >= len)
1104             {
1105               scm_gen_ungetc (c, port);
1106               return SCM_BOOL_F;
1107             }
1108           p[j++] = c;
1109           c = scm_gen_getc (port);
1110         }
1111     }
1112 }
1113
1114
1115
1116 SCM_PROC (s_write_line, "write-line", 1, 1, 0, scm_write_line);
1117 #ifdef __STDC__
1118 SCM
1119 scm_write_line (SCM obj, SCM port)
1120 #else
1121 SCM
1122 scm_write_line (obj, port)
1123      SCM obj;
1124      SCM port;
1125 #endif
1126 {
1127   scm_display (obj, port);
1128   return scm_newline (port);
1129 }
1130
1131
1132
1133 SCM_PROC (s_setlocale, "%setlocale", 1, 1, 0, scm_setlocale);
1134 #ifdef __STDC__
1135 SCM
1136 scm_setlocale (SCM category, SCM locale)
1137 #else
1138 SCM
1139 scm_setlocale (category, locale)
1140      SCM category;
1141      SCM locale;
1142 #endif
1143 {
1144 #ifdef HAVE_SETLOCALE
1145   char *clocale;
1146   char *rv;
1147
1148   SCM_ASSERT (SCM_INUMP (category), category, SCM_ARG1, s_setlocale);
1149   if (SCM_UNBNDP (locale))
1150     {
1151       clocale = NULL;
1152     }
1153   else
1154     {
1155       SCM_ASSERT (SCM_NIMP (locale) && SCM_STRINGP (locale), locale, SCM_ARG2, s_setlocale);
1156       clocale = SCM_CHARS (locale);
1157     }
1158
1159   rv = setlocale (SCM_INUM (category), clocale);
1160   return rv ? scm_makfrom0str (rv) : SCM_MAKINUM (errno);
1161 #else
1162   /* setlocale not available.  */
1163   return SCM_MAKINUM (errno);
1164 #endif
1165 }
1166
1167 SCM_PROC (s_strftime, "strftime", 2, 0, 0, scm_strftime);
1168 #ifdef __STDC__
1169 SCM
1170 scm_strftime (SCM format, SCM stime)
1171 #else
1172 SCM
1173 scm_strftime (format, stime)
1174      SCM format;
1175      SCM stime;
1176 #endif
1177 {
1178   struct tm t;
1179
1180   char *tbuf;
1181   int n;
1182   int size = 50;
1183   char *fmt;
1184   int len;
1185
1186   SCM_ASSERT (SCM_NIMP (format) && SCM_STRINGP (format), format, SCM_ARG1, s_strftime);
1187   SCM_ASSERT (SCM_NIMP (stime) && SCM_VECTORP (stime) && scm_obj_length (stime) == 9,
1188           stime, SCM_ARG2, s_strftime);
1189
1190   fmt = SCM_ROCHARS (format);
1191   len = SCM_ROLENGTH (format);
1192
1193 #define tm_deref scm_num2long (SCM_VELTS (stime)[n++], (char *)SCM_ARG2, s_strftime)
1194   n = 0;
1195   t.tm_sec = tm_deref;
1196   t.tm_min = tm_deref;
1197   t.tm_hour = tm_deref;
1198   t.tm_mday = tm_deref;
1199   t.tm_mon = tm_deref;
1200   t.tm_year = tm_deref;
1201   /* not used by mktime.
1202      t.tm_wday = tm_deref;
1203      t.tm_yday = tm_deref; */
1204   t.tm_isdst = tm_deref;
1205 #undef tm_deref
1206
1207   /* fill in missing fields and set the timezone.  */
1208   mktime (&t);
1209
1210   tbuf = scm_must_malloc (size, s_strftime);
1211   while ((len = strftime (tbuf, size, fmt, &t)) == size)
1212     {
1213       scm_must_free (tbuf);
1214       size *= 2;
1215       tbuf = scm_must_malloc (size, s_strftime);
1216     }
1217   return scm_makfromstr (tbuf, len, 0);
1218 }
1219
1220
1221
1222 SCM_PROC (s_sys_strptime, "%strptime", 2, 0, 0, scm_sys_strptime);
1223 #ifdef __STDC__
1224 SCM
1225 scm_sys_strptime (SCM format, SCM string)
1226 #else
1227 SCM
1228 scm_sys_strptime (format, string)
1229      SCM format;
1230      SCM string;
1231 #endif
1232 {
1233 #ifdef HAVE_STRPTIME
1234   SCM stime;
1235   struct tm t;
1236
1237   char *fmt, *str, *rest;
1238   int len;
1239   int n;
1240
1241   SCM_ASSERT (SCM_NIMP (format) && SCM_ROSTRINGP (format), format, SCM_ARG1, s_sys_strptime);
1242   if (SCM_SUBSTRP (format))
1243     format =  scm_makfromstr (SCM_ROCHARS (format), SCM_ROLENGTH (format), 0);
1244   SCM_ASSERT (SCM_NIMP (string) && SCM_ROSTRINGP (string), string, SCM_ARG2, s_sys_strptime);
1245   if (SCM_SUBSTRP (string))
1246     string =  scm_makfromstr (SCM_ROCHARS (string), SCM_ROLENGTH (string), 0);
1247
1248   fmt = SCM_CHARS (format);
1249   str = SCM_CHARS (string);
1250
1251   /* initialize the struct tm */
1252 #define tm_init(field) t.field = 0
1253   tm_init (tm_sec);
1254   tm_init (tm_min);
1255   tm_init (tm_hour);
1256   tm_init (tm_mday);
1257   tm_init (tm_mon);
1258   tm_init (tm_year);
1259   tm_init (tm_wday);
1260   tm_init (tm_yday);
1261   tm_init (tm_isdst);
1262 #undef tm_init
1263
1264   SCM_DEFER_INTS;
1265   rest = strptime (str, fmt, &t);
1266   SCM_ALLOW_INTS;
1267
1268   if (rest == NULL) {
1269     return SCM_BOOL_F;
1270   }
1271
1272   stime = scm_make_vector (SCM_MAKINUM (9), scm_long2num (0), SCM_UNDEFINED);
1273
1274 #define stime_set(val) scm_vector_set_x (stime, SCM_MAKINUM (n++), scm_long2num (t.val));
1275   n = 0;
1276   stime_set (tm_sec);
1277   stime_set (tm_min);
1278   stime_set (tm_hour);
1279   stime_set (tm_mday);
1280   stime_set (tm_mon);
1281   stime_set (tm_year);
1282   stime_set (tm_wday);
1283   stime_set (tm_yday);
1284   stime_set (tm_isdst);
1285 #undef stime_set
1286
1287   return scm_cons (stime, scm_makfrom0str (rest));
1288 #else
1289   scm_wta (SCM_UNSPECIFIED, "strptime is not available and no replacement has (yet) been supplied", "strptime");
1290   return SCM_BOOL_F;
1291 #endif
1292 }
1293
1294 SCM_PROC (s_sys_mknod, "%mknod", 3, 0, 0, scm_sys_mknod);
1295 #ifdef __STDC__
1296 SCM
1297 scm_sys_mknod(SCM path, SCM mode, SCM dev)
1298 #else
1299 SCM
1300 scm_sys_mknod(path, mode, dev)
1301      SCM path;
1302      SCM mode;
1303      SCM dev;
1304 #endif
1305 {
1306 #ifdef HAVE_MKNOD
1307   int val;
1308   SCM_ASSERT(SCM_NIMP(path) && SCM_STRINGP(path), path, SCM_ARG1, s_sys_mknod);
1309   SCM_ASSERT(SCM_INUMP(mode), mode, SCM_ARG2, s_sys_mknod);
1310   SCM_ASSERT(SCM_INUMP(dev), dev, SCM_ARG3, s_sys_mknod);
1311   SCM_SYSCALL(val = mknod(SCM_CHARS(path), SCM_INUM(mode), SCM_INUM(dev)));
1312   return val ? SCM_BOOL_F : SCM_BOOL_T;
1313 #else
1314   return SCM_BOOL_F;
1315 #endif
1316 }
1317
1318
1319 SCM_PROC (s_sys_nice, "%nice", 1, 0, 0, scm_sys_nice);
1320 #ifdef __STDC__
1321 SCM
1322 scm_sys_nice(SCM incr)
1323 #else
1324 SCM
1325 scm_sys_nice(incr)
1326      SCM incr;
1327 #endif
1328 {
1329 #ifdef HAVE_NICE
1330   SCM_ASSERT(SCM_INUMP(incr), incr, SCM_ARG1, s_sys_nice);
1331   return nice(SCM_INUM(incr)) ? SCM_MAKINUM (errno) : SCM_BOOL_T;
1332 #else
1333   return SCM_MAKINUM (ENOSYS);
1334 #endif
1335 }
1336
1337
1338 SCM_PROC (s_sync, "sync", 0, 0, 0, scm_sync);
1339 #ifdef __STDC__
1340 SCM
1341 scm_sync(void)
1342 #else
1343 SCM
1344 scm_sync()
1345 #endif
1346 {
1347 #ifdef HAVE_SYNC
1348   sync();
1349 #endif
1350   return SCM_UNSPECIFIED;
1351 }
1352
1353
1354
1355 #ifdef __STDC__
1356 void
1357 scm_init_posix (void)
1358 #else
1359 void
1360 scm_init_posix ()
1361 #endif
1362 {
1363   scm_add_feature ("posix");
1364 #ifdef HAVE_GETEUID
1365   scm_add_feature ("EIDs");
1366 #endif
1367 #ifdef WAIT_ANY
1368   scm_sysintern ("WAIT_ANY", SCM_MAKINUM (WAIT_ANY));
1369 #endif
1370 #ifdef WAIT_MYPGRP
1371   scm_sysintern ("WAIT_MYPGRP", SCM_MAKINUM (WAIT_MYPGRP));
1372 #endif
1373 #ifdef WNOHANG
1374   scm_sysintern ("WNOHANG", SCM_MAKINUM (WNOHANG));
1375 #endif
1376 #ifdef WUNTRACED
1377   scm_sysintern ("WUNTRACED", SCM_MAKINUM (WUNTRACED));
1378 #endif
1379
1380 #ifdef EINTR
1381   scm_sysintern ("EINTR", SCM_MAKINUM (EINTR));
1382 #endif
1383
1384 #ifdef SIGHUP
1385   scm_sysintern ("SIGHUP", SCM_MAKINUM (SIGHUP));
1386 #endif
1387 #ifdef SIGINT
1388   scm_sysintern ("SIGINT", SCM_MAKINUM (SIGINT));
1389 #endif
1390 #ifdef SIGQUIT
1391   scm_sysintern ("SIGQUIT", SCM_MAKINUM (SIGQUIT));
1392 #endif
1393 #ifdef SIGILL
1394   scm_sysintern ("SIGILL", SCM_MAKINUM (SIGILL));
1395 #endif
1396 #ifdef SIGTRAP
1397   scm_sysintern ("SIGTRAP", SCM_MAKINUM (SIGTRAP));
1398 #endif
1399 #ifdef SIGABRT
1400   scm_sysintern ("SIGABRT", SCM_MAKINUM (SIGABRT));
1401 #endif
1402 #ifdef SIGIOT
1403   scm_sysintern ("SIGIOT", SCM_MAKINUM (SIGIOT));
1404 #endif
1405 #ifdef SIGBUS
1406   scm_sysintern ("SIGBUS", SCM_MAKINUM (SIGBUS));
1407 #endif
1408 #ifdef SIGFPE
1409   scm_sysintern ("SIGFPE", SCM_MAKINUM (SIGFPE));
1410 #endif
1411 #ifdef SIGKILL
1412   scm_sysintern ("SIGKILL", SCM_MAKINUM (SIGKILL));
1413 #endif
1414 #ifdef SIGUSR1
1415   scm_sysintern ("SIGUSR1", SCM_MAKINUM (SIGUSR1));
1416 #endif
1417 #ifdef SIGSEGV
1418   scm_sysintern ("SIGSEGV", SCM_MAKINUM (SIGSEGV));
1419 #endif
1420 #ifdef SIGUSR2
1421   scm_sysintern ("SIGUSR2", SCM_MAKINUM (SIGUSR2));
1422 #endif
1423 #ifdef SIGPIPE
1424   scm_sysintern ("SIGPIPE", SCM_MAKINUM (SIGPIPE));
1425 #endif
1426 #ifdef SIGALRM
1427   scm_sysintern ("SIGALRM", SCM_MAKINUM (SIGALRM));
1428 #endif
1429 #ifdef SIGTERM
1430   scm_sysintern ("SIGTERM", SCM_MAKINUM (SIGTERM));
1431 #endif
1432 #ifdef SIGSTKFLT
1433   scm_sysintern ("SIGSTKFLT", SCM_MAKINUM (SIGSTKFLT));
1434 #endif
1435 #ifdef SIGCHLD
1436   scm_sysintern ("SIGCHLD", SCM_MAKINUM (SIGCHLD));
1437 #endif
1438 #ifdef SIGCONT
1439   scm_sysintern ("SIGCONT", SCM_MAKINUM (SIGCONT));
1440 #endif
1441 #ifdef SIGSTOP
1442   scm_sysintern ("SIGSTOP", SCM_MAKINUM (SIGSTOP));
1443 #endif
1444 #ifdef SIGTSTP
1445   scm_sysintern ("SIGTSTP", SCM_MAKINUM (SIGTSTP));
1446 #endif
1447 #ifdef SIGTTIN
1448   scm_sysintern ("SIGTTIN", SCM_MAKINUM (SIGTTIN));
1449 #endif
1450 #ifdef SIGTTOU
1451   scm_sysintern ("SIGTTOU", SCM_MAKINUM (SIGTTOU));
1452 #endif
1453 #ifdef SIGIO
1454   scm_sysintern ("SIGIO", SCM_MAKINUM (SIGIO));
1455 #endif
1456 #ifdef SIGPOLL
1457   scm_sysintern ("SIGPOLL", SCM_MAKINUM (SIGPOLL));
1458 #endif
1459 #ifdef SIGURG
1460   scm_sysintern ("SIGURG", SCM_MAKINUM (SIGURG));
1461 #endif
1462 #ifdef SIGXCPU
1463   scm_sysintern ("SIGXCPU", SCM_MAKINUM (SIGXCPU));
1464 #endif
1465 #ifdef SIGXFSZ
1466   scm_sysintern ("SIGXFSZ", SCM_MAKINUM (SIGXFSZ));
1467 #endif
1468 #ifdef SIGVTALRM
1469   scm_sysintern ("SIGVTALRM", SCM_MAKINUM (SIGVTALRM));
1470 #endif
1471 #ifdef SIGPROF
1472   scm_sysintern ("SIGPROF", SCM_MAKINUM (SIGPROF));
1473 #endif
1474 #ifdef SIGWINCH
1475   scm_sysintern ("SIGWINCH", SCM_MAKINUM (SIGWINCH));
1476 #endif
1477 #ifdef SIGLOST
1478   scm_sysintern ("SIGLOST", SCM_MAKINUM (SIGLOST));
1479 #endif
1480 #ifdef SIGPWR
1481   scm_sysintern ("SIGPWR", SCM_MAKINUM (SIGPWR));
1482 #endif
1483   /* access() symbols.  */
1484   scm_sysintern ("R_OK", SCM_MAKINUM (R_OK));
1485   scm_sysintern ("W_OK", SCM_MAKINUM (W_OK));
1486   scm_sysintern ("X_OK", SCM_MAKINUM (X_OK));
1487   scm_sysintern ("F_OK", SCM_MAKINUM (F_OK));
1488
1489 #ifdef LC_COLLATE
1490   scm_sysintern ("LC_COLLATE", SCM_MAKINUM (LC_COLLATE));
1491 #endif
1492 #ifdef LC_CTYPE
1493   scm_sysintern ("LC_CTYPE", SCM_MAKINUM (LC_CTYPE));
1494 #endif
1495 #ifdef LC_MONETARY
1496   scm_sysintern ("LC_MONETARY", SCM_MAKINUM (LC_MONETARY));
1497 #endif
1498 #ifdef LC_NUMERIC
1499   scm_sysintern ("LC_NUMERIC", SCM_MAKINUM (LC_NUMERIC));
1500 #endif
1501 #ifdef LC_TIME
1502   scm_sysintern ("LC_TIME", SCM_MAKINUM (LC_TIME));
1503 #endif
1504 #ifdef LC_MESSAGES
1505   scm_sysintern ("LC_MESSAGES", SCM_MAKINUM (LC_MESSAGES));
1506 #endif
1507 #ifdef LC_ALL
1508   scm_sysintern ("LC_ALL", SCM_MAKINUM (LC_ALL));
1509 #endif
1510 #include "posix.x"
1511 }