1 /* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2003, 2004, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
3 * This library is free software; you can redistribute it and/or
4 * modify it under the terms of the GNU Lesser General Public License
5 * as published by the Free Software Foundation; either version 3 of
6 * the License, or (at your option) any later version.
8 * This library is distributed in the hope that it will be useful, but
9 * WITHOUT ANY WARRANTY; without even the implied warranty of
10 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
11 * Lesser General Public License for more details.
13 * You should have received a copy of the GNU Lesser General Public
14 * License along with this library; if not, write to the Free Software
15 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
21 #define _LARGEFILE64_SOURCE /* ask for stat64 etc */
29 #include "libguile/_scm.h"
30 #include "libguile/strings.h"
31 #include "libguile/validate.h"
32 #include "libguile/gc.h"
33 #include "libguile/posix.h"
34 #include "libguile/dynwind.h"
35 #include "libguile/hashtab.h"
37 #include "libguile/fports.h"
48 #ifdef HAVE_STRUCT_STAT_ST_BLKSIZE
53 #include <sys/types.h>
55 #include "libguile/iselect.h"
57 /* Some defines for Windows (native port, not Cygwin). */
59 # include <sys/stat.h>
60 # include <winsock2.h>
61 #endif /* __MINGW32__ */
63 #include <full-write.h>
65 /* Mingw (version 3.4.5, circa 2006) has ftruncate as an alias for chsize
66 already, but have this code here in case that wasn't so in past versions,
67 or perhaps to help other minimal DOS environments.
69 gnulib ftruncate.c has code using fcntl F_CHSIZE and F_FREESP, which
70 might be possibilities if we've got other systems without ftruncate. */
72 #if HAVE_CHSIZE && ! HAVE_FTRUNCATE
73 # define ftruncate(fd, size) chsize (fd, size)
75 #define HAVE_FTRUNCATE 1
78 #if SIZEOF_OFF_T == SIZEOF_INT
79 #define OFF_T_MAX INT_MAX
80 #define OFF_T_MIN INT_MIN
81 #elif SIZEOF_OFF_T == SIZEOF_LONG
82 #define OFF_T_MAX LONG_MAX
83 #define OFF_T_MIN LONG_MIN
84 #elif SIZEOF_OFF_T == SIZEOF_LONG_LONG
85 #define OFF_T_MAX LONG_LONG_MAX
86 #define OFF_T_MIN LONG_LONG_MIN
88 #error Oops, unknown OFF_T size
91 scm_t_bits scm_tc16_fport
;
94 /* default buffer size, used if the O/S won't supply a value. */
95 static const size_t default_buffer_size
= 1024;
97 /* create FPORT buffer with specified sizes (or -1 to use default size or
100 scm_fport_buffer_add (SCM port
, long read_size
, int write_size
)
101 #define FUNC_NAME "scm_fport_buffer_add"
103 scm_t_port
*pt
= SCM_PTAB_ENTRY (port
);
105 if (read_size
== -1 || write_size
== -1)
108 #ifdef HAVE_STRUCT_STAT_ST_BLKSIZE
110 scm_t_fport
*fp
= SCM_FSTREAM (port
);
112 default_size
= (fstat (fp
->fdes
, &st
) == -1) ? default_buffer_size
115 default_size
= default_buffer_size
;
118 read_size
= default_size
;
119 if (write_size
== -1)
120 write_size
= default_size
;
123 if (SCM_INPUT_PORT_P (port
) && read_size
> 0)
125 pt
->read_buf
= scm_gc_malloc_pointerless (read_size
, "port buffer");
126 pt
->read_pos
= pt
->read_end
= pt
->read_buf
;
127 pt
->read_buf_size
= read_size
;
131 pt
->read_pos
= pt
->read_buf
= pt
->read_end
= &pt
->shortbuf
;
132 pt
->read_buf_size
= 1;
135 if (SCM_OUTPUT_PORT_P (port
) && write_size
> 0)
137 pt
->write_buf
= scm_gc_malloc_pointerless (write_size
, "port buffer");
138 pt
->write_pos
= pt
->write_buf
;
139 pt
->write_buf_size
= write_size
;
143 pt
->write_buf
= pt
->write_pos
= &pt
->shortbuf
;
144 pt
->write_buf_size
= 1;
147 pt
->write_end
= pt
->write_buf
+ pt
->write_buf_size
;
148 if (read_size
> 0 || write_size
> 0)
149 SCM_SET_CELL_WORD_0 (port
, SCM_CELL_WORD_0 (port
) & ~SCM_BUF0
);
151 SCM_SET_CELL_WORD_0 (port
, SCM_CELL_WORD_0 (port
) | SCM_BUF0
);
155 SCM_DEFINE (scm_setvbuf
, "setvbuf", 2, 1, 0,
156 (SCM port
, SCM mode
, SCM size
),
157 "Set the buffering mode for @var{port}. @var{mode} can be:\n"
164 "block buffered, using a newly allocated buffer of @var{size} bytes.\n"
165 "If @var{size} is omitted, a default size will be used.\n"
167 #define FUNC_NAME s_scm_setvbuf
173 port
= SCM_COERCE_OUTPORT (port
);
175 SCM_VALIDATE_OPFPORT (1,port
);
176 cmode
= scm_to_int (mode
);
177 if (cmode
!= _IONBF
&& cmode
!= _IOFBF
&& cmode
!= _IOLBF
)
178 scm_out_of_range (FUNC_NAME
, mode
);
182 SCM_SET_CELL_WORD_0 (port
, SCM_CELL_WORD_0 (port
) | SCM_BUFLINE
);
187 SCM_SET_CELL_WORD_0 (port
, SCM_CELL_WORD_0 (port
) & ~(scm_t_bits
)SCM_BUFLINE
);
190 if (SCM_UNBNDP (size
))
199 csize
= scm_to_int (size
);
200 if (csize
< 0 || (cmode
== _IONBF
&& csize
> 0))
201 scm_out_of_range (FUNC_NAME
, size
);
204 pt
= SCM_PTAB_ENTRY (port
);
206 /* silently discards buffered and put-back chars. */
207 if (pt
->read_buf
== pt
->putback_buf
)
209 pt
->read_buf
= pt
->saved_read_buf
;
210 pt
->read_pos
= pt
->saved_read_pos
;
211 pt
->read_end
= pt
->saved_read_end
;
212 pt
->read_buf_size
= pt
->saved_read_buf_size
;
214 if (pt
->read_buf
!= &pt
->shortbuf
)
215 scm_gc_free (pt
->read_buf
, pt
->read_buf_size
, "port buffer");
216 if (pt
->write_buf
!= &pt
->shortbuf
)
217 scm_gc_free (pt
->write_buf
, pt
->write_buf_size
, "port buffer");
219 scm_fport_buffer_add (port
, csize
, csize
);
220 return SCM_UNSPECIFIED
;
224 /* Move ports with the specified file descriptor to new descriptors,
225 * resetting the revealed count to 0.
228 scm_i_evict_port (void *closure
, SCM port
)
230 int fd
= * (int*) closure
;
232 if (SCM_FPORTP (port
))
237 /* XXX: In some cases, we can encounter a port with no associated ptab
239 p
= SCM_PTAB_ENTRY (port
);
240 fp
= (p
!= NULL
) ? (scm_t_fport
*) p
->stream
: NULL
;
242 if ((fp
!= NULL
) && (fp
->fdes
== fd
))
246 scm_syserror ("scm_evict_ports");
247 scm_set_port_revealed_x (port
, scm_from_int (0));
253 scm_evict_ports (int fd
)
255 scm_c_port_for_each (scm_i_evict_port
, (void *) &fd
);
259 SCM_DEFINE (scm_file_port_p
, "file-port?", 1, 0, 0,
261 "Determine whether @var{obj} is a port that is related to a file.")
262 #define FUNC_NAME s_scm_file_port_p
264 return scm_from_bool (SCM_FPORTP (obj
));
270 * Return a new port open on a given file.
272 * The mode string must match the pattern: [rwa+]** which
273 * is interpreted in the usual unix way.
275 * Return the new port.
277 SCM_DEFINE (scm_open_file
, "open-file", 2, 0, 0,
278 (SCM filename
, SCM mode
),
279 "Open the file whose name is @var{filename}, and return a port\n"
280 "representing that file. The attributes of the port are\n"
281 "determined by the @var{mode} string. The way in which this is\n"
282 "interpreted is similar to C stdio. The first character must be\n"
283 "one of the following:\n"
286 "Open an existing file for input.\n"
288 "Open a file for output, creating it if it doesn't already exist\n"
289 "or removing its contents if it does.\n"
291 "Open a file for output, creating it if it doesn't already\n"
292 "exist. All writes to the port will go to the end of the file.\n"
293 "The \"append mode\" can be turned off while the port is in use\n"
294 "@pxref{Ports and File Descriptors, fcntl}\n"
296 "The following additional characters can be appended:\n"
299 "Open the underlying file in binary mode, if supported by the operating system. "
301 "Open the port for both input and output. E.g., @code{r+}: open\n"
302 "an existing file for both input and output.\n"
304 "Create an \"unbuffered\" port. In this case input and output\n"
305 "operations are passed directly to the underlying port\n"
306 "implementation without additional buffering. This is likely to\n"
307 "slow down I/O operations. The buffering mode can be changed\n"
308 "while a port is in use @pxref{Ports and File Descriptors,\n"
311 "Add line-buffering to the port. The port output buffer will be\n"
312 "automatically flushed whenever a newline character is written.\n"
314 "In theory we could create read/write ports which were buffered\n"
315 "in one direction only. However this isn't included in the\n"
316 "current interfaces. If a file cannot be opened with the access\n"
317 "requested, @code{open-file} throws an exception.")
318 #define FUNC_NAME s_scm_open_file
322 unsigned int retries
;
323 char *file
, *md
, *ptr
;
325 scm_dynwind_begin (0);
327 file
= scm_to_locale_string (filename
);
328 scm_dynwind_free (file
);
330 md
= scm_to_locale_string (mode
);
331 scm_dynwind_free (md
);
339 flags
|= O_WRONLY
| O_CREAT
| O_TRUNC
;
342 flags
|= O_WRONLY
| O_CREAT
| O_APPEND
;
345 scm_out_of_range (FUNC_NAME
, mode
);
353 flags
= (flags
& ~(O_RDONLY
| O_WRONLY
)) | O_RDWR
;
356 #if defined (O_BINARY)
360 case '0': /* unbuffered: handled later. */
361 case 'l': /* line buffered: handled during output. */
364 scm_out_of_range (FUNC_NAME
, mode
);
369 for (retries
= 0, fdes
= -1;
370 fdes
< 0 && retries
< 2;
373 SCM_SYSCALL (fdes
= open_or_open64 (file
, flags
, 0666));
378 if (en
== EMFILE
&& retries
== 0)
379 /* Run the GC in case it collects open file ports that are no
380 longer referenced. */
381 scm_i_gc (FUNC_NAME
);
383 SCM_SYSERROR_MSG ("~A: ~S",
384 scm_cons (scm_strerror (scm_from_int (en
)),
385 scm_cons (filename
, SCM_EOL
)), en
);
389 port
= scm_i_fdes_to_port (fdes
, scm_i_mode_bits (mode
), filename
);
400 * Try getting the appropiate file flags for a given file descriptor
401 * under Windows. This incorporates some fancy operations because Windows
402 * differentiates between file, pipe and socket descriptors.
405 # define O_ACCMODE 0x0003
408 static int getflags (int fdes
)
412 int error
, optlen
= sizeof (int);
414 /* Is this a socket ? */
415 if (getsockopt (fdes
, SOL_SOCKET
, SO_ERROR
, (void *) &error
, &optlen
) >= 0)
417 /* Maybe a regular file ? */
418 else if (fstat (fdes
, &buf
) < 0)
422 /* Or an anonymous pipe handle ? */
423 if (buf
.st_mode
& _S_IFIFO
)
424 flags
= PeekNamedPipe ((HANDLE
) _get_osfhandle (fdes
), NULL
, 0,
425 NULL
, NULL
, NULL
) ? O_RDONLY
: O_WRONLY
;
427 else if (fdes
== fileno (stdin
) && isatty (fdes
))
429 /* stdout / stderr ? */
430 else if ((fdes
== fileno (stdout
) || fdes
== fileno (stderr
)) &&
438 #endif /* __MINGW32__ */
440 /* Building Guile ports from a file descriptor. */
442 /* Build a Scheme port from an open file descriptor `fdes'.
443 MODE indicates whether FILE is open for reading or writing; it uses
444 the same notation as open-file's second argument.
445 NAME is a string to be used as the port's filename.
448 scm_i_fdes_to_port (int fdes
, long mode_bits
, SCM name
)
449 #define FUNC_NAME "scm_fdes_to_port"
455 /* test that fdes is valid. */
457 flags
= getflags (fdes
);
459 flags
= fcntl (fdes
, F_GETFL
, 0);
465 && ((flags
!= O_WRONLY
&& (mode_bits
& SCM_WRTNG
))
466 || (flags
!= O_RDONLY
&& (mode_bits
& SCM_RDNG
))))
468 SCM_MISC_ERROR ("requested file mode not available on fdes", SCM_EOL
);
471 scm_i_scm_pthread_mutex_lock (&scm_i_port_table_mutex
);
473 port
= scm_new_port_table_entry (scm_tc16_fport
);
474 SCM_SET_CELL_TYPE(port
, scm_tc16_fport
| mode_bits
);
475 pt
= SCM_PTAB_ENTRY(port
);
478 = (scm_t_fport
*) scm_gc_malloc_pointerless (sizeof (scm_t_fport
),
482 pt
->rw_random
= SCM_FDES_RANDOM_P (fdes
);
483 SCM_SETSTREAM (port
, fp
);
484 if (mode_bits
& SCM_BUF0
)
485 scm_fport_buffer_add (port
, 0, 0);
487 scm_fport_buffer_add (port
, -1, -1);
489 SCM_SET_FILENAME (port
, name
);
490 scm_i_pthread_mutex_unlock (&scm_i_port_table_mutex
);
496 scm_fdes_to_port (int fdes
, char *mode
, SCM name
)
498 return scm_i_fdes_to_port (fdes
, scm_mode_bits (mode
), name
);
501 /* Return a lower bound on the number of bytes available for input. */
503 fport_input_waiting (SCM port
)
506 int fdes
= SCM_FSTREAM (port
)->fdes
;
507 struct timeval timeout
;
508 SELECT_TYPE read_set
;
509 SELECT_TYPE write_set
;
510 SELECT_TYPE except_set
;
513 FD_ZERO (&write_set
);
514 FD_ZERO (&except_set
);
516 FD_SET (fdes
, &read_set
);
521 if (select (SELECT_SET_SIZE
,
522 &read_set
, &write_set
, &except_set
, &timeout
)
524 scm_syserror ("fport_input_waiting");
525 return FD_ISSET (fdes
, &read_set
) ? 1 : 0;
527 #elif HAVE_IOCTL && defined (FIONREAD)
528 /* Note: cannot test just defined(FIONREAD) here, since mingw has FIONREAD
529 (for use with winsock ioctlsocket()) but not ioctl(). */
530 int fdes
= SCM_FSTREAM (port
)->fdes
;
532 ioctl(fdes
, FIONREAD
, &remir
);
536 scm_misc_error ("fport_input_waiting",
537 "Not fully implemented on this platform",
544 fport_print (SCM exp
, SCM port
, scm_print_state
*pstate SCM_UNUSED
)
546 scm_puts ("#<", port
);
547 scm_print_port_mode (exp
, port
);
548 if (SCM_OPFPORTP (exp
))
551 SCM name
= SCM_FILENAME (exp
);
552 if (scm_is_string (name
) || scm_is_symbol (name
))
553 scm_display (name
, port
);
555 scm_puts (SCM_PTOBNAME (SCM_PTOBNUM (exp
)), port
);
556 scm_putc (' ', port
);
557 fdes
= (SCM_FSTREAM (exp
))->fdes
;
561 scm_display (scm_ttyname (exp
), port
);
563 #endif /* HAVE_TTYNAME */
564 scm_intprint (fdes
, 10, port
);
568 scm_puts (SCM_PTOBNAME (SCM_PTOBNUM (exp
)), port
);
569 scm_putc (' ', port
);
570 scm_uintprint ((scm_t_bits
) SCM_PTAB_ENTRY (exp
), 16, port
);
572 scm_putc ('>', port
);
577 /* thread-local block for input on fport's fdes. */
579 fport_wait_for_input (SCM port
)
581 int fdes
= SCM_FSTREAM (port
)->fdes
;
583 if (!fport_input_waiting (port
))
587 int flags
= fcntl (fdes
, F_GETFL
);
590 scm_syserror ("scm_fdes_wait_for_input");
591 if (!(flags
& O_NONBLOCK
))
595 FD_SET (fdes
, &readfds
);
596 n
= scm_std_select (fdes
+ 1, &readfds
, NULL
, NULL
, NULL
);
598 while (n
== -1 && errno
== EINTR
);
601 #endif /* !__MINGW32__ */
603 static void fport_flush (SCM port
);
605 /* fill a port's read-buffer with a single read. returns the first
606 char or EOF if end of file. */
608 fport_fill_input (SCM port
)
611 scm_t_port
*pt
= SCM_PTAB_ENTRY (port
);
612 scm_t_fport
*fp
= SCM_FSTREAM (port
);
615 fport_wait_for_input (port
);
616 #endif /* !__MINGW32__ */
617 SCM_SYSCALL (count
= read (fp
->fdes
, pt
->read_buf
, pt
->read_buf_size
));
619 scm_syserror ("fport_fill_input");
621 return (scm_t_wchar
) EOF
;
624 pt
->read_pos
= pt
->read_buf
;
625 pt
->read_end
= pt
->read_buf
+ count
;
626 return *pt
->read_buf
;
631 fport_seek (SCM port
, scm_t_off offset
, int whence
)
633 scm_t_port
*pt
= SCM_PTAB_ENTRY (port
);
634 scm_t_fport
*fp
= SCM_FSTREAM (port
);
636 off_t_or_off64_t result
;
638 if (pt
->rw_active
== SCM_PORT_WRITE
)
640 if (offset
!= 0 || whence
!= SEEK_CUR
)
643 result
= rv
= lseek_or_lseek64 (fp
->fdes
, offset
, whence
);
647 /* read current position without disturbing the buffer. */
648 rv
= lseek_or_lseek64 (fp
->fdes
, offset
, whence
);
649 result
= rv
+ (pt
->write_pos
- pt
->write_buf
);
652 else if (pt
->rw_active
== SCM_PORT_READ
)
654 if (offset
!= 0 || whence
!= SEEK_CUR
)
656 /* could expand to avoid a second seek. */
657 scm_end_input (port
);
658 result
= rv
= lseek_or_lseek64 (fp
->fdes
, offset
, whence
);
662 /* read current position without disturbing the buffer
663 (particularly the unread-char buffer). */
664 rv
= lseek_or_lseek64 (fp
->fdes
, offset
, whence
);
665 result
= rv
- (pt
->read_end
- pt
->read_pos
);
667 if (pt
->read_buf
== pt
->putback_buf
)
668 result
-= pt
->saved_read_end
- pt
->saved_read_pos
;
671 else /* SCM_PORT_NEITHER */
673 result
= rv
= lseek_or_lseek64 (fp
->fdes
, offset
, whence
);
677 scm_syserror ("fport_seek");
683 fport_truncate (SCM port
, scm_t_off length
)
685 scm_t_fport
*fp
= SCM_FSTREAM (port
);
687 if (ftruncate (fp
->fdes
, length
) == -1)
688 scm_syserror ("ftruncate");
691 /* helper for fport_write: try to write data, using multiple system
692 calls if required. */
693 #define FUNC_NAME "write_all"
694 static void write_all (SCM port
, const void *data
, size_t remaining
)
696 int fdes
= SCM_FSTREAM (port
)->fdes
;
698 while (remaining
> 0)
702 SCM_SYSCALL (done
= write (fdes
, data
, remaining
));
707 data
= ((const char *) data
) + done
;
713 fport_write (SCM port
, const void *data
, size_t size
)
715 /* this procedure tries to minimize the number of writes/flushes. */
716 scm_t_port
*pt
= SCM_PTAB_ENTRY (port
);
718 if (pt
->write_buf
== &pt
->shortbuf
719 || (pt
->write_pos
== pt
->write_buf
&& size
>= pt
->write_buf_size
))
721 /* "unbuffered" port, or
722 port with empty buffer and data won't fit in buffer. */
723 write_all (port
, data
, size
);
728 scm_t_off space
= pt
->write_end
- pt
->write_pos
;
732 /* data fits in buffer. */
733 memcpy (pt
->write_pos
, data
, size
);
734 pt
->write_pos
+= size
;
735 if (pt
->write_pos
== pt
->write_end
)
738 /* we can skip the line-buffering check if nothing's buffered. */
744 memcpy (pt
->write_pos
, data
, space
);
745 pt
->write_pos
= pt
->write_end
;
748 const void *ptr
= ((const char *) data
) + space
;
749 size_t remaining
= size
- space
;
751 if (size
>= pt
->write_buf_size
)
753 write_all (port
, ptr
, remaining
);
758 memcpy (pt
->write_pos
, ptr
, remaining
);
759 pt
->write_pos
+= remaining
;
764 /* handle line buffering. */
765 if ((SCM_CELL_WORD_0 (port
) & SCM_BUFLINE
) && memchr (data
, '\n', size
))
770 /* becomes 1 when process is exiting: normal exception handling won't
771 work by this time. */
772 extern int scm_i_terminating
;
775 fport_flush (SCM port
)
777 scm_t_port
*pt
= SCM_PTAB_ENTRY (port
);
778 scm_t_fport
*fp
= SCM_FSTREAM (port
);
779 unsigned char *ptr
= pt
->write_buf
;
780 long init_size
= pt
->write_pos
- pt
->write_buf
;
781 long remaining
= init_size
;
783 while (remaining
> 0)
787 SCM_SYSCALL (count
= write (fp
->fdes
, ptr
, remaining
));
790 /* error. assume nothing was written this call, but
791 fix up the buffer for any previous successful writes. */
792 long done
= init_size
- remaining
;
798 for (i
= 0; i
< remaining
; i
++)
800 *(pt
->write_buf
+ i
) = *(pt
->write_buf
+ done
+ i
);
802 pt
->write_pos
= pt
->write_buf
+ remaining
;
804 if (scm_i_terminating
)
806 const char *msg
= "Error: could not flush file-descriptor ";
809 full_write (2, msg
, strlen (msg
));
810 sprintf (buf
, "%d\n", fp
->fdes
);
811 full_write (2, buf
, strlen (buf
));
815 else if (scm_gc_running_p
)
817 /* silently ignore the error. scm_error would abort if we
822 scm_syserror ("fport_flush");
827 pt
->write_pos
= pt
->write_buf
;
828 pt
->rw_active
= SCM_PORT_NEITHER
;
831 /* clear the read buffer and adjust the file position for unread bytes. */
833 fport_end_input (SCM port
, int offset
)
835 scm_t_fport
*fp
= SCM_FSTREAM (port
);
836 scm_t_port
*pt
= SCM_PTAB_ENTRY (port
);
838 offset
+= pt
->read_end
- pt
->read_pos
;
842 pt
->read_pos
= pt
->read_end
;
843 /* will throw error if unread-char used at beginning of file
844 then attempting to write. seems correct. */
845 if (lseek (fp
->fdes
, -offset
, SEEK_CUR
) == -1)
846 scm_syserror ("fport_end_input");
848 pt
->rw_active
= SCM_PORT_NEITHER
;
852 fport_close (SCM port
)
854 scm_t_fport
*fp
= SCM_FSTREAM (port
);
855 scm_t_port
*pt
= SCM_PTAB_ENTRY (port
);
859 SCM_SYSCALL (rv
= close (fp
->fdes
));
860 if (rv
== -1 && errno
!= EBADF
)
862 if (scm_gc_running_p
)
863 /* silently ignore the error. scm_error would abort if we
867 scm_syserror ("fport_close");
869 if (pt
->read_buf
== pt
->putback_buf
)
870 pt
->read_buf
= pt
->saved_read_buf
;
871 if (pt
->read_buf
!= &pt
->shortbuf
)
872 scm_gc_free (pt
->read_buf
, pt
->read_buf_size
, "port buffer");
873 if (pt
->write_buf
!= &pt
->shortbuf
)
874 scm_gc_free (pt
->write_buf
, pt
->write_buf_size
, "port buffer");
875 scm_gc_free (fp
, sizeof (*fp
), "file port");
880 fport_free (SCM port
)
889 scm_t_bits tc
= scm_make_port_type ("file", fport_fill_input
, fport_write
);
891 scm_set_port_free (tc
, fport_free
);
892 scm_set_port_print (tc
, fport_print
);
893 scm_set_port_flush (tc
, fport_flush
);
894 scm_set_port_end_input (tc
, fport_end_input
);
895 scm_set_port_close (tc
, fport_close
);
896 scm_set_port_seek (tc
, fport_seek
);
897 scm_set_port_truncate (tc
, fport_truncate
);
898 scm_set_port_input_waiting (tc
, fport_input_waiting
);
906 scm_tc16_fport
= scm_make_fptob ();
908 scm_c_define ("_IOFBF", scm_from_int (_IOFBF
));
909 scm_c_define ("_IOLBF", scm_from_int (_IOLBF
));
910 scm_c_define ("_IONBF", scm_from_int (_IONBF
));
912 #include "libguile/fports.x"