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