1 /* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2003, 2004, 2006, 2007, 2008 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 #include <full-write.h>
64 /* Mingw (version 3.4.5, circa 2006) has ftruncate as an alias for chsize
65 already, but have this code here in case that wasn't so in past versions,
66 or perhaps to help other minimal DOS environments.
68 gnulib ftruncate.c has code using fcntl F_CHSIZE and F_FREESP, which
69 might be possibilities if we've got other systems without ftruncate. */
71 #if HAVE_CHSIZE && ! HAVE_FTRUNCATE
72 # define ftruncate(fd, size) chsize (fd, size)
74 #define HAVE_FTRUNCATE 1
77 #if SIZEOF_OFF_T == SIZEOF_INT
78 #define OFF_T_MAX INT_MAX
79 #define OFF_T_MIN INT_MIN
80 #elif SIZEOF_OFF_T == SIZEOF_LONG
81 #define OFF_T_MAX LONG_MAX
82 #define OFF_T_MIN LONG_MIN
83 #elif SIZEOF_OFF_T == SIZEOF_LONG_LONG
84 #define OFF_T_MAX LONG_LONG_MAX
85 #define OFF_T_MIN LONG_LONG_MIN
87 #error Oops, unknown OFF_T size
90 scm_t_bits scm_tc16_fport
;
93 /* default buffer size, used if the O/S won't supply a value. */
94 static const size_t default_buffer_size
= 1024;
96 /* create FPORT buffer with specified sizes (or -1 to use default size or
99 scm_fport_buffer_add (SCM port
, long read_size
, int write_size
)
100 #define FUNC_NAME "scm_fport_buffer_add"
102 scm_t_port
*pt
= SCM_PTAB_ENTRY (port
);
104 if (read_size
== -1 || write_size
== -1)
107 #ifdef HAVE_STRUCT_STAT_ST_BLKSIZE
109 scm_t_fport
*fp
= SCM_FSTREAM (port
);
111 default_size
= (fstat (fp
->fdes
, &st
) == -1) ? default_buffer_size
114 default_size
= default_buffer_size
;
117 read_size
= default_size
;
118 if (write_size
== -1)
119 write_size
= default_size
;
122 if (SCM_INPUT_PORT_P (port
) && read_size
> 0)
124 pt
->read_buf
= scm_gc_malloc (read_size
, "port buffer");
125 pt
->read_pos
= pt
->read_end
= pt
->read_buf
;
126 pt
->read_buf_size
= read_size
;
130 pt
->read_pos
= pt
->read_buf
= pt
->read_end
= &pt
->shortbuf
;
131 pt
->read_buf_size
= 1;
134 if (SCM_OUTPUT_PORT_P (port
) && write_size
> 0)
136 pt
->write_buf
= scm_gc_malloc (write_size
, "port buffer");
137 pt
->write_pos
= pt
->write_buf
;
138 pt
->write_buf_size
= write_size
;
142 pt
->write_buf
= pt
->write_pos
= &pt
->shortbuf
;
143 pt
->write_buf_size
= 1;
146 pt
->write_end
= pt
->write_buf
+ pt
->write_buf_size
;
147 if (read_size
> 0 || write_size
> 0)
148 SCM_SET_CELL_WORD_0 (port
, SCM_CELL_WORD_0 (port
) & ~SCM_BUF0
);
150 SCM_SET_CELL_WORD_0 (port
, SCM_CELL_WORD_0 (port
) | SCM_BUF0
);
154 SCM_DEFINE (scm_setvbuf
, "setvbuf", 2, 1, 0,
155 (SCM port
, SCM mode
, SCM size
),
156 "Set the buffering mode for @var{port}. @var{mode} can be:\n"
163 "block buffered, using a newly allocated buffer of @var{size} bytes.\n"
164 "If @var{size} is omitted, a default size will be used.\n"
166 #define FUNC_NAME s_scm_setvbuf
172 port
= SCM_COERCE_OUTPORT (port
);
174 SCM_VALIDATE_OPFPORT (1,port
);
175 cmode
= scm_to_int (mode
);
176 if (cmode
!= _IONBF
&& cmode
!= _IOFBF
&& cmode
!= _IOLBF
)
177 scm_out_of_range (FUNC_NAME
, mode
);
181 SCM_SET_CELL_WORD_0 (port
, SCM_CELL_WORD_0 (port
) | SCM_BUFLINE
);
186 SCM_SET_CELL_WORD_0 (port
, SCM_CELL_WORD_0 (port
) & ~(scm_t_bits
)SCM_BUFLINE
);
189 if (SCM_UNBNDP (size
))
198 csize
= scm_to_int (size
);
199 if (csize
< 0 || (cmode
== _IONBF
&& csize
> 0))
200 scm_out_of_range (FUNC_NAME
, size
);
203 pt
= SCM_PTAB_ENTRY (port
);
205 /* silently discards buffered and put-back chars. */
206 if (pt
->read_buf
== pt
->putback_buf
)
208 pt
->read_buf
= pt
->saved_read_buf
;
209 pt
->read_pos
= pt
->saved_read_pos
;
210 pt
->read_end
= pt
->saved_read_end
;
211 pt
->read_buf_size
= pt
->saved_read_buf_size
;
213 if (pt
->read_buf
!= &pt
->shortbuf
)
214 scm_gc_free (pt
->read_buf
, pt
->read_buf_size
, "port buffer");
215 if (pt
->write_buf
!= &pt
->shortbuf
)
216 scm_gc_free (pt
->write_buf
, pt
->write_buf_size
, "port buffer");
218 scm_fport_buffer_add (port
, csize
, csize
);
219 return SCM_UNSPECIFIED
;
223 /* Move ports with the specified file descriptor to new descriptors,
224 * resetting the revealed count to 0.
227 scm_i_evict_port (void *closure
, SCM port
)
229 int fd
= * (int*) closure
;
231 if (SCM_FPORTP (port
))
233 scm_t_fport
*fp
= SCM_FSTREAM (port
);
239 scm_syserror ("scm_evict_ports");
240 scm_set_port_revealed_x (port
, scm_from_int (0));
246 scm_evict_ports (int fd
)
248 scm_c_port_for_each (scm_i_evict_port
, (void *) &fd
);
252 SCM_DEFINE (scm_file_port_p
, "file-port?", 1, 0, 0,
254 "Determine whether @var{obj} is a port that is related to a file.")
255 #define FUNC_NAME s_scm_file_port_p
257 return scm_from_bool (SCM_FPORTP (obj
));
263 * Return a new port open on a given file.
265 * The mode string must match the pattern: [rwa+]** which
266 * is interpreted in the usual unix way.
268 * Return the new port.
270 SCM_DEFINE (scm_open_file
, "open-file", 2, 0, 0,
271 (SCM filename
, SCM mode
),
272 "Open the file whose name is @var{filename}, and return a port\n"
273 "representing that file. The attributes of the port are\n"
274 "determined by the @var{mode} string. The way in which this is\n"
275 "interpreted is similar to C stdio. The first character must be\n"
276 "one of the following:\n"
279 "Open an existing file for input.\n"
281 "Open a file for output, creating it if it doesn't already exist\n"
282 "or removing its contents if it does.\n"
284 "Open a file for output, creating it if it doesn't already\n"
285 "exist. All writes to the port will go to the end of the file.\n"
286 "The \"append mode\" can be turned off while the port is in use\n"
287 "@pxref{Ports and File Descriptors, fcntl}\n"
289 "The following additional characters can be appended:\n"
292 "Open the underlying file in binary mode, if supported by the operating system. "
294 "Open the port for both input and output. E.g., @code{r+}: open\n"
295 "an existing file for both input and output.\n"
297 "Create an \"unbuffered\" port. In this case input and output\n"
298 "operations are passed directly to the underlying port\n"
299 "implementation without additional buffering. This is likely to\n"
300 "slow down I/O operations. The buffering mode can be changed\n"
301 "while a port is in use @pxref{Ports and File Descriptors,\n"
304 "Add line-buffering to the port. The port output buffer will be\n"
305 "automatically flushed whenever a newline character is written.\n"
307 "In theory we could create read/write ports which were buffered\n"
308 "in one direction only. However this isn't included in the\n"
309 "current interfaces. If a file cannot be opened with the access\n"
310 "requested, @code{open-file} throws an exception.")
311 #define FUNC_NAME s_scm_open_file
320 scm_dynwind_begin (0);
322 file
= scm_to_locale_string (filename
);
323 scm_dynwind_free (file
);
325 md
= scm_to_locale_string (mode
);
326 scm_dynwind_free (md
);
334 flags
|= O_WRONLY
| O_CREAT
| O_TRUNC
;
337 flags
|= O_WRONLY
| O_CREAT
| O_APPEND
;
340 scm_out_of_range (FUNC_NAME
, mode
);
348 flags
= (flags
& ~(O_RDONLY
| O_WRONLY
)) | O_RDWR
;
351 #if defined (O_BINARY)
355 case '0': /* unbuffered: handled later. */
356 case 'l': /* line buffered: handled during output. */
359 scm_out_of_range (FUNC_NAME
, mode
);
363 SCM_SYSCALL (fdes
= open_or_open64 (file
, flags
, 0666));
368 SCM_SYSERROR_MSG ("~A: ~S",
369 scm_cons (scm_strerror (scm_from_int (en
)),
370 scm_cons (filename
, SCM_EOL
)), en
);
372 port
= scm_i_fdes_to_port (fdes
, scm_i_mode_bits (mode
), filename
);
383 * Try getting the appropiate file flags for a given file descriptor
384 * under Windows. This incorporates some fancy operations because Windows
385 * differentiates between file, pipe and socket descriptors.
388 # define O_ACCMODE 0x0003
391 static int getflags (int fdes
)
395 int error
, optlen
= sizeof (int);
397 /* Is this a socket ? */
398 if (getsockopt (fdes
, SOL_SOCKET
, SO_ERROR
, (void *) &error
, &optlen
) >= 0)
400 /* Maybe a regular file ? */
401 else if (fstat (fdes
, &buf
) < 0)
405 /* Or an anonymous pipe handle ? */
406 if (buf
.st_mode
& _S_IFIFO
)
407 flags
= PeekNamedPipe ((HANDLE
) _get_osfhandle (fdes
), NULL
, 0,
408 NULL
, NULL
, NULL
) ? O_RDONLY
: O_WRONLY
;
410 else if (fdes
== fileno (stdin
) && isatty (fdes
))
412 /* stdout / stderr ? */
413 else if ((fdes
== fileno (stdout
) || fdes
== fileno (stderr
)) &&
421 #endif /* __MINGW32__ */
423 /* Building Guile ports from a file descriptor. */
425 /* Build a Scheme port from an open file descriptor `fdes'.
426 MODE indicates whether FILE is open for reading or writing; it uses
427 the same notation as open-file's second argument.
428 NAME is a string to be used as the port's filename.
431 scm_i_fdes_to_port (int fdes
, long mode_bits
, SCM name
)
432 #define FUNC_NAME "scm_fdes_to_port"
438 /* test that fdes is valid. */
440 flags
= getflags (fdes
);
442 flags
= fcntl (fdes
, F_GETFL
, 0);
448 && ((flags
!= O_WRONLY
&& (mode_bits
& SCM_WRTNG
))
449 || (flags
!= O_RDONLY
&& (mode_bits
& SCM_RDNG
))))
451 SCM_MISC_ERROR ("requested file mode not available on fdes", SCM_EOL
);
454 scm_i_scm_pthread_mutex_lock (&scm_i_port_table_mutex
);
456 port
= scm_new_port_table_entry (scm_tc16_fport
);
457 SCM_SET_CELL_TYPE(port
, scm_tc16_fport
| mode_bits
);
458 pt
= SCM_PTAB_ENTRY(port
);
461 = (scm_t_fport
*) scm_gc_malloc (sizeof (scm_t_fport
), "file port");
464 pt
->rw_random
= SCM_FDES_RANDOM_P (fdes
);
465 SCM_SETSTREAM (port
, fp
);
466 if (mode_bits
& SCM_BUF0
)
467 scm_fport_buffer_add (port
, 0, 0);
469 scm_fport_buffer_add (port
, -1, -1);
471 SCM_SET_FILENAME (port
, name
);
472 scm_i_pthread_mutex_unlock (&scm_i_port_table_mutex
);
478 scm_fdes_to_port (int fdes
, char *mode
, SCM name
)
480 return scm_i_fdes_to_port (fdes
, scm_mode_bits (mode
), name
);
483 /* Return a lower bound on the number of bytes available for input. */
485 fport_input_waiting (SCM port
)
488 int fdes
= SCM_FSTREAM (port
)->fdes
;
489 struct timeval timeout
;
490 SELECT_TYPE read_set
;
491 SELECT_TYPE write_set
;
492 SELECT_TYPE except_set
;
495 FD_ZERO (&write_set
);
496 FD_ZERO (&except_set
);
498 FD_SET (fdes
, &read_set
);
503 if (select (SELECT_SET_SIZE
,
504 &read_set
, &write_set
, &except_set
, &timeout
)
506 scm_syserror ("fport_input_waiting");
507 return FD_ISSET (fdes
, &read_set
) ? 1 : 0;
509 #elif HAVE_IOCTL && defined (FIONREAD)
510 /* Note: cannot test just defined(FIONREAD) here, since mingw has FIONREAD
511 (for use with winsock ioctlsocket()) but not ioctl(). */
512 int fdes
= SCM_FSTREAM (port
)->fdes
;
514 ioctl(fdes
, FIONREAD
, &remir
);
518 scm_misc_error ("fport_input_waiting",
519 "Not fully implemented on this platform",
526 fport_print (SCM exp
, SCM port
, scm_print_state
*pstate SCM_UNUSED
)
528 scm_puts ("#<", port
);
529 scm_print_port_mode (exp
, port
);
530 if (SCM_OPFPORTP (exp
))
533 SCM name
= SCM_FILENAME (exp
);
534 if (scm_is_string (name
) || scm_is_symbol (name
))
535 scm_display (name
, port
);
537 scm_puts (SCM_PTOBNAME (SCM_PTOBNUM (exp
)), port
);
538 scm_putc (' ', port
);
539 fdes
= (SCM_FSTREAM (exp
))->fdes
;
543 scm_display (scm_ttyname (exp
), port
);
545 #endif /* HAVE_TTYNAME */
546 scm_intprint (fdes
, 10, port
);
550 scm_puts (SCM_PTOBNAME (SCM_PTOBNUM (exp
)), port
);
551 scm_putc (' ', port
);
552 scm_uintprint ((scm_t_bits
) SCM_PTAB_ENTRY (exp
), 16, port
);
554 scm_putc ('>', port
);
559 /* thread-local block for input on fport's fdes. */
561 fport_wait_for_input (SCM port
)
563 int fdes
= SCM_FSTREAM (port
)->fdes
;
565 if (!fport_input_waiting (port
))
569 int flags
= fcntl (fdes
, F_GETFL
);
572 scm_syserror ("scm_fdes_wait_for_input");
573 if (!(flags
& O_NONBLOCK
))
577 FD_SET (fdes
, &readfds
);
578 n
= scm_std_select (fdes
+ 1, &readfds
, NULL
, NULL
, NULL
);
580 while (n
== -1 && errno
== EINTR
);
583 #endif /* !__MINGW32__ */
585 static void fport_flush (SCM port
);
587 /* fill a port's read-buffer with a single read. returns the first
588 char or EOF if end of file. */
590 fport_fill_input (SCM port
)
593 scm_t_port
*pt
= SCM_PTAB_ENTRY (port
);
594 scm_t_fport
*fp
= SCM_FSTREAM (port
);
597 fport_wait_for_input (port
);
598 #endif /* !__MINGW32__ */
599 SCM_SYSCALL (count
= read (fp
->fdes
, pt
->read_buf
, pt
->read_buf_size
));
601 scm_syserror ("fport_fill_input");
606 pt
->read_pos
= pt
->read_buf
;
607 pt
->read_end
= pt
->read_buf
+ count
;
608 return *pt
->read_buf
;
612 static off_t_or_off64_t
613 fport_seek_or_seek64 (SCM port
, off_t_or_off64_t offset
, int whence
)
615 scm_t_port
*pt
= SCM_PTAB_ENTRY (port
);
616 scm_t_fport
*fp
= SCM_FSTREAM (port
);
618 off_t_or_off64_t result
;
620 if (pt
->rw_active
== SCM_PORT_WRITE
)
622 if (offset
!= 0 || whence
!= SEEK_CUR
)
625 result
= rv
= lseek_or_lseek64 (fp
->fdes
, offset
, whence
);
629 /* read current position without disturbing the buffer. */
630 rv
= lseek_or_lseek64 (fp
->fdes
, offset
, whence
);
631 result
= rv
+ (pt
->write_pos
- pt
->write_buf
);
634 else if (pt
->rw_active
== SCM_PORT_READ
)
636 if (offset
!= 0 || whence
!= SEEK_CUR
)
638 /* could expand to avoid a second seek. */
639 scm_end_input (port
);
640 result
= rv
= lseek_or_lseek64 (fp
->fdes
, offset
, whence
);
644 /* read current position without disturbing the buffer
645 (particularly the unread-char buffer). */
646 rv
= lseek_or_lseek64 (fp
->fdes
, offset
, whence
);
647 result
= rv
- (pt
->read_end
- pt
->read_pos
);
649 if (pt
->read_buf
== pt
->putback_buf
)
650 result
-= pt
->saved_read_end
- pt
->saved_read_pos
;
653 else /* SCM_PORT_NEITHER */
655 result
= rv
= lseek_or_lseek64 (fp
->fdes
, offset
, whence
);
659 scm_syserror ("fport_seek");
664 /* If we've got largefile and off_t isn't already off64_t then
665 fport_seek_or_seek64 needs a range checking wrapper to be fport_seek in
668 Otherwise if no largefile, or off_t is the same as off64_t (which is the
669 case on NetBSD apparently), then fport_seek_or_seek64 is right to be
670 fport_seek already. */
672 #if GUILE_USE_64_CALLS && HAVE_STAT64 && SIZEOF_OFF_T != SIZEOF_OFF64_T
674 fport_seek (SCM port
, off_t offset
, int whence
)
676 off64_t rv
= fport_seek_or_seek64 (port
, (off64_t
) offset
, whence
);
677 if (rv
> OFF_T_MAX
|| rv
< OFF_T_MIN
)
680 scm_syserror ("fport_seek");
686 #define fport_seek fport_seek_or_seek64
689 /* `how' has been validated and is one of SEEK_SET, SEEK_CUR or SEEK_END */
691 scm_i_fport_seek (SCM port
, SCM offset
, int how
)
693 return scm_from_off_t_or_off64_t
694 (fport_seek_or_seek64 (port
, scm_to_off_t_or_off64_t (offset
), how
));
698 fport_truncate (SCM port
, off_t length
)
700 scm_t_fport
*fp
= SCM_FSTREAM (port
);
702 if (ftruncate (fp
->fdes
, length
) == -1)
703 scm_syserror ("ftruncate");
707 scm_i_fport_truncate (SCM port
, SCM length
)
709 scm_t_fport
*fp
= SCM_FSTREAM (port
);
710 return ftruncate_or_ftruncate64 (fp
->fdes
, scm_to_off_t_or_off64_t (length
));
713 /* helper for fport_write: try to write data, using multiple system
714 calls if required. */
715 #define FUNC_NAME "write_all"
716 static void write_all (SCM port
, const void *data
, size_t remaining
)
718 int fdes
= SCM_FSTREAM (port
)->fdes
;
720 while (remaining
> 0)
724 SCM_SYSCALL (done
= write (fdes
, data
, remaining
));
729 data
= ((const char *) data
) + done
;
735 fport_write (SCM port
, const void *data
, size_t size
)
737 /* this procedure tries to minimize the number of writes/flushes. */
738 scm_t_port
*pt
= SCM_PTAB_ENTRY (port
);
740 if (pt
->write_buf
== &pt
->shortbuf
741 || (pt
->write_pos
== pt
->write_buf
&& size
>= pt
->write_buf_size
))
743 /* "unbuffered" port, or
744 port with empty buffer and data won't fit in buffer. */
745 write_all (port
, data
, size
);
750 off_t space
= pt
->write_end
- pt
->write_pos
;
754 /* data fits in buffer. */
755 memcpy (pt
->write_pos
, data
, size
);
756 pt
->write_pos
+= size
;
757 if (pt
->write_pos
== pt
->write_end
)
760 /* we can skip the line-buffering check if nothing's buffered. */
766 memcpy (pt
->write_pos
, data
, space
);
767 pt
->write_pos
= pt
->write_end
;
770 const void *ptr
= ((const char *) data
) + space
;
771 size_t remaining
= size
- space
;
773 if (size
>= pt
->write_buf_size
)
775 write_all (port
, ptr
, remaining
);
780 memcpy (pt
->write_pos
, ptr
, remaining
);
781 pt
->write_pos
+= remaining
;
786 /* handle line buffering. */
787 if ((SCM_CELL_WORD_0 (port
) & SCM_BUFLINE
) && memchr (data
, '\n', size
))
792 /* becomes 1 when process is exiting: normal exception handling won't
793 work by this time. */
794 extern int scm_i_terminating
;
797 fport_flush (SCM port
)
799 scm_t_port
*pt
= SCM_PTAB_ENTRY (port
);
800 scm_t_fport
*fp
= SCM_FSTREAM (port
);
801 unsigned char *ptr
= pt
->write_buf
;
802 long init_size
= pt
->write_pos
- pt
->write_buf
;
803 long remaining
= init_size
;
805 while (remaining
> 0)
809 SCM_SYSCALL (count
= write (fp
->fdes
, ptr
, remaining
));
812 /* error. assume nothing was written this call, but
813 fix up the buffer for any previous successful writes. */
814 long done
= init_size
- remaining
;
820 for (i
= 0; i
< remaining
; i
++)
822 *(pt
->write_buf
+ i
) = *(pt
->write_buf
+ done
+ i
);
824 pt
->write_pos
= pt
->write_buf
+ remaining
;
826 if (scm_i_terminating
)
828 const char *msg
= "Error: could not flush file-descriptor ";
831 full_write (2, msg
, strlen (msg
));
832 sprintf (buf
, "%d\n", fp
->fdes
);
833 full_write (2, buf
, strlen (buf
));
837 else if (scm_gc_running_p
)
839 /* silently ignore the error. scm_error would abort if we
844 scm_syserror ("fport_flush");
849 pt
->write_pos
= pt
->write_buf
;
850 pt
->rw_active
= SCM_PORT_NEITHER
;
853 /* clear the read buffer and adjust the file position for unread bytes. */
855 fport_end_input (SCM port
, int offset
)
857 scm_t_fport
*fp
= SCM_FSTREAM (port
);
858 scm_t_port
*pt
= SCM_PTAB_ENTRY (port
);
860 offset
+= pt
->read_end
- pt
->read_pos
;
864 pt
->read_pos
= pt
->read_end
;
865 /* will throw error if unread-char used at beginning of file
866 then attempting to write. seems correct. */
867 if (lseek (fp
->fdes
, -offset
, SEEK_CUR
) == -1)
868 scm_syserror ("fport_end_input");
870 pt
->rw_active
= SCM_PORT_NEITHER
;
874 fport_close (SCM port
)
876 scm_t_fport
*fp
= SCM_FSTREAM (port
);
877 scm_t_port
*pt
= SCM_PTAB_ENTRY (port
);
881 SCM_SYSCALL (rv
= close (fp
->fdes
));
882 if (rv
== -1 && errno
!= EBADF
)
884 if (scm_gc_running_p
)
885 /* silently ignore the error. scm_error would abort if we
889 scm_syserror ("fport_close");
891 if (pt
->read_buf
== pt
->putback_buf
)
892 pt
->read_buf
= pt
->saved_read_buf
;
893 if (pt
->read_buf
!= &pt
->shortbuf
)
894 scm_gc_free (pt
->read_buf
, pt
->read_buf_size
, "port buffer");
895 if (pt
->write_buf
!= &pt
->shortbuf
)
896 scm_gc_free (pt
->write_buf
, pt
->write_buf_size
, "port buffer");
897 scm_gc_free (fp
, sizeof (*fp
), "file port");
902 fport_free (SCM port
)
911 scm_t_bits tc
= scm_make_port_type ("file", fport_fill_input
, fport_write
);
913 scm_set_port_free (tc
, fport_free
);
914 scm_set_port_print (tc
, fport_print
);
915 scm_set_port_flush (tc
, fport_flush
);
916 scm_set_port_end_input (tc
, fport_end_input
);
917 scm_set_port_close (tc
, fport_close
);
918 scm_set_port_seek (tc
, fport_seek
);
919 scm_set_port_truncate (tc
, fport_truncate
);
920 scm_set_port_input_waiting (tc
, fport_input_waiting
);
928 scm_tc16_fport
= scm_make_fptob ();
930 scm_c_define ("_IOFBF", scm_from_int (_IOFBF
));
931 scm_c_define ("_IOLBF", scm_from_int (_IOLBF
));
932 scm_c_define ("_IONBF", scm_from_int (_IONBF
));
934 #include "libguile/fports.x"