*** empty log message ***
[bpt/guile.git] / libguile / ports.c
index 645bd87..4a7063e 100644 (file)
@@ -1,4 +1,4 @@
-/*     Copyright (C) 1995,1996,1997 Free Software Foundation, Inc.
+/*     Copyright (C) 1995,1996,1997,1998 Free Software Foundation, Inc.
  * 
  * This program is free software; you can redistribute it and/or modify
  * it under the terms of the GNU General Public License as published by
@@ -39,6 +39,8 @@
  * whether to permit this exception to apply to your modifications.
  * If you do not wish that, delete this exception notice.  */
 \f
+/* Headers.  */
+
 #include <stdio.h>
 #include "_scm.h"
 #include "genio.h"
@@ -49,6 +51,7 @@
 #include "fports.h"
 #include "strports.h"
 #include "vports.h"
+#include "keywords.h"
 
 #include "ports.h"
 
@@ -63,7 +66,9 @@
 #ifdef HAVE_SYS_IOCTL_H
 #include <sys/ioctl.h>
 #endif
+
 \f
+/* The port kind table --- a dynamically resized array of port types.  */
 
 
 /* scm_ptobs scm_numptob
@@ -72,7 +77,7 @@
  * tags for smobjects (if you know a tag you can get an index and conversely).
  */
 scm_ptobfuns *scm_ptobs;
-scm_sizet scm_numptob;
+int scm_numptob;
 
 
 SCM 
@@ -80,10 +85,7 @@ scm_markstream (ptr)
      SCM ptr;
 {
   int openp;
-  if (SCM_GC8MARKP (ptr))
-    return SCM_BOOL_F;
   openp = SCM_CAR (ptr) & SCM_OPN;
-  SCM_SETGC8MARK (ptr);
   if (openp)
     return SCM_STREAM  (ptr);
   else
@@ -113,6 +115,7 @@ scm_newptob (ptob)
       scm_ptobs[scm_numptob].fwrite = ptob->fwrite;
       scm_ptobs[scm_numptob].fflush = ptob->fflush;
       scm_ptobs[scm_numptob].fgetc = ptob->fgetc;
+      scm_ptobs[scm_numptob].fgets = ptob->fgets;
       scm_ptobs[scm_numptob].fclose = ptob->fclose;
       scm_numptob++;
     }
@@ -123,17 +126,6 @@ scm_newptob (ptob)
 }
 
 \f
-/* internal SCM call */
-
-void 
-scm_fflush (port)
-     SCM port;
-{
-  scm_sizet i = SCM_PTOBNUM (port);
-  (scm_ptobs[i].fflush) (SCM_STREAM (port));
-}
-
-\f
 
 SCM_PROC(s_char_ready_p, "char-ready?", 0, 1, 0, scm_char_ready_p);
 
@@ -144,7 +136,9 @@ scm_char_ready_p (port)
   if (SCM_UNBNDP (port))
     port = scm_cur_inp;
   else
-    SCM_ASSERT (SCM_NIMP (port) && SCM_OPINPORTP (port), port, SCM_ARG1, s_char_ready_p);
+    SCM_ASSERT (SCM_NIMP (port) && SCM_OPINPORTP (port), port, SCM_ARG1,
+               s_char_ready_p);
+
   if (SCM_CRDYP (port) || !SCM_FPORTP (port))
     return SCM_BOOL_T;
   return (scm_input_waiting_p ((FILE *) SCM_STREAM (port), s_char_ready_p)
@@ -154,10 +148,8 @@ scm_char_ready_p (port)
 
 
 \f
+/* Standard ports --- current input, output, error, and more(!).  */
 
-
-/* {Standard Ports}
- */
 SCM_PROC(s_current_input_port, "current-input-port", 0, 0, 0, scm_current_input_port);
 
 SCM 
@@ -182,6 +174,14 @@ scm_current_error_port ()
   return scm_cur_errp;
 }
 
