1 /* Copyright (C) 1996 Free Software Foundation, Inc.
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)
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.
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.
17 * As a special exception, the Free Software Foundation gives permission
18 * for additional uses of the text contained in its release of GUILE.
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.
26 * This exception does not however invalidate any other reasons why
27 * the executable file might be covered by the GNU General Public License.
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.
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.
49 #ifdef TIME_WITH_SYS_TIME
50 # include <sys/time.h>
54 # include <sys/time.h>
68 #ifdef HAVE_SYS_SELECT_H
69 #include <sys/select.h>
76 #include <sys/types.h>
85 #define SELECT_TYPE fd_set
86 #define SELECT_SET_SIZE FD_SETSIZE
90 /* Define the macros to access a single-int bitmap of descriptors. */
91 #define SELECT_SET_SIZE 32
92 #define SELECT_TYPE int
93 #define FD_SET(n, p) (*(p) |= (1 << (n)))
94 #define FD_CLR(n, p) (*(p) &= ~(1 << (n)))
95 #define FD_ISSET(n, p) (*(p) & (1 << (n)))
96 #define FD_ZERO(p) (*(p) = 0)
98 #endif /* no FD_SET */
102 # define NAMLEN(dirent) strlen((dirent)->d_name)
104 # define dirent direct
105 # define NAMLEN(dirent) (dirent)->d_namlen
107 # include <sys/ndir.h>
110 # include <sys/dir.h>
120 SCM_CONST_LONG (scm_O_CREAT
, "O_CREAT", O_CREAT
);
124 SCM_CONST_LONG (scm_O_EXCL
, "O_EXCL", O_EXCL
);
128 SCM_CONST_LONG (scm_O_NOCTTY
, "O_NOCTTY", O_NOCTTY
);
132 SCM_CONST_LONG (scm_O_TRUNC
, "O_TRUNC", O_TRUNC
);
136 SCM_CONST_LONG (scm_O_APPEND
, "O_APPEND", O_APPEND
);
140 SCM_CONST_LONG (scm_O_NONBLOCK
, "O_NONBLOCK", O_NONBLOCK
);
144 SCM_CONST_LONG (scm_O_NDELAY
, "O_NDELAY", O_NDELAY
);
148 SCM_CONST_LONG (scm_O_SYNC
, "O_SYNC", O_SYNC
);
158 SCM_PROC (s_sys_chown
, "chown", 3, 0, 0, scm_sys_chown
);
161 scm_sys_chown (path
, owner
, group
)
168 SCM_ASSERT (SCM_NIMP (path
) && SCM_ROSTRINGP (path
), path
, SCM_ARG1
, s_sys_chown
);
169 if (SCM_SUBSTRP (path
))
170 path
= scm_makfromstr (SCM_ROCHARS (path
), SCM_ROLENGTH (path
), 0);
171 SCM_ASSERT (SCM_INUMP (owner
), owner
, SCM_ARG2
, s_sys_chown
);
172 SCM_ASSERT (SCM_INUMP (group
), group
, SCM_ARG3
, s_sys_chown
);
173 SCM_SYSCALL (val
= chown (SCM_ROCHARS (path
),
174 SCM_INUM (owner
), SCM_INUM (group
)));
176 scm_syserror (s_sys_chown
);
177 return SCM_UNSPECIFIED
;
181 SCM_PROC (s_sys_chmod
, "chmod", 2, 0, 0, scm_sys_chmod
);
184 scm_sys_chmod (port_or_path
, mode
)
189 SCM_ASSERT (SCM_INUMP (mode
), mode
, SCM_ARG2
, s_sys_chmod
);
190 SCM_ASSERT (SCM_NIMP (port_or_path
), port_or_path
, SCM_ARG1
, s_sys_chmod
);
191 if (SCM_STRINGP (port_or_path
))
192 SCM_SYSCALL (rv
= chmod (SCM_CHARS (port_or_path
), SCM_INUM (mode
)));
195 SCM_ASSERT (SCM_OPFPORTP (port_or_path
), port_or_path
, SCM_ARG1
, s_sys_chmod
);
196 rv
= fileno ((FILE *)SCM_STREAM (port_or_path
));
198 SCM_SYSCALL (rv
= fchmod (rv
, SCM_INUM (mode
)));
201 scm_syserror (s_sys_chmod
);
202 return SCM_UNSPECIFIED
;
205 SCM_PROC (s_umask
, "umask", 0, 1, 0, scm_umask
);
212 if (SCM_UNBNDP (mode
))
219 SCM_ASSERT (SCM_INUMP (mode
), mode
, SCM_ARG1
, s_umask
);
220 mask
= umask (SCM_INUM (mode
));
222 return SCM_MAKINUM (mask
);
226 /* {File Descriptors}
231 static int scm_fd_print
SCM_P ((SCM sexp
, SCM port
, scm_print_state
*pstate
));
234 scm_fd_print (sexp
, port
, pstate
)
237 scm_print_state
*pstate
;
239 scm_gen_puts (scm_regular_string
, "#<fd ", port
);
240 scm_intprint (SCM_CDR (sexp
), 10, port
);
241 scm_gen_puts (scm_regular_string
, ">", port
);
246 static scm_sizet scm_fd_free
SCM_P ((SCM p
));
254 flags
= SCM_FD_FLAGS (p
);
255 if ((scm_close_fd_on_gc
& flags
) && (scm_fd_is_open
& flags
))
257 SCM_SYSCALL( close (SCM_FD (p
)) );
262 static scm_smobfuns fd_smob
= {scm_mark0
, scm_fd_free
, scm_fd_print
, 0};
266 scm_intern_fd (fd
, flags
)
273 SCM_SETCAR (it
, (scm_tc16_fd
| (flags
<< 16)));
274 SCM_SETCDR (it
, (SCM
)fd
);
281 SCM_PROC (s_sys_open
, "open", 3, 0, 0, scm_sys_open
);
284 scm_sys_open (path
, flags
, mode
)
292 SCM_ASSERT (SCM_NIMP (path
) && SCM_ROSTRINGP (path
), path
, SCM_ARG1
, s_sys_open
);
293 SCM_ASSERT (SCM_INUMP (flags
), flags
, SCM_ARG2
, s_sys_open
);
294 SCM_ASSERT (SCM_INUMP (mode
), mode
, SCM_ARG3
, s_sys_open
);
296 if (SCM_SUBSTRP (path
))
297 path
= scm_makfromstr (SCM_ROCHARS (path
), SCM_ROLENGTH (path
), 0);
300 SCM_SYSCALL ( fd
= open (SCM_ROCHARS (path
), SCM_INUM (flags
), SCM_INUM (mode
)) );
302 scm_syserror (s_sys_open
);
303 sfd
= scm_intern_fd (fd
, scm_fd_is_open
| scm_close_fd_on_gc
);
306 return scm_return_first (sfd
, path
);
310 SCM_PROC (s_sys_create
, "create", 2, 0, 0, scm_sys_create
);
313 scm_sys_create (path
, mode
)
320 SCM_ASSERT (SCM_NIMP (path
) && SCM_ROSTRINGP (path
), path
, SCM_ARG1
, s_sys_create
);
321 SCM_ASSERT (SCM_INUMP (mode
), mode
, SCM_ARG2
, s_sys_create
);
323 if (SCM_SUBSTRP (path
))
324 path
= scm_makfromstr (SCM_ROCHARS (path
), SCM_ROLENGTH (path
), 0);
327 SCM_SYSCALL ( fd
= creat (SCM_ROCHARS (path
), SCM_INUM (mode
)) );
329 scm_syserror (s_sys_create
);
330 sfd
= scm_intern_fd (fd
, scm_fd_is_open
| scm_close_fd_on_gc
);
333 return scm_return_first (sfd
, path
);
337 SCM_PROC (s_sys_close
, "close", 1, 0, 0, scm_sys_close
);
345 SCM_ASSERT (SCM_NIMP (sfd
) && SCM_FD_P (sfd
), sfd
, SCM_ARG1
, s_sys_close
);
350 SCM_SETCAR (sfd
, scm_tc16_fd
);
353 scm_syserror (s_sys_close
);
354 return SCM_UNSPECIFIED
;
358 SCM_PROC (s_sys_write_fd
, "write-fd", 2, 0, 0, scm_sys_write_fd
);
361 scm_sys_write_fd (sfd
, buf
)
368 SCM_ASSERT (SCM_NIMP (sfd
) && SCM_FD_P (sfd
), sfd
, SCM_ARG1
, s_sys_write_fd
);
369 SCM_ASSERT (SCM_NIMP (buf
) && SCM_ROSTRINGP (buf
), buf
, SCM_ARG2
, s_sys_write_fd
);
372 written
= write (fd
, SCM_ROCHARS (buf
), SCM_ROLENGTH (buf
));
374 scm_syserror (s_sys_write_fd
);
375 answer
= scm_long2num (written
);
377 return scm_return_first (answer
, buf
);
381 SCM_PROC (s_sys_read_fd
, "read-fd", 2, 2, 0, scm_sys_read_fd
);
384 scm_sys_read_fd (sfd
, buf
, offset
, length
)
397 SCM_ASSERT (SCM_NIMP (sfd
) && SCM_FD_P (sfd
), sfd
, SCM_ARG1
, s_sys_read_fd
);
400 SCM_ASSERT (SCM_NIMP (buf
) && SCM_STRINGP (buf
), buf
, SCM_ARG2
, s_sys_read_fd
);
401 bytes
= SCM_CHARS (buf
);
403 if (SCM_UNBNDP (offset
))
407 SCM_ASSERT (SCM_INUMP (offset
), offset
, SCM_ARG3
, s_sys_read_fd
);
408 off
= SCM_INUM (offset
);
411 if (SCM_UNBNDP (length
))
412 len
= SCM_LENGTH (buf
);
415 SCM_ASSERT (SCM_INUMP (length
), length
, SCM_ARG3
, s_sys_read_fd
);
416 len
= SCM_INUM (length
);
420 got
= read (fd
, bytes
+ off
, len
);
422 scm_syserror (s_sys_read_fd
);
423 answer
= scm_long2num (got
);
425 return scm_return_first (answer
, buf
);
428 SCM_PROC (s_sys_lseek
, "lseek", 2, 1, 0, scm_sys_lseek
);
431 scm_sys_lseek (sfd
, offset
, whence
)
442 SCM_ASSERT (SCM_NIMP (sfd
) && SCM_FD_P (sfd
), sfd
, SCM_ARG1
, s_sys_lseek
);
445 off
= scm_num2long (offset
, (char *)SCM_ARG2
, s_sys_lseek
);
446 if (SCM_UNBNDP (whence
))
450 SCM_ASSERT (SCM_INUMP (whence
), whence
, SCM_ARG3
, s_sys_lseek
);
451 wh
= SCM_INUM (whence
);
455 SCM_SYSCALL (got
= lseek (fd
, off
, wh
));
457 scm_syserror (s_sys_lseek
);
458 answer
= scm_long2num (got
);
464 SCM_PROC (s_sys_dup
, "dup", 1, 1, 0, scm_sys_dup
);
467 scm_sys_dup (oldfd
, newfd
)
476 SCM_ASSERT (SCM_NIMP (oldfd
) && SCM_FD_P (oldfd
), oldfd
, SCM_ARG1
, s_sys_dup
);
477 SCM_ASSERT (SCM_UNBNDP (newfd
) || SCM_INUMP (newfd
), newfd
, SCM_ARG2
, s_sys_dup
);
479 nfd
= (SCM_INUMP (newfd
) ? SCM_INUM (newfd
) : -1);
482 fn
= ((nfd
== -1) ? (int (*)())dup
: (int (*)())dup2
);
485 scm_syserror (s_sys_dup
);
486 answer
= SCM_MAKINUM (nfd
);
496 SCM_SYMBOL (scm_sym_regular
, "regular");
497 SCM_SYMBOL (scm_sym_directory
, "directory");
498 SCM_SYMBOL (scm_sym_symlink
, "symlink");
499 SCM_SYMBOL (scm_sym_block_special
, "block-special");
500 SCM_SYMBOL (scm_sym_char_special
, "char-special");
501 SCM_SYMBOL (scm_sym_fifo
, "fifo");
502 SCM_SYMBOL (scm_sym_sock
, "socket");
503 SCM_SYMBOL (scm_sym_unknown
, "unknown");
505 static SCM scm_stat2scm
SCM_P ((struct stat
*stat_temp
));
508 scm_stat2scm (stat_temp
)
509 struct stat
*stat_temp
;
511 SCM ans
= scm_make_vector (SCM_MAKINUM (15), SCM_UNSPECIFIED
, SCM_BOOL_F
);
512 SCM
*ve
= SCM_VELTS (ans
);
514 ve
[0] = scm_ulong2num ((unsigned long) stat_temp
->st_dev
);
515 ve
[1] = scm_ulong2num ((unsigned long) stat_temp
->st_ino
);
516 ve
[2] = scm_ulong2num ((unsigned long) stat_temp
->st_mode
);
517 ve
[3] = scm_ulong2num ((unsigned long) stat_temp
->st_nlink
);
518 ve
[4] = scm_ulong2num ((unsigned long) stat_temp
->st_uid
);
519 ve
[5] = scm_ulong2num ((unsigned long) stat_temp
->st_gid
);
521 ve
[6] = scm_ulong2num ((unsigned long) stat_temp
->st_rdev
);
525 ve
[7] = scm_ulong2num ((unsigned long) stat_temp
->st_size
);
526 ve
[8] = scm_ulong2num ((unsigned long) stat_temp
->st_atime
);
527 ve
[9] = scm_ulong2num ((unsigned long) stat_temp
->st_mtime
);
528 ve
[10] = scm_ulong2num ((unsigned long) stat_temp
->st_ctime
);
529 #ifdef HAVE_ST_BLKSIZE
530 ve
[11] = scm_ulong2num ((unsigned long) stat_temp
->st_blksize
);
532 ve
[11] = scm_ulong2num (4096L);
534 #ifdef HAVE_ST_BLOCKS
535 ve
[12] = scm_ulong2num ((unsigned long) stat_temp
->st_blocks
);
540 int mode
= stat_temp
->st_mode
;
543 ve
[13] = scm_sym_regular
;
544 else if (S_ISDIR (mode
))
545 ve
[13] = scm_sym_directory
;
546 else if (S_ISLNK (mode
))
547 ve
[13] = scm_sym_symlink
;
548 else if (S_ISBLK (mode
))
549 ve
[13] = scm_sym_block_special
;
550 else if (S_ISCHR (mode
))
551 ve
[13] = scm_sym_char_special
;
552 else if (S_ISFIFO (mode
))
553 ve
[13] = scm_sym_fifo
;
554 else if (S_ISSOCK (mode
))
555 ve
[13] = scm_sym_sock
;
557 ve
[13] = scm_sym_unknown
;
559 ve
[14] = SCM_MAKINUM ((~S_IFMT
) & mode
);
561 /* the layout of the bits in ve[14] is intended to be portable.
562 If there are systems that don't follow the usual convention,
563 the following could be used:
566 if (S_ISUID & mode) tmp += 1;
568 if (S_IRGRP & mode) tmp += 1;
570 if (S_ISVTX & mode) tmp += 1;
572 if (S_IRUSR & mode) tmp += 1;
574 if (S_IWUSR & mode) tmp += 1;
576 if (S_IXUSR & mode) tmp += 1;
578 if (S_IWGRP & mode) tmp += 1;
580 if (S_IXGRP & mode) tmp += 1;
582 if (S_IROTH & mode) tmp += 1;
584 if (S_IWOTH & mode) tmp += 1;
586 if (S_IXOTH & mode) tmp += 1;
588 ve[14] = SCM_MAKINUM (tmp);
596 SCM_PROC (s_sys_stat
, "stat", 1, 0, 0, scm_sys_stat
);
599 scm_sys_stat (fd_or_path
)
603 struct stat stat_temp
;
605 if (SCM_INUMP (fd_or_path
))
607 rv
= SCM_INUM (fd_or_path
);
608 SCM_SYSCALL (rv
= fstat (rv
, &stat_temp
));
610 else if (SCM_NIMP (fd_or_path
) && SCM_FD_P (fd_or_path
))
612 rv
= SCM_FD (fd_or_path
);
613 SCM_SYSCALL (rv
= fstat (rv
, &stat_temp
));
617 SCM_ASSERT (SCM_NIMP (fd_or_path
), fd_or_path
, SCM_ARG1
, s_sys_stat
);
618 SCM_ASSERT (SCM_ROSTRINGP (fd_or_path
), fd_or_path
, SCM_ARG1
, s_sys_stat
);
619 if (SCM_ROSTRINGP (fd_or_path
))
621 if (SCM_SUBSTRP (fd_or_path
))
622 fd_or_path
= scm_makfromstr (SCM_ROCHARS (fd_or_path
), SCM_ROLENGTH (fd_or_path
), 0);
623 SCM_SYSCALL (rv
= stat (SCM_CHARS (fd_or_path
), &stat_temp
));
628 scm_syserror_msg (s_sys_stat
, "%s: %S",
629 scm_listify (scm_makfrom0str (strerror (errno
)),
632 return scm_stat2scm (&stat_temp
);
637 /* {Modifying Directories}
640 SCM_PROC (s_sys_link
, "link", 2, 0, 0, scm_sys_link
);
643 scm_sys_link (oldpath
, newpath
)
649 SCM_ASSERT (SCM_NIMP (oldpath
) && SCM_ROSTRINGP (oldpath
), oldpath
, SCM_ARG1
, s_sys_link
);
650 if (SCM_SUBSTRP (oldpath
))
651 oldpath
= scm_makfromstr (SCM_ROCHARS (oldpath
), SCM_ROLENGTH (oldpath
), 0);
652 SCM_ASSERT (SCM_NIMP (newpath
) && SCM_ROSTRINGP (newpath
), newpath
, SCM_ARG2
, s_sys_link
);
653 if (SCM_SUBSTRP (newpath
))
654 newpath
= scm_makfromstr (SCM_ROCHARS (newpath
), SCM_ROLENGTH (newpath
), 0);
655 SCM_SYSCALL (val
= link (SCM_ROCHARS (oldpath
), SCM_ROCHARS (newpath
)));
657 scm_syserror (s_sys_link
);
658 return SCM_UNSPECIFIED
;
663 SCM_PROC (s_sys_rename
, "rename-file", 2, 0, 0, scm_sys_rename
);
666 scm_sys_rename (oldname
, newname
)
671 SCM_ASSERT (SCM_NIMP (oldname
) && SCM_STRINGP (oldname
), oldname
, SCM_ARG1
, s_sys_rename
);
672 SCM_ASSERT (SCM_NIMP (newname
) && SCM_STRINGP (newname
), newname
, SCM_ARG2
, s_sys_rename
);
674 SCM_SYSCALL (rv
= rename (SCM_CHARS (oldname
), SCM_CHARS (newname
)));
676 scm_syserror (s_sys_rename
);
677 return SCM_UNSPECIFIED
;
680 SCM_SYSCALL (rv
= link (SCM_CHARS (oldname
), SCM_CHARS (newname
)));
683 SCM_SYSCALL (rv
= unlink (SCM_CHARS (oldname
)));;
685 /* unlink failed. remove new name */
686 SCM_SYSCALL (unlink (SCM_CHARS (newname
)));
690 scm_syserror (s_sys_rename
);
691 return SCM_UNSPECIFIED
;
696 SCM_PROC(s_sys_delete_file
, "delete-file", 1, 0, 0, scm_sys_delete_file
);
699 scm_sys_delete_file (str
)
703 SCM_ASSERT (SCM_NIMP (str
) && SCM_STRINGP (str
), str
, SCM_ARG1
, s_sys_delete_file
);
704 SCM_SYSCALL (ans
= unlink (SCM_CHARS (str
)));
706 scm_syserror (s_sys_delete_file
);
707 return SCM_UNSPECIFIED
;
711 SCM_PROC (s_sys_mkdir
, "mkdir", 1, 1, 0, scm_sys_mkdir
);
714 scm_sys_mkdir (path
, mode
)
721 SCM_ASSERT (SCM_NIMP (path
) && SCM_STRINGP (path
), path
, SCM_ARG1
, s_sys_mkdir
);
722 if (SCM_UNBNDP (mode
))
726 SCM_SYSCALL (rv
= mkdir (SCM_CHARS (path
), 0777 ^ mask
));
730 SCM_ASSERT (SCM_INUMP (mode
), mode
, SCM_ARG2
, s_sys_mkdir
);
731 SCM_SYSCALL (rv
= mkdir (SCM_CHARS (path
), SCM_INUM (mode
)));
734 scm_syserror (s_sys_mkdir
);
735 return SCM_UNSPECIFIED
;
737 scm_sysmissing (s_sys_mkdir
);
744 SCM_PROC (s_sys_rmdir
, "rmdir", 1, 0, 0, scm_sys_rmdir
);
753 SCM_ASSERT (SCM_NIMP (path
) && SCM_STRINGP (path
), path
, SCM_ARG1
, s_sys_rmdir
);
754 SCM_SYSCALL (val
= rmdir (SCM_CHARS (path
)));
756 scm_syserror (s_sys_rmdir
);
757 return SCM_UNSPECIFIED
;
759 scm_sysmissing (s_sys_rmdir
);
766 /* {Examining Directories}
771 SCM_PROC (s_sys_opendir
, "opendir", 1, 0, 0, scm_sys_opendir
);
774 scm_sys_opendir (dirname
)
779 SCM_ASSERT (SCM_NIMP (dirname
) && SCM_STRINGP (dirname
), dirname
, SCM_ARG1
, s_sys_opendir
);
782 SCM_SYSCALL (ds
= opendir (SCM_CHARS (dirname
)));
784 scm_syserror (s_sys_opendir
);
785 SCM_SETCAR (dir
, scm_tc16_dir
| SCM_OPN
);
786 SCM_SETCDR (dir
, ds
);
792 SCM_PROC (s_sys_readdir
, "readdir", 1, 0, 0, scm_sys_readdir
);
795 scm_sys_readdir (port
)
798 struct dirent
*rdent
;
800 SCM_ASSERT (SCM_NIMP (port
) && SCM_OPDIRP (port
), port
, SCM_ARG1
, s_sys_readdir
);
802 SCM_SYSCALL (rdent
= readdir ((DIR *) SCM_CDR (port
)));
805 scm_syserror (s_sys_readdir
);
806 return (rdent
? scm_makfromstr (rdent
->d_name
, NAMLEN (rdent
), 0)
812 SCM_PROC (s_rewinddir
, "rewinddir", 1, 0, 0, scm_rewinddir
);
818 SCM_ASSERT (SCM_NIMP (port
) && SCM_OPDIRP (port
), port
, SCM_ARG1
, s_rewinddir
);
819 rewinddir ((DIR *) SCM_CDR (port
));
820 return SCM_UNSPECIFIED
;
825 SCM_PROC (s_sys_closedir
, "closedir", 1, 0, 0, scm_sys_closedir
);
828 scm_sys_closedir (port
)
833 SCM_ASSERT (SCM_NIMP (port
) && SCM_DIRP (port
), port
, SCM_ARG1
, s_sys_closedir
);
835 if (SCM_CLOSEDP (port
))
838 return SCM_UNSPECIFIED
;
840 SCM_SYSCALL (sts
= closedir ((DIR *) SCM_CDR (port
)));
842 scm_syserror (s_sys_closedir
);
843 SCM_SETCAR (port
, scm_tc16_dir
);
845 return SCM_UNSPECIFIED
;
851 static int scm_dir_print
SCM_P ((SCM sexp
, SCM port
, scm_print_state
*pstate
));
854 scm_dir_print (sexp
, port
, pstate
)
857 scm_print_state
*pstate
;
859 scm_prinport (sexp
, port
, "directory");
864 static scm_sizet scm_dir_free
SCM_P ((SCM p
));
871 closedir ((DIR *) SCM_CDR (p
));
875 static scm_smobfuns dir_smob
= {scm_mark0
, scm_dir_free
, scm_dir_print
, 0};
878 /* {Navigating Directories}
882 SCM_PROC (s_sys_chdir
, "chdir", 1, 0, 0, scm_sys_chdir
);
890 SCM_ASSERT (SCM_NIMP (str
) && SCM_STRINGP (str
), str
, SCM_ARG1
, s_sys_chdir
);
891 SCM_SYSCALL (ans
= chdir (SCM_CHARS (str
)));
893 scm_syserror (s_sys_chdir
);
894 return SCM_UNSPECIFIED
;
899 SCM_PROC (s_sys_getcwd
, "getcwd", 0, 0, 0, scm_sys_getcwd
);
907 scm_sizet size
= 100;
912 wd
= scm_must_malloc (size
, s_sys_getcwd
);
913 while ((rv
= getcwd (wd
, size
)) == 0 && errno
== ERANGE
)
917 wd
= scm_must_malloc (size
, s_sys_getcwd
);
920 scm_syserror (s_sys_getcwd
);
921 result
= scm_makfromstr (wd
, strlen (wd
), 0);
926 scm_sysmissing (s_sys_getcwd
);
935 static void fill_select_type
SCM_P ((SELECT_TYPE
* set
, SCM list
));
938 fill_select_type (set
, list
)
942 while (list
!= SCM_EOL
)
944 if ( SCM_NIMP (SCM_CAR (list
))
945 && (scm_tc16_fport
== SCM_TYP16 (SCM_CAR (list
)))
946 && SCM_OPPORTP (SCM_CAR (list
)))
947 FD_SET (fileno ((FILE *)SCM_STREAM (SCM_CAR (list
))), set
);
948 else if (SCM_INUMP (SCM_CAR (list
)))
949 FD_SET (SCM_INUM (SCM_CAR (list
)), set
);
950 else if (SCM_NIMP (SCM_CAR (list
)) && SCM_FD_P (SCM_CAR (list
)))
951 FD_SET (SCM_FD (SCM_CAR (list
)), set
);
952 list
= SCM_CDR (list
);
957 static SCM retrieve_select_type
SCM_P ((SELECT_TYPE
* set
, SCM list
));
960 retrieve_select_type (set
, list
)
966 while (list
!= SCM_EOL
)
968 if ( SCM_NIMP (SCM_CAR (list
))
969 && (scm_tc16_fport
== SCM_TYP16 (SCM_CAR (list
)))
970 && SCM_OPPORTP (SCM_CAR (list
)))
972 if (FD_ISSET (fileno ((FILE *)SCM_STREAM (SCM_CAR (list
))), set
))
973 answer
= scm_cons (SCM_CAR (list
), answer
);
975 else if (SCM_INUMP (SCM_CAR (list
)))
977 if (FD_ISSET (SCM_INUM (SCM_CAR (list
)), set
))
978 answer
= scm_cons (SCM_CAR (list
), answer
);
980 else if (SCM_NIMP (SCM_CAR (list
)) && SCM_FD_P (SCM_CAR (list
)))
982 if (FD_ISSET (SCM_FD (SCM_CAR (list
)), set
))
983 answer
= scm_cons (SCM_CAR (list
), answer
);
985 list
= SCM_CDR (list
);
991 SCM_PROC (s_sys_select
, "select", 3, 2, 0, scm_sys_select
);
994 scm_sys_select (reads
, writes
, excepts
, secs
, msecs
)
1002 struct timeval timeout
;
1003 struct timeval
* time_p
;
1004 SELECT_TYPE read_set
;
1005 SELECT_TYPE write_set
;
1006 SELECT_TYPE except_set
;
1009 SCM_ASSERT (-1 < scm_ilength (reads
), reads
, SCM_ARG1
, s_sys_select
);
1010 SCM_ASSERT (-1 < scm_ilength (writes
), reads
, SCM_ARG1
, s_sys_select
);
1011 SCM_ASSERT (-1 < scm_ilength (excepts
), reads
, SCM_ARG1
, s_sys_select
);
1013 FD_ZERO (&read_set
);
1014 FD_ZERO (&write_set
);
1015 FD_ZERO (&except_set
);
1017 fill_select_type (&read_set
, reads
);
1018 fill_select_type (&write_set
, writes
);
1019 fill_select_type (&except_set
, excepts
);
1021 if (SCM_UNBNDP (secs
))
1025 SCM_ASSERT (SCM_INUMP (secs
), secs
, SCM_ARG4
, s_sys_select
);
1026 if (SCM_UNBNDP (msecs
))
1029 SCM_ASSERT (SCM_INUMP (msecs
), msecs
, SCM_ARG5
, s_sys_select
);
1031 timeout
.tv_sec
= SCM_INUM (secs
);
1032 timeout
.tv_usec
= 1000 * SCM_INUM (msecs
);
1037 sreturn
= select (SELECT_SET_SIZE
,
1038 &read_set
, &write_set
, &except_set
, time_p
);
1040 scm_syserror (s_sys_select
);
1042 return scm_listify (retrieve_select_type (&read_set
, reads
),
1043 retrieve_select_type (&write_set
, writes
),
1044 retrieve_select_type (&except_set
, excepts
),
1047 scm_sysmissing (s_sys_select
);
1057 SCM_PROC (s_sys_symlink
, "symlink", 2, 0, 0, scm_sys_symlink
);
1060 scm_sys_symlink(oldpath
, newpath
)
1067 SCM_ASSERT(SCM_NIMP(oldpath
) && SCM_STRINGP(oldpath
), oldpath
, SCM_ARG1
, s_sys_symlink
);
1068 SCM_ASSERT(SCM_NIMP(newpath
) && SCM_STRINGP(newpath
), newpath
, SCM_ARG2
, s_sys_symlink
);
1069 SCM_SYSCALL (val
= symlink(SCM_CHARS(oldpath
), SCM_CHARS(newpath
)));
1071 scm_syserror (s_sys_symlink
);
1072 return SCM_UNSPECIFIED
;
1074 scm_sysmissing (s_sys_symlink
);
1081 SCM_PROC (s_sys_readlink
, "readlink", 1, 0, 0, scm_sys_readlink
);
1084 scm_sys_readlink(path
)
1087 #ifdef HAVE_READLINK
1089 scm_sizet size
= 100;
1092 SCM_ASSERT (SCM_NIMP (path
) && SCM_STRINGP (path
), path
, (char *) SCM_ARG1
, s_sys_readlink
);
1094 buf
= scm_must_malloc (size
, s_sys_readlink
);
1095 while ((rv
= readlink (SCM_CHARS (path
), buf
, (scm_sizet
) size
)) == size
)
1097 scm_must_free (buf
);
1099 buf
= scm_must_malloc (size
, s_sys_readlink
);
1102 scm_syserror (s_sys_readlink
);
1103 result
= scm_makfromstr (buf
, rv
, 0);
1104 scm_must_free (buf
);
1108 scm_sysmissing (s_sys_readlink
);
1115 SCM_PROC (s_sys_lstat
, "lstat", 1, 0, 0, scm_sys_lstat
);
1123 struct stat stat_temp
;
1125 SCM_ASSERT(SCM_NIMP(str
) && SCM_STRINGP(str
), str
, (char *)SCM_ARG1
, s_sys_lstat
);
1126 SCM_SYSCALL(rv
= lstat(SCM_CHARS(str
), &stat_temp
));
1128 scm_syserror_msg (s_sys_lstat
, "%s: %S",
1129 scm_listify (scm_makfrom0str (strerror (errno
)),
1132 return scm_stat2scm(&stat_temp
);
1134 scm_sysmissing (s_sys_lstat
);
1141 SCM_PROC (s_sys_copy_file
, "copy-file", 2, 0, 0, scm_sys_copy_file
);
1144 scm_sys_copy_file (oldfile
, newfile
)
1150 char buf
[BUFSIZ
]; /* this space could be shared. */
1151 struct stat oldstat
;
1153 SCM_ASSERT (SCM_NIMP (oldfile
) && SCM_ROSTRINGP (oldfile
), oldfile
, SCM_ARG1
, s_sys_copy_file
);
1154 if (SCM_SUBSTRP (oldfile
))
1155 oldfile
= scm_makfromstr (SCM_ROCHARS (oldfile
), SCM_ROLENGTH (oldfile
), 0);
1156 SCM_ASSERT (SCM_NIMP (newfile
) && SCM_ROSTRINGP (newfile
), newfile
, SCM_ARG2
, s_sys_copy_file
);
1157 if (SCM_SUBSTRP (newfile
))
1158 newfile
= scm_makfromstr (SCM_ROCHARS (newfile
), SCM_ROLENGTH (newfile
), 0);
1159 if (stat (SCM_ROCHARS (oldfile
), &oldstat
) == -1)
1160 scm_syserror (s_sys_copy_file
);
1162 oldfd
= open (SCM_ROCHARS (oldfile
), O_RDONLY
);
1164 scm_syserror (s_sys_copy_file
);
1166 /* use POSIX flags instead of 07777?. */
1167 newfd
= open (SCM_ROCHARS (newfile
), O_WRONLY
| O_CREAT
| O_TRUNC
,
1168 oldstat
.st_mode
& 07777);
1170 scm_syserror (s_sys_copy_file
);
1172 while ((n
= read (oldfd
, buf
, sizeof buf
)) > 0)
1173 if (write (newfd
, buf
, n
) != n
)
1177 scm_syserror (s_sys_copy_file
);
1180 if (close (newfd
) == -1)
1181 scm_syserror (s_sys_copy_file
);
1183 return SCM_UNSPECIFIED
;
1191 scm_add_feature ("i/o-extensions");
1193 scm_tc16_fd
= scm_newsmob (&fd_smob
);
1194 scm_tc16_dir
= scm_newsmob (&dir_smob
);
1196 #include "filesys.x"