1 /* Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003,
2 * 2004, 2006, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc.
4 * This library is free software; you can redistribute it and/or
5 * modify it under the terms of the GNU Lesser General Public License
6 * as published by the Free Software Foundation; either version 3 of
7 * the License, or (at your option) any later version.
9 * This library is distributed in the hope that it will be useful, but
10 * WITHOUT ANY WARRANTY; without even the implied warranty of
11 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
12 * Lesser General Public License for more details.
14 * You should have received a copy of the GNU Lesser General Public
15 * License along with this library; if not, write to the Free Software
16 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
22 #define _LARGEFILE64_SOURCE /* ask for stat64 etc */
23 #define _GNU_SOURCE /* ask for LONG_LONG_MAX/LONG_LONG_MIN */
31 #include "libguile/_scm.h"
32 #include "libguile/strings.h"
33 #include "libguile/validate.h"
34 #include "libguile/gc.h"
35 #include "libguile/posix.h"
36 #include "libguile/dynwind.h"
37 #include "libguile/hashtab.h"
39 #include "libguile/fports.h"
50 #ifdef HAVE_STRUCT_STAT_ST_BLKSIZE
57 #include <sys/types.h>
59 #include <full-write.h>
61 #include "libguile/iselect.h"
63 /* Some defines for Windows (native port, not Cygwin). */
65 # include <sys/stat.h>
66 # include <winsock2.h>
67 #endif /* __MINGW32__ */
69 #include <full-write.h>
71 /* Mingw (version 3.4.5, circa 2006) has ftruncate as an alias for chsize
72 already, but have this code here in case that wasn't so in past versions,
73 or perhaps to help other minimal DOS environments.
75 gnulib ftruncate.c has code using fcntl F_CHSIZE and F_FREESP, which
76 might be possibilities if we've got other systems without ftruncate. */
78 #if defined HAVE_CHSIZE && ! defined HAVE_FTRUNCATE
79 # define ftruncate(fd, size) chsize (fd, size)
80 # undef HAVE_FTRUNCATE
81 # define HAVE_FTRUNCATE 1
84 #if SIZEOF_OFF_T == SIZEOF_INT
85 #define OFF_T_MAX INT_MAX
86 #define OFF_T_MIN INT_MIN
87 #elif SIZEOF_OFF_T == SIZEOF_LONG
88 #define OFF_T_MAX LONG_MAX
89 #define OFF_T_MIN LONG_MIN
90 #elif SIZEOF_OFF_T == SIZEOF_LONG_LONG
91 #define OFF_T_MAX LONG_LONG_MAX
92 #define OFF_T_MIN LONG_LONG_MIN
94 #error Oops, unknown OFF_T size
97 scm_t_bits scm_tc16_fport
;
100 /* default buffer size, used if the O/S won't supply a value. */
101 static const size_t default_buffer_size
= 1024;
103 /* create FPORT buffer with specified sizes (or -1 to use default size or
106 scm_fport_buffer_add (SCM port
, long read_size
, int write_size
)
107 #define FUNC_NAME "scm_fport_buffer_add"
109 scm_t_port
*pt
= SCM_PTAB_ENTRY (port
);
111 if (read_size
== -1 || write_size
== -1)
114 #ifdef HAVE_STRUCT_STAT_ST_BLKSIZE
116 scm_t_fport
*fp
= SCM_FSTREAM (port
);
118 default_size
= (fstat (fp
->fdes
, &st
) == -1) ? default_buffer_size
121 default_size
= default_buffer_size
;
124 read_size
= default_size
;
125 if (write_size
== -1)
126 write_size
= default_size
;
129 if (SCM_INPUT_PORT_P (port
) && read_size
> 0)
131 pt
->read_buf
= scm_gc_malloc_pointerless (read_size
, "port buffer");
132 pt
->read_pos
= pt
->read_end
= pt
->read_buf
;
133 pt
->read_buf_size
= read_size
;
137 pt
->read_pos
= pt
->read_buf
= pt
->read_end
= &pt
->shortbuf
;
138 pt
->read_buf_size
= 1;
141 if (SCM_OUTPUT_PORT_P (port
) && write_size
> 0)
143 pt
->write_buf
= scm_gc_malloc_pointerless (write_size
, "port buffer");
144 pt
->write_pos
= pt
->write_buf
;
145 pt
->write_buf_size
= write_size
;
149 pt
->write_buf
= pt
->write_pos
= &pt
->shortbuf
;
150 pt
->write_buf_size
= 1;
153 pt
->write_end
= pt
->write_buf
+ pt
->write_buf_size
;
154 if (read_size
> 0 || write_size
> 0)
155 SCM_SET_CELL_WORD_0 (port
, SCM_CELL_WORD_0 (port
) & ~SCM_BUF0
);
157 SCM_SET_CELL_WORD_0 (port
, SCM_CELL_WORD_0 (port
) | SCM_BUF0
);
161 SCM_DEFINE (scm_setvbuf
, "setvbuf", 2, 1, 0,
162 (SCM port
, SCM mode
, SCM size
),
163 "Set the buffering mode for @var{port}. @var{mode} can be:\n"
170 "block buffered, using a newly allocated buffer of @var{size} bytes.\n"
171 "If @var{size} is omitted, a default size will be used.\n"
173 #define FUNC_NAME s_scm_setvbuf
180 port
= SCM_COERCE_OUTPORT (port
);
182 SCM_VALIDATE_OPFPORT (1,port
);
183 cmode
= scm_to_int (mode
);
184 if (cmode
!= _IONBF
&& cmode
!= _IOFBF
&& cmode
!= _IOLBF
)
185 scm_out_of_range (FUNC_NAME
, mode
);
189 SCM_SET_CELL_WORD_0 (port
, SCM_CELL_WORD_0 (port
) | SCM_BUFLINE
);
194 SCM_SET_CELL_WORD_0 (port
, SCM_CELL_WORD_0 (port
) & ~(scm_t_bits
)SCM_BUFLINE
);
197 if (SCM_UNBNDP (size
))
206 csize
= scm_to_int (size
);
207 if (csize
< 0 || (cmode
== _IONBF
&& csize
> 0))
208 scm_out_of_range (FUNC_NAME
, size
);
211 pt
= SCM_PTAB_ENTRY (port
);
213 if (SCM_INPUT_PORT_P (port
))
214 drained
= scm_drain_input (port
);
216 drained
= scm_nullstr
;
218 if (SCM_OUTPUT_PORT_P (port
))
219 scm_flush_unlocked (port
);
221 if (pt
->read_buf
== pt
->putback_buf
)
223 pt
->read_buf
= pt
->saved_read_buf
;
224 pt
->read_pos
= pt
->saved_read_pos
;
225 pt
->read_end
= pt
->saved_read_end
;
226 pt
->read_buf_size
= pt
->saved_read_buf_size
;
228 if (pt
->read_buf
!= &pt
->shortbuf
)
229 scm_gc_free (pt
->read_buf
, pt
->read_buf_size
, "port buffer");
230 if (pt
->write_buf
!= &pt
->shortbuf
)
231 scm_gc_free (pt
->write_buf
, pt
->write_buf_size
, "port buffer");
233 scm_fport_buffer_add (port
, csize
, csize
);
235 if (scm_is_true (drained
) && scm_c_string_length (drained
))
236 scm_unread_string (drained
, port
);
238 return SCM_UNSPECIFIED
;
242 /* Move ports with the specified file descriptor to new descriptors,
243 * resetting the revealed count to 0.
246 scm_i_evict_port (void *closure
, SCM port
)
248 int fd
= * (int*) closure
;
250 if (SCM_FPORTP (port
))
255 /* XXX: In some cases, we can encounter a port with no associated ptab
257 p
= SCM_PTAB_ENTRY (port
);
258 fp
= (p
!= NULL
) ? (scm_t_fport
*) p
->stream
: NULL
;
260 if ((fp
!= NULL
) && (fp
->fdes
== fd
))
264 scm_syserror ("scm_evict_ports");
265 scm_set_port_revealed_x (port
, scm_from_int (0));
271 scm_evict_ports (int fd
)
273 scm_c_port_for_each (scm_i_evict_port
, (void *) &fd
);
277 SCM_DEFINE (scm_file_port_p
, "file-port?", 1, 0, 0,
279 "Determine whether @var{obj} is a port that is related to a file.")
280 #define FUNC_NAME s_scm_file_port_p
282 return scm_from_bool (SCM_FPORTP (obj
));
287 static SCM sys_file_port_name_canonicalization
;
288 SCM_SYMBOL (sym_relative
, "relative");
289 SCM_SYMBOL (sym_absolute
, "absolute");
292 fport_canonicalize_filename (SCM filename
)
294 SCM mode
= scm_fluid_ref (sys_file_port_name_canonicalization
);
296 if (!scm_is_string (filename
))
300 else if (scm_is_eq (mode
, sym_relative
))
304 path
= scm_variable_ref (scm_c_module_lookup (scm_the_root_module (),
306 rel
= scm_i_relativize_path (filename
, path
);
308 return scm_is_true (rel
) ? rel
: filename
;
310 else if (scm_is_eq (mode
, sym_absolute
))
314 str
= scm_to_locale_string (filename
);
315 canon
= canonicalize_file_name (str
);
318 return canon
? scm_take_locale_string (canon
) : filename
;
328 * Return a new port open on a given file.
330 * The mode string must match the pattern: [rwa+]** which
331 * is interpreted in the usual unix way.
333 * Return the new port.
335 SCM_DEFINE (scm_open_file
, "open-file", 2, 0, 0,
336 (SCM filename
, SCM mode
),
337 "Open the file whose name is @var{filename}, and return a port\n"
338 "representing that file. The attributes of the port are\n"
339 "determined by the @var{mode} string. The way in which this is\n"
340 "interpreted is similar to C stdio. The first character must be\n"
341 "one of the following:\n"
344 "Open an existing file for input.\n"
346 "Open a file for output, creating it if it doesn't already exist\n"
347 "or removing its contents if it does.\n"
349 "Open a file for output, creating it if it doesn't already\n"
350 "exist. All writes to the port will go to the end of the file.\n"
351 "The \"append mode\" can be turned off while the port is in use\n"
352 "@pxref{Ports and File Descriptors, fcntl}\n"
354 "The following additional characters can be appended:\n"
357 "Open the underlying file in binary mode, if supported by the system.\n"
358 "Also, open the file using the binary-compatible character encoding\n"
359 "\"ISO-8859-1\", ignoring the port's encoding and the coding declaration\n"
360 "at the top of the input file, if any.\n"
362 "Open the port for both input and output. E.g., @code{r+}: open\n"
363 "an existing file for both input and output.\n"
365 "Create an \"unbuffered\" port. In this case input and output\n"
366 "operations are passed directly to the underlying port\n"
367 "implementation without additional buffering. This is likely to\n"
368 "slow down I/O operations. The buffering mode can be changed\n"
369 "while a port is in use @pxref{Ports and File Descriptors,\n"
372 "Add line-buffering to the port. The port output buffer will be\n"
373 "automatically flushed whenever a newline character is written.\n"
375 "When the file is opened, this procedure will scan for a coding\n"
376 "declaration@pxref{Character Encoding of Source Files}. If present\n"
377 "will use that encoding for interpreting the file. Otherwise, the\n"
378 "port's encoding will be used.\n"
380 "In theory we could create read/write ports which were buffered\n"
381 "in one direction only. However this isn't included in the\n"
382 "current interfaces. If a file cannot be opened with the access\n"
383 "requested, @code{open-file} throws an exception.")
384 #define FUNC_NAME s_scm_open_file
387 int fdes
, flags
= 0, use_encoding
= 1;
388 unsigned int retries
;
389 char *file
, *md
, *ptr
;
391 scm_dynwind_begin (0);
393 file
= scm_to_locale_string (filename
);
394 scm_dynwind_free (file
);
396 md
= scm_to_locale_string (mode
);
397 scm_dynwind_free (md
);
405 flags
|= O_WRONLY
| O_CREAT
| O_TRUNC
;
408 flags
|= O_WRONLY
| O_CREAT
| O_APPEND
;
411 scm_out_of_range (FUNC_NAME
, mode
);
419 flags
= (flags
& ~(O_RDONLY
| O_WRONLY
)) | O_RDWR
;
423 #if defined (O_BINARY)
427 case '0': /* unbuffered: handled later. */
428 case 'l': /* line buffered: handled during output. */
431 scm_out_of_range (FUNC_NAME
, mode
);
436 for (retries
= 0, fdes
= -1;
437 fdes
< 0 && retries
< 2;
440 SCM_SYSCALL (fdes
= open_or_open64 (file
, flags
, 0666));
445 if (en
== EMFILE
&& retries
== 0)
446 /* Run the GC in case it collects open file ports that are no
447 longer referenced. */
448 scm_i_gc (FUNC_NAME
);
450 SCM_SYSERROR_MSG ("~A: ~S",
451 scm_cons (scm_strerror (scm_from_int (en
)),
452 scm_cons (filename
, SCM_EOL
)), en
);
456 /* Create a port from this file descriptor. The port's encoding is initially
457 %default-port-encoding. */
458 port
= scm_i_fdes_to_port (fdes
, scm_i_mode_bits (mode
),
459 fport_canonicalize_filename (filename
));
463 /* If this file has a coding declaration, use that as the port
465 if (SCM_INPUT_PORT_P (port
))
467 char *enc
= scm_i_scan_for_encoding (port
);
469 scm_i_set_port_encoding_x (port
, enc
);
473 /* If this is a binary file, use the binary-friendly ISO-8859-1
475 scm_i_set_port_encoding_x (port
, NULL
);
486 * Try getting the appropiate file flags for a given file descriptor
487 * under Windows. This incorporates some fancy operations because Windows
488 * differentiates between file, pipe and socket descriptors.
491 # define O_ACCMODE 0x0003
494 static int getflags (int fdes
)
498 int error
, optlen
= sizeof (int);
500 /* Is this a socket ? */
501 if (getsockopt (fdes
, SOL_SOCKET
, SO_ERROR
, (void *) &error
, &optlen
) >= 0)
503 /* Maybe a regular file ? */
504 else if (fstat (fdes
, &buf
) < 0)
508 /* Or an anonymous pipe handle ? */
509 if (buf
.st_mode
& _S_IFIFO
)
510 flags
= PeekNamedPipe ((HANDLE
) _get_osfhandle (fdes
), NULL
, 0,
511 NULL
, NULL
, NULL
) ? O_RDONLY
: O_WRONLY
;
513 else if (fdes
== fileno (stdin
) && isatty (fdes
))
515 /* stdout / stderr ? */
516 else if ((fdes
== fileno (stdout
) || fdes
== fileno (stderr
)) &&
524 #endif /* __MINGW32__ */
526 /* Building Guile ports from a file descriptor. */
528 /* Build a Scheme port from an open file descriptor `fdes'.
529 MODE indicates whether FILE is open for reading or writing; it uses
530 the same notation as open-file's second argument.
531 NAME is a string to be used as the port's filename.
534 scm_i_fdes_to_port (int fdes
, long mode_bits
, SCM name
)
535 #define FUNC_NAME "scm_fdes_to_port"
541 /* test that fdes is valid. */
543 flags
= getflags (fdes
);
545 flags
= fcntl (fdes
, F_GETFL
, 0);
551 && ((flags
!= O_WRONLY
&& (mode_bits
& SCM_WRTNG
))
552 || (flags
!= O_RDONLY
&& (mode_bits
& SCM_RDNG
))))
554 SCM_MISC_ERROR ("requested file mode not available on fdes", SCM_EOL
);
557 fp
= (scm_t_fport
*) scm_gc_malloc_pointerless (sizeof (scm_t_fport
),
561 port
= scm_c_make_port (scm_tc16_fport
, mode_bits
, (scm_t_bits
)fp
);
563 SCM_PTAB_ENTRY (port
)->rw_random
= SCM_FDES_RANDOM_P (fdes
);
565 if (mode_bits
& SCM_BUF0
)
566 scm_fport_buffer_add (port
, 0, 0);
568 scm_fport_buffer_add (port
, -1, -1);
570 SCM_SET_FILENAME (port
, name
);
577 scm_fdes_to_port (int fdes
, char *mode
, SCM name
)
579 return scm_i_fdes_to_port (fdes
, scm_mode_bits (mode
), name
);
582 /* Return a lower bound on the number of bytes available for input. */
584 fport_input_waiting (SCM port
)
586 int fdes
= SCM_FSTREAM (port
)->fdes
;
588 /* `FD_SETSIZE', which is 1024 on GNU systems, effectively limits the
589 highest numerical value of file descriptors that can be monitored.
590 Thus, use poll(2) whenever that is possible. */
593 struct pollfd pollfd
= { fdes
, POLLIN
, 0 };
595 if (poll (&pollfd
, 1, 0) < 0)
596 scm_syserror ("fport_input_waiting");
598 return pollfd
.revents
& POLLIN
? 1 : 0;
600 #elif defined(HAVE_SELECT)
601 struct timeval timeout
;
602 SELECT_TYPE read_set
;
603 SELECT_TYPE write_set
;
604 SELECT_TYPE except_set
;
607 FD_ZERO (&write_set
);
608 FD_ZERO (&except_set
);
610 FD_SET (fdes
, &read_set
);
615 if (select (SELECT_SET_SIZE
,
616 &read_set
, &write_set
, &except_set
, &timeout
)
618 scm_syserror ("fport_input_waiting");
619 return FD_ISSET (fdes
, &read_set
) ? 1 : 0;
621 #elif HAVE_IOCTL && defined (FIONREAD)
622 /* Note: cannot test just defined(FIONREAD) here, since mingw has FIONREAD
623 (for use with winsock ioctlsocket()) but not ioctl(). */
624 int fdes
= SCM_FSTREAM (port
)->fdes
;
626 ioctl(fdes
, FIONREAD
, &remir
);
630 scm_misc_error ("fport_input_waiting",
631 "Not fully implemented on this platform",
638 fport_print (SCM exp
, SCM port
, scm_print_state
*pstate SCM_UNUSED
)
640 scm_puts_unlocked ("#<", port
);
641 scm_print_port_mode (exp
, port
);
642 if (SCM_OPFPORTP (exp
))
645 SCM name
= SCM_FILENAME (exp
);
646 if (scm_is_string (name
) || scm_is_symbol (name
))
647 scm_display (name
, port
);
649 scm_puts_unlocked (SCM_PTOBNAME (SCM_PTOBNUM (exp
)), port
);
650 scm_putc_unlocked (' ', port
);
651 fdes
= (SCM_FSTREAM (exp
))->fdes
;
653 #if (defined HAVE_TTYNAME) && (defined HAVE_POSIX)
655 scm_display (scm_ttyname (exp
), port
);
657 #endif /* HAVE_TTYNAME */
658 scm_intprint (fdes
, 10, port
);
662 scm_puts_unlocked (SCM_PTOBNAME (SCM_PTOBNUM (exp
)), port
);
663 scm_putc_unlocked (' ', port
);
664 scm_uintprint ((scm_t_bits
) SCM_PTAB_ENTRY (exp
), 16, port
);
666 scm_putc_unlocked ('>', port
);
670 static void fport_flush (SCM port
);
672 /* fill a port's read-buffer with a single read. returns the first
673 char or EOF if end of file. */
675 fport_fill_input (SCM port
)
678 scm_t_port
*pt
= SCM_PTAB_ENTRY (port
);
679 scm_t_fport
*fp
= SCM_FSTREAM (port
);
681 SCM_SYSCALL (count
= read (fp
->fdes
, pt
->read_buf
, pt
->read_buf_size
));
683 scm_syserror ("fport_fill_input");
685 return (scm_t_wchar
) EOF
;
688 pt
->read_pos
= pt
->read_buf
;
689 pt
->read_end
= pt
->read_buf
+ count
;
690 return *pt
->read_buf
;
695 fport_seek (SCM port
, scm_t_off offset
, int whence
)
697 scm_t_port
*pt
= SCM_PTAB_ENTRY (port
);
698 scm_t_fport
*fp
= SCM_FSTREAM (port
);
700 off_t_or_off64_t result
;
702 if (pt
->rw_active
== SCM_PORT_WRITE
)
704 if (offset
!= 0 || whence
!= SEEK_CUR
)
707 result
= rv
= lseek_or_lseek64 (fp
->fdes
, offset
, whence
);
711 /* read current position without disturbing the buffer. */
712 rv
= lseek_or_lseek64 (fp
->fdes
, offset
, whence
);
713 result
= rv
+ (pt
->write_pos
- pt
->write_buf
);
716 else if (pt
->rw_active
== SCM_PORT_READ
)
718 if (offset
!= 0 || whence
!= SEEK_CUR
)
720 /* could expand to avoid a second seek. */
721 scm_end_input_unlocked (port
);
722 result
= rv
= lseek_or_lseek64 (fp
->fdes
, offset
, whence
);
726 /* read current position without disturbing the buffer
727 (particularly the unread-char buffer). */
728 rv
= lseek_or_lseek64 (fp
->fdes
, offset
, whence
);
729 result
= rv
- (pt
->read_end
- pt
->read_pos
);
731 if (pt
->read_buf
== pt
->putback_buf
)
732 result
-= pt
->saved_read_end
- pt
->saved_read_pos
;
735 else /* SCM_PORT_NEITHER */
737 result
= rv
= lseek_or_lseek64 (fp
->fdes
, offset
, whence
);
741 scm_syserror ("fport_seek");
747 fport_truncate (SCM port
, scm_t_off length
)
749 scm_t_fport
*fp
= SCM_FSTREAM (port
);
751 if (ftruncate (fp
->fdes
, length
) == -1)
752 scm_syserror ("ftruncate");
756 fport_write (SCM port
, const void *data
, size_t size
)
757 #define FUNC_NAME "fport_write"
759 /* this procedure tries to minimize the number of writes/flushes. */
760 scm_t_port
*pt
= SCM_PTAB_ENTRY (port
);
762 if (pt
->write_buf
== &pt
->shortbuf
763 || (pt
->write_pos
== pt
->write_buf
&& size
>= pt
->write_buf_size
))
765 /* Unbuffered port, or port with empty buffer and data won't fit in
767 if (full_write (SCM_FPORT_FDES (port
), data
, size
) < size
)
774 scm_t_off space
= pt
->write_end
- pt
->write_pos
;
778 /* data fits in buffer. */
779 memcpy (pt
->write_pos
, data
, size
);
780 pt
->write_pos
+= size
;
781 if (pt
->write_pos
== pt
->write_end
)
784 /* we can skip the line-buffering check if nothing's buffered. */
790 memcpy (pt
->write_pos
, data
, space
);
791 pt
->write_pos
= pt
->write_end
;
794 const void *ptr
= ((const char *) data
) + space
;
795 size_t remaining
= size
- space
;
797 if (size
>= pt
->write_buf_size
)
799 if (full_write (SCM_FPORT_FDES (port
), ptr
, remaining
)
806 memcpy (pt
->write_pos
, ptr
, remaining
);
807 pt
->write_pos
+= remaining
;
812 /* handle line buffering. */
813 if ((SCM_CELL_WORD_0 (port
) & SCM_BUFLINE
) && memchr (data
, '\n', size
))
820 fport_flush (SCM port
)
823 scm_t_port
*pt
= SCM_PTAB_ENTRY (port
);
824 scm_t_fport
*fp
= SCM_FSTREAM (port
);
825 size_t count
= pt
->write_pos
- pt
->write_buf
;
827 written
= full_write (fp
->fdes
, pt
->write_buf
, count
);
829 scm_syserror ("scm_flush");
831 pt
->write_pos
= pt
->write_buf
;
832 pt
->rw_active
= SCM_PORT_NEITHER
;
835 /* clear the read buffer and adjust the file position for unread bytes. */
837 fport_end_input (SCM port
, int offset
)
839 scm_t_fport
*fp
= SCM_FSTREAM (port
);
840 scm_t_port
*pt
= SCM_PTAB_ENTRY (port
);
842 offset
+= pt
->read_end
- pt
->read_pos
;
846 pt
->read_pos
= pt
->read_end
;
847 /* will throw error if unread-char used at beginning of file
848 then attempting to write. seems correct. */
849 if (lseek (fp
->fdes
, -offset
, SEEK_CUR
) == -1)
850 scm_syserror ("fport_end_input");
852 pt
->rw_active
= SCM_PORT_NEITHER
;
856 close_the_fd (void *data
)
858 scm_t_fport
*fp
= data
;
861 /* There's already one exception. That's probably enough! */
866 fport_close (SCM port
)
868 scm_t_fport
*fp
= SCM_FSTREAM (port
);
871 scm_dynwind_begin (0);
872 scm_dynwind_unwind_handler (close_the_fd
, fp
, 0);
876 scm_port_non_buffer (SCM_PTAB_ENTRY (port
));
878 rv
= close (fp
->fdes
);
880 /* It's not useful to retry after EINTR, as the file descriptor is
881 in an undefined state. See http://lwn.net/Articles/365294/.
882 Instead just throw an error if close fails, trusting that the fd
884 scm_syserror ("fport_close");
890 fport_free (SCM port
)
899 scm_t_bits tc
= scm_make_port_type ("file", fport_fill_input
, fport_write
);
901 scm_set_port_free (tc
, fport_free
);
902 scm_set_port_print (tc
, fport_print
);
903 scm_set_port_flush (tc
, fport_flush
);
904 scm_set_port_end_input (tc
, fport_end_input
);
905 scm_set_port_close (tc
, fport_close
);
906 scm_set_port_seek (tc
, fport_seek
);
907 scm_set_port_truncate (tc
, fport_truncate
);
908 scm_set_port_input_waiting (tc
, fport_input_waiting
);
916 scm_tc16_fport
= scm_make_fptob ();
918 scm_c_define ("_IOFBF", scm_from_int (_IOFBF
));
919 scm_c_define ("_IOLBF", scm_from_int (_IOLBF
));
920 scm_c_define ("_IONBF", scm_from_int (_IONBF
));
922 sys_file_port_name_canonicalization
= scm_make_fluid ();
923 scm_c_define ("%file-port-name-canonicalization",
924 sys_file_port_name_canonicalization
);
926 #include "libguile/fports.x"