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