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