1 /* Copyright (C) 1995 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 SCM_PROC (s_sys_ftell
, "%ftell", 1, 0, 0, scm_sys_ftell
);
54 scm_sys_ftell (SCM port
)
62 SCM_ASSERT (SCM_NIMP (port
) && SCM_OPFPORTP (port
), port
, SCM_ARG1
, s_sys_ftell
);
63 SCM_SYSCALL (pos
= ftell ((FILE *)SCM_STREAM (port
)));
66 if (pos
> 0 && SCM_CRDYP (port
))
68 return SCM_MAKINUM (pos
);
73 SCM_PROC (s_sys_fseek
, "%fseek", 3, 0, 0, scm_sys_fseek
);
76 scm_sys_fseek (SCM port
, SCM offset
, SCM whence
)
79 scm_sys_fseek (port
, offset
, whence
)
86 SCM_ASSERT (SCM_NIMP (port
) && SCM_OPFPORTP (port
), port
, SCM_ARG1
, s_sys_fseek
);
87 SCM_ASSERT (SCM_INUMP (offset
), offset
, SCM_ARG2
, s_sys_fseek
);
88 SCM_ASSERT (SCM_INUMP (whence
) && (SCM_INUM (whence
) < 3) && (SCM_INUM (whence
) >= 0),
89 whence
, SCM_ARG3
, s_sys_fseek
);
90 SCM_CLRDY (port
); /* Clear ungetted char */
91 /* Values of whence are interned in scm_init_ioext. */
92 rv
= fseek ((FILE *)SCM_STREAM (port
), SCM_INUM (offset
), SCM_INUM (whence
));
93 return rv
? SCM_MAKINUM (errno
) : SCM_BOOL_T
;
98 SCM_PROC (s_sys_freopen
, "%freopen", 3, 0, 0, scm_sys_freopen
);
101 scm_sys_freopen (SCM filename
, SCM modes
, SCM port
)
104 scm_sys_freopen (filename
, modes
, port
)
111 SCM_ASSERT (SCM_NIMP (filename
) && SCM_STRINGP (filename
), filename
, SCM_ARG1
, s_sys_freopen
);
112 SCM_ASSERT (SCM_NIMP (modes
) && SCM_STRINGP (modes
), modes
, SCM_ARG2
, s_sys_freopen
);
114 SCM_ASSERT (SCM_NIMP (port
) && SCM_FPORTP (port
), port
, SCM_ARG3
, s_sys_freopen
);
115 SCM_SYSCALL (f
= freopen (SCM_CHARS (filename
), SCM_CHARS (modes
), (FILE *)SCM_STREAM (port
)));
120 port
= SCM_MAKINUM (errno
);
121 SCM_CAR (p
) &= ~SCM_OPN
;
122 scm_remove_from_port_table (p
);
126 SCM_CAR (port
) = scm_tc16_fport
| scm_mode_bits (SCM_CHARS (modes
));
127 SCM_SETSTREAM (port
, (SCM
)f
);
128 if (SCM_BUF0
& (SCM_CAR (port
) = scm_tc16_fport
| scm_mode_bits (SCM_CHARS (modes
))))
137 SCM_PROC (s_sys_duplicate_port
, "%duplicate-port", 2, 0, 0, scm_sys_duplicate_port
);
140 scm_sys_duplicate_port (SCM oldpt
, SCM modes
)
143 scm_sys_duplicate_port (oldpt
, modes
)
152 SCM_ASSERT (SCM_NIMP (oldpt
) && SCM_OPPORTP (oldpt
), oldpt
, SCM_ARG1
, s_sys_duplicate_port
);
153 SCM_ASSERT (SCM_NIMP (modes
) && SCM_STRINGP (modes
), modes
, SCM_ARG2
, s_sys_duplicate_port
);
156 oldfd
= fileno ((FILE *)SCM_STREAM (oldpt
));
162 SCM_SYSCALL (newfd
= dup (oldfd
));
168 f
= fdopen (newfd
, SCM_CHARS (modes
));
171 SCM_SYSCALL (close (newfd
));
176 struct scm_port_table
* pt
;
177 pt
= scm_add_to_port_table (newpt
);
178 SCM_SETPTAB_ENTRY (newpt
, pt
);
179 if (SCM_BUF0
& (SCM_CAR (newpt
) = scm_tc16_fport
| scm_mode_bits (SCM_CHARS (modes
))))
181 SCM_SETSTREAM (newpt
, (SCM
)f
);
182 SCM_PTAB_ENTRY (newpt
)->file_name
= SCM_PTAB_ENTRY (oldpt
)->file_name
;
190 SCM_PROC (s_sys_redirect_port
, "%redirect-port", 2, 0, 0, scm_sys_redirect_port
);
193 scm_sys_redirect_port (SCM into_pt
, SCM from_pt
)
196 scm_sys_redirect_port (into_pt
, from_pt
)
201 int ans
, oldfd
, newfd
;
203 SCM_ASSERT (SCM_NIMP (into_pt
) && SCM_OPPORTP (into_pt
), into_pt
, SCM_ARG1
, s_sys_redirect_port
);
204 SCM_ASSERT (SCM_NIMP (from_pt
) && SCM_OPPORTP (from_pt
), from_pt
, SCM_ARG2
, s_sys_redirect_port
);
205 oldfd
= fileno ((FILE *)SCM_STREAM (into_pt
));
206 newfd
= fileno ((FILE *)SCM_STREAM (from_pt
));
207 if (oldfd
== -1 || newfd
== -1)
210 SCM_SYSCALL (ans
= dup2 (oldfd
, newfd
));
212 return (ans
== -1) ? SCM_MAKINUM (errno
) : SCM_BOOL_T
;
215 SCM_PROC (s_sys_fileno
, "%fileno", 1, 0, 0, scm_sys_fileno
);
218 scm_sys_fileno (SCM port
)
221 scm_sys_fileno (port
)
226 SCM_ASSERT (SCM_NIMP (port
) && SCM_OPFPORTP (port
), port
, SCM_ARG1
, s_sys_fileno
);
227 fd
= fileno ((FILE *)SCM_STREAM (port
));
228 return (fd
== -1) ? SCM_BOOL_F
: SCM_MAKINUM (fd
);
232 SCM_PROC (s_sys_soft_fileno
, "%soft-fileno", 1, 0, 0, scm_sys_soft_fileno
);
235 scm_sys_soft_fileno (SCM port
)
238 scm_sys_soft_fileno (port
)
243 SCM_ASSERT (SCM_NIMP (port
) && SCM_PORTP (port
), port
, SCM_ARG1
, s_sys_fileno
);
245 if (!SCM_OPFPORTP (port
))
248 fd
= fileno ((FILE *)SCM_STREAM (port
));
249 return (fd
== -1) ? SCM_BOOL_F
: SCM_MAKINUM (fd
);
254 SCM_PROC (s_sys_isatty
, "%isatty?", 1, 0, 0, scm_sys_isatty_p
);
257 scm_sys_isatty_p (SCM port
)
260 scm_sys_isatty_p (port
)
265 SCM_ASSERT (SCM_NIMP (port
) && SCM_OPFPORTP (port
), port
, SCM_ARG1
, s_sys_isatty
);
266 rv
= fileno ((FILE *)SCM_STREAM (port
));
268 return SCM_MAKINUM (errno
);
272 return rv
? SCM_BOOL_T
: SCM_BOOL_F
;
278 SCM_PROC (s_sys_fdopen
, "%fdopen", 2, 0, 0, scm_sys_fdopen
);
281 scm_sys_fdopen (SCM fdes
, SCM modes
)
284 scm_sys_fdopen (fdes
, modes
)
292 SCM_ASSERT (SCM_INUMP (fdes
), fdes
, SCM_ARG1
, s_sys_fdopen
);
293 SCM_ASSERT (SCM_NIMP (modes
) && SCM_STRINGP (modes
), modes
, SCM_ARG2
, s_sys_fdopen
);
295 f
= fdopen (SCM_INUM (fdes
), SCM_CHARS (modes
));
299 return SCM_MAKINUM (errno
);
302 SCM_CAR (port
) = scm_tc16_fport
| scm_mode_bits (SCM_CHARS (modes
));
303 SCM_SETSTREAM (port
,(SCM
)f
);
304 scm_add_to_port_table (port
);
311 /* Move a port's underlying file descriptor to a given value.
312 * Returns: #f for error.
313 * 0 if fdes is already the given value.
315 * MOVE->FDES is implemented in Scheme and calls this primitive.
317 SCM_PROC (s_sys_primitive_move_to_fdes
, "%primitive-move->fdes", 2, 0, 0, scm_sys_primitive_move_to_fdes
);
320 scm_sys_primitive_move_to_fdes (SCM port
, SCM fd
)
323 scm_sys_primitive_move_to_fdes (port
, fd
)
333 SCM_ASSERT (SCM_NIMP (port
) && SCM_OPFPORTP (port
), port
, SCM_ARG1
, s_sys_primitive_move_to_fdes
);
334 SCM_ASSERT (SCM_INUMP (fd
), fd
, SCM_ARG2
, s_sys_primitive_move_to_fdes
);
336 stream
= (FILE *)SCM_STREAM (port
);
337 old_fd
= fileno (stream
);
338 new_fd
= SCM_INUM (fd
);
339 if (old_fd
== new_fd
)
342 return SCM_MAKINUM (0);
344 scm_evict_ports (new_fd
);
345 rv
= dup2 (old_fd
, new_fd
);
351 scm_setfileno (stream
, new_fd
);
352 SCM_SYSCALL (close (old_fd
));
354 return SCM_MAKINUM (1);
362 scm_setfileno (FILE *fs
, int fd
)
365 scm_setfileno (fs
, fd
)
370 #ifdef SET_FILE_FD_FIELD
371 SET_FILE_FD_FIELD(fs
, fd
);
373 Configure could
not guess the name of the correct field in a
FILE *.
375 This function needs to be ported to your system
.
377 SET_FILE_FD_FIELD should change the descriptor refered to by a stdio
378 stream
, and nothing
else.
380 The way to port
this file is to add cases to configure
.in
. Search
381 that file
for "SET_FILE_FD_FIELD" and follow the examples there
.
385 /* Move ports with the specified file descriptor to new descriptors,
386 * reseting the revealed count to 0.
387 * Should be called with SCM_DEFER_INTS active.
391 scm_evict_ports (int fd
)
400 for (i
= 0; i
< scm_port_table_size
; i
++)
402 if (SCM_FPORTP (scm_port_table
[i
]->port
)
403 && fileno ((FILE *)SCM_STREAM (scm_port_table
[i
]->port
)) == fd
)
405 scm_setfileno ((FILE *)SCM_STREAM (scm_port_table
[i
]->port
), dup (fd
));
406 scm_set_port_revealed_x (scm_port_table
[i
]->port
, SCM_MAKINUM (0));
411 /* Return a list of ports using a given file descriptor. */
412 SCM_PROC(s_fdes_to_ports
, "fdes->ports", 1, 0, 0, scm_fdes_to_ports
);
415 scm_fdes_to_ports (SCM fd
)
418 scm_fdes_to_ports (fd
)
422 SCM result
= SCM_EOL
;
426 SCM_ASSERT (SCM_INUMP (fd
), fd
, SCM_ARG1
, s_fdes_to_ports
);
427 int_fd
= SCM_INUM (fd
);
430 for (i
= 0; i
< scm_port_table_size
; i
++)
432 if (SCM_FPORTP (scm_port_table
[i
]->port
)
433 && fileno ((FILE *)SCM_STREAM (scm_port_table
[i
]->port
)) == int_fd
)
434 result
= scm_cons (scm_port_table
[i
]->port
, result
);
442 scm_init_ioext (void)
448 /* fseek() symbols. */
449 scm_sysintern ("SEEK_SET", SCM_MAKINUM (SEEK_SET
));
450 scm_sysintern ("SEEK_CUR", SCM_MAKINUM (SEEK_CUR
));
451 scm_sysintern ("SEEK_END", SCM_MAKINUM (SEEK_END
));
453 /* access() symbols. */
454 scm_sysintern ("R_OK", SCM_MAKINUM (R_OK
));
455 scm_sysintern ("W_OK", SCM_MAKINUM (W_OK
));
456 scm_sysintern ("X_OK", SCM_MAKINUM (X_OK
));
457 scm_sysintern ("F_OK", SCM_MAKINUM (F_OK
));
459 /* File type/permission bits. */
461 scm_sysintern ("S_IRUSR", SCM_MAKINUM (S_IRUSR
));
464 scm_sysintern ("S_IWUSR", SCM_MAKINUM (S_IWUSR
));
467 scm_sysintern ("S_IXUSR", SCM_MAKINUM (S_IXUSR
));
470 scm_sysintern ("S_IRWXU", SCM_MAKINUM (S_IRWXU
));
474 scm_sysintern ("S_IRGRP", SCM_MAKINUM (S_IRGRP
));
477 scm_sysintern ("S_IWGRP", SCM_MAKINUM (S_IWGRP
));
480 scm_sysintern ("S_IXGRP", SCM_MAKINUM (S_IXGRP
));
483 scm_sysintern ("S_IRWXG", SCM_MAKINUM (S_IRWXG
));
487 scm_sysintern ("S_IROTH", SCM_MAKINUM (S_IROTH
));
490 scm_sysintern ("S_IWOTH", SCM_MAKINUM (S_IWOTH
));
493 scm_sysintern ("S_IXOTH", SCM_MAKINUM (S_IXOTH
));
496 scm_sysintern ("S_IRWXO", SCM_MAKINUM (S_IRWXO
));
500 scm_sysintern ("S_ISUID", SCM_MAKINUM (S_ISUID
));
503 scm_sysintern ("S_ISGID", SCM_MAKINUM (S_ISGID
));
506 scm_sysintern ("S_ISVTX", SCM_MAKINUM (S_ISVTX
));
510 scm_sysintern ("S_IFMT", SCM_MAKINUM (S_IFMT
));
513 scm_sysintern ("S_IFDIR", SCM_MAKINUM (S_IFDIR
));
516 scm_sysintern ("S_IFCHR", SCM_MAKINUM (S_IFCHR
));
519 scm_sysintern ("S_IFBLK", SCM_MAKINUM (S_IFBLK
));
522 scm_sysintern ("S_IFREG", SCM_MAKINUM (S_IFREG
));
525 scm_sysintern ("S_IFLNK", SCM_MAKINUM (S_IFLNK
));
528 scm_sysintern ("S_IFSOCK", SCM_MAKINUM (S_IFSOCK
));
531 scm_sysintern ("S_IFIFO", SCM_MAKINUM (S_IFIFO
));