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