* Some more work to get rid of SCM_LENGTH
[bpt/guile.git] / libguile / fports.c
index 1111338..bd955e3 100644 (file)
@@ -1,4 +1,4 @@
-/*     Copyright (C) 1995,1996,1997,1998,1999 Free Software Foundation, Inc.
+/*     Copyright (C) 1995,1996,1997,1998,1999, 2000 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
  * If you write modifications of your own for GUILE, it is your choice
  * whether to permit this exception to apply to your modifications.
  * If you do not wish that, delete this exception notice.  */
+
+/* Software engineering face-lift by Greg J. Badros, 11-Dec-1999,
+   gjb@cs.washington.edu, http://www.cs.washington.edu/homes/gjb */
+
 \f
 
 #include <stdio.h>
 #include <fcntl.h>
-#include "_scm.h"
+#include "libguile/_scm.h"
+#include "libguile/strings.h"
 
-#include "fports.h"
+#include "libguile/validate.h"
+#include "libguile/fports.h"
 
 #ifdef HAVE_STRING_H
 #include <string.h>
@@ -60,7 +66,10 @@ scm_sizet fwrite ();
 
 #include <errno.h>
 
-#include "iselect.h"
+#include "libguile/iselect.h"
+
+/* default buffer size, used if the O/S won't supply a value.  */
+static const int default_buffer_size = 1024;
 
 /* create FPORT buffer with specified sizes (or -1 to use default size or
    0 for no buffer.  */
@@ -77,11 +86,10 @@ scm_fport_buffer_add (SCM port, int read_size, int write_size)
 #ifdef HAVE_ST_BLKSIZE
       struct stat st;
       
-      if (fstat (fp->fdes, &st) == -1)
-       scm_syserror (s_scm_fport_buffer_add);
-      default_size = st.st_blksize;
+      default_size = (fstat (fp->fdes, &st) == -1) ? default_buffer_size
+       : st.st_blksize;
 #else
-      default_size = 1024;
+      default_size = default_buffer_size;
 #endif
       if (read_size == -1)
        read_size = default_size;
@@ -89,7 +97,7 @@ scm_fport_buffer_add (SCM port, int read_size, int write_size)
        write_size = default_size;
     }
 
-  if (SCM_INPORTP (port) && read_size > 0)
+  if (SCM_INPUT_PORT_P (port) && read_size > 0)
     {
       pt->read_buf = malloc (read_size);
       if (pt->read_buf == NULL)
@@ -103,7 +111,7 @@ scm_fport_buffer_add (SCM port, int read_size, int write_size)
       pt->read_buf_size = 1;
     }
 
-  if (SCM_OUTPORTP (port) && write_size > 0)
+  if (SCM_OUTPUT_PORT_P (port) && write_size > 0)
     {
       pt->write_buf = malloc (write_size);
       if (pt->write_buf == NULL)
@@ -119,26 +127,45 @@ scm_fport_buffer_add (SCM port, int read_size, int write_size)
 
   pt->write_end = pt->write_buf + pt->write_buf_size;
   if (read_size > 0 || write_size > 0)
-    SCM_SETCAR (port, SCM_CAR (port) & ~SCM_BUF0);
+    SCM_SET_CELL_WORD_0 (port, SCM_CELL_WORD_0 (port) & ~SCM_BUF0);
   else
-    SCM_SETCAR (port, (SCM_CAR (port) | SCM_BUF0));
+    SCM_SET_CELL_WORD_0 (port, SCM_CELL_WORD_0 (port) | SCM_BUF0);
 }
 
