1 /* Copyright (C) 1996, 1997 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.
51 #ifdef TIME_WITH_SYS_TIME
52 # include <sys/time.h>
56 # include <sys/time.h>
66 #ifdef LIBC_H_WITH_UNISTD_H
70 #ifdef HAVE_SYS_SELECT_H
71 #include <sys/select.h>
78 #include <sys/types.h>
87 #define SELECT_TYPE fd_set
88 #define SELECT_SET_SIZE FD_SETSIZE
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)
100 #endif /* no FD_SET */
104 # define NAMLEN(dirent) strlen((dirent)->d_name)
106 # define dirent direct
107 # define NAMLEN(dirent) (dirent)->d_namlen
109 # include <sys/ndir.h>
112 # include <sys/dir.h>
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)
131 SCM_PROC (s_chown
, "chown", 3, 0, 0, scm_chown
);
134 scm_chown (path
, owner
, group
)
141 SCM_ASSERT (SCM_NIMP (path
) && SCM_ROSTRINGP (path
), path
, SCM_ARG1
, s_chown
);
142 SCM_ASSERT (SCM_INUMP (owner
), owner
, SCM_ARG2
, s_chown
);
143 SCM_ASSERT (SCM_INUMP (group
), group
, SCM_ARG3
, s_chown
);
145 SCM_COERCE_SUBSTR (path
);
146 SCM_SYSCALL (val
= chown (SCM_ROCHARS (path
),
147 SCM_INUM (owner
), SCM_INUM (group
)));
149 scm_syserror (s_chown
);
150 return SCM_UNSPECIFIED
;
154 SCM_PROC (s_chmod
, "chmod", 2, 0, 0, scm_chmod
);
157 scm_chmod (port_or_path
, mode
)
162 SCM_ASSERT (SCM_INUMP (mode
), mode
, SCM_ARG2
, s_chmod
);
163 SCM_ASSERT (SCM_NIMP (port_or_path
), port_or_path
, SCM_ARG1
, s_chmod
);
164 if (SCM_ROSTRINGP (port_or_path
))
166 SCM_COERCE_SUBSTR (port_or_path
);
167 SCM_SYSCALL (rv
= chmod (SCM_ROCHARS (port_or_path
), SCM_INUM (mode
)));
171 SCM_ASSERT (SCM_OPFPORTP (port_or_path
), port_or_path
, SCM_ARG1
, s_chmod
);
172 rv
= fileno ((FILE *)SCM_STREAM (port_or_path
));
174 SCM_SYSCALL (rv
= fchmod (rv
, SCM_INUM (mode
)));
177 scm_syserror (s_chmod
);
178 return SCM_UNSPECIFIED
;
181 SCM_PROC (s_umask
, "umask", 0, 1, 0, scm_umask
);
188 if (SCM_UNBNDP (mode
))
195 SCM_ASSERT (SCM_INUMP (mode
), mode
, SCM_ARG1
, s_umask
);
196 mask
= umask (SCM_INUM (mode
));
198 return SCM_MAKINUM (mask
);
203 SCM_PROC (s_open
, "open", 2, 1, 0, scm_open
);
206 scm_open (path
, flags
, mode
)
217 SCM_ASSERT (SCM_NIMP (path
) && SCM_ROSTRINGP (path
), path
, SCM_ARG1
, s_open
);
218 iflags
= scm_num2long (flags
, (char *) SCM_ARG2
, s_open
);
220 if (SCM_SUBSTRP (path
))
221 path
= scm_makfromstr (SCM_ROCHARS (path
), SCM_ROLENGTH (path
), 0);
224 if (SCM_UNBNDP (mode
))
225 SCM_SYSCALL (fd
= open (SCM_ROCHARS (path
), iflags
));
228 SCM_ASSERT (SCM_INUMP (mode
), mode
, SCM_ARG3
, s_open
);
229 SCM_SYSCALL (fd
= open (SCM_ROCHARS (path
), iflags
, SCM_INUM (mode
)));
232 scm_syserror (s_open
);
237 if (iflags
& O_WRONLY
)
242 f
= fdopen (fd
, port_mode
);
245 SCM_SYSCALL (close (fd
));
246 scm_syserror (s_open
);
249 struct scm_port_table
* pt
;
251 pt
= scm_add_to_port_table (newpt
);
252 SCM_SETPTAB_ENTRY (newpt
, pt
);
253 SCM_SETCAR (newpt
, scm_tc16_fport
| scm_mode_bits (port_mode
));
254 /* if (SCM_BUF0 & SCM_CAR (newpt))
255 scm_setbuf0 (newpt); */
256 SCM_SETSTREAM (newpt
, (SCM
)f
);
257 SCM_PTAB_ENTRY (newpt
)->file_name
= path
;
268 SCM_SYMBOL (scm_sym_regular
, "regular");
269 SCM_SYMBOL (scm_sym_directory
, "directory");
270 SCM_SYMBOL (scm_sym_symlink
, "symlink");
271 SCM_SYMBOL (scm_sym_block_special
, "block-special");
272 SCM_SYMBOL (scm_sym_char_special
, "char-special");
273 SCM_SYMBOL (scm_sym_fifo
, "fifo");
274 SCM_SYMBOL (scm_sym_sock
, "socket");
275 SCM_SYMBOL (scm_sym_unknown
, "unknown");
277 static SCM scm_stat2scm
SCM_P ((struct stat
*stat_temp
));
280 scm_stat2scm (stat_temp
)
281 struct stat
*stat_temp
;
283 SCM ans
= scm_make_vector (SCM_MAKINUM (15), SCM_UNSPECIFIED
, SCM_BOOL_F
);
284 SCM
*ve
= SCM_VELTS (ans
);
286 ve
[0] = scm_ulong2num ((unsigned long) stat_temp
->st_dev
);
287 ve
[1] = scm_ulong2num ((unsigned long) stat_temp
->st_ino
);
288 ve
[2] = scm_ulong2num ((unsigned long) stat_temp
->st_mode
);
289 ve
[3] = scm_ulong2num ((unsigned long) stat_temp
->st_nlink
);
290 ve
[4] = scm_ulong2num ((unsigned long) stat_temp
->st_uid
);
291 ve
[5] = scm_ulong2num ((unsigned long) stat_temp
->st_gid
);
293 ve
[6] = scm_ulong2num ((unsigned long) stat_temp
->st_rdev
);
297 ve
[7] = scm_ulong2num ((unsigned long) stat_temp
->st_size
);
298 ve
[8] = scm_ulong2num ((unsigned long) stat_temp
->st_atime
);
299 ve
[9] = scm_ulong2num ((unsigned long) stat_temp
->st_mtime
);
300 ve
[10] = scm_ulong2num ((unsigned long) stat_temp
->st_ctime
);
301 #ifdef HAVE_ST_BLKSIZE
302 ve
[11] = scm_ulong2num ((unsigned long) stat_temp
->st_blksize
);
304 ve
[11] = scm_ulong2num (4096L);
306 #ifdef HAVE_ST_BLOCKS
307 ve
[12] = scm_ulong2num ((unsigned long) stat_temp
->st_blocks
);
312 int mode
= stat_temp
->st_mode
;
315 ve
[13] = scm_sym_regular
;
316 else if (S_ISDIR (mode
))
317 ve
[13] = scm_sym_directory
;
318 else if (S_ISLNK (mode
))
319 ve
[13] = scm_sym_symlink
;
320 else if (S_ISBLK (mode
))
321 ve
[13] = scm_sym_block_special
;
322 else if (S_ISCHR (mode
))
323 ve
[13] = scm_sym_char_special
;
324 else if (S_ISFIFO (mode
))
325 ve
[13] = scm_sym_fifo
;
326 else if (S_ISSOCK (mode
))
327 ve
[13] = scm_sym_sock
;
329 ve
[13] = scm_sym_unknown
;
331 ve
[14] = SCM_MAKINUM ((~S_IFMT
) & mode
);
333 /* the layout of the bits in ve[14] is intended to be portable.
334 If there are systems that don't follow the usual convention,
335 the following could be used:
338 if (S_ISUID & mode) tmp += 1;
340 if (S_IRGRP & mode) tmp += 1;
342 if (S_ISVTX & mode) tmp += 1;
344 if (S_IRUSR & mode) tmp += 1;
346 if (S_IWUSR & mode) tmp += 1;
348 if (S_IXUSR & mode) tmp += 1;
350 if (S_IWGRP & mode) tmp += 1;
352 if (S_IXGRP & mode) tmp += 1;
354 if (S_IROTH & mode) tmp += 1;
356 if (S_IWOTH & mode) tmp += 1;
358 if (S_IXOTH & mode) tmp += 1;
360 ve[14] = SCM_MAKINUM (tmp);
368 SCM_PROC (s_stat
, "stat", 1, 0, 0, scm_stat
);
375 struct stat stat_temp
;
377 if (SCM_INUMP (file
))
378 SCM_SYSCALL (rv
= fstat (SCM_INUM (file
), &stat_temp
));
381 SCM_ASSERT (SCM_NIMP (file
), file
, SCM_ARG1
, s_stat
);
382 if (SCM_FPORTP (file
))
383 SCM_SYSCALL (rv
= fstat (fileno ((FILE *) SCM_STREAM (file
)),
387 SCM_ASSERT (SCM_ROSTRINGP (file
), file
, SCM_ARG1
, s_stat
);
388 if (SCM_SUBSTRP (file
))
389 file
= scm_makfromstr (SCM_ROCHARS (file
),
392 SCM_SYSCALL (rv
= stat (SCM_CHARS (file
), &stat_temp
));
399 scm_syserror_msg (s_stat
, "%s: %S",
400 scm_listify (scm_makfrom0str (strerror (errno
)),
405 return scm_stat2scm (&stat_temp
);
410 /* {Modifying Directories}
413 SCM_PROC (s_link
, "link", 2, 0, 0, scm_link
);
416 scm_link (oldpath
, newpath
)
422 SCM_ASSERT (SCM_NIMP (oldpath
) && SCM_ROSTRINGP (oldpath
), oldpath
, SCM_ARG1
, s_link
);
423 if (SCM_SUBSTRP (oldpath
))
424 oldpath
= scm_makfromstr (SCM_ROCHARS (oldpath
), SCM_ROLENGTH (oldpath
), 0);
425 SCM_ASSERT (SCM_NIMP (newpath
) && SCM_ROSTRINGP (newpath
), newpath
, SCM_ARG2
, s_link
);
426 if (SCM_SUBSTRP (newpath
))
427 newpath
= scm_makfromstr (SCM_ROCHARS (newpath
), SCM_ROLENGTH (newpath
), 0);
428 SCM_SYSCALL (val
= link (SCM_ROCHARS (oldpath
), SCM_ROCHARS (newpath
)));
430 scm_syserror (s_link
);
431 return SCM_UNSPECIFIED
;
436 SCM_PROC (s_rename
, "rename-file", 2, 0, 0, scm_rename
);
439 scm_rename (oldname
, newname
)
444 SCM_ASSERT (SCM_NIMP (oldname
) && SCM_ROSTRINGP (oldname
), oldname
, SCM_ARG1
,
446 SCM_ASSERT (SCM_NIMP (newname
) && SCM_ROSTRINGP (newname
), newname
, SCM_ARG2
,
448 SCM_COERCE_SUBSTR (oldname
);
449 SCM_COERCE_SUBSTR (newname
);
451 SCM_SYSCALL (rv
= rename (SCM_ROCHARS (oldname
), SCM_ROCHARS (newname
)));
453 scm_syserror (s_rename
);
454 return SCM_UNSPECIFIED
;
457 SCM_SYSCALL (rv
= link (SCM_ROCHARS (oldname
), SCM_ROCHARS (newname
)));
460 SCM_SYSCALL (rv
= unlink (SCM_ROCHARS (oldname
)));;
462 /* unlink failed. remove new name */
463 SCM_SYSCALL (unlink (SCM_ROCHARS (newname
)));
467 scm_syserror (s_rename
);
468 return SCM_UNSPECIFIED
;
473 SCM_PROC(s_delete_file
, "delete-file", 1, 0, 0, scm_delete_file
);
476 scm_delete_file (str
)
480 SCM_ASSERT (SCM_NIMP (str
) && SCM_ROSTRINGP (str
), str
, SCM_ARG1
, s_delete_file
);
481 SCM_COERCE_SUBSTR (str
);
482 SCM_SYSCALL (ans
= unlink (SCM_ROCHARS (str
)));
484 scm_syserror (s_delete_file
);
485 return SCM_UNSPECIFIED
;
489 SCM_PROC (s_mkdir
, "mkdir", 1, 1, 0, scm_mkdir
);
492 scm_mkdir (path
, mode
)
499 SCM_ASSERT (SCM_NIMP (path
) && SCM_ROSTRINGP (path
), path
, SCM_ARG1
,
501 SCM_COERCE_SUBSTR (path
);
502 if (SCM_UNBNDP (mode
))
506 SCM_SYSCALL (rv
= mkdir (SCM_ROCHARS (path
), 0777 ^ mask
));
510 SCM_ASSERT (SCM_INUMP (mode
), mode
, SCM_ARG2
, s_mkdir
);
511 SCM_SYSCALL (rv
= mkdir (SCM_ROCHARS (path
), SCM_INUM (mode
)));
514 scm_syserror (s_mkdir
);
515 return SCM_UNSPECIFIED
;
517 scm_sysmissing (s_mkdir
);
524 SCM_PROC (s_rmdir
, "rmdir", 1, 0, 0, scm_rmdir
);
533 SCM_ASSERT (SCM_NIMP (path
) && SCM_ROSTRINGP (path
), path
, SCM_ARG1
,
535 SCM_COERCE_SUBSTR (path
);
536 SCM_SYSCALL (val
= rmdir (SCM_ROCHARS (path
)));
538 scm_syserror (s_rmdir
);
539 return SCM_UNSPECIFIED
;
541 scm_sysmissing (s_rmdir
);
548 /* {Examining Directories}
553 SCM_PROC (s_opendir
, "opendir", 1, 0, 0, scm_opendir
);
556 scm_opendir (dirname
)
561 SCM_ASSERT (SCM_NIMP (dirname
) && SCM_ROSTRINGP (dirname
), dirname
, SCM_ARG1
,
563 SCM_COERCE_SUBSTR (dirname
);
566 SCM_SYSCALL (ds
= opendir (SCM_ROCHARS (dirname
)));
568 scm_syserror (s_opendir
);
569 SCM_SETCAR (dir
, scm_tc16_dir
| SCM_OPN
);
570 SCM_SETCDR (dir
, ds
);
576 SCM_PROC (s_readdir
, "readdir", 1, 0, 0, scm_readdir
);
582 struct dirent
*rdent
;
584 SCM_ASSERT (SCM_NIMP (port
) && SCM_OPDIRP (port
), port
, SCM_ARG1
, s_readdir
);
586 SCM_SYSCALL (rdent
= readdir ((DIR *) SCM_CDR (port
)));
589 scm_syserror (s_readdir
);
590 return (rdent
? scm_makfromstr (rdent
->d_name
, NAMLEN (rdent
), 0)
596 SCM_PROC (s_rewinddir
, "rewinddir", 1, 0, 0, scm_rewinddir
);
602 SCM_ASSERT (SCM_NIMP (port
) && SCM_OPDIRP (port
), port
, SCM_ARG1
, s_rewinddir
);
603 rewinddir ((DIR *) SCM_CDR (port
));
604 return SCM_UNSPECIFIED
;
609 SCM_PROC (s_closedir
, "closedir", 1, 0, 0, scm_closedir
);
617 SCM_ASSERT (SCM_NIMP (port
) && SCM_DIRP (port
), port
, SCM_ARG1
, s_closedir
);
619 if (SCM_CLOSEDP (port
))
622 return SCM_UNSPECIFIED
;
624 SCM_SYSCALL (sts
= closedir ((DIR *) SCM_CDR (port
)));
626 scm_syserror (s_closedir
);
627 SCM_SETCAR (port
, scm_tc16_dir
);
629 return SCM_UNSPECIFIED
;
635 static int scm_dir_print
SCM_P ((SCM sexp
, SCM port
, scm_print_state
*pstate
));
638 scm_dir_print (sexp
, port
, pstate
)
641 scm_print_state
*pstate
;
643 scm_prinport (sexp
, port
, "directory");
648 static scm_sizet scm_dir_free
SCM_P ((SCM p
));
655 closedir ((DIR *) SCM_CDR (p
));
659 static scm_smobfuns dir_smob
= {scm_mark0
, scm_dir_free
, scm_dir_print
, 0};
662 /* {Navigating Directories}
666 SCM_PROC (s_chdir
, "chdir", 1, 0, 0, scm_chdir
);
674 SCM_ASSERT (SCM_NIMP (str
) && SCM_ROSTRINGP (str
), str
, SCM_ARG1
, s_chdir
);
675 SCM_COERCE_SUBSTR (str
);
676 SCM_SYSCALL (ans
= chdir (SCM_ROCHARS (str
)));
678 scm_syserror (s_chdir
);
679 return SCM_UNSPECIFIED
;
684 SCM_PROC (s_getcwd
, "getcwd", 0, 0, 0, scm_getcwd
);
692 scm_sizet size
= 100;
697 wd
= scm_must_malloc (size
, s_getcwd
);
698 while ((rv
= getcwd (wd
, size
)) == 0 && errno
== ERANGE
)
702 wd
= scm_must_malloc (size
, s_getcwd
);
705 scm_syserror (s_getcwd
);
706 result
= scm_makfromstr (wd
, strlen (wd
), 0);
711 scm_sysmissing (s_getcwd
);
720 static void fill_select_type
SCM_P ((SELECT_TYPE
* set
, SCM list
));
723 fill_select_type (set
, list
)
727 while (list
!= SCM_EOL
)
729 if ( SCM_NIMP (SCM_CAR (list
))
730 && (scm_tc16_fport
== SCM_TYP16 (SCM_CAR (list
)))
731 && SCM_OPPORTP (SCM_CAR (list
)))
732 FD_SET (fileno ((FILE *)SCM_STREAM (SCM_CAR (list
))), set
);
733 else if (SCM_INUMP (SCM_CAR (list
)))
734 FD_SET (SCM_INUM (SCM_CAR (list
)), set
);
735 list
= SCM_CDR (list
);
740 static SCM retrieve_select_type
SCM_P ((SELECT_TYPE
* set
, SCM list
));
743 retrieve_select_type (set
, list
)
749 while (list
!= SCM_EOL
)
751 if ( SCM_NIMP (SCM_CAR (list
))
752 && (scm_tc16_fport
== SCM_TYP16 (SCM_CAR (list
)))
753 && SCM_OPPORTP (SCM_CAR (list
)))
755 if (FD_ISSET (fileno ((FILE *)SCM_STREAM (SCM_CAR (list
))), set
))
756 answer
= scm_cons (SCM_CAR (list
), answer
);
758 else if (SCM_INUMP (SCM_CAR (list
)))
760 if (FD_ISSET (SCM_INUM (SCM_CAR (list
)), set
))
761 answer
= scm_cons (SCM_CAR (list
), answer
);
763 list
= SCM_CDR (list
);
769 /* {Checking for events}
772 SCM_PROC (s_select
, "select", 3, 2, 0, scm_select
);
775 scm_select (reads
, writes
, excepts
, secs
, msecs
)
783 struct timeval timeout
;
784 struct timeval
* time_p
;
785 SELECT_TYPE read_set
;
786 SELECT_TYPE write_set
;
787 SELECT_TYPE except_set
;
790 SCM_ASSERT (-1 < scm_ilength (reads
), reads
, SCM_ARG1
, s_select
);
791 SCM_ASSERT (-1 < scm_ilength (writes
), reads
, SCM_ARG1
, s_select
);
792 SCM_ASSERT (-1 < scm_ilength (excepts
), reads
, SCM_ARG1
, s_select
);
795 FD_ZERO (&write_set
);
796 FD_ZERO (&except_set
);
798 fill_select_type (&read_set
, reads
);
799 fill_select_type (&write_set
, writes
);
800 fill_select_type (&except_set
, excepts
);
802 if (SCM_UNBNDP (secs
))
806 SCM_ASSERT (SCM_INUMP (secs
), secs
, SCM_ARG4
, s_select
);
807 if (SCM_UNBNDP (msecs
))
810 SCM_ASSERT (SCM_INUMP (msecs
), msecs
, SCM_ARG5
, s_select
);
812 timeout
.tv_sec
= SCM_INUM (secs
);
813 timeout
.tv_usec
= 1000 * SCM_INUM (msecs
);
818 sreturn
= select (SELECT_SET_SIZE
,
819 &read_set
, &write_set
, &except_set
, time_p
);
821 scm_syserror (s_select
);
823 return scm_listify (retrieve_select_type (&read_set
, reads
),
824 retrieve_select_type (&write_set
, writes
),
825 retrieve_select_type (&except_set
, excepts
),
828 scm_sysmissing (s_select
);
834 /* Check if FILE has characters waiting to be read. */
845 scm_input_waiting_p (f
, caller
)
851 if (fileno (f
) == fileno (stdin
) && (isatty (fileno (stdin
))))
868 # include <sys/ioctl.h>
877 scm_input_waiting_p (f
, caller
)
881 /* Can we return an end-of-file character? */
885 /* Do we have characters in the stdio buffer? */
886 # ifdef FILE_CNT_FIELD
887 if (f
->FILE_CNT_FIELD
> 0)
890 # ifdef FILE_CNT_GPTR
891 if (f
->_gptr
!= f
->_egptr
)
894 # ifdef FILE_CNT_READPTR
895 if (f
->_IO_read_end
!= f
->_IO_read_ptr
)
898 Configure
.in could
not guess the name of the correct field in a
FILE *.
899 This function needs to be ported to your system
.
900 It should
return zero iff no characters are waiting to be read
.;
905 /* Is the file prepared to deliver input? */
908 struct timeval timeout
;
909 SELECT_TYPE read_set
;
910 SELECT_TYPE write_set
;
911 SELECT_TYPE except_set
;
912 int fno
= fileno ((FILE *)f
);
915 FD_ZERO (&write_set
);
916 FD_ZERO (&except_set
);
918 FD_SET (fno
, &read_set
);
924 if (select (SELECT_SET_SIZE
,
925 &read_set
, &write_set
, &except_set
, &timeout
)
927 scm_syserror (caller
);
929 return FD_ISSET (fno
, &read_set
);
935 ioctl(fileno(f
), FIONREAD
, &remir
);
939 scm_misc_error ("char-ready?", "Not fully implemented on this platform",
948 SCM_PROC (s_fcntl
, "fcntl", 3, 0, 0, scm_fcntl
);
951 scm_fcntl (port
, cmd
, value
)
958 SCM_ASSERT (SCM_OPFPORTP (port
), port
, SCM_ARG1
, s_fcntl
);
959 SCM_ASSERT (SCM_INUMP (cmd
), cmd
, SCM_ARG2
, s_fcntl
);
960 SCM_ASSERT (SCM_INUMP (value
), value
, SCM_ARG3
, s_fcntl
);
962 rv
= fileno ((FILE *)SCM_STREAM (port
));
964 SCM_SYSCALL (rv
= fcntl (rv
, SCM_INUM (cmd
), SCM_INUM (value
)));
966 scm_syserror (s_fcntl
);
967 return SCM_MAKINUM (rv
);
973 SCM_PROC (s_symlink
, "symlink", 2, 0, 0, scm_symlink
);
976 scm_symlink(oldpath
, newpath
)
983 SCM_ASSERT (SCM_NIMP (oldpath
) && SCM_ROSTRINGP (oldpath
), oldpath
, SCM_ARG1
,
985 SCM_ASSERT (SCM_NIMP (newpath
) && SCM_ROSTRINGP (newpath
), newpath
, SCM_ARG2
,
987 SCM_COERCE_SUBSTR (oldpath
);
988 SCM_COERCE_SUBSTR (newpath
);
989 SCM_SYSCALL (val
= symlink(SCM_ROCHARS(oldpath
), SCM_ROCHARS(newpath
)));
991 scm_syserror (s_symlink
);
992 return SCM_UNSPECIFIED
;
994 scm_sysmissing (s_symlink
);
1001 SCM_PROC (s_readlink
, "readlink", 1, 0, 0, scm_readlink
);
1007 #ifdef HAVE_READLINK
1009 scm_sizet size
= 100;
1012 SCM_ASSERT (SCM_NIMP (path
) && SCM_ROSTRINGP (path
), path
, (char *) SCM_ARG1
,
1014 SCM_COERCE_SUBSTR (path
);
1016 buf
= scm_must_malloc (size
, s_readlink
);
1017 while ((rv
= readlink (SCM_ROCHARS (path
), buf
, (scm_sizet
) size
)) == size
)
1019 scm_must_free (buf
);
1021 buf
= scm_must_malloc (size
, s_readlink
);
1024 scm_syserror (s_readlink
);
1025 result
= scm_makfromstr (buf
, rv
, 0);
1026 scm_must_free (buf
);
1030 scm_sysmissing (s_readlink
);
1037 SCM_PROC (s_lstat
, "lstat", 1, 0, 0, scm_lstat
);
1045 struct stat stat_temp
;
1047 SCM_ASSERT (SCM_NIMP (str
) && SCM_ROSTRINGP (str
), str
, (char *) SCM_ARG1
,
1049 SCM_COERCE_SUBSTR (str
);
1050 SCM_SYSCALL(rv
= lstat(SCM_ROCHARS(str
), &stat_temp
));
1055 scm_syserror_msg (s_lstat
, "%s: %S",
1056 scm_listify (scm_makfrom0str (strerror (errno
)),
1061 return scm_stat2scm(&stat_temp
);
1063 scm_sysmissing (s_lstat
);
1070 SCM_PROC (s_copy_file
, "copy-file", 2, 0, 0, scm_copy_file
);
1073 scm_copy_file (oldfile
, newfile
)
1079 char buf
[BUFSIZ
]; /* this space could be shared. */
1080 struct stat oldstat
;
1082 SCM_ASSERT (SCM_NIMP (oldfile
) && SCM_ROSTRINGP (oldfile
), oldfile
, SCM_ARG1
, s_copy_file
);
1083 if (SCM_SUBSTRP (oldfile
))
1084 oldfile
= scm_makfromstr (SCM_ROCHARS (oldfile
), SCM_ROLENGTH (oldfile
), 0);
1085 SCM_ASSERT (SCM_NIMP (newfile
) && SCM_ROSTRINGP (newfile
), newfile
, SCM_ARG2
, s_copy_file
);
1086 if (SCM_SUBSTRP (newfile
))
1087 newfile
= scm_makfromstr (SCM_ROCHARS (newfile
), SCM_ROLENGTH (newfile
), 0);
1088 if (stat (SCM_ROCHARS (oldfile
), &oldstat
) == -1)
1089 scm_syserror (s_copy_file
);
1091 oldfd
= open (SCM_ROCHARS (oldfile
), O_RDONLY
);
1093 scm_syserror (s_copy_file
);
1095 /* use POSIX flags instead of 07777?. */
1096 newfd
= open (SCM_ROCHARS (newfile
), O_WRONLY
| O_CREAT
| O_TRUNC
,
1097 oldstat
.st_mode
& 07777);
1099 scm_syserror (s_copy_file
);
1101 while ((n
= read (oldfd
, buf
, sizeof buf
)) > 0)
1102 if (write (newfd
, buf
, n
) != n
)
1106 scm_syserror (s_copy_file
);
1109 if (close (newfd
) == -1)
1110 scm_syserror (s_copy_file
);
1112 return SCM_UNSPECIFIED
;
1120 scm_add_feature ("i/o-extensions");
1122 scm_tc16_dir
= scm_newsmob (&dir_smob
);
1125 scm_sysintern ("O_RDONLY", scm_long2num (O_RDONLY
));
1128 scm_sysintern ("O_WRONLY", scm_long2num (O_WRONLY
));
1131 scm_sysintern ("O_RDWR", scm_long2num (O_RDWR
));
1134 scm_sysintern ("O_CREAT", scm_long2num (O_CREAT
));
1137 scm_sysintern ("O_EXCL", scm_long2num (O_EXCL
));
1140 scm_sysintern ("O_NOCTTY", scm_long2num (O_NOCTTY
));
1143 scm_sysintern ("O_TRUNC", scm_long2num (O_TRUNC
));
1146 scm_sysintern ("O_APPEND", scm_long2num (O_APPEND
));
1149 scm_sysintern ("O_NONBLOCK", scm_long2num (O_NONBLOCK
));
1152 scm_sysintern ("O_NDELAY", scm_long2num (O_NDELAY
));
1155 scm_sysintern ("O_SYNC", scm_long2num (O_SYNC
));
1159 scm_sysintern ("F_DUPFD", scm_long2num (F_DUPFD
));
1162 scm_sysintern ("F_GETFD", scm_long2num (F_GETFD
));
1165 scm_sysintern ("F_SETFD", scm_long2num (F_SETFD
));
1168 scm_sysintern ("F_GETFL", scm_long2num (F_GETFL
));
1171 scm_sysintern ("F_SETFL", scm_long2num (F_SETFL
));
1174 scm_sysintern ("F_GETOWN", scm_long2num (F_GETOWN
));
1177 scm_sysintern ("F_SETOWN", scm_long2num (F_SETOWN
));
1180 scm_sysintern ("FD_CLOEXEC", scm_long2num (FD_CLOEXEC
));
1183 #include "filesys.x"