+SCM_PROC(s_current_load_port, "current-load-port", 0, 0, 0, scm_current_load_port);
+
+SCM 
+scm_current_load_port ()
+{
+  return scm_cur_loadp;
+}
+
 SCM_PROC(s_set_current_input_port, "set-current-input-port", 1, 0, 0, scm_set_current_input_port);
 
 SCM 
@@ -202,6 +202,7 @@ scm_set_current_output_port (port)
      SCM port;
 {
   SCM ooutp = scm_cur_outp;
+  port = SCM_COERCE_OUTPORT (port);
   SCM_ASSERT (SCM_NIMP (port) && SCM_OPOUTPORTP (port), port, SCM_ARG1, s_set_current_output_port);
   scm_cur_outp = port;
   return ooutp;
@@ -215,16 +216,14 @@ scm_set_current_error_port (port)
      SCM port;
 {
   SCM oerrp = scm_cur_errp;
+  port = SCM_COERCE_OUTPORT (port);
   SCM_ASSERT (SCM_NIMP (port) && SCM_OPOUTPORTP (port), port, SCM_ARG1, s_set_current_error_port);
   scm_cur_errp = port;
   return oerrp;
 }
 
 \f
-
-/* {Ports - in general}
- * 
- */
+/* The port table --- a table of all the open ports.  */
 
 /* Array of open ports, required for reliable MOVE->FDES etc.  */
 struct scm_port_table **scm_port_table;
@@ -242,8 +241,8 @@ scm_add_to_port_table (port)
     {
       scm_port_table = ((struct scm_port_table **)
                        realloc ((char *) scm_port_table,
-                                (long) (sizeof (struct scm_port_table)
-                                        * scm_port_table_room * 2)));
+                                (scm_sizet) (sizeof (struct scm_port_table *)
+                                             * scm_port_table_room * 2)));
       /* !!! error checking */
       scm_port_table_room *= 2;
     }
@@ -251,12 +250,16 @@ scm_add_to_port_table (port)
                                         scm_must_malloc (sizeof (struct scm_port_table),
                                                          "system port table"));
   scm_port_table[scm_port_table_size]->port = port;
+  scm_port_table[scm_port_table_size]->entry = scm_port_table_size;
   scm_port_table[scm_port_table_size]->revealed = 0;
   scm_port_table[scm_port_table_size]->stream = 0;
   scm_port_table[scm_port_table_size]->file_name = SCM_BOOL_F;
-  scm_port_table[scm_port_table_size]->line_number = 1;
+  scm_port_table[scm_port_table_size]->line_number = 0;
   scm_port_table[scm_port_table_size]->column_number = 0;
-  scm_port_table[scm_port_table_size]->representation = scm_regular_port;
+  scm_port_table[scm_port_table_size]->cp
+    = scm_port_table[scm_port_table_size]->cbuf;
+  scm_port_table[scm_port_table_size]->cbufend
+    = &scm_port_table[scm_port_table_size]->cbuf[SCM_INITIAL_CBUF_SIZE];
   return scm_port_table[scm_port_table_size++];
 }
 
@@ -266,21 +269,41 @@ void
 scm_remove_from_port_table (port)
      SCM port;
 {
-  int i = 0;
-  while (scm_port_table[i]->port != port)
+  struct scm_port_table *p = SCM_PTAB_ENTRY (port);
+  int i = p->entry;
+  /* Error if not found: too violent?  May occur in GC.  */
+  if (i >= scm_port_table_size)
+    scm_wta (port, "Port not in table", "scm_remove_from_port_table");
+  scm_mallocated -= (sizeof (*p)
+                    + (p->cbufend - p->cbuf)
+                    - SCM_INITIAL_CBUF_SIZE);
+  scm_must_free ((char *)p);
+  /* Since we have just freed slot i we can shrink the table by moving
+     the last entry to that slot... */
+  if (i < scm_port_table_size - 1)
     {
-      i++;
-      /* Error if not found: too violent?  May occur in GC.  */
-      if (i >= scm_port_table_size)
-       scm_wta (port, "Port not in table", "scm_remove_from_port_table");
+      scm_port_table[i] = scm_port_table[scm_port_table_size - 1];
+      scm_port_table[i]->entry = i;
     }
-  scm_must_free ((char *)scm_port_table[i]);
-  scm_mallocated -= sizeof (*scm_port_table[i]);
-  scm_port_table[i] = scm_port_table[scm_port_table_size - 1];
   SCM_SETPTAB_ENTRY (port, 0);
   scm_port_table_size--;
 }
 
