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