Making new ports.

[Dale P. Smith]

Greetings List!

Well, I got an apache request_rec port working!

There is some documentation on make a new port type in the cvs guile
docs.  Unfortunately, it only does half the job.  The instructions are
how to create a new port type object (ptob).  There are no
instructions on how to actually create new ports of that type.  By
browsing the source (is there any other way!), I found four different
kinds of ports: file, string, soft, and void.  Here is the code that
creates each of them. (docstrings deleted)


Soft ports:
SCM_DEFINE (scm_make_soft_port, "make-soft-port", 2, 0, 0,
           (SCM pv, SCM modes),
#define FUNC_NAME s_scm_make_soft_port
{
  scm_port *pt;
  SCM z;
  SCM_VALIDATE_VECTOR_LEN (1,pv,5);
  SCM_VALIDATE_ROSTRING (2,modes);
  SCM_COERCE_SUBSTR (modes);
  SCM_NEWCELL (z);
  SCM_DEFER_INTS;
  pt = scm_add_to_port_table (z);
  scm_port_non_buffer (pt);
  SCM_SET_CELL_TYPE (z, scm_tc16_sfport | scm_mode_bits (SCM_ROCHARS
(modes)));
  SCM_SETPTAB_ENTRY (z, pt);
  SCM_SETSTREAM (z, SCM_UNPACK (pv));
  SCM_ALLOW_INTS;
  return z;
}
#undef FUNC_NAME


String ports:
SCM 
scm_mkstrport (SCM pos, SCM str, long modes, const char *caller)
{
  SCM z;
  scm_port *pt;
  int str_len;

  SCM_ASSERT (SCM_INUMP(pos) && SCM_INUM(pos) >= 0, pos, SCM_ARG1,
caller);
  SCM_ASSERT (SCM_ROSTRINGP(str), str, SCM_ARG1, caller);
  str_len = SCM_ROLENGTH (str);
  if (SCM_INUM (pos) > str_len)
    scm_out_of_range (caller, pos);
  if (!((modes & SCM_WRTNG) || (modes & SCM_RDNG)))
    scm_misc_error ("scm_mkstrport", "port must read or write",
SCM_EOL);
  SCM_NEWCELL (z);
  SCM_DEFER_INTS;
  pt = scm_add_to_port_table (z);
  SCM_SET_CELL_TYPE (z, scm_tc16_strport | modes);
  SCM_SETPTAB_ENTRY (z, pt);
  SCM_SETSTREAM (z, SCM_UNPACK (str));
  pt->write_buf = pt->read_buf = SCM_ROUCHARS (str);
  pt->read_pos = pt->write_pos = pt->read_buf + SCM_INUM (pos);
  pt->write_buf_size = pt->read_buf_size = str_len;
  pt->write_end = pt->read_end = pt->read_buf + pt->read_buf_size;

  pt->rw_random = 1;

  SCM_ALLOW_INTS;

  /* ensure write_pos is writable. */
  if ((modes & SCM_WRTNG) && pt->write_pos == pt->write_end)
    st_flush (z);
  return z;
}

Void ports:
SCM
scm_void_port (char *mode_str)
{
  int mode_bits;
  SCM answer;
  scm_port * pt;

  SCM_NEWCELL (answer);
  SCM_DEFER_INTS;
  mode_bits = scm_mode_bits (mode_str);
  pt = scm_add_to_port_table (answer);
  scm_port_non_buffer (pt);
  SCM_SETPTAB_ENTRY (answer, pt);
  SCM_SETSTREAM (answer, 0);
  SCM_SET_CELL_TYPE (answer, scm_tc16_void_port | mode_bits);
  SCM_ALLOW_INTS;
  return answer;
}

And file ports:
/* Building Guile ports from a file descriptor.  */

/* Build a Scheme port from an open file descriptor `fdes'.
   MODE indicates whether FILE is open for reading or writing; it uses
      the same notation as open-file's second argument.
   NAME is a string to be used as the port's filename.
*/
SCM
scm_fdes_to_port (int fdes, char *mode, SCM name)
#define FUNC_NAME "scm_fdes_to_port"
{
  long mode_bits = scm_mode_bits (mode);
  SCM port;
  scm_port *pt;
  int flags;

  /* test that fdes is valid.  */
  flags = fcntl (fdes, F_GETFL, 0);
  if (flags == -1)
    SCM_SYSERROR;
  flags &= O_ACCMODE;
  if (flags != O_RDWR
      && ((flags != O_WRONLY && (mode_bits & SCM_WRTNG))
          || (flags != O_RDONLY && (mode_bits & SCM_RDNG))))
    {
      SCM_MISC_ERROR ("requested file mode not available on fdes",
SCM_EOL);
    }

  SCM_NEWCELL (port);
  SCM_DEFER_INTS;
  pt = scm_add_to_port_table (port);
  SCM_SETPTAB_ENTRY (port, pt);
  SCM_SET_CELL_TYPE (port, (scm_tc16_fport | mode_bits));

  {
    struct scm_fport *fp
      = (struct scm_fport *) malloc (sizeof (struct scm_fport));
    if (fp == NULL)
      SCM_MEMORY_ERROR;
    fp->fdes = fdes;
    pt->rw_random = SCM_FDES_RANDOM_P (fdes);
    SCM_SETSTREAM (port, fp);
    if (mode_bits & SCM_BUF0)
      scm_fport_buffer_add (port, 0, 0);
    else
      scm_fport_buffer_add (port, -1, -1);
  }
  SCM_PTAB_ENTRY (port)->file_name = name;
  SCM_ALLOW_INTS;
  return port;
}
#undef FUNC_NAME


The common code seems to be:

  SCM_NEWCELL (port);
  SCM_DEFER_INTS;
  pt = scm_add_to_port_table (port);
  scm_port_non_buffer (pt);        /* or scm_fport_buffer_add() */
  SCM_SET_CELL_TYPE (prt, port_type | mode_bits);
  SCM_SETPTAB_ENTRY (port, pt);
  SCM_SETSTREAM (port, stuff);     /* the str or fd or whatever */
  SCM_ALLOW_INTS;

port_type is the value returned from scm_make_port_type() or one of
the pre-defined scm_tc16_sfport, scm_tc_strport, scm_tc16_void_port or
scm_tc16_fport.

I think that the above code needs to generalized to make building user
defined ports from C easier.

Something like:

SCM
make_new_port(long port_type, void *stream, long mode_bits)
{
  SCM port;
  scm_port *pt;
  
  SCM_NEWCELL (port);
  SCM_DEFER_INTS;
  pt = scm_add_to_port_table (port);
  scm_port_non_buffer (pt);
  SCM_SET_CELL_TYPE (prt, port_type | mode_bits);
  SCM_SETPTAB_ENTRY (port, pt);
  SCM_SETSTREAM (port, stream);
  SCM_ALLOW_INTS;
  return port;
}

The tricky bit is the buffering.  The string ports use the string
directly as the buffer, the file ports query the os for the best
buffer size.  Void ports have none.  I guess initially setting the
port to nonbuffered and changing it later would work.

Would it be a good idea to factor out the port creation code like this?

Anyway, Here is what I did to make an apache port from a request_rec
pointer:

int
ap_port_fill_input(SCM port)
{
  return EOF;
}

void
ap_port_write(SCM port, const void *data, size_t size)
{
  ap_rwrite(data, size, (request_rec *) SCM_STREAM(port));
}

void
ap_port_flush (SCM port)
{
  ap_rflush((request_rec *) SCM_STREAM(port));
}

long ap_port_type;

/* This needs to be called at initialization time, before any apache
 * ports are created. */
void
make_ap_port()
{
  long tc = scm_make_port_type("Apache",
                               ap_port_fill_input,
                               ap_port_write);
  scm_set_port_flush(tc, ap_port_flush);

  ap_port_type = tc;
}

/*
 Returns a new port based on a request_rec structure.

 I'm not really sure if this is the right way to go, or should be dig
 in to to the request_rec and record the BUFF pointer and make calls
 that use it instead? */
SCM
new_apache_port(request_rec *r)
{
  SCM port;
  scm_port *pt;

  SCM_NEWCELL(port);
  SCM_DEFER_INTS;
  pt = scm_add_to_port_table(port);
  scm_port_non_buffer(pt);
  SCM_SETPTAB_ENTRY(port, pt);
  SCM_SETSTREAM(port, r);
  SCM_SET_CELL_TYPE(port, ap_port_type | SCM_OPN | SCM_WRTNG);
  SCM_ALLOW_INTS;
  return port;
}

It actually works!

-Dale

-- 
Dale P. Smith
Altus Technologies Corp.
address@hidden
400-746-9000 x309