+void
+scm_grow_port_cbuf (port, requested)
+  SCM port;
+  size_t requested;
+{
+  struct scm_port_table *p = SCM_PTAB_ENTRY (port);
+  int size = p->cbufend - p->cbuf;
+  int new_size = size * 3 / 2;
+  if (new_size < requested)
+    new_size = requested;
+  p = realloc (p, sizeof (*p) - SCM_INITIAL_CBUF_SIZE + new_size);
+  scm_port_table[p->entry] = p;
+  SCM_SETPTAB_ENTRY (port, p);
+}
 #ifdef GUILE_DEBUG
 /* Undocumented functions for debugging.  */
 /* Return the number of ports in the table.  */
@@ -309,6 +332,9 @@ scm_pt_member (member)
 #endif
 
 
+\f
+/* Revealed counts --- an oddity inherited from SCSH.  */
+
 /* Find a port in the table and return its revealed count.
    Also used by the garbage collector.
  */
@@ -330,6 +356,7 @@ SCM
 scm_port_revealed (port)
      SCM port;
 {
+  port = SCM_COERCE_OUTPORT (port);
   SCM_ASSERT (SCM_NIMP (port) && SCM_PORTP (port), port, SCM_ARG1, s_port_revealed);
   return SCM_MAKINUM (scm_revealed_count (port));
 }
@@ -342,6 +369,7 @@ scm_set_port_revealed_x (port, rcount)
      SCM port;
      SCM rcount;
 {
+  port = SCM_COERCE_OUTPORT (port);
   SCM_ASSERT (SCM_NIMP (port) && SCM_PORTP (port), port, SCM_ARG1, s_set_port_revealed_x);
   SCM_ASSERT (SCM_INUMP (rcount), rcount, SCM_ARG2, s_set_port_revealed_x);
   SCM_DEFER_INTS;
@@ -350,8 +378,64 @@ scm_set_port_revealed_x (port, rcount)
   return SCM_UNSPECIFIED;
 }
 
+
+\f
+/* Retrieving a port's mode.  */
+
+/* Return the flags that characterize a port based on the mode
+ * string used to open a file for that port.
+ *
+ * See PORT FLAGS in scm.h
+ */
+
+long
+scm_mode_bits (modes)
+     char *modes;
+{
+  return (SCM_OPN
+         | (strchr (modes, 'r') || strchr (modes, '+') ? SCM_RDNG : 0)
+         | (   strchr (modes, 'w')
+            || strchr (modes, 'a')
+            || strchr (modes, '+') ? SCM_WRTNG : 0)
+         | (strchr (modes, '0') ? SCM_BUF0 : 0));
+}
+
+
+/* Return the mode flags from an open port.
+ * Some modes such as "append" are only used when opening
+ * a file and are not returned here.  */
+
+SCM_PROC(s_port_mode, "port-mode", 1, 0, 0, scm_port_mode);
+
+SCM
+scm_port_mode (port)
+     SCM port;
+{
+  char modes[3];
+  modes[0] = '\0';
+
+  port = SCM_COERCE_OUTPORT (port);
+  SCM_ASSERT (SCM_NIMP (port) && SCM_OPPORTP (port), port, SCM_ARG1, s_port_mode);  
+  if (SCM_CAR (port) & SCM_RDNG) {
+    if (SCM_CAR (port) & SCM_WRTNG)
+      strcpy (modes, "r+");
+    else
+      strcpy (modes, "r");
+  }
+  else if (SCM_CAR (port) & SCM_WRTNG)
+    strcpy (modes, "w");
+  if (SCM_CAR (port) & SCM_BUF0)
+    strcat (modes, "0");
+  return scm_makfromstr (modes, strlen (modes), 0);
+}
+
+
+\f
+/* Closing ports.  */
+
 /* scm_close_port
  * Call the close operation on a port object. 
+ * see also scm_close.
  */
 SCM_PROC(s_close_port, "close-port", 1, 0, 0, scm_close_port);
 
