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 */
30 #include "libguile/_scm.h"
31 #include "libguile/strings.h"
32 #include "libguile/validate.h"
33 #include "libguile/gc.h"
34 #include "libguile/posix.h"
35 #include "libguile/dynwind.h"
36 #include "libguile/hashtab.h"
38 #include "libguile/fports.h"
49 #ifdef HAVE_STRUCT_STAT_ST_BLKSIZE
54 #include <sys/types.h>
56 #include <full-write.h>
58 #include "libguile/iselect.h"
60 /* Some defines for Windows (native port, not Cygwin). */
62 # include <sys/stat.h>
63 # include <winsock2.h>
64 #endif /* __MINGW32__ */
66 #include <full-write.h>
68 /* Mingw (version 3.4.5, circa 2006) has ftruncate as an alias for chsize
69 already, but have this code here in case that wasn't so in past versions,
70 or perhaps to help other minimal DOS environments.
72 gnulib ftruncate.c has code using fcntl F_CHSIZE and F_FREESP, which
73 might be possibilities if we've got other systems without ftruncate. */
75 #if defined HAVE_CHSIZE && ! defined HAVE_FTRUNCATE
76 # define ftruncate(fd, size) chsize (fd, size)
77 # undef HAVE_FTRUNCATE
78 # define HAVE_FTRUNCATE 1
81 #if SIZEOF_OFF_T == SIZEOF_INT
82 #define OFF_T_MAX INT_MAX
83 #define OFF_T_MIN INT_MIN
84 #elif SIZEOF_OFF_T == SIZEOF_LONG
85 #define OFF_T_MAX LONG_MAX
86 #define OFF_T_MIN LONG_MIN
87 #elif SIZEOF_OFF_T == SIZEOF_LONG_LONG
88 #define OFF_T_MAX LONG_LONG_MAX
89 #define OFF_T_MIN LONG_LONG_MIN
91 #error Oops, unknown OFF_T size
94 scm_t_bits scm_tc16_fport
;
97 /* default buffer size, used if the O/S won't supply a value. */
98 static const size_t default_buffer_size
= 1024;
100 /* create FPORT buffer with specified sizes (or -1 to use default size or
103 scm_fport_buffer_add (SCM port
, long read_size
, int write_size
)
104 #define FUNC_NAME "scm_fport_buffer_add"
106 scm_t_port
*pt
= SCM_PTAB_ENTRY (port
);
108 if (read_size
== -1 || write_size
== -1)
111 #ifdef HAVE_STRUCT_STAT_ST_BLKSIZE
113 scm_t_fport
*fp
= SCM_FSTREAM (port
);
115 default_size
= (fstat (fp
->fdes
, &st
) == -1) ? default_buffer_size
118 default_size
= default_buffer_size
;
121 read_size
= default_size
;
122 if (write_size
== -1)
123 write_size
= default_size
;
126 if (SCM_INPUT_PORT_P (port
) && read_size
> 0)
128 pt
->read_buf
= scm_gc_malloc_pointerless (read_size
, "port buffer");
129 pt
->read_pos
= pt
->read_end
= pt
->read_buf
;
130 pt
->read_buf_size
= read_size
;
134 pt
->read_pos
= pt
->read_buf
= pt
->read_end
= &pt
->shortbuf
;
135 pt
->read_buf_size
= 1;
138 if (SCM_OUTPUT_PORT_P (port
) && write_size
> 0)
140 pt
->write_buf
= scm_gc_malloc_pointerless (write_size
, "port buffer");
141 pt
->write_pos
= pt
->write_buf
;
142 pt
->write_buf_size
= write_size
;
146 pt
->write_buf
= pt
->write_pos
= &pt
->shortbuf
;
147 pt
->write_buf_size
= 1;
150 pt
->write_end
= pt
->write_buf
+ pt
->write_buf_size
;
151 if (read_size
> 0 || write_size
> 0)
152 SCM_SET_CELL_WORD_0 (port
, SCM_CELL_WORD_0 (port
) & ~SCM_BUF0
);
154 SCM_SET_CELL_WORD_0 (port
, SCM_CELL_WORD_0 (port
) | SCM_BUF0
);
158 SCM_DEFINE (scm_setvbuf
, "setvbuf", 2, 1, 0,
159 (SCM port
, SCM mode
, SCM size
),
160 "Set the buffering mode for @var{port}. @var{mode} can be:\n"
167 "block buffered, using a newly allocated buffer of @var{size} bytes.\n"
168 "If @var{size} is omitted, a default size will be used.\n"
170 #define FUNC_NAME s_scm_setvbuf
177 port
= SCM_COERCE_OUTPORT (port
);
179 SCM_VALIDATE_OPFPORT (1,port
);
180 cmode
= scm_to_int (mode
);
181 if (cmode
!= _IONBF
&& cmode
!= _IOFBF
&& cmode
!= _IOLBF
)
182 scm_out_of_range (FUNC_NAME
, mode
);
186 SCM_SET_CELL_WORD_0 (port
, SCM_CELL_WORD_0 (port
) | SCM_BUFLINE
);
191 SCM_SET_CELL_WORD_0 (port
, SCM_CELL_WORD_0 (port
) & ~(scm_t_bits
)SCM_BUFLINE
);
194 if (SCM_UNBNDP (size
))
203 csize
= scm_to_int (size
);
204 if (csize
< 0 || (cmode
== _IONBF
&& csize
> 0))
205 scm_out_of_range (FUNC_NAME
, size
);
208 pt
= SCM_PTAB_ENTRY (port
);
210 if (SCM_INPUT_PORT_P (port
))
211 drained
= scm_drain_input (port
);
213 drained
= scm_nullstr
;
215 if (SCM_OUTPUT_PORT_P (port
))
218 if (pt
->read_buf
== pt
->putback_buf
)
220 pt
->read_buf
= pt
->saved_read_buf
;
221 pt
->read_pos
= pt
->saved_read_pos
;
222 pt
->read_end
= pt
->saved_read_end
;
223 pt
->read_buf_size
= pt
->saved_read_buf_size
;
225 if (pt
->read_buf
!= &pt
->shortbuf
)
226 scm_gc_free (pt
->read_buf
, pt
->read_buf_size
, "port buffer");
227 if (pt
->write_buf
!= &pt
->shortbuf
)
228 scm_gc_free (pt
->write_buf
, pt
->write_buf_size
, "port buffer");
230 scm_fport_buffer_add (port
, csize
, csize
);
232 if (scm_is_true (drained
) && scm_c_string_length (drained
))
233 scm_unread_string (drained
, port
);
235 return SCM_UNSPECIFIED
;
239 /* Move ports with the specified file descriptor to new descriptors,
240 * resetting the revealed count to 0.
243 scm_i_evict_port (void *closure
, SCM port
)
245 int fd
= * (int*) closure
;
247 if (SCM_FPORTP (port
))
252 /* XXX: In some cases, we can encounter a port with no associated ptab
254 p
= SCM_PTAB_ENTRY (port
);
255 fp
= (p
!= NULL
) ? (scm_t_fport
*) p
->stream
: NULL
;
257 if ((fp
!= NULL
) && (fp
->fdes
== fd
))
261 scm_syserror ("scm_evict_ports");
262 scm_set_port_revealed_x (port
, scm_from_int (0));
268 scm_evict_ports (int fd
)
270 scm_c_port_for_each (scm_i_evict_port
, (void *) &fd
);
274 SCM_DEFINE (scm_file_port_p
, "file-port?", 1, 0, 0,
276 "Determine whether @var{obj} is a port that is related to a file.")
277 #define FUNC_NAME s_scm_file_port_p
279 return scm_from_bool (SCM_FPORTP (obj
));
284 static SCM sys_file_port_name_canonicalization
;
285 SCM_SYMBOL (sym_relative
, "relative");
286 SCM_SYMBOL (sym_absolute
, "absolute");
289 fport_canonicalize_filename (SCM filename
)
291 SCM mode
= scm_fluid_ref (sys_file_port_name_canonicalization
);
293 if (!scm_is_string (filename
))
297 else if (scm_is_eq (mode
, sym_relative
))
301 path
= scm_variable_ref (scm_c_module_lookup (scm_the_root_module (),
303 rel
= scm_i_relativize_path (filename
, path
);
305 return scm_is_true (rel
) ? rel
: filename
;
307 else if (scm_is_eq (mode
, sym_absolute
))
311 str
= scm_to_locale_string (filename
);
312 canon
= canonicalize_file_name (str
);
315 return canon
? scm_take_locale_string (canon
) : filename
;
325 * Return a new port open on a given file.
327 * The mode string must match the pattern: [rwa+]** which
328 * is interpreted in the usual unix way.
330 * Return the new port.
332 SCM_DEFINE (scm_open_file
, "open-file", 2, 0, 0,
333 (SCM filename
, SCM mode
),
334 "Open the file whose name is @var{filename}, and return a port\n"
335 "representing that file. The attributes of the port are\n"
336 "determined by the @var{mode} string. The way in which this is\n"
337 "interpreted is similar to C stdio. The first character must be\n"
338 "one of the following:\n"
341 "Open an existing file for input.\n"
343 "Open a file for output, creating it if it doesn't already exist\n"
344 "or removing its contents if it does.\n"
346 "Open a file for output, creating it if it doesn't already\n"
347 "exist. All writes to the port will go to the end of the file.\n"
348 "The \"append mode\" can be turned off while the port is in use\n"
349 "@pxref{Ports and File Descriptors, fcntl}\n"
351 "The following additional characters can be appended:\n"
354 "Open the underlying file in binary mode, if supported by the system.\n"
355 "Also, open the file using the binary-compatible character encoding\n"
356 "\"ISO-8859-1\", ignoring the port's encoding and the coding declaration\n"
357 "at the top of the input file, if any.\n"
359 "Open the port for both input and output. E.g., @code{r+}: open\n"
360 "an existing file for both input and output.\n"
362 "Create an \"unbuffered\" port. In this case input and output\n"
363 "operations are passed directly to the underlying port\n"
364 "implementation without additional buffering. This is likely to\n"
365 "slow down I/O operations. The buffering mode can be changed\n"
366 "while a port is in use @pxref{Ports and File Descriptors,\n"
369 "Add line-buffering to the port. The port output buffer will be\n"
370 "automatically flushed whenever a newline character is written.\n"
372 "When the file is opened, this procedure will scan for a coding\n"
373 "declaration@pxref{Character Encoding of Source Files}. If present\n"
374 "will use that encoding for interpreting the file. Otherwise, the\n"
375 "port's encoding will be used.\n"
377 "In theory we could create read/write ports which were buffered\n"
378 "in one direction only. However this isn't included in the\n"
379 "current interfaces. If a file cannot be opened with the access\n"
380 "requested, @code{open-file} throws an exception.")
381 #define FUNC_NAME s_scm_open_file
384 int fdes
, flags
= 0, use_encoding
= 1;
385 unsigned int retries
;
386 char *file
, *md
, *ptr
;
388 scm_dynwind_begin (0);
390 file
= scm_to_locale_string (filename
);
391 scm_dynwind_free (file
);
393 md
= scm_to_locale_string (mode
);
394 scm_dynwind_free (md
);
402 flags
|= O_WRONLY
| O_CREAT
| O_TRUNC
;
405 flags
|= O_WRONLY
| O_CREAT
| O_APPEND
;
408 scm_out_of_range (FUNC_NAME
, mode
);
416 flags
= (flags
& ~(O_RDONLY
| O_WRONLY
)) | O_RDWR
;
420 #if defined (O_BINARY)
424 case '0': /* unbuffered: handled later. */
425 case 'l': /* line buffered: handled during output. */
428 scm_out_of_range (FUNC_NAME
, mode
);
433 for (retries
= 0, fdes
= -1;
434 fdes
< 0 && retries
< 2;
437 SCM_SYSCALL (fdes
= open_or_open64 (file
, flags
, 0666));
442 if (en
== EMFILE
&& retries
== 0)
443 /* Run the GC in case it collects open file ports that are no
444 longer referenced. */
445 scm_i_gc (FUNC_NAME
);
447 SCM_SYSERROR_MSG ("~A: ~S",
448 scm_cons (scm_strerror (scm_from_int (en
)),
449 scm_cons (filename
, SCM_EOL
)), en
);
453 /* Create a port from this file descriptor. The port's encoding is initially
454 %default-port-encoding. */
455 port
= scm_i_fdes_to_port (fdes
, scm_i_mode_bits (mode
),
456 fport_canonicalize_filename (filename
));
460 /* If this file has a coding declaration, use that as the port
462 if (SCM_INPUT_PORT_P (port
))
464 char *enc
= scm_i_scan_for_encoding (port
);
466 scm_i_set_port_encoding_x (port
, enc
);
470 /* If this is a binary file, use the binary-friendly ISO-8859-1
472 scm_i_set_port_encoding_x (port
, NULL
);
483 * Try getting the appropiate file flags for a given file descriptor
484 * under Windows. This incorporates some fancy operations because Windows
485 * differentiates between file, pipe and socket descriptors.
488 # define O_ACCMODE 0x0003
491 static int getflags (int fdes
)
495 int error
, optlen
= sizeof (int);
497 /* Is this a socket ? */
498 if (getsockopt (fdes
, SOL_SOCKET
, SO_ERROR
, (void *) &error
, &optlen
) >= 0)
500 /* Maybe a regular file ? */
501 else if (fstat (fdes
, &buf
) < 0)
505 /* Or an anonymous pipe handle ? */
506 if (buf
.st_mode
& _S_IFIFO
)
507 flags
= PeekNamedPipe ((HANDLE
) _get_osfhandle (fdes
), NULL
, 0,
508 NULL
, NULL
, NULL
) ? O_RDONLY
: O_WRONLY
;
510 else if (fdes
== fileno (stdin
) && isatty (fdes
))
512 /* stdout / stderr ? */
513 else if ((fdes
== fileno (stdout
) || fdes
== fileno (stderr
)) &&
521 #endif /* __MINGW32__ */
523 /* Building Guile ports from a file descriptor. */
525 /* Build a Scheme port from an open file descriptor `fdes'.
526 MODE indicates whether FILE is open for reading or writing; it uses
527 the same notation as open-file's second argument.
528 NAME is a string to be used as the port's filename.
531 scm_i_fdes_to_port (int fdes
, long mode_bits
, SCM name
)
532 #define FUNC_NAME "scm_fdes_to_port"
538 /* test that fdes is valid. */
540 flags
= getflags (fdes
);
542 flags
= fcntl (fdes
, F_GETFL
, 0);
548 && ((flags
!= O_WRONLY
&& (mode_bits
& SCM_WRTNG
))
549 || (flags
!= O_RDONLY
&& (mode_bits
& SCM_RDNG
))))
551 SCM_MISC_ERROR ("requested file mode not available on fdes", SCM_EOL
);
554 scm_i_scm_pthread_mutex_lock (&scm_i_port_table_mutex
);
556 port
= scm_new_port_table_entry (scm_tc16_fport
);
557 SCM_SET_CELL_TYPE(port
, scm_tc16_fport
| mode_bits
);
558 pt
= SCM_PTAB_ENTRY(port
);
561 = (scm_t_fport
*) scm_gc_malloc_pointerless (sizeof (scm_t_fport
),
565 pt
->rw_random
= SCM_FDES_RANDOM_P (fdes
);
566 SCM_SETSTREAM (port
, fp
);
567 if (mode_bits
& SCM_BUF0
)
568 scm_fport_buffer_add (port
, 0, 0);
570 scm_fport_buffer_add (port
, -1, -1);
572 SCM_SET_FILENAME (port
, name
);
573 scm_i_pthread_mutex_unlock (&scm_i_port_table_mutex
);
579 scm_fdes_to_port (int fdes
, char *mode
, SCM name
)
581 return scm_i_fdes_to_port (fdes
, scm_mode_bits (mode
), name
);
584 /* Return a lower bound on the number of bytes available for input. */
586 fport_input_waiting (SCM port
)
589 int fdes
= SCM_FSTREAM (port
)->fdes
;
590 struct timeval timeout
;
591 SELECT_TYPE read_set
;
592 SELECT_TYPE write_set
;
593 SELECT_TYPE except_set
;
596 FD_ZERO (&write_set
);
597 FD_ZERO (&except_set
);
599 FD_SET (fdes
, &read_set
);
604 if (select (SELECT_SET_SIZE
,
605 &read_set
, &write_set
, &except_set
, &timeout
)
607 scm_syserror ("fport_input_waiting");
608 return FD_ISSET (fdes
, &read_set
) ? 1 : 0;
610 #elif HAVE_IOCTL && defined (FIONREAD)
611 /* Note: cannot test just defined(FIONREAD) here, since mingw has FIONREAD
612 (for use with winsock ioctlsocket()) but not ioctl(). */
613 int fdes
= SCM_FSTREAM (port
)->fdes
;
615 ioctl(fdes
, FIONREAD
, &remir
);
619 scm_misc_error ("fport_input_waiting",
620 "Not fully implemented on this platform",
627 fport_print (SCM exp
, SCM port
, scm_print_state
*pstate SCM_UNUSED
)
629 scm_puts ("#<", port
);
630 scm_print_port_mode (exp
, port
);
631 if (SCM_OPFPORTP (exp
))
634 SCM name
= SCM_FILENAME (exp
);
635 if (scm_is_string (name
) || scm_is_symbol (name
))
636 scm_display (name
, port
);
638 scm_puts (SCM_PTOBNAME (SCM_PTOBNUM (exp
)), port
);
639 scm_putc (' ', port
);
640 fdes
= (SCM_FSTREAM (exp
))->fdes
;
642 #if (defined HAVE_TTYNAME) && (defined HAVE_POSIX)
644 scm_display (scm_ttyname (exp
), port
);
646 #endif /* HAVE_TTYNAME */
647 scm_intprint (fdes
, 10, port
);
651 scm_puts (SCM_PTOBNAME (SCM_PTOBNUM (exp
)), port
);
652 scm_putc (' ', port
);
653 scm_uintprint ((scm_t_bits
) SCM_PTAB_ENTRY (exp
), 16, port
);
655 scm_putc ('>', port
);
659 static void fport_flush (SCM port
);
661 /* fill a port's read-buffer with a single read. returns the first
662 char or EOF if end of file. */
664 fport_fill_input (SCM port
)
667 scm_t_port
*pt
= SCM_PTAB_ENTRY (port
);
668 scm_t_fport
*fp
= SCM_FSTREAM (port
);
670 SCM_SYSCALL (count
= read (fp
->fdes
, pt
->read_buf
, pt
->read_buf_size
));
672 scm_syserror ("fport_fill_input");
674 return (scm_t_wchar
) EOF
;
677 pt
->read_pos
= pt
->read_buf
;
678 pt
->read_end
= pt
->read_buf
+ count
;
679 return *pt
->read_buf
;
684 fport_seek (SCM port
, scm_t_off offset
, int whence
)
686 scm_t_port
*pt
= SCM_PTAB_ENTRY (port
);
687 scm_t_fport
*fp
= SCM_FSTREAM (port
);
689 off_t_or_off64_t result
;
691 if (pt
->rw_active
== SCM_PORT_WRITE
)
693 if (offset
!= 0 || whence
!= SEEK_CUR
)
696 result
= rv
= lseek_or_lseek64 (fp
->fdes
, offset
, whence
);
700 /* read current position without disturbing the buffer. */
701 rv
= lseek_or_lseek64 (fp
->fdes
, offset
, whence
);
702 result
= rv
+ (pt
->write_pos
- pt
->write_buf
);
705 else if (pt
->rw_active
== SCM_PORT_READ
)
707 if (offset
!= 0 || whence
!= SEEK_CUR
)
709 /* could expand to avoid a second seek. */
710 scm_end_input (port
);
711 result
= rv
= lseek_or_lseek64 (fp
->fdes
, offset
, whence
);
715 /* read current position without disturbing the buffer
716 (particularly the unread-char buffer). */
717 rv
= lseek_or_lseek64 (fp
->fdes
, offset
, whence
);
718 result
= rv
- (pt
->read_end
- pt
->read_pos
);
720 if (pt
->read_buf
== pt
->putback_buf
)
721 result
-= pt
->saved_read_end
- pt
->saved_read_pos
;
724 else /* SCM_PORT_NEITHER */
726 result
= rv
= lseek_or_lseek64 (fp
->fdes
, offset
, whence
);
730 scm_syserror ("fport_seek");
736 fport_truncate (SCM port
, scm_t_off length
)
738 scm_t_fport
*fp
= SCM_FSTREAM (port
);
740 if (ftruncate (fp
->fdes
, length
) == -1)
741 scm_syserror ("ftruncate");
745 fport_write (SCM port
, const void *data
, size_t size
)
746 #define FUNC_NAME "fport_write"
748 /* this procedure tries to minimize the number of writes/flushes. */
749 scm_t_port
*pt
= SCM_PTAB_ENTRY (port
);
751 if (pt
->write_buf
== &pt
->shortbuf
752 || (pt
->write_pos
== pt
->write_buf
&& size
>= pt
->write_buf_size
))
754 /* Unbuffered port, or port with empty buffer and data won't fit in
756 if (full_write (SCM_FPORT_FDES (port
), data
, size
) < size
)
763 scm_t_off space
= pt
->write_end
- pt
->write_pos
;
767 /* data fits in buffer. */
768 memcpy (pt
->write_pos
, data
, size
);
769 pt
->write_pos
+= size
;
770 if (pt
->write_pos
== pt
->write_end
)
773 /* we can skip the line-buffering check if nothing's buffered. */
779 memcpy (pt
->write_pos
, data
, space
);
780 pt
->write_pos
= pt
->write_end
;
783 const void *ptr
= ((const char *) data
) + space
;
784 size_t remaining
= size
- space
;
786 if (size
>= pt
->write_buf_size
)
788 if (full_write (SCM_FPORT_FDES (port
), ptr
, remaining
)
795 memcpy (pt
->write_pos
, ptr
, remaining
);
796 pt
->write_pos
+= remaining
;
801 /* handle line buffering. */
802 if ((SCM_CELL_WORD_0 (port
) & SCM_BUFLINE
) && memchr (data
, '\n', size
))
809 fport_flush (SCM port
)
812 scm_t_port
*pt
= SCM_PTAB_ENTRY (port
);
813 scm_t_fport
*fp
= SCM_FSTREAM (port
);
814 size_t count
= pt
->write_pos
- pt
->write_buf
;
816 written
= full_write (fp
->fdes
, pt
->write_buf
, count
);
818 scm_syserror ("scm_flush");
820 pt
->write_pos
= pt
->write_buf
;
821 pt
->rw_active
= SCM_PORT_NEITHER
;
824 /* clear the read buffer and adjust the file position for unread bytes. */
826 fport_end_input (SCM port
, int offset
)
828 scm_t_fport
*fp
= SCM_FSTREAM (port
);
829 scm_t_port
*pt
= SCM_PTAB_ENTRY (port
);
831 offset
+= pt
->read_end
- pt
->read_pos
;
835 pt
->read_pos
= pt
->read_end
;
836 /* will throw error if unread-char used at beginning of file
837 then attempting to write. seems correct. */
838 if (lseek (fp
->fdes
, -offset
, SEEK_CUR
) == -1)
839 scm_syserror ("fport_end_input");
841 pt
->rw_active
= SCM_PORT_NEITHER
;
845 fport_close (SCM port
)
847 scm_t_fport
*fp
= SCM_FSTREAM (port
);
848 scm_t_port
*pt
= SCM_PTAB_ENTRY (port
);
852 SCM_SYSCALL (rv
= close (fp
->fdes
));
853 if (rv
== -1 && errno
!= EBADF
)
855 if (scm_gc_running_p
)
856 /* silently ignore the error. scm_error would abort if we
860 scm_syserror ("fport_close");
862 if (pt
->read_buf
== pt
->putback_buf
)
863 pt
->read_buf
= pt
->saved_read_buf
;
864 if (pt
->read_buf
!= &pt
->shortbuf
)
865 scm_gc_free (pt
->read_buf
, pt
->read_buf_size
, "port buffer");
866 if (pt
->write_buf
!= &pt
->shortbuf
)
867 scm_gc_free (pt
->write_buf
, pt
->write_buf_size
, "port buffer");
868 scm_gc_free (fp
, sizeof (*fp
), "file port");
873 fport_free (SCM port
)
882 scm_t_bits tc
= scm_make_port_type ("file", fport_fill_input
, fport_write
);
884 scm_set_port_free (tc
, fport_free
);
885 scm_set_port_print (tc
, fport_print
);
886 scm_set_port_flush (tc
, fport_flush
);
887 scm_set_port_end_input (tc
, fport_end_input
);
888 scm_set_port_close (tc
, fport_close
);
889 scm_set_port_seek (tc
, fport_seek
);
890 scm_set_port_truncate (tc
, fport_truncate
);
891 scm_set_port_input_waiting (tc
, fport_input_waiting
);
899 scm_tc16_fport
= scm_make_fptob ();
901 scm_c_define ("_IOFBF", scm_from_int (_IOFBF
));
902 scm_c_define ("_IOLBF", scm_from_int (_IOLBF
));
903 scm_c_define ("_IONBF", scm_from_int (_IONBF
));
905 sys_file_port_name_canonicalization
= scm_make_fluid ();
906 scm_c_define ("%file-port-name-canonicalization",
907 sys_file_port_name_canonicalization
);
909 #include "libguile/fports.x"