2001-11-04 Stefan Jahn <stefan@lkcc.org>
[bpt/guile.git] / libguile / fports.c
index acf7b3f..426db6f 100644 (file)
@@ -1,4 +1,4 @@
-/*     Copyright (C) 1995,1996,1997,1998,1999,2000,2001 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001 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,8 +39,6 @@
  * 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
 
@@ -61,6 +59,9 @@
 #else
 size_t fwrite ();
 #endif
+#ifdef HAVE_IO_H
+#include <io.h>
+#endif
 #ifdef HAVE_STRUCT_STAT_ST_BLKSIZE
 #include <sys/stat.h>
 #endif
@@ -68,9 +69,15 @@ size_t fwrite ();
 #include <errno.h>
 
 #include "libguile/iselect.h"
+/* Some defines for Windows. */
+#ifdef __MINGW32__
+# include <sys/stat.h>
+# include <winsock2.h>
+# define ftruncate(fd, size) chsize (fd, size)
+#endif /* __MINGW32__ */
 
 
-scm_bits_t scm_tc16_fport;
+scm_t_bits scm_tc16_fport;
 
 
 /* default buffer size, used if the O/S won't supply a value.  */
@@ -82,14 +89,14 @@ static void
 scm_fport_buffer_add (SCM port, long read_size, int write_size)
 #define FUNC_NAME "scm_fport_buffer_add"
 {
-  scm_fport_t *fp = SCM_FSTREAM (port);
-  scm_port_t *pt = SCM_PTAB_ENTRY (port);
+  scm_t_port *pt = SCM_PTAB_ENTRY (port);
 
   if (read_size == -1 || write_size == -1)
     {
       size_t default_size;
 #ifdef HAVE_STRUCT_STAT_ST_BLKSIZE
       struct stat st;
+      scm_t_fport *fp = SCM_FSTREAM (port);
       
       default_size = (fstat (fp->fdes, &st) == -1) ? default_buffer_size
        : st.st_blksize;
@@ -150,7 +157,7 @@ SCM_DEFINE (scm_setvbuf, "setvbuf", 2, 1, 0,
 {
   int cmode;
   long csize;
-  scm_port_t *pt;
+  scm_t_port *pt;
 
   port = SCM_COERCE_OUTPORT (port);
 
@@ -211,7 +218,7 @@ scm_evict_ports (int fd)
 
       if (SCM_FPORTP (port))
        {
-         scm_fport_t *fp = SCM_FSTREAM (port);
+         scm_t_fport *fp = SCM_FSTREAM (port);
 
          if (fp->fdes == fd)
            {
@@ -293,8 +300,6 @@ SCM_DEFINE (scm_open_file, "open-file", 2, 0, 0,
 
   SCM_VALIDATE_STRING (1, filename);
   SCM_VALIDATE_STRING (2, mode);
-  SCM_STRING_COERCE_0TERMINATION_X (filename);
-  SCM_STRING_COERCE_0TERMINATION_X (mode);
 
   file = SCM_STRING_CHARS (filename);
   md = SCM_STRING_CHARS (mode);
@@ -349,6 +354,48 @@ SCM_DEFINE (scm_open_file, "open-file", 2, 0, 0,
 #undef FUNC_NAME
 
 \f
+#ifdef __MINGW32__
+/*
+ * Try getting the appropiate file flags for a given file descriptor
+ * under Windows. This incorporates some fancy operations because Windows
+ * differentiates between file, pipe and socket descriptors.
+ */
+#ifndef O_ACCMODE
+# define O_ACCMODE 0x0003
+#endif
+
+static int getflags (int fdes)
+{
+  int flags = 0;
+  struct stat buf;
+  int error, optlen = sizeof (int);
+
+  /* Is this a socket ? */
+  if (getsockopt (fdes, SOL_SOCKET, SO_ERROR, (void *) &error, &optlen) >= 0)
+    flags = O_RDWR;
+  /* Maybe a regular file ? */
+  else if (fstat (fdes, &buf) < 0)
+    flags = -1;
+  else
+    {
+      /* Or an anonymous pipe handle ? */
+      if (buf.st_mode & _S_IFIFO)
+       flags = PeekNamedPipe ((HANDLE) _get_osfhandle (fdes), NULL, 0, 
+                              NULL, NULL, NULL) ? O_RDONLY : O_WRONLY;
+      /* stdin ? */
+      else if (fdes == fileno (stdin) && isatty (fdes))
+       flags = O_RDONLY;
+      /* stdout / stderr ? */
+      else if ((fdes == fileno (stdout) || fdes == fileno (stderr)) && 
+              isatty (fdes))
+       flags = O_WRONLY;
+      else
+       flags = buf.st_mode;
+    }
+  return flags;
+}
+#endif /* __MINGW32__ */
+
 /* Building Guile ports from a file descriptor.  */
 
 /* Build a Scheme port from an open file descriptor `fdes'.
@@ -362,11 +409,15 @@ scm_fdes_to_port (int fdes, char *mode, SCM name)
 {
   long mode_bits = scm_mode_bits (mode);
   SCM port;
-  scm_port_t *pt;
+  scm_t_port *pt;
   int flags;
 
   /* test that fdes is valid.  */
+#ifdef __MINGW32__
+  flags = getflags (fdes);
+#else
   flags = fcntl (fdes, F_GETFL, 0);
+#endif
   if (flags == -1)
     SCM_SYSERROR;
   flags &= O_ACCMODE;
@@ -384,8 +435,8 @@ scm_fdes_to_port (int fdes, char *mode, SCM name)
   SCM_SET_CELL_TYPE (port, (scm_tc16_fport | mode_bits));
 
   {
-    scm_fport_t *fp
-      = (scm_fport_t *) scm_must_malloc (sizeof (scm_fport_t),
+    scm_t_fport *fp
+      = (scm_t_fport *) scm_must_malloc (sizeof (scm_t_fport),
                                              FUNC_NAME);
 
     fp->fdes = fdes;
@@ -441,7 +492,7 @@ fport_input_waiting (SCM port)
 
 \f
 static int 
-fport_print (SCM exp, SCM port, scm_print_state *pstate)
+fport_print (SCM exp, SCM port, scm_print_state *pstate SCM_UNUSED)
 {
   scm_puts ("#<", port);
   scm_print_port_mode (exp, port);    
@@ -456,16 +507,18 @@ fport_print (SCM exp, SCM port, scm_print_state *pstate)
       scm_putc (' ', port);
       fdes = (SCM_FSTREAM (exp))->fdes;
       
+#ifdef HAVE_TTYNAME
       if (isatty (fdes))
        scm_puts (ttyname (fdes), port);
       else
+#endif /* HAVE_TTYNAME */
        scm_intprint (fdes, 10, port);
     }
   else
     {
       scm_puts (SCM_PTOBNAME (SCM_PTOBNUM (exp)), port);
       scm_putc (' ', port);
-      scm_intprint (SCM_UNPACK (SCM_CDR (exp)), 16, port);
+      scm_intprint ((scm_t_bits) SCM_PTAB_ENTRY (exp), 16, port);
     }
   scm_putc ('>', port);
   return 1;
@@ -506,8 +559,8 @@ static int
 fport_fill_input (SCM port)
 {
   long count;
-  scm_port_t *pt = SCM_PTAB_ENTRY (port);
-  scm_fport_t *fp = SCM_FSTREAM (port);
+  scm_t_port *pt = SCM_PTAB_ENTRY (port);
+  scm_t_fport *fp = SCM_FSTREAM (port);
 
 #ifdef GUILE_ISELECT
   fport_wait_for_input (port);
@@ -528,8 +581,8 @@ fport_fill_input (SCM port)
 static off_t
 fport_seek (SCM port, off_t offset, int whence)
 {
-  scm_port_t *pt = SCM_PTAB_ENTRY (port);
-  scm_fport_t *fp = SCM_FSTREAM (port);
+  scm_t_port *pt = SCM_PTAB_ENTRY (port);
+  scm_t_fport *fp = SCM_FSTREAM (port);
   off_t rv;
   off_t result;
 
@@ -580,7 +633,7 @@ fport_seek (SCM port, off_t offset, int whence)
 static void
 fport_truncate (SCM port, off_t length)
 {
-  scm_fport_t *fp = SCM_FSTREAM (port);
+  scm_t_fport *fp = SCM_FSTREAM (port);
 
   if (ftruncate (fp->fdes, length) == -1)
     scm_syserror ("ftruncate");
@@ -595,7 +648,7 @@ static void write_all (SCM port, const void *data, size_t remaining)
 
   while (remaining > 0)
     {
-      ssize_t done;
+      size_t done;
 
       SCM_SYSCALL (done = write (fdes, data, remaining));
 
@@ -611,7 +664,7 @@ static void
 fport_write (SCM port, const void *data, size_t size)
 {
   /* this procedure tries to minimize the number of writes/flushes.  */
-  scm_port_t *pt = SCM_PTAB_ENTRY (port);
+  scm_t_port *pt = SCM_PTAB_ENTRY (port);
 
   if (pt->write_buf == &pt->shortbuf
       || (pt->write_pos == pt->write_buf && size >= pt->write_buf_size))
@@ -672,8 +725,8 @@ extern int terminating;
 static void
 fport_flush (SCM port)
 {
-  scm_port_t *pt = SCM_PTAB_ENTRY (port);
-  scm_fport_t *fp = SCM_FSTREAM (port);
+  scm_t_port *pt = SCM_PTAB_ENTRY (port);
+  scm_t_fport *fp = SCM_FSTREAM (port);
   unsigned char *ptr = pt->write_buf;
   long init_size = pt->write_pos - pt->write_buf;
   long remaining = init_size;
@@ -730,8 +783,8 @@ fport_flush (SCM port)
 static void
 fport_end_input (SCM port, int offset)
 {
-  scm_fport_t *fp = SCM_FSTREAM (port);
-  scm_port_t *pt = SCM_PTAB_ENTRY (port);
+  scm_t_fport *fp = SCM_FSTREAM (port);
+  scm_t_port *pt = SCM_PTAB_ENTRY (port);
   
   offset += pt->read_end - pt->read_pos;
 
@@ -749,8 +802,8 @@ fport_end_input (SCM port, int offset)
 static int
 fport_close (SCM port)
 {
-  scm_fport_t *fp = SCM_FSTREAM (port);
-  scm_port_t *pt = SCM_PTAB_ENTRY (port);
+  scm_t_fport *fp = SCM_FSTREAM (port);
+  scm_t_port *pt = SCM_PTAB_ENTRY (port);
   int rv;
 
   fport_flush (port);
@@ -781,10 +834,10 @@ fport_free (SCM port)
   return 0;
 }
 
-static scm_bits_t
+static scm_t_bits
 scm_make_fptob ()
 {
-  scm_bits_t tc = scm_make_port_type ("file", fport_fill_input, fport_write);
+  scm_t_bits tc = scm_make_port_type ("file", fport_fill_input, fport_write);
 
   scm_set_port_free            (tc, fport_free);
   scm_set_port_print           (tc, fport_print);