@@ -360,17 +444,29 @@ scm_close_port (port)
      SCM port;
 {
   scm_sizet i;
-  SCM_ASSERT (SCM_NIMP (port) && SCM_PORTP (port), port, SCM_ARG1, s_close_port);
+  int rv;
+
+  port = SCM_COERCE_OUTPORT (port);
+
+  SCM_ASSERT (SCM_NIMP (port) && SCM_PORTP (port), port, SCM_ARG1,
+             s_close_port);
   if (SCM_CLOSEDP (port))
-    return SCM_UNSPECIFIED;
+    return SCM_BOOL_F;
   i = SCM_PTOBNUM (port);
   SCM_DEFER_INTS;
   if (scm_ptobs[i].fclose)
-    SCM_SYSCALL ((scm_ptobs[i].fclose) (SCM_STREAM (port)));
+    {
+      SCM_SYSCALL (rv = (scm_ptobs[i].fclose) (port));
+      /* ports with a closed file descriptor can be reclosed without error.  */
+      if (rv < 0 && errno != EBADF)
+       scm_syserror (s_close_port);
+    }
+  else
+    rv = 0;
   scm_remove_from_port_table (port);
   SCM_SETAND_CAR (port, ~SCM_OPN);
   SCM_ALLOW_INTS;
-  return SCM_UNSPECIFIED;
+  return (rv < 0) ? SCM_BOOL_F : SCM_BOOL_T;
 }
 
 SCM_PROC(s_close_all_ports_except, "close-all-ports-except", 0, 0, 1, scm_close_all_ports_except);
@@ -390,7 +486,7 @@ scm_close_all_ports_except (ports)
 
       while (SCM_NNULLP (ports_ptr))
        {
-         SCM port = SCM_CAR (ports_ptr);
+         SCM port = SCM_COERCE_OUTPORT (SCM_CAR (ports_ptr));
          if (i == 0)
            SCM_ASSERT (SCM_NIMP (port) && SCM_OPPORTP (port), port, SCM_ARG1, s_close_all_ports_except);
          if (port == thisport)
@@ -407,6 +503,10 @@ scm_close_all_ports_except (ports)
   return SCM_UNSPECIFIED;
 }
 
+
+\f
+/* Utter miscellany.  Gosh, we should clean this up some time.  */
+
 SCM_PROC(s_input_port_p, "input-port?", 1, 0, 0, scm_input_port_p);
 
 SCM 
@@ -436,7 +536,7 @@ SCM
 scm_eof_object_p (x)
      SCM x;
 {
-  return (SCM_EOF_VAL == x) ? SCM_BOOL_T : SCM_BOOL_F;
+  return SCM_EOF_OBJECT_P (x) ? SCM_BOOL_T : SCM_BOOL_F;
 }
 
 SCM_PROC(s_force_output, "force-output", 0, 1, 0, scm_force_output);
@@ -446,16 +546,37 @@ scm_force_output (port)
      SCM port;
 {
   if (SCM_UNBNDP (port))
- port = scm_cur_outp;
   port = scm_cur_outp;
   else
-    SCM_ASSERT (SCM_NIMP (port) && SCM_OPOUTPORTP (port), port, SCM_ARG1, s_force_output);
+    {
+      port = SCM_COERCE_OUTPORT (port);
+      SCM_ASSERT (SCM_NIMP (port) && SCM_OPOUTPORTP (port), port, SCM_ARG1, 
+                 s_force_output);
+    }
   {
     scm_sizet i = SCM_PTOBNUM (port);
-    SCM_SYSCALL ((scm_ptobs[i].fflush) (SCM_STREAM (port)));
+    SCM_SYSCALL ((scm_ptobs[i].fflush) (port));
     return SCM_UNSPECIFIED;
   }
 }
 
