Commit | Line | Data |
---|---|---|
7dc6e754 | 1 | /* Copyright (C) 1995,1996,1997,1998 Free Software Foundation, Inc. |
0f2d19dd JB |
2 | * |
3 | * This program is free software; you can redistribute it and/or modify | |
4 | * it under the terms of the GNU General Public License as published by | |
5 | * the Free Software Foundation; either version 2, or (at your option) | |
6 | * any later version. | |
7 | * | |
8 | * This program 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 | |
11 | * GNU General Public License for more details. | |
12 | * | |
13 | * You should have received a copy of the GNU General Public License | |
14 | * along with this software; see the file COPYING. If not, write to | |
82892bed JB |
15 | * the Free Software Foundation, Inc., 59 Temple Place, Suite 330, |
16 | * Boston, MA 02111-1307 USA | |
0f2d19dd JB |
17 | * |
18 | * As a special exception, the Free Software Foundation gives permission | |
19 | * for additional uses of the text contained in its release of GUILE. | |
20 | * | |
21 | * The exception is that, if you link the GUILE library with other files | |
22 | * to produce an executable, this does not by itself cause the | |
23 | * resulting executable to be covered by the GNU General Public License. | |
24 | * Your use of that executable is in no way restricted on account of | |
25 | * linking the GUILE library code into it. | |
26 | * | |
27 | * This exception does not however invalidate any other reasons why | |
28 | * the executable file might be covered by the GNU General Public License. | |
29 | * | |
30 | * This exception applies only to the code released by the | |
31 | * Free Software Foundation under the name GUILE. If you copy | |
32 | * code from other Free Software Foundation releases into a copy of | |
33 | * GUILE, as the General Public License permits, the exception does | |
34 | * not apply to the code that you add in this way. To avoid misleading | |
35 | * anyone as to the status of such modified files, you must delete | |
36 | * this exception notice from them. | |
37 | * | |
38 | * If you write modifications of your own for GUILE, it is your choice | |
39 | * whether to permit this exception to apply to your modifications. | |
82892bed | 40 | * If you do not wish that, delete this exception notice. */ |
0f2d19dd JB |
41 | \f |
42 | ||
43 | #include <stdio.h> | |
44 | #include "_scm.h" | |
20e6290e JB |
45 | #include "markers.h" |
46 | ||
47 | #include "fports.h" | |
95b88819 GH |
48 | |
49 | #ifdef HAVE_STRING_H | |
50 | #include <string.h> | |
51 | #endif | |
0f2d19dd JB |
52 | #ifdef HAVE_UNISTD_H |
53 | #include <unistd.h> | |
54 | #else | |
0f2d19dd JB |
55 | scm_sizet fwrite (); |
56 | #endif | |
0f2d19dd | 57 | |
e145dd02 JB |
58 | \f |
59 | /* Port direction --- handling el cheapo stdio implementations. | |
60 | ||
61 | Guile says that when you've got a port that's both readable and | |
62 | writable, like a socket, why then, by gum, you can read from it and | |
63 | write to it! However, most standard I/O implementations make | |
64 | cheezy caveats like this: | |
65 | ||
66 | When a file is opened for update, both input and output may | |
67 | be done on the resulting stream. However, output may not be | |
68 | directly followed by input without an intervening fflush(), | |
69 | fseek(), fsetpos(), or rewind(), and input may not be | |
70 | directly followed by output without an intervening fseek(), | |
71 | fsetpos(), or rewind(), or an input operation that | |
72 | encounters end-of-file. | |
73 | -- the Solaris fdopen(3S) man page | |
74 | ||
75 | I think this behavior is permitted by the ANSI C standard. | |
76 | ||
77 | So we made the implementation more complex, so what the user sees | |
78 | remains simple. When we have a Guile port based on a stdio stream | |
79 | (this source file's specialty), we keep track of whether it was | |
80 | last written to, read from, or whether it is in a safe state for | |
81 | both operations. Each port operation function just checks the | |
82 | state of the port before each operation, and does the required | |
83 | magic if necessary. | |
84 | ||
85 | We use two bits in the CAR of the port, FPORT_READ_SAFE and | |
86 | FPORT_WRITE_SAFE, to indicate what operations the underlying stdio | |
87 | stream could correctly perform next. You're not allowed to clear | |
88 | them both at the same time, but both can be set --- for example, if | |
89 | the stream has just been opened, or flushed, or had its position | |
90 | changed. | |
91 | ||
92 | It's possible for a port to have neither bit set, if we receive a | |
93 | FILE * pointer in an unknown state; this code should handle that | |
94 | gracefully. */ | |
95 | ||
96 | #define FPORT_READ_SAFE (1L << 24) | |
97 | #define FPORT_WRITE_SAFE (2L << 24) | |
98 | ||
99 | #define FPORT_ALL_OKAY(port) \ | |
100 | (SCM_SETOR_CAR (port, (FPORT_READ_SAFE | FPORT_WRITE_SAFE))) | |
101 | ||
102 | static inline void | |
103 | pre_read (SCM port) | |
104 | { | |
105 | if (! (SCM_CAR (port) & FPORT_READ_SAFE)) | |
106 | fflush ((FILE *)SCM_STREAM (port)); | |
107 | ||
108 | /* We've done the flush, so reading is safe. | |
109 | Assuming that we're going to do a read next, writing will not be | |
110 | safe by the time we're done. */ | |
111 | SCM_SETOR_CAR (port, FPORT_READ_SAFE); | |
112 | SCM_SETAND_CAR (port, ~FPORT_WRITE_SAFE); | |
113 | ||
114 | } | |
115 | ||
116 | static inline void | |
117 | pre_write (SCM port) | |
118 | { | |
119 | if (! (SCM_CAR (port) & FPORT_WRITE_SAFE)) | |
120 | /* This can fail, if we're talking to a line-buffered terminal. As | |
121 | far as I can tell, there's no way to get mixed reads and writes | |
122 | to work on a line-buffered terminal at all --- you get a full | |
123 | line in the buffer when you read, and then you have to throw it | |
124 | out to write. You have to do unbuffered input, and make the | |
125 | system provide the second buffer. */ | |
126 | fseek ((FILE *)SCM_STREAM (port), 0, SEEK_CUR); | |
127 | ||
128 | /* We've done the seek, so writing is safe. | |
129 | Assuming that we're going to do a write next, reading will not be | |
130 | safe by the time we're done. */ | |
131 | SCM_SETOR_CAR (port, FPORT_WRITE_SAFE); | |
132 | SCM_SETAND_CAR (port, ~FPORT_READ_SAFE); | |
133 | } | |
134 | ||
135 | \f | |
136 | /* Helpful operations on stdio FILE-based ports */ | |
0f2d19dd JB |
137 | |
138 | /* should be called with SCM_DEFER_INTS active */ | |
1717856b | 139 | |
0f2d19dd JB |
140 | SCM |
141 | scm_setbuf0 (port) | |
142 | SCM port; | |
0f2d19dd | 143 | { |
7a6f1ffa GH |
144 | /* NOSETBUF was provided by scm to allow unbuffered ports to be |
145 | avoided on systems where ungetc didn't work correctly. See | |
146 | comment in unif.c, which seems to be the only place where it | |
147 | could still be a problem. */ | |
0f2d19dd | 148 | #ifndef NOSETBUF |
7a6f1ffa GH |
149 | /* SCM_SYSCALL (setbuf ((FILE *)SCM_STREAM (port), 0);); */ |
150 | SCM_SYSCALL (setvbuf ((FILE *)SCM_STREAM (port), 0, _IONBF, 0);); | |
0f2d19dd | 151 | #endif |
7a6f1ffa GH |
152 | return SCM_UNSPECIFIED; |
153 | } | |
154 | ||
155 | SCM_PROC (s_setvbuf, "setvbuf", 2, 1, 0, scm_setvbuf); | |
156 | SCM | |
157 | scm_setvbuf (SCM port, SCM mode, SCM size) | |
158 | { | |
159 | int rv; | |
160 | int cmode, csize; | |
161 | ||
78446828 MV |
162 | port = SCM_COERCE_OUTPORT (port); |
163 | ||
7a6f1ffa GH |
164 | SCM_ASSERT (SCM_NIMP (port) && SCM_FPORTP (port), port, SCM_ARG1, s_setvbuf); |
165 | SCM_ASSERT (SCM_INUMP (mode), mode, SCM_ARG2, s_setvbuf); | |
166 | if (SCM_UNBNDP (size)) | |
167 | csize = 0; | |
168 | else | |
169 | { | |
170 | SCM_ASSERT (SCM_INUMP (size), size, SCM_ARG3, s_setvbuf); | |
171 | csize = SCM_INUM (size); | |
172 | } | |
173 | cmode = SCM_INUM (mode); | |
174 | if (csize == 0 && cmode == _IOFBF) | |
175 | cmode = _IONBF; | |
176 | SCM_DEFER_INTS; | |
177 | SCM_SYSCALL (rv = setvbuf ((FILE *)SCM_STREAM (port), 0, cmode, csize)); | |
178 | if (rv < 0) | |
179 | scm_syserror (s_setvbuf); | |
180 | if (cmode == _IONBF) | |
181 | SCM_SETCAR (port, SCM_CAR (port) | SCM_BUF0); | |
182 | else | |
183 | SCM_SETCAR (port, (SCM_CAR (port) & ~SCM_BUF0)); | |
184 | SCM_ALLOW_INTS; | |
185 | return SCM_UNSPECIFIED; | |
186 | } | |
187 | ||
188 | #ifdef FD_SETTER | |
189 | #define SET_FILE_FD_FIELD(F,D) ((F)->FD_SETTER = (D)) | |
0f2d19dd | 190 | #endif |
7a6f1ffa GH |
191 | |
192 | void | |
193 | scm_setfileno (fs, fd) | |
194 | FILE *fs; | |
195 | int fd; | |
196 | { | |
197 | #ifdef SET_FILE_FD_FIELD | |
198 | SET_FILE_FD_FIELD(fs, fd); | |
199 | #else | |
200 | scm_misc_error ("scm_setfileno", "Not fully implemented on this platform", | |
201 | SCM_EOL); | |
0f2d19dd | 202 | #endif |
0f2d19dd JB |
203 | } |
204 | ||
eadd48de GH |
205 | /* Move ports with the specified file descriptor to new descriptors, |
206 | * reseting the revealed count to 0. | |
207 | * Should be called with SCM_DEFER_INTS active. | |
0f2d19dd | 208 | */ |
1717856b | 209 | |
eadd48de GH |
210 | void |
211 | scm_evict_ports (fd) | |
212 | int fd; | |
0f2d19dd | 213 | { |
eadd48de | 214 | int i; |
0f2d19dd | 215 | |
eadd48de GH |
216 | for (i = 0; i < scm_port_table_size; i++) |
217 | { | |
218 | if (SCM_FPORTP (scm_port_table[i]->port) | |
219 | && fileno ((FILE *)SCM_STREAM (scm_port_table[i]->port)) == fd) | |
220 | { | |
221 | scm_setfileno ((FILE *)SCM_STREAM (scm_port_table[i]->port), dup (fd)); | |
222 | scm_set_port_revealed_x (scm_port_table[i]->port, SCM_MAKINUM (0)); | |
223 | } | |
224 | } | |
225 | } | |
0f2d19dd JB |
226 | |
227 | /* scm_open_file | |
228 | * Return a new port open on a given file. | |
229 | * | |
230 | * The mode string must match the pattern: [rwa+]** which | |
231 | * is interpreted in the usual unix way. | |
232 | * | |
233 | * Return the new port. | |
234 | */ | |
19639113 | 235 | SCM_PROC(s_open_file, "open-file", 2, 0, 0, scm_open_file); |
1717856b | 236 | |
0f2d19dd | 237 | SCM |
19639113 GH |
238 | scm_open_file (filename, modes) |
239 | SCM filename; | |
240 | SCM modes; | |
0f2d19dd | 241 | { |
19639113 | 242 | SCM port; |
0f2d19dd | 243 | FILE *f; |
19639113 GH |
244 | char *file; |
245 | char *mode; | |
246 | ||
247 | SCM_ASSERT (SCM_NIMP (filename) && SCM_ROSTRINGP (filename), filename, SCM_ARG1, s_open_file); | |
248 | SCM_ASSERT (SCM_NIMP (modes) && SCM_ROSTRINGP (modes), modes, SCM_ARG2, s_open_file); | |
249 | if (SCM_SUBSTRP (filename)) | |
250 | filename = scm_makfromstr (SCM_ROCHARS (filename), SCM_ROLENGTH (filename), 0); | |
251 | if (SCM_SUBSTRP (modes)) | |
252 | modes = scm_makfromstr (SCM_ROCHARS (modes), SCM_ROLENGTH (modes), 0); | |
253 | ||
254 | file = SCM_ROCHARS (filename); | |
255 | mode = SCM_ROCHARS (modes); | |
256 | ||
0f2d19dd | 257 | SCM_DEFER_INTS; |
19639113 | 258 | SCM_SYSCALL (f = fopen (file, mode)); |
0f2d19dd JB |
259 | if (!f) |
260 | { | |
3d8d56df GH |
261 | int en = errno; |
262 | ||
f5bf2977 | 263 | scm_syserror_msg (s_open_file, "%s: %S", |
19639113 GH |
264 | scm_listify (scm_makfrom0str (strerror (errno)), |
265 | filename, | |
3d8d56df GH |
266 | SCM_UNDEFINED), |
267 | en); | |
0f2d19dd JB |
268 | } |
269 | else | |
e145dd02 JB |
270 | port = scm_stdio_to_port (f, mode, filename); |
271 | SCM_ALLOW_INTS; | |
272 | return port; | |
273 | } | |
274 | ||
275 | ||
276 | SCM_PROC (s_freopen, "freopen", 3, 0, 0, scm_freopen); | |
277 | ||
278 | SCM | |
279 | scm_freopen (filename, modes, port) | |
280 | SCM filename; | |
281 | SCM modes; | |
282 | SCM port; | |
283 | { | |
284 | FILE *f; | |
285 | SCM_ASSERT (SCM_NIMP (filename) && SCM_ROSTRINGP (filename), filename, | |
286 | SCM_ARG1, s_freopen); | |
287 | SCM_ASSERT (SCM_NIMP (modes) && SCM_ROSTRINGP (modes), modes, SCM_ARG2, | |
288 | s_freopen); | |
19639113 | 289 | |
e145dd02 JB |
290 | SCM_COERCE_SUBSTR (filename); |
291 | SCM_COERCE_SUBSTR (modes); | |
292 | port = SCM_COERCE_OUTPORT (port); | |
293 | SCM_DEFER_INTS; | |
294 | SCM_ASSERT (SCM_NIMP (port) && SCM_FPORTP (port), port, SCM_ARG3, s_freopen); | |
295 | SCM_SYSCALL (f = freopen (SCM_ROCHARS (filename), SCM_ROCHARS (modes), | |
296 | (FILE *)SCM_STREAM (port))); | |
297 | if (!f) | |
298 | { | |
299 | SCM p; | |
300 | p = port; | |
301 | port = SCM_MAKINUM (errno); | |
302 | SCM_SETAND_CAR (p, ~SCM_OPN); | |
303 | scm_remove_from_port_table (p); | |
304 | } | |
305 | else | |
306 | { | |
307 | SCM_SETSTREAM (port, (SCM)f); | |
308 | SCM_SETCAR (port, (scm_tc16_fport | |
309 | | scm_mode_bits (SCM_ROCHARS (modes)) | |
310 | | FPORT_READ_SAFE | FPORT_WRITE_SAFE)); | |
a6c64c3c | 311 | if (SCM_BUF0 & SCM_CAR (port)) |
0f2d19dd | 312 | scm_setbuf0 (port); |
0f2d19dd | 313 | } |
19639113 | 314 | SCM_ALLOW_INTS; |
0f2d19dd JB |
315 | return port; |
316 | } | |
317 | ||
a089567e | 318 | |
e145dd02 JB |
319 | \f |
320 | /* Building Guile ports from stdio FILE pointers. */ | |
321 | ||
a089567e JB |
322 | /* Build a Scheme port from an open stdio port, FILE. |
323 | MODE indicates whether FILE is open for reading or writing; it uses | |
324 | the same notation as open-file's second argument. | |
e145dd02 | 325 | Use NAME as the port's filename. */ |
a089567e | 326 | SCM |
e145dd02 | 327 | scm_stdio_to_port (FILE *file, char *mode, SCM name) |
a089567e JB |
328 | { |
329 | long mode_bits = scm_mode_bits (mode); | |
330 | SCM port; | |
331 | struct scm_port_table * pt; | |
332 | ||
333 | SCM_NEWCELL (port); | |
334 | SCM_DEFER_INTS; | |
335 | { | |
336 | pt = scm_add_to_port_table (port); | |
337 | SCM_SETPTAB_ENTRY (port, pt); | |
e145dd02 JB |
338 | SCM_SETCAR (port, (scm_tc16_fport |
339 | | mode_bits | |
340 | | FPORT_READ_SAFE | FPORT_WRITE_SAFE)); | |
7471fb03 | 341 | SCM_SETSTREAM (port, (SCM) file); |
a089567e JB |
342 | if (SCM_BUF0 & SCM_CAR (port)) |
343 | scm_setbuf0 (port); | |
e145dd02 | 344 | SCM_PTAB_ENTRY (port)->file_name = name; |
a089567e JB |
345 | } |
346 | SCM_ALLOW_INTS; | |
e145dd02 JB |
347 | return port; |
348 | } | |
349 | ||
350 | ||
351 | /* Like scm_stdio_to_port, except that: | |
352 | - NAME is a standard C string, not a Guile string | |
353 | - we set the revealed count for FILE's file descriptor to 1, so | |
354 | that FILE won't be closed when the port object is GC'd. */ | |
355 | SCM | |
356 | scm_standard_stream_to_port (FILE *file, char *mode, char *name) | |
357 | { | |
358 | SCM port = scm_stdio_to_port (file, mode, scm_makfrom0str (name)); | |
a089567e JB |
359 | scm_set_port_revealed_x (port, SCM_MAKINUM (1)); |
360 | return port; | |
361 | } | |
362 | ||
363 | ||
e145dd02 JB |
364 | \f |
365 | /* The fport and pipe port scm_ptobfuns functions --- reading and writing */ | |
1717856b JB |
366 | |
367 | static int prinfport SCM_P ((SCM exp, SCM port, scm_print_state *pstate)); | |
368 | ||
0f2d19dd | 369 | static int |
1717856b | 370 | prinfport (exp, port, pstate) |
0f2d19dd JB |
371 | SCM exp; |
372 | SCM port; | |
1717856b | 373 | scm_print_state *pstate; |
0f2d19dd JB |
374 | { |
375 | SCM name; | |
376 | char * c; | |
377 | if (SCM_CLOSEDP (exp)) | |
378 | { | |
379 | c = "file"; | |
380 | } | |
381 | else | |
382 | { | |
383 | name = SCM_PTAB_ENTRY (exp)->file_name; | |
384 | if (SCM_NIMP (name) && SCM_ROSTRINGP (name)) | |
385 | c = SCM_ROCHARS (name); | |
386 | else | |
387 | c = "file"; | |
388 | } | |
19639113 | 389 | |
0f2d19dd JB |
390 | scm_prinport (exp, port, c); |
391 | return !0; | |
392 | } | |
393 | ||
394 | ||
1717856b | 395 | |
0f2d19dd | 396 | static int |
ea9fc30d | 397 | local_fgetc (SCM port) |
0f2d19dd | 398 | { |
ea9fc30d | 399 | FILE *s = (FILE *) SCM_STREAM (port); |
e145dd02 | 400 | pre_read (port); |
0f2d19dd JB |
401 | if (feof (s)) |
402 | return EOF; | |
403 | else | |
404 | return fgetc (s); | |
405 | } | |
406 | ||
3cb988bd TP |
407 | |
408 | static char * | |
ea9fc30d | 409 | local_fgets (SCM port, int *len) |
3cb988bd TP |
410 | { |
411 | FILE *f; | |
412 | ||
413 | char *buf = NULL; | |
414 | char *p; /* pointer to current buffer position */ | |
3cb988bd | 415 | int limit = 80; /* current size of buffer */ |
3cb988bd | 416 | |
e145dd02 JB |
417 | pre_read (port); |
418 | ||
d9803e92 JB |
419 | /* If this is a socket port or something where we can't rely on |
420 | ftell to determine how much we've read, then call the generic | |
421 | function. We could use a separate scm_ptobfuns table with | |
422 | scm_generic_fgets, but then we'd have to change SCM_FPORTP, etc. | |
423 | Ideally, it should become something that means "this port has a | |
424 | file descriptor"; sometimes we reject sockets when we shouldn't. | |
425 | But I'm too stupid at the moment to do that right. */ | |
426 | if (SCM_CAR (port) & SCM_NOFTELL) | |
427 | return scm_generic_fgets (port, len); | |
428 | ||
7a6f1ffa | 429 | f = (FILE *) SCM_STREAM (port); |
3cb988bd TP |
430 | if (feof (f)) |
431 | return NULL; | |
432 | ||
3e2043c4 | 433 | buf = (char *) malloc (limit * sizeof(char)); |
848f2a01 | 434 | *len = 0; |
3e2043c4 TP |
435 | |
436 | /* If a char has been pushed onto the port with scm_ungetc, | |
437 | read that first. */ | |
64e76448 | 438 | while (SCM_CRDYP (port)) |
3e2043c4 | 439 | { |
848f2a01 | 440 | buf[*len] = SCM_CGETUN (port); |
64e76448 MD |
441 | SCM_TRY_CLRDY (port); |
442 | if (buf[(*len)++] == '\n' || *len == limit - 1) | |
3e2043c4 | 443 | { |
848f2a01 | 444 | buf[*len] = '\0'; |
3e2043c4 TP |
445 | return buf; |
446 | } | |
447 | } | |
3cb988bd | 448 | |
8122b543 TP |
449 | while (1) |
450 | { | |
848f2a01 TP |
451 | int chunk_size = limit - *len; |
452 | long int numread, pos; | |
8122b543 | 453 | |
848f2a01 TP |
454 | p = buf + *len; |
455 | ||
456 | /* We must use ftell to figure out how many characters were read. | |
457 | If there are null characters near the end of file, and no | |
458 | terminating newline, there is no other way to tell the difference | |
459 | between an embedded null and the string-terminating null. */ | |
460 | ||
461 | pos = ftell (f); | |
8122b543 | 462 | if (fgets (p, chunk_size, f) == NULL) { |
848f2a01 | 463 | if (*len) |
8122b543 TP |
464 | return buf; |
465 | free (buf); | |
466 | return NULL; | |
467 | } | |
848f2a01 TP |
468 | numread = ftell (f) - pos; |
469 | *len += numread; | |
3cb988bd | 470 | |
848f2a01 | 471 | if (numread < chunk_size - 1 || buf[limit-2] == '\n') |
8122b543 | 472 | return buf; |
3cb988bd | 473 | |
8122b543 | 474 | buf = (char *) realloc (buf, sizeof(char) * limit * 2); |
8122b543 TP |
475 | limit *= 2; |
476 | } | |
3cb988bd TP |
477 | } |
478 | ||
0f2d19dd | 479 | #ifdef vms |
1717856b JB |
480 | |
481 | static scm_sizet pwrite SCM_P ((char *ptr, scm_sizet size, nitems, FILE *port)); | |
482 | ||
0f2d19dd JB |
483 | static scm_sizet |
484 | pwrite (ptr, size, nitems, port) | |
485 | char *ptr; | |
486 | scm_sizet size, nitems; | |
487 | FILE *port; | |
0f2d19dd JB |
488 | { |
489 | scm_sizet len = size * nitems; | |
490 | scm_sizet i = 0; | |
491 | for (; i < len; i++) | |
492 | putc (ptr[i], port); | |
493 | return len; | |
494 | } | |
495 | ||
496 | #define ffwrite pwrite | |
497 | #else | |
498 | #define ffwrite fwrite | |
499 | #endif | |
500 | ||
0f2d19dd | 501 | static int |
ea9fc30d | 502 | local_fclose (SCM port) |
0f2d19dd | 503 | { |
ea9fc30d JB |
504 | FILE *fp = (FILE *) SCM_STREAM (port); |
505 | ||
0f2d19dd JB |
506 | return fclose (fp); |
507 | } | |
508 | ||
509 | static int | |
ea9fc30d | 510 | local_fflush (SCM port) |
0f2d19dd | 511 | { |
ea9fc30d | 512 | FILE *fp = (FILE *) SCM_STREAM (port); |
0f2d19dd | 513 | return fflush (fp); |
e145dd02 | 514 | FPORT_ALL_OKAY (port); |
0f2d19dd JB |
515 | } |
516 | ||
517 | static int | |
ea9fc30d | 518 | local_fputc (int c, SCM port) |
0f2d19dd | 519 | { |
ea9fc30d JB |
520 | FILE *fp = (FILE *) SCM_STREAM (port); |
521 | ||
e145dd02 | 522 | pre_write (port); |
0f2d19dd JB |
523 | return fputc (c, fp); |
524 | } | |
525 | ||
526 | static int | |
ea9fc30d | 527 | local_fputs (char *s, SCM port) |
0f2d19dd | 528 | { |
ea9fc30d | 529 | FILE *fp = (FILE *) SCM_STREAM (port); |
e145dd02 | 530 | pre_write (port); |
0f2d19dd JB |
531 | return fputs (s, fp); |
532 | } | |
533 | ||
534 | static scm_sizet | |
ea9fc30d JB |
535 | local_ffwrite (char *ptr, |
536 | scm_sizet size, | |
537 | scm_sizet nitems, | |
538 | SCM port) | |
0f2d19dd | 539 | { |
ea9fc30d | 540 | FILE *fp = (FILE *) SCM_STREAM (port); |
e145dd02 | 541 | pre_write (port); |
0f2d19dd JB |
542 | return ffwrite (ptr, size, nitems, fp); |
543 | } | |
544 | ||
8f29fbd0 JB |
545 | static int |
546 | print_pipe_port (SCM exp, SCM port, scm_print_state *pstate) | |
547 | { | |
548 | scm_prinport (exp, port, "pipe"); | |
549 | return 1; | |
550 | } | |
551 | ||
6a2c4c81 | 552 | static int |
ea9fc30d | 553 | local_pclose (SCM port) |
6a2c4c81 | 554 | { |
ea9fc30d JB |
555 | FILE *fp = (FILE *) SCM_STREAM (port); |
556 | ||
6a2c4c81 JB |
557 | return pclose (fp); |
558 | } | |
559 | ||
0f2d19dd | 560 | \f |
e145dd02 JB |
561 | /* The file and pipe port scm_ptobfuns structures themselves. */ |
562 | ||
0f2d19dd JB |
563 | scm_ptobfuns scm_fptob = |
564 | { | |
dc53f026 | 565 | 0, |
ea9fc30d | 566 | local_fclose, |
0f2d19dd JB |
567 | prinfport, |
568 | 0, | |
ea9fc30d JB |
569 | local_fputc, |
570 | local_fputs, | |
571 | local_ffwrite, | |
572 | local_fflush, | |
573 | local_fgetc, | |
574 | local_fgets, | |
575 | local_fclose | |
0f2d19dd JB |
576 | }; |
577 | ||
6a2c4c81 | 578 | /* {Pipe ports} */ |
0f2d19dd JB |
579 | scm_ptobfuns scm_pipob = |
580 | { | |
dc53f026 | 581 | 0, |
ea9fc30d | 582 | local_pclose, |
8f29fbd0 | 583 | print_pipe_port, |
0f2d19dd | 584 | 0, |
ea9fc30d JB |
585 | local_fputc, |
586 | local_fputs, | |
587 | local_ffwrite, | |
588 | local_fflush, | |
589 | local_fgetc, | |
590 | scm_generic_fgets, | |
591 | local_pclose | |
19468eff | 592 | }; |
0f2d19dd | 593 | |
0f2d19dd JB |
594 | void |
595 | scm_init_fports () | |
0f2d19dd JB |
596 | { |
597 | #include "fports.x" | |
7a6f1ffa GH |
598 | scm_sysintern ("_IOFBF", SCM_MAKINUM (_IOFBF)); |
599 | scm_sysintern ("_IOLBF", SCM_MAKINUM (_IOLBF)); | |
600 | scm_sysintern ("_IONBF", SCM_MAKINUM (_IONBF)); | |
0f2d19dd | 601 | } |