1 /* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2003, 2004, 2006, 2007, 2008, 2009, 2010 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 <full-write.h>
57 #include "libguile/iselect.h"
59 /* Some defines for Windows (native port, not Cygwin). */
61 # include <sys/stat.h>
62 # include <winsock2.h>
63 #endif /* __MINGW32__ */
65 #include <full-write.h>
67 /* Mingw (version 3.4.5, circa 2006) has ftruncate as an alias for chsize
68 already, but have this code here in case that wasn't so in past versions,
69 or perhaps to help other minimal DOS environments.
71 gnulib ftruncate.c has code using fcntl F_CHSIZE and F_FREESP, which
72 might be possibilities if we've got other systems without ftruncate. */
74 #if defined HAVE_CHSIZE && ! defined HAVE_FTRUNCATE
75 # define ftruncate(fd, size) chsize (fd, size)
76 # undef HAVE_FTRUNCATE
77 # define HAVE_FTRUNCATE 1
80 #if SIZEOF_OFF_T == SIZEOF_INT
81 #define OFF_T_MAX INT_MAX
82 #define OFF_T_MIN INT_MIN
83 #elif SIZEOF_OFF_T == SIZEOF_LONG
84 #define OFF_T_MAX LONG_MAX
85 #define OFF_T_MIN LONG_MIN
86 #elif SIZEOF_OFF_T == SIZEOF_LONG_LONG
87 #define OFF_T_MAX LONG_LONG_MAX
88 #define OFF_T_MIN LONG_LONG_MIN
90 #error Oops, unknown OFF_T size
93 scm_t_bits scm_tc16_fport
;
96 /* default buffer size, used if the O/S won't supply a value. */
97 static const size_t default_buffer_size
= 1024;
99 /* create FPORT buffer with specified sizes (or -1 to use default size or
102 scm_fport_buffer_add (SCM port
, long read_size
, int write_size
)
103 #define FUNC_NAME "scm_fport_buffer_add"
105 scm_t_port
*pt
= SCM_PTAB_ENTRY (port
);
107 if (read_size
== -1 || write_size
== -1)
110 #ifdef HAVE_STRUCT_STAT_ST_BLKSIZE
112 scm_t_fport
*fp
= SCM_FSTREAM (port
);
114 default_size
= (fstat (fp
->fdes
, &st
) == -1) ? default_buffer_size
117 default_size
= default_buffer_size
;
120 read_size
= default_size
;
121 if (write_size
== -1)
122 write_size
= default_size
;
125 if (SCM_INPUT_PORT_P (port
) && read_size
> 0)
127 pt
->read_buf
= scm_gc_malloc_pointerless (read_size
, "port buffer");
128 pt
->read_pos
= pt
->read_end
= pt
->read_buf
;
129 pt
->read_buf_size
= read_size
;
133 pt
->read_pos
= pt
->read_buf
= pt
->read_end
= &pt
->shortbuf
;
134 pt
->read_buf_size
= 1;
137 if (SCM_OUTPUT_PORT_P (port
) && write_size
> 0)
139 pt
->write_buf
= scm_gc_malloc_pointerless (write_size
, "port buffer");
140 pt
->write_pos
= pt
->write_buf
;
141 pt
->write_buf_size
= write_size
;
145 pt
->write_buf
= pt
->write_pos
= &pt
->shortbuf
;
146 pt
->write_buf_size
= 1;
149 pt
->write_end
= pt
->write_buf
+ pt
->write_buf_size
;
150 if (read_size
> 0 || write_size
> 0)
151 SCM_SET_CELL_WORD_0 (port
, SCM_CELL_WORD_0 (port
) & ~SCM_BUF0
);
153 SCM_SET_CELL_WORD_0 (port
, SCM_CELL_WORD_0 (port
) | SCM_BUF0
);
157 SCM_DEFINE (scm_setvbuf
, "setvbuf", 2, 1, 0,
158 (SCM port
, SCM mode
, SCM size
),
159 "Set the buffering mode for @var{port}. @var{mode} can be:\n"
166 "block buffered, using a newly allocated buffer of @var{size} bytes.\n"
167 "If @var{size} is omitted, a default size will be used.\n"
169 #define FUNC_NAME s_scm_setvbuf
175 port
= SCM_COERCE_OUTPORT (port
);
177 SCM_VALIDATE_OPFPORT (1,port
);
178 cmode
= scm_to_int (mode
);
179 if (cmode
!= _IONBF
&& cmode
!= _IOFBF
&& cmode
!= _IOLBF
)
180 scm_out_of_range (FUNC_NAME
, mode
);
184 SCM_SET_CELL_WORD_0 (port
, SCM_CELL_WORD_0 (port
) | SCM_BUFLINE
);
189 SCM_SET_CELL_WORD_0 (port
, SCM_CELL_WORD_0 (port
) & ~(scm_t_bits
)SCM_BUFLINE
);
192 if (SCM_UNBNDP (size
))
201 csize
= scm_to_int (size
);
202 if (csize
< 0 || (cmode
== _IONBF
&& csize
> 0))
203 scm_out_of_range (FUNC_NAME
, size
);
206 pt
= SCM_PTAB_ENTRY (port
);
208 /* silently discards buffered and put-back chars. */
209 if (pt
->read_buf
== pt
->putback_buf
)
211 pt
->read_buf
= pt
->saved_read_buf
;
212 pt
->read_pos
= pt
->saved_read_pos
;
213 pt
->read_end
= pt
->saved_read_end
;
214 pt
->read_buf_size
= pt
->saved_read_buf_size
;
216 if (pt
->read_buf
!= &pt
->shortbuf
)
217 scm_gc_free (pt
->read_buf
, pt
->read_buf_size
, "port buffer");
218 if (pt
->write_buf
!= &pt
->shortbuf
)
219 scm_gc_free (pt
->write_buf
, pt
->write_buf_size
, "port buffer");
221 scm_fport_buffer_add (port
, csize
, csize
);
222 return SCM_UNSPECIFIED
;
226 /* Move ports with the specified file descriptor to new descriptors,
227 * resetting the revealed count to 0.
230 scm_i_evict_port (void *closure
, SCM port
)
232 int fd
= * (int*) closure
;
234 if (SCM_FPORTP (port
))
239 /* XXX: In some cases, we can encounter a port with no associated ptab
241 p
= SCM_PTAB_ENTRY (port
);
242 fp
= (p
!= NULL
) ? (scm_t_fport
*) p
->stream
: NULL
;
244 if ((fp
!= NULL
) && (fp
->fdes
== fd
))
248 scm_syserror ("scm_evict_ports");
249 scm_set_port_revealed_x (port
, scm_from_int (0));
255 scm_evict_ports (int fd
)
257 scm_c_port_for_each (scm_i_evict_port
, (void *) &fd
);
261 SCM_DEFINE (scm_file_port_p
, "file-port?", 1, 0, 0,
263 "Determine whether @var{obj} is a port that is related to a file.")
264 #define FUNC_NAME s_scm_file_port_p
266 return scm_from_bool (SCM_FPORTP (obj
));
271 static SCM sys_file_port_name_canonicalization
;
272 SCM_SYMBOL (sym_relative
, "relative");
273 SCM_SYMBOL (sym_absolute
, "absolute");
276 fport_canonicalize_filename (SCM filename
)
278 SCM mode
= scm_fluid_ref (sys_file_port_name_canonicalization
);
280 if (!scm_is_string (filename
))
284 else if (scm_is_eq (mode
, sym_relative
))
288 path
= scm_variable_ref (scm_c_module_lookup (scm_the_root_module (),
290 rel
= scm_i_relativize_path (filename
, path
);
292 return scm_is_true (rel
) ? rel
: filename
;
294 else if (scm_is_eq (mode
, sym_absolute
))
298 str
= scm_to_locale_string (filename
);
299 canon
= canonicalize_file_name (str
);
302 return canon
? scm_take_locale_string (canon
) : filename
;
312 * Return a new port open on a given file.
314 * The mode string must match the pattern: [rwa+]** which
315 * is interpreted in the usual unix way.
317 * Return the new port.
319 SCM_DEFINE (scm_open_file
, "open-file", 2, 0, 0,
320 (SCM filename
, SCM mode
),
321 "Open the file whose name is @var{filename}, and return a port\n"
322 "representing that file. The attributes of the port are\n"
323 "determined by the @var{mode} string. The way in which this is\n"
324 "interpreted is similar to C stdio. The first character must be\n"
325 "one of the following:\n"
328 "Open an existing file for input.\n"
330 "Open a file for output, creating it if it doesn't already exist\n"
331 "or removing its contents if it does.\n"
333 "Open a file for output, creating it if it doesn't already\n"
334 "exist. All writes to the port will go to the end of the file.\n"
335 "The \"append mode\" can be turned off while the port is in use\n"
336 "@pxref{Ports and File Descriptors, fcntl}\n"
338 "The following additional characters can be appended:\n"
341 "Open the underlying file in binary mode, if supported by the system.\n"
342 "Also, open the file using the binary-compatible character encoding\n"
343 "\"ISO-8859-1\", ignoring the port's encoding and the coding declaration\n"
344 "at the top of the input file, if any.\n"
346 "Open the port for both input and output. E.g., @code{r+}: open\n"
347 "an existing file for both input and output.\n"
349 "Create an \"unbuffered\" port. In this case input and output\n"
350 "operations are passed directly to the underlying port\n"
351 "implementation without additional buffering. This is likely to\n"
352 "slow down I/O operations. The buffering mode can be changed\n"
353 "while a port is in use @pxref{Ports and File Descriptors,\n"
356 "Add line-buffering to the port. The port output buffer will be\n"
357 "automatically flushed whenever a newline character is written.\n"
359 "When the file is opened, this procedure will scan for a coding\n"
360 "declaration@pxref{Character Encoding of Source Files}. If present\n"
361 "will use that encoding for interpreting the file. Otherwise, the\n"
362 "port's encoding will be used.\n"
364 "In theory we could create read/write ports which were buffered\n"
365 "in one direction only. However this isn't included in the\n"
366 "current interfaces. If a file cannot be opened with the access\n"
367 "requested, @code{open-file} throws an exception.")
368 #define FUNC_NAME s_scm_open_file
371 int fdes
, flags
= 0, use_encoding
= 1;
372 unsigned int retries
;
373 char *file
, *md
, *ptr
;
375 scm_dynwind_begin (0);
377 file
= scm_to_locale_string (filename
);
378 scm_dynwind_free (file
);
380 md
= scm_to_locale_string (mode
);
381 scm_dynwind_free (md
);
389 flags
|= O_WRONLY
| O_CREAT
| O_TRUNC
;
392 flags
|= O_WRONLY
| O_CREAT
| O_APPEND
;
395 scm_out_of_range (FUNC_NAME
, mode
);
403 flags
= (flags
& ~(O_RDONLY
| O_WRONLY
)) | O_RDWR
;
407 #if defined (O_BINARY)
411 case '0': /* unbuffered: handled later. */
412 case 'l': /* line buffered: handled during output. */
415 scm_out_of_range (FUNC_NAME
, mode
);
420 for (retries
= 0, fdes
= -1;
421 fdes
< 0 && retries
< 2;
424 SCM_SYSCALL (fdes
= open_or_open64 (file
, flags
, 0666));
429 if (en
== EMFILE
&& retries
== 0)
430 /* Run the GC in case it collects open file ports that are no
431 longer referenced. */
432 scm_i_gc (FUNC_NAME
);
434 SCM_SYSERROR_MSG ("~A: ~S",
435 scm_cons (scm_strerror (scm_from_int (en
)),
436 scm_cons (filename
, SCM_EOL
)), en
);
440 /* Create a port from this file descriptor. The port's encoding is initially
441 %default-port-encoding. */
442 port
= scm_i_fdes_to_port (fdes
, scm_i_mode_bits (mode
),
443 fport_canonicalize_filename (filename
));
447 /* If this file has a coding declaration, use that as the port
449 if (SCM_INPUT_PORT_P (port
))
451 char *enc
= scm_i_scan_for_encoding (port
);
453 scm_i_set_port_encoding_x (port
, enc
);
457 /* If this is a binary file, use the binary-friendly ISO-8859-1
459 scm_i_set_port_encoding_x (port
, NULL
);
470 * Try getting the appropiate file flags for a given file descriptor
471 * under Windows. This incorporates some fancy operations because Windows
472 * differentiates between file, pipe and socket descriptors.
475 # define O_ACCMODE 0x0003
478 static int getflags (int fdes
)
482 int error
, optlen
= sizeof (int);
484 /* Is this a socket ? */
485 if (getsockopt (fdes
, SOL_SOCKET
, SO_ERROR
, (void *) &error
, &optlen
) >= 0)
487 /* Maybe a regular file ? */
488 else if (fstat (fdes
, &buf
) < 0)
492 /* Or an anonymous pipe handle ? */
493 if (buf
.st_mode
& _S_IFIFO
)
494 flags
= PeekNamedPipe ((HANDLE
) _get_osfhandle (fdes
), NULL
, 0,
495 NULL
, NULL
, NULL
) ? O_RDONLY
: O_WRONLY
;
497 else if (fdes
== fileno (stdin
) && isatty (fdes
))
499 /* stdout / stderr ? */
500 else if ((fdes
== fileno (stdout
) || fdes
== fileno (stderr
)) &&
508 #endif /* __MINGW32__ */
510 /* Building Guile ports from a file descriptor. */
512 /* Build a Scheme port from an open file descriptor `fdes'.
513 MODE indicates whether FILE is open for reading or writing; it uses
514 the same notation as open-file's second argument.
515 NAME is a string to be used as the port's filename.
518 scm_i_fdes_to_port (int fdes
, long mode_bits
, SCM name
)
519 #define FUNC_NAME "scm_fdes_to_port"
525 /* test that fdes is valid. */
527 flags
= getflags (fdes
);
529 flags
= fcntl (fdes
, F_GETFL
, 0);
535 && ((flags
!= O_WRONLY
&& (mode_bits
& SCM_WRTNG
))
536 || (flags
!= O_RDONLY
&& (mode_bits
& SCM_RDNG
))))
538 SCM_MISC_ERROR ("requested file mode not available on fdes", SCM_EOL
);
541 scm_i_scm_pthread_mutex_lock (&scm_i_port_table_mutex
);
543 port
= scm_new_port_table_entry (scm_tc16_fport
);
544 SCM_SET_CELL_TYPE(port
, scm_tc16_fport
| mode_bits
);
545 pt
= SCM_PTAB_ENTRY(port
);
548 = (scm_t_fport
*) scm_gc_malloc_pointerless (sizeof (scm_t_fport
),
552 pt
->rw_random
= SCM_FDES_RANDOM_P (fdes
);
553 SCM_SETSTREAM (port
, fp
);
554 if (mode_bits
& SCM_BUF0
)
555 scm_fport_buffer_add (port
, 0, 0);
557 scm_fport_buffer_add (port
, -1, -1);
559 SCM_SET_FILENAME (port
, name
);
560 scm_i_pthread_mutex_unlock (&scm_i_port_table_mutex
);
566 scm_fdes_to_port (int fdes
, char *mode
, SCM name
)
568 return scm_i_fdes_to_port (fdes
, scm_mode_bits (mode
), name
);
571 /* Return a lower bound on the number of bytes available for input. */
573 fport_input_waiting (SCM port
)
576 int fdes
= SCM_FSTREAM (port
)->fdes
;
577 struct timeval timeout
;
578 SELECT_TYPE read_set
;
579 SELECT_TYPE write_set
;
580 SELECT_TYPE except_set
;
583 FD_ZERO (&write_set
);
584 FD_ZERO (&except_set
);
586 FD_SET (fdes
, &read_set
);
591 if (select (SELECT_SET_SIZE
,
592 &read_set
, &write_set
, &except_set
, &timeout
)
594 scm_syserror ("fport_input_waiting");
595 return FD_ISSET (fdes
, &read_set
) ? 1 : 0;
597 #elif HAVE_IOCTL && defined (FIONREAD)
598 /* Note: cannot test just defined(FIONREAD) here, since mingw has FIONREAD
599 (for use with winsock ioctlsocket()) but not ioctl(). */
600 int fdes
= SCM_FSTREAM (port
)->fdes
;
602 ioctl(fdes
, FIONREAD
, &remir
);
606 scm_misc_error ("fport_input_waiting",
607 "Not fully implemented on this platform",
614 fport_print (SCM exp
, SCM port
, scm_print_state
*pstate SCM_UNUSED
)
616 scm_puts ("#<", port
);
617 scm_print_port_mode (exp
, port
);
618 if (SCM_OPFPORTP (exp
))
621 SCM name
= SCM_FILENAME (exp
);
622 if (scm_is_string (name
) || scm_is_symbol (name
))
623 scm_display (name
, port
);
625 scm_puts (SCM_PTOBNAME (SCM_PTOBNUM (exp
)), port
);
626 scm_putc (' ', port
);
627 fdes
= (SCM_FSTREAM (exp
))->fdes
;
631 scm_display (scm_ttyname (exp
), port
);
633 #endif /* HAVE_TTYNAME */
634 scm_intprint (fdes
, 10, port
);
638 scm_puts (SCM_PTOBNAME (SCM_PTOBNUM (exp
)), port
);
639 scm_putc (' ', port
);
640 scm_uintprint ((scm_t_bits
) SCM_PTAB_ENTRY (exp
), 16, port
);
642 scm_putc ('>', port
);
647 /* thread-local block for input on fport's fdes. */
649 fport_wait_for_input (SCM port
)
651 int fdes
= SCM_FSTREAM (port
)->fdes
;
653 if (!fport_input_waiting (port
))
657 int flags
= fcntl (fdes
, F_GETFL
);
660 scm_syserror ("scm_fdes_wait_for_input");
661 if (!(flags
& O_NONBLOCK
))
665 FD_SET (fdes
, &readfds
);
666 n
= scm_std_select (fdes
+ 1, &readfds
, NULL
, NULL
, NULL
);
668 while (n
== -1 && errno
== EINTR
);
671 #endif /* !__MINGW32__ */
673 static void fport_flush (SCM port
);
675 /* fill a port's read-buffer with a single read. returns the first
676 char or EOF if end of file. */
678 fport_fill_input (SCM port
)
681 scm_t_port
*pt
= SCM_PTAB_ENTRY (port
);
682 scm_t_fport
*fp
= SCM_FSTREAM (port
);
685 fport_wait_for_input (port
);
686 #endif /* !__MINGW32__ */
687 SCM_SYSCALL (count
= read (fp
->fdes
, pt
->read_buf
, pt
->read_buf_size
));
689 scm_syserror ("fport_fill_input");
691 return (scm_t_wchar
) EOF
;
694 pt
->read_pos
= pt
->read_buf
;
695 pt
->read_end
= pt
->read_buf
+ count
;
696 return *pt
->read_buf
;
701 fport_seek (SCM port
, scm_t_off offset
, int whence
)
703 scm_t_port
*pt
= SCM_PTAB_ENTRY (port
);
704 scm_t_fport
*fp
= SCM_FSTREAM (port
);
706 off_t_or_off64_t result
;
708 if (pt
->rw_active
== SCM_PORT_WRITE
)
710 if (offset
!= 0 || whence
!= SEEK_CUR
)
713 result
= rv
= lseek_or_lseek64 (fp
->fdes
, offset
, whence
);
717 /* read current position without disturbing the buffer. */
718 rv
= lseek_or_lseek64 (fp
->fdes
, offset
, whence
);
719 result
= rv
+ (pt
->write_pos
- pt
->write_buf
);
722 else if (pt
->rw_active
== SCM_PORT_READ
)
724 if (offset
!= 0 || whence
!= SEEK_CUR
)
726 /* could expand to avoid a second seek. */
727 scm_end_input (port
);
728 result
= rv
= lseek_or_lseek64 (fp
->fdes
, offset
, whence
);
732 /* read current position without disturbing the buffer
733 (particularly the unread-char buffer). */
734 rv
= lseek_or_lseek64 (fp
->fdes
, offset
, whence
);
735 result
= rv
- (pt
->read_end
- pt
->read_pos
);
737 if (pt
->read_buf
== pt
->putback_buf
)
738 result
-= pt
->saved_read_end
- pt
->saved_read_pos
;
741 else /* SCM_PORT_NEITHER */
743 result
= rv
= lseek_or_lseek64 (fp
->fdes
, offset
, whence
);
747 scm_syserror ("fport_seek");
753 fport_truncate (SCM port
, scm_t_off length
)
755 scm_t_fport
*fp
= SCM_FSTREAM (port
);
757 if (ftruncate (fp
->fdes
, length
) == -1)
758 scm_syserror ("ftruncate");
762 fport_write (SCM port
, const void *data
, size_t size
)
763 #define FUNC_NAME "fport_write"
765 /* this procedure tries to minimize the number of writes/flushes. */
766 scm_t_port
*pt
= SCM_PTAB_ENTRY (port
);
768 if (pt
->write_buf
== &pt
->shortbuf
769 || (pt
->write_pos
== pt
->write_buf
&& size
>= pt
->write_buf_size
))
771 /* Unbuffered port, or port with empty buffer and data won't fit in
773 if (full_write (SCM_FPORT_FDES (port
), data
, size
) < size
)
780 scm_t_off space
= pt
->write_end
- pt
->write_pos
;
784 /* data fits in buffer. */
785 memcpy (pt
->write_pos
, data
, size
);
786 pt
->write_pos
+= size
;
787 if (pt
->write_pos
== pt
->write_end
)
790 /* we can skip the line-buffering check if nothing's buffered. */
796 memcpy (pt
->write_pos
, data
, space
);
797 pt
->write_pos
= pt
->write_end
;
800 const void *ptr
= ((const char *) data
) + space
;
801 size_t remaining
= size
- space
;
803 if (size
>= pt
->write_buf_size
)
805 if (full_write (SCM_FPORT_FDES (port
), ptr
, remaining
)
812 memcpy (pt
->write_pos
, ptr
, remaining
);
813 pt
->write_pos
+= remaining
;
818 /* handle line buffering. */
819 if ((SCM_CELL_WORD_0 (port
) & SCM_BUFLINE
) && memchr (data
, '\n', size
))
826 fport_flush (SCM port
)
829 scm_t_port
*pt
= SCM_PTAB_ENTRY (port
);
830 scm_t_fport
*fp
= SCM_FSTREAM (port
);
831 size_t count
= pt
->write_pos
- pt
->write_buf
;
833 written
= full_write (fp
->fdes
, pt
->write_buf
, count
);
835 scm_syserror ("scm_flush");
837 pt
->write_pos
= pt
->write_buf
;
838 pt
->rw_active
= SCM_PORT_NEITHER
;
841 /* clear the read buffer and adjust the file position for unread bytes. */
843 fport_end_input (SCM port
, int offset
)
845 scm_t_fport
*fp
= SCM_FSTREAM (port
);
846 scm_t_port
*pt
= SCM_PTAB_ENTRY (port
);
848 offset
+= pt
->read_end
- pt
->read_pos
;
852 pt
->read_pos
= pt
->read_end
;
853 /* will throw error if unread-char used at beginning of file
854 then attempting to write. seems correct. */
855 if (lseek (fp
->fdes
, -offset
, SEEK_CUR
) == -1)
856 scm_syserror ("fport_end_input");
858 pt
->rw_active
= SCM_PORT_NEITHER
;
862 fport_close (SCM port
)
864 scm_t_fport
*fp
= SCM_FSTREAM (port
);
865 scm_t_port
*pt
= SCM_PTAB_ENTRY (port
);
869 SCM_SYSCALL (rv
= close (fp
->fdes
));
870 if (rv
== -1 && errno
!= EBADF
)
872 if (scm_gc_running_p
)
873 /* silently ignore the error. scm_error would abort if we
877 scm_syserror ("fport_close");
879 if (pt
->read_buf
== pt
->putback_buf
)
880 pt
->read_buf
= pt
->saved_read_buf
;
881 if (pt
->read_buf
!= &pt
->shortbuf
)
882 scm_gc_free (pt
->read_buf
, pt
->read_buf_size
, "port buffer");
883 if (pt
->write_buf
!= &pt
->shortbuf
)
884 scm_gc_free (pt
->write_buf
, pt
->write_buf_size
, "port buffer");
885 scm_gc_free (fp
, sizeof (*fp
), "file port");
890 fport_free (SCM port
)
899 scm_t_bits tc
= scm_make_port_type ("file", fport_fill_input
, fport_write
);
901 scm_set_port_free (tc
, fport_free
);
902 scm_set_port_print (tc
, fport_print
);
903 scm_set_port_flush (tc
, fport_flush
);
904 scm_set_port_end_input (tc
, fport_end_input
);
905 scm_set_port_close (tc
, fport_close
);
906 scm_set_port_seek (tc
, fport_seek
);
907 scm_set_port_truncate (tc
, fport_truncate
);
908 scm_set_port_input_waiting (tc
, fport_input_waiting
);
916 scm_tc16_fport
= scm_make_fptob ();
918 scm_c_define ("_IOFBF", scm_from_int (_IOFBF
));
919 scm_c_define ("_IOLBF", scm_from_int (_IOLBF
));
920 scm_c_define ("_IONBF", scm_from_int (_IONBF
));
922 sys_file_port_name_canonicalization
= scm_make_fluid ();
923 scm_c_define ("%file-port-name-canonicalization",
924 sys_file_port_name_canonicalization
);
926 #include "libguile/fports.x"