+SCM_PROC (s_flush_all_ports, "flush-all-ports", 0, 0, 0, scm_flush_all_ports);
+SCM
+scm_flush_all_ports (void)
+{
+  int i;
+
+  for (i = 0; i < scm_port_table_size; i++)
+    {
+      SCM port = scm_port_table[i]->port;
+      if (SCM_OPOUTPORTP (port))
+       {
+         scm_sizet ptob = SCM_PTOBNUM (port);
+         (scm_ptobs[ptob].fflush) (port);
+       }
+    }
+  return SCM_UNSPECIFIED;
+}
 
 SCM_PROC(s_read_char, "read-char", 0, 1, 0, scm_read_char);
 
@@ -468,7 +589,7 @@ scm_read_char (port)
     port = scm_cur_inp;
   else
     SCM_ASSERT (SCM_NIMP (port) && SCM_OPINPORTP (port), port, SCM_ARG1, s_read_char);
-  c = scm_gen_getc (port);
+  c = scm_getc (port);
   if (EOF == c)
     return SCM_EOF_VAL;
   return SCM_MAKICHR (c);
@@ -486,13 +607,77 @@ scm_peek_char (port)
     port = scm_cur_inp;
   else
     SCM_ASSERT (SCM_NIMP (port) && SCM_OPINPORTP (port), port, SCM_ARG1, s_peek_char);
-  c = scm_gen_getc (port);
+  c = scm_getc (port);
   if (EOF == c)
     return SCM_EOF_VAL;
-  scm_gen_ungetc (c, port);
+  scm_ungetc (c, port);
   return SCM_MAKICHR (c);
 }
 
+/*
+ * A generic fgets method.  We supply this method so that ports which
+ * can't use fgets(3) (like string ports or soft ports) can still use
+ * line-based i/o.  The generic method calls the port's own fgetc method
+ * for input.  It should be possible to write a more efficient
+ * method for any given port representation -- this is supplied just
+ * to ensure that you don't have to.
+ */
+
+char * scm_generic_fgets SCM_P ((SCM port, int *len));
+
+char *
+scm_generic_fgets (port, len)
+     SCM port;
+     int *len;
+{
+  scm_sizet p  = SCM_PTOBNUM (port);
+
+  char *buf;
+  int   limit = 80;    /* current size of buffer */
+  int   c;
+
+  /* FIXME: It would be nice to be able to check for EOF before anything. */
+
+  *len = 0;
+  buf = (char *) malloc (limit * sizeof(char));
+
+  /* If a char has been pushed onto the port with scm_ungetc,
+     read that first. */
+  while (SCM_CRDYP (port))
+    {
+      buf[*len] = SCM_CGETUN (port);
+      SCM_TRY_CLRDY (port);
+      if (buf[(*len)++] == '\n' || *len == limit - 1)
+       {
+         buf[*len] = '\0';
+         return buf;
+       }
+    }
+
+  while (1) {
+    if (*len >= limit-1)
+      {
+       buf = (char *) realloc (buf, sizeof(char) * limit * 2);
+       limit *= 2;
+      }
+
+    c = (scm_ptobs[p].fgetc) (port);
+    if (c != EOF)
+      buf[(*len)++] = c;
+
+    if (c == EOF || c == '\n')
+      {
+       if (*len)
+         {
+           buf[*len] = '\0';
+           return buf;
+         }
+       free (buf);
+       return NULL;
+      }
+  }
+}
+
 SCM_PROC (s_unread_char, "unread-char", 2, 0, 0, scm_unread_char);
 
 SCM 
@@ -512,117 +697,118 @@ scm_unread_char (cobj, port)
 
   c = SCM_ICHR (cobj);
 
