1 /* Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003,
2 * 2004, 2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013 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 */
41 #ifdef HAVE_STRUCT_STAT_ST_BLKSIZE
46 #include <sys/types.h>
48 #include <sys/select.h>
50 #include <full-write.h>
52 #include "libguile/_scm.h"
53 #include "libguile/strings.h"
54 #include "libguile/validate.h"
55 #include "libguile/gc.h"
56 #include "libguile/posix.h"
57 #include "libguile/dynwind.h"
58 #include "libguile/hashtab.h"
60 #include "libguile/fports.h"
62 #if SIZEOF_OFF_T == SIZEOF_INT
63 #define OFF_T_MAX INT_MAX
64 #define OFF_T_MIN INT_MIN
65 #elif SIZEOF_OFF_T == SIZEOF_LONG
66 #define OFF_T_MAX LONG_MAX
67 #define OFF_T_MIN LONG_MIN
68 #elif SIZEOF_OFF_T == SIZEOF_LONG_LONG
69 #define OFF_T_MAX LONG_LONG_MAX
70 #define OFF_T_MIN LONG_LONG_MIN
72 #error Oops, unknown OFF_T size
75 scm_t_bits scm_tc16_fport
;
78 /* default buffer size, used if the O/S won't supply a value. */
79 static const size_t default_buffer_size
= 1024;
81 /* create FPORT buffer with specified sizes (or -1 to use default size or
84 scm_fport_buffer_add (SCM port
, long read_size
, int write_size
)
85 #define FUNC_NAME "scm_fport_buffer_add"
87 scm_t_port
*pt
= SCM_PTAB_ENTRY (port
);
89 if (read_size
== -1 || write_size
== -1)
92 #ifdef HAVE_STRUCT_STAT_ST_BLKSIZE
94 scm_t_fport
*fp
= SCM_FSTREAM (port
);
96 default_size
= (fstat (fp
->fdes
, &st
) == -1) ? default_buffer_size
99 default_size
= default_buffer_size
;
102 read_size
= default_size
;
103 if (write_size
== -1)
104 write_size
= default_size
;
107 if (SCM_INPUT_PORT_P (port
) && read_size
> 0)
109 pt
->read_buf
= scm_gc_malloc_pointerless (read_size
, "port buffer");
110 pt
->read_pos
= pt
->read_end
= pt
->read_buf
;
111 pt
->read_buf_size
= read_size
;
115 pt
->read_pos
= pt
->read_buf
= pt
->read_end
= &pt
->shortbuf
;
116 pt
->read_buf_size
= 1;
119 if (SCM_OUTPUT_PORT_P (port
) && write_size
> 0)
121 pt
->write_buf
= scm_gc_malloc_pointerless (write_size
, "port buffer");
122 pt
->write_pos
= pt
->write_buf
;
123 pt
->write_buf_size
= write_size
;
127 pt
->write_buf
= pt
->write_pos
= &pt
->shortbuf
;
128 pt
->write_buf_size
= 1;
131 pt
->write_end
= pt
->write_buf
+ pt
->write_buf_size
;
132 if (read_size
> 0 || write_size
> 0)
133 SCM_SET_CELL_WORD_0 (port
, SCM_CELL_WORD_0 (port
) & ~SCM_BUF0
);
135 SCM_SET_CELL_WORD_0 (port
, SCM_CELL_WORD_0 (port
) | SCM_BUF0
);
139 SCM_DEFINE (scm_setvbuf
, "setvbuf", 2, 1, 0,
140 (SCM port
, SCM mode
, SCM size
),
141 "Set the buffering mode for @var{port}. @var{mode} can be:\n"
148 "block buffered, using a newly allocated buffer of @var{size} bytes.\n"
149 "If @var{size} is omitted, a default size will be used.\n"
151 #define FUNC_NAME s_scm_setvbuf
159 port
= SCM_COERCE_OUTPORT (port
);
161 SCM_VALIDATE_OPFPORT (1,port
);
162 cmode
= scm_to_int (mode
);
163 if (cmode
!= _IONBF
&& cmode
!= _IOFBF
&& cmode
!= _IOLBF
)
164 scm_out_of_range (FUNC_NAME
, mode
);
168 SCM_SET_CELL_WORD_0 (port
, SCM_CELL_WORD_0 (port
) | SCM_BUFLINE
);
173 SCM_SET_CELL_WORD_0 (port
, SCM_CELL_WORD_0 (port
) & ~(scm_t_bits
)SCM_BUFLINE
);
176 if (SCM_UNBNDP (size
))
185 csize
= scm_to_int (size
);
186 if (csize
< 0 || (cmode
== _IONBF
&& csize
> 0))
187 scm_out_of_range (FUNC_NAME
, size
);
190 pt
= SCM_PTAB_ENTRY (port
);
192 if (SCM_INPUT_PORT_P (port
))
194 /* Drain pending input from PORT. Don't use `scm_drain_input' since
195 it returns a string, whereas we want binary input here. */
196 ndrained
= pt
->read_end
- pt
->read_pos
;
197 if (pt
->read_buf
== pt
->putback_buf
)
198 ndrained
+= pt
->saved_read_end
- pt
->saved_read_pos
;
202 drained
= scm_gc_malloc_pointerless (ndrained
, "file port");
203 scm_take_from_input_buffers (port
, drained
, ndrained
);
209 if (SCM_OUTPUT_PORT_P (port
))
210 scm_flush_unlocked (port
);
212 if (pt
->read_buf
== pt
->putback_buf
)
214 pt
->read_buf
= pt
->saved_read_buf
;
215 pt
->read_pos
= pt
->saved_read_pos
;
216 pt
->read_end
= pt
->saved_read_end
;
217 pt
->read_buf_size
= pt
->saved_read_buf_size
;
219 if (pt
->read_buf
!= &pt
->shortbuf
)
220 scm_gc_free (pt
->read_buf
, pt
->read_buf_size
, "port buffer");
221 if (pt
->write_buf
!= &pt
->shortbuf
)
222 scm_gc_free (pt
->write_buf
, pt
->write_buf_size
, "port buffer");
224 scm_fport_buffer_add (port
, csize
, csize
);
227 /* Put DRAINED back to PORT. */
228 scm_unget_bytes ((unsigned char *) drained
, ndrained
, port
);
230 return SCM_UNSPECIFIED
;
234 /* Move ports with the specified file descriptor to new descriptors,
235 * resetting the revealed count to 0.
238 scm_i_evict_port (void *closure
, SCM port
)
240 int fd
= * (int*) closure
;
242 if (SCM_FPORTP (port
))
247 /* XXX: In some cases, we can encounter a port with no associated ptab
249 p
= SCM_PTAB_ENTRY (port
);
250 fp
= (p
!= NULL
) ? (scm_t_fport
*) p
->stream
: NULL
;
252 if ((fp
!= NULL
) && (fp
->fdes
== fd
))
256 scm_syserror ("scm_evict_ports");
257 scm_set_port_revealed_x (port
, scm_from_int (0));
263 scm_evict_ports (int fd
)
265 scm_c_port_for_each (scm_i_evict_port
, (void *) &fd
);
269 SCM_DEFINE (scm_file_port_p
, "file-port?", 1, 0, 0,
271 "Determine whether @var{obj} is a port that is related to a file.")
272 #define FUNC_NAME s_scm_file_port_p
274 return scm_from_bool (SCM_FPORTP (obj
));
279 static SCM sys_file_port_name_canonicalization
;
280 SCM_SYMBOL (sym_relative
, "relative");
281 SCM_SYMBOL (sym_absolute
, "absolute");
284 fport_canonicalize_filename (SCM filename
)
286 SCM mode
= scm_fluid_ref (sys_file_port_name_canonicalization
);
288 if (!scm_is_string (filename
))
292 else if (scm_is_eq (mode
, sym_relative
))
296 path
= scm_variable_ref (scm_c_module_lookup (scm_the_root_module (),
298 rel
= scm_i_relativize_path (filename
, path
);
300 return scm_is_true (rel
) ? rel
: filename
;
302 else if (scm_is_eq (mode
, sym_absolute
))
306 str
= scm_to_locale_string (filename
);
307 canon
= canonicalize_file_name (str
);
310 return canon
? scm_take_locale_string (canon
) : filename
;
318 /* scm_open_file_with_encoding
319 Return a new port open on a given file.
321 The mode string must match the pattern: [rwa+]** which
322 is interpreted in the usual unix way.
324 Unless binary mode is requested, the character encoding of the new
325 port is determined as follows: First, if GUESS_ENCODING is true,
326 'file-encoding' is used to guess the encoding of the file. If
327 GUESS_ENCODING is false or if 'file-encoding' fails, ENCODING is used
328 unless it is also false. As a last resort, the default port encoding
329 is used. It is an error to pass a non-false GUESS_ENCODING or
330 ENCODING if binary mode is requested.
332 Return the new port. */
334 scm_open_file_with_encoding (SCM filename
, SCM mode
,
335 SCM guess_encoding
, SCM encoding
)
336 #define FUNC_NAME "open-file"
339 int fdes
, flags
= 0, binary
= 0;
340 unsigned int retries
;
341 char *file
, *md
, *ptr
;
343 if (SCM_UNLIKELY (!(scm_is_false (encoding
) || scm_is_string (encoding
))))
344 scm_wrong_type_arg_msg (FUNC_NAME
, 0, encoding
,
345 "encoding to be string or false");
347 scm_dynwind_begin (0);
349 file
= scm_to_locale_string (filename
);
350 scm_dynwind_free (file
);
352 md
= scm_to_locale_string (mode
);
353 scm_dynwind_free (md
);
361 flags
|= O_WRONLY
| O_CREAT
| O_TRUNC
;
364 flags
|= O_WRONLY
| O_CREAT
| O_APPEND
;
367 scm_out_of_range (FUNC_NAME
, mode
);
375 flags
= (flags
& ~(O_RDONLY
| O_WRONLY
)) | O_RDWR
;
379 #if defined (O_BINARY)
383 case '0': /* unbuffered: handled later. */
384 case 'l': /* line buffered: handled during output. */
387 scm_out_of_range (FUNC_NAME
, mode
);
392 for (retries
= 0, fdes
= -1;
393 fdes
< 0 && retries
< 2;
396 SCM_SYSCALL (fdes
= open_or_open64 (file
, flags
, 0666));
401 if (en
== EMFILE
&& retries
== 0)
402 /* Run the GC in case it collects open file ports that are no
403 longer referenced. */
404 scm_i_gc (FUNC_NAME
);
406 SCM_SYSERROR_MSG ("~A: ~S",
407 scm_cons (scm_strerror (scm_from_int (en
)),
408 scm_cons (filename
, SCM_EOL
)), en
);
412 /* Create a port from this file descriptor. The port's encoding is initially
413 %default-port-encoding. */
414 port
= scm_i_fdes_to_port (fdes
, scm_i_mode_bits (mode
),
415 fport_canonicalize_filename (filename
));
419 if (scm_is_true (encoding
))
420 scm_misc_error (FUNC_NAME
,
421 "Encoding specified on a binary port",
422 scm_list_1 (encoding
));
423 if (scm_is_true (guess_encoding
))
424 scm_misc_error (FUNC_NAME
,
425 "Request to guess encoding on a binary port",
428 /* Use the binary-friendly ISO-8859-1 encoding. */
429 scm_i_set_port_encoding_x (port
, NULL
);
435 if (scm_is_true (guess_encoding
))
437 if (SCM_INPUT_PORT_P (port
))
438 enc
= scm_i_scan_for_encoding (port
);
440 scm_misc_error (FUNC_NAME
,
441 "Request to guess encoding on an output-only port",
445 if (!enc
&& scm_is_true (encoding
))
447 char *buf
= scm_to_latin1_string (encoding
);
448 enc
= scm_gc_strdup (buf
, "encoding");
453 scm_i_set_port_encoding_x (port
, enc
);
463 scm_open_file (SCM filename
, SCM mode
)
465 return scm_open_file_with_encoding (filename
, mode
, SCM_BOOL_F
, SCM_BOOL_F
);
468 /* We can't define these using SCM_KEYWORD, because keywords have not
469 yet been initialized when scm_init_fports is called. */
470 static SCM k_guess_encoding
= SCM_UNDEFINED
;
471 static SCM k_encoding
= SCM_UNDEFINED
;
473 SCM_INTERNAL SCM
scm_i_open_file (SCM
, SCM
, SCM
);
475 SCM_DEFINE (scm_i_open_file
, "open-file", 2, 0, 1,
476 (SCM filename
, SCM mode
, SCM keyword_args
),
477 "Open the file whose name is @var{filename}, and return a port\n"
478 "representing that file. The attributes of the port are\n"
479 "determined by the @var{mode} string. The way in which this is\n"
480 "interpreted is similar to C stdio. The first character must be\n"
481 "one of the following:\n"
484 "Open an existing file for input.\n"
486 "Open a file for output, creating it if it doesn't already exist\n"
487 "or removing its contents if it does.\n"
489 "Open a file for output, creating it if it doesn't already\n"
490 "exist. All writes to the port will go to the end of the file.\n"
491 "The \"append mode\" can be turned off while the port is in use\n"
492 "@pxref{Ports and File Descriptors, fcntl}\n"
494 "The following additional characters can be appended:\n"
497 "Open the underlying file in binary mode, if supported by the system.\n"
498 "Also, open the file using the binary-compatible character encoding\n"
499 "\"ISO-8859-1\", ignoring the default port encoding.\n"
501 "Open the port for both input and output. E.g., @code{r+}: open\n"
502 "an existing file for both input and output.\n"
504 "Create an \"unbuffered\" port. In this case input and output\n"
505 "operations are passed directly to the underlying port\n"
506 "implementation without additional buffering. This is likely to\n"
507 "slow down I/O operations. The buffering mode can be changed\n"
508 "while a port is in use @pxref{Ports and File Descriptors,\n"
511 "Add line-buffering to the port. The port output buffer will be\n"
512 "automatically flushed whenever a newline character is written.\n"
514 "In theory we could create read/write ports which were buffered\n"
515 "in one direction only. However this isn't included in the\n"
516 "current interfaces. If a file cannot be opened with the access\n"
517 "requested, @code{open-file} throws an exception.")
518 #define FUNC_NAME s_scm_i_open_file
520 SCM encoding
= SCM_BOOL_F
;
521 SCM guess_encoding
= SCM_BOOL_F
;
523 scm_c_bind_keyword_arguments (FUNC_NAME
, keyword_args
, 0,
524 k_guess_encoding
, &guess_encoding
,
525 k_encoding
, &encoding
,
528 return scm_open_file_with_encoding (filename
, mode
,
529 guess_encoding
, encoding
);
534 /* Building Guile ports from a file descriptor. */
536 /* Build a Scheme port from an open file descriptor `fdes'.
537 MODE indicates whether FILE is open for reading or writing; it uses
538 the same notation as open-file's second argument.
539 NAME is a string to be used as the port's filename.
542 scm_i_fdes_to_port (int fdes
, long mode_bits
, SCM name
)
543 #define FUNC_NAME "scm_fdes_to_port"
548 /* Test that fdes is valid. */
550 int flags
= fcntl (fdes
, F_GETFL
, 0);
555 && ((flags
!= O_WRONLY
&& (mode_bits
& SCM_WRTNG
))
556 || (flags
!= O_RDONLY
&& (mode_bits
& SCM_RDNG
))))
558 SCM_MISC_ERROR ("requested file mode not available on fdes", SCM_EOL
);
561 /* If we don't have F_GETFL, as on mingw, at least we can test that
562 it is a valid file descriptor. */
564 if (fstat (fdes
, &st
) != 0)
568 fp
= (scm_t_fport
*) scm_gc_malloc_pointerless (sizeof (scm_t_fport
),
572 port
= scm_c_make_port (scm_tc16_fport
, mode_bits
, (scm_t_bits
)fp
);
574 SCM_PTAB_ENTRY (port
)->rw_random
= SCM_FDES_RANDOM_P (fdes
);
576 if (mode_bits
& SCM_BUF0
)
577 scm_fport_buffer_add (port
, 0, 0);
579 scm_fport_buffer_add (port
, -1, -1);
581 SCM_SET_FILENAME (port
, name
);
588 scm_fdes_to_port (int fdes
, char *mode
, SCM name
)
590 return scm_i_fdes_to_port (fdes
, scm_mode_bits (mode
), name
);
593 /* Return a lower bound on the number of bytes available for input. */
595 fport_input_waiting (SCM port
)
597 int fdes
= SCM_FSTREAM (port
)->fdes
;
599 struct pollfd pollfd
= { fdes
, POLLIN
, 0 };
601 if (poll (&pollfd
, 1, 0) < 0)
602 scm_syserror ("fport_input_waiting");
604 return pollfd
.revents
& POLLIN
? 1 : 0;
610 /* Revealed counts --- an oddity inherited from SCSH. */
612 #define SCM_REVEALED(x) (SCM_FSTREAM(x)->revealed)
614 static SCM revealed_ports
= SCM_EOL
;
615 static scm_i_pthread_mutex_t revealed_lock
= SCM_I_PTHREAD_MUTEX_INITIALIZER
;
617 /* Find a port in the table and return its revealed count.
618 Also used by the garbage collector.
621 scm_revealed_count (SCM port
)
625 scm_i_pthread_mutex_lock (&revealed_lock
);
626 ret
= SCM_REVEALED (port
);
627 scm_i_pthread_mutex_unlock (&revealed_lock
);
632 SCM_DEFINE (scm_port_revealed
, "port-revealed", 1, 0, 0,
634 "Return the revealed count for @var{port}.")
635 #define FUNC_NAME s_scm_port_revealed
637 port
= SCM_COERCE_OUTPORT (port
);
638 SCM_VALIDATE_OPFPORT (1, port
);
639 return scm_from_int (scm_revealed_count (port
));
643 /* Set the revealed count for a port. */
644 SCM_DEFINE (scm_set_port_revealed_x
, "set-port-revealed!", 2, 0, 0,
645 (SCM port
, SCM rcount
),
646 "Sets the revealed count for a port to a given value.\n"
647 "The return value is unspecified.")
648 #define FUNC_NAME s_scm_set_port_revealed_x
652 port
= SCM_COERCE_OUTPORT (port
);
653 SCM_VALIDATE_OPFPORT (1, port
);
655 r
= scm_to_int (rcount
);
657 scm_i_pthread_mutex_lock (&revealed_lock
);
659 prev
= SCM_REVEALED (port
);
660 SCM_REVEALED (port
) = r
;
663 revealed_ports
= scm_cons (port
, revealed_ports
);
665 revealed_ports
= scm_delq_x (port
, revealed_ports
);
667 scm_i_pthread_mutex_unlock (&revealed_lock
);
669 return SCM_UNSPECIFIED
;
673 /* Set the revealed count for a port. */
674 SCM_DEFINE (scm_adjust_port_revealed_x
, "adjust-port-revealed!", 2, 0, 0,
675 (SCM port
, SCM addend
),
676 "Add @var{addend} to the revealed count of @var{port}.\n"
677 "The return value is unspecified.")
678 #define FUNC_NAME s_scm_adjust_port_revealed_x
682 port
= SCM_COERCE_OUTPORT (port
);
683 SCM_VALIDATE_OPFPORT (1, port
);
685 a
= scm_to_int (addend
);
687 return SCM_UNSPECIFIED
;
689 scm_i_pthread_mutex_lock (&revealed_lock
);
691 SCM_REVEALED (port
) += a
;
692 if (SCM_REVEALED (port
) == a
)
693 revealed_ports
= scm_cons (port
, revealed_ports
);
694 else if (!SCM_REVEALED (port
))
695 revealed_ports
= scm_delq_x (port
, revealed_ports
);
697 scm_i_pthread_mutex_unlock (&revealed_lock
);
699 return SCM_UNSPECIFIED
;
706 fport_print (SCM exp
, SCM port
, scm_print_state
*pstate SCM_UNUSED
)
708 scm_puts_unlocked ("#<", port
);
709 scm_print_port_mode (exp
, port
);
710 if (SCM_OPFPORTP (exp
))
713 SCM name
= SCM_FILENAME (exp
);
714 if (scm_is_string (name
) || scm_is_symbol (name
))
715 scm_display (name
, port
);
717 scm_puts_unlocked (SCM_PTOBNAME (SCM_PTOBNUM (exp
)), port
);
718 scm_putc_unlocked (' ', port
);
719 fdes
= (SCM_FSTREAM (exp
))->fdes
;
721 #if (defined HAVE_TTYNAME) && (defined HAVE_POSIX)
723 scm_display (scm_ttyname (exp
), port
);
725 #endif /* HAVE_TTYNAME */
726 scm_intprint (fdes
, 10, port
);
730 scm_puts_unlocked (SCM_PTOBNAME (SCM_PTOBNUM (exp
)), port
);
731 scm_putc_unlocked (' ', port
);
732 scm_uintprint ((scm_t_bits
) SCM_PTAB_ENTRY (exp
), 16, port
);
734 scm_putc_unlocked ('>', port
);
738 static void fport_flush (SCM port
);
740 /* fill a port's read-buffer with a single read. returns the first
741 char or EOF if end of file. */
743 fport_fill_input (SCM port
)
746 scm_t_port
*pt
= SCM_PTAB_ENTRY (port
);
747 scm_t_fport
*fp
= SCM_FSTREAM (port
);
749 SCM_SYSCALL (count
= read (fp
->fdes
, pt
->read_buf
, pt
->read_buf_size
));
751 scm_syserror ("fport_fill_input");
753 return (scm_t_wchar
) EOF
;
756 pt
->read_pos
= pt
->read_buf
;
757 pt
->read_end
= pt
->read_buf
+ count
;
758 return *pt
->read_buf
;
763 fport_seek (SCM port
, scm_t_off offset
, int whence
)
765 scm_t_port
*pt
= SCM_PTAB_ENTRY (port
);
766 scm_t_fport
*fp
= SCM_FSTREAM (port
);
768 off_t_or_off64_t result
;
770 if (pt
->rw_active
== SCM_PORT_WRITE
)
772 if (offset
!= 0 || whence
!= SEEK_CUR
)
775 result
= rv
= lseek_or_lseek64 (fp
->fdes
, offset
, whence
);
779 /* read current position without disturbing the buffer. */
780 rv
= lseek_or_lseek64 (fp
->fdes
, offset
, whence
);
781 result
= rv
+ (pt
->write_pos
- pt
->write_buf
);
784 else if (pt
->rw_active
== SCM_PORT_READ
)
786 if (offset
!= 0 || whence
!= SEEK_CUR
)
788 /* could expand to avoid a second seek. */
789 scm_end_input_unlocked (port
);
790 result
= rv
= lseek_or_lseek64 (fp
->fdes
, offset
, whence
);
794 /* read current position without disturbing the buffer
795 (particularly the unread-char buffer). */
796 rv
= lseek_or_lseek64 (fp
->fdes
, offset
, whence
);
797 result
= rv
- (pt
->read_end
- pt
->read_pos
);
799 if (pt
->read_buf
== pt
->putback_buf
)
800 result
-= pt
->saved_read_end
- pt
->saved_read_pos
;
803 else /* SCM_PORT_NEITHER */
805 result
= rv
= lseek_or_lseek64 (fp
->fdes
, offset
, whence
);
809 scm_syserror ("fport_seek");
815 fport_truncate (SCM port
, scm_t_off length
)
817 scm_t_fport
*fp
= SCM_FSTREAM (port
);
819 if (ftruncate (fp
->fdes
, length
) == -1)
820 scm_syserror ("ftruncate");
824 fport_write (SCM port
, const void *data
, size_t size
)
825 #define FUNC_NAME "fport_write"
827 /* this procedure tries to minimize the number of writes/flushes. */
828 scm_t_port
*pt
= SCM_PTAB_ENTRY (port
);
830 if (pt
->write_buf
== &pt
->shortbuf
831 || (pt
->write_pos
== pt
->write_buf
&& size
>= pt
->write_buf_size
))
833 /* Unbuffered port, or port with empty buffer and data won't fit in
835 if (full_write (SCM_FPORT_FDES (port
), data
, size
) < size
)
842 scm_t_off space
= pt
->write_end
- pt
->write_pos
;
846 /* data fits in buffer. */
847 memcpy (pt
->write_pos
, data
, size
);
848 pt
->write_pos
+= size
;
849 if (pt
->write_pos
== pt
->write_end
)
852 /* we can skip the line-buffering check if nothing's buffered. */
858 memcpy (pt
->write_pos
, data
, space
);
859 pt
->write_pos
= pt
->write_end
;
862 const void *ptr
= ((const char *) data
) + space
;
863 size_t remaining
= size
- space
;
865 if (size
>= pt
->write_buf_size
)
867 if (full_write (SCM_FPORT_FDES (port
), ptr
, remaining
)
874 memcpy (pt
->write_pos
, ptr
, remaining
);
875 pt
->write_pos
+= remaining
;
880 /* handle line buffering. */
881 if ((SCM_CELL_WORD_0 (port
) & SCM_BUFLINE
) && memchr (data
, '\n', size
))
888 fport_flush (SCM port
)
891 scm_t_port
*pt
= SCM_PTAB_ENTRY (port
);
892 scm_t_fport
*fp
= SCM_FSTREAM (port
);
893 size_t count
= pt
->write_pos
- pt
->write_buf
;
895 written
= full_write (fp
->fdes
, pt
->write_buf
, count
);
897 scm_syserror ("scm_flush");
899 pt
->write_pos
= pt
->write_buf
;
900 pt
->rw_active
= SCM_PORT_NEITHER
;
903 /* clear the read buffer and adjust the file position for unread bytes. */
905 fport_end_input (SCM port
, int offset
)
907 scm_t_fport
*fp
= SCM_FSTREAM (port
);
908 scm_t_port
*pt
= SCM_PTAB_ENTRY (port
);
910 offset
+= pt
->read_end
- pt
->read_pos
;
914 pt
->read_pos
= pt
->read_end
;
915 /* will throw error if unread-char used at beginning of file
916 then attempting to write. seems correct. */
917 if (lseek (fp
->fdes
, -offset
, SEEK_CUR
) == -1)
918 scm_syserror ("fport_end_input");
920 pt
->rw_active
= SCM_PORT_NEITHER
;
924 close_the_fd (void *data
)
926 scm_t_fport
*fp
= data
;
929 /* There's already one exception. That's probably enough! */
934 fport_close (SCM port
)
936 scm_t_fport
*fp
= SCM_FSTREAM (port
);
939 scm_dynwind_begin (0);
940 scm_dynwind_unwind_handler (close_the_fd
, fp
, 0);
944 scm_port_non_buffer (SCM_PTAB_ENTRY (port
));
946 rv
= close (fp
->fdes
);
948 /* It's not useful to retry after EINTR, as the file descriptor is
949 in an undefined state. See http://lwn.net/Articles/365294/.
950 Instead just throw an error if close fails, trusting that the fd
952 scm_syserror ("fport_close");
958 fport_free (SCM port
)
967 scm_t_bits tc
= scm_make_port_type ("file", fport_fill_input
, fport_write
);
969 scm_set_port_free (tc
, fport_free
);
970 scm_set_port_print (tc
, fport_print
);
971 scm_set_port_flush (tc
, fport_flush
);
972 scm_set_port_end_input (tc
, fport_end_input
);
973 scm_set_port_close (tc
, fport_close
);
974 scm_set_port_seek (tc
, fport_seek
);
975 scm_set_port_truncate (tc
, fport_truncate
);
976 scm_set_port_input_waiting (tc
, fport_input_waiting
);
981 /* We can't initialize the keywords from 'scm_init_fports', because
982 keywords haven't yet been initialized at that point. */
984 scm_init_fports_keywords ()
986 k_guess_encoding
= scm_from_latin1_keyword ("guess-encoding");
987 k_encoding
= scm_from_latin1_keyword ("encoding");
993 scm_tc16_fport
= scm_make_fptob ();
995 scm_c_define ("_IOFBF", scm_from_int (_IOFBF
));
996 scm_c_define ("_IOLBF", scm_from_int (_IOLBF
));
997 scm_c_define ("_IONBF", scm_from_int (_IONBF
));
999 sys_file_port_name_canonicalization
= scm_make_fluid ();
1000 scm_c_define ("%file-port-name-canonicalization",
1001 sys_file_port_name_canonicalization
);
1003 #include "libguile/fports.x"