libguile/filesys.c

   1 /*      Copyright (C) 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 #include "_scm.h"
  43
  44 \f
  45 #ifdef TIME_WITH_SYS_TIME
  46 # include <sys/time.h>
  47 # include <time.h>
  48 #else
  49 # if HAVE_SYS_TIME_H
  50 #  include <sys/time.h>
  51 # else
  52 #  include <time.h>
  53 # endif
  54 #endif
  55
  56 #ifdef HAVE_UNISTD_H
  57 #include <unistd.h>
  58 #endif
  59
  60 #ifdef HAVE_LIBC_H
  61 #include <libc.h>
  62 #endif
  63
  64 #ifdef HAVE_SYS_SELECT_H
  65 #include <sys/select.h>
  66 #endif
  67
  68 #ifdef HAVE_STRING_H
  69 #include <string.h>
  70 #endif
  71
  72 #include <sys/types.h>
  73 #include <sys/stat.h>
  74 #include <fcntl.h>
  75
  76 #include <pwd.h>
  77
  78
  79 #ifdef FD_SET
  80
  81 #define SELECT_TYPE fd_set
  82 #define SELECT_SET_SIZE FD_SETSIZE
  83
  84 #else /* no FD_SET */
  85
  86 /* Define the macros to access a single-int bitmap of descriptors.  */
  87 #define SELECT_SET_SIZE 32
  88 #define SELECT_TYPE int
  89 #define FD_SET(n, p) (*(p) |= (1 << (n)))
  90 #define FD_CLR(n, p) (*(p) &= ~(1 << (n)))
  91 #define FD_ISSET(n, p) (*(p) & (1 << (n)))
  92 #define FD_ZERO(p) (*(p) = 0)
  93
  94 #endif /* no FD_SET */
  95
  96 #if HAVE_DIRENT_H
  97 # include <dirent.h>
  98 # define NAMLEN(dirent) strlen((dirent)->d_name)
  99 #else
 100 # define dirent direct
 101 # define NAMLEN(dirent) (dirent)->d_namlen
 102 # if HAVE_SYS_NDIR_H
 103 #  include <sys/ndir.h>
 104 # endif
 105 # if HAVE_SYS_DIR_H
 106 #  include <sys/dir.h>
 107 # endif
 108 # if HAVE_NDIR_H
 109 #  include <ndir.h>
 110 # endif
 111 #endif
 112
 113 \f
 114
 115 #ifdef O_CREAT
 116 SCM_CONST_LONG (scm_O_CREAT, "O_CREAT", O_CREAT);
 117 #endif
 118
 119 #ifdef O_EXCL
 120 SCM_CONST_LONG (scm_O_EXCL, "O_EXCL", O_EXCL);
 121 #endif
 122
 123 #ifdef O_NOCTTY
 124 SCM_CONST_LONG (scm_O_NOCTTY, "O_NOCTTY", O_NOCTTY);
 125 #endif
 126
 127 #ifdef O_TRUNC
 128 SCM_CONST_LONG (scm_O_TRUNC, "O_TRUNC", O_TRUNC);
 129 #endif
 130
 131 #ifdef O_APPEND
 132 SCM_CONST_LONG (scm_O_APPEND, "O_APPEND", O_APPEND);
 133 #endif
 134
 135 #ifdef O_NONBLOCK
 136 SCM_CONST_LONG (scm_O_NONBLOCK, "O_NONBLOCK", O_NONBLOCK);
 137 #endif
 138
 139 #ifdef O_NDELAY
 140 SCM_CONST_LONG (scm_O_NDELAY, "O_NDELAY", O_NDELAY);
 141 #endif
 142
 143 #ifdef O_SYNC
 144 SCM_CONST_LONG (scm_O_SYNC, "O_SYNC", O_SYNC);
 145 #endif
 146
 147
 148
 149 \f
 150
 151 /* {Permissions}
 152  */
 153
 154 SCM_PROC (s_sys_chown, "chown", 3, 0, 0, scm_sys_chown);
 155 #ifdef __STDC__
 156 SCM
 157 scm_sys_chown (SCM path, SCM owner, SCM group)
 158 #else
 159 SCM
 160 scm_sys_chown (path, owner, group)
 161      SCM path;
 162      SCM owner;
 163      SCM group;
 164 #endif
 165 {
 166   int val;
 167
 168   SCM_ASSERT (SCM_NIMP (path) && SCM_ROSTRINGP (path), path, SCM_ARG1, s_sys_chown);
 169   if (SCM_SUBSTRP (path))
 170     path = scm_makfromstr (SCM_ROCHARS (path), SCM_ROLENGTH (path), 0);
 171   SCM_ASSERT (SCM_INUMP (owner), owner, SCM_ARG2, s_sys_chown);
 172   SCM_ASSERT (SCM_INUMP (group), group, SCM_ARG3, s_sys_chown);
 173   SCM_SYSCALL (val = chown (SCM_ROCHARS (path),
 174                             SCM_INUM (owner), SCM_INUM (group)));
 175   if (val != 0)
 176     SCM_SYSERROR (s_sys_chown);
 177   return SCM_UNSPECIFIED;
 178 }
 179
 180
 181 SCM_PROC (s_sys_chmod, "chmod", 2, 0, 0, scm_sys_chmod);
 182 #ifdef __STDC__
 183 SCM
 184 scm_sys_chmod (SCM port_or_path, SCM mode)
 185 #else
 186 SCM
 187 scm_sys_chmod (port_or_path, mode)
 188      SCM port_or_path;
 189      SCM mode;
 190 #endif
 191 {
 192   int rv;
 193   SCM_ASSERT (SCM_INUMP (mode), mode, SCM_ARG2, s_sys_chmod);
 194   SCM_ASSERT (SCM_NIMP (port_or_path), port_or_path, SCM_ARG1, s_sys_chmod);
 195   if (SCM_STRINGP (port_or_path))
 196     SCM_SYSCALL (rv = chmod (SCM_CHARS (port_or_path), SCM_INUM (mode)));
 197   else
 198     {
 199       SCM_ASSERT (SCM_OPFPORTP (port_or_path), port_or_path, SCM_ARG1, s_sys_chmod);
 200       rv = fileno ((FILE *)SCM_STREAM (port_or_path));
 201       if (rv != -1)
 202         SCM_SYSCALL (rv = fchmod (rv, SCM_INUM (mode)));
 203     }
 204   if (rv != 0)
 205     SCM_SYSERROR (s_sys_chmod);
 206   return SCM_UNSPECIFIED;
 207 }
 208
 209 SCM_PROC (s_umask, "umask", 0, 1, 0, scm_umask);
 210 #ifdef __STDC__
 211 SCM
 212 scm_umask (SCM mode)
 213 #else
 214 SCM
 215 scm_umask (mode)
 216      SCM mode;
 217 #endif
 218 {
 219   mode_t mask;
 220   if (SCM_UNBNDP (mode))
 221     {
 222       mask = umask (0);
 223       umask (mask);
 224     }
 225   else
 226     {
 227       SCM_ASSERT (SCM_INUMP (mode), mode, SCM_ARG1, s_umask);
 228       mask = umask (SCM_INUM (mode));
 229     }
 230   return SCM_MAKINUM (mask);
 231 }
 232
 233 \f
 234 /* {File Descriptors}
 235  */
 236 long scm_tc16_fd;
 237
 238 #ifdef __STDC__
 239 static int
 240 scm_fd_print (SCM sexp, SCM port, int writing)
 241 #else
 242 static int
 243 scm_fd_print (sexp, port, writing)
 244      SCM sexp;
 245      SCM port;
 246      int writing;
 247 #endif
 248 {
 249   scm_gen_puts (scm_regular_string, "#<fd ", port);
 250   scm_intprint (SCM_CDR (sexp), 10, port);
 251   scm_gen_puts (scm_regular_string, ">", port);
 252   return 1;
 253 }
 254
 255 #ifdef __STDC__
 256 static scm_sizet
 257 scm_fd_free (SCM p)
 258 #else
 259 static scm_sizet
 260 scm_fd_free (p)
 261      SCM p;
 262 #endif
 263 {
 264   SCM flags;
 265
 266   flags = SCM_FD_FLAGS (p);
 267   if ((scm_close_fd_on_gc & flags) && (scm_fd_is_open & flags))
 268     {
 269       SCM_SYSCALL( close (SCM_FD (p)) );
 270     }
 271   return 0;
 272 }
 273
 274 static scm_smobfuns fd_smob = {scm_mark0, scm_fd_free, scm_fd_print, 0};
 275
 276 #ifdef __STDC__
 277 SCM
 278 scm_intern_fd (int fd, int flags)
 279 #else
 280 SCM
 281 scm_intern_fd (fd, flags)
 282      int fd;
 283      int flags;
 284 #endif
 285 {
 286   SCM it;
 287   SCM_NEWCELL (it);
 288   SCM_REDEFER_INTS;
 289   SCM_SETCAR (it, (scm_tc16_fd | (flags << 16)));
 290   SCM_SETCDR (it, (SCM)fd);
 291   SCM_REALLOW_INTS;
 292   return it;
 293 }
 294
 295 \f
 296
 297 SCM_PROC (s_sys_open, "open", 3, 0, 0, scm_sys_open);
 298 #ifdef __STDC__
 299 SCM
 300 scm_sys_open (SCM path, SCM flags, SCM mode)
 301 #else
 302 SCM
 303 scm_sys_open (path, flags, mode)
 304      SCM path;
 305      SCM flags;
 306      SCM mode;
 307 #endif
 308 {
 309   int fd;
 310   SCM sfd;
 311
 312   SCM_ASSERT (SCM_NIMP (path) && SCM_ROSTRINGP (path), path, SCM_ARG1, s_sys_open);
 313   SCM_ASSERT (SCM_INUMP (flags), flags, SCM_ARG2, s_sys_open);
 314   SCM_ASSERT (SCM_INUMP (mode), mode, SCM_ARG3, s_sys_open);
 315
 316   if (SCM_SUBSTRP (path))
 317     path = scm_makfromstr (SCM_ROCHARS (path), SCM_ROLENGTH (path), 0);
 318
 319   SCM_DEFER_INTS;
 320   SCM_SYSCALL ( fd = open (SCM_ROCHARS (path), SCM_INUM (flags), SCM_INUM (mode)) );
 321   if (fd == -1)
 322     SCM_SYSERROR (s_sys_open);
 323   sfd = scm_intern_fd (fd, scm_fd_is_open | scm_close_fd_on_gc);
 324   SCM_ALLOW_INTS;
 325
 326   return scm_return_first (sfd, path);
 327 }
 328
 329
 330 SCM_PROC (s_sys_create, "create", 2, 0, 0, scm_sys_create);
 331 #ifdef __STDC__
 332 SCM
 333 scm_sys_create (SCM path, SCM mode)
 334 #else
 335 SCM
 336 scm_sys_create (path, mode)
 337      SCM path;
 338      SCM mode;
 339 #endif
 340 {
 341   int fd;
 342   SCM sfd;
 343
 344   SCM_ASSERT (SCM_NIMP (path) && SCM_ROSTRINGP (path), path, SCM_ARG1, s_sys_create);
 345   SCM_ASSERT (SCM_INUMP (mode), mode, SCM_ARG2, s_sys_create);
 346
 347   if (SCM_SUBSTRP (path))
 348     path = scm_makfromstr (SCM_ROCHARS (path), SCM_ROLENGTH (path), 0);
 349
 350   SCM_DEFER_INTS;
 351   SCM_SYSCALL ( fd = creat (SCM_ROCHARS (path), SCM_INUM (mode)) );
 352   if (fd == -1)
 353     SCM_SYSERROR (s_sys_create);
 354   sfd = scm_intern_fd (fd, scm_fd_is_open | scm_close_fd_on_gc);
 355   SCM_ALLOW_INTS;
 356
 357   return scm_return_first (sfd, path);
 358 }
 359
 360
 361 SCM_PROC (s_sys_close, "close", 1, 0, 0, scm_sys_close);
 362 #ifdef __STDC__
 363 SCM
 364 scm_sys_close (SCM sfd)
 365 #else
 366 SCM
 367 scm_sys_close (sfd)
 368      SCM sfd;
 369 #endif
 370 {
 371   int fd;
 372   int got;
 373   SCM_ASSERT (SCM_NIMP (sfd) && SCM_FD_P (sfd), sfd, SCM_ARG1,  s_sys_close);
 374   fd = SCM_FD (sfd);
 375
 376   SCM_DEFER_INTS;
 377   got = close (fd);
 378   SCM_SETCAR (sfd, scm_tc16_fd);
 379   SCM_ALLOW_INTS;
 380   if (got == -1)
 381     SCM_SYSERROR (s_sys_close);
 382   return SCM_UNSPECIFIED;
 383 }
 384
 385
 386 SCM_PROC (s_sys_write_fd, "write-fd", 2, 0, 0, scm_sys_write_fd);
 387 #ifdef __STDC__
 388 SCM
 389 scm_sys_write_fd (SCM sfd, SCM buf)
 390 #else
 391 SCM
 392 scm_sys_write_fd (sfd, buf)
 393      SCM sfd;
 394      SCM buf;
 395 #endif
 396 {
 397   SCM answer;
 398   int fd;
 399   size_t written;
 400   SCM_ASSERT (SCM_NIMP (sfd) && SCM_FD_P (sfd), sfd, SCM_ARG1,  s_sys_write_fd);
 401   SCM_ASSERT (SCM_NIMP (buf) && SCM_ROSTRINGP (buf), buf, SCM_ARG2,  s_sys_write_fd);
 402   fd = SCM_FD (sfd);
 403   SCM_DEFER_INTS;
 404   written = write (fd, SCM_ROCHARS (buf), SCM_ROLENGTH (buf));
 405   if (written == -1)
 406     SCM_SYSERROR (s_sys_write_fd);
 407   answer = scm_long2num (written);
 408   SCM_ALLOW_INTS;
 409   return scm_return_first (answer, buf);
 410 }
 411
 412
 413 SCM_PROC (s_sys_read_fd, "read-fd", 2, 2, 0, scm_sys_read_fd);
 414 #ifdef __STDC__
 415 SCM
 416 scm_sys_read_fd (SCM sfd, SCM buf, SCM offset, SCM length)
 417 #else
 418 SCM
 419 scm_sys_read_fd (sfd, buf, offset, length)
 420      SCM sfd;
 421      SCM buf;
 422      SCM offset;
 423      SCM length;
 424 #endif
 425 {
 426   SCM answer;
 427   int fd;
 428   char * bytes;
 429   int off;
 430   int len;
 431   size_t got;
 432
 433   SCM_ASSERT (SCM_NIMP (sfd) && SCM_FD_P (sfd), sfd, SCM_ARG1,  s_sys_read_fd);
 434   fd = SCM_FD (sfd);
 435
 436   SCM_ASSERT (SCM_NIMP (buf) && SCM_STRINGP (buf), buf, SCM_ARG2,  s_sys_read_fd);
 437   bytes = SCM_CHARS (buf);
 438
 439   if (SCM_UNBNDP (offset))
 440     off = 0;
 441   else
 442     {
 443       SCM_ASSERT (SCM_INUMP (offset), offset, SCM_ARG3, s_sys_read_fd);
 444       off = SCM_INUM (offset);
 445     }
 446
 447   if (SCM_UNBNDP (length))
 448     len = SCM_LENGTH (buf);
 449   else
 450     {
 451       SCM_ASSERT (SCM_INUMP (length), length, SCM_ARG3, s_sys_read_fd);
 452       len = SCM_INUM (length);
 453     }
 454
 455   SCM_DEFER_INTS;
 456   got = read (fd, bytes + off, len);
 457   if (got == -1)
 458     SCM_SYSERROR (s_sys_read_fd);
 459   answer = scm_long2num (got);
 460   SCM_ALLOW_INTS;
 461   return scm_return_first (answer, buf);
 462 }
 463
 464 SCM_PROC (s_sys_lseek, "lseek", 2, 1, 0, scm_sys_lseek);
 465 #ifdef __STDC__
 466 SCM
 467 scm_sys_lseek (SCM sfd, SCM offset, SCM whence)
 468 #else
 469 SCM
 470 scm_sys_lseek (sfd, offset, whence)
 471      SCM sfd;
 472      SCM offset;
 473      SCM whence;
 474 #endif
 475 {
 476   SCM answer;
 477   int fd;
 478   long off;
 479   int wh;
 480   long got;
 481
 482   SCM_ASSERT (SCM_NIMP (sfd) && SCM_FD_P (sfd), sfd, SCM_ARG1,  s_sys_lseek);
 483   fd = SCM_FD (sfd);
 484
 485   off = scm_num2long (offset, (char *)SCM_ARG2, s_sys_lseek);
 486   if (SCM_UNBNDP (whence))
 487     wh = SEEK_SET;
 488   else
 489     {
 490       SCM_ASSERT (SCM_INUMP (whence), whence, SCM_ARG3, s_sys_lseek);
 491       wh = SCM_INUM (whence);
 492     }
 493
 494   SCM_DEFER_INTS;
 495   SCM_SYSCALL (got = lseek (fd, off, wh));
 496   if (got == -1)
 497     SCM_SYSERROR (s_sys_lseek);
 498   answer = scm_long2num (got);
 499   SCM_ALLOW_INTS;
 500   return answer;
 501 }
 502
 503
 504 SCM_PROC (s_sys_dup, "dup", 1, 1, 0, scm_sys_dup);
 505 #ifdef __STDC__
 506 SCM
 507 scm_sys_dup (SCM oldfd, SCM newfd)
 508 #else
 509 SCM
 510 scm_sys_dup (oldfd, newfd)
 511      SCM oldfd;
 512      SCM newfd;
 513 #endif
 514 {
 515   SCM answer;
 516   int fd;
 517   int nfd;
 518   int (*fn)();
 519
 520   SCM_ASSERT (SCM_NIMP (oldfd) && SCM_FD_P (oldfd), oldfd, SCM_ARG1,  s_sys_dup);
 521   SCM_ASSERT (SCM_UNBNDP (newfd) || SCM_INUMP (newfd), newfd, SCM_ARG2,  s_sys_dup);
 522   fd = SCM_FD (oldfd);
 523   nfd = (SCM_INUMP (newfd) ? SCM_INUM (newfd) : -1);
 524
 525   SCM_DEFER_INTS;
 526   fn = ((nfd == -1) ? (int (*)())dup : (int (*)())dup2);
 527   nfd = fn (fd, nfd);
 528   if (nfd == -1)
 529     SCM_SYSERROR (s_sys_dup);
 530   answer = SCM_MAKINUM (nfd);
 531   SCM_ALLOW_INTS;
 532   return answer;
 533 }
 534
 535
 536 \f
 537 /* {Files}
 538  */
 539 #ifdef __STDC__
 540 static SCM
 541 scm_stat2scm (struct stat *stat_temp)
 542 #else
 543 static SCM
 544 scm_stat2scm (stat_temp)
 545      struct stat *stat_temp;
 546 #endif
 547 {
 548   SCM ans = scm_make_vector (SCM_MAKINUM (13), SCM_UNSPECIFIED, SCM_BOOL_F);
 549   SCM *ve = SCM_VELTS (ans);
 550   ve[0] = scm_ulong2num ((unsigned long) stat_temp->st_dev);
 551   ve[1] = scm_ulong2num ((unsigned long) stat_temp->st_ino);
 552   ve[2] = scm_ulong2num ((unsigned long) stat_temp->st_mode);
 553   ve[3] = scm_ulong2num ((unsigned long) stat_temp->st_nlink);
 554   ve[4] = scm_ulong2num ((unsigned long) stat_temp->st_uid);
 555   ve[5] = scm_ulong2num ((unsigned long) stat_temp->st_gid);
 556 #ifdef HAVE_ST_RDEV
 557   ve[6] = scm_ulong2num ((unsigned long) stat_temp->st_rdev);
 558 #else
 559   ve[6] = SCM_BOOL_F;
 560 #endif
 561   ve[7] = scm_ulong2num ((unsigned long) stat_temp->st_size);
 562   ve[8] = scm_ulong2num ((unsigned long) stat_temp->st_atime);
 563   ve[9] = scm_ulong2num ((unsigned long) stat_temp->st_mtime);
 564   ve[10] = scm_ulong2num ((unsigned long) stat_temp->st_ctime);
 565 #ifdef HAVE_ST_BLKSIZE
 566   ve[11] = scm_ulong2num ((unsigned long) stat_temp->st_blksize);
 567 #else
 568   ve[11] = scm_ulong2num (4096L);
 569 #endif
 570 #ifdef HAVE_ST_BLOCKS
 571   ve[12] = scm_ulong2num ((unsigned long) stat_temp->st_blocks);
 572 #else
 573   ve[12] = SCM_BOOL_F;
 574 #endif
 575
 576   return ans;
 577 }
 578
 579 SCM_PROC (s_sys_stat, "stat", 1, 0, 0, scm_sys_stat);
 580 #ifdef __STDC__
 581 SCM
 582 scm_sys_stat (SCM fd_or_path)
 583 #else
 584 SCM
 585 scm_sys_stat (fd_or_path)
 586      SCM fd_or_path;
 587 #endif
 588 {
 589   int rv;
 590   struct stat stat_temp;
 591
 592   if (SCM_INUMP (fd_or_path))
 593     {
 594       SCM_ASSERT (SCM_OPFPORTP (fd_or_path), fd_or_path, SCM_ARG1, s_sys_stat);
 595       rv = SCM_INUM (fd_or_path);
 596       SCM_SYSCALL (rv = fstat (rv, &stat_temp));
 597     }
 598   else if (SCM_NIMP (fd_or_path) && SCM_FD_P (fd_or_path))
 599     {
 600       rv = SCM_FD (fd_or_path);
 601       SCM_SYSCALL (rv = fstat (rv, &stat_temp));
 602     }
 603   else
 604     {
 605       SCM_ASSERT (SCM_NIMP (fd_or_path), fd_or_path, SCM_ARG1, s_sys_stat);
 606       SCM_ASSERT (SCM_ROSTRINGP (fd_or_path), fd_or_path, SCM_ARG1, s_sys_stat);
 607       if (SCM_ROSTRINGP (fd_or_path))
 608         {
 609           if (SCM_SUBSTRP (fd_or_path))
 610             fd_or_path = scm_makfromstr (SCM_ROCHARS (fd_or_path), SCM_ROLENGTH (fd_or_path), 0);
 611           SCM_SYSCALL (rv = stat (SCM_CHARS (fd_or_path), &stat_temp));
 612         }
 613
 614     }
 615   if (rv != 0)
 616     SCM_SYSERROR (s_sys_stat);
 617   return scm_stat2scm (&stat_temp);
 618 }
 619
 620
 621 \f
 622 /* {Modifying Directories}
 623  */
 624
 625 SCM_PROC (s_sys_link, "link", 2, 0, 0, scm_sys_link);
 626 #ifdef __STDC__
 627 SCM
 628 scm_sys_link (SCM oldpath, SCM newpath)
 629 #else
 630 SCM
 631 scm_sys_link (oldpath, newpath)
 632      SCM oldpath;
 633      SCM newpath;
 634 #endif
 635 {
 636   int val;
 637
 638   SCM_ASSERT (SCM_NIMP (oldpath) && SCM_ROSTRINGP (oldpath), oldpath, SCM_ARG1, s_sys_link);
 639   if (SCM_SUBSTRP (oldpath))
 640     oldpath = scm_makfromstr (SCM_ROCHARS (oldpath), SCM_ROLENGTH (oldpath), 0);
 641   SCM_ASSERT (SCM_NIMP (newpath) && SCM_ROSTRINGP (newpath), newpath, SCM_ARG2, s_sys_link);
 642   if (SCM_SUBSTRP (newpath))
 643     newpath = scm_makfromstr (SCM_ROCHARS (newpath), SCM_ROLENGTH (newpath), 0);
 644   SCM_SYSCALL (val = link (SCM_ROCHARS (oldpath), SCM_ROCHARS (newpath)));
 645   if (val != 0)
 646     SCM_SYSERROR (s_sys_link);
 647   return SCM_UNSPECIFIED;
 648 }
 649
 650
 651
 652 SCM_PROC (s_sys_rename, "rename-file", 2, 0, 0, scm_sys_rename);
 653 #ifdef __STDC__
 654 SCM
 655 scm_sys_rename (SCM oldname, SCM newname)
 656 #else
 657 SCM
 658 scm_sys_rename (oldname, newname)
 659      SCM oldname;
 660      SCM newname;
 661 #endif
 662 {
 663   int rv;
 664   SCM_ASSERT (SCM_NIMP (oldname) && SCM_STRINGP (oldname), oldname, SCM_ARG1, s_sys_rename);
 665   SCM_ASSERT (SCM_NIMP (newname) && SCM_STRINGP (newname), newname, SCM_ARG2, s_sys_rename);
 666 #ifdef HAVE_RENAME
 667   SCM_SYSCALL (rv = rename (SCM_CHARS (oldname), SCM_CHARS (newname)));
 668   if (rv != 0)
 669     SCM_SYSERROR (s_sys_rename);
 670   return SCM_UNSPECIFIED;
 671 #else
 672   SCM_DEFER_INTS;
 673   SCM_SYSCALL (rv = link (SCM_CHARS (oldname), SCM_CHARS (newname)));
 674   if (rv == 0)
 675     {
 676       SCM_SYSCALL (rv = unlink (SCM_CHARS (oldname)));;
 677       if (rv != 0)
 678         /* unlink failed.  remove new name */
 679         SCM_SYSCALL (unlink (SCM_CHARS (newname)));
 680     }
 681   SCM_ALLOW_INTS;
 682   if (rv != 0)
 683     SCM_SYSERROR (s_sys_rename);
 684   return SCM_UNSPECIFIED;
 685 #endif
 686 }
 687
 688
 689
 690 SCM_PROC (s_sys_mkdir, "mkdir", 1, 1, 0, scm_sys_mkdir);
 691 #ifdef __STDC__
 692 SCM
 693 scm_sys_mkdir (SCM path, SCM mode)
 694 #else
 695 SCM
 696 scm_sys_mkdir (path, mode)
 697      SCM path;
 698      SCM mode;
 699 #endif
 700 {
 701 #ifdef HAVE_MKDIR
 702   int rv;
 703   mode_t mask;
 704   SCM_ASSERT (SCM_NIMP (path) && SCM_STRINGP (path), path, SCM_ARG1, s_sys_mkdir);
 705   if (SCM_UNBNDP (mode))
 706     {
 707       mask = umask (0);
 708       umask (mask);
 709       SCM_SYSCALL (rv = mkdir (SCM_CHARS (path), 0777 ^ mask));
 710     }
 711   else
 712     {
 713       SCM_ASSERT (SCM_INUMP (mode), mode, SCM_ARG2, s_sys_mkdir);
 714       SCM_SYSCALL (rv = mkdir (SCM_CHARS (path), SCM_INUM (mode)));
 715     }
 716   if (rv != 0)
 717     SCM_SYSERROR (s_sys_mkdir);
 718   return SCM_UNSPECIFIED;
 719 #else
 720   SCM_SYSMISSING (s_sys_mkdir);
 721   /* not reached.  */
 722   return SCM_BOOL_F;
 723 #endif
 724 }
 725
 726
 727 SCM_PROC (s_sys_rmdir, "rmdir", 1, 0, 0, scm_sys_rmdir);
 728 #ifdef __STDC__
 729 SCM
 730 scm_sys_rmdir (SCM path)
 731 #else
 732 SCM
 733 scm_sys_rmdir (path)
 734      SCM path;
 735 #endif
 736 {
 737 #ifdef HAVE_RMDIR
 738   int val;
 739
 740   SCM_ASSERT (SCM_NIMP (path) && SCM_STRINGP (path), path, SCM_ARG1, s_sys_rmdir);
 741   SCM_SYSCALL (val = rmdir (SCM_CHARS (path)));
 742   if (val != 0)
 743     SCM_SYSERROR (s_sys_rmdir);
 744   return SCM_UNSPECIFIED;
 745 #else
 746   SCM_SYSMISSING (s_sys_rmdir);
 747   /* not reached.  */
 748   return SCM_BOOL_F;
 749 #endif
 750 }
 751
 752 \f
 753 /* {Examining Directories}
 754  */
 755
 756 long scm_tc16_dir;
 757
 758 SCM_PROC (s_sys_opendir, "opendir", 1, 0, 0, scm_sys_opendir);
 759 #ifdef __STDC__
 760 SCM
 761 scm_sys_opendir (SCM dirname)
 762 #else
 763 SCM
 764 scm_sys_opendir (dirname)
 765      SCM dirname;
 766 #endif
 767 {
 768   DIR *ds;
 769   SCM dir;
 770   SCM_ASSERT (SCM_NIMP (dirname) && SCM_STRINGP (dirname), dirname, SCM_ARG1, s_sys_opendir);
 771   SCM_NEWCELL (dir);
 772   SCM_DEFER_INTS;
 773   SCM_SYSCALL (ds = opendir (SCM_CHARS (dirname)));
 774   if (ds == NULL)
 775     SCM_SYSERROR (s_sys_opendir);
 776   SCM_CAR (dir) = scm_tc16_dir | SCM_OPN;
 777   SCM_SETCDR (dir, ds);
 778   SCM_ALLOW_INTS;
 779   return dir;
 780 }
 781
 782
 783 SCM_PROC (s_sys_readdir, "readdir", 1, 0, 0, scm_sys_readdir);
 784 #ifdef __STDC__
 785 SCM
 786 scm_sys_readdir (SCM port)
 787 #else
 788 SCM
 789 scm_sys_readdir (port)
 790      SCM port;
 791 #endif
 792 {
 793   struct dirent *rdent;
 794   SCM_DEFER_INTS;
 795   SCM_ASSERT (SCM_NIMP (port) && SCM_OPDIRP (port), port, SCM_ARG1, s_sys_readdir);
 796   errno = 0;
 797   SCM_SYSCALL (rdent = readdir ((DIR *) SCM_CDR (port)));
 798   SCM_ALLOW_INTS;
 799   if (errno != 0)
 800     SCM_SYSERROR (s_sys_readdir);
 801   return (rdent ? scm_makfromstr (rdent->d_name, NAMLEN (rdent), 0)
 802           : SCM_EOF_VAL);
 803 }
 804
 805
 806
 807 SCM_PROC (s_rewinddir, "rewinddir", 1, 0, 0, scm_rewinddir);
 808 #ifdef __STDC__
 809 SCM
 810 scm_rewinddir (SCM port)
 811 #else
 812 SCM
 813 scm_rewinddir (port)
 814      SCM port;
 815 #endif
 816 {
 817   SCM_ASSERT (SCM_NIMP (port) && SCM_OPDIRP (port), port, SCM_ARG1, s_rewinddir);
 818   rewinddir ((DIR *) SCM_CDR (port));
 819   return SCM_UNSPECIFIED;
 820 }
 821
 822
 823
 824 SCM_PROC (s_sys_closedir, "closedir", 1, 0, 0, scm_sys_closedir);
 825 #ifdef __STDC__
 826 SCM
 827 scm_sys_closedir (SCM port)
 828 #else
 829 SCM
 830 scm_sys_closedir (port)
 831      SCM port;
 832 #endif
 833 {
 834   int sts;
 835
 836   SCM_ASSERT (SCM_NIMP (port) && SCM_DIRP (port), port, SCM_ARG1, s_sys_closedir);
 837   SCM_DEFER_INTS;
 838   if (SCM_CLOSEDP (port))
 839     {
 840       SCM_ALLOW_INTS;
 841       return SCM_UNSPECIFIED;
 842     }
 843   SCM_SYSCALL (sts = closedir ((DIR *) SCM_CDR (port)));
 844   if (sts != 0)
 845     SCM_SYSERROR (s_sys_closedir);
 846   SCM_CAR (port) = scm_tc16_dir;
 847   SCM_ALLOW_INTS;
 848   return SCM_UNSPECIFIED;
 849 }
 850
 851
 852
 853 #ifdef __STDC__
 854 static int
 855 scm_dir_print (SCM sexp, SCM port, int writing)
 856 #else
 857 static int
 858 scm_dir_print (sexp, port, writing)
 859      SCM sexp;
 860      SCM port;
 861      int writing;
 862 #endif
 863 {
 864   scm_prinport (sexp, port, "directory");
 865   return 1;
 866 }
 867
 868 #ifdef __STDC__
 869 static scm_sizet
 870 scm_dir_free (SCM p)
 871 #else
 872 static scm_sizet
 873 scm_dir_free (p)
 874      SCM p;
 875 #endif
 876 {
 877   if (SCM_OPENP (p))
 878     closedir ((DIR *) SCM_CDR (p));
 879   return 0;
 880 }
 881
 882 static scm_smobfuns dir_smob = {scm_mark0, scm_dir_free, scm_dir_print, 0};
 883
 884 \f
 885 /* {Navigating Directories}
 886  */
 887
 888
 889 SCM_PROC (s_sys_chdir, "chdir", 1, 0, 0, scm_sys_chdir);
 890 #ifdef __STDC__
 891 SCM
 892 scm_sys_chdir (SCM str)
 893 #else
 894 SCM
 895 scm_sys_chdir (str)
 896      SCM str;
 897 #endif
 898 {
 899   int ans;
 900
 901   SCM_ASSERT (SCM_NIMP (str) && SCM_STRINGP (str), str, SCM_ARG1, s_sys_chdir);
 902   SCM_SYSCALL (ans = chdir (SCM_CHARS (str)));
 903   if (ans != 0)
 904     SCM_SYSERROR (s_sys_chdir);
 905   return SCM_UNSPECIFIED;
 906 }
 907
 908
 909
 910 SCM_PROC (s_sys_getcwd, "getcwd", 0, 0, 0, scm_sys_getcwd);
 911 #ifdef __STDC__
 912 SCM
 913 scm_sys_getcwd (void)
 914 #else
 915 SCM
 916 scm_sys_getcwd ()
 917 #endif
 918 {
 919 #ifdef HAVE_GETCWD
 920   char *rv;
 921
 922   scm_sizet size = 100;
 923   char *wd;
 924   SCM result;
 925
 926   SCM_DEFER_INTS;
 927   wd = scm_must_malloc (size, s_sys_getcwd);
 928   while ((rv = getcwd (wd, size)) == 0 && errno == ERANGE)
 929     {
 930       scm_must_free (wd);
 931       size *= 2;
 932       wd = scm_must_malloc (size, s_sys_getcwd);
 933     }
 934   if (rv == 0)
 935     SCM_SYSERROR (s_sys_getcwd);
 936   result = scm_makfromstr (wd, strlen (wd), 0);
 937   scm_must_free (wd);
 938   SCM_ALLOW_INTS;
 939   return result;
 940 #else
 941   SCM_SYSMISSING (s_sys_getcwd);
 942   /* not reached.  */
 943   return SCM_BOOL_F;
 944 #endif
 945 }
 946
 947 \f
 948
 949 #ifdef __STDC__
 950 static void
 951 fill_select_type (SELECT_TYPE * set, SCM list)
 952 #else
 953 static void
 954 fill_select_type (set, list)
 955      SELECT_TYPE * set;
 956      SCM list;
 957 #endif
 958 {
 959   while (list != SCM_EOL)
 960     {
 961       if (   SCM_NIMP (SCM_CAR (list))
 962           && (scm_tc16_fport == SCM_TYP16 (SCM_CAR (list)))
 963           && SCM_OPPORTP (SCM_CAR (list)))
 964         FD_SET (fileno ((FILE *)SCM_STREAM (SCM_CAR (list))), set);
 965       else if (SCM_INUMP (SCM_CAR (list)))
 966         FD_SET (SCM_INUM (SCM_CAR (list)), set);
 967       else if (SCM_NIMP (SCM_CAR (list)) && SCM_FD_P (SCM_CAR (list)))
 968         FD_SET (SCM_FD (SCM_CAR (list)), set);
 969       list = SCM_CDR (list);
 970     }
 971 }
 972
 973 #ifdef __STDC__
 974 static SCM
 975 retrieve_select_type (SELECT_TYPE * set, SCM list)
 976 #else
 977 static SCM
 978 retrieve_select_type (set, list)
 979      SELECT_TYPE * set;
 980      SCM list;
 981 #endif
 982 {
 983   SCM answer;
 984   answer = SCM_EOL;
 985   while (list != SCM_EOL)
 986     {
 987       if (   SCM_NIMP (SCM_CAR (list))
 988           && (scm_tc16_fport == SCM_TYP16 (SCM_CAR (list)))
 989           && SCM_OPPORTP (SCM_CAR (list)))
 990         {
 991           if (FD_ISSET (fileno ((FILE *)SCM_STREAM (SCM_CAR (list))), set))
 992             answer = scm_cons (SCM_CAR (list), answer);
 993         }
 994       else if (SCM_INUMP (SCM_CAR (list)))
 995         {
 996           if (FD_ISSET (SCM_INUM (SCM_CAR (list)), set))
 997             answer = scm_cons (SCM_CAR (list), answer);
 998         }
 999       else if (SCM_NIMP (SCM_CAR (list)) && SCM_FD_P (SCM_CAR (list)))
1000         {
1001           if (FD_ISSET (SCM_FD (SCM_CAR (list)), set))
1002             answer = scm_cons (SCM_CAR (list), answer);
1003         }
1004       list = SCM_CDR (list);
1005     }
1006   return answer;
1007 }
1008
1009
1010 SCM_PROC (s_sys_select, "select", 3, 2, 0, scm_sys_select);
1011 #ifdef __STDC__
1012 SCM
1013 scm_sys_select (SCM reads, SCM writes, SCM excepts, SCM secs, SCM msecs)
1014 #else
1015 SCM
1016 scm_sys_select (reads, writes, excepts, secs, msecs)
1017      SCM reads;
1018      SCM writes;
1019      SCM excepts;
1020      SCM secs;
1021      SCM msecs;
1022 #endif
1023 {
1024 #ifdef HAVE_SELECT
1025   struct timeval timeout;
1026   struct timeval * time_p;
1027   SELECT_TYPE read_set;
1028   SELECT_TYPE write_set;
1029   SELECT_TYPE except_set;
1030   int sreturn;
1031
1032   SCM_ASSERT (-1 < scm_ilength (reads), reads, SCM_ARG1, s_sys_select);
1033   SCM_ASSERT (-1 < scm_ilength (writes), reads, SCM_ARG1, s_sys_select);
1034   SCM_ASSERT (-1 < scm_ilength (excepts), reads, SCM_ARG1, s_sys_select);
1035
1036   FD_ZERO (&read_set);
1037   FD_ZERO (&write_set);
1038   FD_ZERO (&except_set);
1039
1040   fill_select_type (&read_set, reads);
1041   fill_select_type (&write_set, writes);
1042   fill_select_type (&except_set, excepts);
1043
1044   if (SCM_UNBNDP (secs))
1045     time_p = 0;
1046   else
1047     {
1048       SCM_ASSERT (SCM_INUMP (secs), secs, SCM_ARG4, s_sys_select);
1049       if (SCM_UNBNDP (msecs))
1050         msecs = SCM_INUM0;
1051       else
1052         SCM_ASSERT (SCM_INUMP (msecs), msecs, SCM_ARG5, s_sys_select);
1053
1054       timeout.tv_sec = SCM_INUM (secs);
1055       timeout.tv_usec = 1000 * SCM_INUM (msecs);
1056       time_p = &timeout;
1057     }
1058
1059   SCM_DEFER_INTS;
1060   sreturn = select (SELECT_SET_SIZE,
1061                     &read_set, &write_set, &except_set, time_p);
1062   SCM_ALLOW_INTS;
1063   if (sreturn < 0)
1064     SCM_SYSERROR (s_sys_select);
1065   return scm_listify (retrieve_select_type (&read_set, reads),
1066                       retrieve_select_type (&write_set, writes),
1067                       retrieve_select_type (&except_set, excepts),
1068                       SCM_UNDEFINED);
1069 #else
1070   SCM_SYSMISSING (s_sys_select);
1071   /* not reached.  */
1072   return SCM_BOOL_F;
1073 #endif
1074 }
1075
1076 \f
1077 /* {Symbolic Links}
1078  */
1079
1080 SCM_PROC (s_sys_symlink, "symlink", 2, 0, 0, scm_sys_symlink);
1081 #ifdef __STDC__
1082 SCM
1083 scm_sys_symlink(SCM oldpath, SCM newpath)
1084 #else
1085 SCM
1086 scm_sys_symlink(oldpath, newpath)
1087      SCM oldpath;
1088      SCM newpath;
1089 #endif
1090 {
1091 #ifdef HAVE_SYMLINK
1092   int val;
1093
1094   SCM_ASSERT(SCM_NIMP(oldpath) && SCM_STRINGP(oldpath), oldpath, SCM_ARG1, s_sys_symlink);
1095   SCM_ASSERT(SCM_NIMP(newpath) && SCM_STRINGP(newpath), newpath, SCM_ARG2, s_sys_symlink);
1096   SCM_SYSCALL (val = symlink(SCM_CHARS(oldpath), SCM_CHARS(newpath)));
1097   if (val != 0)
1098     SCM_SYSERROR (s_sys_symlink);
1099   return SCM_UNSPECIFIED;
1100 #else
1101   SCM_SYSMISSING (s_sys_symlink);
1102   /* not reached.  */
1103   return SCM_BOOL_F;
1104 #endif
1105 }
1106
1107
1108 SCM_PROC (s_sys_readlink, "readlink", 1, 0, 0, scm_sys_readlink);
1109 #ifdef __STDC__
1110 SCM
1111 scm_sys_readlink(SCM path)
1112 #else
1113 SCM
1114 scm_sys_readlink(path)
1115   SCM path;
1116 #endif
1117 {
1118 #ifdef HAVE_READLINK
1119   scm_sizet rv;
1120   scm_sizet size = 100;
1121   char *buf;
1122   SCM result;
1123   SCM_ASSERT (SCM_NIMP (path) && SCM_STRINGP (path),  path, (char *) SCM_ARG1, s_sys_readlink);
1124   SCM_DEFER_INTS;
1125   buf = scm_must_malloc (size, s_sys_readlink);
1126   while ((rv = readlink (SCM_CHARS (path), buf, (scm_sizet) size)) == size)
1127     {
1128       scm_must_free (buf);
1129       size *= 2;
1130       buf = scm_must_malloc (size, s_sys_readlink);
1131     }
1132   if (rv == -1)
1133     SCM_SYSERROR (s_sys_readlink);
1134   result = scm_makfromstr (buf, rv, 0);
1135   scm_must_free (buf);
1136   SCM_ALLOW_INTS;
1137   return result;
1138 #else
1139   SCM_SYSMISSING (s_sys_readlink);
1140   /* not reached.  */
1141   return SCM_BOOL_F;
1142 #endif
1143 }
1144
1145
1146 SCM_PROC (s_sys_lstat, "lstat", 1, 0, 0, scm_sys_lstat);
1147 #ifdef __STDC__
1148 SCM
1149 scm_sys_lstat(SCM str)
1150 #else
1151 SCM
1152 scm_sys_lstat(str)
1153   SCM str;
1154 #endif
1155 {
1156 #ifdef HAVE_LSTAT
1157   int rv;
1158   struct stat stat_temp;
1159
1160   SCM_ASSERT(SCM_NIMP(str) && SCM_STRINGP(str), str, (char *)SCM_ARG1, s_sys_lstat);
1161   SCM_SYSCALL(rv = lstat(SCM_CHARS(str), &stat_temp));
1162   if (rv != 0)
1163     SCM_SYSERROR (s_sys_lstat);
1164   return scm_stat2scm(&stat_temp);
1165 #else
1166   SCM_SYSMISSING (s_sys_lstat);
1167   /* not reached.  */
1168   return SCM_BOOL_F;
1169 #endif
1170 }
1171
1172
1173 SCM_PROC (s_sys_copy_file, "copy-file", 2, 0, 0, scm_sys_copy_file);
1174 #ifdef __STDC__
1175 SCM
1176 scm_sys_copy_file (SCM oldfile, SCM newfile)
1177 #else
1178 SCM
1179 scm_sys_copy_file (oldfile, newfile)
1180      SCM oldfile;
1181      SCM newfile;
1182 #endif
1183 {
1184   int oldfd, newfd;
1185   int n;
1186   char buf[BUFSIZ];             /* this space could be shared.  */
1187   struct stat oldstat;
1188
1189   SCM_ASSERT (SCM_NIMP (oldfile) && SCM_ROSTRINGP (oldfile), oldfile, SCM_ARG1, s_sys_copy_file);
1190   if (SCM_SUBSTRP (oldfile))
1191     oldfile = scm_makfromstr (SCM_ROCHARS (oldfile), SCM_ROLENGTH (oldfile), 0);
1192   SCM_ASSERT (SCM_NIMP (newfile) && SCM_ROSTRINGP (newfile), newfile, SCM_ARG2, s_sys_copy_file);
1193   if (SCM_SUBSTRP (newfile))
1194     newfile = scm_makfromstr (SCM_ROCHARS (newfile), SCM_ROLENGTH (newfile), 0);
1195   if (stat (SCM_ROCHARS (oldfile), &oldstat) == -1)
1196     SCM_SYSERROR (s_sys_copy_file);
1197   SCM_DEFER_INTS;
1198   oldfd = open (SCM_ROCHARS (oldfile), O_RDONLY);
1199   if (oldfd == -1)
1200     SCM_SYSERROR (s_sys_copy_file);
1201
1202   /* use POSIX flags instead of 07777?.  */
1203   newfd = open (SCM_ROCHARS (newfile), O_WRONLY | O_CREAT | O_TRUNC,
1204                 oldstat.st_mode & 07777);
1205   if (newfd == -1)
1206     SCM_SYSERROR (s_sys_copy_file);
1207
1208   while ((n = read (oldfd, buf, sizeof buf)) > 0)
1209     if (write (newfd, buf, n) != n)
1210       {
1211         close (oldfd);
1212         close (newfd);
1213         SCM_SYSERROR (s_sys_copy_file);
1214       }
1215   close (oldfd);
1216   if (close (newfd) == -1)
1217     SCM_SYSERROR (s_sys_copy_file);
1218   SCM_ALLOW_INTS;
1219   return SCM_UNSPECIFIED;
1220 }
1221
1222 \f
1223 #ifdef __STDC__
1224 void
1225 scm_init_filesys (void)
1226 #else
1227 void
1228 scm_init_filesys ()
1229 #endif
1230 {
1231   /* File type/permission bits.  */
1232 #ifdef S_IRUSR
1233   scm_sysintern ("S_IRUSR", SCM_MAKINUM (S_IRUSR));
1234 #endif
1235 #ifdef S_IWUSR
1236   scm_sysintern ("S_IWUSR", SCM_MAKINUM (S_IWUSR));
1237 #endif
1238 #ifdef S_IXUSR
1239   scm_sysintern ("S_IXUSR", SCM_MAKINUM (S_IXUSR));
1240 #endif
1241 #ifdef S_IRWXU
1242   scm_sysintern ("S_IRWXU", SCM_MAKINUM (S_IRWXU));
1243 #endif
1244
1245 #ifdef S_IRGRP
1246   scm_sysintern ("S_IRGRP", SCM_MAKINUM (S_IRGRP));
1247 #endif
1248 #ifdef S_IWGRP
1249   scm_sysintern ("S_IWGRP", SCM_MAKINUM (S_IWGRP));
1250 #endif
1251 #ifdef S_IXGRP
1252   scm_sysintern ("S_IXGRP", SCM_MAKINUM (S_IXGRP));
1253 #endif
1254 #ifdef S_IRWXG
1255   scm_sysintern ("S_IRWXG", SCM_MAKINUM (S_IRWXG));
1256 #endif
1257
1258 #ifdef S_IROTH
1259   scm_sysintern ("S_IROTH", SCM_MAKINUM (S_IROTH));
1260 #endif
1261 #ifdef S_IWOTH
1262   scm_sysintern ("S_IWOTH", SCM_MAKINUM (S_IWOTH));
1263 #endif
1264 #ifdef S_IXOTH
1265   scm_sysintern ("S_IXOTH", SCM_MAKINUM (S_IXOTH));
1266 #endif
1267 #ifdef S_IRWXO
1268   scm_sysintern ("S_IRWXO", SCM_MAKINUM (S_IRWXO));
1269 #endif
1270
1271 #ifdef S_ISUID
1272   scm_sysintern ("S_ISUID", SCM_MAKINUM (S_ISUID));
1273 #endif
1274 #ifdef S_ISGID
1275   scm_sysintern ("S_ISGID", SCM_MAKINUM (S_ISGID));
1276 #endif
1277 #ifdef S_ISVTX
1278   scm_sysintern ("S_ISVTX", SCM_MAKINUM (S_ISVTX));
1279 #endif
1280
1281 #ifdef S_IFMT
1282   scm_sysintern ("S_IFMT", SCM_MAKINUM (S_IFMT));
1283 #endif
1284 #ifdef S_IFDIR
1285   scm_sysintern ("S_IFDIR", SCM_MAKINUM (S_IFDIR));
1286 #endif
1287 #ifdef S_IFCHR
1288   scm_sysintern ("S_IFCHR", SCM_MAKINUM (S_IFCHR));
1289 #endif
1290 #ifdef S_IFBLK
1291   scm_sysintern ("S_IFBLK", SCM_MAKINUM (S_IFBLK));
1292 #endif
1293 #ifdef S_IFREG
1294   scm_sysintern ("S_IFREG", SCM_MAKINUM (S_IFREG));
1295 #endif
1296 #ifdef S_IFLNK
1297   scm_sysintern ("S_IFLNK", SCM_MAKINUM (S_IFLNK));
1298 #endif
1299 #ifdef S_IFSOCK
1300   scm_sysintern ("S_IFSOCK", SCM_MAKINUM (S_IFSOCK));
1301 #endif
1302 #ifdef S_IFIFO
1303   scm_sysintern ("S_IFIFO", SCM_MAKINUM (S_IFIFO));
1304 #endif
1305
1306
1307   scm_tc16_fd = scm_newsmob (&fd_smob);
1308   scm_tc16_dir = scm_newsmob (&dir_smob);
1309
1310 #include "filesys.x"
1311 }