-  scm_gen_ungetc (c, port);
+  scm_ungetc (c, port);
   return cobj;
 }
 
+SCM_PROC (s_unread_string, "unread-string", 2, 0, 0, scm_unread_string);
 
+SCM 
+scm_unread_string (str, port)
+     SCM str;
+     SCM port;
+{
+  SCM_ASSERT (SCM_NIMP (str) && SCM_STRINGP (str),
+             str, SCM_ARG1, s_unread_string);
 
-SCM_PROC (s_port_line, "port-line", 0, 1, 0, scm_port_line);
+  if (SCM_UNBNDP (port))
+    port = scm_cur_inp;
+  else
+    SCM_ASSERT (SCM_NIMP (port) && SCM_OPINPORTP (port),
+               port, SCM_ARG2, s_unread_string);
+
+  scm_ungets (SCM_ROUCHARS (str), SCM_LENGTH (str), port);
+  
+  return str;
+}
+
+SCM_PROC (s_port_line, "port-line", 1, 0, 0, scm_port_line);
 
 SCM 
 scm_port_line (port)
      SCM port;
 {
-  SCM p;
-  p = ((port == SCM_UNDEFINED)
-       ? scm_cur_inp
-       : port);
-  if (!(SCM_NIMP (p) && SCM_PORTP (p)))
-    return SCM_BOOL_F;
-  else
-    return SCM_MAKINUM (SCM_LINUM (p));
+  port = SCM_COERCE_OUTPORT (port);
+  SCM_ASSERT (SCM_NIMP (port) && SCM_PORTP (port) && SCM_OPENP (port),
+             port,
+             SCM_ARG1,
+             s_port_line);
+  return SCM_MAKINUM (SCM_LINUM (port));
 }
 
-SCM_PROC (s_set_port_line_x, "set-port-line!", 1, 1, 0, scm_set_port_line_x);
+SCM_PROC (s_set_port_line_x, "set-port-line!", 2, 0, 0, scm_set_port_line_x);
 
 SCM 
 scm_set_port_line_x (port, line)
      SCM port;
      SCM line;
 {
-  if (line == SCM_UNDEFINED)
-    {
-      line = port;
-      port = scm_cur_inp;
-    }
-  else
-    SCM_ASSERT (SCM_NIMP (port) && SCM_PORTP (port) && SCM_OPENP (port),
-               port,
-               SCM_ARG1,
-               s_set_port_line_x);
+  port = SCM_COERCE_OUTPORT (port);
+  SCM_ASSERT (SCM_NIMP (port) && SCM_PORTP (port) && SCM_OPENP (port),
+             port,
+             SCM_ARG1,
+             s_set_port_line_x);
+  SCM_ASSERT (SCM_INUMP (line), line, SCM_ARG2, s_set_port_line_x);
   return SCM_PTAB_ENTRY (port)->line_number = SCM_INUM (line);
 }
 
-SCM_PROC (s_port_column, "port-column", 0, 1, 0, scm_port_column);
+SCM_PROC (s_port_column, "port-column", 1, 0, 0, scm_port_column);
 
 SCM
 scm_port_column  (port)
      SCM port;
 {
-  SCM p;
-  p = ((port == SCM_UNDEFINED)
-       ? scm_cur_inp
-       : port);
-  if (!(SCM_NIMP (p) && SCM_PORTP (p)))
-    return SCM_BOOL_F;
-  else
-    return SCM_MAKINUM (SCM_COL (p));
+  port = SCM_COERCE_OUTPORT (port);
+  SCM_ASSERT (SCM_NIMP (port) && SCM_PORTP (port) && SCM_OPENP (port),
+             port,
+             SCM_ARG1,
+             s_port_column);
+  return SCM_MAKINUM (SCM_COL (port));
 }
 
