1 /* Copyright 1995-2004,2006-2015,2017-2020
2 Free Software Foundation, Inc.
3
4 This file is part of Guile.
5
6 Guile is free software: you can redistribute it and/or modify it
7 under the terms of the GNU Lesser General Public License as published
8 by the Free Software Foundation, either version 3 of the License, or
9 (at your option) any later version.
10
11 Guile is distributed in the hope that it will be useful, but WITHOUT
12 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
13 FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public
14 License for more details.
15
16 You should have received a copy of the GNU Lesser General Public
17 License along with Guile. If not, see
18 <https://www.gnu.org/licenses/>. */
19
20
21
22 #define _LARGEFILE64_SOURCE /* ask for stat64 etc */
23 #define _GNU_SOURCE /* ask for LONG_LONG_MAX/LONG_LONG_MIN */
24
25 #ifdef HAVE_CONFIG_H
26 # include <config.h>
27 #endif
28
29 #include <stdio.h>
30 #include <fcntl.h>
31
32 #ifdef HAVE_STRING_H
33 #include <string.h>
34 #endif
35 #include <unistd.h>
36 #ifdef HAVE_IO_H
37 #include <io.h>
38 #endif
39 #ifdef HAVE_STRUCT_STAT_ST_BLKSIZE
40 #include <sys/stat.h>
41 #endif
42 #include <poll.h>
43 #include <errno.h>
44 #include <sys/types.h>
45 #include <sys/stat.h>
46 #include <sys/select.h>
47 #include <full-write.h>
48
49 #include "async.h"
50 #include "boolean.h"
51 #include "dynwind.h"
52 #include "extensions.h"
53 #include "fdes-finalizers.h"
54 #include "filesys.h"
55 #include "fluids.h"
56 #include "gc.h"
57 #include "gsubr.h"
58 #include "hashtab.h"
59 #include "keywords.h"
60 #include "modules.h"
61 #include "numbers.h"
62 #include "pairs.h"
63 #include "ports-internal.h"
64 #include "posix.h"
65 #include "read.h"
66 #include "strings.h"
67 #include "symbols.h"
68 #include "syscalls.h"
69 #include "variable.h"
70 #include "version.h"
71
72 #include "fports.h"
73
74
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
84 #else
85 #error Oops, unknown OFF_T size
86 #endif
87
88 scm_t_port_type *scm_file_port_type;
89
90
91 /* Move ports with the specified file descriptor to new descriptors,
92 * resetting the revealed count to 0.
93 */
94 static void
scm_i_evict_port(void * closure,SCM port)95 scm_i_evict_port (void *closure, SCM port)
96 {
97 int fd = * (int*) closure;
98
99 if (SCM_OPFPORTP (port))
100 {
101 scm_t_fport *fp = SCM_FSTREAM (port);
102 if ((fp != NULL) && (fp->fdes == fd))
103 {
104 fp->fdes = dup (fd);
105 if (fp->fdes == -1)
106 scm_syserror ("scm_evict_ports");
107 scm_set_port_revealed_x (port, scm_from_int (0));
108 }
109 }
110 }
111
112 void
scm_evict_ports(int fd)113 scm_evict_ports (int fd)
114 {
115 scm_c_port_for_each (scm_i_evict_port, (void *) &fd);
116 }
117
118
119 SCM_DEFINE (scm_file_port_p, "file-port?", 1, 0, 0,
120 (SCM obj),
121 "Determine whether @var{obj} is a port that is related to a file.")
122 #define FUNC_NAME s_scm_file_port_p
123 {
124 return scm_from_bool (SCM_FPORTP (obj));
125 }
126 #undef FUNC_NAME
127
128
129 static SCM sys_file_port_name_canonicalization;
130 static SCM sym_relative;
131 static SCM sym_absolute;
132
133 static SCM
fport_canonicalize_filename(SCM filename)134 fport_canonicalize_filename (SCM filename)
135 {
136 SCM mode = scm_fluid_ref (sys_file_port_name_canonicalization);
137
138 if (!scm_is_string (filename))
139 {
140 return filename;
141 }
142 else if (scm_is_eq (mode, sym_relative))
143 {
144 SCM path, rel;
145
146 path = scm_variable_ref (scm_c_module_lookup (scm_the_root_module (),
147 "%load-path"));
148 rel = scm_i_relativize_path (filename, path);
149
150 return scm_is_true (rel) ? rel : filename;
151 }
152 else if (scm_is_eq (mode, sym_absolute))
153 {
154 char *str, *canon;
155
156 str = scm_to_locale_string (filename);
157 canon = canonicalize_file_name (str);
158 free (str);
159
160 return canon ? scm_take_locale_string (canon) : filename;
161 }
162 else
163 {
164 return filename;
165 }
166 }
167
168 int
scm_i_mode_to_open_flags(SCM mode,int * is_binary,const char * FUNC_NAME)169 scm_i_mode_to_open_flags (SCM mode, int *is_binary, const char *FUNC_NAME)
170 {
171 int flags = 0;
172 const char *md, *ptr;
173
174 if (SCM_UNLIKELY (!scm_is_string (mode)))
175 scm_out_of_range (FUNC_NAME, mode);
176
177 if (SCM_UNLIKELY (!scm_i_try_narrow_string (mode)))
178 scm_out_of_range (FUNC_NAME, mode);
179
180 md = scm_i_string_chars (mode);
181 *is_binary = 0;
182
183 switch (*md)
184 {
185 case 'r':
186 flags |= O_RDONLY;
187 break;
188 case 'w':
189 flags |= O_WRONLY | O_CREAT | O_TRUNC;
190 break;
191 case 'a':
192 flags |= O_WRONLY | O_CREAT | O_APPEND;
193 break;
194 default:
195 scm_out_of_range (FUNC_NAME, mode);
196 }
197 ptr = md + 1;
198 while (*ptr != '\0')
199 {
200 switch (*ptr)
201 {
202 case '+':
203 flags = (flags & ~(O_RDONLY | O_WRONLY)) | O_RDWR;
204 break;
205 case 'b':
206 *is_binary = 1;
207 #if defined (O_BINARY)
208 flags |= O_BINARY;
209 #endif
210 break;
211 case '0': /* unbuffered: handled later. */
212 case 'l': /* line buffered: handled during output. */
213 break;
214 default:
215 scm_out_of_range (FUNC_NAME, mode);
216 }
217 ptr++;
218 }
219
220 return flags;
221 }
222
223 /* scm_open_file_with_encoding
224 Return a new port open on a given file.
225
226 The mode string must match the pattern: [rwa+]** which
227 is interpreted in the usual unix way.
228
229 Unless binary mode is requested, the character encoding of the new
230 port is determined as follows: First, if GUESS_ENCODING is true,
231 'file-encoding' is used to guess the encoding of the file. If
232 GUESS_ENCODING is false or if 'file-encoding' fails, ENCODING is used
233 unless it is also false. As a last resort, the default port encoding
234 is used. It is an error to pass a non-false GUESS_ENCODING or
235 ENCODING if binary mode is requested.
236
237 Return the new port. */
238 SCM
scm_open_file_with_encoding(SCM filename,SCM mode,SCM guess_encoding,SCM encoding)239 scm_open_file_with_encoding (SCM filename, SCM mode,
240 SCM guess_encoding, SCM encoding)
241 #define FUNC_NAME "open-file"
242 {
243 SCM port;
244 int fdes, flags, binary = 0;
245 unsigned int retries;
246 char *file;
247
248 if (SCM_UNLIKELY (!(scm_is_false (encoding) || scm_is_string (encoding))))
249 scm_wrong_type_arg_msg (FUNC_NAME, 0, encoding,
250 "encoding to be string or false");
251
252 scm_dynwind_begin (0);
253
254 file = scm_to_locale_string (filename);
255 scm_dynwind_free (file);
256
257 flags = scm_i_mode_to_open_flags (mode, &binary, FUNC_NAME);
258
259 for (retries = 0, fdes = -1;
260 fdes < 0 && retries < 2;
261 retries++)
262 {
263 SCM_SYSCALL (fdes = open_or_open64 (file, flags, 0666));
264 if (fdes == -1)
265 {
266 int en = errno;
267
268 if (en == EMFILE && retries == 0)
269 /* Run the GC in case it collects open file ports that are no
270 longer referenced. */
271 scm_i_gc (FUNC_NAME);
272 else
273 SCM_SYSERROR_MSG ("~A: ~S",
274 scm_cons (scm_strerror (scm_from_int (en)),
275 scm_cons (filename, SCM_EOL)), en);
276 }
277 }
278
279 /* Create a port from this file descriptor. The port's encoding is initially
280 %default-port-encoding. */
281 port = scm_i_fdes_to_port (fdes, scm_i_mode_bits (mode),
282 fport_canonicalize_filename (filename),
283 0);
284
285 if (binary)
286 {
287 if (scm_is_true (encoding))
288 scm_misc_error (FUNC_NAME,
289 "Encoding specified on a binary port",
290 scm_list_1 (encoding));
291 if (scm_is_true (guess_encoding))
292 scm_misc_error (FUNC_NAME,
293 "Request to guess encoding on a binary port",
294 SCM_EOL);
295
296 /* Use the binary-friendly ISO-8859-1 encoding. */
297 scm_i_set_port_encoding_x (port, NULL);
298 }
299 else
300 {
301 char *enc = NULL;
302
303 if (scm_is_true (guess_encoding))
304 {
305 if (SCM_INPUT_PORT_P (port))
306 enc = scm_i_scan_for_encoding (port);
307 else
308 scm_misc_error (FUNC_NAME,
309 "Request to guess encoding on an output-only port",
310 SCM_EOL);
311 }
312
313 if (!enc && scm_is_true (encoding))
314 {
315 char *buf = scm_to_latin1_string (encoding);
316 enc = scm_gc_strdup (buf, "encoding");
317 free (buf);
318 }
319
320 if (enc)
321 scm_i_set_port_encoding_x (port, enc);
322 }
323
324 scm_dynwind_end ();
325
326 return port;
327 }
328 #undef FUNC_NAME
329
330 SCM
scm_open_file(SCM filename,SCM mode)331 scm_open_file (SCM filename, SCM mode)
332 {
333 return scm_open_file_with_encoding (filename, mode, SCM_BOOL_F, SCM_BOOL_F);
334 }
335
336 /* We can't define these using SCM_KEYWORD, because keywords have not
337 yet been initialized when scm_init_fports is called. */
338 static SCM k_guess_encoding = SCM_UNDEFINED;
339 static SCM k_encoding = SCM_UNDEFINED;
340
341 SCM_INTERNAL SCM scm_i_open_file (SCM, SCM, SCM);
342
343 SCM_DEFINE (scm_i_open_file, "open-file", 2, 0, 1,
344 (SCM filename, SCM mode, SCM keyword_args),
345 "Open the file whose name is @var{filename}, and return a port\n"
346 "representing that file. The attributes of the port are\n"
347 "determined by the @var{mode} string. The way in which this is\n"
348 "interpreted is similar to C stdio. The first character must be\n"
349 "one of the following:\n"
350 "@table @samp\n"
351 "@item r\n"
352 "Open an existing file for input.\n"
353 "@item w\n"
354 "Open a file for output, creating it if it doesn't already exist\n"
355 "or removing its contents if it does.\n"
356 "@item a\n"
357 "Open a file for output, creating it if it doesn't already\n"
358 "exist. All writes to the port will go to the end of the file.\n"
359 "The \"append mode\" can be turned off while the port is in use\n"
360 "@pxref{Ports and File Descriptors, fcntl}\n"
361 "@end table\n"
362 "The following additional characters can be appended:\n"
363 "@table @samp\n"
364 "@item b\n"
365 "Open the underlying file in binary mode, if supported by the system.\n"
366 "Also, open the file using the binary-compatible character encoding\n"
367 "\"ISO-8859-1\", ignoring the default port encoding.\n"
368 "@item +\n"
369 "Open the port for both input and output. E.g., @code{r+}: open\n"
370 "an existing file for both input and output.\n"
371 "@item 0\n"
372 "Create an \"unbuffered\" port. In this case input and output\n"
373 "operations are passed directly to the underlying port\n"
374 "implementation without additional buffering. This is likely to\n"
375 "slow down I/O operations. The buffering mode can be changed\n"
376 "while a port is in use @pxref{Ports and File Descriptors,\n"
377 "setvbuf}\n"
378 "@item l\n"
379 "Add line-buffering to the port. The port output buffer will be\n"
380 "automatically flushed whenever a newline character is written.\n"
381 "@end table\n"
382 "In theory we could create read/write ports which were buffered\n"
383 "in one direction only. However this isn't included in the\n"
384 "current interfaces. If a file cannot be opened with the access\n"
385 "requested, @code{open-file} throws an exception.")
386 #define FUNC_NAME s_scm_i_open_file
387 {
388 SCM encoding = SCM_BOOL_F;
389 SCM guess_encoding = SCM_BOOL_F;
390
391 scm_c_bind_keyword_arguments (FUNC_NAME, keyword_args, 0,
392 k_guess_encoding, &guess_encoding,
393 k_encoding, &encoding,
394 SCM_UNDEFINED);
395
396 return scm_open_file_with_encoding (filename, mode,
397 guess_encoding, encoding);
398 }
399 #undef FUNC_NAME
400
401
402 /* Building Guile ports from a file descriptor. */
403
404 int
scm_i_fdes_is_valid(int fdes,long mode_bits)405 scm_i_fdes_is_valid (int fdes, long mode_bits)
406 {
407 #ifdef F_GETFL
408 int flags = fcntl (fdes, F_GETFL, 0);
409 if (flags == -1)
410 return 0;
411 flags &= O_ACCMODE;
412 if (flags == O_RDWR)
413 return 1;
414 if (flags != O_WRONLY && (mode_bits & SCM_WRTNG))
415 return 0;
416 if (flags != O_RDONLY && (mode_bits & SCM_RDNG))
417 return 0;
418 return 1;
419 #else
420 /* If we don't have F_GETFL, as on mingw, at least we can test that
421 it is a valid file descriptor. */
422 struct stat st;
423 return fstat (fdes, &st) == 0;
424 #endif
425 }
426
427 /* Build a Scheme port from an open file descriptor `fdes'.
428 MODE indicates whether FILE is open for reading or writing; it uses
429 the same notation as open-file's second argument.
430 NAME is a string to be used as the port's filename.
431 */
432 SCM
scm_i_fdes_to_port(int fdes,long mode_bits,SCM name,unsigned options)433 scm_i_fdes_to_port (int fdes, long mode_bits, SCM name, unsigned options)
434 #define FUNC_NAME "scm_fdes_to_port"
435 {
436 SCM port;
437 scm_t_fport *fp;
438
439 if (options & SCM_FPORT_OPTION_VERIFY)
440 {
441 errno = 0;
442 if (!scm_i_fdes_is_valid (fdes, mode_bits))
443 {
444 if (errno)
445 SCM_SYSERROR;
446 SCM_MISC_ERROR ("requested file mode not available on fdes",
447 SCM_EOL);
448 }
449 }
450
451 fp = (scm_t_fport *) scm_gc_malloc_pointerless (sizeof (scm_t_fport),
452 "file port");
453 fp->fdes = fdes;
454 fp->options = options;
455 fp->revealed = 0;
456
457 port = scm_c_make_port (scm_file_port_type, mode_bits, (scm_t_bits)fp);
458
459 SCM_SET_FILENAME (port, name);
460
461 return port;
462 }
463 #undef FUNC_NAME
464
465 SCM
scm_fdes_to_port(int fdes,char * mode,SCM name)466 scm_fdes_to_port (int fdes, char *mode, SCM name)
467 {
468 return scm_i_fdes_to_port (fdes, scm_mode_bits (mode), name,
469 SCM_FPORT_OPTION_VERIFY);
470 }
471
472 /* Return a lower bound on the number of bytes available for input. */
473 static int
fport_input_waiting(SCM port)474 fport_input_waiting (SCM port)
475 {
476 int fdes = SCM_FSTREAM (port)->fdes;
477
478 struct pollfd pollfd = { fdes, POLLIN, 0 };
479
480 if (poll (&pollfd, 1, 0) < 0)
481 scm_syserror ("fport_input_waiting");
482
483 return pollfd.revents & POLLIN ? 1 : 0;
484 }
485
486
487
488
489 /* Revealed counts --- an oddity inherited from SCSH. */
490
491 #define SCM_REVEALED(x) (SCM_FSTREAM(x)->revealed)
492
493
494 /* Find a port in the table and return its revealed count.
495 Also used by the garbage collector.
496 */
497 int
scm_revealed_count(SCM port)498 scm_revealed_count (SCM port)
499 {
500 return SCM_REVEALED (port);
501 }
502
503 SCM_DEFINE (scm_port_revealed, "port-revealed", 1, 0, 0,
504 (SCM port),
505 "Return the revealed count for @var{port}.")
506 #define FUNC_NAME s_scm_port_revealed
507 {
508 port = SCM_COERCE_OUTPORT (port);
509 SCM_VALIDATE_OPFPORT (1, port);
510 return scm_from_int (scm_revealed_count (port));
511 }
512 #undef FUNC_NAME
513
514 /* Set the revealed count for a port. */
515 SCM_DEFINE (scm_set_port_revealed_x, "set-port-revealed!", 2, 0, 0,
516 (SCM port, SCM rcount),
517 "Sets the revealed count for a port to a given value.\n"
518 "The return value is unspecified.")
519 #define FUNC_NAME s_scm_set_port_revealed_x
520 {
521 int r;
522
523 port = SCM_COERCE_OUTPORT (port);
524 SCM_VALIDATE_OPFPORT (1, port);
525
526 r = scm_to_int (rcount);
527 SCM_REVEALED (port) = r;
528
529 return SCM_UNSPECIFIED;
530 }
531 #undef FUNC_NAME
532
533 /* Set the revealed count for a port. */
534 SCM_DEFINE (scm_adjust_port_revealed_x, "adjust-port-revealed!", 2, 0, 0,
535 (SCM port, SCM addend),
536 "Add @var{addend} to the revealed count of @var{port}.\n"
537 "The return value is unspecified.")
538 #define FUNC_NAME s_scm_adjust_port_revealed_x
539 {
540 int a;
541
542 port = SCM_COERCE_OUTPORT (port);
543 SCM_VALIDATE_OPFPORT (1, port);
544
545 a = scm_to_int (addend);
546 SCM_REVEALED (port) += a;
547
548 return SCM_UNSPECIFIED;
549 }
550 #undef FUNC_NAME
551
552
553
554 static int
fport_print(SCM exp,SCM port,scm_print_state * pstate SCM_UNUSED)555 fport_print (SCM exp, SCM port, scm_print_state *pstate SCM_UNUSED)
556 {
557 scm_puts ("#<", port);
558 scm_print_port_mode (exp, port);
559 if (SCM_OPFPORTP (exp))
560 {
561 int fdes;
562 SCM name = SCM_FILENAME (exp);
563 if (scm_is_string (name) || scm_is_symbol (name))
564 scm_display (name, port);
565 else
566 scm_puts (SCM_PORT_TYPE (exp)->name, port);
567 scm_putc (' ', port);
568 fdes = (SCM_FSTREAM (exp))->fdes;
569
570 #if (defined HAVE_TTYNAME) && (defined HAVE_POSIX)
571 if (isatty (fdes))
572 scm_display (scm_ttyname (exp), port);
573 else
574 #endif /* HAVE_TTYNAME */
575 scm_intprint (fdes, 10, port);
576 }
577 else
578 {
579 scm_puts (SCM_PORT_TYPE (exp)->name, port);
580 scm_putc (' ', port);
581 scm_uintprint ((scm_t_bits) SCM_PORT (exp), 16, port);
582 }
583 scm_putc ('>', port);
584 return 1;
585 }
586
587 /* fill a port's read-buffer with a single read. returns the first
588 char or EOF if end of file. */
589 static size_t
fport_read(SCM port,SCM dst,size_t start,size_t count)590 fport_read (SCM port, SCM dst, size_t start, size_t count)
591 {
592 scm_t_fport *fp = SCM_FSTREAM (port);
593 signed char *ptr = SCM_BYTEVECTOR_CONTENTS (dst) + start;
594 ssize_t ret;
595
596 retry:
597 ret = read (fp->fdes, ptr, count);
598 if (ret < 0)
599 {
600 if (errno == EINTR)
601 {
602 scm_async_tick ();
603 goto retry;
604 }
605 if (errno == EWOULDBLOCK || errno == EAGAIN)
606 return -1;
607 scm_syserror ("fport_read");
608 }
609 return ret;
610 }
611
612 static size_t
fport_write(SCM port,SCM src,size_t start,size_t count)613 fport_write (SCM port, SCM src, size_t start, size_t count)
614 {
615 int fd = SCM_FPORT_FDES (port);
616 signed char *ptr = SCM_BYTEVECTOR_CONTENTS (src) + start;
617 ssize_t ret;
618
619 retry:
620 ret = write (fd, ptr, count);
621 if (ret < 0)
622 {
623 if (errno == EINTR)
624 {
625 scm_async_tick ();
626 goto retry;
627 }
628 if (errno == EWOULDBLOCK || errno == EAGAIN)
629 return -1;
630 scm_syserror ("fport_write");
631 }
632
633 return ret;
634 }
635
636 static scm_t_off
fport_seek(SCM port,scm_t_off offset,int whence)637 fport_seek (SCM port, scm_t_off offset, int whence)
638 {
639 scm_t_fport *fp = SCM_FSTREAM (port);
640 scm_t_off result;
641
642 result = lseek (fp->fdes, offset, whence);
643
644 if (result == -1)
645 scm_syserror ("fport_seek");
646
647 return result;
648 }
649
650 static void
fport_truncate(SCM port,scm_t_off length)651 fport_truncate (SCM port, scm_t_off length)
652 {
653 scm_t_fport *fp = SCM_FSTREAM (port);
654
655 if (ftruncate (fp->fdes, length) == -1)
656 scm_syserror ("ftruncate");
657 }
658
659 static void
fport_close(SCM port)660 fport_close (SCM port)
661 {
662 scm_t_fport *fp = SCM_FSTREAM (port);
663
664 if (SCM_REVEALED (port) > 0)
665 /* The port has a non-zero revealed count, so don't close the
666 underlying file descriptor. */
667 return;
668
669 scm_run_fdes_finalizers (fp->fdes);
670 if (close (fp->fdes) != 0)
671 /* It's not useful to retry after EINTR, as the file descriptor is
672 in an undefined state. See http://lwn.net/Articles/365294/.
673 Instead just throw an error if close fails, trusting that the fd
674 was cleaned up. */
675 scm_syserror ("fport_close");
676 }
677
678 static int
fport_random_access_p(SCM port)679 fport_random_access_p (SCM port)
680 {
681 scm_t_fport *fp = SCM_FSTREAM (port);
682
683 if (fp->options & SCM_FPORT_OPTION_NOT_SEEKABLE)
684 return 0;
685
686 if (lseek (fp->fdes, 0, SEEK_CUR) == -1)
687 return 0;
688
689 return 1;
690 }
691
692 static int
fport_wait_fd(SCM port)693 fport_wait_fd (SCM port)
694 {
695 return SCM_FSTREAM (port)->fdes;
696 }
697
698 /* Query the OS to get the natural buffering for FPORT, if available. */
699 static void
fport_get_natural_buffer_sizes(SCM port,size_t * read_size,size_t * write_size)700 fport_get_natural_buffer_sizes (SCM port, size_t *read_size, size_t *write_size)
701 {
702 #ifdef HAVE_STRUCT_STAT_ST_BLKSIZE
703 scm_t_fport *fp = SCM_FSTREAM (port);
704 struct stat st;
705
706 if (fstat (fp->fdes, &st) == 0)
707 *read_size = *write_size = st.st_blksize;
708 #endif
709 }
710
711 static scm_t_port_type *
scm_make_fptob()712 scm_make_fptob ()
713 {
714 scm_t_port_type *ptob = scm_make_port_type ("file", fport_read, fport_write);
715
716 scm_set_port_print (ptob, fport_print);
717 scm_set_port_needs_close_on_gc (ptob, 1);
718 scm_set_port_close (ptob, fport_close);
719 scm_set_port_seek (ptob, fport_seek);
720 scm_set_port_truncate (ptob, fport_truncate);
721 scm_set_port_read_wait_fd (ptob, fport_wait_fd);
722 scm_set_port_write_wait_fd (ptob, fport_wait_fd);
723 scm_set_port_input_waiting (ptob, fport_input_waiting);
724 scm_set_port_random_access_p (ptob, fport_random_access_p);
725 scm_set_port_get_natural_buffer_sizes (ptob, fport_get_natural_buffer_sizes);
726
727 return ptob;
728 }
729
730 /* We can't initialize the keywords from 'scm_init_fports', because
731 keywords haven't yet been initialized at that point. */
732 void
scm_init_fports_keywords()733 scm_init_fports_keywords ()
734 {
735 k_guess_encoding = scm_from_latin1_keyword ("guess-encoding");
736 k_encoding = scm_from_latin1_keyword ("encoding");
737 }
738
739 static void
scm_init_ice_9_fports(void)740 scm_init_ice_9_fports (void)
741 {
742 #include "fports.x"
743 }
744
745 void
scm_init_fports()746 scm_init_fports ()
747 {
748 scm_file_port_type = scm_make_fptob ();
749
750 scm_c_register_extension ("libguile-" SCM_EFFECTIVE_VERSION,
751 "scm_init_ice_9_fports",
752 (scm_t_extension_init_func) scm_init_ice_9_fports,
753 NULL);
754
755 /* The following bindings are used early in boot-9.scm. */
756
757 /* Used by `include' and also by `file-exists?' if `stat' is
758 unavailable. */
759 scm_c_define_gsubr (s_scm_i_open_file, 2, 0, 1, (scm_t_subr) scm_i_open_file);
760
761 /* Used by `open-file.', also via C. */
762 sym_relative = scm_from_latin1_symbol ("relative");
763 sym_absolute = scm_from_latin1_symbol ("absolute");
764 sys_file_port_name_canonicalization = scm_make_fluid ();
765 scm_c_define ("%file-port-name-canonicalization",
766 sys_file_port_name_canonicalization);
767 }
768