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