-SCM_PROC (s_set_port_column_x, "set-port-column!", 1, 1, 0, scm_set_port_column_x);
+SCM_PROC (s_set_port_column_x, "set-port-column!", 2, 0, 0, scm_set_port_column_x);
 
 SCM 
 scm_set_port_column_x (port, column)
      SCM port;
      SCM column;
 {
-  if (column == SCM_UNDEFINED)
-    {
-      column = port;
-      port = scm_cur_inp;
-    }
-  else
-    SCM_ASSERT (SCM_NIMP (port) && SCM_PORTP (port) && SCM_OPENP (port),
-               port,
-               SCM_ARG1,
-               s_set_port_column_x);
+  port = SCM_COERCE_OUTPORT (port);
+  SCM_ASSERT (SCM_NIMP (port) && SCM_PORTP (port) && SCM_OPENP (port),
+             port,
+             SCM_ARG1,
+             s_set_port_column_x);
+  SCM_ASSERT (SCM_INUMP (column), column, SCM_ARG2, s_set_port_column_x);
   return SCM_PTAB_ENTRY (port)->column_number = SCM_INUM (column);
 }
 
-SCM_PROC (s_port_filename, "port-filename", 0, 1, 0, scm_port_filename);
+SCM_PROC (s_port_filename, "port-filename", 1, 0, 0, scm_port_filename);
 
 SCM 
 scm_port_filename (port)
      SCM port;
 {
-  SCM p;
-  p = ((port == SCM_UNDEFINED)
-       ? scm_cur_inp
-       : port);
-  if (!(SCM_NIMP (p) && SCM_PORTP (p)))
-    return SCM_BOOL_F;
-  else
-    return SCM_PTAB_ENTRY (p)->file_name;
+  port = SCM_COERCE_OUTPORT (port);
+  SCM_ASSERT (SCM_NIMP (port) && SCM_PORTP (port) && SCM_OPENP (port),
+             port,
+             SCM_ARG1,
+             s_port_filename);
+  return SCM_PTAB_ENTRY (port)->file_name;
 }
 
-SCM_PROC (s_set_port_filename_x, "set-port-filename!", 1, 1, 0, scm_set_port_filename_x);
+SCM_PROC (s_set_port_filename_x, "set-port-filename!", 2, 0, 0, scm_set_port_filename_x);
 
 SCM 
 scm_set_port_filename_x (port, filename)
      SCM port;
      SCM filename;
 {
-  if (filename == SCM_UNDEFINED)
-    {
-      filename = port;
-      port = scm_cur_inp;
-    }
-  else
-    SCM_ASSERT (SCM_NIMP (port) && SCM_PORTP (port) && SCM_OPENP (port),
-               port,
-               SCM_ARG1,
-               s_set_port_filename_x);
+  port = SCM_COERCE_OUTPORT (port);
+  SCM_ASSERT (SCM_NIMP (port) && SCM_PORTP (port) && SCM_OPENP (port),
+             port,
+             SCM_ARG1,
+             s_set_port_filename_x);
+  /* We allow the user to set the filename to whatever he likes.  */
   return SCM_PTAB_ENTRY (port)->file_name = filename;
 }
 
@@ -637,25 +823,25 @@ scm_prinport (exp, port, type)
      SCM port;
      char *type;
 {
-  scm_gen_puts (scm_regular_string, "#<", port);
+  scm_puts ("#<", port);
   if (SCM_CLOSEDP (exp))
-    scm_gen_puts (scm_regular_string, "closed: ", port);
+    scm_puts ("closed: ", port);
   else
     {
       if (SCM_RDNG & SCM_CAR (exp))
-       scm_gen_puts (scm_regular_string, "input: ", port);
+       scm_puts ("input: ", port);
       if (SCM_WRTNG & SCM_CAR (exp))
-       scm_gen_puts (scm_regular_string, "output: ", port);
+       scm_puts ("output: ", port);
     }
-  scm_gen_puts (scm_regular_string, type, port);
-  scm_gen_putc (' ', port);
+  scm_puts (type, port);
+  scm_putc (' ', port);
 #ifndef MSDOS
 #ifndef __EMX__
 #ifndef _DCC
 #ifndef AMIGA
 #ifndef THINK_C
   if (SCM_OPENP (exp) && scm_tc16_fport == SCM_TYP16 (exp) && isatty (fileno ((FILE *)SCM_STREAM (exp))))
-    scm_gen_puts (scm_regular_string, ttyname (fileno ((FILE *)SCM_STREAM (exp))), port);
+    scm_puts (ttyname (fileno ((FILE *)SCM_STREAM (exp))), port);
   else
 #endif
 #endif
@@ -666,7 +852,7 @@ scm_prinport (exp, port, type)
     scm_intprint ((long) fileno ((FILE *)SCM_STREAM (exp)), 10, port);
   else
     scm_intprint (SCM_CDR (exp), 16, port);
-  scm_gen_putc ('>', port);
+  scm_putc ('>', port);
 }
 
 
