libguile/filesys.c

   1 /*      Copyright (C) 1996, 1997 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, Inc., 59 Temple Place, Suite 330,
  16  * Boston, MA 02111-1307 USA
  17  *
  18  * As a special exception, the Free Software Foundation gives permission
  19  * for additional uses of the text contained in its release of GUILE.
  20  *
  21  * The exception is that, if you link the GUILE library with other files
  22  * to produce an executable, this does not by itself cause the
  23  * resulting executable to be covered by the GNU General Public License.
  24  * Your use of that executable is in no way restricted on account of
  25  * linking the GUILE library code into it.
  26  *
  27  * This exception does not however invalidate any other reasons why
  28  * the executable file might be covered by the GNU General Public License.
  29  *
  30  * This exception applies only to the code released by the
  31  * Free Software Foundation under the name GUILE.  If you copy
  32  * code from other Free Software Foundation releases into a copy of
  33  * GUILE, as the General Public License permits, the exception does
  34  * not apply to the code that you add in this way.  To avoid misleading
  35  * anyone as to the status of such modified files, you must delete
  36  * this exception notice from them.
  37  *
  38  * If you write modifications of your own for GUILE, it is your choice
  39  * whether to permit this exception to apply to your modifications.
  40  * If you do not wish that, delete this exception notice.  */
  41 \f
  42 #include <stdio.h>
  43 #include "_scm.h"
  44 #include "genio.h"
  45 #include "smob.h"
  46 #include "feature.h"
  47 #include "fports.h"
  48
  49 #include "filesys.h"
  50 \f
  51 #ifdef TIME_WITH_SYS_TIME
  52 # include <sys/time.h>
  53 # include <time.h>
  54 #else
  55 # if HAVE_SYS_TIME_H
  56 #  include <sys/time.h>
  57 # else
  58 #  include <time.h>
  59 # endif
  60 #endif
  61
  62 #ifdef HAVE_UNISTD_H
  63 #include <unistd.h>
  64 #endif
  65
  66 #ifdef LIBC_H_WITH_UNISTD_H
  67 #include <libc.h>
  68 #endif
  69
  70 #ifdef HAVE_SYS_SELECT_H
  71 #include <sys/select.h>
  72 #endif
  73
  74 #ifdef HAVE_STRING_H
  75 #include <string.h>
  76 #endif
  77
  78 #include <sys/types.h>
  79 #include <sys/stat.h>
  80 #include <fcntl.h>
  81
  82 #include <pwd.h>
  83
  84
  85 #ifdef FD_SET
  86
  87 #define SELECT_TYPE fd_set
  88 #define SELECT_SET_SIZE FD_SETSIZE
  89
  90 #else /* no FD_SET */
  91
  92 /* Define the macros to access a single-int bitmap of descriptors.  */
  93 #define SELECT_SET_SIZE 32
  94 #define SELECT_TYPE int
  95 #define FD_SET(n, p) (*(p) |= (1 << (n)))
  96 #define FD_CLR(n, p) (*(p) &= ~(1 << (n)))
  97 #define FD_ISSET(n, p) (*(p) & (1 << (n)))
  98 #define FD_ZERO(p) (*(p) = 0)
  99
 100 #endif /* no FD_SET */
 101
 102 #if HAVE_DIRENT_H
 103 # include <dirent.h>
 104 # define NAMLEN(dirent) strlen((dirent)->d_name)
 105 #else
 106 # define dirent direct
 107 # define NAMLEN(dirent) (dirent)->d_namlen
 108 # if HAVE_SYS_NDIR_H
 109 #  include <sys/ndir.h>
 110 # endif
 111 # if HAVE_SYS_DIR_H
 112 #  include <sys/dir.h>
 113 # endif
 114 # if HAVE_NDIR_H
 115 #  include <ndir.h>
 116 # endif
 117 #endif
 118
 119 /* Ultrix has S_IFSOCK, but no S_ISSOCK.  Ipe!  */
 120 #if defined (S_IFSOCK) && ! defined (S_ISSOCK)
 121 #define S_ISSOCK(mode) (((mode) & S_IFMT) == S_IFSOCK)
 122 #endif
 123 \f
 124
 125
 126 \f
 127
 128 /* {Permissions}
 129  */
 130
 131 SCM_PROC (s_chown, "chown", 3, 0, 0, scm_chown);
 132
 133 SCM
 134 scm_chown (object, owner, group)
 135      SCM object;
 136      SCM owner;
 137      SCM group;
 138 {
 139   int rv;
 140   int fdes;
 141
 142   object = SCM_COERCE_OUTPORT (object);
 143
 144   SCM_ASSERT (SCM_INUMP (owner), owner, SCM_ARG2, s_chown);
 145   SCM_ASSERT (SCM_INUMP (group), group, SCM_ARG3, s_chown);
 146   SCM_DEFER_INTS;
 147   if (SCM_INUMP (object) || (SCM_NIMP (object) && SCM_OPFPORTP (object)))
 148     {
 149       if (SCM_INUMP (object))
 150         fdes = SCM_INUM (object);
 151       else
 152         {
 153           fdes = fileno ((FILE *) SCM_STREAM (object));
 154           if (fdes == -1)
 155             scm_syserror (s_chown);
 156         }
 157       SCM_SYSCALL (rv = fchown (fdes, SCM_INUM (owner), SCM_INUM (group)));
 158     }
 159   else
 160     {
 161       SCM_ASSERT (SCM_NIMP (object) && SCM_ROSTRINGP (object),
 162                   object, SCM_ARG1, s_chown);
 163       SCM_COERCE_SUBSTR (object);
 164       SCM_SYSCALL (rv = chown (SCM_ROCHARS (object),
 165                                SCM_INUM (owner), SCM_INUM (group)));
 166     }
 167   if (rv == -1)
 168     scm_syserror (s_chown);
 169   SCM_ALLOW_INTS;
 170   return SCM_UNSPECIFIED;
 171 }
 172
 173
 174 SCM_PROC (s_chmod, "chmod", 2, 0, 0, scm_chmod);
 175
 176 SCM
 177 scm_chmod (object, mode)
 178      SCM object;
 179      SCM mode;
 180 {
 181   int rv;
 182   int fdes;
 183
 184   object = SCM_COERCE_OUTPORT (object);
 185
 186   SCM_ASSERT (SCM_INUMP (mode), mode, SCM_ARG2, s_chmod);
 187   SCM_DEFER_INTS;
 188   if (SCM_INUMP (object) || (SCM_NIMP (object) && SCM_OPFPORTP (object)))
 189     {
 190       if (SCM_INUMP (object))
 191         fdes = SCM_INUM (object);
 192       else
 193         {
 194           fdes = fileno ((FILE *) SCM_STREAM (object));
 195           if (fdes == -1)
 196             scm_syserror (s_chmod);
 197         }
 198       SCM_SYSCALL (rv = fchmod (fdes, SCM_INUM (mode)));
 199     }
 200   else
 201     {
 202       SCM_ASSERT (SCM_NIMP (object) && SCM_ROSTRINGP (object),
 203                   object, SCM_ARG1, s_chmod);
 204       SCM_COERCE_SUBSTR (object);
 205       SCM_SYSCALL (rv = chmod (SCM_ROCHARS (object), SCM_INUM (mode)));
 206     }
 207   if (rv == -1)
 208     scm_syserror (s_chmod);
 209   SCM_ALLOW_INTS;
 210   return SCM_UNSPECIFIED;
 211 }
 212
 213 SCM_PROC (s_umask, "umask", 0, 1, 0, scm_umask);
 214
 215 SCM
 216 scm_umask (mode)
 217      SCM mode;
 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
 235 SCM_PROC (s_open_fdes, "open-fdes", 2, 1, 0, scm_open_fdes);
 236 SCM
 237 scm_open_fdes (SCM path, SCM flags, SCM mode)
 238 {
 239   int fd;
 240   int iflags;
 241   int imode;
 242
 243   SCM_ASSERT (SCM_NIMP (path) && SCM_ROSTRINGP (path), path, SCM_ARG1,
 244               s_open_fdes);
 245   SCM_COERCE_SUBSTR (path);
 246   iflags = scm_num2long (flags, (char *) SCM_ARG2, s_open_fdes);
 247
 248   SCM_DEFER_INTS;
 249   if (SCM_UNBNDP (mode))
 250     imode = 0666;
 251   else
 252     {
 253       SCM_ASSERT (SCM_INUMP (mode), mode, SCM_ARG3, s_open_fdes);
 254       imode = SCM_INUM (mode);
 255     }
 256   SCM_SYSCALL (fd = open (SCM_ROCHARS (path), iflags, imode));
 257   if (fd == -1)
 258     scm_syserror (s_open_fdes);
 259   SCM_ALLOW_INTS;
 260   return SCM_MAKINUM (fd);
 261 }
 262
 263 SCM_PROC (s_open, "open", 2, 1, 0, scm_open);
 264 SCM
 265 scm_open (SCM path, SCM flags, SCM mode)
 266 {
 267   SCM newpt;
 268   char *port_mode;
 269   int fd;
 270   FILE *f;
 271   int iflags;
 272
 273   fd = SCM_INUM (scm_open_fdes (path, flags, mode));
 274   iflags = scm_num2long (flags, (char *) SCM_ARG2, s_open_fdes);
 275   SCM_NEWCELL (newpt);
 276   if (iflags & O_RDWR)
 277     port_mode = "r+";
 278   else {
 279     if (iflags & O_WRONLY)
 280       port_mode = "w";
 281     else
 282       port_mode = "r";
 283   }
 284   SCM_DEFER_INTS;
 285   f = fdopen (fd, port_mode);
 286   if (!f)
 287     {
 288       SCM_SYSCALL (close (fd));
 289       scm_syserror (s_open);
 290     }
 291   {
 292     struct scm_port_table * pt;
 293
 294     pt = scm_add_to_port_table (newpt);
 295     SCM_SETPTAB_ENTRY (newpt, pt);
 296     SCM_SETCAR (newpt, scm_tc16_fport | scm_mode_bits (port_mode));
 297     /* if (SCM_BUF0 & SCM_CAR (newpt))
 298        scm_setbuf0 (newpt); */
 299     SCM_SETSTREAM (newpt, (SCM)f);
 300     SCM_PTAB_ENTRY (newpt)->file_name = path;
 301   }
 302   SCM_ALLOW_INTS;
 303
 304   return newpt;
 305 }
 306
 307 SCM_PROC (s_close, "close", 1, 0, 0, scm_close);
 308 SCM
 309 scm_close (SCM fd_or_port)
 310 {
 311   int rv;
 312   int fd;
 313
 314   fd_or_port = SCM_COERCE_OUTPORT (fd_or_port);
 315
 316   if (SCM_NIMP (fd_or_port) && SCM_PORTP (fd_or_port))
 317     return scm_close_port (fd_or_port);
 318   SCM_ASSERT (SCM_INUMP (fd_or_port), fd_or_port, SCM_ARG1, s_close);
 319   fd = SCM_INUM (fd_or_port);
 320   SCM_DEFER_INTS;
 321   scm_evict_ports (fd);         /* see scsh manual.  */
 322   SCM_SYSCALL (rv = close (fd));
 323   /* following scsh, closing an already closed file descriptor is
 324      not an error.  */
 325   if (rv < 0 && errno != EBADF)
 326     scm_syserror (s_close);
 327   SCM_ALLOW_INTS;
 328   return (rv < 0) ? SCM_BOOL_F : SCM_BOOL_T;
 329 }
 330
 331 \f
 332 /* {Files}
 333  */
 334
 335 SCM_SYMBOL (scm_sym_regular, "regular");
 336 SCM_SYMBOL (scm_sym_directory, "directory");
 337 SCM_SYMBOL (scm_sym_symlink, "symlink");
 338 SCM_SYMBOL (scm_sym_block_special, "block-special");
 339 SCM_SYMBOL (scm_sym_char_special, "char-special");
 340 SCM_SYMBOL (scm_sym_fifo, "fifo");
 341 SCM_SYMBOL (scm_sym_sock, "socket");
 342 SCM_SYMBOL (scm_sym_unknown, "unknown");
 343
 344 static SCM scm_stat2scm SCM_P ((struct stat *stat_temp));
 345
 346 static SCM
 347 scm_stat2scm (stat_temp)
 348      struct stat *stat_temp;
 349 {
 350   SCM ans = scm_make_vector (SCM_MAKINUM (15), SCM_UNSPECIFIED, SCM_BOOL_F);
 351   SCM *ve = SCM_VELTS (ans);
 352
 353   ve[0] = scm_ulong2num ((unsigned long) stat_temp->st_dev);
 354   ve[1] = scm_ulong2num ((unsigned long) stat_temp->st_ino);
 355   ve[2] = scm_ulong2num ((unsigned long) stat_temp->st_mode);
 356   ve[3] = scm_ulong2num ((unsigned long) stat_temp->st_nlink);
 357   ve[4] = scm_ulong2num ((unsigned long) stat_temp->st_uid);
 358   ve[5] = scm_ulong2num ((unsigned long) stat_temp->st_gid);
 359 #ifdef HAVE_ST_RDEV
 360   ve[6] = scm_ulong2num ((unsigned long) stat_temp->st_rdev);
 361 #else
 362   ve[6] = SCM_BOOL_F;
 363 #endif
 364   ve[7] = scm_ulong2num ((unsigned long) stat_temp->st_size);
 365   ve[8] = scm_ulong2num ((unsigned long) stat_temp->st_atime);
 366   ve[9] = scm_ulong2num ((unsigned long) stat_temp->st_mtime);
 367   ve[10] = scm_ulong2num ((unsigned long) stat_temp->st_ctime);
 368 #ifdef HAVE_ST_BLKSIZE
 369   ve[11] = scm_ulong2num ((unsigned long) stat_temp->st_blksize);
 370 #else
 371   ve[11] = scm_ulong2num (4096L);
 372 #endif
 373 #ifdef HAVE_ST_BLOCKS
 374   ve[12] = scm_ulong2num ((unsigned long) stat_temp->st_blocks);
 375 #else
 376   ve[12] = SCM_BOOL_F;
 377 #endif
 378   {
 379     int mode = stat_temp->st_mode;
 380
 381     if (S_ISREG (mode))
 382       ve[13] = scm_sym_regular;
 383     else if (S_ISDIR (mode))
 384       ve[13] = scm_sym_directory;
 385     else if (S_ISLNK (mode))
 386       ve[13] = scm_sym_symlink;
 387     else if (S_ISBLK (mode))
 388       ve[13] = scm_sym_block_special;
 389     else if (S_ISCHR (mode))
 390       ve[13] = scm_sym_char_special;
 391     else if (S_ISFIFO (mode))
 392       ve[13] = scm_sym_fifo;
 393     else if (S_ISSOCK (mode))
 394       ve[13] = scm_sym_sock;
 395     else
 396       ve[13] = scm_sym_unknown;
 397
 398     ve[14] = SCM_MAKINUM ((~S_IFMT) & mode);
 399
 400     /* the layout of the bits in ve[14] is intended to be portable.
 401        If there are systems that don't follow the usual convention,
 402        the following could be used:
 403
 404        tmp = 0;
 405        if (S_ISUID & mode) tmp += 1;
 406        tmp <<= 1;
 407        if (S_IRGRP & mode) tmp += 1;
 408        tmp <<= 1;
 409        if (S_ISVTX & mode) tmp += 1;
 410        tmp <<= 1;
 411        if (S_IRUSR & mode) tmp += 1;
 412        tmp <<= 1;
 413        if (S_IWUSR & mode) tmp += 1;
 414        tmp <<= 1;
 415        if (S_IXUSR & mode) tmp += 1;
 416        tmp <<= 1;
 417        if (S_IWGRP & mode) tmp += 1;
 418        tmp <<= 1;
 419        if (S_IXGRP & mode) tmp += 1;
 420        tmp <<= 1;
 421        if (S_IROTH & mode) tmp += 1;
 422        tmp <<= 1;
 423        if (S_IWOTH & mode) tmp += 1;
 424        tmp <<= 1;
 425        if (S_IXOTH & mode) tmp += 1;
 426
 427        ve[14] = SCM_MAKINUM (tmp);
 428
 429        */
 430   }
 431
 432   return ans;
 433 }
 434
 435 SCM_PROC (s_stat, "stat", 1, 0, 0, scm_stat);
 436
 437 SCM
 438 scm_stat (object)
 439      SCM object;
 440 {
 441   int rv;
 442   int fdes;
 443   struct stat stat_temp;
 444
 445   object = SCM_COERCE_OUTPORT (object);
 446
 447   SCM_DEFER_INTS;
 448   if (SCM_INUMP (object) || (SCM_NIMP (object) && SCM_OPFPORTP (object)))
 449     {
 450       if (SCM_INUMP (object))
 451         fdes = SCM_INUM (object);
 452       else
 453         {
 454           fdes = fileno ((FILE *) SCM_STREAM (object));
 455           if (fdes == -1)
 456             scm_syserror (s_stat);
 457         }
 458       SCM_SYSCALL (rv = fstat (fdes, &stat_temp));
 459     }
 460   else
 461     {
 462       SCM_ASSERT (SCM_NIMP (object) && SCM_ROSTRINGP (object),
 463                   object, SCM_ARG1, s_stat);
 464       SCM_COERCE_SUBSTR (object);
 465       SCM_SYSCALL (rv = stat (SCM_ROCHARS (object), &stat_temp));
 466     }
 467   if (rv == -1)
 468     {
 469       int en = errno;
 470
 471       scm_syserror_msg (s_stat, "%s: %S",
 472                         scm_listify (scm_makfrom0str (strerror (errno)),
 473                                      object,
 474                                      SCM_UNDEFINED),
 475                         en);
 476     }
 477   SCM_ALLOW_INTS;
 478   return scm_stat2scm (&stat_temp);
 479 }
 480
 481
 482 \f
 483 /* {Modifying Directories}
 484  */
 485
 486 SCM_PROC (s_link, "link", 2, 0, 0, scm_link);
 487
 488 SCM
 489 scm_link (oldpath, newpath)
 490      SCM oldpath;
 491      SCM newpath;
 492 {
 493   int val;
 494
 495   SCM_ASSERT (SCM_NIMP (oldpath) && SCM_ROSTRINGP (oldpath), oldpath,
 496               SCM_ARG1, s_link);
 497   if (SCM_SUBSTRP (oldpath))
 498     oldpath = scm_makfromstr (SCM_ROCHARS (oldpath),
 499                               SCM_ROLENGTH (oldpath), 0);
 500   SCM_ASSERT (SCM_NIMP (newpath) && SCM_ROSTRINGP (newpath), newpath,
 501               SCM_ARG2, s_link);
 502   if (SCM_SUBSTRP (newpath))
 503     newpath = scm_makfromstr (SCM_ROCHARS (newpath),
 504                               SCM_ROLENGTH (newpath), 0);
 505   SCM_DEFER_INTS;
 506   SCM_SYSCALL (val = link (SCM_ROCHARS (oldpath), SCM_ROCHARS (newpath)));
 507   if (val != 0)
 508     scm_syserror (s_link);
 509   SCM_ALLOW_INTS;
 510   return SCM_UNSPECIFIED;
 511 }
 512
 513
 514
 515 SCM_PROC (s_rename, "rename-file", 2, 0, 0, scm_rename);
 516
 517 SCM
 518 scm_rename (oldname, newname)
 519      SCM oldname;
 520      SCM newname;
 521 {
 522   int rv;
 523   SCM_ASSERT (SCM_NIMP (oldname) && SCM_ROSTRINGP (oldname), oldname, SCM_ARG1,
 524               s_rename);
 525   SCM_ASSERT (SCM_NIMP (newname) && SCM_ROSTRINGP (newname), newname, SCM_ARG2,
 526               s_rename);
 527   SCM_COERCE_SUBSTR (oldname);
 528   SCM_COERCE_SUBSTR (newname);
 529   SCM_DEFER_INTS;
 530 #ifdef HAVE_RENAME
 531   SCM_SYSCALL (rv = rename (SCM_ROCHARS (oldname), SCM_ROCHARS (newname)));
 532 #else
 533   SCM_SYSCALL (rv = link (SCM_ROCHARS (oldname), SCM_ROCHARS (newname)));
 534   if (rv == 0)
 535     {
 536       SCM_SYSCALL (rv = unlink (SCM_ROCHARS (oldname)));;
 537       if (rv != 0)
 538         /* unlink failed.  remove new name */
 539         SCM_SYSCALL (unlink (SCM_ROCHARS (newname)));
 540     }
 541 #endif
 542   if (rv != 0)
 543     scm_syserror (s_rename);
 544   SCM_ALLOW_INTS;
 545   return SCM_UNSPECIFIED;
 546 }
 547
 548
 549 SCM_PROC(s_delete_file, "delete-file", 1, 0, 0, scm_delete_file);
 550
 551 SCM
 552 scm_delete_file (str)
 553      SCM str;
 554 {
 555   int ans;
 556   SCM_ASSERT (SCM_NIMP (str) && SCM_ROSTRINGP (str), str, SCM_ARG1,
 557               s_delete_file);
 558   SCM_COERCE_SUBSTR (str);
 559   SCM_DEFER_INTS;
 560   SCM_SYSCALL (ans = unlink (SCM_ROCHARS (str)));
 561   if (ans != 0)
 562     scm_syserror (s_delete_file);
 563   SCM_ALLOW_INTS;
 564   return SCM_UNSPECIFIED;
 565 }
 566
 567 SCM_PROC (s_truncate_file, "truncate-file", 2, 0, 0, scm_truncate_file);
 568 SCM
 569 scm_truncate_file (SCM object, SCM size)
 570 {
 571   int rv;
 572   scm_sizet csize;
 573   int fdes;
 574
 575   object = SCM_COERCE_OUTPORT (object);
 576
 577   csize = (scm_sizet) scm_num2long (size, (char *) SCM_ARG2, s_truncate_file);
 578   SCM_DEFER_INTS;
 579   if (SCM_INUMP (object) || (SCM_NIMP (object) && SCM_OPFPORTP (object)))
 580     {
 581       if (SCM_INUMP (object))
 582         fdes = SCM_INUM (object);
 583       else
 584         {
 585           fdes = fileno ((FILE *) SCM_STREAM (object));
 586           if (fdes == -1)
 587             scm_syserror (s_truncate_file);
 588         }
 589       SCM_SYSCALL (rv = ftruncate (fdes, csize));
 590     }
 591   else
 592     {
 593       SCM_ASSERT (SCM_NIMP (object) && SCM_ROSTRINGP (object),
 594                   object, SCM_ARG1, s_chown);
 595       SCM_COERCE_SUBSTR (object);
 596       SCM_SYSCALL (rv = truncate (SCM_ROCHARS (object), csize));
 597     }
 598   if (rv == -1)
 599     scm_syserror (s_truncate_file);
 600   SCM_ALLOW_INTS;
 601   return SCM_UNSPECIFIED;
 602 }
 603
 604 SCM_PROC (s_mkdir, "mkdir", 1, 1, 0, scm_mkdir);
 605
 606 SCM
 607 scm_mkdir (path, mode)
 608      SCM path;
 609      SCM mode;
 610 {
 611 #ifdef HAVE_MKDIR
 612   int rv;
 613   mode_t mask;
 614   SCM_ASSERT (SCM_NIMP (path) && SCM_ROSTRINGP (path), path, SCM_ARG1,
 615               s_mkdir);
 616   SCM_COERCE_SUBSTR (path);
 617   SCM_DEFER_INTS;
 618   if (SCM_UNBNDP (mode))
 619     {
 620       mask = umask (0);
 621       umask (mask);
 622       SCM_SYSCALL (rv = mkdir (SCM_ROCHARS (path), 0777 ^ mask));
 623     }
 624   else
 625     {
 626       SCM_ASSERT (SCM_INUMP (mode), mode, SCM_ARG2, s_mkdir);
 627       SCM_SYSCALL (rv = mkdir (SCM_ROCHARS (path), SCM_INUM (mode)));
 628     }
 629   if (rv != 0)
 630     scm_syserror (s_mkdir);
 631   SCM_ALLOW_INTS;
 632   return SCM_UNSPECIFIED;
 633 #else
 634   scm_sysmissing (s_mkdir);
 635   /* not reached.  */
 636   return SCM_BOOL_F;
 637 #endif
 638 }
 639
 640
 641 SCM_PROC (s_rmdir, "rmdir", 1, 0, 0, scm_rmdir);
 642
 643 SCM
 644 scm_rmdir (path)
 645      SCM path;
 646 {
 647 #ifdef HAVE_RMDIR
 648   int val;
 649
 650   SCM_ASSERT (SCM_NIMP (path) && SCM_ROSTRINGP (path), path, SCM_ARG1,
 651               s_rmdir);
 652   SCM_COERCE_SUBSTR (path);
 653   SCM_DEFER_INTS;
 654   SCM_SYSCALL (val = rmdir (SCM_ROCHARS (path)));
 655   if (val != 0)
 656     scm_syserror (s_rmdir);
 657   SCM_ALLOW_INTS;
 658   return SCM_UNSPECIFIED;
 659 #else
 660   scm_sysmissing (s_rmdir);
 661   /* not reached.  */
 662   return SCM_BOOL_F;
 663 #endif
 664 }
 665
 666 \f
 667 /* {Examining Directories}
 668  */
 669
 670 long scm_tc16_dir;
 671
 672 SCM_PROC (s_opendir, "opendir", 1, 0, 0, scm_opendir);
 673
 674 SCM
 675 scm_opendir (dirname)
 676      SCM dirname;
 677 {
 678   DIR *ds;
 679   SCM dir;
 680   SCM_ASSERT (SCM_NIMP (dirname) && SCM_ROSTRINGP (dirname), dirname, SCM_ARG1,
 681               s_opendir);
 682   SCM_COERCE_SUBSTR (dirname);
 683   SCM_NEWCELL (dir);
 684   SCM_DEFER_INTS;
 685   SCM_SYSCALL (ds = opendir (SCM_ROCHARS (dirname)));
 686   if (ds == NULL)
 687     scm_syserror (s_opendir);
 688   SCM_SETCAR (dir, scm_tc16_dir | SCM_OPN);
 689   SCM_SETCDR (dir, ds);
 690   SCM_ALLOW_INTS;
 691   return dir;
 692 }
 693
 694
 695 SCM_PROC (s_readdir, "readdir", 1, 0, 0, scm_readdir);
 696
 697 SCM
 698 scm_readdir (port)
 699      SCM port;
 700 {
 701   struct dirent *rdent;
 702   SCM_DEFER_INTS;
 703   SCM_ASSERT (SCM_NIMP (port) && SCM_OPDIRP (port), port, SCM_ARG1, s_readdir);
 704   errno = 0;
 705   SCM_SYSCALL (rdent = readdir ((DIR *) SCM_CDR (port)));
 706   SCM_ALLOW_INTS;
 707   if (errno != 0)
 708     scm_syserror (s_readdir);
 709   return (rdent ? scm_makfromstr (rdent->d_name, NAMLEN (rdent), 0)
 710           : SCM_EOF_VAL);
 711 }
 712
 713
 714
 715 SCM_PROC (s_rewinddir, "rewinddir", 1, 0, 0, scm_rewinddir);
 716
 717 SCM
 718 scm_rewinddir (port)
 719      SCM port;
 720 {
 721   SCM_ASSERT (SCM_NIMP (port) && SCM_OPDIRP (port), port, SCM_ARG1, s_rewinddir);
 722   rewinddir ((DIR *) SCM_CDR (port));
 723   return SCM_UNSPECIFIED;
 724 }
 725
 726
 727
 728 SCM_PROC (s_closedir, "closedir", 1, 0, 0, scm_closedir);
 729
 730 SCM
 731 scm_closedir (port)
 732      SCM port;
 733 {
 734   int sts;
 735
 736   SCM_ASSERT (SCM_NIMP (port) && SCM_DIRP (port), port, SCM_ARG1, s_closedir);
 737   SCM_DEFER_INTS;
 738   if (SCM_CLOSEDP (port))
 739     {
 740       SCM_ALLOW_INTS;
 741       return SCM_UNSPECIFIED;
 742     }
 743   SCM_SYSCALL (sts = closedir ((DIR *) SCM_CDR (port)));
 744   if (sts != 0)
 745     scm_syserror (s_closedir);
 746   SCM_SETCAR (port, scm_tc16_dir);
 747   SCM_ALLOW_INTS;
 748   return SCM_UNSPECIFIED;
 749 }
 750
 751
 752
 753
 754 static int scm_dir_print SCM_P ((SCM sexp, SCM port, scm_print_state *pstate));
 755
 756 static int
 757 scm_dir_print (sexp, port, pstate)
 758      SCM sexp;
 759      SCM port;
 760      scm_print_state *pstate;
 761 {
 762   scm_prinport (sexp, port, "directory");
 763   return 1;
 764 }
 765
 766
 767 static scm_sizet scm_dir_free SCM_P ((SCM p));
 768
 769 static scm_sizet
 770 scm_dir_free (p)
 771      SCM p;
 772 {
 773   if (SCM_OPENP (p))
 774     closedir ((DIR *) SCM_CDR (p));
 775   return 0;
 776 }
 777
 778 static scm_smobfuns dir_smob = {scm_mark0, scm_dir_free, scm_dir_print, 0};
 779
 780 \f
 781 /* {Navigating Directories}
 782  */
 783
 784
 785 SCM_PROC (s_chdir, "chdir", 1, 0, 0, scm_chdir);
 786
 787 SCM
 788 scm_chdir (str)
 789      SCM str;
 790 {
 791   int ans;
 792
 793   SCM_ASSERT (SCM_NIMP (str) && SCM_ROSTRINGP (str), str, SCM_ARG1, s_chdir);
 794   SCM_COERCE_SUBSTR (str);
 795   SCM_DEFER_INTS;
 796   SCM_SYSCALL (ans = chdir (SCM_ROCHARS (str)));
 797   if (ans != 0)
 798     scm_syserror (s_chdir);
 799   SCM_ALLOW_INTS;
 800   return SCM_UNSPECIFIED;
 801 }
 802
 803
 804
 805 SCM_PROC (s_getcwd, "getcwd", 0, 0, 0, scm_getcwd);
 806
 807 SCM
 808 scm_getcwd ()
 809 {
 810 #ifdef HAVE_GETCWD
 811   char *rv;
 812
 813   scm_sizet size = 100;
 814   char *wd;
 815   SCM result;
 816
 817   SCM_DEFER_INTS;
 818   wd = scm_must_malloc (size, s_getcwd);
 819   while ((rv = getcwd (wd, size)) == 0 && errno == ERANGE)
 820     {
 821       scm_must_free (wd);
 822       size *= 2;
 823       wd = scm_must_malloc (size, s_getcwd);
 824     }
 825   if (rv == 0)
 826     scm_syserror (s_getcwd);
 827   result = scm_makfromstr (wd, strlen (wd), 0);
 828   scm_must_free (wd);
 829   SCM_ALLOW_INTS;
 830   return result;
 831 #else
 832   scm_sysmissing (s_getcwd);
 833   /* not reached.  */
 834   return SCM_BOOL_F;
 835 #endif
 836 }
 837
 838 \f
 839
 840
 841 static void
 842 set_element (SELECT_TYPE *set, SCM element)
 843 {
 844   element = SCM_COERCE_OUTPORT (element);
 845   if (SCM_NIMP (element) && SCM_TYP16 (element) == scm_tc16_fport
 846       && SCM_OPPORTP (element))
 847     FD_SET (fileno ((FILE *) SCM_STREAM (element)), set);
 848   else if (SCM_INUMP (element))
 849     FD_SET (SCM_INUM (element), set);
 850 }
 851
 852 static void
 853 fill_select_type (SELECT_TYPE *set, SCM list)
 854 {
 855   if (SCM_NIMP (list) && SCM_VECTORP (list))
 856     {
 857       int len = SCM_LENGTH (list);
 858       SCM *ve = SCM_VELTS (list);
 859
 860       while (len > 0)
 861         {
 862           set_element (set, ve[len - 1]);
 863           len--;
 864         }
 865     }
 866   else
 867     {
 868       while (list != SCM_EOL)
 869         {
 870           set_element (set, SCM_CAR (list));
 871           list = SCM_CDR (list);
 872         }
 873     }
 874 }
 875
 876 static SCM
 877 get_element (SELECT_TYPE *set, SCM element, SCM list)
 878 {
 879   element = SCM_COERCE_OUTPORT (element);
 880   if (SCM_NIMP (element)
 881       && (scm_tc16_fport == SCM_TYP16 (element))
 882       && SCM_OPPORTP (element))
 883     {
 884       if (FD_ISSET (fileno ((FILE *)SCM_STREAM (element)), set))
 885         list = scm_cons (element, list);
 886     }
 887   else if (SCM_INUMP (element))
 888     {
 889       if (FD_ISSET (SCM_INUM (element), set))
 890         list = scm_cons (element, list);
 891     }
 892   return list;
 893 }
 894
 895 static SCM
 896 retrieve_select_type (SELECT_TYPE *set, SCM list)
 897 {
 898   SCM answer_list = SCM_EOL;
 899
 900   if (SCM_NIMP (list) && SCM_VECTORP (list))
 901     {
 902       int len = SCM_LENGTH (list);
 903       SCM *ve = SCM_VELTS (list);
 904
 905       while (len > 0)
 906         {
 907           answer_list = get_element (set, ve[len - 1], answer_list);
 908           len--;
 909         }
 910       return scm_vector (answer_list);
 911     }
 912   else
 913     {
 914       /* list is a list.  */
 915       while (list != SCM_EOL)
 916         {
 917           answer_list = get_element (set, SCM_CAR (list), answer_list);
 918           list = SCM_CDR (list);
 919         }
 920       return answer_list;
 921     }
 922 }
 923
 924
 925 SCM_PROC (s_select, "select", 3, 2, 0, scm_select);
 926
 927 SCM
 928 scm_select (reads, writes, excepts, secs, usecs)
 929      SCM reads;
 930      SCM writes;
 931      SCM excepts;
 932      SCM secs;
 933      SCM usecs;
 934 {
 935 #ifdef HAVE_SELECT
 936   struct timeval timeout;
 937   struct timeval * time_p;
 938   SELECT_TYPE read_set;
 939   SELECT_TYPE write_set;
 940   SELECT_TYPE except_set;
 941   int sreturn;
 942
 943 #define assert_set(x, arg) \
 944   SCM_ASSERT (scm_ilength (x) > -1 || (SCM_NIMP (x) && SCM_VECTORP (x)), \
 945               x, arg, s_select)
 946   assert_set (reads, SCM_ARG1);
 947   assert_set (writes, SCM_ARG2);
 948   assert_set (excepts, SCM_ARG3);
 949 #undef assert_set
 950
 951   FD_ZERO (&read_set);
 952   FD_ZERO (&write_set);
 953   FD_ZERO (&except_set);
 954
 955   fill_select_type (&read_set, reads);
 956   fill_select_type (&write_set, writes);
 957   fill_select_type (&except_set, excepts);
 958
 959   if (SCM_UNBNDP (secs) || SCM_FALSEP (secs))
 960     time_p = 0;
 961   else
 962     {
 963       if (SCM_INUMP (secs))
 964         {
 965           timeout.tv_sec = SCM_INUM (secs);
 966           if (SCM_UNBNDP (usecs))
 967             timeout.tv_usec = 0;
 968           else
 969             {
 970               SCM_ASSERT (SCM_INUMP (usecs), usecs, SCM_ARG5, s_select);
 971
 972               timeout.tv_usec = SCM_INUM (usecs);
 973             }
 974         }
 975       else
 976         {
 977           double fl = scm_num2dbl (secs, s_select);
 978
 979           if (!SCM_UNBNDP (usecs))
 980             scm_wrong_type_arg (s_select, 4, secs);
 981           if (fl > LONG_MAX)
 982             scm_out_of_range (s_select, secs);
 983           timeout.tv_sec = (long) fl;
 984           timeout.tv_usec = (long) ((fl - timeout.tv_sec) * 1000000);
 985         }
 986       time_p = &timeout;
 987     }
 988
 989   SCM_DEFER_INTS;
 990   sreturn = select (SELECT_SET_SIZE,
 991                     &read_set, &write_set, &except_set, time_p);
 992   if (sreturn < 0)
 993     scm_syserror (s_select);
 994   SCM_ALLOW_INTS;
 995   return scm_listify (retrieve_select_type (&read_set, reads),
 996                       retrieve_select_type (&write_set, writes),
 997                       retrieve_select_type (&except_set, excepts),
 998                       SCM_UNDEFINED);
 999 #else
1000   scm_sysmissing (s_select);
1001   /* not reached.  */
1002   return SCM_BOOL_F;
1003 #endif
1004 }
1005
1006 /* Check if FILE has characters waiting to be read.  */
1007
1008 #ifdef __IBMC__
1009 # define MSDOS
1010 #endif
1011 #ifdef MSDOS
1012 # ifndef GO32
1013 #  include <io.h>
1014 #  include <conio.h>
1015
1016 int
1017 scm_input_waiting_p (f, caller)
1018      FILE *f;
1019      char *caller;
1020 {
1021   if (feof (f))
1022     return 1;
1023   if (fileno (f) == fileno (stdin) && (isatty (fileno (stdin))))
1024     return kbhit ();
1025   return -1;
1026 }
1027
1028 # endif
1029 #else
1030 # ifdef _DCC
1031 #  include <ioctl.h>
1032 # else
1033 #  ifndef AMIGA
1034 #   ifndef vms
1035 #    ifdef MWC
1036 #     include <sys/io.h>
1037 #    else
1038 #     ifndef THINK_C
1039 #      ifndef ARM_ULIB
1040 #       include <sys/ioctl.h>
1041 #      endif
1042 #     endif
1043 #    endif
1044 #   endif
1045 #  endif
1046 # endif
1047
1048 int
1049 scm_input_waiting_p (f, caller)
1050      FILE *f;
1051      char *caller;
1052 {
1053   /* Can we return an end-of-file character? */
1054   if (feof (f))
1055     return 1;
1056
1057   /* Do we have characters in the stdio buffer? */
1058 # ifdef FILE_CNT_FIELD
1059   if (f->FILE_CNT_FIELD > 0)
1060     return 1;
1061 # else
1062 #  ifdef FILE_CNT_GPTR
1063   if (f->_gptr != f->_egptr)
1064     return 1;
1065 # else
1066 #   ifdef FILE_CNT_READPTR
1067   if (f->_IO_read_end != f->_IO_read_ptr)
1068     return 1;
1069 #   else
1070   Configure.in could not guess the name of the correct field in a FILE *.
1071   This function needs to be ported to your system.
1072   It should return zero iff no characters are waiting to be read.;
1073 #   endif
1074 #  endif
1075 # endif
1076
1077   /* Is the file prepared to deliver input? */
1078 # ifdef HAVE_SELECT
1079   {
1080     struct timeval timeout;
1081     SELECT_TYPE read_set;
1082     SELECT_TYPE write_set;
1083     SELECT_TYPE except_set;
1084     int fno = fileno ((FILE *)f);
1085
1086     FD_ZERO (&read_set);
1087     FD_ZERO (&write_set);
1088     FD_ZERO (&except_set);
1089
1090     FD_SET (fno, &read_set);
1091
1092     timeout.tv_sec = 0;
1093     timeout.tv_usec = 0;
1094
1095     SCM_DEFER_INTS;
1096     if (select (SELECT_SET_SIZE,
1097                 &read_set, &write_set, &except_set, &timeout)
1098         < 0)
1099       scm_syserror (caller);
1100     SCM_ALLOW_INTS;
1101     return FD_ISSET (fno, &read_set);
1102   }
1103 # else
1104 # ifdef FIONREAD
1105   {
1106     long remir;
1107     ioctl(fileno(f), FIONREAD, &remir);
1108     return remir;
1109   }
1110 #  else
1111   scm_misc_error ("char-ready?", "Not fully implemented on this platform",
1112                   SCM_EOL);
1113 #  endif
1114 # endif
1115 }
1116 #endif
1117
1118 \f
1119
1120 SCM_PROC (s_fcntl, "fcntl", 2, 0, 1, scm_fcntl);
1121 SCM
1122 scm_fcntl (SCM object, SCM cmd, SCM value)
1123 {
1124   int rv;
1125   int fdes;
1126   int ivalue;
1127
1128   object = SCM_COERCE_OUTPORT (object);
1129
1130   SCM_ASSERT (SCM_INUMP (cmd), cmd, SCM_ARG2, s_fcntl);
1131   if (SCM_NIMP (object) && SCM_OPFPORTP (object))
1132     fdes = fileno ((FILE *) SCM_STREAM (object));
1133   else
1134     {
1135       SCM_ASSERT (SCM_INUMP (object), object, SCM_ARG1, s_fcntl);
1136       fdes = SCM_INUM (object);
1137     }
1138   if (SCM_NULLP (value))
1139     ivalue = 0;
1140   else
1141     {
1142       SCM_ASSERT (SCM_INUMP (SCM_CAR (value)), value, SCM_ARG3, s_fcntl);
1143       ivalue = SCM_INUM (SCM_CAR (value));
1144     }
1145   SCM_DEFER_INTS;
1146   if (fdes != -1)
1147     SCM_SYSCALL (rv = fcntl (fdes, SCM_INUM (cmd), ivalue));
1148   else
1149     rv = 0;                     /* avoid compiler warning.  */
1150   if (rv == -1 || fdes == -1)
1151     scm_syserror (s_fcntl);
1152   SCM_ALLOW_INTS;
1153   return SCM_MAKINUM (rv);
1154 }
1155
1156 SCM_PROC (s_fsync, "fsync", 1, 0, 0, scm_fsync);
1157 SCM
1158 scm_fsync (SCM object)
1159 {
1160   int fdes;
1161
1162   object = SCM_COERCE_OUTPORT (object);
1163
1164   SCM_DEFER_INTS;
1165   if (SCM_NIMP (object) && SCM_OPFPORTP (object))
1166     {
1167       scm_force_output (object);
1168       fdes = fileno ((FILE *) SCM_STREAM (object));
1169       if (fdes == -1)
1170         scm_syserror (s_fsync);
1171     }
1172   else
1173     {
1174       SCM_ASSERT (SCM_INUMP (object), object, SCM_ARG1, s_fsync);
1175       fdes = SCM_INUM (object);
1176     }
1177   if (fsync (fdes) == -1)
1178     scm_syserror (s_fsync);
1179   SCM_ALLOW_INTS;
1180   return SCM_UNSPECIFIED;
1181 }
1182
1183 SCM_PROC (s_symlink, "symlink", 2, 0, 0, scm_symlink);
1184
1185 SCM
1186 scm_symlink(oldpath, newpath)
1187      SCM oldpath;
1188      SCM newpath;
1189 {
1190 #ifdef HAVE_SYMLINK
1191   int val;
1192
1193   SCM_ASSERT (SCM_NIMP (oldpath) && SCM_ROSTRINGP (oldpath), oldpath, SCM_ARG1,
1194               s_symlink);
1195   SCM_ASSERT (SCM_NIMP (newpath) && SCM_ROSTRINGP (newpath), newpath, SCM_ARG2,
1196               s_symlink);
1197   SCM_COERCE_SUBSTR (oldpath);
1198   SCM_COERCE_SUBSTR (newpath);
1199   SCM_DEFER_INTS;
1200   SCM_SYSCALL (val = symlink(SCM_ROCHARS(oldpath), SCM_ROCHARS(newpath)));
1201   if (val != 0)
1202     scm_syserror (s_symlink);
1203   SCM_ALLOW_INTS;
1204   return SCM_UNSPECIFIED;
1205 #else
1206   scm_sysmissing (s_symlink);
1207   /* not reached.  */
1208   return SCM_BOOL_F;
1209 #endif
1210 }
1211
1212
1213 SCM_PROC (s_readlink, "readlink", 1, 0, 0, scm_readlink);
1214
1215 SCM
1216 scm_readlink(path)
1217   SCM path;
1218 {
1219 #ifdef HAVE_READLINK
1220   scm_sizet rv;
1221   scm_sizet size = 100;
1222   char *buf;
1223   SCM result;
1224   SCM_ASSERT (SCM_NIMP (path) && SCM_ROSTRINGP (path), path, (char *) SCM_ARG1,
1225               s_readlink);
1226   SCM_COERCE_SUBSTR (path);
1227   SCM_DEFER_INTS;
1228   buf = scm_must_malloc (size, s_readlink);
1229   while ((rv = readlink (SCM_ROCHARS (path), buf, (scm_sizet) size)) == size)
1230     {
1231       scm_must_free (buf);
1232       size *= 2;
1233       buf = scm_must_malloc (size, s_readlink);
1234     }
1235   if (rv == -1)
1236     scm_syserror (s_readlink);
1237   result = scm_makfromstr (buf, rv, 0);
1238   scm_must_free (buf);
1239   SCM_ALLOW_INTS;
1240   return result;
1241 #else
1242   scm_sysmissing (s_readlink);
1243   /* not reached.  */
1244   return SCM_BOOL_F;
1245 #endif
1246 }
1247
1248
1249 SCM_PROC (s_lstat, "lstat", 1, 0, 0, scm_lstat);
1250
1251 SCM
1252 scm_lstat(str)
1253   SCM str;
1254 {
1255 #ifdef HAVE_LSTAT
1256   int rv;
1257   struct stat stat_temp;
1258
1259   SCM_ASSERT (SCM_NIMP (str) && SCM_ROSTRINGP (str), str, (char *) SCM_ARG1,
1260               s_lstat);
1261   SCM_COERCE_SUBSTR (str);
1262   SCM_DEFER_INTS;
1263   SCM_SYSCALL(rv = lstat(SCM_ROCHARS(str), &stat_temp));
1264   if (rv != 0)
1265     {
1266       int en = errno;
1267
1268       scm_syserror_msg (s_lstat, "%s: %S",
1269                         scm_listify (scm_makfrom0str (strerror (errno)),
1270                                      str,
1271                                      SCM_UNDEFINED),
1272                         en);
1273     }
1274   SCM_ALLOW_INTS;
1275   return scm_stat2scm(&stat_temp);
1276 #else
1277   scm_sysmissing (s_lstat);
1278   /* not reached.  */
1279   return SCM_BOOL_F;
1280 #endif
1281 }
1282
1283
1284 SCM_PROC (s_copy_file, "copy-file", 2, 0, 0, scm_copy_file);
1285
1286 SCM
1287 scm_copy_file (oldfile, newfile)
1288      SCM oldfile;
1289      SCM newfile;
1290 {
1291   int oldfd, newfd;
1292   int n;
1293   char buf[BUFSIZ];             /* this space could be shared.  */
1294   struct stat oldstat;
1295
1296   SCM_ASSERT (SCM_NIMP (oldfile) && SCM_ROSTRINGP (oldfile), oldfile, SCM_ARG1, s_copy_file);
1297   if (SCM_SUBSTRP (oldfile))
1298     oldfile = scm_makfromstr (SCM_ROCHARS (oldfile), SCM_ROLENGTH (oldfile), 0);
1299   SCM_ASSERT (SCM_NIMP (newfile) && SCM_ROSTRINGP (newfile), newfile, SCM_ARG2, s_copy_file);
1300   if (SCM_SUBSTRP (newfile))
1301     newfile = scm_makfromstr (SCM_ROCHARS (newfile), SCM_ROLENGTH (newfile), 0);
1302   if (stat (SCM_ROCHARS (oldfile), &oldstat) == -1)
1303     scm_syserror (s_copy_file);
1304   SCM_DEFER_INTS;
1305   oldfd = open (SCM_ROCHARS (oldfile), O_RDONLY);
1306   if (oldfd == -1)
1307     scm_syserror (s_copy_file);
1308
1309   /* use POSIX flags instead of 07777?.  */
1310   newfd = open (SCM_ROCHARS (newfile), O_WRONLY | O_CREAT | O_TRUNC,
1311                 oldstat.st_mode & 07777);
1312   if (newfd == -1)
1313     scm_syserror (s_copy_file);
1314
1315   while ((n = read (oldfd, buf, sizeof buf)) > 0)
1316     if (write (newfd, buf, n) != n)
1317       {
1318         close (oldfd);
1319         close (newfd);
1320         scm_syserror (s_copy_file);
1321       }
1322   close (oldfd);
1323   if (close (newfd) == -1)
1324     scm_syserror (s_copy_file);
1325   SCM_ALLOW_INTS;
1326   return SCM_UNSPECIFIED;
1327 }
1328
1329 \f
1330
1331 void
1332 scm_init_filesys ()
1333 {
1334   scm_add_feature ("i/o-extensions");
1335
1336   scm_tc16_dir = scm_newsmob (&dir_smob);
1337
1338 #ifdef O_RDONLY
1339 scm_sysintern ("O_RDONLY", scm_long2num (O_RDONLY));
1340 #endif
1341 #ifdef O_WRONLY
1342 scm_sysintern ("O_WRONLY", scm_long2num (O_WRONLY));
1343 #endif
1344 #ifdef O_RDWR
1345 scm_sysintern ("O_RDWR", scm_long2num (O_RDWR));
1346 #endif
1347 #ifdef O_CREAT
1348 scm_sysintern ("O_CREAT", scm_long2num (O_CREAT));
1349 #endif
1350 #ifdef O_EXCL
1351 scm_sysintern ("O_EXCL", scm_long2num (O_EXCL));
1352 #endif
1353 #ifdef O_NOCTTY
1354 scm_sysintern ("O_NOCTTY", scm_long2num (O_NOCTTY));
1355 #endif
1356 #ifdef O_TRUNC
1357 scm_sysintern ("O_TRUNC", scm_long2num (O_TRUNC));
1358 #endif
1359 #ifdef O_APPEND
1360 scm_sysintern ("O_APPEND", scm_long2num (O_APPEND));
1361 #endif
1362 #ifdef O_NONBLOCK
1363 scm_sysintern ("O_NONBLOCK", scm_long2num (O_NONBLOCK));
1364 #endif
1365 #ifdef O_NDELAY
1366 scm_sysintern ("O_NDELAY", scm_long2num (O_NDELAY));
1367 #endif
1368 #ifdef O_SYNC
1369 scm_sysintern ("O_SYNC", scm_long2num (O_SYNC));
1370 #endif
1371
1372 #ifdef F_DUPFD
1373 scm_sysintern ("F_DUPFD", scm_long2num (F_DUPFD));
1374 #endif
1375 #ifdef F_GETFD
1376 scm_sysintern ("F_GETFD", scm_long2num (F_GETFD));
1377 #endif
1378 #ifdef F_SETFD
1379 scm_sysintern ("F_SETFD", scm_long2num (F_SETFD));
1380 #endif
1381 #ifdef F_GETFL
1382 scm_sysintern ("F_GETFL", scm_long2num (F_GETFL));
1383 #endif
1384 #ifdef F_SETFL
1385 scm_sysintern ("F_SETFL", scm_long2num (F_SETFL));
1386 #endif
1387 #ifdef F_GETOWN
1388 scm_sysintern ("F_GETOWN", scm_long2num (F_GETOWN));
1389 #endif
1390 #ifdef F_SETOWN
1391 scm_sysintern ("F_SETOWN", scm_long2num (F_SETOWN));
1392 #endif
1393 #ifdef FD_CLOEXEC
1394 scm_sysintern ("FD_CLOEXEC", scm_long2num (FD_CLOEXEC));
1395 #endif
1396
1397 #include "filesys.x"
1398 }