-SCM_PROC (s_setvbuf, "setvbuf", 2, 1, 0, scm_setvbuf);
-SCM
-scm_setvbuf (SCM port, SCM mode, SCM size)
+SCM_DEFINE (scm_setvbuf, "setvbuf", 2, 1, 0, 
+            (SCM port, SCM mode, SCM size),
+           "Set the buffering mode for @var{port}.  @var{mode} can be:\n"
+           "@table @code\n"
+           "@item _IONBF\n"
+           "non-buffered\n"
+           "@item _IOLBF\n"
+           "line buffered\n"
+           "@item _IOFBF\n"
+           "block buffered, using a newly allocated buffer of @var{size} bytes.\n"
+           "If @var{size} is omitted, a default size will be used.\n"
+           "@end table")
+#define FUNC_NAME s_scm_setvbuf
 {
   int cmode, csize;
   scm_port *pt;
 
   port = SCM_COERCE_OUTPORT (port);
 
-  SCM_ASSERT (SCM_NIMP (port) && SCM_OPFPORTP (port), port, SCM_ARG1,
-             s_setvbuf);
-  SCM_ASSERT (SCM_INUMP (mode), mode, SCM_ARG2, s_setvbuf);
-  cmode = SCM_INUM (mode);
-  if (cmode != _IONBF && cmode != _IOFBF)
-    scm_out_of_range (s_setvbuf, mode);
+  SCM_VALIDATE_OPFPORT (1,port);
+  SCM_VALIDATE_INUM_COPY (2,mode,cmode);
+  if (cmode != _IONBF && cmode != _IOFBF && cmode != _IOLBF)
+    scm_out_of_range (FUNC_NAME, mode);
+
+  if (cmode == _IOLBF)
+    {
+      SCM_SET_CELL_WORD_0 (port, SCM_CELL_WORD_0 (port) | SCM_BUFLINE);
+      cmode = _IOFBF;
+    }
+  else
+    {
+      SCM_SET_CELL_WORD_0 (port, SCM_CELL_WORD_0 (port) ^ SCM_BUFLINE);
+    }
+
   if (SCM_UNBNDP (size))
     {
       if (cmode == _IOFBF)
@@ -148,30 +175,30 @@ scm_setvbuf (SCM port, SCM mode, SCM size)
     }
   else
     {
-      SCM_ASSERT (SCM_INUMP (size), size, SCM_ARG3, s_setvbuf);
-      csize = SCM_INUM (size);
+      SCM_VALIDATE_INUM_COPY (3,size,csize);
       if (csize < 0 || (cmode == _IONBF && csize > 0))
-       scm_out_of_range (s_setvbuf, size);
+       scm_out_of_range (FUNC_NAME, size);
     }
+
   pt = SCM_PTAB_ENTRY (port);
 
   /* silently discards buffered chars.  */
   if (pt->read_buf != &pt->shortbuf)
-    scm_must_free (pt->read_buf);
+    free (pt->read_buf);
   if (pt->write_buf != &pt->shortbuf)
-    scm_must_free (pt->write_buf);
+    free (pt->write_buf);
 
   scm_fport_buffer_add (port, csize, csize);
   return SCM_UNSPECIFIED;
 }
+#undef FUNC_NAME
 
 /* Move ports with the specified file descriptor to new descriptors,
  * reseting the revealed count to 0.
  */
 
 void
-scm_evict_ports (fd)
-     int fd;
+scm_evict_ports (int fd)
 {
   int i;
 
@@ -202,12 +229,45 @@ scm_evict_ports (fd)
  *
  * Return the new port.
  */
-SCM_PROC(s_open_file, "open-file", 2, 0, 0, scm_open_file);
-
-SCM
-scm_open_file (filename, modes)
-     SCM filename;
-     SCM modes;
+SCM_DEFINE (scm_open_file, "open-file", 2, 0, 0,
+           (SCM filename, SCM modes),
+           "Open the file whose name is @var{string}, and return a port\n"
+           "representing that file.  The attributes of the port are\n"
+           "determined by the @var{mode} string.  The way in \n"
+           "which this is interpreted is similar to C stdio:\n\n"
+           "The first character must be one of the following:\n\n"
+           "@table @samp\n"
+           "@item r\n"
+           "Open an existing file for input.\n"
+           "@item w\n"
+           "Open a file for output, creating it if it doesn't already exist\n"
+           "or removing its contents if it does.\n"
+           "@item a\n"
+           "Open a file for output, creating it if it doesn't already exist.\n"
+           "All writes to the port will go to the end of the file.\n"
+           "The \"append mode\" can be turned off while the port is in use\n"
+           "@pxref{Ports and File Descriptors, fcntl}\n"
+           "@end table\n\n"
+           "The following additional characters can be appended:\n\n"
+           "@table @samp\n"
+           "@item +\n"
+           "Open the port for both input and output.  E.g., @code{r+}: open\n"
+           "an existing file for both input and output.\n"
+           "@item 0\n"
+           "Create an \"unbuffered\" port.  In this case input and output operations\n"
+           "are passed directly to the underlying port implementation without\n"
+           "additional buffering.  This is likely to slow down I/O operations.\n"
+           "The buffering mode can be changed while a port is in use\n"
+           "@pxref{Ports and File Descriptors, setvbuf}\n"
+           "@item l\n"
+           "Add line-buffering to the port.  The port output buffer will be\n"
+           "automatically flushed whenever a newline character is written.\n"
+           "@end table\n\n"
+           "In theory we could create read/write ports which were buffered in one\n"
+           "direction only.  However this isn't included in the current interfaces.\n\n"
+           "If a file cannot be opened with the access requested,\n"
+           "@code{open-file} throws an exception.")
+#define FUNC_NAME s_scm_open_file
 {
   SCM port;
   int fdes;
@@ -216,12 +276,12 @@ scm_open_file (filename, modes)
   char *mode;
   char *ptr;
 
-  SCM_ASSERT (SCM_NIMP (filename) && SCM_ROSTRINGP (filename), filename, SCM_ARG1, s_open_file);
-  SCM_ASSERT (SCM_NIMP (modes) && SCM_ROSTRINGP (modes), modes, SCM_ARG2, s_open_file);
+  SCM_VALIDATE_ROSTRING (1,filename);
+  SCM_VALIDATE_ROSTRING (2,modes);
   if (SCM_SUBSTRP (filename))
-    filename = scm_makfromstr (SCM_ROCHARS (filename), SCM_ROLENGTH (filename), 0);
+    filename = scm_makfromstr (SCM_ROCHARS (filename), SCM_STRING_LENGTH (filename), 0);
   if (SCM_SUBSTRP (modes))
-    modes = scm_makfromstr (SCM_ROCHARS (modes), SCM_ROLENGTH (modes), 0);
+    modes = scm_makfromstr (SCM_ROCHARS (modes), SCM_STRING_LENGTH (modes), 0);
 
   file = SCM_ROCHARS (filename);
   mode = SCM_ROCHARS (modes);
@@ -238,7 +298,7 @@ scm_open_file (filename, modes)
       flags |= O_WRONLY | O_CREAT | O_APPEND;
       break;
     default:
-      scm_out_of_range (s_open_file, modes);
+      scm_out_of_range (FUNC_NAME, modes);
     }
   ptr = mode + 1;
   while (*ptr != '\0')
@@ -250,9 +310,10 @@ scm_open_file (filename, modes)
          break;
        case '0':  /* unbuffered: handled later.  */
        case 'b':  /* 'binary' mode: ignored.  */
+       case 'l':  /* line buffered: handled during output.  */
          break;
        default:
-         scm_out_of_range (s_open_file, modes);
+         scm_out_of_range (FUNC_NAME, modes);
        }
       ptr++;
     }
