Implementing R6RS `transcoded-port'

[Andreas Rottmann]

Hi!

I've done a bit of work on (rnrs io ports), and a big stumbling block is
`transcoded-port':

,----
| (transcoded-port binary-port transcoder)    procedure 
| 
| The transcoded-port procedure returns a new textual port with the
| specified transcoder. Otherwise the new textual port’s state is
| largely the same as that of binary-port. If binary-port is an input
| port, the new textual port will be an input port and will transcode
| the bytes that have not yet been read from binary-port. If binary-port
| is an output port, the new textual port will be an output port and
| will transcode output characters into bytes that are written to the
| byte sink represented by binary-port.
| 
| As a side effect, however, transcoded-port closes binary-port in a
| special way that allows the new textual port to continue to use the
| byte source or sink represented by binary-port, even though
| binary-port itself is closed and cannot be used by the input and
| output operations described in this chapter.
`----

According to this specification, one essentially needs to "copy" a port
(including buffers), mark the source of the copy as closed and adjust
the encoding of the copy.  I've been trying to do so with the following
code, but that crashes in GC -- somehow the whole scm_t_port attached to
the SCM port seems to get cleared to 0, and I don't see why. I'd be glad
if someone could take a look at the code and perhaps hint me in the
right direction.  First the test program:

;; --------8<--------------
(import (rnrs)
        (only (guile) gc))

(do ((i 0 (+ i 1)))
    ((>= i 5))
  (let* ((stdout (standard-output-port))
         (stdout-t (transcoded-port stdout (native-transcoder))))
    (display "Hello!\n" stdout-t)))

(gc) ;; <-- crashes here
;; --------8<--------------

And the C code used to implement `transcoded-port' -- I'm probably doing
something stupid in here:

SCM_DEFINE (scm_transcoded_port,
            "transcoded-port", 2, 0, 0,
            (SCM port, SCM transcoder),
            "")
#define FUNC_NAME s_scm_transcoded_port
{
  SCM codec;

  port = SCM_COERCE_OUTPORT (port);
  
  SCM_VALIDATE_PORT (SCM_ARG1, port);
  SCM_VALIDATE_STRUCT (SCM_ARG1, transcoder);

  codec = scm_struct_ref (transcoder, scm_from_int8 (2));
  
  scm_i_scm_pthread_mutex_lock (&scm_i_port_table_mutex);
  {
    scm_t_bits type = SCM_CELL_TYPE (port);
    SCM modes = scm_port_mode (port);
    SCM result = scm_new_port_table_entry (type & 0xffff);
    scm_t_port * result_pt = SCM_PTAB_ENTRY (result);
    scm_t_port * pt = SCM_PTAB_ENTRY (port);

    printf ("XXX: created port %p from %p\n", result_pt, pt);
    
    result_pt->revealed = pt->revealed;
    SCM_SETSTREAM (result, SCM_STREAM (port));

    result_pt->file_name = pt->file_name;
    result_pt->line_number = pt->line_number;
    result_pt->column_number = pt->column_number;
    
    result_pt->read_buf = pt->read_buf;
    result_pt->read_pos = pt->read_pos;
    result_pt->read_end = pt->read_end;
    result_pt->read_buf_size = pt->read_buf_size;
    
    result_pt->saved_read_buf = pt->saved_read_buf;
    result_pt->saved_read_pos = pt->saved_read_pos;
    result_pt->saved_read_end = pt->saved_read_end;
    result_pt->saved_read_buf_size = pt->saved_read_buf_size;

    result_pt->write_buf = pt->write_buf;
    result_pt->write_pos = pt->write_pos;
    result_pt->write_end = pt->write_end;
    result_pt->write_buf_size = pt->write_buf_size;

    result_pt->shortbuf = pt->shortbuf;
    result_pt->rw_random = pt->rw_random;
    result_pt->rw_active = pt->rw_active;
    result_pt->putback_buf = pt->putback_buf;
    result_pt->putback_buf_size = pt->putback_buf_size; 
   
    scm_i_remove_port (port);
    SCM_CLR_PORT_OPEN_FLAG (port);

    SCM_SET_CELL_TYPE (result, (type & 0xffff) | scm_i_mode_bits (modes));
    scm_i_pthread_mutex_unlock (&scm_i_port_table_mutex);

    scm_set_port_encoding_x (result, codec);
    
    return result;
  }
}
#undef FUNC_NAME

Regards, Rotty
-- 
Andreas Rottmann -- <http://rotty.yi.org/>