libguile/r6rs-ports.c

   1 /* Copyright (C) 2009, 2010, 2011, 2013 Free Software Foundation, Inc.
   2  *
   3  * This library is free software; you can redistribute it and/or
   4  * modify it under the terms of the GNU Lesser General Public License
   5  * as published by the Free Software Foundation; either version 3 of
   6  * the License, or (at your option) any later version.
   7  *
   8  * This library is distributed in the hope that it will be useful, but
   9  * WITHOUT ANY WARRANTY; without even the implied warranty of
  10  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  11  * Lesser General Public License for more details.
  12  *
  13  * You should have received a copy of the GNU Lesser General Public
  14  * License along with this library; if not, write to the Free Software
  15  * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
  16  * 02110-1301 USA
  17  */
  18
  19 #ifdef HAVE_CONFIG_H
  20 # include <config.h>
  21 #endif
  22
  23 #ifdef HAVE_UNISTD_H
  24 # include <unistd.h>
  25 #endif
  26
  27 #include <string.h>
  28 #include <stdio.h>
  29 #include <assert.h>
  30
  31 #include "libguile/_scm.h"
  32 #include "libguile/bytevectors.h"
  33 #include "libguile/chars.h"
  34 #include "libguile/eval.h"
  35 #include "libguile/r6rs-ports.h"
  36 #include "libguile/strings.h"
  37 #include "libguile/validate.h"
  38 #include "libguile/values.h"
  39 #include "libguile/vectors.h"
  40
  41
  42 \f
  43 /* Unimplemented features.  */
  44
  45
  46 /* Transoders are currently not implemented since Guile 1.8 is not
  47    Unicode-capable.  Thus, most of the code here assumes the use of the
  48    binary transcoder.  */
  49 static inline void
  50 transcoders_not_implemented (void)
  51 {
  52   fprintf (stderr, "%s: warning: transcoders not implemented\n",
  53            PACKAGE_NAME);
  54 }
  55
  56 \f
  57 /* End-of-file object.  */
  58
  59 SCM_DEFINE (scm_eof_object, "eof-object", 0, 0, 0,
  60             (void),
  61             "Return the end-of-file object.")
  62 #define FUNC_NAME s_scm_eof_object
  63 {
  64   return (SCM_EOF_VAL);
  65 }
  66 #undef FUNC_NAME
  67
  68 \f
  69 /* Input ports.  */
  70
  71 #ifndef MIN
  72 # define MIN(a,b) ((a) < (b) ? (a) : (b))
  73 #endif
  74
  75 /* Bytevector input ports or "bip" for short.  */
  76 static scm_t_bits bytevector_input_port_type = 0;
  77
  78 static inline SCM
  79 make_bip (SCM bv)
  80 {
  81   SCM port;
  82   char *c_bv;
  83   unsigned c_len;
  84   scm_t_port *c_port;
  85   const unsigned long mode_bits = SCM_OPN | SCM_RDNG;
  86
  87   scm_i_scm_pthread_mutex_lock (&scm_i_port_table_mutex);
  88
  89   port = scm_new_port_table_entry (bytevector_input_port_type);
  90   c_port = SCM_PTAB_ENTRY (port);
  91
  92   /* Match the expectation of `binary-port?'.  */
  93   c_port->encoding = NULL;
  94
  95   /* Prevent BV from being GC'd.  */
  96   SCM_SETSTREAM (port, SCM_UNPACK (bv));
  97
  98   /* Have the port directly access the bytevector.  */
  99   c_bv = (char *) SCM_BYTEVECTOR_CONTENTS (bv);
 100   c_len = SCM_BYTEVECTOR_LENGTH (bv);
 101
 102   c_port->read_pos = c_port->read_buf = (unsigned char *) c_bv;
 103   c_port->read_end = (unsigned char *) c_bv + c_len;
 104   c_port->read_buf_size = c_len;
 105
 106   /* Mark PORT as open, readable and unbuffered (hmm, how elegant...).  */
 107   SCM_SET_CELL_TYPE (port, bytevector_input_port_type | mode_bits);
 108
 109   scm_i_pthread_mutex_unlock (&scm_i_port_table_mutex);
 110
 111   return port;
 112 }
 113
 114 static int
 115 bip_fill_input (SCM port)
 116 {
 117   int result;
 118   scm_t_port *c_port = SCM_PTAB_ENTRY (port);
 119
 120   if (c_port->read_pos >= c_port->read_end)
 121     result = EOF;
 122   else
 123     result = (int) *c_port->read_pos;
 124
 125   return result;
 126 }
 127
 128 static scm_t_off
 129 bip_seek (SCM port, scm_t_off offset, int whence)
 130 #define FUNC_NAME "bip_seek"
 131 {
 132   scm_t_off c_result = 0;
 133   scm_t_port *c_port = SCM_PTAB_ENTRY (port);
 134
 135   switch (whence)
 136     {
 137     case SEEK_CUR:
 138       offset += c_port->read_pos - c_port->read_buf;
 139       /* Fall through.  */
 140
 141     case SEEK_SET:
 142       if (c_port->read_buf + offset <= c_port->read_end)
 143         {
 144           c_port->read_pos = c_port->read_buf + offset;
 145           c_result = offset;
 146         }
 147       else
 148         scm_out_of_range (FUNC_NAME, scm_from_int (offset));
 149       break;
 150
 151     case SEEK_END:
 152       if (c_port->read_end - offset >= c_port->read_buf)
 153         {
 154           c_port->read_pos = c_port->read_end - offset;
 155           c_result = c_port->read_pos - c_port->read_buf;
 156         }
 157       else
 158         scm_out_of_range (FUNC_NAME, scm_from_int (offset));
 159       break;
 160
 161     default:
 162       scm_wrong_type_arg_msg (FUNC_NAME, 0, port,
 163                               "invalid `seek' parameter");
 164     }
 165
 166   return c_result;
 167 }
 168 #undef FUNC_NAME
 169
 170
 171 /* Instantiate the bytevector input port type.  */
 172 static inline void
 173 initialize_bytevector_input_ports (void)
 174 {
 175   bytevector_input_port_type =
 176     scm_make_port_type ("r6rs-bytevector-input-port", bip_fill_input,
 177                         NULL);
 178
 179   scm_set_port_seek (bytevector_input_port_type, bip_seek);
 180 }
 181
 182
 183 SCM_DEFINE (scm_open_bytevector_input_port,
 184             "open-bytevector-input-port", 1, 1, 0,
 185             (SCM bv, SCM transcoder),
 186             "Return an input port whose contents are drawn from "
 187             "bytevector @var{bv}.")
 188 #define FUNC_NAME s_scm_open_bytevector_input_port
 189 {
 190   SCM_VALIDATE_BYTEVECTOR (1, bv);
 191   if (!SCM_UNBNDP (transcoder) && !scm_is_false (transcoder))
 192     transcoders_not_implemented ();
 193
 194   return (make_bip (bv));
 195 }
 196 #undef FUNC_NAME
 197
 198 \f
 199 /* Custom binary ports.  The following routines are shared by input and
 200    output custom binary ports.  */
 201
 202 #define SCM_CBP_GET_POSITION_PROC(_port)                        \
 203   SCM_SIMPLE_VECTOR_REF (SCM_PACK (SCM_STREAM (_port)), 1)
 204 #define SCM_CBP_SET_POSITION_PROC(_port)                        \
 205   SCM_SIMPLE_VECTOR_REF (SCM_PACK (SCM_STREAM (_port)), 2)
 206 #define SCM_CBP_CLOSE_PROC(_port)                               \
 207   SCM_SIMPLE_VECTOR_REF (SCM_PACK (SCM_STREAM (_port)), 3)
 208
 209 static scm_t_off
 210 cbp_seek (SCM port, scm_t_off offset, int whence)
 211 #define FUNC_NAME "cbp_seek"
 212 {
 213   SCM result;
 214   scm_t_off c_result = 0;
 215
 216   switch (whence)
 217     {
 218     case SEEK_CUR:
 219       {
 220         SCM get_position_proc;
 221
 222         get_position_proc = SCM_CBP_GET_POSITION_PROC (port);
 223         if (SCM_LIKELY (scm_is_true (get_position_proc)))
 224           result = scm_call_0 (get_position_proc);
 225         else
 226           scm_wrong_type_arg_msg (FUNC_NAME, 0, port,
 227                                   "R6RS custom binary port does not "
 228                                   "support `port-position'");
 229
 230         offset += scm_to_int (result);
 231         /* Fall through.  */
 232       }
 233
 234     case SEEK_SET:
 235       {
 236         SCM set_position_proc;
 237
 238         set_position_proc = SCM_CBP_SET_POSITION_PROC (port);
 239         if (SCM_LIKELY (scm_is_true (set_position_proc)))
 240           result = scm_call_1 (set_position_proc, scm_from_int (offset));
 241         else
 242           scm_wrong_type_arg_msg (FUNC_NAME, 0, port,
 243                                   "R6RS custom binary port does not "
 244                                   "support `set-port-position!'");
 245
 246         /* Assuming setting the position succeeded.  */
 247         c_result = offset;
 248         break;
 249       }
 250
 251     default:
 252       /* `SEEK_END' cannot be supported.  */
 253       scm_wrong_type_arg_msg (FUNC_NAME, 0, port,
 254                               "R6RS custom binary ports do not "
 255                               "support `SEEK_END'");
 256     }
 257
 258   return c_result;
 259 }
 260 #undef FUNC_NAME
 261
 262 static int
 263 cbp_close (SCM port)
 264 {
 265   SCM close_proc;
 266
 267   close_proc = SCM_CBP_CLOSE_PROC (port);
 268   if (scm_is_true (close_proc))
 269     /* Invoke the `close' thunk.  */
 270     scm_call_0 (close_proc);
 271
 272   return 1;
 273 }
 274
 275 \f
 276 /* Custom binary input port ("cbip" for short).  */
 277
 278 static scm_t_bits custom_binary_input_port_type = 0;
 279
 280 /* Size of the buffer embedded in custom binary input ports.  */
 281 #define CBIP_BUFFER_SIZE  4096
 282
 283 /* Return the bytevector associated with PORT.  */
 284 #define SCM_CBIP_BYTEVECTOR(_port)                              \
 285   SCM_SIMPLE_VECTOR_REF (SCM_PACK (SCM_STREAM (_port)), 4)
 286
 287 /* Return the various procedures of PORT.  */
 288 #define SCM_CBIP_READ_PROC(_port)                               \
 289   SCM_SIMPLE_VECTOR_REF (SCM_PACK (SCM_STREAM (_port)), 0)
 290
 291
 292 static inline SCM
 293 make_cbip (SCM read_proc, SCM get_position_proc,
 294            SCM set_position_proc, SCM close_proc)
 295 {
 296   SCM port, bv, method_vector;
 297   char *c_bv;
 298   unsigned c_len;
 299   scm_t_port *c_port;
 300   const unsigned long mode_bits = SCM_OPN | SCM_RDNG;
 301
 302   /* Use a bytevector as the underlying buffer.  */
 303   c_len = CBIP_BUFFER_SIZE;
 304   bv = scm_c_make_bytevector (c_len);
 305   c_bv = (char *) SCM_BYTEVECTOR_CONTENTS (bv);
 306
 307   /* Store the various methods and bytevector in a vector.  */
 308   method_vector = scm_c_make_vector (5, SCM_BOOL_F);
 309   SCM_SIMPLE_VECTOR_SET (method_vector, 4, bv);
 310   SCM_SIMPLE_VECTOR_SET (method_vector, 0, read_proc);
 311   SCM_SIMPLE_VECTOR_SET (method_vector, 1, get_position_proc);
 312   SCM_SIMPLE_VECTOR_SET (method_vector, 2, set_position_proc);
 313   SCM_SIMPLE_VECTOR_SET (method_vector, 3, close_proc);
 314
 315   scm_i_pthread_mutex_lock (&scm_i_port_table_mutex);
 316
 317   port = scm_new_port_table_entry (custom_binary_input_port_type);
 318   c_port = SCM_PTAB_ENTRY (port);
 319
 320   /* Match the expectation of `binary-port?'.  */
 321   c_port->encoding = NULL;
 322
 323   /* Attach it the method vector.  */
 324   SCM_SETSTREAM (port, SCM_UNPACK (method_vector));
 325
 326   /* Have the port directly access the buffer (bytevector).  */
 327   c_port->read_pos = c_port->read_buf = (unsigned char *) c_bv;
 328   c_port->read_end = (unsigned char *) c_bv;
 329   c_port->read_buf_size = c_len;
 330
 331   /* Mark PORT as open, readable and unbuffered (hmm, how elegant...).  */
 332   SCM_SET_CELL_TYPE (port, custom_binary_input_port_type | mode_bits);
 333
 334   scm_i_pthread_mutex_unlock (&scm_i_port_table_mutex);
 335
 336   return port;
 337 }
 338
 339 static int
 340 cbip_fill_input (SCM port)
 341 #define FUNC_NAME "cbip_fill_input"
 342 {
 343   int result;
 344   scm_t_port *c_port = SCM_PTAB_ENTRY (port);
 345
 346  again:
 347   if (c_port->read_pos >= c_port->read_end)
 348     {
 349       /* Invoke the user's `read!' procedure.  */
 350       unsigned c_octets;
 351       SCM bv, read_proc, octets;
 352
 353       /* Use the bytevector associated with PORT as the buffer passed to the
 354          `read!' procedure, thereby avoiding additional allocations.  */
 355       bv = SCM_CBIP_BYTEVECTOR (port);
 356       read_proc = SCM_CBIP_READ_PROC (port);
 357
 358       /* The assumption here is that C_PORT's internal buffer wasn't changed
 359          behind our back.  */
 360       assert (c_port->read_buf ==
 361               (unsigned char *) SCM_BYTEVECTOR_CONTENTS (bv));
 362       assert ((unsigned) c_port->read_buf_size
 363               == SCM_BYTEVECTOR_LENGTH (bv));
 364
 365       octets = scm_call_3 (read_proc, bv, SCM_INUM0,
 366                            SCM_I_MAKINUM (CBIP_BUFFER_SIZE));
 367       c_octets = scm_to_uint (octets);
 368
 369       c_port->read_pos = (unsigned char *) SCM_BYTEVECTOR_CONTENTS (bv);
 370       c_port->read_end = (unsigned char *) c_port->read_pos + c_octets;
 371
 372       if (c_octets > 0)
 373         goto again;
 374       else
 375         result = EOF;
 376     }
 377   else
 378     result = (int) *c_port->read_pos;
 379
 380   return result;
 381 }
 382 #undef FUNC_NAME
 383
 384
 385 SCM_DEFINE (scm_make_custom_binary_input_port,
 386             "make-custom-binary-input-port", 5, 0, 0,
 387             (SCM id, SCM read_proc, SCM get_position_proc,
 388              SCM set_position_proc, SCM close_proc),
 389             "Return a new custom binary input port whose input is drained "
 390             "by invoking @var{read_proc} and passing it a bytevector, an "
 391             "index where octets should be written, and an octet count.")
 392 #define FUNC_NAME s_scm_make_custom_binary_input_port
 393 {
 394   SCM_VALIDATE_STRING (1, id);
 395   SCM_VALIDATE_PROC (2, read_proc);
 396
 397   if (!scm_is_false (get_position_proc))
 398     SCM_VALIDATE_PROC (3, get_position_proc);
 399
 400   if (!scm_is_false (set_position_proc))
 401     SCM_VALIDATE_PROC (4, set_position_proc);
 402
 403   if (!scm_is_false (close_proc))
 404     SCM_VALIDATE_PROC (5, close_proc);
 405
 406   return (make_cbip (read_proc, get_position_proc, set_position_proc,
 407                      close_proc));
 408 }
 409 #undef FUNC_NAME
 410
 411
 412 /* Instantiate the custom binary input port type.  */
 413 static inline void
 414 initialize_custom_binary_input_ports (void)
 415 {
 416   custom_binary_input_port_type =
 417     scm_make_port_type ("r6rs-custom-binary-input-port",
 418                         cbip_fill_input, NULL);
 419
 420   scm_set_port_seek (custom_binary_input_port_type, cbp_seek);
 421   scm_set_port_close (custom_binary_input_port_type, cbp_close);
 422 }
 423
 424
 425 \f
 426 /* Binary input.  */
 427
 428 /* We currently don't support specific binary input ports.  */
 429 #define SCM_VALIDATE_BINARY_INPUT_PORT SCM_VALIDATE_OPINPORT
 430
 431 SCM_DEFINE (scm_get_u8, "get-u8", 1, 0, 0,
 432             (SCM port),
 433             "Read an octet from @var{port}, a binary input port, "
 434             "blocking as necessary.")
 435 #define FUNC_NAME s_scm_get_u8
 436 {
 437   SCM result;
 438   int c_result;
 439
 440   SCM_VALIDATE_BINARY_INPUT_PORT (1, port);
 441
 442   c_result = scm_get_byte_or_eof (port);
 443   if (c_result == EOF)
 444     result = SCM_EOF_VAL;
 445   else
 446     result = SCM_I_MAKINUM ((unsigned char) c_result);
 447
 448   return result;
 449 }
 450 #undef FUNC_NAME
 451
 452 SCM_DEFINE (scm_lookahead_u8, "lookahead-u8", 1, 0, 0,
 453             (SCM port),
 454             "Like @code{get-u8} but does not update @var{port} to "
 455             "point past the octet.")
 456 #define FUNC_NAME s_scm_lookahead_u8
 457 {
 458   int u8;
 459   SCM result;
 460
 461   SCM_VALIDATE_BINARY_INPUT_PORT (1, port);
 462
 463   u8 = scm_peek_byte_or_eof (port);
 464   if (u8 == EOF)
 465     result = SCM_EOF_VAL;
 466   else
 467     result = SCM_I_MAKINUM ((scm_t_uint8) u8);
 468
 469   return result;
 470 }
 471 #undef FUNC_NAME
 472
 473 SCM_DEFINE (scm_get_bytevector_n, "get-bytevector-n", 2, 0, 0,
 474             (SCM port, SCM count),
 475             "Read @var{count} octets from @var{port}, blocking as "
 476             "necessary and return a bytevector containing the octets "
 477             "read.  If fewer bytes are available, a bytevector smaller "
 478             "than @var{count} is returned.")
 479 #define FUNC_NAME s_scm_get_bytevector_n
 480 {
 481   SCM result;
 482   char *c_bv;
 483   unsigned c_count;
 484   size_t c_read;
 485
 486   SCM_VALIDATE_BINARY_INPUT_PORT (1, port);
 487   c_count = scm_to_uint (count);
 488
 489   result = scm_c_make_bytevector (c_count);
 490   c_bv = (char *) SCM_BYTEVECTOR_CONTENTS (result);
 491
 492   if (SCM_LIKELY (c_count > 0))
 493     /* XXX: `scm_c_read ()' does not update the port position.  */
 494     c_read = scm_c_read (port, c_bv, c_count);
 495   else
 496     /* Don't invoke `scm_c_read ()' since it may block.  */
 497     c_read = 0;
 498
 499   if (c_read < c_count)
 500     {
 501       if (c_read == 0)
 502         result = SCM_EOF_VAL;
 503       else
 504         result = scm_c_shrink_bytevector (result, c_read);
 505     }
 506
 507   return result;
 508 }
 509 #undef FUNC_NAME
 510
 511 SCM_DEFINE (scm_get_bytevector_n_x, "get-bytevector-n!", 4, 0, 0,
 512             (SCM port, SCM bv, SCM start, SCM count),
 513             "Read @var{count} bytes from @var{port} and store them "
 514             "in @var{bv} starting at index @var{start}.  Return either "
 515             "the number of bytes actually read or the end-of-file "
 516             "object.")
 517 #define FUNC_NAME s_scm_get_bytevector_n_x
 518 {
 519   SCM result;
 520   char *c_bv;
 521   unsigned c_start, c_count, c_len;
 522   size_t c_read;
 523
 524   SCM_VALIDATE_BINARY_INPUT_PORT (1, port);
 525   SCM_VALIDATE_BYTEVECTOR (2, bv);
 526   c_start = scm_to_uint (start);
 527   c_count = scm_to_uint (count);
 528
 529   c_bv = (char *) SCM_BYTEVECTOR_CONTENTS (bv);
 530   c_len = SCM_BYTEVECTOR_LENGTH (bv);
 531
 532   if (SCM_UNLIKELY (c_start + c_count > c_len))
 533     scm_out_of_range (FUNC_NAME, count);
 534
 535   if (SCM_LIKELY (c_count > 0))
 536     c_read = scm_c_read (port, c_bv + c_start, c_count);
 537   else
 538     /* Don't invoke `scm_c_read ()' since it may block.  */
 539     c_read = 0;
 540
 541   if (c_read == 0 && c_count > 0)
 542     result = SCM_EOF_VAL;
 543   else
 544     result = scm_from_size_t (c_read);
 545
 546   return result;
 547 }
 548 #undef FUNC_NAME
 549
 550
 551 SCM_DEFINE (scm_get_bytevector_some, "get-bytevector-some", 1, 0, 0,
 552             (SCM port),
 553             "Read from @var{port}, blocking as necessary, until bytes "
 554             "are available or an end-of-file is reached.  Return either "
 555             "the end-of-file object or a new bytevector containing some "
 556             "of the available bytes (at least one), and update the port "
 557             "position to point just past these bytes.")
 558 #define FUNC_NAME s_scm_get_bytevector_some
 559 {
 560   scm_t_port *pt;
 561   size_t size;
 562   SCM bv;
 563
 564   SCM_VALIDATE_BINARY_INPUT_PORT (1, port);
 565   pt = SCM_PTAB_ENTRY (port);
 566
 567   if (pt->rw_active == SCM_PORT_WRITE)
 568     scm_ptobs[SCM_PTOBNUM (port)].flush (port);
 569
 570   if (pt->rw_random)
 571     pt->rw_active = SCM_PORT_READ;
 572
 573   if (pt->read_pos >= pt->read_end)
 574     {
 575       if (scm_fill_input (port) == EOF)
 576         return SCM_EOF_VAL;
 577     }
 578
 579   size = pt->read_end - pt->read_pos;
 580   if (pt->read_buf == pt->putback_buf)
 581     size += pt->saved_read_end - pt->saved_read_pos;
 582
 583   bv = scm_c_make_bytevector (size);
 584   scm_take_from_input_buffers
 585     (port, (char *) SCM_BYTEVECTOR_CONTENTS (bv), size);
 586
 587   return bv;
 588 }
 589 #undef FUNC_NAME
 590
 591 SCM_DEFINE (scm_get_bytevector_all, "get-bytevector-all", 1, 0, 0,
 592             (SCM port),
 593             "Read from @var{port}, blocking as necessary, until "
 594             "the end-of-file is reached.  Return either "
 595             "a new bytevector containing the data read or the "
 596             "end-of-file object (if no data were available).")
 597 #define FUNC_NAME s_scm_get_bytevector_all
 598 {
 599   SCM result;
 600   char *c_bv;
 601   unsigned c_len, c_count;
 602   size_t c_read, c_total;
 603
 604   SCM_VALIDATE_BINARY_INPUT_PORT (1, port);
 605
 606   c_len = c_count = 4096;
 607   c_bv = (char *) scm_gc_malloc_pointerless (c_len, SCM_GC_BYTEVECTOR);
 608   c_total = c_read = 0;
 609
 610   do
 611     {
 612       if (c_total + c_read > c_len)
 613         {
 614           /* Grow the bytevector.  */
 615           c_bv = (char *) scm_gc_realloc (c_bv, c_len, c_len * 2,
 616                                           SCM_GC_BYTEVECTOR);
 617           c_count = c_len;
 618           c_len *= 2;
 619         }
 620
 621       /* `scm_c_read ()' blocks until C_COUNT bytes are available or EOF is
 622          reached.  */
 623       c_read = scm_c_read (port, c_bv + c_total, c_count);
 624       c_total += c_read, c_count -= c_read;
 625     }
 626   while (c_count == 0);
 627
 628   if (c_total == 0)
 629     {
 630       result = SCM_EOF_VAL;
 631       scm_gc_free (c_bv, c_len, SCM_GC_BYTEVECTOR);
 632     }
 633   else
 634     {
 635       if (c_len > c_total)
 636         {
 637           /* Shrink the bytevector.  */
 638           c_bv = (char *) scm_gc_realloc (c_bv, c_len, c_total,
 639                                           SCM_GC_BYTEVECTOR);
 640           c_len = (unsigned) c_total;
 641         }
 642
 643       result = scm_c_take_gc_bytevector ((signed char *) c_bv, c_len);
 644     }
 645
 646   return result;
 647 }
 648 #undef FUNC_NAME
 649
 650
 651 \f
 652 /* Binary output.  */
 653
 654 /* We currently don't support specific binary input ports.  */
 655 #define SCM_VALIDATE_BINARY_OUTPUT_PORT SCM_VALIDATE_OPOUTPORT
 656
 657
 658 SCM_DEFINE (scm_put_u8, "put-u8", 2, 0, 0,
 659             (SCM port, SCM octet),
 660             "Write @var{octet} to binary port @var{port}.")
 661 #define FUNC_NAME s_scm_put_u8
 662 {
 663   scm_t_uint8 c_octet;
 664
 665   SCM_VALIDATE_BINARY_OUTPUT_PORT (1, port);
 666   c_octet = scm_to_uint8 (octet);
 667
 668   scm_putc ((char) c_octet, port);
 669
 670   return SCM_UNSPECIFIED;
 671 }
 672 #undef FUNC_NAME
 673
 674 SCM_DEFINE (scm_put_bytevector, "put-bytevector", 2, 2, 0,
 675             (SCM port, SCM bv, SCM start, SCM count),
 676             "Write the contents of @var{bv} to @var{port}, optionally "
 677             "starting at index @var{start} and limiting to @var{count} "
 678             "octets.")
 679 #define FUNC_NAME s_scm_put_bytevector
 680 {
 681   char *c_bv;
 682   unsigned c_start, c_count, c_len;
 683
 684   SCM_VALIDATE_BINARY_OUTPUT_PORT (1, port);
 685   SCM_VALIDATE_BYTEVECTOR (2, bv);
 686
 687   c_len = SCM_BYTEVECTOR_LENGTH (bv);
 688   c_bv = (char *) SCM_BYTEVECTOR_CONTENTS (bv);
 689
 690   if (!scm_is_eq (start, SCM_UNDEFINED))
 691     {
 692       c_start = scm_to_uint (start);
 693
 694       if (!scm_is_eq (count, SCM_UNDEFINED))
 695         {
 696           c_count = scm_to_uint (count);
 697           if (SCM_UNLIKELY (c_start + c_count > c_len))
 698             scm_out_of_range (FUNC_NAME, count);
 699         }
 700       else
 701         {
 702           if (SCM_UNLIKELY (c_start >= c_len))
 703             scm_out_of_range (FUNC_NAME, start);
 704           else
 705             c_count = c_len - c_start;
 706         }
 707     }
 708   else
 709     c_start = 0, c_count = c_len;
 710
 711   scm_c_write (port, c_bv + c_start, c_count);
 712
 713   return SCM_UNSPECIFIED;
 714 }
 715 #undef FUNC_NAME
 716
 717 SCM_DEFINE (scm_unget_bytevector, "unget-bytevector", 2, 2, 0,
 718             (SCM port, SCM bv, SCM start, SCM count),
 719             "Unget the contents of @var{bv} to @var{port}, optionally "
 720             "starting at index @var{start} and limiting to @var{count} "
 721             "octets.")
 722 #define FUNC_NAME s_scm_unget_bytevector
 723 {
 724   unsigned char *c_bv;
 725   size_t c_start, c_count, c_len;
 726
 727   SCM_VALIDATE_BINARY_INPUT_PORT (1, port);
 728   SCM_VALIDATE_BYTEVECTOR (2, bv);
 729
 730   c_len = SCM_BYTEVECTOR_LENGTH (bv);
 731   c_bv = (unsigned char *) SCM_BYTEVECTOR_CONTENTS (bv);
 732
 733   if (!scm_is_eq (start, SCM_UNDEFINED))
 734     {
 735       c_start = scm_to_size_t (start);
 736
 737       if (!scm_is_eq (count, SCM_UNDEFINED))
 738         {
 739           c_count = scm_to_size_t (count);
 740           if (SCM_UNLIKELY (c_start + c_count > c_len))
 741             scm_out_of_range (FUNC_NAME, count);
 742         }
 743       else
 744         {
 745           if (SCM_UNLIKELY (c_start >= c_len))
 746             scm_out_of_range (FUNC_NAME, start);
 747           else
 748             c_count = c_len - c_start;
 749         }
 750     }
 751   else
 752     c_start = 0, c_count = c_len;
 753
 754   scm_unget_bytes (c_bv + c_start, c_count, port);
 755
 756   return SCM_UNSPECIFIED;
 757 }
 758 #undef FUNC_NAME
 759
 760
 761 \f
 762 /* Bytevector output port ("bop" for short).  */
 763
 764 /* Implementation of "bops".
 765
 766    Each bop has an internal buffer, of type `scm_t_bop_buffer', attached to
 767    it.  The procedure returned along with the output port is actually an
 768    applicable SMOB.  The SMOB holds a reference to the port.  When applied,
 769    the SMOB swallows the port's internal buffer, turning it into a
 770    bytevector, and resets it.
 771
 772    XXX: Access to a bop's internal buffer is not thread-safe.  */
 773
 774 static scm_t_bits bytevector_output_port_type = 0;
 775
 776 SCM_SMOB (bytevector_output_port_procedure,
 777           "r6rs-bytevector-output-port-procedure",
 778           0);
 779
 780 #define SCM_GC_BOP "r6rs-bytevector-output-port"
 781 #define SCM_BOP_BUFFER_INITIAL_SIZE 4096
 782
 783 /* Representation of a bop's internal buffer.  */
 784 typedef struct
 785 {
 786   size_t total_len;
 787   size_t len;
 788   size_t pos;
 789   char  *buffer;
 790 } scm_t_bop_buffer;
 791
 792
 793 /* Accessing a bop's buffer.  */
 794 #define SCM_BOP_BUFFER(_port)           \
 795   ((scm_t_bop_buffer *) SCM_STREAM (_port))
 796 #define SCM_SET_BOP_BUFFER(_port, _buf)         \
 797   (SCM_SETSTREAM ((_port), (scm_t_bits) (_buf)))
 798
 799
 800 static inline void
 801 bop_buffer_init (scm_t_bop_buffer *buf)
 802 {
 803   buf->total_len = buf->len = buf->pos = 0;
 804   buf->buffer = NULL;
 805 }
 806
 807 static inline void
 808 bop_buffer_grow (scm_t_bop_buffer *buf, size_t min_size)
 809 {
 810   char *new_buf;
 811   size_t new_size;
 812
 813   for (new_size = buf->total_len
 814          ? buf->total_len : SCM_BOP_BUFFER_INITIAL_SIZE;
 815        new_size < min_size;
 816        new_size *= 2);
 817
 818   if (buf->buffer)
 819     new_buf = scm_gc_realloc ((void *) buf->buffer, buf->total_len,
 820                               new_size, SCM_GC_BOP);
 821   else
 822     new_buf = scm_gc_malloc_pointerless (new_size, SCM_GC_BOP);
 823
 824   buf->buffer = new_buf;
 825   buf->total_len = new_size;
 826 }
 827
 828 static inline SCM
 829 make_bop (void)
 830 {
 831   SCM port, bop_proc;
 832   scm_t_port *c_port;
 833   scm_t_bop_buffer *buf;
 834   const unsigned long mode_bits = SCM_OPN | SCM_WRTNG;
 835
 836   scm_i_pthread_mutex_lock (&scm_i_port_table_mutex);
 837
 838   port = scm_new_port_table_entry (bytevector_output_port_type);
 839   c_port = SCM_PTAB_ENTRY (port);
 840
 841   /* Match the expectation of `binary-port?'.  */
 842   c_port->encoding = NULL;
 843
 844   buf = (scm_t_bop_buffer *) scm_gc_malloc (sizeof (* buf), SCM_GC_BOP);
 845   bop_buffer_init (buf);
 846
 847   c_port->write_buf = c_port->write_pos = c_port->write_end = NULL;
 848   c_port->write_buf_size = 0;
 849
 850   SCM_SET_BOP_BUFFER (port, buf);
 851
 852   /* Mark PORT as open and writable.  */
 853   SCM_SET_CELL_TYPE (port, bytevector_output_port_type | mode_bits);
 854
 855   scm_i_pthread_mutex_unlock (&scm_i_port_table_mutex);
 856
 857   /* Make the bop procedure.  */
 858   SCM_NEWSMOB (bop_proc, bytevector_output_port_procedure, buf);
 859
 860   return (scm_values (scm_list_2 (port, bop_proc)));
 861 }
 862
 863 /* Write SIZE octets from DATA to PORT.  */
 864 static void
 865 bop_write (SCM port, const void *data, size_t size)
 866 {
 867   scm_t_bop_buffer *buf;
 868
 869   buf = SCM_BOP_BUFFER (port);
 870
 871   if (buf->pos + size > buf->total_len)
 872     bop_buffer_grow (buf, buf->pos + size);
 873
 874   memcpy (buf->buffer + buf->pos, data, size);
 875   buf->pos += size;
 876   buf->len = (buf->len > buf->pos) ? buf->len : buf->pos;
 877 }
 878
 879 static scm_t_off
 880 bop_seek (SCM port, scm_t_off offset, int whence)
 881 #define FUNC_NAME "bop_seek"
 882 {
 883   scm_t_bop_buffer *buf;
 884
 885   buf = SCM_BOP_BUFFER (port);
 886   switch (whence)
 887     {
 888     case SEEK_CUR:
 889       offset += (scm_t_off) buf->pos;
 890       /* Fall through.  */
 891
 892     case SEEK_SET:
 893       if (offset < 0 || (unsigned) offset > buf->len)
 894         scm_out_of_range (FUNC_NAME, scm_from_int (offset));
 895       else
 896         buf->pos = offset;
 897       break;
 898
 899     case SEEK_END:
 900       if (offset < 0 || (unsigned) offset >= buf->len)
 901         scm_out_of_range (FUNC_NAME, scm_from_int (offset));
 902       else
 903         buf->pos = buf->len - (offset + 1);
 904       break;
 905
 906     default:
 907       scm_wrong_type_arg_msg (FUNC_NAME, 0, port,
 908                               "invalid `seek' parameter");
 909     }
 910
 911   return buf->pos;
 912 }
 913 #undef FUNC_NAME
 914
 915 /* Fetch data from a bop.  */
 916 SCM_SMOB_APPLY (bytevector_output_port_procedure,
 917                 bop_proc_apply, 0, 0, 0, (SCM bop_proc))
 918 {
 919   SCM bv;
 920   scm_t_bop_buffer *buf, result_buf;
 921
 922   buf = (scm_t_bop_buffer *) SCM_SMOB_DATA (bop_proc);
 923
 924   result_buf = *buf;
 925   bop_buffer_init (buf);
 926
 927   if (result_buf.len == 0)
 928     bv = scm_c_take_gc_bytevector (NULL, 0);
 929   else
 930     {
 931       if (result_buf.total_len > result_buf.len)
 932         /* Shrink the buffer.  */
 933         result_buf.buffer = scm_gc_realloc ((void *) result_buf.buffer,
 934                                             result_buf.total_len,
 935                                             result_buf.len,
 936                                             SCM_GC_BOP);
 937
 938       bv = scm_c_take_gc_bytevector ((signed char *) result_buf.buffer,
 939                                      result_buf.len);
 940     }
 941
 942   return bv;
 943 }
 944
 945 SCM_DEFINE (scm_open_bytevector_output_port,
 946             "open-bytevector-output-port", 0, 1, 0,
 947             (SCM transcoder),
 948             "Return two values: an output port and a procedure.  The latter "
 949             "should be called with zero arguments to obtain a bytevector "
 950             "containing the data accumulated by the port.")
 951 #define FUNC_NAME s_scm_open_bytevector_output_port
 952 {
 953   if (!SCM_UNBNDP (transcoder) && !scm_is_false (transcoder))
 954     transcoders_not_implemented ();
 955
 956   return (make_bop ());
 957 }
 958 #undef FUNC_NAME
 959
 960 static inline void
 961 initialize_bytevector_output_ports (void)
 962 {
 963   bytevector_output_port_type =
 964     scm_make_port_type ("r6rs-bytevector-output-port",
 965                         NULL, bop_write);
 966
 967   scm_set_port_seek (bytevector_output_port_type, bop_seek);
 968 }
 969
 970 \f
 971 /* Custom binary output port ("cbop" for short).  */
 972
 973 static scm_t_bits custom_binary_output_port_type;
 974
 975 /* Return the various procedures of PORT.  */
 976 #define SCM_CBOP_WRITE_PROC(_port)                              \
 977   SCM_SIMPLE_VECTOR_REF (SCM_PACK (SCM_STREAM (_port)), 0)
 978
 979
 980 static inline SCM
 981 make_cbop (SCM write_proc, SCM get_position_proc,
 982            SCM set_position_proc, SCM close_proc)
 983 {
 984   SCM port, method_vector;
 985   scm_t_port *c_port;
 986   const unsigned long mode_bits = SCM_OPN | SCM_WRTNG;
 987
 988   /* Store the various methods and bytevector in a vector.  */
 989   method_vector = scm_c_make_vector (4, SCM_BOOL_F);
 990   SCM_SIMPLE_VECTOR_SET (method_vector, 0, write_proc);
 991   SCM_SIMPLE_VECTOR_SET (method_vector, 1, get_position_proc);
 992   SCM_SIMPLE_VECTOR_SET (method_vector, 2, set_position_proc);
 993   SCM_SIMPLE_VECTOR_SET (method_vector, 3, close_proc);
 994
 995   scm_i_pthread_mutex_lock (&scm_i_port_table_mutex);
 996
 997   port = scm_new_port_table_entry (custom_binary_output_port_type);
 998   c_port = SCM_PTAB_ENTRY (port);
 999
1000   /* Match the expectation of `binary-port?'.  */
1001   c_port->encoding = NULL;
1002
1003   /* Attach it the method vector.  */
1004   SCM_SETSTREAM (port, SCM_UNPACK (method_vector));
1005
1006   /* Have the port directly access the buffer (bytevector).  */
1007   c_port->write_buf = c_port->write_pos = c_port->write_end = NULL;
1008   c_port->write_buf_size = c_port->read_buf_size = 0;
1009
1010   /* Mark PORT as open, writable and unbuffered.  */
1011   SCM_SET_CELL_TYPE (port, custom_binary_output_port_type | mode_bits);
1012
1013   scm_i_pthread_mutex_unlock (&scm_i_port_table_mutex);
1014
1015   return port;
1016 }
1017
1018 /* Write SIZE octets from DATA to PORT.  */
1019 static void
1020 cbop_write (SCM port, const void *data, size_t size)
1021 #define FUNC_NAME "cbop_write"
1022 {
1023   long int c_result;
1024   size_t c_written;
1025   SCM bv, write_proc, result;
1026
1027   /* XXX: Allocating a new bytevector at each `write' call is inefficient,
1028      but necessary since (1) we don't control the lifetime of the buffer
1029      pointed to by DATA, and (2) the `write!' procedure could capture the
1030      bytevector it is passed.  */
1031   bv = scm_c_make_bytevector (size);
1032   memcpy (SCM_BYTEVECTOR_CONTENTS (bv), data, size);
1033
1034   write_proc = SCM_CBOP_WRITE_PROC (port);
1035
1036   /* Since the `write' procedure of Guile's ports has type `void', it must
1037      try hard to write exactly SIZE bytes, regardless of how many bytes the
1038      sink can handle.  */
1039   for (c_written = 0;
1040        c_written < size;
1041        c_written += c_result)
1042     {
1043       result = scm_call_3 (write_proc, bv,
1044                            scm_from_size_t (c_written),
1045                            scm_from_size_t (size - c_written));
1046
1047       c_result = scm_to_long (result);
1048       if (SCM_UNLIKELY (c_result < 0
1049                         || (size_t) c_result > (size - c_written)))
1050         scm_wrong_type_arg_msg (FUNC_NAME, 0, result,
1051                                 "R6RS custom binary output port `write!' "
1052                                 "returned a incorrect integer");
1053     }
1054 }
1055 #undef FUNC_NAME
1056
1057
1058 SCM_DEFINE (scm_make_custom_binary_output_port,
1059             "make-custom-binary-output-port", 5, 0, 0,
1060             (SCM id, SCM write_proc, SCM get_position_proc,
1061              SCM set_position_proc, SCM close_proc),
1062             "Return a new custom binary output port whose output is drained "
1063             "by invoking @var{write_proc} and passing it a bytevector, an "
1064             "index where octets should be written, and an octet count.")
1065 #define FUNC_NAME s_scm_make_custom_binary_output_port
1066 {
1067   SCM_VALIDATE_STRING (1, id);
1068   SCM_VALIDATE_PROC (2, write_proc);
1069
1070   if (!scm_is_false (get_position_proc))
1071     SCM_VALIDATE_PROC (3, get_position_proc);
1072
1073   if (!scm_is_false (set_position_proc))
1074     SCM_VALIDATE_PROC (4, set_position_proc);
1075
1076   if (!scm_is_false (close_proc))
1077     SCM_VALIDATE_PROC (5, close_proc);
1078
1079   return (make_cbop (write_proc, get_position_proc, set_position_proc,
1080                      close_proc));
1081 }
1082 #undef FUNC_NAME
1083
1084
1085 /* Instantiate the custom binary output port type.  */
1086 static inline void
1087 initialize_custom_binary_output_ports (void)
1088 {
1089   custom_binary_output_port_type =
1090     scm_make_port_type ("r6rs-custom-binary-output-port",
1091                         NULL, cbop_write);
1092
1093   scm_set_port_seek (custom_binary_output_port_type, cbp_seek);
1094   scm_set_port_close (custom_binary_output_port_type, cbp_close);
1095 }
1096
1097 \f
1098 /* Transcoded ports ("tp" for short).  */
1099 static scm_t_bits transcoded_port_type = 0;
1100
1101 #define TP_INPUT_BUFFER_SIZE 4096
1102
1103 #define SCM_TP_BINARY_PORT(_port) SCM_PACK (SCM_STREAM (_port))
1104
1105 static inline SCM
1106 make_tp (SCM binary_port, unsigned long mode)
1107 {
1108   SCM port;
1109   scm_t_port *c_port;
1110   const unsigned long mode_bits = SCM_OPN | mode;
1111
1112   scm_i_pthread_mutex_lock (&scm_i_port_table_mutex);
1113
1114   port = scm_new_port_table_entry (transcoded_port_type);
1115
1116   SCM_SETSTREAM (port, SCM_UNPACK (binary_port));
1117
1118   SCM_SET_CELL_TYPE (port, transcoded_port_type | mode_bits);
1119
1120   if (SCM_INPUT_PORT_P (port))
1121     {
1122       c_port = SCM_PTAB_ENTRY (port);
1123       c_port->read_buf = scm_gc_malloc_pointerless (TP_INPUT_BUFFER_SIZE,
1124                                                     "port buffer");
1125       c_port->read_pos = c_port->read_end = c_port->read_buf;
1126       c_port->read_buf_size = TP_INPUT_BUFFER_SIZE;
1127
1128       SCM_SET_CELL_WORD_0 (port, SCM_CELL_WORD_0 (port) & ~SCM_BUF0);
1129     }
1130
1131   scm_i_pthread_mutex_unlock (&scm_i_port_table_mutex);
1132
1133   return port;
1134 }
1135
1136 static void
1137 tp_write (SCM port, const void *data, size_t size)
1138 {
1139   scm_c_write (SCM_TP_BINARY_PORT (port), data, size);
1140 }
1141
1142 static int
1143 tp_fill_input (SCM port)
1144 {
1145   size_t count;
1146   scm_t_port *c_port = SCM_PTAB_ENTRY (port);
1147   SCM bport = SCM_TP_BINARY_PORT (port);
1148   scm_t_port *c_bport = SCM_PTAB_ENTRY (bport);
1149
1150   /* We can't use `scm_c_read' here, since it blocks until the whole
1151      block has been read or EOF. */
1152
1153   if (c_bport->rw_active == SCM_PORT_WRITE)
1154     scm_force_output (bport);
1155
1156   if (c_bport->read_pos >= c_bport->read_end)
1157     scm_fill_input (bport);
1158
1159   count = c_bport->read_end - c_bport->read_pos;
1160   if (count > c_port->read_buf_size)
1161     count = c_port->read_buf_size;
1162
1163   memcpy (c_port->read_buf, c_bport->read_pos, count);
1164   c_bport->read_pos += count;
1165
1166   if (c_bport->rw_random)
1167     c_bport->rw_active = SCM_PORT_READ;
1168
1169   if (count == 0)
1170     return EOF;
1171   else
1172     {
1173       c_port->read_pos = c_port->read_buf;
1174       c_port->read_end = c_port->read_buf + count;
1175       return *c_port->read_buf;
1176     }
1177 }
1178
1179 static void
1180 tp_flush (SCM port)
1181 {
1182   SCM binary_port = SCM_TP_BINARY_PORT (port);
1183   scm_t_port *c_port = SCM_PTAB_ENTRY (port);
1184   size_t count = c_port->write_pos - c_port->write_buf;
1185
1186   /* As the runtime will try to flush all ports upon exit, we test for
1187      the underlying port still being open here. Otherwise, when you
1188      would explicitly close the underlying port and the transcoded port
1189      still had data outstanding, you'd get an exception on Guile exit.
1190
1191      We just throw away the data when the underlying port is closed.  */
1192
1193   if (SCM_OPOUTPORTP (binary_port))
1194       scm_c_write (binary_port, c_port->write_buf, count);
1195
1196   c_port->write_pos = c_port->write_buf;
1197   c_port->rw_active = SCM_PORT_NEITHER;
1198
1199   if (SCM_OPOUTPORTP (binary_port))
1200     scm_force_output (binary_port);
1201 }
1202
1203 static int
1204 tp_close (SCM port)
1205 {
1206   if (SCM_OUTPUT_PORT_P (port))
1207     tp_flush (port);
1208   return scm_is_true (scm_close_port (SCM_TP_BINARY_PORT (port))) ? 0 : -1;
1209 }
1210
1211 static inline void
1212 initialize_transcoded_ports (void)
1213 {
1214   transcoded_port_type =
1215     scm_make_port_type ("r6rs-transcoded-port", tp_fill_input, tp_write);
1216
1217   scm_set_port_flush (transcoded_port_type, tp_flush);
1218   scm_set_port_close (transcoded_port_type, tp_close);
1219 }
1220
1221 SCM_DEFINE (scm_i_make_transcoded_port,
1222             "%make-transcoded-port", 1, 0, 0,
1223             (SCM port),
1224             "Return a new port which reads and writes to @var{port}")
1225 #define FUNC_NAME s_scm_i_make_transcoded_port
1226 {
1227   SCM result;
1228   unsigned long mode = 0;
1229
1230   SCM_VALIDATE_PORT (SCM_ARG1, port);
1231
1232   if (scm_is_true (scm_output_port_p (port)))
1233     mode |= SCM_WRTNG;
1234   else if (scm_is_true (scm_input_port_p (port)))
1235     mode |=  SCM_RDNG;
1236
1237   result = make_tp (port, mode);
1238
1239   /* FIXME: We should actually close `port' "in a special way" here,
1240      according to R6RS.  As there is no way to do that in Guile without
1241      rendering the underlying port unusable for our purposes as well, we
1242      just leave it open. */
1243
1244   return result;
1245 }
1246 #undef FUNC_NAME
1247
1248 \f
1249 /* Textual I/O */
1250
1251 SCM_DEFINE (scm_get_string_n_x,
1252             "get-string-n!", 4, 0, 0,
1253             (SCM port, SCM str, SCM start, SCM count),
1254             "Read up to @var{count} characters from @var{port} into "
1255             "@var{str}, starting at @var{start}.  If no characters "
1256             "can be read before the end of file is encountered, the end "
1257             "of file object is returned.  Otherwise, the number of "
1258             "characters read is returned.")
1259 #define FUNC_NAME s_scm_get_string_n_x
1260 {
1261   size_t c_start, c_count, c_len, c_end, j;
1262   scm_t_wchar c;
1263
1264   SCM_VALIDATE_OPINPORT (1, port);
1265   SCM_VALIDATE_STRING (2, str);
1266   c_len = scm_c_string_length (str);
1267   c_start = scm_to_size_t (start);
1268   c_count = scm_to_size_t (count);
1269   c_end = c_start + c_count;
1270
1271   if (SCM_UNLIKELY (c_end > c_len))
1272     scm_out_of_range (FUNC_NAME, count);
1273
1274   for (j = c_start; j < c_end; j++)
1275     {
1276       c = scm_getc (port);
1277       if (c == EOF)
1278         {
1279           size_t chars_read = j - c_start;
1280           return chars_read == 0 ? SCM_EOF_VAL : scm_from_size_t (chars_read);
1281         }
1282       scm_c_string_set_x (str, j, SCM_MAKE_CHAR (c));
1283     }
1284   return count;
1285 }
1286 #undef FUNC_NAME
1287
1288 \f
1289 /* Initialization.  */
1290
1291 void
1292 scm_register_r6rs_ports (void)
1293 {
1294   scm_c_register_extension ("libguile-" SCM_EFFECTIVE_VERSION,
1295                             "scm_init_r6rs_ports",
1296                             (scm_t_extension_init_func) scm_init_r6rs_ports,
1297                             NULL);
1298 }
1299
1300 void
1301 scm_init_r6rs_ports (void)
1302 {
1303 #include "libguile/r6rs-ports.x"
1304
1305   initialize_bytevector_input_ports ();
1306   initialize_custom_binary_input_ports ();
1307   initialize_bytevector_output_ports ();
1308   initialize_custom_binary_output_ports ();
1309   initialize_transcoded_ports ();
1310 }