@@ -684,46 +870,33 @@ scm_ports_prehistory ()
   /* scm_tc16_strport = */ scm_newptob (&scm_stptob);
   /* scm_tc16_sfport = */ scm_newptob (&scm_sfptob);
 }
-\f
 
 \f
-/* {Void Ports}
- */
+/* Void ports.   */
 
 int scm_tc16_void_port = 0;
 
 static int
-print_void_port (exp, port, writing)
-     SCM exp;
-     SCM port;
-     int writing;
+print_void_port (SCM exp, SCM port, scm_print_state *pstate)
 {
   scm_prinport (exp, port, "void");
   return 1;
 }
 
 static int
-putc_void_port (c, strm)
-     int c;
-     SCM strm;
+putc_void_port (int c, SCM port)
 {
   return 0;                    /* vestigial return value */
 }
 
 static int
-puts_void_port (s, strm)
-     char * s;
-     SCM strm;
+puts_void_port (char *s, SCM port)
 {
   return 0;                    /* vestigial return value */
 }
 
 static scm_sizet
-write_void_port (ptr, size, nitems, strm)
-     void * ptr;
-     int size;
-     int nitems;
-     SCM strm;
+write_void_port (char *ptr, scm_sizet size, scm_sizet nitems, SCM port)
 {
   int len;
   len = size * nitems;
@@ -731,50 +904,43 @@ write_void_port (ptr, size, nitems, strm)
 }
 
 
-static int flush_void_port SCM_P ((SCM strm));
-
 static int
-flush_void_port (strm)
-     SCM strm;
+flush_void_port (SCM port)
 {
   return 0;
 }
 
 
-static int getc_void_port SCM_P ((SCM strm));
-
 static int
-getc_void_port (strm)
-     SCM strm;
+getc_void_port (SCM port)
 {
   return EOF;
 }
 
-
-static int close_void_port SCM_P ((SCM strm));
+static char *
+fgets_void_port (SCM port, int *len)
+{
+  return NULL;
+}
 
 static int
-close_void_port (strm)
-     SCM strm;
+close_void_port (SCM port)
 {
   return 0;                    /* this is ignored by scm_close_port. */
 }
 
 
 
-static int noop0 SCM_P ((SCM stream));
-
 static int 
-noop0 (stream)
-     SCM stream;
+noop0 (SCM stream)
 {
   return 0;
 }
 
 
-static struct scm_ptobfuns  void_port_ptob =
+static struct scm_ptobfuns void_port_ptob =
 {
-  scm_mark0, 
+  0, 
   noop0,
   print_void_port,
   0,                           /* equal? */
@@ -783,12 +949,10 @@ static struct scm_ptobfuns  void_port_ptob =
   write_void_port,
   flush_void_port,
   getc_void_port,
+  fgets_void_port,
   close_void_port,
 };
 
-\f
-
-
 SCM
 scm_void_port (mode_str)
      char * mode_str;
@@ -825,7 +989,7 @@ scm_sys_make_void_port (mode)
 
 
 \f
-
+/* Initialization.  */
 
 void
 scm_init_ports ()