* Some more work to get rid of SCM_LENGTH
[bpt/guile.git] / libguile / fports.c
index fdb2b45..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
 
 #include <stdio.h>
 #include <fcntl.h>
-#include "_scm.h"
+#include "libguile/_scm.h"
+#include "libguile/strings.h"
 
-#include "validate.h"
-#include "fports.h"
+#include "libguile/validate.h"
+#include "libguile/fports.h"
 
 #ifdef HAVE_STRING_H
 #include <string.h>
@@ -65,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.  */
@@ -82,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;
@@ -94,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)
@@ -108,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)
@@ -124,9 +127,9 @@ 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_CARW (port) & ~SCM_BUF0);
+    SCM_SET_CELL_WORD_0 (port, SCM_CELL_WORD_0 (port) & ~SCM_BUF0);
   else
-    SCM_SETCAR (port, (SCM_CARW (port) | SCM_BUF0));
+    SCM_SET_CELL_WORD_0 (port, SCM_CELL_WORD_0 (port) | SCM_BUF0);
 }
 
 SCM_DEFINE (scm_setvbuf, "setvbuf", 2, 1, 0, 
@@ -140,32 +143,7 @@ SCM_DEFINE (scm_setvbuf, "setvbuf", 2, 1, 0,
            "@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\n\n\n"
-           "@deffn primitive fcntl fd/port command [value]\n"
-           "Apply @var{command} to the specified file descriptor or the underlying\n"
-           "file descriptor of the specified port.  @var{value} is an optional\n"
-           "integer argument.\n\n"
-           "Values for @var{command} are:\n\n"
-           "@table @code\n"
-           "@item F_DUPFD\n"
-           "Duplicate a file descriptor\n"
-           "@item F_GETFD\n"
-           "Get flags associated with the file descriptor.\n"
-           "@item F_SETFD\n"
-           "Set flags associated with the file descriptor to @var{value}.\n"
-           "@item F_GETFL\n"
-           "Get flags associated with the open file.\n"
-           "@item F_SETFL\n"
-           "Set flags associated with the open file to @var{value}\n"
-           "@item F_GETOWN\n"
-           "Get the process ID of a socket's owner, for @code{SIGIO} signals.\n"
-           "@item F_SETOWN\n"
-           "Set the process that owns a socket to @var{value}, for @code{SIGIO} signals.\n"
-           "@item FD_CLOEXEC\n"
-           "The value used to indicate the \"close on exec\" flag with @code{F_GETFL} or\n"
-           "@code{F_SETFL}.\n"
-           "@end table\n"
-           "")
+           "@end table")
 #define FUNC_NAME s_scm_setvbuf
 {
   int cmode, csize;
@@ -180,12 +158,12 @@ SCM_DEFINE (scm_setvbuf, "setvbuf", 2, 1, 0,
 
   if (cmode == _IOLBF)
     {
-      SCM_SETCAR (port, SCM_CARW (port) | SCM_BUFLINE);
+      SCM_SET_CELL_WORD_0 (port, SCM_CELL_WORD_0 (port) | SCM_BUFLINE);
       cmode = _IOFBF;
     }
   else
     {
-      SCM_SETCAR (port, SCM_CARW (port) ^ SCM_BUFLINE);
+      SCM_SET_CELL_WORD_0 (port, SCM_CELL_WORD_0 (port) ^ SCM_BUFLINE);
     }
 
   if (SCM_UNBNDP (size))
@@ -206,9 +184,9 @@ SCM_DEFINE (scm_setvbuf, "setvbuf", 2, 1, 0,
 
   /* 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;
@@ -301,9 +279,9 @@ SCM_DEFINE (scm_open_file, "open-file", 2, 0, 0,
   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);
@@ -359,26 +337,40 @@ SCM_DEFINE (scm_open_file, "open-file", 2, 0, 0,
 /* 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 = SCM_FDES_RANDOM_P (fdes);
     SCM_SETSTREAM (port, fp);
@@ -391,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
@@ -456,7 +448,7 @@ prinfport (SCM exp,SCM port,scm_print_state *pstate)
     {
       scm_puts (SCM_PTOBNAME (SCM_PTOBNUM (exp)), port);
       scm_putc (' ', port);
-      scm_intprint (SCM_ASWORD (SCM_CDR (exp)), 16, port);
+      scm_intprint (SCM_UNPACK (SCM_CDR (exp)), 16, port);
     }
   scm_putc ('>', port);
   return 1;
@@ -610,7 +602,7 @@ fport_write (SCM port, const void *data, size_t size)
        }
 
       /* handle line buffering.  */
-      if ((SCM_CARW (port) & SCM_BUFLINE) && memchr (data, '\n', size))
+      if ((SCM_CELL_WORD_0 (port) & SCM_BUFLINE) && memchr (data, '\n', size))
        fport_flush (port);
     }
 }
@@ -624,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;
 
@@ -737,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:
+*/