@@ -261,14 +322,14 @@ scm_open_file (filename, modes)
     {
       int en = errno;
 
-      scm_syserror_msg (s_open_file, "%s: %S",
+      SCM_SYSERROR_MSG ("~A: ~S",
                        scm_cons (scm_makfrom0str (strerror (en)),
-                                 scm_cons (filename, SCM_EOL)),
-                       en);
+                                 scm_cons (filename, SCM_EOL)), en);
     }
   port = scm_fdes_to_port (fdes, mode, filename);
   return port;
 }
+#undef FUNC_NAME
 
 \f
 /* Building Guile ports from a file descriptor.  */
@@ -276,29 +337,42 @@ scm_open_file (filename, modes)
 /* 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.
-   Use NAME as the port's filename.  */
-
+   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_SETCAR (port, (scm_tc16_fport | mode_bits));
+  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 ("scm_fdes_to_port");
+      SCM_MEMORY_ERROR;
     fp->fdes = fdes;
-    pt->rw_random = (mode_bits & SCM_RDNG) && (mode_bits & SCM_WRTNG)
-      && SCM_FDES_RANDOM_P (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);
@@ -309,7 +383,7 @@ scm_fdes_to_port (int fdes, char *mode, SCM name)
   SCM_ALLOW_INTS;
   return port;
 }
-
+#undef FUNC_NAME
 
 /* Return a lower bound on the number of bytes available for input.  */
 static int
@@ -349,13 +423,8 @@ fport_input_waiting (SCM port)
 }
 
 \f
-static int prinfport SCM_P ((SCM exp, SCM port, scm_print_state *pstate));
-
 static int 
