/* [<][>][^][v][top][bottom][index][help] */
DEFINITIONS
This source file includes following definitions.
- vport
- vport_getb
- vport_getc
- vport_getz
- vport_ready
- vport_putb
- vport_putc
- vport_putz
- vport_puts
- vport_flush
- vport_close
- vport_seek
- vport_allocate
- vport_print
- bport
- bport_fill
- bport_flush
- bport_close
- bport_ready
- bport_filenum
- bport_seek
- bport_allocate
- Scm_Init_vport
1 /*
2 * vport.c - 'virtual port'
3 *
4 * Copyright (c) 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: vport.c,v 1.13 2005/10/28 02:20:26 shirok Exp $
34 */
35
36 #include "gauche/vport.h"
37 #include "gauche/uvector.h"
38 #include <gauche/class.h>
39 #include <gauche/extend.h>
40
41 /*================================================================
42 * <virtual-port>
43 */
44
45 static ScmObj vport_allocate(ScmClass *klass, ScmObj initargs);
46 static void vport_print(ScmObj obj, ScmPort *port, ScmWriteContext *ctx);
47
48 static ScmClass *vport_cpa[] = {
49 SCM_CLASS_STATIC_PTR(Scm_PortClass),
50 SCM_CLASS_STATIC_PTR(Scm_TopClass),
51 NULL
52 };
53
54 SCM_DEFINE_BASE_CLASS(Scm_VirtualInputPortClass, ScmPort,
55 vport_print, NULL, NULL,
56 vport_allocate, vport_cpa);
57
58 SCM_DEFINE_BASE_CLASS(Scm_VirtualOutputPortClass, ScmPort,
59 vport_print, NULL, NULL,
60 vport_allocate, vport_cpa);
61
62 /*
63 * Scheme handlers. They are visible from Scheme as instance slots.
64 * Any of these slots can be #f - if possible, the vport tries to fulfill
65 * the feature by using alternative methods. If not possible, it raises
66 * 'not supported' error.
67 */
68 typedef struct vport_rec {
69 ScmObj getb_proc; /* () -> Maybe Byte */
70 ScmObj getc_proc; /* () -> Maybe Char */
71 ScmObj gets_proc; /* (Size) -> Maybe String */
72 ScmObj ready_proc; /* (Bool) -> Bool */
73 ScmObj putb_proc; /* (Byte) -> () */
74 ScmObj putc_proc; /* (Char) -> () */
75 ScmObj puts_proc; /* (String) -> () */
76 ScmObj flush_proc; /* () -> () */
77 ScmObj close_proc; /* () -> () */
78 ScmObj seek_proc; /* (Offset, Whence) -> Offset */
79 } vport;
80
81 /*------------------------------------------------------------
82 * Vport Getb
83 */
84 static int vport_getb(ScmPort *p)
85 {
86 vport *data = (vport*)p->src.vt.data;
87 SCM_ASSERT(data != NULL);
88
89 if (SCM_FALSEP(data->getb_proc)) {
90 /* If the port doesn't have get-byte method, use get-char
91 if possible. */
92 ScmObj ch;
93 ScmChar c;
94 char buf[SCM_CHAR_MAX_BYTES];
95 int nb, i;
96
97 if (SCM_FALSEP(data->getc_proc)) return EOF;
98 ch = Scm_Apply(data->getc_proc, SCM_NIL);
99 if (!SCM_CHARP(ch)) return EOF;
100
101 c = SCM_CHAR_VALUE(ch);
102 nb = SCM_CHAR_NBYTES(c);
103 SCM_CHAR_PUT(buf, c);
104
105 for (i=1; i<nb; i++) {
106 /* pushback for later use. this isn't very efficient;
107 if efficiency becomes a problem, we need another API
108 to pushback multiple bytes. */
109 Scm_UngetbUnsafe(buf[i], p);
110 }
111 return buf[0];
112 } else {
113 ScmObj b = Scm_Apply(data->getb_proc, SCM_NIL);
114 if (!SCM_INTP(b)) return EOF;
115 return (SCM_INT_VALUE(b) & 0xff);
116 }
117 }
118
119 /*------------------------------------------------------------
120 * Vport Getc
121 */
122 static int vport_getc(ScmPort *p)
123 {
124 vport *data = (vport*)p->src.vt.data;
125 SCM_ASSERT(data != NULL);
126
127 if (SCM_FALSEP(data->getc_proc)) {
128 /* If the port doesn't have get-char method, try get-byte */
129 ScmObj b;
130 int n, i;
131 ScmChar ch;
132 char buf[SCM_CHAR_MAX_BYTES];
133
134 if (SCM_FALSEP(data->getb_proc)) return EOF;
135 b = Scm_Apply(data->getb_proc, SCM_NIL);
136 if (!SCM_INTP(b)) return EOF;
137 buf[0] = SCM_INT_VALUE(b);
138 n = SCM_CHAR_NFOLLOWS(p->scratch[0]);
139 for (i=0; i<n; i++) {
140 b = Scm_Apply(data->getb_proc, SCM_NIL);
141 if (!SCM_INTP(b)) {
142 /* TODO: should raise an exception? */
143 return EOF;
144 }
145 buf[i+1] = SCM_INT_VALUE(b);
146 }
147 SCM_CHAR_GET(buf, ch);
148 return ch;
149 } else {
150 ScmObj ch = Scm_Apply(data->getc_proc, SCM_NIL);
151 if (!SCM_CHARP(ch)) return EOF;
152 return SCM_CHAR_VALUE(ch);
153 }
154 }
155
156 /*------------------------------------------------------------
157 * Vport Gets
158 */
159 static int vport_getz(char *buf, int buflen, ScmPort *p)
160 {
161 vport *data = (vport*)p->src.vt.data;
162 SCM_ASSERT(data != NULL);
163
164 if (!SCM_FALSEP(data->gets_proc)) {
165 u_int size;
166 const char *start;
167 ScmObj s = Scm_Apply(data->gets_proc, SCM_LIST1(SCM_MAKE_INT(buflen)));
168 if (!SCM_STRINGP(s)) return EOF;
169 start = Scm_GetStringContent(SCM_STRING(s), &size, NULL, NULL);
170 if (size > buflen) {
171 /* NB: should raise an exception? */
172 memcpy(buf, start, buflen);
173 return buflen;
174 } else {
175 memcpy(buf, start, size);
176 return size;
177 }
178 } else {
179 int byte, i;
180 for (i=0; i<buflen; i++) {
181 byte = vport_getb(p);
182 if (byte == EOF) break;
183 buf[i] = byte;
184 }
185 if (i==0) return EOF;
186 else return i;
187 }
188 }
189
190 /*------------------------------------------------------------
191 * Vport Ready
192 */
193 static int vport_ready(ScmPort *p, int charp)
194 {
195 vport *data = (vport*)p->src.vt.data;
196 SCM_ASSERT(data != NULL);
197
198 if (!SCM_FALSEP(data->ready_proc)) {
199 ScmObj s = Scm_Apply(data->ready_proc,
200 SCM_LIST1(SCM_MAKE_BOOL(charp)));
201 return !SCM_FALSEP(s);
202 } else {
203 /* if no method is given, always return #t */
204 return TRUE;
205 }
206 }
207
208 /*------------------------------------------------------------
209 * Vport putb
210 */
211 static void vport_putb(ScmByte b, ScmPort *p)
212 {
213 vport *data = (vport*)p->src.vt.data;
214 SCM_ASSERT(data != NULL);
215
216 if (SCM_FALSEP(data->putb_proc)) {
217 if (!SCM_FALSEP(data->putc_proc)
218 && SCM_CHAR_NFOLLOWS(b) == 0) {
219 /* This byte is a single-byte character, so we can use putc. */
220 Scm_Apply(data->putc_proc, SCM_LIST1(SCM_MAKE_CHAR(b)));
221 } else {
222 /* Given byte is a part of multibyte sequence. We don't
223 handle it for the time being. */
224 Scm_PortError(p, SCM_PORT_ERROR_UNIT,
225 "cannot perform binary output to the port %S", p);
226 }
227 } else {
228 Scm_Apply(data->putb_proc, SCM_LIST1(SCM_MAKE_INT(b)));
229 }
230 }
231
232 /*------------------------------------------------------------
233 * Vport putc
234 */
235 static void vport_putc(ScmChar c, ScmPort *p)
236 {
237 vport *data = (vport*)p->src.vt.data;
238 SCM_ASSERT(data != NULL);
239
240 if (SCM_FALSEP(data->putc_proc)) {
241 if (SCM_FALSEP(data->putb_proc)) {
242 Scm_PortError(p, SCM_PORT_ERROR_OTHER,
243 "cannot perform output to the port %S", p);
244 } else {
245 unsigned char buf[SCM_CHAR_MAX_BYTES];
246 int i, n=SCM_CHAR_NBYTES(c);
247 SCM_CHAR_PUT(buf, c);
248 for (i=0; i<n; i++) {
249 Scm_Apply(data->putb_proc, SCM_LIST1(SCM_MAKE_INT(buf[i])));
250 }
251 }
252 } else {
253 Scm_Apply(data->putc_proc, SCM_LIST1(SCM_MAKE_CHAR(c)));
254 }
255 }
256
257 /*------------------------------------------------------------
258 * Vport putz
259 */
260 static void vport_putz(const char *buf, int size, ScmPort *p)
261 {
262 vport *data = (vport*)p->src.vt.data;
263 SCM_ASSERT(data != NULL);
264
265 if (!SCM_FALSEP(data->puts_proc)) {
266 Scm_Apply(data->puts_proc,
267 SCM_LIST1(Scm_MakeString(buf, size, -1,
268 SCM_MAKSTR_COPYING)));
269 } else if (!SCM_FALSEP(data->putb_proc)) {
270 int i;
271 for (i=0; i<size; i++) {
272 unsigned char b = buf[i];
273 Scm_Apply(data->putb_proc, SCM_LIST1(SCM_MAKE_INT(b)));
274 }
275 } else {
276 Scm_PortError(p, SCM_PORT_ERROR_UNIT,
277 "cannot perform binary output to the port %S", p);
278 }
279 }
280
281 /*------------------------------------------------------------
282 * Vport puts
283 */
284 static void vport_puts(ScmString *s, ScmPort *p)
285 {
286 vport *data = (vport*)p->src.vt.data;
287 const ScmStringBody *b = SCM_STRING_BODY(s);
288 SCM_ASSERT(data != NULL);
289
290 if (!SCM_FALSEP(data->puts_proc)) {
291 Scm_Apply(data->puts_proc, SCM_LIST1(SCM_OBJ(s)));
292 } else if (SCM_STRING_BODY_INCOMPLETE_P(b)
293 || (SCM_FALSEP(data->putc_proc)
294 && !SCM_FALSEP(data->putb_proc))) {
295 /* we perform binary output */
296 vport_putz(SCM_STRING_BODY_START(b), SCM_STRING_BODY_SIZE(b), p);
297 } else if (!SCM_FALSEP(data->putc_proc)) {
298 ScmChar c;
299 int i;
300 const char *cp = SCM_STRING_BODY_START(b);
301 for (i=0; i < SCM_STRING_BODY_LENGTH(b); i++) {
302 SCM_CHAR_GET(cp, c);
303 cp += SCM_CHAR_NFOLLOWS(*cp)+1;
304 Scm_Apply(data->putc_proc, SCM_LIST1(SCM_MAKE_CHAR(c)));
305 }
306 } else {
307 Scm_PortError(p, SCM_PORT_ERROR_OTHER,
308 "cannot perform output to the port %S", p);
309 }
310 }
311
312 /*------------------------------------------------------------
313 * Vport flush
314 */
315 static void vport_flush(ScmPort *p)
316 {
317 vport *data = (vport*)p->src.vt.data;
318 SCM_ASSERT(data != NULL);
319 if (!SCM_FALSEP(data->flush_proc)) {
320 Scm_Apply(data->flush_proc, SCM_NIL);
321 }
322 }
323
324 /*------------------------------------------------------------
325 * Vport close
326 */
327 static void vport_close(ScmPort *p)
328 {
329 vport *data = (vport*)p->src.vt.data;
330 SCM_ASSERT(data != NULL);
331 if (!SCM_FALSEP(data->close_proc)) {
332 Scm_Apply(data->close_proc, SCM_NIL);
333 }
334 }
335
336 /*------------------------------------------------------------
337 * Vport seek
338 */
339 static off_t vport_seek(ScmPort *p, off_t off, int whence)
340 {
341 vport *data = (vport*)p->src.vt.data;
342 SCM_ASSERT(data != NULL);
343 if (!SCM_FALSEP(data->seek_proc)) {
344 ScmObj r = Scm_Apply(data->seek_proc,
345 SCM_LIST2(Scm_OffsetToInteger(off),
346 Scm_MakeInteger(whence)));
347 if (SCM_INTEGERP(r)) {
348 return Scm_IntegerToOffset(r);
349 }
350 }
351 return (off_t)-1;
352 }
353
354 /*------------------------------------------------------------
355 * Allocation & wiring
356 */
357
358 static ScmObj vport_allocate(ScmClass *klass, ScmObj initargs)
359 {
360 ScmObj port;
361 vport *data = SCM_NEW(vport);
362 ScmPortVTable vtab;
363 int dir;
364
365 data->getb_proc = SCM_FALSE;
366 data->getc_proc = SCM_FALSE;
367 data->gets_proc = SCM_FALSE;
368 data->ready_proc = SCM_FALSE;
369 data->putb_proc = SCM_FALSE;
370 data->putc_proc = SCM_FALSE;
371 data->puts_proc = SCM_FALSE;
372 data->flush_proc = SCM_FALSE;
373 data->close_proc = SCM_FALSE;
374 data->seek_proc = SCM_FALSE;
375
376 vtab.Getb = vport_getb;
377 vtab.Getc = vport_getc;
378 vtab.Getz = vport_getz;
379 vtab.Ready = vport_ready;
380 vtab.Putb = vport_putb;
381 vtab.Putc = vport_putc;
382 vtab.Putz = vport_putz;
383 vtab.Puts = vport_puts;
384 vtab.Flush = vport_flush;
385 vtab.Close = vport_close;
386 vtab.Seek = vport_seek;
387
388 if (Scm_SubtypeP(klass, SCM_CLASS_VIRTUAL_INPUT_PORT)) {
389 dir = SCM_PORT_INPUT;
390 } else if (Scm_SubtypeP(klass, SCM_CLASS_VIRTUAL_OUTPUT_PORT)) {
391 dir = SCM_PORT_OUTPUT;
392 } else {
393 Scm_Panic("vport_allocate: implementaion error (class wiring screwed?)");
394 }
395 port = Scm_MakeVirtualPort(klass, dir, &vtab);
396 SCM_PORT(port)->src.vt.data = data;
397 return port;
398 }
399
400 static void vport_print(ScmObj obj, ScmPort *port, ScmWriteContext *ctx)
401 {
402 Scm_Printf(port, "#<%A%s %A %p>",
403 Scm__InternalClassName(Scm_ClassOf(obj)),
404 SCM_PORT_CLOSED_P(obj)? "(closed)" : "",
405 Scm_PortName(SCM_PORT(obj)),
406 obj);
407 }
408
409 /* Accessors */
410 #define VPORT_ACC(name) \
411 static ScmObj SCM_CPP_CAT3(vport_,name,_get) (ScmObj p) \
412 { \
413 vport *data = (vport*)SCM_PORT(p)->src.vt.data; \
414 SCM_ASSERT(data != NULL); \
415 return data->SCM_CPP_CAT(name,_proc); \
416 } \
417 static void SCM_CPP_CAT3(vport_,name,_set) (ScmObj p, ScmObj v) \
418 { \
419 vport *data = (vport*)SCM_PORT(p)->src.vt.data; \
420 SCM_ASSERT(data != NULL); \
421 data->SCM_CPP_CAT(name,_proc) = v; \
422 }
423
424 VPORT_ACC(getb)
425 VPORT_ACC(getc)
426 VPORT_ACC(gets)
427 VPORT_ACC(ready)
428 VPORT_ACC(putb)
429 VPORT_ACC(putc)
430 VPORT_ACC(puts)
431 VPORT_ACC(flush)
432 VPORT_ACC(close)
433 VPORT_ACC(seek)
434
435 #define VPORT_SLOT(name) \
436 SCM_CLASS_SLOT_SPEC(#name, \
437 SCM_CPP_CAT3(vport_,name,_get), \
438 SCM_CPP_CAT3(vport_,name,_set))
439
440 static ScmClassStaticSlotSpec viport_slots[] = {
441 VPORT_SLOT(getb),
442 VPORT_SLOT(getc),
443 VPORT_SLOT(gets),
444 VPORT_SLOT(ready),
445 VPORT_SLOT(close),
446 VPORT_SLOT(seek),
447 SCM_CLASS_SLOT_SPEC_END()
448 };
449
450 static ScmClassStaticSlotSpec voport_slots[] = {
451 VPORT_SLOT(putb),
452 VPORT_SLOT(putc),
453 VPORT_SLOT(puts),
454 VPORT_SLOT(flush),
455 VPORT_SLOT(close),
456 VPORT_SLOT(seek),
457 SCM_CLASS_SLOT_SPEC_END()
458 };
459
460 #if 0
461 static ScmClassStaticSlotSpec vioport_slots[] = {
462 VPORT_SLOT(getb),
463 VPORT_SLOT(getc),
464 VPORT_SLOT(gets),
465 VPORT_SLOT(ready),
466 VPORT_SLOT(putb),
467 VPORT_SLOT(putc),
468 VPORT_SLOT(puts),
469 VPORT_SLOT(flush),
470 VPORT_SLOT(close),
471 VPORT_SLOT(seek),
472 SCM_CLASS_SLOT_SPEC_END()
473 };
474 #endif
475
476 /*================================================================
477 * <buffered-port>
478 */
479
480 static ScmObj bport_allocate(ScmClass *klass, ScmObj initargs);
481
482 SCM_DEFINE_BASE_CLASS(Scm_BufferedInputPortClass, ScmPort,
483 vport_print, NULL, NULL,
484 bport_allocate, vport_cpa);
485
486 SCM_DEFINE_BASE_CLASS(Scm_BufferedOutputPortClass, ScmPort,
487 vport_print, NULL, NULL,
488 bport_allocate, vport_cpa);
489
490 static ScmObj key_bufsize = SCM_FALSE; /* :buffer-size */
491
492 /*
493 * Scheme handlers. They are visible from Scheme as instance slots.
494 */
495
496 typedef struct bport_rec {
497 ScmObj fill_proc; /* (U8vector) -> Maybe Int*/
498 ScmObj flush_proc; /* (U8vector, Bool) -> Maybe Int */
499 ScmObj close_proc; /* () -> () */
500 ScmObj ready_proc; /* () -> Bool */
501 ScmObj filenum_proc; /* () -> Maybe Int */
502 ScmObj seek_proc; /* (Offset, Whence) -> Offset */
503 } bport;
504
505 /*------------------------------------------------------------
506 * Bport fill
507 */
508 static int bport_fill(ScmPort *p, int cnt)
509 {
510 bport *data = (bport*)p->src.buf.data;
511 ScmObj vec, r;
512 SCM_ASSERT(data != NULL);
513 if (SCM_FALSEP(data->fill_proc)) {
514 return 0; /* indicates EOF */
515 }
516 vec = Scm_MakeU8VectorFromArrayShared(cnt,
517 (unsigned char*)p->src.buf.buffer);
518 r = Scm_Apply(data->fill_proc, SCM_LIST1(vec));
519 if (SCM_INTP(r)) return SCM_INT_VALUE(r);
520 else if (SCM_EOFP(r)) return 0;
521 else return -1;
522 }
523
524 /*------------------------------------------------------------
525 * Bport flush
526 */
527 static int bport_flush(ScmPort *p, int cnt, int forcep)
528 {
529 bport *data = (bport*)p->src.buf.data;
530 ScmObj vec, r;
531 SCM_ASSERT(data != NULL);
532 if (SCM_FALSEP(data->flush_proc)) {
533 return cnt; /* blackhole */
534 }
535 vec = Scm_MakeU8VectorFromArrayShared(cnt,
536 (unsigned char*)p->src.buf.buffer);
537 r = Scm_Apply(data->flush_proc, SCM_LIST2(vec, SCM_MAKE_BOOL(forcep)));
538 if (SCM_INTP(r)) return SCM_INT_VALUE(r);
539 else if (SCM_EOFP(r)) return 0;
540 else return -1;
541 }
542
543 /*------------------------------------------------------------
544 * Bport close
545 */
546 static void bport_close(ScmPort *p)
547 {
548 bport *data = (bport*)p->src.buf.data;
549 SCM_ASSERT(data != NULL);
550 if (!SCM_FALSEP(data->close_proc)) {
551 Scm_Apply(data->close_proc, SCM_NIL);
552 }
553 }
554
555 /*------------------------------------------------------------
556 * Bport Ready
557 */
558 static int bport_ready(ScmPort *p)
559 {
560 bport *data = (bport*)p->src.buf.data;
561 SCM_ASSERT(data != NULL);
562
563 if (!SCM_FALSEP(data->ready_proc)) {
564 ScmObj s = Scm_Apply(data->ready_proc, SCM_NIL);
565 return SCM_FALSEP(s)? SCM_FD_WOULDBLOCK:SCM_FD_READY;
566 } else {
567 /* if no method is given, always return #t */
568 return SCM_FD_READY;
569 }
570 }
571
572 /*------------------------------------------------------------
573 * Bport filenum
574 */
575 static int bport_filenum(ScmPort *p)
576 {
577 bport *data = (bport*)p->src.buf.data;
578 SCM_ASSERT(data != NULL);
579
580 if (SCM_FALSEP(data->filenum_proc)) {
581 return -1;
582 } else {
583 ScmObj s = Scm_Apply(data->filenum_proc, SCM_NIL);
584 if (SCM_INTP(s)) return SCM_INT_VALUE(s);
585 else return -1;
586 }
587 }
588
589 /*------------------------------------------------------------
590 * Bport seek
591 */
592 static off_t bport_seek(ScmPort *p, off_t off, int whence)
593 {
594 bport *data = (bport*)p->src.buf.data;
595 SCM_ASSERT(data != NULL);
596 if (!SCM_FALSEP(data->seek_proc)) {
597 ScmObj r = Scm_Apply(data->seek_proc,
598 SCM_LIST2(Scm_OffsetToInteger(off),
599 Scm_MakeInteger(whence)));
600 if (SCM_INTEGERP(r)) {
601 return Scm_IntegerToOffset(r);
602 }
603 }
604 return (off_t)-1;
605 }
606
607 /*------------------------------------------------------------
608 * Allocation & wiring
609 */
610
611 static ScmObj bport_allocate(ScmClass *klass, ScmObj initargs)
612 {
613 ScmObj port;
614 bport *data = SCM_NEW(bport);
615 ScmPortBuffer buf;
616 int dir;
617 int bufsize = Scm_GetInteger(Scm_GetKeyword(key_bufsize, initargs,
618 SCM_MAKE_INT(0)));
619
620 data->fill_proc = SCM_FALSE;
621 data->flush_proc = SCM_FALSE;
622 data->close_proc = SCM_FALSE;
623 data->ready_proc = SCM_FALSE;
624 data->filenum_proc = SCM_FALSE;
625 data->seek_proc = SCM_FALSE;
626
627 if (bufsize > 0) {
628 buf.buffer = SCM_NEW_ATOMIC2(char*, bufsize);
629 buf.size = bufsize;
630 } else {
631 buf.buffer = NULL;
632 buf.size = 0;
633 }
634
635 buf.current = NULL;
636 buf.end = NULL;
637 buf.mode = SCM_PORT_BUFFER_FULL;
638 buf.filler = bport_fill;
639 buf.flusher = bport_flush;
640 buf.closer = bport_close;
641 buf.ready = bport_ready;
642 buf.filenum = bport_filenum;
643 buf.seeker = bport_seek;
644 buf.data = data;
645
646 if (Scm_SubtypeP(klass, SCM_CLASS_BUFFERED_INPUT_PORT)) {
647 dir = SCM_PORT_INPUT;
648 } else if (Scm_SubtypeP(klass, SCM_CLASS_BUFFERED_OUTPUT_PORT)) {
649 dir = SCM_PORT_OUTPUT;
650 } else {
651 Scm_Panic("bport_allocate: implementaion error (class wiring screwed?)");
652 }
653 port = Scm_MakeBufferedPort(klass, SCM_FALSE, dir, TRUE, &buf);
654 return port;
655 }
656
657 /* Accessors */
658 #define BPORT_ACC(name) \
659 static ScmObj SCM_CPP_CAT3(bport_,name,_get) (ScmObj p) \
660 { \
661 bport *data = (bport*)SCM_PORT(p)->src.buf.data; \
662 SCM_ASSERT(data != NULL); \
663 return data->SCM_CPP_CAT(name,_proc); \
664 } \
665 static void SCM_CPP_CAT3(bport_,name,_set) (ScmObj p, ScmObj v) \
666 { \
667 bport *data = (bport*)SCM_PORT(p)->src.buf.data; \
668 SCM_ASSERT(data != NULL); \
669 data->SCM_CPP_CAT(name,_proc) = v; \
670 }
671
672 BPORT_ACC(fill)
673 BPORT_ACC(ready)
674 BPORT_ACC(flush)
675 BPORT_ACC(close)
676 BPORT_ACC(filenum)
677 BPORT_ACC(seek)
678
679 #define BPORT_SLOT(name) \
680 SCM_CLASS_SLOT_SPEC(#name, \
681 SCM_CPP_CAT3(bport_,name,_get), \
682 SCM_CPP_CAT3(bport_,name,_set))
683
684 static ScmClassStaticSlotSpec biport_slots[] = {
685 BPORT_SLOT(fill),
686 BPORT_SLOT(ready),
687 BPORT_SLOT(close),
688 BPORT_SLOT(filenum),
689 BPORT_SLOT(seek),
690 SCM_CLASS_SLOT_SPEC_END()
691 };
692
693 static ScmClassStaticSlotSpec boport_slots[] = {
694 BPORT_SLOT(flush),
695 BPORT_SLOT(close),
696 BPORT_SLOT(filenum),
697 BPORT_SLOT(seek),
698 SCM_CLASS_SLOT_SPEC_END()
699 };
700
701 /*================================================================
702 * Initialization
703 */
704
705 void Scm_Init_vport(void)
706 {
707 ScmModule *mod;
708 SCM_INIT_EXTENSION(vport);
709 mod = SCM_FIND_MODULE("gauche.vport", SCM_FIND_MODULE_CREATE);
710
711 Scm_InitStaticClass(&Scm_VirtualInputPortClass,
712 "<virtual-input-port>", mod, viport_slots, 0);
713 Scm_InitStaticClass(&Scm_VirtualOutputPortClass,
714 "<virtual-output-port>", mod, voport_slots, 0);
715 Scm_InitStaticClass(&Scm_BufferedInputPortClass,
716 "<buffered-input-port>", mod, biport_slots, 0);
717 Scm_InitStaticClass(&Scm_BufferedOutputPortClass,
718 "<buffered-output-port>", mod, boport_slots, 0);
719
720 key_bufsize = SCM_MAKE_KEYWORD("buffer-size");
721
722 Scm_Init_vportlib(mod);
723 }
724