root/src/port.c

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

DEFINITIONS

This source file includes following definitions.
  1. port_cleanup
  2. port_finalize
  3. make_port
  4. Scm_ClosePort
  5. with_port_locking_pre_thunk
  6. with_port_locking_post_thunk
  7. Scm_VMWithPortLocking
  8. Scm_PortName
  9. Scm_PortLine
  10. port_print
  11. Scm_PortFileNo
  12. Scm_FdReady
  13. Scm_MakeBufferedPort
  14. bufport_flush
  15. bufport_write
  16. bufport_fill
  17. bufport_read
  18. register_buffered_port
  19. unregister_buffered_port
  20. Scm_FlushAllPorts
  21. Scm_BufferingMode
  22. Scm_GetBufferingMode
  23. file_filler
  24. file_flusher
  25. file_closer
  26. file_ready
  27. file_filenum
  28. file_seeker
  29. Scm_OpenFilePort
  30. Scm_MakePortWithFd
  31. Scm_MakeInputStringPort
  32. Scm_MakeOutputStringPort
  33. Scm_GetOutputString
  34. Scm_GetOutputStringUnsafe
  35. Scm_GetRemainingInputString
  36. null_getb
  37. null_getc
  38. null_getz
  39. null_ready
  40. null_putb
  41. null_putc
  42. null_putz
  43. null_puts
  44. null_flush
  45. Scm_MakeVirtualPort
  46. coding_port_data
  47. look_for_encoding
  48. coding_port_recognize_encoding
  49. coding_filler
  50. coding_closer
  51. coding_ready
  52. coding_filenum
  53. Scm_MakeCodingAwarePort
  54. port_restorer
  55. Scm_WithPort
  56. Scm_Stdin
  57. Scm_Stdout
  58. Scm_Stderr
  59. 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 }

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