/* [<][>][^][v][top][bottom][index][help] */
DEFINITIONS
This source file includes following definitions.
- port_cleanup
- port_finalize
- make_port
- Scm_ClosePort
- with_port_locking_pre_thunk
- with_port_locking_post_thunk
- Scm_VMWithPortLocking
- Scm_PortName
- Scm_PortLine
- port_print
- Scm_PortFileNo
- Scm_FdReady
- Scm_MakeBufferedPort
- bufport_flush
- bufport_write
- bufport_fill
- bufport_read
- register_buffered_port
- unregister_buffered_port
- Scm_FlushAllPorts
- Scm_BufferingMode
- Scm_GetBufferingMode
- file_filler
- file_flusher
- file_closer
- file_ready
- file_filenum
- file_seeker
- Scm_OpenFilePort
- Scm_MakePortWithFd
- Scm_MakeInputStringPort
- Scm_MakeOutputStringPort
- Scm_GetOutputString
- Scm_GetOutputStringUnsafe
- Scm_GetRemainingInputString
- null_getb
- null_getc
- null_getz
- null_ready
- null_putb
- null_putc
- null_putz
- null_puts
- null_flush
- Scm_MakeVirtualPort
- coding_port_data
- look_for_encoding
- coding_port_recognize_encoding
- coding_filler
- coding_closer
- coding_ready
- coding_filenum
- Scm_MakeCodingAwarePort
- port_restorer
- Scm_WithPort
- Scm_Stdin
- Scm_Stdout
- Scm_Stderr
- Scm__InitPort
1 /*
2 * port.c - port implementation
3 *
4 * Copyright (c) 2000-2004 Shiro Kawai, All rights reserved.
5 *
6 * Redistribution and use in source and binary forms, with or without
7 * modification, are permitted provided that the following conditions
8 * are met:
9 *
10 * 1. Redistributions of source code must retain the above copyright
11 * notice, this list of conditions and the following disclaimer.
12 *
13 * 2. Redistributions in binary form must reproduce the above copyright
14 * notice, this list of conditions and the following disclaimer in the
15 * documentation and/or other materials provided with the distribution.
16 *
17 * 3. Neither the name of the authors nor the names of its contributors
18 * may be used to endorse or promote products derived from this
19 * software without specific prior written permission.
20 *
21 * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
22 * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
23 * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
24 * A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
25 * OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
26 * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
27 * TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
28 * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
29 * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
30 * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
31 * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
32 *
33 * $Id: port.c,v 1.122 2005/10/13 08:14:13 shirok Exp $
34 */
35
36 #include <unistd.h>
37 #include <string.h>
38 #include <fcntl.h>
39 #include <errno.h>
40 #include <ctype.h>
41 #define LIBGAUCHE_BODY
42 #include "gauche.h"
43 #include "gauche/class.h"
44 #include "gauche/port.h"
45
46 #undef MAX
47 #undef MIN
48 #define MAX(a, b) ((a)>(b)? (a) : (b))
49 #define MIN(a, b) ((a)<(b)? (a) : (b))
50
51 /*================================================================
52 * Class stuff
53 */
54
55 static void port_print(ScmObj obj, ScmPort *port, ScmWriteContext *ctx);
56 static void port_finalize(ScmObj obj, void* data);
57 static void register_buffered_port(ScmPort *port);
58 static void unregister_buffered_port(ScmPort *port);
59 static void bufport_flush(ScmPort*, int, int);
60 static void file_closer(ScmPort *p);
61
62 SCM_DEFINE_BASE_CLASS(Scm_PortClass,
63 ScmPort, /* instance type */
64 port_print, NULL, NULL, NULL, NULL);
65
66 static ScmClass *port_cpl[] = {
67 SCM_CLASS_STATIC_PTR(Scm_PortClass),
68 SCM_CLASS_STATIC_PTR(Scm_TopClass),
69 NULL
70 };
71
72 SCM_DEFINE_BASE_CLASS(Scm_CodingAwarePortClass,
73 ScmPort, /* instance type */
74 port_print, NULL, NULL, NULL, port_cpl);
75
76 /*================================================================
77 * Common
78 */
79
80 /* Cleaning up:
81 * The underlying file descriptor/stream may be closed when the port
82 * is explicitly closed by close-port, or implicitly destroyed by
83 * garbage collector. To keep consistency, Scheme ports should never
84 * share the same file descriptor. However, C code and Scheme port
85 * may share the same file descriptor for efficiency (e.g. stdios).
86 * In such cases, it is C code's responsibility to destroy the port.
87 */
88 static void port_cleanup(ScmPort *port)
89 {
90 if (SCM_PORT_CLOSED_P(port)) return;
91 switch (SCM_PORT_TYPE(port)) {
92 case SCM_PORT_FILE:
93 if (SCM_PORT_DIR(port) == SCM_PORT_OUTPUT
94 && !SCM_PORT_ERROR_OCCURRED_P(port)) {
95 bufport_flush(port, 0, TRUE);
96 }
97 if (port->ownerp && port->src.buf.closer) port->src.buf.closer(port);
98 break;
99 case SCM_PORT_PROC:
100 if (port->src.vt.Close) port->src.vt.Close(port);
101 break;
102 default:
103 break;
104 }
105 SCM_PORT_CLOSED_P(port) = TRUE;
106 /* avoid unnecessary finalization */
107 Scm_UnregisterFinalizer(SCM_OBJ(port));
108 }
109
110 /* called by GC */
111 static void port_finalize(ScmObj obj, void* data)
112 {
113 port_cleanup(SCM_PORT(obj));
114 }
115
116 /*
117 * Internal Constructor.
118 * If this port owns the underlying file descriptor/stream,
119 * ownerp must be TRUE.
120 */
121 static ScmPort *make_port(ScmClass *klass, int dir, int type)
122 {
123 ScmPort *port;
124
125 port = SCM_ALLOCATE(ScmPort, klass);
126 SCM_SET_CLASS(port, klass);
127 port->direction = dir;
128 port->type = type;
129 port->scrcnt = 0;
130 port->ungotten = SCM_CHAR_INVALID;
131 port->closed = FALSE;
132 port->error = FALSE;
133 port->ownerp = FALSE;
134 port->flags = 0;
135 port->name = SCM_FALSE;
136 (void)SCM_INTERNAL_MUTEX_INIT(port->mutex);
137 (void)SCM_INTERNAL_COND_INIT(port->cv);
138 port->lockOwner = NULL;
139 port->lockCount = 0;
140 port->data = SCM_FALSE;
141 port->line = 1;
142 switch (type) {
143 case SCM_PORT_FILE: /*FALLTHROUGH*/;
144 case SCM_PORT_PROC:
145 Scm_RegisterFinalizer(SCM_OBJ(port), port_finalize, NULL);
146 break;
147 default:
148 break;
149 }
150 return port;
151 }
152
153 /*
154 * Close
155 */
156 void Scm_ClosePort(ScmPort *port)
157 {
158 ScmVM *vm = Scm_VM();
159 PORT_LOCK(port, vm);
160 PORT_SAFE_CALL(port,
161 do {
162 if (!SCM_PORT_CLOSED_P(port)) {
163 port_cleanup(port);
164 if (SCM_PORT_TYPE(port) == SCM_PORT_FILE
165 && SCM_PORT_DIR(port) == SCM_PORT_OUTPUT) {
166 unregister_buffered_port(port);
167 }
168 }
169 } while (0));
170 PORT_UNLOCK(port);
171 }
172
173 /*
174 * External routine to access port exclusively
175 */
176 static ScmObj with_port_locking_pre_thunk(ScmObj *args, int nargs, void *data)
177 {
178 ScmPort *p = (ScmPort*)data;
179 ScmVM *vm = Scm_VM();
180 PORT_LOCK(p, vm);
181 return SCM_UNDEFINED;
182 }
183
184 static ScmObj with_port_locking_post_thunk(ScmObj *args, int nargs, void *data)
185 {
186 ScmPort *p = (ScmPort*)data;
187 PORT_UNLOCK(p);
188 return SCM_UNDEFINED;
189 }
190
191 ScmObj Scm_VMWithPortLocking(ScmPort *port, ScmObj closure)
192 {
193 ScmObj before = Scm_MakeSubr(with_port_locking_pre_thunk, (void*)port,
194 0, 0, SCM_FALSE);
195 ScmObj after = Scm_MakeSubr(with_port_locking_post_thunk, (void*)port,
196 0, 0, SCM_FALSE);
197 return Scm_VMDynamicWind(before, closure, after);
198 }
199
200 /*===============================================================
201 * Getting information
202 */
203 ScmObj Scm_PortName(ScmPort *port)
204 {
205 return port->name;
206 }
207
208 int Scm_PortLine(ScmPort *port)
209 {
210 return port->line;
211 }
212
213 static void port_print(ScmObj obj, ScmPort *port, ScmWriteContext *ctx)
214 {
215 Scm_Printf(port, "#<%s%sport%s %A %p>",
216 (SCM_PORT_DIR(obj)&SCM_PORT_INPUT)? "i" : "",
217 (SCM_PORT_DIR(obj)&SCM_PORT_OUTPUT)? "o" : "",
218 SCM_PORT_CLOSED_P(obj)? "(closed)" : "",
219 Scm_PortName(SCM_PORT(obj)),
220 obj);
221 }
222
223 /* Returns port's associated file descriptor number, if any.
224 Returns -1 otherwise. */
225 int Scm_PortFileNo(ScmPort *port)
226 {
227 if (SCM_PORT_TYPE(port) == SCM_PORT_FILE) {
228 if (port->src.buf.filenum) return port->src.buf.filenum(port);
229 else return -1;
230 } else {
231 /* TODO: proc port */
232 return -1;
233 }
234 }
235
236 /* Low-level function to find if the file descriptor is ready or not.
237 DIR specifies SCM_PORT_INPUT or SCM_PORT_OUTPUT.
238 If the system doesn't have select(), this function returns
239 SCM_FD_UNKNOWN. */
240 int Scm_FdReady(int fd, int dir)
241 {
242 #ifdef HAVE_SELECT
243 fd_set fds;
244 int r;
245 struct timeval tm;
246
247 /* In case if this is called on non-file ports.*/
248 if (fd < 0) return SCM_FD_READY;
249
250 FD_ZERO(&fds);
251 FD_SET(fd, &fds);
252 tm.tv_sec = tm.tv_usec = 0;
253 if (dir == SCM_PORT_OUTPUT) {
254 SCM_SYSCALL(r, select(fd+1, NULL, &fds, NULL, &tm));
255 } else {
256 SCM_SYSCALL(r, select(fd+1, &fds, NULL, NULL, &tm));
257 }
258 if (r < 0) Scm_SysError("select failed");
259 if (r > 0) return SCM_FD_READY;
260 else return SCM_FD_WOULDBLOCK;
261 #else /*!HAVE_SELECT*/
262 return SCM_FD_UNKNOWN;
263 #endif /*!HAVE_SELECT*/
264 }
265
266 /*===============================================================
267 * buffered Port
268 * - mainly used for buffered file I/O, but can also be used
269 * for other purpose, like character-code conversion port.
270 */
271
272 /* [Buffered port protocol]
273 *
274 * Legends
275 * b = port->src.buf.buffer
276 * c = port->src.buf.current
277 * e = port->src.buf.end
278 * '*' = valid data
279 * '-' = invalid data
280 *
281 * Output
282 *
283 * When used as output, the end pointer always points one byte past
284 * the buffer. Initially the buffer is empty and the current pointer
285 * is the same as the beginning of the buffer.
286 *
287 * port->src.buf.flusher(ScmPort* p, int cnt, int forcep) is called when
288 * the port needs to create some room in the buffer. When the flusher
289 * is called, the buffer is like this:
290 *
291 * <--------------- size ---------------->
292 * |*********************************-----|
293 * ^ ^ ^
294 * b c e
295 *
296 * The flusher is supposed to output the cnt bytes of data beginning from
297 * the buffer, which is usually up to the current pointer (but the flusher
298 * doesn't need to check the current pointer; it is taken care of by the
299 * caller of the flusher).
300 *
301 * If the third argument forcep is false, the flusher may return before
302 * entire data is output, in case like underlying device is busy.
303 * The flusher must output at least one byte even in that case.
304 * On the other hand, if the forcep argument is true, the flusher must
305 * write cnt bytes; if it is not possible, the flusher must return -1 to
306 * indicate an error(*1).
307 *
308 * The flusher returns the number of bytes actually written out.
309 * If an error occurs, the flusher must return -1.
310 *
311 * The flusher must be aware that the port p is locked by the current
312 * thread when called.
313 *
314 * The flusher shouldn't change the buffer's internal state.
315 *
316 * After the flusher returns, bufport_flush shifts the unflushed data
317 * (if any), so the buffer becomes like this:
318 *
319 * <--------------- size ---------------->
320 * |****----------------------------------|
321 * ^ ^ ^
322 * b c e
323 *
324 * (*1) Why should these two mode need to be distinguished? Suppose
325 * you implement a buffered port that does character encoding conversion.
326 * The flusher converts the content of the buffer to different character
327 * encoding and feed it to some specified port. It is often the case
328 * that you find a few bytes at the end of the buffer which you can't
329 * convert into a whole character but have to wait for next byte(s).
330 * It is valid that you leave them in the buffer if you can expect
331 * more data to come. However, if you know it is really the end of
332 * the stream, you can't leave any data in the buffer and you should
333 * take appropriate action, for example, raising an error.
334 *
335 * Input
336 *
337 * When used as input, the end pointer points to one byte past the
338 * end of the valid data, which may be before the end of the buffer.
339 *
340 * port->src.buf.filler(ScmPort *p, int cnt) is called when the buffer
341 * doesn't have enough data to read. Suppose the input routine detects
342 * the buffer doesn't have enough data when it looks like this:
343 *
344 * <--------------- size ---------------->
345 * |-----------------------------****-----|
346 * ^ ^ ^
347 * b c e
348 *
349 * First, bufport_fill shifts the unread data (if any) to the beginning
350 * of the buffer, so it becomes like this:
351 *
352 * <--------------- size ---------------->
353 * |****----------------------------------|
354 * ^ ^
355 * bc e
356 *
357 * Then port->src.buf.filler is called. It is supposed to read as many
358 * bytes as cnt, putting them after the end pointer. It may read
359 * less if all cnt bytes of data is not available immediately.
360 * The filler returns the number of bytes actually read in.
361 * The filler should return 0 if it reaches the end of the data source.
362 * If an error occurs, the filler must return -1.
363 *
364 * bufport_fill then adjust the end pointer, so the buffer becomes like
365 * this.
366 *
367 * <--------------- size ---------------->
368 * |************************************--|
369 * ^ ^
370 * bc e
371 *
372 * Close
373 * Port is closed either explicitly (via close-port etc) or implicity
374 * (via GC -> finalizer). In either case, the flusher is called first
375 * if there's any data remaining in the buffer. Then, if the closer
376 * procedure (port->src.buf.closer) is not NULL, and port->owner is TRUE,
377 * the closer procedure is called which has to take care of any system-
378 * level cleanup. The closer can assume the buffer is already flushed.
379 *
380 * Ready
381 * When char-ready? is called on a buffered port, it first checks if
382 * there's any data available in the buffer. If so, it returns true.
383 * If not, it calls port->src.buf.ready if it is not NULL to query
384 * the character is ready. If port->src.buf.ready is NULL, bufport
385 * assumes the input is always ready.
386 * port->src.buf.ready should return either SCM_FD_READY, SCM_FD_WOULDBLOCK
387 * or SCM_FD_UNKNOWN.
388 *
389 * Filenum
390 * Port->src.buf.filenum is a query procedure that should return the
391 * underlying integer file descriptor of the port, or -1 if there's
392 * no associated one. If it is NULL, the port is assumed not to
393 * be associated to any file descriptor.
394 *
395 * Buffering mode
396 * {For Output}
397 * SCM_PORT_BUFFER_FULL : Full buffering. The buffer is flushed
398 * only when the buffer gets full, explicitly requested, or
399 * closed. This is the default, and suitable for file I/O.
400 *
401 * SCM_PORT_BUFFER_LINE : Line buffering. The buffer is flushed
402 * when a newline character is put, other than the normal
403 * circumstances as in SCM_PORT_BUFFER_FULL. Unlike C stdio,
404 * the buffer isn't flushed when an input is called on the same
405 * terminal device.
406 * This is natural for output of interactive communication.
407 * This is the default of stdout.
408 *
409 * SCM_PORT_BUFFER_NONE : data is always passed to the flusher
410 * procedure. The buffer is used just as a temporary storage.
411 * This slows down port operation significantly. Should only
412 * be used when you want to guarantee what you write is always
413 * passed to the lower layer. This is the default of stderr.
414 *
415 * {For Input}
416 * SCM_PORT_BUFFER_FULL : Full buffering. The filler procedure
417 * is called only if the buffer doesn't have enough data to
418 * satisfy the read request. Read-block or read-string won't
419 * return until the specified bytes/characters are read from
420 * the port, except the port reaches EOF.
421 *
422 * SCM_PORT_BUFFER_LINE : For input ports, this is almost the same
423 * as BUFFER_FULL, except that read-block and read-string may
424 * return shorter data than requested, if only that amount of
425 * data is immediately available. Usually this mode is suitable
426 * for the ports that is attached to a pipe or network.
427 *
428 * SCM_PORT_BUFFER_NONE : No buffering. Every time the data is
429 * requested, the filler procedure is called with exact amount
430 * of the requested data.
431 */
432
433 #define SCM_PORT_DEFAULT_BUFSIZ 8192
434
435 ScmObj Scm_MakeBufferedPort(ScmClass *klass,
436 ScmObj name,
437 int dir, /* direction */
438 int ownerp, /* owner flag*/
439 ScmPortBuffer *bufrec)
440 {
441 ScmPort *p;
442 int size = bufrec->size;
443 char *buf = bufrec->buffer;
444
445 if (size <= 0) size = SCM_PORT_DEFAULT_BUFSIZ;
446 if (buf == NULL) buf = SCM_NEW_ATOMIC2(char*, size);
447 p = make_port(klass, dir, SCM_PORT_FILE);
448 p->name = name;
449 p->ownerp = ownerp;
450 p->src.buf.buffer = buf;
451 if (dir == SCM_PORT_INPUT) {
452 p->src.buf.current = p->src.buf.buffer;
453 p->src.buf.end = p->src.buf.buffer;
454 } else {
455 p->src.buf.current = p->src.buf.buffer;
456 p->src.buf.end = p->src.buf.buffer + size;
457 }
458 p->src.buf.size = size;
459 p->src.buf.mode = bufrec->mode;
460 p->src.buf.filler = bufrec->filler;
461 p->src.buf.flusher = bufrec->flusher;
462 p->src.buf.closer = bufrec->closer;
463 p->src.buf.ready = bufrec->ready;
464 p->src.buf.filenum = bufrec->filenum;
465 p->src.buf.seeker = bufrec->seeker;
466 p->src.buf.data = bufrec->data;
467 if (dir == SCM_PORT_OUTPUT) register_buffered_port(p);
468 return SCM_OBJ(p);
469 }
470
471 /* flushes the buffer, to make a room of cnt bytes.
472 cnt == 0 means all the available data. Note that, unless forcep == TRUE,
473 this function only does "best effort" to make room, but doesn't
474 guarantee to output cnt bytes. */
475 static void bufport_flush(ScmPort *p, int cnt, int forcep)
476 {
477 int cursiz = SCM_PORT_BUFFER_AVAIL(p);
478 int nwrote, force = FALSE;
479
480 if (cursiz == 0) return;
481 if (cnt <= 0) { cnt = cursiz; force = TRUE; }
482 nwrote = p->src.buf.flusher(p, cnt, forcep);
483 if (nwrote < 0) {
484 p->src.buf.current = p->src.buf.buffer; /* for safety */
485 p->error = TRUE;
486 /* TODO: can we raise an error here, or should we propagate
487 it to the caller? */
488 Scm_PortError(p, SCM_PORT_ERROR_OUTPUT,
489 "Couldn't flush port %S due to an error", p);
490 }
491 if (nwrote >= 0 && nwrote < cursiz) {
492 memmove(p->src.buf.buffer, p->src.buf.buffer+nwrote,
493 cursiz-nwrote);
494 p->src.buf.current -= nwrote;
495 } else {
496 p->src.buf.current = p->src.buf.buffer;
497 }
498 }
499
500 /* Writes siz bytes in src to the buffered port. siz may be larger than
501 the port's buffer. Won't return until entire siz bytes are written. */
502 static void bufport_write(ScmPort *p, const char *src, int siz)
503 {
504 do {
505 int room = (int)(p->src.buf.end - p->src.buf.current);
506 if (room >= siz) {
507 memcpy(p->src.buf.current, src, siz);
508 p->src.buf.current += siz;
509 siz = 0;
510 } else {
511 memcpy(p->src.buf.current, src, room);
512 p->src.buf.current += room;
513 siz -= room;
514 src += room;
515 bufport_flush(p, 0, FALSE);
516 }
517 } while (siz > 0);
518 }
519
520 /* Fills the buffer. Reads at least MIN bytes (unless it reaches EOF).
521 * If ALLOW_LESS is true, however, we allow to return before the full
522 * data is read.
523 * Returns the number of bytes actually read, or 0 if EOF, or -1 if error.
524 */
525 static int bufport_fill(ScmPort *p, int min, int allow_less)
526 {
527 int cursiz = (int)(p->src.buf.end - p->src.buf.current);
528 int nread = 0, toread;
529 if (cursiz > 0) {
530 memmove(p->src.buf.buffer, p->src.buf.current, cursiz);
531 p->src.buf.current = p->src.buf.buffer;
532 p->src.buf.end = p->src.buf.current + cursiz;
533 } else {
534 p->src.buf.current = p->src.buf.end = p->src.buf.buffer;
535 }
536 if (min <= 0) min = SCM_PORT_BUFFER_ROOM(p);
537 if (p->src.buf.mode != SCM_PORT_BUFFER_NONE) {
538 toread = SCM_PORT_BUFFER_ROOM(p);
539 } else {
540 toread = min;
541 }
542
543 do {
544 int r = p->src.buf.filler(p, toread-nread);
545 if (r <= 0) break;
546 nread += r;
547 p->src.buf.end += r;
548 } while (!allow_less && nread < min);
549 return nread;
550 }
551
552 /* Reads siz bytes to dst from the buffered port. siz may be larger
553 * than the port's buffer, in which case the filler procedure is called
554 * more than once. Unless the port buffering mode is BUFFER_FULL,
555 * this may read less than SIZ bytes if only that amount of data is
556 * immediately available.
557 * Caveat: if the filler procedure returns N where 0 < N < requested size,
558 * we know less data is available; non-greedy read can return at that point.
559 * However, if the filler procedure returns exactly the requested size,
560 * and we need more bytes, we gotta be careful -- next call to the filler
561 * procedure may or may not hang. So we need to check the ready procedure.
562 */
563 static int bufport_read(ScmPort *p, char *dst, int siz)
564 {
565 int nread = 0, r, req;
566 int avail = (int)(p->src.buf.end - p->src.buf.current);
567
568 req = MIN(siz, avail);
569 if (req > 0) {
570 memcpy(dst, p->src.buf.current, req);
571 p->src.buf.current += req;
572 nread += req;
573 siz -= req;
574 dst += req;
575 }
576 while (siz > 0) {
577 req = MIN(siz, p->src.buf.size);
578 r = bufport_fill(p, req, TRUE);
579 if (r <= 0) break; /* EOF or an error*/
580 if (r >= siz) {
581 memcpy(dst, p->src.buf.current, siz);
582 p->src.buf.current += siz;
583 nread += siz;
584 break;
585 } else {
586 memcpy(dst, p->src.buf.current, r);
587 p->src.buf.current += r;
588 nread += r;
589 siz -= r;
590 dst += r;
591 }
592 if (p->src.buf.mode != SCM_PORT_BUFFER_FULL) {
593 if (r < req) break;
594 if (p->src.buf.ready
595 && p->src.buf.ready(p) == SCM_FD_WOULDBLOCK) {
596 break;
597 }
598 }
599 }
600 return nread;
601 }
602
603 /* Tracking buffered ports:
604 * The system doesn't automatically flush the buffered output port,
605 * as it does on FILE* structure. So Gauche keeps track of active
606 * output buffered ports, in a weak vector.
607 * When the port is no longer used, it is collected by GC and removed
608 * from the vector. Scm_FlushAllPorts() flushes the active ports.
609 */
610
611 /*TODO: allow to extend the port vector. */
612
613 #define PORT_VECTOR_SIZE 256 /* need to be 2^n */
614
615 static struct {
616 int dummy;
617 ScmWeakVector *ports;
618 ScmInternalMutex mutex;
619 } active_buffered_ports = { 1, NULL }; /* magic to put this in .data area */
620
621 #define PORT_HASH(port) \
622 ((((SCM_WORD(port)>>3) * 2654435761UL)>>16) % PORT_VECTOR_SIZE)
623
624 static void register_buffered_port(ScmPort *port)
625 {
626 int i, h, c;
627 h = i = PORT_HASH(port);
628 c = 0;
629 /* search the available entry by quadratic hash */
630 (void)SCM_INTERNAL_MUTEX_LOCK(active_buffered_ports.mutex);
631 while (!SCM_FALSEP(Scm_WeakVectorRef(active_buffered_ports.ports, i, SCM_FALSE))) {
632 i -= ++c; if (i<0) i+=PORT_VECTOR_SIZE;
633 if (i == h) Scm_Panic("active buffered port table overflow");
634 }
635 Scm_WeakVectorSet(active_buffered_ports.ports, i, SCM_OBJ(port));
636 (void)SCM_INTERNAL_MUTEX_UNLOCK(active_buffered_ports.mutex);
637 }
638
639 /* This should be called when the output buffered port is explicitly closed.
640 The ports collected by GC are automatically unregistered. */
641 static void unregister_buffered_port(ScmPort *port)
642 {
643 int i, h, c;
644 ScmObj p;
645
646 h = i = PORT_HASH(port);
647 c = 0;
648 (void)SCM_INTERNAL_MUTEX_LOCK(active_buffered_ports.mutex);
649 do {
650 p = Scm_WeakVectorRef(active_buffered_ports.ports, i, SCM_FALSE);
651 if (!SCM_FALSEP(p) && SCM_EQ(SCM_OBJ(port), p)) {
652 Scm_WeakVectorSet(active_buffered_ports.ports, i, SCM_FALSE);
653 break;
654 }
655 i -= ++c; if (i<0) i+=PORT_VECTOR_SIZE;
656 } while (i != h);
657 (void)SCM_INTERNAL_MUTEX_UNLOCK(active_buffered_ports.mutex);
658 }
659
660 /* Flush all ports. Note that it is possible that this routine can be
661 called recursively if one of the flushing routine calls Scm_Exit.
662 In order to avoid infinite loop, I have to delete the entries of already
663 flushed port before calling flush, then recover them before return
664 (unless exitting is true, in that case we know nobody cares the active
665 port vector anymore).
666 Even if more than one thread calls Scm_FlushAllPorts simultaneously,
667 the flush method is called only once, from one of the calling thread.
668 */
669 void Scm_FlushAllPorts(int exitting)
670 {
671 ScmWeakVector *save, *ports;
672 ScmObj p = SCM_FALSE;
673 int i, saved = 0;
674
675 save = SCM_WEAK_VECTOR(Scm_MakeWeakVector(PORT_VECTOR_SIZE));
676 ports = active_buffered_ports.ports;
677
678 for (i=0; i<PORT_VECTOR_SIZE;) {
679 (void)SCM_INTERNAL_MUTEX_LOCK(active_buffered_ports.mutex);
680 for (; i<PORT_VECTOR_SIZE; i++) {
681 p = Scm_WeakVectorRef(ports, i, SCM_FALSE);
682 if (!SCM_FALSEP(p)) {
683 Scm_WeakVectorSet(save, i, p);
684 Scm_WeakVectorSet(ports, i, SCM_FALSE);
685 saved++;
686 break;
687 }
688 }
689 (void)SCM_INTERNAL_MUTEX_UNLOCK(active_buffered_ports.mutex);
690 if (!SCM_FALSEP(p)) {
691 SCM_ASSERT(SCM_PORTP(p) && SCM_PORT_TYPE(p)==SCM_PORT_FILE);
692 if (!SCM_PORT_ERROR_OCCURRED_P(SCM_PORT(p))) {
693 bufport_flush(SCM_PORT(p), 0, TRUE);
694 }
695 }
696 }
697 if (!exitting && saved) {
698 (void)SCM_INTERNAL_MUTEX_LOCK(active_buffered_ports.mutex);
699 for (i=0; i<PORT_VECTOR_SIZE; i++) {
700 p = Scm_WeakVectorRef(save, i, SCM_FALSE);
701 if (!SCM_FALSEP(p)) Scm_WeakVectorSet(ports, i, p);
702 }
703 (void)SCM_INTERNAL_MUTEX_UNLOCK(active_buffered_ports.mutex);
704 }
705 }
706
707 /* Utility procedure to translate Scheme arg into buffering mode */
708 static ScmObj key_full = SCM_UNBOUND;
709 static ScmObj key_modest = SCM_UNBOUND;
710 static ScmObj key_line = SCM_UNBOUND;
711 static ScmObj key_none = SCM_UNBOUND;
712
713 int Scm_BufferingMode(ScmObj flag, int direction, int fallback)
714 {
715 if (SCM_EQ(flag, key_full)) return SCM_PORT_BUFFER_FULL;
716 if (SCM_EQ(flag, key_none)) return SCM_PORT_BUFFER_NONE;
717 if (fallback >= 0 && (SCM_UNBOUNDP(flag) || SCM_FALSEP(flag)))
718 return fallback;
719 if (direction == SCM_PORT_INPUT) {
720 if (SCM_EQ(flag, key_modest)) return SCM_PORT_BUFFER_LINE;
721 else Scm_Error("buffering mode must be one of :full, :modest or :none, but got %S", flag);
722 }
723 if (direction == SCM_PORT_OUTPUT) {
724 if (SCM_EQ(flag, key_line)) return SCM_PORT_BUFFER_LINE;
725 else Scm_Error("buffering mode must be one of :full, :line or :none, but got %S", flag);
726 }
727 /* if direction is none of input or output, allow both. */
728 if (SCM_EQ(flag, key_line) || SCM_EQ(flag, key_modest)) {
729 return SCM_PORT_BUFFER_LINE;
730 }
731 else Scm_Error("buffering mode must be one of :full, :modest, :line or :none, but got %S", flag);
732 return -1; /* dummy */
733 }
734
735 ScmObj Scm_GetBufferingMode(ScmPort *port)
736 {
737 if (SCM_PORT_TYPE(port) == SCM_PORT_FILE) {
738 switch (port->src.buf.mode) {
739 case SCM_PORT_BUFFER_FULL: return key_full;
740 case SCM_PORT_BUFFER_NONE: return key_none;
741 default:
742 if (SCM_IPORTP(port)) return key_modest;
743 else return key_line;
744 }
745 }
746 return SCM_FALSE;
747 }
748
749 /*===============================================================
750 * Generic procedures
751 */
752
753 #define SAFE_PORT_OP
754 #include "portapi.c"
755 #undef SAFE_PORT_OP
756 #include "portapi.c"
757
758 /*===============================================================
759 * File Port
760 */
761
762 static int file_filler(ScmPort *p, int cnt)
763 {
764 int nread = 0, r;
765 int fd = (int)p->src.buf.data;
766 char *datptr = p->src.buf.end;
767 SCM_ASSERT(fd >= 0);
768 while (nread == 0) {
769 errno = 0;
770 SCM_SYSCALL(r, read(fd, datptr, cnt-nread));
771 if (r < 0) {
772 p->error = TRUE;
773 Scm_SysError("read failed on %S", p);
774 } else if (r == 0) {
775 /* EOF is read */
776 break;
777 } else {
778 datptr += r;
779 nread += r;
780 }
781 }
782 return nread;
783 }
784
785 static int file_flusher(ScmPort *p, int cnt, int forcep)
786 {
787 int nwrote = 0, r;
788 int datsiz = SCM_PORT_BUFFER_AVAIL(p);
789 int fd = (int)p->src.buf.data;
790 char *datptr = p->src.buf.buffer;
791
792 SCM_ASSERT(fd >= 0);
793 while ((!forcep && nwrote == 0)
794 || (forcep && nwrote < cnt)) {
795 errno = 0;
796 SCM_SYSCALL(r, write(fd, datptr, datsiz-nwrote));
797 if (r < 0) {
798 p->error = TRUE;
799 Scm_SysError("write failed on %S", p);
800 } else {
801 datptr += r;
802 nwrote += r;
803 }
804 }
805 return nwrote;
806 }
807
808 static void file_closer(ScmPort *p)
809 {
810 int fd = (int)p->src.buf.data;
811 SCM_ASSERT(fd >= 0);
812 close(fd);
813 }
814
815 static int file_ready(ScmPort *p)
816 {
817 int fd = (int)p->src.buf.data;
818 SCM_ASSERT(fd >= 0);
819 return Scm_FdReady(fd, SCM_PORT_DIR(p));
820 }
821
822 static int file_filenum(ScmPort *p)
823 {
824 return (int)p->src.buf.data;
825 }
826
827 static off_t file_seeker(ScmPort *p, off_t offset, int whence)
828 {
829 return lseek((int)p->src.buf.data, offset, whence);
830 }
831
832 ScmObj Scm_OpenFilePort(const char *path, int flags, int buffering, int perm)
833 {
834 int fd, dir = 0;
835 ScmObj p;
836 ScmPortBuffer bufrec;
837
838 if ((flags & O_ACCMODE) == O_RDONLY) dir = SCM_PORT_INPUT;
839 else if ((flags & O_ACCMODE) == O_WRONLY) dir = SCM_PORT_OUTPUT;
840 else Scm_Error("unsupported file access mode %d to open %s", flags&O_ACCMODE, path);
841 if (buffering < SCM_PORT_BUFFER_FULL || buffering > SCM_PORT_BUFFER_NONE) {
842 Scm_Error("bad buffering flag: %d", buffering);
843 }
844 #if defined(__MINGW32__)
845 /* Force binary mode if not specified */
846 if (!(flags & (O_TEXT|O_BINARY))) {
847 flags |= O_BINARY;
848 }
849 #endif /*__MINGW32__*/
850 fd = open(path, flags, perm);
851 if (fd < 0) return SCM_FALSE;
852 bufrec.mode = buffering;
853 bufrec.buffer = NULL;
854 bufrec.size = 0;
855 bufrec.filler = file_filler;
856 bufrec.flusher = file_flusher;
857 bufrec.closer = file_closer;
858 bufrec.ready = file_ready;
859 bufrec.filenum = file_filenum;
860 bufrec.seeker = file_seeker;
861 bufrec.data = (void*)fd;
862 p = Scm_MakeBufferedPort(SCM_CLASS_PORT, SCM_MAKE_STR_COPYING(path),
863 dir, TRUE, &bufrec);
864 return p;
865 }
866
867 /* Create a port on specified file descriptor.
868 NAME - used for the name of the port.
869 DIRECTION - either SCM_PORT_INPUT or SCM_PORT_OUTPUT
870 FD - the opened file descriptor.
871 BUFMODE - buffering mode (ScmPortBufferMode)
872 OWNERP - if TRUE, fd will be closed when this port is closed.
873 */
874 ScmObj Scm_MakePortWithFd(ScmObj name, int direction,
875 int fd, int bufmode, int ownerp)
876 {
877 ScmObj p;
878 ScmPortBuffer bufrec;
879
880 bufrec.buffer = NULL;
881 bufrec.size = 0;
882 bufrec.mode = bufmode;
883 bufrec.filler = file_filler;
884 bufrec.flusher =file_flusher;
885 bufrec.closer = file_closer;
886 bufrec.ready = file_ready;
887 bufrec.filenum = file_filenum;
888 bufrec.seeker = NULL;
889 bufrec.data = (void*)fd;
890
891 p = Scm_MakeBufferedPort(SCM_CLASS_PORT, name, direction, ownerp, &bufrec);
892 return p;
893 }
894
895 /*===============================================================
896 * String port
897 */
898
899 ScmObj Scm_MakeInputStringPort(ScmString *str, int privatep)
900 {
901 ScmPort *p = make_port(SCM_CLASS_PORT, SCM_PORT_INPUT, SCM_PORT_ISTR);
902 u_int size;
903 const char *s = Scm_GetStringContent(str, &size, NULL, NULL);
904 p->src.istr.start = s;
905 p->src.istr.current = s;
906 p->src.istr.end = s + size;
907 SCM_PORT(p)->name = SCM_MAKE_STR("(input string port)");
908 if (privatep) PORT_PRELOCK(p, Scm_VM());
909 return SCM_OBJ(p);
910 }
911
912 ScmObj Scm_MakeOutputStringPort(int privatep)
913 {
914 ScmPort *p = make_port(SCM_CLASS_PORT, SCM_PORT_OUTPUT, SCM_PORT_OSTR);
915 Scm_DStringInit(&p->src.ostr);
916 SCM_PORT(p)->name = SCM_MAKE_STR("(output string port)");
917 if (privatep) PORT_PRELOCK(p, Scm_VM());
918 return SCM_OBJ(p);
919 }
920
921 ScmObj Scm_GetOutputString(ScmPort *port)
922 {
923 ScmObj r;
924 ScmVM *vm;
925 if (SCM_PORT_TYPE(port) != SCM_PORT_OSTR)
926 Scm_Error("output string port required, but got %S", port);
927 vm = Scm_VM();
928 PORT_LOCK(port, vm);
929 r = Scm_DStringGet(&SCM_PORT(port)->src.ostr, 0);
930 PORT_UNLOCK(port);
931 return r;
932 }
933
934 ScmObj Scm_GetOutputStringUnsafe(ScmPort *port)
935 {
936 if (SCM_PORT_TYPE(port) != SCM_PORT_OSTR)
937 Scm_Error("output string port required, but got %S", port);
938 return Scm_DStringGet(&SCM_PORT(port)->src.ostr, 0);
939 }
940
941 ScmObj Scm_GetRemainingInputString(ScmPort *port)
942 {
943 const char *cp, *ep;
944 if (SCM_PORT_TYPE(port) != SCM_PORT_ISTR)
945 Scm_Error("input string port required, but got %S", port);
946 /* NB: we don't need to lock the port, since the string body
947 the port is pointing won't be changed */
948 ep = port->src.istr.end;
949 cp = port->src.istr.current;
950 return Scm_MakeString(cp, ep-cp, -1, 0);
951 }
952
953 /*===============================================================
954 * Procedural port
955 */
956
957 /* To create a procedural port, fill in the ScmPortVTable function
958 pointers and pass it to Scm_MakeVirutalPort. You don't need to
959 provide all the functions; put NULL if you think you don't
960 provide the functionality.
961 */
962
963 /* default dummy procedures */
964 static int null_getb(ScmPort *dummy)
965 /*ARGSUSED*/
966 {
967 return SCM_CHAR_INVALID;
968 }
969
970 static int null_getc(ScmPort *dummy)
971 /*ARGSUSED*/
972 {
973 return SCM_CHAR_INVALID;
974 }
975
976 static int null_getz(char *buf, int buflen, ScmPort *dummy)
977 /*ARGSUSED*/
978 {
979 return 0;
980 }
981
982 static int null_ready(ScmPort *dummy, int charp)
983 /*ARGSUSED*/
984 {
985 return TRUE;
986 }
987
988 static void null_putb(ScmByte b, ScmPort *dummy)
989 /*ARGSUSED*/
990 {
991 }
992
993 static void null_putc(ScmChar c, ScmPort *dummy)
994 /*ARGSUSED*/
995 {
996 }
997
998 static void null_putz(const char *str, int len, ScmPort *dummy)
999 /*ARGSUSED*/
1000 {
1001 }
1002
1003 static void null_puts(ScmString *s, ScmPort *dummy)
1004 /*ARGSUSED*/
1005 {
1006 }
1007
1008 static void null_flush(ScmPort *dummy)
1009 /*ARGSUSED*/
1010 {
1011 }
1012
1013 ScmObj Scm_MakeVirtualPort(ScmClass *klass, int direction,
1014 ScmPortVTable *vtable)
1015 {
1016 ScmPort *p = make_port(klass, direction, SCM_PORT_PROC);
1017
1018 /* Copy vtable, and ensure all entries contain some ptr */
1019 p->src.vt = *vtable;
1020 if (!p->src.vt.Getb) p->src.vt.Getb = null_getb;
1021 if (!p->src.vt.Getc) p->src.vt.Getc = null_getc;
1022 if (!p->src.vt.Getz) p->src.vt.Getz = null_getz;
1023 if (!p->src.vt.Ready) p->src.vt.Ready = null_ready;
1024 if (!p->src.vt.Putb) p->src.vt.Putb = null_putb;
1025 if (!p->src.vt.Putc) p->src.vt.Putc = null_putc;
1026 if (!p->src.vt.Putz) p->src.vt.Putz = null_putz;
1027 if (!p->src.vt.Puts) p->src.vt.Puts = null_puts;
1028 if (!p->src.vt.Flush) p->src.vt.Flush = null_flush;
1029 /* Close and Seek can be left NULL */
1030 return SCM_OBJ(p);
1031 }
1032
1033 /*===============================================================
1034 * Coding-aware port
1035 */
1036
1037 /* Coding-aware port wraps an input port, and specifically recognizes
1038 'coding' magic comment. It is primarily used when loading source
1039 code, but can be used separately. */
1040
1041 /* gauche.charconv sets the pointer */
1042 ScmPort *(*Scm_CodingAwarePortHook)(ScmPort *src,
1043 const char *srcencoding)
1044 = NULL;
1045
1046 #define CODING_MAGIC_COMMENT_LINES 2 /* maximum number of lines to be
1047 looked at for the 'encoding' magic
1048 comment. */
1049
1050 typedef struct coding_port_data_rec {
1051 ScmPort *source; /* source port */
1052 int state; /* port state; see below */
1053 const char *pbuf; /* prefetched buffer. NUL terminated.
1054 contains at most CODING_MAGIC_COMMENT_LINES
1055 newlines. */
1056 int pbufsize; /* # of bytes in pbuf */
1057 } coding_port_data;
1058
1059 enum {
1060 CODING_PORT_INIT, /* initial state */
1061 CODING_PORT_RECOGNIZED, /* prefetched up to two lines, and
1062 conversion port is set if necessary.
1063 there are buffered data in lines[]. */
1064 CODING_PORT_FLUSHED /* prefetched lines are flushed. */
1065 };
1066
1067 /* A hardcoded DFA to recognize #/;.*coding[:=]\s*([\w.-]+)/ */
1068 static const char *look_for_encoding(const char *buf)
1069 {
1070 const char *s;
1071 char *encoding;
1072
1073 init:
1074 for (;;) {
1075 switch (*buf++) {
1076 case '\0': return NULL;
1077 case ';': goto comment;
1078 }
1079 }
1080 comment:
1081 for (;;) {
1082 switch (*buf++) {
1083 case '\0': return NULL;
1084 case '\n': goto init;
1085 case '\r': if (*buf != '\n') goto init; break;
1086 case 'c' : goto coding;
1087 }
1088 }
1089 coding:
1090 if (strncmp(buf, "oding", 5) != 0) goto comment;
1091 buf+=5;
1092 if (*buf != ':' && *buf != '=') goto comment;
1093 for (buf++;;buf++) {
1094 if (*buf != ' ' && *buf != '\t') break;
1095 }
1096 if (*buf == '\0') return NULL;
1097
1098 for (s = buf;*buf;buf++) {
1099 if (!isalnum(*buf) && *buf != '_' && *buf != '-' && *buf != '.') {
1100 break;
1101 }
1102 }
1103 if (s == buf) goto comment;
1104
1105 /* Here we found a matching string, starting from s and ends at buf. */
1106
1107 /* kludge: Emacs uses special suffix #/-(unix|dos|mac)$/ to distinguish
1108 EOL variants. For compatibility, drop such suffix if we have one. */
1109 if (buf-s > 5 && (strncmp(buf-5, "-unix", 5) == 0)) {
1110 buf -= 5;
1111 } else if (buf-s > 4 && (strncmp(buf-4, "-dos", 4) == 0
1112 || strncmp(buf-4, "-mac", 4) == 0)) {
1113 buf -= 4;
1114 }
1115
1116 /* Copy and return the encoding string */
1117 encoding = SCM_NEW_ATOMIC2(char*, buf-s+1);
1118 memcpy(encoding, s, buf-s);
1119 encoding[buf-s] = '\0';
1120 return encoding;
1121 }
1122
1123 static void coding_port_recognize_encoding(ScmPort *port,
1124 coding_port_data *data)
1125 {
1126 ScmDString ds;
1127 int num_newlines = 0, c;
1128 int cr_seen = FALSE;
1129 const char *encoding = NULL;
1130
1131 SCM_ASSERT(data->source != NULL);
1132
1133 /* Prefetch up to CODING_MAGIC_COMMENT_LINES lines or the first NUL
1134 character. data->pbuf ends up holding NUL terminated string. */
1135 Scm_DStringInit(&ds);
1136 for (;;) {
1137 c = Scm_GetbUnsafe(data->source);
1138 if (c == EOF) break;
1139 if (c == 0) {
1140 /* take extra care not to lose '\0' */
1141 Scm_UngetbUnsafe(c, data->source);
1142 break;
1143 }
1144 SCM_DSTRING_PUTB(&ds, c);
1145 if (c == '\r') { /* for the source that only uses '\r' */
1146 cr_seen = TRUE;
1147 } else if (c == '\n' || cr_seen) {
1148 if (++num_newlines >= CODING_MAGIC_COMMENT_LINES) {
1149 break;
1150 }
1151 } else {
1152 cr_seen = FALSE;
1153 }
1154 }
1155 data->pbuf = Scm_DStringGetz(&ds);
1156 data->pbufsize = strlen(data->pbuf);
1157
1158 /* Look for the magic comment */
1159 encoding = look_for_encoding(data->pbuf);
1160
1161 /* Wrap the source port by conversion port, if necessary. */
1162 if (encoding == NULL || Scm_SupportedCharacterEncodingP(encoding)) {
1163 return;
1164 }
1165
1166 if (Scm_CodingAwarePortHook == NULL) {
1167 /* Require gauche.charconv.
1168 NB: we don't need mutex here, for loading the module is
1169 serialized in Scm_Require. */
1170 Scm_Require(SCM_MAKE_STR("gauche/charconv"));
1171 if (Scm_CodingAwarePortHook == NULL) {
1172 Scm_PortError(port, SCM_PORT_ERROR_OTHER,
1173 "couldn't load gauche.charconv module");
1174 }
1175 }
1176 data->source = Scm_CodingAwarePortHook(data->source, encoding);
1177 }
1178
1179 static int coding_filler(ScmPort *p, int cnt)
1180 {
1181 int nread = 0;
1182 coding_port_data *data = (coding_port_data*)p->src.buf.data;
1183 char *datptr = p->src.buf.end;
1184
1185 SCM_ASSERT(data->source);
1186
1187 /* deals with the most frequent case */
1188 if (data->state == CODING_PORT_FLUSHED) {
1189 return Scm_GetzUnsafe(datptr, cnt, data->source);
1190 }
1191
1192 if (data->state == CODING_PORT_INIT) {
1193 coding_port_recognize_encoding(p, data);
1194 data->state = CODING_PORT_RECOGNIZED;
1195 }
1196
1197 /* Here, we have data->state == CODING_PORT_RECOGNIZED */
1198 if (data->pbufsize > 0) {
1199 if (data->pbufsize <= cnt) {
1200 memcpy(datptr, data->pbuf, data->pbufsize);
1201 nread = data->pbufsize;
1202 data->pbuf = NULL;
1203 data->pbufsize = 0;
1204 data->state = CODING_PORT_FLUSHED;
1205 } else {
1206 memcpy(datptr, data->pbuf, cnt);
1207 nread = cnt;
1208 data->pbuf += cnt;
1209 data->pbufsize -= cnt;
1210 }
1211 return nread;
1212 } else {
1213 data->state = CODING_PORT_FLUSHED;
1214 return Scm_GetzUnsafe(datptr, cnt, data->source);
1215 }
1216 }
1217
1218 static void coding_closer(ScmPort *p)
1219 {
1220 coding_port_data *data = (coding_port_data*)p->src.buf.data;
1221 if (data->source) {
1222 Scm_ClosePort(data->source);
1223 data->source = NULL;
1224 }
1225 }
1226
1227 static int coding_ready(ScmPort *p)
1228 {
1229 coding_port_data *data = (coding_port_data*)p->src.buf.data;
1230 if (data->source == NULL) return TRUE;
1231 if (data->state == CODING_PORT_RECOGNIZED) {
1232 return SCM_FD_READY;
1233 } else {
1234 return Scm_ByteReadyUnsafe(p);
1235 }
1236 }
1237
1238 static int coding_filenum(ScmPort *p)
1239 {
1240 coding_port_data *data = (coding_port_data*)p->src.buf.data;
1241 if (data->source == NULL) return -1;
1242 return Scm_PortFileNo(data->source);
1243 }
1244
1245 ScmObj Scm_MakeCodingAwarePort(ScmPort *iport)
1246 {
1247 ScmObj p;
1248 ScmPortBuffer bufrec;
1249 coding_port_data *data;
1250
1251 if (!SCM_IPORTP(iport)) {
1252 Scm_Error("open-coding-aware-port requires an input port, but got %S", iport);
1253 }
1254 data = SCM_NEW(coding_port_data);
1255 data->source = iport;
1256 data->state = CODING_PORT_INIT;
1257 data->pbuf = NULL;
1258 data->pbufsize = 0;
1259
1260 bufrec.mode = SCM_PORT_BUFFER_FULL;
1261 bufrec.buffer = NULL;
1262 bufrec.size = 0;
1263 bufrec.filler = coding_filler;
1264 bufrec.flusher = NULL;
1265 bufrec.closer = coding_closer;
1266 bufrec.ready = coding_ready;
1267 bufrec.filenum = coding_filenum;
1268 bufrec.seeker = NULL;
1269 bufrec.data = (void*)data;
1270 p = Scm_MakeBufferedPort(SCM_CLASS_CODING_AWARE_PORT,
1271 Scm_PortName(iport), SCM_PORT_INPUT,
1272 TRUE, &bufrec);
1273 return p;
1274 }
1275
1276
1277 /*===============================================================
1278 * with-port
1279 */
1280 struct with_port_packet {
1281 ScmPort *origport[3];
1282 int mask;
1283 int closep;
1284 };
1285
1286 static ScmObj port_restorer(ScmObj *args, int nargs, void *data)
1287 {
1288 struct with_port_packet *p = (struct with_port_packet*)data;
1289 int pcnt = 0;
1290 ScmPort *curport;
1291
1292 if (p->mask & SCM_PORT_CURIN) {
1293 curport = SCM_CURIN;
1294 SCM_CURIN = p->origport[pcnt++];
1295 if (p->closep) Scm_ClosePort(curport);
1296 }
1297 if (p->mask & SCM_PORT_CUROUT) {
1298 curport = SCM_CUROUT;
1299 SCM_CUROUT = p->origport[pcnt++];
1300 if (p->closep) Scm_ClosePort(curport);
1301 }
1302 if (p->mask & SCM_PORT_CURERR) {
1303 curport = SCM_CURERR;
1304 SCM_CURERR = p->origport[pcnt++];
1305 if (p->closep) Scm_ClosePort(curport);
1306 }
1307 return SCM_UNDEFINED;
1308 }
1309
1310 ScmObj Scm_WithPort(ScmPort *port[], ScmObj thunk, int mask, int closep)
1311 {
1312 ScmObj finalizer;
1313 struct with_port_packet *packet;
1314 int pcnt = 0;
1315
1316 packet = SCM_NEW(struct with_port_packet);
1317 if (mask & SCM_PORT_CURIN) {
1318 packet->origport[pcnt] = SCM_CURIN;
1319 SCM_CURIN = port[pcnt++];
1320 }
1321 if (mask & SCM_PORT_CUROUT) {
1322 packet->origport[pcnt] = SCM_CUROUT;
1323 SCM_CUROUT = port[pcnt++];
1324 }
1325 if (mask & SCM_PORT_CURERR) {
1326 packet->origport[pcnt] = SCM_CURERR;
1327 SCM_CURERR = port[pcnt++];
1328 }
1329 packet->mask = mask;
1330 packet->closep = closep;
1331 finalizer = Scm_MakeSubr(port_restorer, (void*)packet,
1332 0, 0, SCM_FALSE);
1333 return Scm_VMDynamicWind(Scm_NullProc(), SCM_OBJ(thunk), finalizer);
1334 }
1335
1336 /*===============================================================
1337 * Standard ports
1338 */
1339
1340 static ScmObj scm_stdin = SCM_UNBOUND;
1341 static ScmObj scm_stdout = SCM_UNBOUND;
1342 static ScmObj scm_stderr = SCM_UNBOUND;
1343
1344 ScmObj Scm_Stdin(void)
1345 {
1346 return scm_stdin;
1347 }
1348
1349 ScmObj Scm_Stdout(void)
1350 {
1351 return scm_stdout;
1352 }
1353
1354 ScmObj Scm_Stderr(void)
1355 {
1356 return scm_stderr;
1357 }
1358
1359 /*===============================================================
1360 * Initialization
1361 */
1362
1363 void Scm__InitPort(void)
1364 {
1365 (void)SCM_INTERNAL_MUTEX_INIT(active_buffered_ports.mutex);
1366 active_buffered_ports.ports = SCM_WEAK_VECTOR(Scm_MakeWeakVector(PORT_VECTOR_SIZE));
1367
1368 Scm_InitStaticClass(&Scm_PortClass, "<port>",
1369 Scm_GaucheModule(), NULL, 0);
1370 Scm_InitStaticClass(&Scm_CodingAwarePortClass, "<coding-aware-port>",
1371 Scm_GaucheModule(), NULL, 0);
1372
1373 scm_stdin = Scm_MakePortWithFd(SCM_MAKE_STR("(stdin)"),
1374 SCM_PORT_INPUT, 0,
1375 SCM_PORT_BUFFER_FULL, TRUE);
1376 scm_stdout = Scm_MakePortWithFd(SCM_MAKE_STR("(stdout)"),
1377 SCM_PORT_OUTPUT, 1,
1378 SCM_PORT_BUFFER_LINE, TRUE);
1379 scm_stderr = Scm_MakePortWithFd(SCM_MAKE_STR("(stderr)"),
1380 SCM_PORT_OUTPUT, 2,
1381 SCM_PORT_BUFFER_NONE, TRUE);
1382 key_full = Scm_MakeKeyword(SCM_STRING(SCM_MAKE_STR("full")));
1383 key_modest = Scm_MakeKeyword(SCM_STRING(SCM_MAKE_STR("modest")));
1384 key_line = Scm_MakeKeyword(SCM_STRING(SCM_MAKE_STR("line")));
1385 key_none = Scm_MakeKeyword(SCM_STRING(SCM_MAKE_STR("none")));
1386 }