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 #ifdef HAVE_WAITPID
 401   int i;
 402   int status;
 403   int ioptions;
 404   SCM_ASSERT (SCM_INUMP (pid), pid, SCM_ARG1, s_sys_waitpid);
 405   if (SCM_UNBNDP (options))
 406     ioptions = 0;
 407   else
 408     {
 409       SCM_ASSERT (SCM_INUMP (options), options, SCM_ARG2, s_sys_waitpid);
 410       /* Flags are interned in scm_init_posix.  */
 411       ioptions = SCM_INUM (options);
 412     }
 413   SCM_SYSCALL (i = waitpid (SCM_INUM (pid), &status, ioptions));
 414   if (i == -1)
 415     SCM_SYSERROR (s_sys_waitpid);
 416   return scm_cons (SCM_MAKINUM (0L + i), SCM_MAKINUM (0L + status));
 417 #else
 418   SCM_SYSMISSING (s_sys_waitpid);
 419   /* not reached.  */
 420   return SCM_BOOL_F;
 421 #endif
 422 }
 423
 424
 425
 426 SCM_PROC (s_getppid, "getppid", 0, 0, 0, scm_getppid);
 427 #ifdef __STDC__
 428 SCM
 429 scm_getppid (void)
 430 #else
 431 SCM
 432 scm_getppid ()
 433 #endif
 434 {
 435   return SCM_MAKINUM (0L + getppid ());
 436 }
 437
 438
 439
 440 SCM_PROC (s_getuid, "getuid", 0, 0, 0, scm_getuid);
 441 #ifdef __STDC__
 442 SCM
 443 scm_getuid (void)
 444 #else
 445 SCM
 446 scm_getuid ()
 447 #endif
 448 {
 449   return SCM_MAKINUM (0L + getuid ());
 450 }
 451
 452
 453
 454 SCM_PROC (s_getgid, "getgid", 0, 0, 0, scm_getgid);
 455 #ifdef __STDC__
 456 SCM
 457 scm_getgid (void)
 458 #else
 459 SCM
 460 scm_getgid ()
 461 #endif
 462 {
 463   return SCM_MAKINUM (0L + getgid ());
 464 }
 465
 466
 467
 468 SCM_PROC (s_geteuid, "geteuid", 0, 0, 0, scm_geteuid);
 469 #ifdef __STDC__
 470 SCM
 471 scm_geteuid (void)
 472 #else
 473 SCM
 474 scm_geteuid ()
 475 #endif
 476 {
 477 #ifdef HAVE_GETEUID
 478   return SCM_MAKINUM (0L + geteuid ());
 479 #else
 480   return SCM_MAKINUM (0L + getuid ());
 481 #endif
 482 }
 483
 484
 485
 486 SCM_PROC (s_getegid, "getegid", 0, 0, 0, scm_getegid);
 487 #ifdef __STDC__
 488 SCM
 489 scm_getegid (void)
 490 #else
 491 SCM
 492 scm_getegid ()
 493 #endif
 494 {
 495 #ifdef HAVE_GETEUID
 496   return SCM_MAKINUM (0L + getegid ());
 497 #else
 498   return SCM_MAKINUM (0L + getgid ());
 499 #endif
 500 }
 501
 502
 503 SCM_PROC (s_sys_setuid, "setuid", 1, 0, 0, scm_sys_setuid);
 504 #ifdef __STDC__
 505 SCM
 506 scm_sys_setuid (SCM id)
 507 #else
 508 SCM
 509 scm_sys_setuid (id)
 510      SCM id;
 511 #endif
 512 {
 513   SCM_ASSERT (SCM_INUMP (id), id, SCM_ARG1, s_sys_setuid);
 514   if (setuid (SCM_INUM (id)) != 0)
 515     SCM_SYSERROR (s_sys_setuid);
 516   return SCM_UNSPECIFIED;
 517 }
 518
 519 SCM_PROC (s_sys_setgid, "setgid", 1, 0, 0, scm_sys_setgid);
 520 #ifdef __STDC__
 521 SCM
 522 scm_sys_setgid (SCM id)
 523 #else
 524 SCM
 525 scm_sys_setgid (id)
 526      SCM id;
 527 #endif
 528 {
 529   SCM_ASSERT (SCM_INUMP (id), id, SCM_ARG1, s_sys_setgid);
 530   if (setgid (SCM_INUM (id)) != 0)
 531     SCM_SYSERROR (s_sys_setgid);
 532   return SCM_UNSPECIFIED;
 533 }
 534
 535 SCM_PROC (s_sys_seteuid, "seteuid", 1, 0, 0, scm_sys_seteuid);
 536 #ifdef __STDC__
 537 SCM
 538 scm_sys_seteuid (SCM id)
 539 #else
 540 SCM
 541 scm_sys_seteuid (id)
 542      SCM id;
 543 #endif
 544 {
 545   int rv;
 546
 547   SCM_ASSERT (SCM_INUMP (id), id, SCM_ARG1, s_sys_seteuid);
 548 #ifdef HAVE_SETEUID
 549   rv = seteuid (SCM_INUM (id));
 550 #else
 551   rv = setuid (SCM_INUM (id));
 552 #endif
 553   if (rv != 0)
 554     SCM_SYSERROR (s_sys_seteuid);
 555   return SCM_UNSPECIFIED;
 556 }
 557
 558 SCM_PROC (s_sys_setegid, "setegid", 1, 0, 0, scm_sys_setegid);
 559 #ifdef __STDC__
 560 SCM
 561 scm_sys_setegid (SCM id)
 562 #else
 563 SCM
 564 scm_sys_setegid (id)
 565      SCM id;
 566 #endif
 567 {
 568   int rv;
 569
 570   SCM_ASSERT (SCM_INUMP (id), id, SCM_ARG1, s_sys_setegid);
 571 #ifdef HAVE_SETEUID
 572   rv = setegid (SCM_INUM (id));
 573 #else
 574   rv = setgid (SCM_INUM (id));
 575 #endif
 576   if (rv != 0)
 577     SCM_SYSERROR (s_sys_setegid);
 578   return SCM_UNSPECIFIED;
 579
 580 }
 581
 582 SCM_PROC (s_getpgrp, "getpgrp", 0, 0, 0, scm_getpgrp);
 583 SCM
 584 scm_getpgrp ()
 585 {
 586   int (*fn)();
 587   fn = getpgrp;
 588   return SCM_MAKINUM (fn (0));
 589 }
 590
 591 SCM_PROC (s_setpgid, "setpgid", 2, 0, 0, scm_setpgid);
 592 SCM
 593 scm_setpgid (pid, pgid)
 594      SCM pid, pgid;
 595 {
 596 #ifdef HAVE_SETPGID
 597   SCM_ASSERT (SCM_INUMP (pid), pid, SCM_ARG1, s_setpgid);
 598   SCM_ASSERT (SCM_INUMP (pgid), pgid, SCM_ARG2, s_setpgid);
 599   /* FIXME(?): may be known as setpgrp.  */
 600   if (setpgid (SCM_INUM (pid), SCM_INUM (pgid)) != 0)
 601     SCM_SYSERROR (s_setpgid);
 602   return SCM_UNSPECIFIED;
 603 #else
 604   SCM_SYSMISSING (s_sys_setpgid);
 605   /* not reached.  */
 606   return SCM_BOOL_F;
 607 #endif
 608 }
 609
 610 SCM_PROC (s_setsid, "setsid", 0, 0, 0, scm_setsid);
 611 SCM
 612 scm_setsid ()
 613 {
 614 #ifdef HAVE_SETSID
 615   pid_t sid = setsid ();
 616   if (sid == -1)
 617     SCM_SYSERROR (s_setsid);
 618   return SCM_UNSPECIFIED;
 619 #else
 620   SCM_SYSMISSING (s_sys_setsid);
 621   /* not reached.  */
 622   return SCM_BOOL_F;
 623 #endif
 624 }
 625
 626 SCM_PROC (s_ttyname, "ttyname", 1, 0, 0, scm_ttyname);
 627 #ifdef __STDC__
 628 SCM
 629 scm_ttyname (SCM port)
 630 #else
 631 SCM
 632 scm_ttyname (port)
 633      SCM port;
 634 #endif
 635 {
 636   char *ans;
 637   int fd;
 638   SCM_ASSERT (SCM_NIMP (port) && SCM_OPPORTP (port), port, SCM_ARG1, s_ttyname);
 639   if (scm_tc16_fport != SCM_TYP16 (port))
 640     return SCM_BOOL_F;
 641   fd = fileno ((FILE *)SCM_STREAM (port));
 642   if (fd == -1)
 643     SCM_SYSERROR (s_ttyname);
 644   SCM_SYSCALL (ans = ttyname (fd));
 645   if (!ans)
 646     SCM_SYSERROR (s_ttyname);
 647   /* ans could be overwritten by another call to ttyname */
 648   return (scm_makfrom0str (ans));
 649 }
 650
 651
 652 SCM_PROC (s_ctermid, "ctermid", 0, 0, 0, scm_ctermid);
 653 SCM
 654 scm_ctermid ()
 655 {
 656 #ifdef HAVE_CTERMID
 657   char *result = ctermid (NULL);
 658   if (*result == '\0')
 659     SCM_SYSERROR (s_ctermid);
 660   return scm_makfrom0str (result);
 661 #else
 662   SCM_SYSMISSING (s_sys_ctermid);
 663   /* not reached.  */
 664   return SCM_BOOL_F;
 665 #endif
 666 }
 667
 668 SCM_PROC (s_tcgetpgrp, "tcgetpgrp", 1, 0, 0, scm_tcgetpgrp);
 669 SCM
 670 scm_tcgetpgrp (port)
 671      SCM port;
 672 {
 673 #ifdef HAVE_TCGETPGRP
 674   int fd;
 675   pid_t pgid;
 676   SCM_ASSERT (SCM_NIMP (port) && SCM_OPFPORTP (port), port, SCM_ARG1, s_tcgetpgrp);
 677   fd = fileno ((FILE *)SCM_STREAM (port));
 678   if (fd == -1 || (pgid = tcgetpgrp (fd)) == -1)
 679     SCM_SYSERROR (s_tcgetpgrp);
 680   return SCM_MAKINUM (pgid);
 681 #else
 682   SCM_SYSMISSING (s_sys_tcgetpgrp);
 683   /* not reached.  */
 684   return SCM_BOOL_F;
 685 #endif
 686 }
 687
 688 SCM_PROC (s_tcsetpgrp, "tcsetpgrp", 2, 0, 0, scm_tcsetpgrp);
 689 SCM
 690 scm_tcsetpgrp (port, pgid)
 691      SCM port, pgid;
 692 {
 693 #ifdef HAVE_TCSETPGRP
 694   int fd;
 695   SCM_ASSERT (SCM_NIMP (port) && SCM_OPFPORTP (port), port, SCM_ARG1, s_tcsetpgrp);
 696   SCM_ASSERT (SCM_INUMP (pgid), pgid, SCM_ARG2, s_tcsetpgrp);
 697   fd = fileno ((FILE *)SCM_STREAM (port));
 698   if (fd == -1 || tcsetpgrp (fd, SCM_INUM (pgid)) == -1)
 699     SCM_SYSERROR (s_tcsetpgrp);
 700   return SCM_UNSPECIFIED;
 701 #else
 702   SCM_SYSMISSING (s_sys_tcsetpgrp);
 703   /* not reached.  */
 704   return SCM_BOOL_F;
 705 #endif
 706 }
 707
 708 /* Copy exec args from an SCM vector into a new C array.  */
 709 #ifdef __STDC__
 710 static char **
 711 scm_convert_exec_args (SCM args)
 712 #else
 713 static char **
 714 scm_convert_exec_args (args)
 715      SCM args;
 716 #endif
 717 {
 718   char **execargv;
 719   int num_args;
 720   int i;
 721   SCM_DEFER_INTS;
 722   num_args = scm_ilength (args);
 723   execargv = (char **)
 724     scm_must_malloc ((num_args + 1) * sizeof (char *), s_ttyname);
 725   for (i = 0; SCM_NNULLP (args); args = SCM_CDR (args), ++i)
 726     {
 727       scm_sizet len;
 728       char *dst;
 729       char *src;
 730       SCM_ASSERT (SCM_NIMP (SCM_CAR (args)) && SCM_ROSTRINGP (SCM_CAR (args)), SCM_CAR (args),
 731               "wrong type in SCM_ARG", "exec arg");
 732       len = 1 + SCM_ROLENGTH (SCM_CAR (args));
 733       dst = (char *) scm_must_malloc ((long) len, s_ttyname);
 734       src = SCM_ROCHARS (SCM_CAR (args));
 735       while (len--)
 736         dst[len] = src[len];
 737       execargv[i] = dst;
 738     }
 739   execargv[i] = 0;
 740   SCM_ALLOW_INTS;
 741   return execargv;
 742 }
 743
 744 SCM_PROC (s_sys_execl, "execl", 0, 0, 1, scm_sys_execl);
 745 #ifdef __STDC__
 746 SCM
 747 scm_sys_execl (SCM args)
 748 #else
 749 SCM
 750 scm_sys_execl (args)
 751      SCM args;
 752 #endif
 753 {
 754   char **execargv;
 755   SCM filename = SCM_CAR (args);
 756   SCM_ASSERT (SCM_NIMP (filename) && SCM_ROSTRINGP (filename), filename, SCM_ARG1, s_sys_execl);
 757   if (SCM_SUBSTRP (filename))
 758     filename = scm_makfromstr (SCM_ROCHARS (filename), SCM_ROLENGTH (filename), 0);
 759   args = SCM_CDR (args);
 760   execargv = scm_convert_exec_args (args);
 761   execv (SCM_ROCHARS (filename), execargv);
 762   SCM_SYSERROR (s_sys_execl);
 763   /* not reached.  */
 764   return SCM_BOOL_F;
 765 }
 766
 767 SCM_PROC (s_sys_execlp, "execlp", 0, 0, 1, scm_sys_execlp);
 768 #ifdef __STDC__
 769 SCM
 770 scm_sys_execlp (SCM args)
 771 #else
 772 SCM
 773 scm_sys_execlp (args)
 774      SCM args;
 775 #endif
 776 {
 777   char **execargv;
 778   SCM filename = SCM_CAR (args);
 779   SCM_ASSERT (SCM_NIMP (filename) && SCM_ROSTRINGP (filename), filename, SCM_ARG1, s_sys_execlp);
 780   if (SCM_SUBSTRP (filename))
 781     filename = scm_makfromstr (SCM_ROCHARS (filename), SCM_ROLENGTH (filename), 0);
 782   args = SCM_CDR (args);
 783   execargv = scm_convert_exec_args (args);
 784   execvp (SCM_ROCHARS (filename), execargv);
 785   SCM_SYSERROR (s_sys_execlp);
 786   /* not reached.  */
 787   return SCM_BOOL_F;
 788 }
 789
 790 /* Flushing streams etc., is not done here.  */
 791 SCM_PROC (s_sys_fork, "fork", 0, 0, 0, scm_sys_fork);
 792 #ifdef __STDC__
 793 SCM
 794 scm_sys_fork(void)
 795 #else
 796 SCM
 797 scm_sys_fork()
 798 #endif
 799 {
 800   pid_t pid;
 801   pid = fork ();
 802   if (pid == -1)
 803     SCM_SYSERROR (s_sys_fork);
 804   return SCM_MAKINUM (0L+pid);
 805 }
 806
 807
 808 SCM_PROC (s_sys_uname, "uname", 0, 0, 0, scm_sys_uname);
 809 #ifdef __STDC__
 810 SCM
 811 scm_sys_uname (void)
 812 #else
 813 SCM
 814 scm_sys_uname ()
 815 #endif
 816 {
 817 #ifdef HAVE_UNAME
 818   struct utsname buf;
 819   SCM ans = scm_make_vector(SCM_MAKINUM(5), SCM_UNSPECIFIED, SCM_BOOL_F);
 820   SCM *ve = SCM_VELTS (ans);
 821   if (uname (&buf))
 822     return SCM_MAKINUM (errno);
 823   ve[0] = scm_makfrom0str (buf.sysname);
 824   ve[1] = scm_makfrom0str (buf.nodename);
 825   ve[2] = scm_makfrom0str (buf.release);
 826   ve[3] = scm_makfrom0str (buf.version);
 827   ve[4] = scm_makfrom0str (buf.machine);
 828 /*
 829    a linux special?
 830   ve[5] = scm_makfrom0str (buf.domainname);
 831 */
 832   return ans;
 833 #else
 834   SCM_SYSMISSING (s_sys_uname);
 835   /* not reached.  */
 836   return SCM_BOOL_F;
 837 #endif
 838 }
 839
 840 SCM_PROC (s_environ, "environ", 0, 1, 0, scm_environ);
 841 #ifdef __STDC__
 842 SCM
 843 scm_environ (SCM env)
 844 #else
 845 SCM
 846 scm_environ (env)
 847      SCM env;
 848 #endif
 849 {
 850   if (SCM_UNBNDP (env))
 851     return scm_makfromstrs (-1, environ);
 852   else
 853     {
 854       int num_strings;
 855       char **new_environ;
 856       int i = 0;
 857       SCM_ASSERT (SCM_NULLP (env) || (SCM_NIMP (env) && SCM_CONSP (env)),
 858               env, SCM_ARG1, s_environ);
 859       num_strings = scm_ilength (env);
 860       new_environ = (char **) scm_must_malloc ((num_strings + 1)
 861                                                * sizeof (char *),
 862                                                s_environ);
 863       while (SCM_NNULLP (env))
 864         {
 865           int len;
 866           char *src;
 867           SCM_ASSERT (SCM_NIMP (SCM_CAR (env)) && SCM_ROSTRINGP (SCM_CAR (env)), env, SCM_ARG1,
 868                   s_environ);
 869           len = 1 + SCM_ROLENGTH (SCM_CAR (env));
 870           new_environ[i] = scm_must_malloc ((long) len, s_environ);
 871           src = SCM_ROCHARS (SCM_CAR (env));
 872           while (len--)
 873             new_environ[i][len] = src[len];
 874           env = SCM_CDR (env);
 875           i++;
 876         }
 877       new_environ[i] = 0;
 878       /* Free the old environment, except when called for the first
 879        * time.
 880        */
 881       {
 882         char **ep;
 883         static int first = 1;
 884         if (!first)
 885           {
 886             for (ep = environ; *ep != NULL; ep++)
 887               scm_must_free (*ep);
 888             scm_must_free ((char *) environ);
 889           }
 890         first = 0;
 891       }
 892       environ = new_environ;
 893       return SCM_UNSPECIFIED;
 894     }
 895 }
 896
 897
 898 SCM_PROC (s_open_pipe, "open-pipe", 2, 0, 0, scm_open_pipe);
 899 #ifdef __STDC__
 900 SCM
 901 scm_open_pipe (SCM pipestr, SCM modes)
 902 #else
 903 SCM
 904 scm_open_pipe (pipestr, modes)
 905      SCM pipestr;
 906      SCM modes;
 907 #endif
 908 {
 909   FILE *f;
 910   register SCM z;
 911   struct scm_port_table * pt;
 912
 913   SCM_ASSERT (SCM_NIMP (pipestr) && SCM_ROSTRINGP (pipestr), pipestr, SCM_ARG1, s_open_pipe);
 914   if (SCM_SUBSTRP (pipestr))
 915     pipestr = scm_makfromstr (SCM_ROCHARS (pipestr), SCM_ROLENGTH (pipestr), 0);
 916   SCM_ASSERT (SCM_NIMP (modes) && SCM_ROSTRINGP (modes), modes, SCM_ARG2, s_open_pipe);
 917   if (SCM_SUBSTRP (modes))
 918     modes = scm_makfromstr (SCM_ROCHARS (modes), SCM_ROLENGTH (modes), 0);
 919   SCM_NEWCELL (z);
 920   SCM_DEFER_INTS;
 921   scm_ignore_signals ();
 922   SCM_SYSCALL (f = popen (SCM_ROCHARS (pipestr), SCM_ROCHARS (modes)));
 923   scm_unignore_signals ();
 924   if (!f)
 925     SCM_SYSERROR (s_open_pipe);
 926   pt = scm_add_to_port_table (z);
 927   SCM_SETPTAB_ENTRY (z, pt);
 928   SCM_CAR (z) = scm_tc16_pipe | SCM_OPN
 929     | (strchr (SCM_ROCHARS (modes), 'r') ? SCM_RDNG : SCM_WRTNG);
 930   SCM_SETSTREAM (z, (SCM)f);
 931   SCM_ALLOW_INTS;
 932   return z;
 933 }
 934
 935
 936 SCM_PROC (s_open_input_pipe, "open-input-pipe", 1, 0, 0, scm_open_input_pipe);
 937 #ifdef __STDC__
 938 SCM
 939 scm_open_input_pipe(SCM pipestr)
 940 #else
 941 SCM
 942 scm_open_input_pipe(pipestr)
 943      SCM pipestr;
 944 #endif
 945 {
 946   return scm_open_pipe(pipestr, scm_makfromstr("r", (sizeof "r")-1, 0));
 947 }
 948
 949 SCM_PROC (s_open_output_pipe, "open-output-pipe", 1, 0, 0, scm_open_output_pipe);
 950 #ifdef __STDC__
 951 SCM
 952 scm_open_output_pipe(SCM pipestr)
 953 #else
 954 SCM
 955 scm_open_output_pipe(pipestr)
 956      SCM pipestr;
 957 #endif
 958 {
 959   return scm_open_pipe(pipestr, scm_makfromstr("w", (sizeof "w")-1, 0));
 960 }
 961
 962
 963 #ifdef __EMX__
 964 #include <sys/utime.h>
 965 #else
 966 #include <utime.h>
 967 #endif
 968
 969 SCM_PROC (s_sys_utime, "utime", 1, 2, 0, scm_sys_utime);
 970 #ifdef __STDC__
 971 SCM
 972 scm_sys_utime (SCM pathname, SCM actime, SCM modtime)
 973 #else
 974 SCM
 975 scm_sys_utime (pathname, actime, modtime)
 976      SCM pathname;
 977      SCM actime;
 978      SCM modtime;
 979 #endif
 980 {
 981   int rv;
 982   struct utimbuf utm_tmp;
 983
 984   SCM_ASSERT (SCM_NIMP (pathname) && SCM_STRINGP (pathname), pathname, SCM_ARG1, s_sys_utime);
 985
 986   if (SCM_UNBNDP (actime))
 987     SCM_SYSCALL (time (&utm_tmp.actime));
 988   else
 989     utm_tmp.actime = scm_num2ulong (actime, (char *) SCM_ARG2, s_sys_utime);
 990
 991   if (SCM_UNBNDP (modtime))
 992     SCM_SYSCALL (time (&utm_tmp.modtime));
 993   else
 994     utm_tmp.modtime = scm_num2ulong (modtime, (char *) SCM_ARG3, s_sys_utime);
 995
 996   SCM_SYSCALL (rv = utime (SCM_CHARS (pathname), &utm_tmp));
 997   if (rv != 0)
 998     SCM_SYSERROR (s_sys_utime);
 999   return SCM_UNSPECIFIED;
1000 }
1001
1002 SCM_PROC (s_sys_access, "access?", 2, 0, 0, scm_sys_access);
1003 #ifdef __STDC__
1004 SCM
1005 scm_sys_access (SCM path, SCM how)
1006 #else
1007 SCM
1008 scm_sys_access (path, how)
1009      SCM path;
1010      SCM how;
1011 #endif
1012 {
1013   int rv;
1014
1015   SCM_ASSERT (SCM_NIMP (path) && SCM_ROSTRINGP (path), path, SCM_ARG1, s_sys_access);
1016   if (SCM_SUBSTRP (path))
1017     path = scm_makfromstr (SCM_ROCHARS (path), SCM_ROLENGTH (path), 0);
1018   SCM_ASSERT (SCM_INUMP (how), how, SCM_ARG2, s_sys_access);
1019   rv = access (SCM_ROCHARS (path), SCM_INUM (how));
1020   return rv ? SCM_BOOL_F : SCM_BOOL_T;
1021 }
1022
1023 SCM_PROC (s_getpid, "getpid", 0, 0, 0, scm_getpid);
1024 #ifdef __STDC__
1025 SCM
1026 scm_getpid (void)
1027 #else
1028 SCM
1029 scm_getpid ()
1030 #endif
1031 {
1032   return SCM_MAKINUM ((unsigned long) getpid ());
1033 }
1034
1035 SCM_PROC (s_sys_putenv, "putenv", 1, 0, 0, scm_sys_putenv);
1036 #ifdef __STDC__
1037 SCM
1038 scm_sys_putenv (SCM str)
1039 #else
1040 SCM
1041 scm_sys_putenv (str)
1042      SCM str;
1043 #endif
1044 {
1045 #ifdef HAVE_PUTENV
1046   SCM_ASSERT (SCM_NIMP (str) && SCM_STRINGP (str), str, SCM_ARG1, s_sys_putenv);
1047   return putenv (SCM_CHARS (str)) ? SCM_MAKINUM (errno) : SCM_BOOL_T;
1048 #else
1049   SCM_SYSMISSING (s_sys_putenv);
1050   /* not reached.  */
1051   return SCM_BOOL_F;
1052 #endif
1053 }
1054
1055 SCM_PROC (s_read_line, "read-line", 0, 2, 0, scm_read_line);
1056 #ifdef __STDC__
1057 SCM
1058 scm_read_line (SCM port, SCM include_terminator)
1059 #else
1060 SCM
1061 scm_read_line (port, include_terminator)
1062      SCM port;
1063      SCM include_terminator;
1064 #endif
1065 {
1066   register int c;
1067   register int j = 0;
1068   scm_sizet len = 30;
1069   SCM tok_buf;
1070   register char *p;
1071   int include;
1072
1073   tok_buf = scm_makstr ((long) len, 0);
1074   p = SCM_CHARS (tok_buf);
1075   if (SCM_UNBNDP (port))
1076     port = scm_cur_inp;
1077   else
1078     SCM_ASSERT (SCM_NIMP (port) && SCM_OPINPORTP (port), port, SCM_ARG1, s_read_line);
1079
1080   if (SCM_UNBNDP (include_terminator))
1081     include = 0;
1082   else
1083     include = SCM_NFALSEP (include_terminator);
1084
1085   if (EOF == (c = scm_gen_getc (port)))
1086     return SCM_EOF_VAL;
1087   while (1)
1088     {
1089       switch (c)
1090         {
1091         case SCM_LINE_INCREMENTORS:
1092           if (j >= len)
1093             {
1094               p = scm_grow_tok_buf (&tok_buf);
1095               len = SCM_LENGTH (tok_buf);
1096             }
1097           p[j++] = c;
1098           /* fallthrough */
1099         case EOF:
1100           if (len == j)
1101             return tok_buf;
1102           return scm_vector_set_length_x (tok_buf, (SCM) SCM_MAKINUM (j));
1103
1104         default:
1105           if (j >= len)
1106             {
1107               p = scm_grow_tok_buf (&tok_buf);
1108               len = SCM_LENGTH (tok_buf);
1109             }
1110           p[j++] = c;
1111           c = scm_gen_getc (port);
1112           break;
1113         }
1114     }
1115 }
1116
1117 SCM_PROC (s_read_line_x, "read-line!", 1, 1, 0, scm_read_line_x);
1118 #ifdef __STDC__
1119 SCM
1120 scm_read_line_x (SCM str, SCM port)
1121 #else
1122 SCM
1123 scm_read_line_x (str, port)
1124      SCM str;
1125      SCM port;
1126 #endif
1127 {
1128   register int c;
1129   register int j = 0;
1130   register char *p;
1131   scm_sizet len;
1132   SCM_ASSERT (SCM_NIMP (str) && SCM_STRINGP (str), str, SCM_ARG1, s_read_line_x);
1133   p = SCM_CHARS (str);
1134   len = SCM_LENGTH (str);
1135   if SCM_UNBNDP
1136     (port) port = scm_cur_inp;
1137   else
1138     SCM_ASSERT (SCM_NIMP (port) && SCM_OPINPORTP (port), port, SCM_ARG2, s_read_line_x);
1139   c = scm_gen_getc (port);
1140   if (EOF == c)
1141     return SCM_EOF_VAL;
1142   while (1)
1143     {
1144       switch (c)
1145         {
1146         case SCM_LINE_INCREMENTORS:
1147         case EOF:
1148           return SCM_MAKINUM (j);
1149         default:
1150           if (j >= len)
1151             {
1152               scm_gen_ungetc (c, port);
1153               return SCM_BOOL_F;
1154             }
1155           p[j++] = c;
1156           c = scm_gen_getc (port);
1157         }
1158     }
1159 }
1160
1161 SCM_PROC (s_write_line, "write-line", 1, 1, 0, scm_write_line);
1162 #ifdef __STDC__
1163 SCM
1164 scm_write_line (SCM obj, SCM port)
1165 #else
1166 SCM
1167 scm_write_line (obj, port)
1168      SCM obj;
1169      SCM port;
1170 #endif
1171 {
1172   scm_display (obj, port);
1173   return scm_newline (port);
1174 }
1175
1176 SCM_PROC (s_setlocale, "setlocale", 1, 1, 0, scm_setlocale);
1177 #ifdef __STDC__
1178 SCM
1179 scm_setlocale (SCM category, SCM locale)
1180 #else
1181 SCM
1182 scm_setlocale (category, locale)
1183      SCM category;
1184      SCM locale;
1185 #endif
1186 {
1187 #ifdef HAVE_SETLOCALE
1188   char *clocale;
1189   char *rv;
1190
1191   SCM_ASSERT (SCM_INUMP (category), category, SCM_ARG1, s_setlocale);
1192   if (SCM_UNBNDP (locale))
1193     {
1194       clocale = NULL;
1195     }
1196   else
1197     {
1198       SCM_ASSERT (SCM_NIMP (locale) && SCM_STRINGP (locale), locale, SCM_ARG2, s_setlocale);
1199       clocale = SCM_CHARS (locale);
1200     }
1201
1202   rv = setlocale (SCM_INUM (category), clocale);
1203   if (rv == NULL)
1204     SCM_SYSERROR (s_setlocale);
1205   return scm_makfrom0str (rv);
1206 #else
1207   SCM_SYSMISSING (s_setlocale);
1208   /* not reached.  */
1209   return SCM_BOOL_F;
1210 #endif
1211 }
1212
1213 SCM_PROC (s_strftime, "strftime", 2, 0, 0, scm_strftime);
1214 #ifdef __STDC__
1215 SCM
1216 scm_strftime (SCM format, SCM stime)
1217 #else
1218 SCM
1219 scm_strftime (format, stime)
1220      SCM format;
1221      SCM stime;
1222 #endif
1223 {
1224   struct tm t;
1225
1226   char *tbuf;
1227   int n;
1228   int size = 50;
1229   char *fmt;
1230   int len;
1231
1232   SCM_ASSERT (SCM_NIMP (format) && SCM_STRINGP (format), format, SCM_ARG1, s_strftime);
1233   SCM_ASSERT (SCM_NIMP (stime) && SCM_VECTORP (stime) && scm_obj_length (stime) == 9,
1234           stime, SCM_ARG2, s_strftime);
1235
1236   fmt = SCM_ROCHARS (format);
1237   len = SCM_ROLENGTH (format);
1238
1239 #define tm_deref scm_num2long (SCM_VELTS (stime)[n++], (char *)SCM_ARG2, s_strftime)
1240   n = 0;
1241   t.tm_sec = tm_deref;
1242   t.tm_min = tm_deref;
1243   t.tm_hour = tm_deref;
1244   t.tm_mday = tm_deref;
1245   t.tm_mon = tm_deref;
1246   t.tm_year = tm_deref;
1247   /* not used by mktime.
1248      t.tm_wday = tm_deref;
1249      t.tm_yday = tm_deref; */
1250   t.tm_isdst = tm_deref;
1251 #undef tm_deref
1252
1253   /* fill in missing fields and set the timezone.  */
1254   mktime (&t);
1255
1256   tbuf = scm_must_malloc (size, s_strftime);
1257   while ((len = strftime (tbuf, size, fmt, &t)) == size)
1258     {
1259       scm_must_free (tbuf);
1260       size *= 2;
1261       tbuf = scm_must_malloc (size, s_strftime);
1262     }
1263   return scm_makfromstr (tbuf, len, 0);
1264 }
1265
1266 SCM_PROC (s_sys_strptime, "strptime", 2, 0, 0, scm_sys_strptime);
1267 #ifdef __STDC__
1268 SCM
1269 scm_sys_strptime (SCM format, SCM string)
1270 #else
1271 SCM
1272 scm_sys_strptime (format, string)
1273      SCM format;
1274      SCM string;
1275 #endif
1276 {
1277 #ifdef HAVE_STRPTIME
1278   SCM stime;
1279   struct tm t;
1280
1281   char *fmt, *str, *rest;
1282   int n;
1283
1284   SCM_ASSERT (SCM_NIMP (format) && SCM_ROSTRINGP (format), format, SCM_ARG1, s_sys_strptime);
1285   if (SCM_SUBSTRP (format))
1286     format =  scm_makfromstr (SCM_ROCHARS (format), SCM_ROLENGTH (format), 0);
1287   SCM_ASSERT (SCM_NIMP (string) && SCM_ROSTRINGP (string), string, SCM_ARG2, s_sys_strptime);
1288   if (SCM_SUBSTRP (string))
1289     string =  scm_makfromstr (SCM_ROCHARS (string), SCM_ROLENGTH (string), 0);
1290
1291   fmt = SCM_CHARS (format);
1292   str = SCM_CHARS (string);
1293
1294   /* initialize the struct tm */
1295 #define tm_init(field) t.field = 0
1296   tm_init (tm_sec);
1297   tm_init (tm_min);
1298   tm_init (tm_hour);
1299   tm_init (tm_mday);
1300   tm_init (tm_mon);
1301   tm_init (tm_year);
1302   tm_init (tm_wday);
1303   tm_init (tm_yday);
1304   tm_init (tm_isdst);
1305 #undef tm_init
1306
1307   SCM_DEFER_INTS;
1308   rest = strptime (str, fmt, &t);
1309   SCM_ALLOW_INTS;
1310
1311   if (rest == NULL)
1312     SCM_SYSERROR (s_sys_strptime);
1313
1314   stime = scm_make_vector (SCM_MAKINUM (9), scm_long2num (0), SCM_UNDEFINED);
1315
1316 #define stime_set(val) scm_vector_set_x (stime, SCM_MAKINUM (n++), scm_long2num (t.val));
1317   n = 0;
1318   stime_set (tm_sec);
1319   stime_set (tm_min);
1320   stime_set (tm_hour);
1321   stime_set (tm_mday);
1322   stime_set (tm_mon);
1323   stime_set (tm_year);
1324   stime_set (tm_wday);
1325   stime_set (tm_yday);
1326   stime_set (tm_isdst);
1327 #undef stime_set
1328
1329   return scm_cons (stime, scm_makfrom0str (rest));
1330 #else
1331   SCM_SYSMISSING (s_sys_strptime);
1332   /* not reached.  */
1333   return SCM_BOOL_F;
1334 #endif
1335 }
1336
1337 SCM_PROC (s_sys_mknod, "mknod", 3, 0, 0, scm_sys_mknod);
1338 #ifdef __STDC__
1339 SCM
1340 scm_sys_mknod(SCM path, SCM mode, SCM dev)
1341 #else
1342 SCM
1343 scm_sys_mknod(path, mode, dev)
1344      SCM path;
1345      SCM mode;
1346      SCM dev;
1347 #endif
1348 {
1349 #ifdef HAVE_MKNOD
1350   int val;
1351   SCM_ASSERT(SCM_NIMP(path) && SCM_STRINGP(path), path, SCM_ARG1, s_sys_mknod);
1352   SCM_ASSERT(SCM_INUMP(mode), mode, SCM_ARG2, s_sys_mknod);
1353   SCM_ASSERT(SCM_INUMP(dev), dev, SCM_ARG3, s_sys_mknod);
1354   SCM_SYSCALL(val = mknod(SCM_CHARS(path), SCM_INUM(mode), SCM_INUM(dev)));
1355   if (val != 0)
1356     SCM_SYSERROR (s_sys_mknod);
1357   return SCM_UNSPECIFIED;
1358 #else
1359   SCM_SYSMISSING (s_sys_mknod);
1360   /* not reached.  */
1361   return SCM_BOOL_F;
1362 #endif
1363 }
1364
1365
1366 SCM_PROC (s_sys_nice, "nice", 1, 0, 0, scm_sys_nice);
1367 #ifdef __STDC__
1368 SCM
1369 scm_sys_nice(SCM incr)
1370 #else
1371 SCM
1372 scm_sys_nice(incr)
1373      SCM incr;
1374 #endif
1375 {
1376 #ifdef HAVE_NICE
1377   SCM_ASSERT(SCM_INUMP(incr), incr, SCM_ARG1, s_sys_nice);
1378   if (nice(SCM_INUM(incr)) != 0)
1379     SCM_SYSERROR (s_sys_nice);
1380   return SCM_UNSPECIFIED;
1381 #else
1382   SCM_SYSMISSING (s_sys_nice);
1383   /* not reached.  */
1384   return SCM_BOOL_F;
1385 #endif
1386 }
1387
1388
1389 SCM_PROC (s_sync, "sync", 0, 0, 0, scm_sync);
1390 #ifdef __STDC__
1391 SCM
1392 scm_sync(void)
1393 #else
1394 SCM
1395 scm_sync()
1396 #endif
1397 {
1398 #ifdef HAVE_SYNC
1399   sync();
1400 #endif
1401   SCM_SYSMISSING (s_sync);
1402   /* not reached.  */
1403   return SCM_BOOL_F;
1404 }
1405
1406
1407
1408 #ifdef __STDC__
1409 void
1410 scm_init_posix (void)
1411 #else
1412 void
1413 scm_init_posix ()
1414 #endif
1415 {
1416   scm_add_feature ("posix");
1417 #ifdef HAVE_GETEUID
1418   scm_add_feature ("EIDs");
1419 #endif
1420 #ifdef WAIT_ANY
1421   scm_sysintern ("WAIT_ANY", SCM_MAKINUM (WAIT_ANY));
1422 #endif
1423 #ifdef WAIT_MYPGRP
1424   scm_sysintern ("WAIT_MYPGRP", SCM_MAKINUM (WAIT_MYPGRP));
1425 #endif
1426 #ifdef WNOHANG
1427   scm_sysintern ("WNOHANG", SCM_MAKINUM (WNOHANG));
1428 #endif
1429 #ifdef WUNTRACED
1430   scm_sysintern ("WUNTRACED", SCM_MAKINUM (WUNTRACED));
1431 #endif
1432
1433 #ifdef EINTR
1434   scm_sysintern ("EINTR", SCM_MAKINUM (EINTR));
1435 #endif
1436
1437 #ifdef SIGHUP
1438   scm_sysintern ("SIGHUP", SCM_MAKINUM (SIGHUP));
1439 #endif
1440 #ifdef SIGINT
1441   scm_sysintern ("SIGINT", SCM_MAKINUM (SIGINT));
1442 #endif
1443 #ifdef SIGQUIT
1444   scm_sysintern ("SIGQUIT", SCM_MAKINUM (SIGQUIT));
1445 #endif
1446 #ifdef SIGILL
1447   scm_sysintern ("SIGILL", SCM_MAKINUM (SIGILL));
1448 #endif
1449 #ifdef SIGTRAP
1450   scm_sysintern ("SIGTRAP", SCM_MAKINUM (SIGTRAP));
1451 #endif
1452 #ifdef SIGABRT
1453   scm_sysintern ("SIGABRT", SCM_MAKINUM (SIGABRT));
1454 #endif
1455 #ifdef SIGIOT
1456   scm_sysintern ("SIGIOT", SCM_MAKINUM (SIGIOT));
1457 #endif
1458 #ifdef SIGBUS
1459   scm_sysintern ("SIGBUS", SCM_MAKINUM (SIGBUS));
1460 #endif
1461 #ifdef SIGFPE
1462   scm_sysintern ("SIGFPE", SCM_MAKINUM (SIGFPE));
1463 #endif
1464 #ifdef SIGKILL
1465   scm_sysintern ("SIGKILL", SCM_MAKINUM (SIGKILL));
1466 #endif
1467 #ifdef SIGUSR1
1468   scm_sysintern ("SIGUSR1", SCM_MAKINUM (SIGUSR1));
1469 #endif
1470 #ifdef SIGSEGV
1471   scm_sysintern ("SIGSEGV", SCM_MAKINUM (SIGSEGV));
1472 #endif
1473 #ifdef SIGUSR2
1474   scm_sysintern ("SIGUSR2", SCM_MAKINUM (SIGUSR2));
1475 #endif
1476 #ifdef SIGPIPE
1477   scm_sysintern ("SIGPIPE", SCM_MAKINUM (SIGPIPE));
1478 #endif
1479 #ifdef SIGALRM
1480   scm_sysintern ("SIGALRM", SCM_MAKINUM (SIGALRM));
1481 #endif
1482 #ifdef SIGTERM
1483   scm_sysintern ("SIGTERM", SCM_MAKINUM (SIGTERM));
1484 #endif
1485 #ifdef SIGSTKFLT
1486   scm_sysintern ("SIGSTKFLT", SCM_MAKINUM (SIGSTKFLT));
1487 #endif
1488 #ifdef SIGCHLD
1489   scm_sysintern ("SIGCHLD", SCM_MAKINUM (SIGCHLD));
1490 #endif
1491 #ifdef SIGCONT
1492   scm_sysintern ("SIGCONT", SCM_MAKINUM (SIGCONT));
1493 #endif
1494 #ifdef SIGSTOP
1495   scm_sysintern ("SIGSTOP", SCM_MAKINUM (SIGSTOP));
1496 #endif
1497 #ifdef SIGTSTP
1498   scm_sysintern ("SIGTSTP", SCM_MAKINUM (SIGTSTP));
1499 #endif
1500 #ifdef SIGTTIN
1501   scm_sysintern ("SIGTTIN", SCM_MAKINUM (SIGTTIN));
1502 #endif
1503 #ifdef SIGTTOU
1504   scm_sysintern ("SIGTTOU", SCM_MAKINUM (SIGTTOU));
1505 #endif
1506 #ifdef SIGIO
1507   scm_sysintern ("SIGIO", SCM_MAKINUM (SIGIO));
1508 #endif
1509 #ifdef SIGPOLL
1510   scm_sysintern ("SIGPOLL", SCM_MAKINUM (SIGPOLL));
1511 #endif
1512 #ifdef SIGURG
1513   scm_sysintern ("SIGURG", SCM_MAKINUM (SIGURG));
1514 #endif
1515 #ifdef SIGXCPU
1516   scm_sysintern ("SIGXCPU", SCM_MAKINUM (SIGXCPU));
1517 #endif
1518 #ifdef SIGXFSZ
1519   scm_sysintern ("SIGXFSZ", SCM_MAKINUM (SIGXFSZ));
1520 #endif
1521 #ifdef SIGVTALRM
1522   scm_sysintern ("SIGVTALRM", SCM_MAKINUM (SIGVTALRM));
1523 #endif
1524 #ifdef SIGPROF
1525   scm_sysintern ("SIGPROF", SCM_MAKINUM (SIGPROF));
1526 #endif
1527 #ifdef SIGWINCH
1528   scm_sysintern ("SIGWINCH", SCM_MAKINUM (SIGWINCH));
1529 #endif
1530 #ifdef SIGLOST
1531   scm_sysintern ("SIGLOST", SCM_MAKINUM (SIGLOST));
1532 #endif
1533 #ifdef SIGPWR
1534   scm_sysintern ("SIGPWR", SCM_MAKINUM (SIGPWR));
1535 #endif
1536   /* access() symbols.  */
1537   scm_sysintern ("R_OK", SCM_MAKINUM (R_OK));
1538   scm_sysintern ("W_OK", SCM_MAKINUM (W_OK));
1539   scm_sysintern ("X_OK", SCM_MAKINUM (X_OK));
1540   scm_sysintern ("F_OK", SCM_MAKINUM (F_OK));
1541
1542 #ifdef LC_COLLATE
1543   scm_sysintern ("LC_COLLATE", SCM_MAKINUM (LC_COLLATE));
1544 #endif
1545 #ifdef LC_CTYPE
1546   scm_sysintern ("LC_CTYPE", SCM_MAKINUM (LC_CTYPE));
1547 #endif
1548 #ifdef LC_MONETARY
1549   scm_sysintern ("LC_MONETARY", SCM_MAKINUM (LC_MONETARY));
1550 #endif
1551 #ifdef LC_NUMERIC
1552   scm_sysintern ("LC_NUMERIC", SCM_MAKINUM (LC_NUMERIC));
1553 #endif
1554 #ifdef LC_TIME
1555   scm_sysintern ("LC_TIME", SCM_MAKINUM (LC_TIME));
1556 #endif
1557 #ifdef LC_MESSAGES
1558   scm_sysintern ("LC_MESSAGES", SCM_MAKINUM (LC_MESSAGES));
1559 #endif
1560 #ifdef LC_ALL
1561   scm_sysintern ("LC_ALL", SCM_MAKINUM (LC_ALL));
1562 #endif
1563 #include "posix.x"
1564 }