1 /* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2003, 2004, 2006, 2007 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
5 * License as published by the Free Software Foundation; either
6 * version 2.1 of the License, or (at your option) any later version.
8 * This library 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 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 02110-1301 USA
20 #define _LARGEFILE64_SOURCE /* ask for stat64 etc */
28 #include "libguile/_scm.h"
29 #include "libguile/strings.h"
30 #include "libguile/validate.h"
31 #include "libguile/gc.h"
32 #include "libguile/posix.h"
33 #include "libguile/dynwind.h"
34 #include "libguile/hashtab.h"
36 #include "libguile/fports.h"
47 #ifdef HAVE_STRUCT_STAT_ST_BLKSIZE
52 #include <sys/types.h>
54 #include "libguile/iselect.h"
56 /* Some defines for Windows (native port, not Cygwin). */
58 # include <sys/stat.h>
59 # include <winsock2.h>
60 #endif /* __MINGW32__ */
62 /* Mingw (version 3.4.5, circa 2006) has ftruncate as an alias for chsize
63 already, but have this code here in case that wasn't so in past versions,
64 or perhaps to help other minimal DOS environments.
66 gnulib ftruncate.c has code using fcntl F_CHSIZE and F_FREESP, which
67 might be possibilities if we've got other systems without ftruncate. */
69 #if HAVE_CHSIZE && ! HAVE_FTRUNCATE
70 # define ftruncate(fd, size) chsize (fd, size)
72 #define HAVE_FTRUNCATE 1
75 #if SIZEOF_OFF_T == SIZEOF_INT
76 #define OFF_T_MAX INT_MAX
77 #define OFF_T_MIN INT_MIN
78 #elif SIZEOF_OFF_T == SIZEOF_LONG
79 #define OFF_T_MAX LONG_MAX
80 #define OFF_T_MIN LONG_MIN
81 #elif SIZEOF_OFF_T == SIZEOF_LONG_LONG
82 #define OFF_T_MAX LONG_LONG_MAX
83 #define OFF_T_MIN LONG_LONG_MIN
85 #error Oops, unknown OFF_T size
88 scm_t_bits scm_tc16_fport
;
91 /* default buffer size, used if the O/S won't supply a value. */
92 static const size_t default_buffer_size
= 1024;
94 /* create FPORT buffer with specified sizes (or -1 to use default size or
97 scm_fport_buffer_add (SCM port
, long read_size
, int write_size
)
98 #define FUNC_NAME "scm_fport_buffer_add"
100 scm_t_port
*pt
= SCM_PTAB_ENTRY (port
);
102 if (read_size
== -1 || write_size
== -1)
105 #ifdef HAVE_STRUCT_STAT_ST_BLKSIZE
107 scm_t_fport
*fp
= SCM_FSTREAM (port
);
109 default_size
= (fstat (fp
->fdes
, &st
) == -1) ? default_buffer_size
112 default_size
= default_buffer_size
;
115 read_size
= default_size
;
116 if (write_size
== -1)
117 write_size
= default_size
;
120 if (SCM_INPUT_PORT_P (port
) && read_size
> 0)
122 pt
->read_buf
= scm_gc_malloc (read_size
, "port buffer");
123 pt
->read_pos
= pt
->read_end
= pt
->read_buf
;
124 pt
->read_buf_size
= read_size
;
128 pt
->read_pos
= pt
->read_buf
= pt
->read_end
= &pt
->shortbuf
;
129 pt
->read_buf_size
= 1;
132 if (SCM_OUTPUT_PORT_P (port
) && write_size
> 0)
134 pt
->write_buf
= scm_gc_malloc (write_size
, "port buffer");
135 pt
->write_pos
= pt
->write_buf
;
136 pt
->write_buf_size
= write_size
;
140 pt
->write_buf
= pt
->write_pos
= &pt
->shortbuf
;
141 pt
->write_buf_size
= 1;
144 pt
->write_end
= pt
->write_buf
+ pt
->write_buf_size
;
145 if (read_size
> 0 || write_size
> 0)
146 SCM_SET_CELL_WORD_0 (port
, SCM_CELL_WORD_0 (port
) & ~SCM_BUF0
);
148 SCM_SET_CELL_WORD_0 (port
, SCM_CELL_WORD_0 (port
) | SCM_BUF0
);
152 SCM_DEFINE (scm_setvbuf
, "setvbuf", 2, 1, 0,
153 (SCM port
, SCM mode
, SCM size
),
154 "Set the buffering mode for @var{port}. @var{mode} can be:\n"
161 "block buffered, using a newly allocated buffer of @var{size} bytes.\n"
162 "If @var{size} is omitted, a default size will be used.\n"
164 #define FUNC_NAME s_scm_setvbuf
170 port
= SCM_COERCE_OUTPORT (port
);
172 SCM_VALIDATE_OPFPORT (1,port
);
173 cmode
= scm_to_int (mode
);
174 if (cmode
!= _IONBF
&& cmode
!= _IOFBF
&& cmode
!= _IOLBF
)
175 scm_out_of_range (FUNC_NAME
, mode
);
179 SCM_SET_CELL_WORD_0 (port
, SCM_CELL_WORD_0 (port
) | SCM_BUFLINE
);
184 SCM_SET_CELL_WORD_0 (port
, SCM_CELL_WORD_0 (port
) & ~(scm_t_bits
)SCM_BUFLINE
);
187 if (SCM_UNBNDP (size
))
196 csize
= scm_to_int (size
);
197 if (csize
< 0 || (cmode
== _IONBF
&& csize
> 0))
198 scm_out_of_range (FUNC_NAME
, size
);
201 pt
= SCM_PTAB_ENTRY (port
);
203 /* silently discards buffered and put-back chars. */
204 if (pt
->read_buf
== pt
->putback_buf
)
206 pt
->read_buf
= pt
->saved_read_buf
;
207 pt
->read_pos
= pt
->saved_read_pos
;
208 pt
->read_end
= pt
->saved_read_end
;
209 pt
->read_buf_size
= pt
->saved_read_buf_size
;
211 if (pt
->read_buf
!= &pt
->shortbuf
)
212 scm_gc_free (pt
->read_buf
, pt
->read_buf_size
, "port buffer");
213 if (pt
->write_buf
!= &pt
->shortbuf
)
214 scm_gc_free (pt
->write_buf
, pt
->write_buf_size
, "port buffer");
216 scm_fport_buffer_add (port
, csize
, csize
);
217 return SCM_UNSPECIFIED
;
221 /* Move ports with the specified file descriptor to new descriptors,
222 * resetting the revealed count to 0.
225 scm_i_evict_port (void *closure
, SCM port
)
227 int fd
= * (int*) closure
;
229 if (SCM_FPORTP (port
))
231 scm_t_fport
*fp
= SCM_FSTREAM (port
);
237 scm_syserror ("scm_evict_ports");
238 scm_set_port_revealed_x (port
, scm_from_int (0));
244 scm_evict_ports (int fd
)
246 scm_c_port_for_each (scm_i_evict_port
, (void *) &fd
);
250 SCM_DEFINE (scm_file_port_p
, "file-port?", 1, 0, 0,
252 "Determine whether @var{obj} is a port that is related to a file.")
253 #define FUNC_NAME s_scm_file_port_p
255 return scm_from_bool (SCM_FPORTP (obj
));
261 * Return a new port open on a given file.
263 * The mode string must match the pattern: [rwa+]** which
264 * is interpreted in the usual unix way.
266 * Return the new port.
268 SCM_DEFINE (scm_open_file
, "open-file", 2, 0, 0,
269 (SCM filename
, SCM mode
),
270 "Open the file whose name is @var{filename}, and return a port\n"
271 "representing that file. The attributes of the port are\n"
272 "determined by the @var{mode} string. The way in which this is\n"
273 "interpreted is similar to C stdio. The first character must be\n"
274 "one of the following:\n"
277 "Open an existing file for input.\n"
279 "Open a file for output, creating it if it doesn't already exist\n"
280 "or removing its contents if it does.\n"
282 "Open a file for output, creating it if it doesn't already\n"
283 "exist. All writes to the port will go to the end of the file.\n"
284 "The \"append mode\" can be turned off while the port is in use\n"
285 "@pxref{Ports and File Descriptors, fcntl}\n"
287 "The following additional characters can be appended:\n"
290 "Open the underlying file in binary mode, if supported by the operating system. "
292 "Open the port for both input and output. E.g., @code{r+}: open\n"
293 "an existing file for both input and output.\n"
295 "Create an \"unbuffered\" port. In this case input and output\n"
296 "operations are passed directly to the underlying port\n"
297 "implementation without additional buffering. This is likely to\n"
298 "slow down I/O operations. The buffering mode can be changed\n"
299 "while a port is in use @pxref{Ports and File Descriptors,\n"
302 "Add line-buffering to the port. The port output buffer will be\n"
303 "automatically flushed whenever a newline character is written.\n"
305 "In theory we could create read/write ports which were buffered\n"
306 "in one direction only. However this isn't included in the\n"
307 "current interfaces. If a file cannot be opened with the access\n"
308 "requested, @code{open-file} throws an exception.")
309 #define FUNC_NAME s_scm_open_file
318 scm_dynwind_begin (0);
320 file
= scm_to_locale_string (filename
);
321 scm_dynwind_free (file
);
323 md
= scm_to_locale_string (mode
);
324 scm_dynwind_free (md
);
332 flags
|= O_WRONLY
| O_CREAT
| O_TRUNC
;
335 flags
|= O_WRONLY
| O_CREAT
| O_APPEND
;
338 scm_out_of_range (FUNC_NAME
, mode
);
346 flags
= (flags
& ~(O_RDONLY
| O_WRONLY
)) | O_RDWR
;
349 #if defined (O_BINARY)
353 case '0': /* unbuffered: handled later. */
354 case 'l': /* line buffered: handled during output. */
357 scm_out_of_range (FUNC_NAME
, mode
);
361 SCM_SYSCALL (fdes
= open_or_open64 (file
, flags
, 0666));
366 SCM_SYSERROR_MSG ("~A: ~S",
367 scm_cons (scm_strerror (scm_from_int (en
)),
368 scm_cons (filename
, SCM_EOL
)), en
);
370 port
= scm_i_fdes_to_port (fdes
, scm_i_mode_bits (mode
), filename
);
381 * Try getting the appropiate file flags for a given file descriptor
382 * under Windows. This incorporates some fancy operations because Windows
383 * differentiates between file, pipe and socket descriptors.
386 # define O_ACCMODE 0x0003
389 static int getflags (int fdes
)
393 int error
, optlen
= sizeof (int);
395 /* Is this a socket ? */
396 if (getsockopt (fdes
, SOL_SOCKET
, SO_ERROR
, (void *) &error
, &optlen
) >= 0)
398 /* Maybe a regular file ? */
399 else if (fstat (fdes
, &buf
) < 0)
403 /* Or an anonymous pipe handle ? */
404 if (buf
.st_mode
& _S_IFIFO
)
405 flags
= PeekNamedPipe ((HANDLE
) _get_osfhandle (fdes
), NULL
, 0,
406 NULL
, NULL
, NULL
) ? O_RDONLY
: O_WRONLY
;
408 else if (fdes
== fileno (stdin
) && isatty (fdes
))
410 /* stdout / stderr ? */
411 else if ((fdes
== fileno (stdout
) || fdes
== fileno (stderr
)) &&
419 #endif /* __MINGW32__ */
421 /* Building Guile ports from a file descriptor. */
423 /* Build a Scheme port from an open file descriptor `fdes'.
424 MODE indicates whether FILE is open for reading or writing; it uses
425 the same notation as open-file's second argument.
426 NAME is a string to be used as the port's filename.
429 scm_i_fdes_to_port (int fdes
, long mode_bits
, SCM name
)
430 #define FUNC_NAME "scm_fdes_to_port"
436 /* test that fdes is valid. */
438 flags
= getflags (fdes
);
440 flags
= fcntl (fdes
, F_GETFL
, 0);
446 && ((flags
!= O_WRONLY
&& (mode_bits
& SCM_WRTNG
))
447 || (flags
!= O_RDONLY
&& (mode_bits
& SCM_RDNG
))))
449 SCM_MISC_ERROR ("requested file mode not available on fdes", SCM_EOL
);
452 scm_i_scm_pthread_mutex_lock (&scm_i_port_table_mutex
);
454 port
= scm_new_port_table_entry (scm_tc16_fport
);
455 SCM_SET_CELL_TYPE(port
, scm_tc16_fport
| mode_bits
);
456 pt
= SCM_PTAB_ENTRY(port
);
459 = (scm_t_fport
*) scm_gc_malloc (sizeof (scm_t_fport
), "file port");
462 pt
->rw_random
= SCM_FDES_RANDOM_P (fdes
);
463 SCM_SETSTREAM (port
, fp
);
464 if (mode_bits
& SCM_BUF0
)
465 scm_fport_buffer_add (port
, 0, 0);
467 scm_fport_buffer_add (port
, -1, -1);
469 SCM_SET_FILENAME (port
, name
);
470 scm_i_pthread_mutex_unlock (&scm_i_port_table_mutex
);
476 scm_fdes_to_port (int fdes
, char *mode
, SCM name
)
478 return scm_i_fdes_to_port (fdes
, scm_mode_bits (mode
), name
);
481 /* Return a lower bound on the number of bytes available for input. */
483 fport_input_waiting (SCM port
)
486 int fdes
= SCM_FSTREAM (port
)->fdes
;
487 struct timeval timeout
;
488 SELECT_TYPE read_set
;
489 SELECT_TYPE write_set
;
490 SELECT_TYPE except_set
;
493 FD_ZERO (&write_set
);
494 FD_ZERO (&except_set
);
496 FD_SET (fdes
, &read_set
);
501 if (select (SELECT_SET_SIZE
,
502 &read_set
, &write_set
, &except_set
, &timeout
)
504 scm_syserror ("fport_input_waiting");
505 return FD_ISSET (fdes
, &read_set
) ? 1 : 0;
507 #elif HAVE_IOCTL && defined (FIONREAD)
508 /* Note: cannot test just defined(FIONREAD) here, since mingw has FIONREAD
509 (for use with winsock ioctlsocket()) but not ioctl(). */
510 int fdes
= SCM_FSTREAM (port
)->fdes
;
512 ioctl(fdes
, FIONREAD
, &remir
);
516 scm_misc_error ("fport_input_waiting",
517 "Not fully implemented on this platform",
524 fport_print (SCM exp
, SCM port
, scm_print_state
*pstate SCM_UNUSED
)
526 scm_puts ("#<", port
);
527 scm_print_port_mode (exp
, port
);
528 if (SCM_OPFPORTP (exp
))
531 SCM name
= SCM_FILENAME (exp
);
532 if (scm_is_string (name
) || scm_is_symbol (name
))
533 scm_display (name
, port
);
535 scm_puts (SCM_PTOBNAME (SCM_PTOBNUM (exp
)), port
);
536 scm_putc (' ', port
);
537 fdes
= (SCM_FSTREAM (exp
))->fdes
;
541 scm_display (scm_ttyname (exp
), port
);
543 #endif /* HAVE_TTYNAME */
544 scm_intprint (fdes
, 10, port
);
548 scm_puts (SCM_PTOBNAME (SCM_PTOBNUM (exp
)), port
);
549 scm_putc (' ', port
);
550 scm_uintprint ((scm_t_bits
) SCM_PTAB_ENTRY (exp
), 16, port
);
552 scm_putc ('>', port
);
557 /* thread-local block for input on fport's fdes. */
559 fport_wait_for_input (SCM port
)
561 int fdes
= SCM_FSTREAM (port
)->fdes
;
563 if (!fport_input_waiting (port
))
567 int flags
= fcntl (fdes
, F_GETFL
);
570 scm_syserror ("scm_fdes_wait_for_input");
571 if (!(flags
& O_NONBLOCK
))
575 FD_SET (fdes
, &readfds
);
576 n
= scm_std_select (fdes
+ 1, &readfds
, NULL
, NULL
, NULL
);
578 while (n
== -1 && errno
== EINTR
);
581 #endif /* !__MINGW32__ */
583 static void fport_flush (SCM port
);
585 /* fill a port's read-buffer with a single read. returns the first
586 char or EOF if end of file. */
588 fport_fill_input (SCM port
)
591 scm_t_port
*pt
= SCM_PTAB_ENTRY (port
);
592 scm_t_fport
*fp
= SCM_FSTREAM (port
);
595 fport_wait_for_input (port
);
596 #endif /* !__MINGW32__ */
597 SCM_SYSCALL (count
= read (fp
->fdes
, pt
->read_buf
, pt
->read_buf_size
));
599 scm_syserror ("fport_fill_input");
604 pt
->read_pos
= pt
->read_buf
;
605 pt
->read_end
= pt
->read_buf
+ count
;
606 return *pt
->read_buf
;
610 static off_t_or_off64_t
611 fport_seek_or_seek64 (SCM port
, off_t_or_off64_t offset
, int whence
)
613 scm_t_port
*pt
= SCM_PTAB_ENTRY (port
);
614 scm_t_fport
*fp
= SCM_FSTREAM (port
);
616 off_t_or_off64_t result
;
618 if (pt
->rw_active
== SCM_PORT_WRITE
)
620 if (offset
!= 0 || whence
!= SEEK_CUR
)
623 result
= rv
= lseek_or_lseek64 (fp
->fdes
, offset
, whence
);
627 /* read current position without disturbing the buffer. */
628 rv
= lseek_or_lseek64 (fp
->fdes
, offset
, whence
);
629 result
= rv
+ (pt
->write_pos
- pt
->write_buf
);
632 else if (pt
->rw_active
== SCM_PORT_READ
)
634 if (offset
!= 0 || whence
!= SEEK_CUR
)
636 /* could expand to avoid a second seek. */
637 scm_end_input (port
);
638 result
= rv
= lseek_or_lseek64 (fp
->fdes
, offset
, whence
);
642 /* read current position without disturbing the buffer
643 (particularly the unread-char buffer). */
644 rv
= lseek_or_lseek64 (fp
->fdes
, offset
, whence
);
645 result
= rv
- (pt
->read_end
- pt
->read_pos
);
647 if (pt
->read_buf
== pt
->putback_buf
)
648 result
-= pt
->saved_read_end
- pt
->saved_read_pos
;
651 else /* SCM_PORT_NEITHER */
653 result
= rv
= lseek_or_lseek64 (fp
->fdes
, offset
, whence
);
657 scm_syserror ("fport_seek");
662 /* If we've got largefile and off_t isn't already off64_t then
663 fport_seek_or_seek64 needs a range checking wrapper to be fport_seek in
666 Otherwise if no largefile, or off_t is the same as off64_t (which is the
667 case on NetBSD apparently), then fport_seek_or_seek64 is right to be
668 fport_seek already. */
670 #if GUILE_USE_64_CALLS && HAVE_STAT64 && SIZEOF_OFF_T != SIZEOF_OFF64_T
672 fport_seek (SCM port
, off_t offset
, int whence
)
674 off64_t rv
= fport_seek_or_seek64 (port
, (off64_t
) offset
, whence
);
675 if (rv
> OFF_T_MAX
|| rv
< OFF_T_MIN
)
678 scm_syserror ("fport_seek");
684 #define fport_seek fport_seek_or_seek64
687 /* `how' has been validated and is one of SEEK_SET, SEEK_CUR or SEEK_END */
689 scm_i_fport_seek (SCM port
, SCM offset
, int how
)
691 return scm_from_off_t_or_off64_t
692 (fport_seek_or_seek64 (port
, scm_to_off_t_or_off64_t (offset
), how
));
696 fport_truncate (SCM port
, off_t length
)
698 scm_t_fport
*fp
= SCM_FSTREAM (port
);
700 if (ftruncate (fp
->fdes
, length
) == -1)
701 scm_syserror ("ftruncate");
705 scm_i_fport_truncate (SCM port
, SCM length
)
707 scm_t_fport
*fp
= SCM_FSTREAM (port
);
708 return ftruncate_or_ftruncate64 (fp
->fdes
, scm_to_off_t_or_off64_t (length
));
711 /* helper for fport_write: try to write data, using multiple system
712 calls if required. */
713 #define FUNC_NAME "write_all"
714 static void write_all (SCM port
, const void *data
, size_t remaining
)
716 int fdes
= SCM_FSTREAM (port
)->fdes
;
718 while (remaining
> 0)
722 SCM_SYSCALL (done
= write (fdes
, data
, remaining
));
727 data
= ((const char *) data
) + done
;
733 fport_write (SCM port
, const void *data
, size_t size
)
735 /* this procedure tries to minimize the number of writes/flushes. */
736 scm_t_port
*pt
= SCM_PTAB_ENTRY (port
);
738 if (pt
->write_buf
== &pt
->shortbuf
739 || (pt
->write_pos
== pt
->write_buf
&& size
>= pt
->write_buf_size
))
741 /* "unbuffered" port, or
742 port with empty buffer and data won't fit in buffer. */
743 write_all (port
, data
, size
);
748 off_t space
= pt
->write_end
- pt
->write_pos
;
752 /* data fits in buffer. */
753 memcpy (pt
->write_pos
, data
, size
);
754 pt
->write_pos
+= size
;
755 if (pt
->write_pos
== pt
->write_end
)
758 /* we can skip the line-buffering check if nothing's buffered. */
764 memcpy (pt
->write_pos
, data
, space
);
765 pt
->write_pos
= pt
->write_end
;
768 const void *ptr
= ((const char *) data
) + space
;
769 size_t remaining
= size
- space
;
771 if (size
>= pt
->write_buf_size
)
773 write_all (port
, ptr
, remaining
);
778 memcpy (pt
->write_pos
, ptr
, remaining
);
779 pt
->write_pos
+= remaining
;
784 /* handle line buffering. */
785 if ((SCM_CELL_WORD_0 (port
) & SCM_BUFLINE
) && memchr (data
, '\n', size
))
790 /* becomes 1 when process is exiting: normal exception handling won't
791 work by this time. */
792 extern int scm_i_terminating
;
795 fport_flush (SCM port
)
797 scm_t_port
*pt
= SCM_PTAB_ENTRY (port
);
798 scm_t_fport
*fp
= SCM_FSTREAM (port
);
799 unsigned char *ptr
= pt
->write_buf
;
800 long init_size
= pt
->write_pos
- pt
->write_buf
;
801 long remaining
= init_size
;
803 while (remaining
> 0)
807 SCM_SYSCALL (count
= write (fp
->fdes
, ptr
, remaining
));
810 /* error. assume nothing was written this call, but
811 fix up the buffer for any previous successful writes. */
812 long done
= init_size
- remaining
;
818 for (i
= 0; i
< remaining
; i
++)
820 *(pt
->write_buf
+ i
) = *(pt
->write_buf
+ done
+ i
);
822 pt
->write_pos
= pt
->write_buf
+ remaining
;
824 if (scm_i_terminating
)
826 const char *msg
= "Error: could not flush file-descriptor ";
829 write (2, msg
, strlen (msg
));
830 sprintf (buf
, "%d\n", fp
->fdes
);
831 write (2, buf
, strlen (buf
));
835 else if (scm_gc_running_p
)
837 /* silently ignore the error. scm_error would abort if we
842 scm_syserror ("fport_flush");
847 pt
->write_pos
= pt
->write_buf
;
848 pt
->rw_active
= SCM_PORT_NEITHER
;
851 /* clear the read buffer and adjust the file position for unread bytes. */
853 fport_end_input (SCM port
, int offset
)
855 scm_t_fport
*fp
= SCM_FSTREAM (port
);
856 scm_t_port
*pt
= SCM_PTAB_ENTRY (port
);
858 offset
+= pt
->read_end
- pt
->read_pos
;
862 pt
->read_pos
= pt
->read_end
;
863 /* will throw error if unread-char used at beginning of file
864 then attempting to write. seems correct. */
865 if (lseek (fp
->fdes
, -offset
, SEEK_CUR
) == -1)
866 scm_syserror ("fport_end_input");
868 pt
->rw_active
= SCM_PORT_NEITHER
;
872 fport_close (SCM port
)
874 scm_t_fport
*fp
= SCM_FSTREAM (port
);
875 scm_t_port
*pt
= SCM_PTAB_ENTRY (port
);
879 SCM_SYSCALL (rv
= close (fp
->fdes
));
880 if (rv
== -1 && errno
!= EBADF
)
882 if (scm_gc_running_p
)
883 /* silently ignore the error. scm_error would abort if we
887 scm_syserror ("fport_close");
889 if (pt
->read_buf
== pt
->putback_buf
)
890 pt
->read_buf
= pt
->saved_read_buf
;
891 if (pt
->read_buf
!= &pt
->shortbuf
)
892 scm_gc_free (pt
->read_buf
, pt
->read_buf_size
, "port buffer");
893 if (pt
->write_buf
!= &pt
->shortbuf
)
894 scm_gc_free (pt
->write_buf
, pt
->write_buf_size
, "port buffer");
895 scm_gc_free (fp
, sizeof (*fp
), "file port");
900 fport_free (SCM port
)
909 scm_t_bits tc
= scm_make_port_type ("file", fport_fill_input
, fport_write
);
911 scm_set_port_free (tc
, fport_free
);
912 scm_set_port_print (tc
, fport_print
);
913 scm_set_port_flush (tc
, fport_flush
);
914 scm_set_port_end_input (tc
, fport_end_input
);
915 scm_set_port_close (tc
, fport_close
);
916 scm_set_port_seek (tc
, fport_seek
);
917 scm_set_port_truncate (tc
, fport_truncate
);
918 scm_set_port_input_waiting (tc
, fport_input_waiting
);
926 scm_tc16_fport
= scm_make_fptob ();
928 scm_c_define ("_IOFBF", scm_from_int (_IOFBF
));
929 scm_c_define ("_IOLBF", scm_from_int (_IOLBF
));
930 scm_c_define ("_IONBF", scm_from_int (_IONBF
));
932 #include "libguile/fports.x"