root/ext/vport/vport.c

/* [<][>][^][v][top][bottom][index][help] */

DEFINITIONS

This source file includes following definitions.
  1. vport
  2. vport_getb
  3. vport_getc
  4. vport_getz
  5. vport_ready
  6. vport_putb
  7. vport_putc
  8. vport_putz
  9. vport_puts
  10. vport_flush
  11. vport_close
  12. vport_seek
  13. vport_allocate
  14. vport_print
  15. bport
  16. bport_fill
  17. bport_flush
  18. bport_close
  19. bport_ready
  20. bport_filenum
  21. bport_seek
  22. bport_allocate
  23. 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 

/* [<][>][^][v][top][bottom][index][help] */