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