-prinfport (exp, port, pstate)
-     SCM exp;
-     SCM port;
-     scm_print_state *pstate;
+prinfport (SCM exp,SCM port,scm_print_state *pstate)
 {
   scm_puts ("#<", port);
   scm_print_port_mode (exp, port);    
@@ -363,7 +432,7 @@ prinfport (exp, port, pstate)
     {
       int fdes;
       SCM name = SCM_PTAB_ENTRY (exp)->file_name;
-      scm_puts (SCM_NIMP (name) && SCM_ROSTRINGP (name)
+      scm_puts (SCM_ROSTRINGP (name)
                ? SCM_ROCHARS (name)
                : SCM_PTOBNAME (SCM_PTOBNUM (exp)),
                port);
@@ -379,7 +448,7 @@ prinfport (exp, port, pstate)
     {
       scm_puts (SCM_PTOBNAME (SCM_PTOBNUM (exp)), port);
       scm_putc (' ', port);
-      scm_intprint (SCM_CDR (exp), 16, port);
+      scm_intprint (SCM_UNPACK (SCM_CDR (exp)), 16, port);
     }
   scm_putc ('>', port);
   return 1;
@@ -443,11 +512,52 @@ fport_fill_input (SCM port)
 static off_t
 fport_seek (SCM port, off_t offset, int whence)
 {
+  scm_port *pt = SCM_PTAB_ENTRY (port);
   struct scm_fport *fp = SCM_FSTREAM (port);
-  off_t result = lseek (fp->fdes, offset, whence);
+  off_t rv;
+  off_t result;
 
-  if (result == -1)
+  if (pt->rw_active == SCM_PORT_WRITE)
+    {
+      if (offset != 0 || whence != SEEK_CUR)
+       {
+         fport_flush (port);
+         result = rv = lseek (fp->fdes, offset, whence);
+       }
+      else
+       {
+         /* read current position without disturbing the buffer.  */
+         rv = lseek (fp->fdes, offset, whence);
+         result = rv + (pt->write_pos - pt->write_buf);
+       }
+    }
+  else if (pt->rw_active == SCM_PORT_READ)
+    {
+      if (offset != 0 || whence != SEEK_CUR)
+       {
+         /* could expand to avoid a second seek.  */
+         scm_end_input (port);
+         result = rv = lseek (fp->fdes, offset, whence);
+       }
+      else
+       {
+         /* read current position without disturbing the buffer
+            (particularly the unread-char buffer).  */
+         rv = lseek (fp->fdes, offset, whence);
+         result = rv - (pt->read_end - pt->read_pos);
+
+         if (pt->read_buf == pt->putback_buf)
+           result -= pt->saved_read_end - pt->saved_read_pos;
+       }
+    }
+  else /* SCM_PORT_NEITHER */
+    {
+      result = rv = lseek (fp->fdes, offset, whence);      
+    }
+
+  if (rv == -1)
     scm_syserror ("fport_seek");
+
   return result;
 }
 
@@ -461,7 +571,7 @@ fport_truncate (SCM port, off_t length)
 }
 
 static void
-fport_write (SCM port, void *data, size_t size)
+fport_write (SCM port, const void *data, size_t size)
 {
   scm_port *pt = SCM_PTAB_ENTRY (port);
 
@@ -476,21 +586,23 @@ fport_write (SCM port, void *data, size_t size)
   else 
     {
       const char *input = (char *) data;
-      while (size > 0)
+      size_t remaining = size;
+
+      while (remaining > 0)
        {
          int space = pt->write_end - pt->write_pos;
-         int write_len = (size > space) ? space : size;
+         int write_len = (remaining > space) ? space : remaining;
 
-         strncpy (pt->write_pos, input, write_len);
+         memcpy (pt->write_pos, input, write_len);
          pt->write_pos += write_len;
-         size -= write_len;
+         remaining -= write_len;
          input += write_len;
          if (write_len == space)
            fport_flush (port);
        }
 
       /* handle line buffering.  */
-      if ((SCM_CAR (port) & SCM_BUFLINE) && memchr (data, '\n', size))
+      if ((SCM_CELL_WORD_0 (port) & SCM_BUFLINE) && memchr (data, '\n', size))
        fport_flush (port);
     }
 }
@@ -504,7 +616,7 @@ fport_flush (SCM port)
 {
   scm_port *pt = SCM_PTAB_ENTRY (port);
   struct scm_fport *fp = SCM_FSTREAM (port);
-  char *ptr = pt->write_buf;
+  unsigned char *ptr = pt->write_buf;
   int init_size = pt->write_pos - pt->write_buf;
   int remaining = init_size;
 
@@ -547,7 +659,7 @@ fport_flush (SCM port)
       remaining -= count;
     }
   pt->write_pos = pt->write_buf;
-  pt->rw_active = 0;
+  pt->rw_active = SCM_PORT_NEITHER;
 }
 
 /* clear the read buffer and adjust the file position for unread bytes. */
@@ -567,7 +679,7 @@ fport_end_input (SCM port, int offset)
       if (lseek (fp->fdes, -offset, SEEK_CUR) == -1)
        scm_syserror ("fport_end_input");
     }
-  pt->rw_active = 0;
+  pt->rw_active = SCM_PORT_NEITHER;
 }
 
 static int
@@ -617,8 +729,14 @@ scm_make_fptob ()
 void
 scm_init_fports ()
 {
-#include "fports.x"
+#include "libguile/fports.x"
   scm_sysintern ("_IOFBF", SCM_MAKINUM (_IOFBF));
   scm_sysintern ("_IOLBF", SCM_MAKINUM (_IOLBF));
   scm_sysintern ("_IONBF", SCM_MAKINUM (_IONBF));
 }
+
+/*
+  Local Variables:
+  c-file-style: "gnu"
+  End:
+*/