libguile/fports.c

   1 /*      Copyright (C) 1995,1996,1997,1998,1999 Free Software Foundation, Inc.
   2  *
   3  * This program is free software; you can redistribute it and/or modify
   4  * it under the terms of the GNU General Public License as published by
   5  * the Free Software Foundation; either version 2, or (at your option)
   6  * any later version.
   7  *
   8  * This program is distributed in the hope that it will be useful,
   9  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  10  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  11  * GNU General Public License for more details.
  12  *
  13  * You should have received a copy of the GNU General Public License
  14  * along with this software; see the file COPYING.  If not, write to
  15  * the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
  16  * Boston, MA 02111-1307 USA
  17  *
  18  * As a special exception, the Free Software Foundation gives permission
  19  * for additional uses of the text contained in its release of GUILE.
  20  *
  21  * The exception is that, if you link the GUILE library with other files
  22  * to produce an executable, this does not by itself cause the
  23  * resulting executable to be covered by the GNU General Public License.
  24  * Your use of that executable is in no way restricted on account of
  25  * linking the GUILE library code into it.
  26  *
  27  * This exception does not however invalidate any other reasons why
  28  * the executable file might be covered by the GNU General Public License.
  29  *
  30  * This exception applies only to the code released by the
  31  * Free Software Foundation under the name GUILE.  If you copy
  32  * code from other Free Software Foundation releases into a copy of
  33  * GUILE, as the General Public License permits, the exception does
  34  * not apply to the code that you add in this way.  To avoid misleading
  35  * anyone as to the status of such modified files, you must delete
  36  * this exception notice from them.
  37  *
  38  * If you write modifications of your own for GUILE, it is your choice
  39  * whether to permit this exception to apply to your modifications.
  40  * If you do not wish that, delete this exception notice.  */
  41 \f
  42
  43 #include <stdio.h>
  44 #include <fcntl.h>
  45 #include "_scm.h"
  46
  47 #include "fports.h"
  48
  49 #ifdef HAVE_STRING_H
  50 #include <string.h>
  51 #endif
  52 #ifdef HAVE_UNISTD_H
  53 #include <unistd.h>
  54 #else
  55 scm_sizet fwrite ();
  56 #endif
  57 #ifdef HAVE_ST_BLKSIZE
  58 #include <sys/stat.h>
  59 #endif
  60
  61 #include <errno.h>
  62
  63 #include "iselect.h"
  64
  65 /* create FPORT buffer with specified sizes (or -1 to use default size or
  66    0 for no buffer.  */
  67 static void
  68 scm_fport_buffer_add (SCM port, int read_size, int write_size)
  69 {
  70   struct scm_fport *fp = SCM_FSTREAM (port);
  71    scm_port *pt = SCM_PTAB_ENTRY (port);
  72   char *s_scm_fport_buffer_add = "scm_fport_buffer_add";
  73
  74   if (read_size == -1 || write_size == -1)
  75     {
  76       int default_size;
  77 #ifdef HAVE_ST_BLKSIZE
  78       struct stat st;
  79
  80       if (fstat (fp->fdes, &st) == -1)
  81         scm_syserror (s_scm_fport_buffer_add);
  82       default_size = st.st_blksize;
  83 #else
  84       default_size = 1024;
  85 #endif
  86       if (read_size == -1)
  87         read_size = default_size;
  88       if (write_size == -1)
  89         write_size = default_size;
  90     }
  91
  92   if (SCM_INPORTP (port) && read_size > 0)
  93     {
  94       pt->read_buf = malloc (read_size);
  95       if (pt->read_buf == NULL)
  96         scm_memory_error (s_scm_fport_buffer_add);
  97       pt->read_pos = pt->read_end = pt->read_buf;
  98       pt->read_buf_size = read_size;
  99     }
 100   else
 101     {
 102       pt->read_pos = pt->read_buf = pt->read_end = &pt->shortbuf;
 103       pt->read_buf_size = 1;
 104     }
 105
 106   if (SCM_OUTPORTP (port) && write_size > 0)
 107     {
 108       pt->write_buf = malloc (write_size);
 109       if (pt->write_buf == NULL)
 110         scm_memory_error (s_scm_fport_buffer_add);
 111       pt->write_pos = pt->write_buf;
 112       pt->write_buf_size = write_size;
 113     }
 114   else
 115     {
 116       pt->write_buf = pt->write_pos = &pt->shortbuf;
 117       pt->write_buf_size = 1;
 118     }
 119
 120   pt->write_end = pt->write_buf + pt->write_buf_size;
 121   if (read_size > 0 || write_size > 0)
 122     SCM_SETCAR (port, SCM_CAR (port) & ~SCM_BUF0);
 123   else
 124     SCM_SETCAR (port, (SCM_CAR (port) | SCM_BUF0));
 125 }
 126
 127 SCM_PROC (s_setvbuf, "setvbuf", 2, 1, 0, scm_setvbuf);
 128 SCM
 129 scm_setvbuf (SCM port, SCM mode, SCM size)
 130 {
 131   int cmode, csize;
 132   scm_port *pt;
 133
 134   port = SCM_COERCE_OUTPORT (port);
 135
 136   SCM_ASSERT (SCM_NIMP (port) && SCM_OPFPORTP (port), port, SCM_ARG1,
 137               s_setvbuf);
 138   SCM_ASSERT (SCM_INUMP (mode), mode, SCM_ARG2, s_setvbuf);
 139   cmode = SCM_INUM (mode);
 140   if (cmode != _IONBF && cmode != _IOFBF)
 141     scm_out_of_range (s_setvbuf, mode);
 142   if (SCM_UNBNDP (size))
 143     {
 144       if (cmode == _IOFBF)
 145         csize = -1;
 146       else
 147         csize = 0;
 148     }
 149   else
 150     {
 151       SCM_ASSERT (SCM_INUMP (size), size, SCM_ARG3, s_setvbuf);
 152       csize = SCM_INUM (size);
 153       if (csize < 0 || (cmode == _IONBF && csize > 0))
 154         scm_out_of_range (s_setvbuf, size);
 155     }
 156   pt = SCM_PTAB_ENTRY (port);
 157
 158   /* silently discards buffered chars.  */
 159   if (pt->read_buf != &pt->shortbuf)
 160     scm_must_free (pt->read_buf);
 161   if (pt->write_buf != &pt->shortbuf)
 162     scm_must_free (pt->write_buf);
 163
 164   scm_fport_buffer_add (port, csize, csize);
 165   return SCM_UNSPECIFIED;
 166 }
 167
 168 /* Move ports with the specified file descriptor to new descriptors,
 169  * reseting the revealed count to 0.
 170  */
 171
 172 void
 173 scm_evict_ports (fd)
 174      int fd;
 175 {
 176   int i;
 177
 178   for (i = 0; i < scm_port_table_size; i++)
 179     {
 180       SCM port = scm_port_table[i]->port;
 181
 182       if (SCM_FPORTP (port))
 183         {
 184           struct scm_fport *fp = SCM_FSTREAM (port);
 185
 186           if (fp->fdes == fd)
 187             {
 188               fp->fdes = dup (fd);
 189               if (fp->fdes == -1)
 190                 scm_syserror ("scm_evict_ports");
 191               scm_set_port_revealed_x (port, SCM_MAKINUM (0));
 192             }
 193         }
 194     }
 195 }
 196
 197 /* scm_open_file
 198  * Return a new port open on a given file.
 199  *
 200  * The mode string must match the pattern: [rwa+]** which
 201  * is interpreted in the usual unix way.
 202  *
 203  * Return the new port.
 204  */
 205 SCM_PROC(s_open_file, "open-file", 2, 0, 0, scm_open_file);
 206
 207 SCM
 208 scm_open_file (filename, modes)
 209      SCM filename;
 210      SCM modes;
 211 {
 212   SCM port;
 213   int fdes;
 214   int flags = 0;
 215   char *file;
 216   char *mode;
 217   char *ptr;
 218
 219   SCM_ASSERT (SCM_NIMP (filename) && SCM_ROSTRINGP (filename), filename, SCM_ARG1, s_open_file);
 220   SCM_ASSERT (SCM_NIMP (modes) && SCM_ROSTRINGP (modes), modes, SCM_ARG2, s_open_file);
 221   if (SCM_SUBSTRP (filename))
 222     filename = scm_makfromstr (SCM_ROCHARS (filename), SCM_ROLENGTH (filename), 0);
 223   if (SCM_SUBSTRP (modes))
 224     modes = scm_makfromstr (SCM_ROCHARS (modes), SCM_ROLENGTH (modes), 0);
 225
 226   file = SCM_ROCHARS (filename);
 227   mode = SCM_ROCHARS (modes);
 228
 229   switch (*mode)
 230     {
 231     case 'r':
 232       flags |= O_RDONLY;
 233       break;
 234     case 'w':
 235       flags |= O_WRONLY | O_CREAT | O_TRUNC;
 236       break;
 237     case 'a':
 238       flags |= O_WRONLY | O_CREAT | O_APPEND;
 239       break;
 240     default:
 241       scm_out_of_range (s_open_file, modes);
 242     }
 243   ptr = mode + 1;
 244   while (*ptr != '\0')
 245     {
 246       switch (*ptr)
 247         {
 248         case '+':
 249           flags = (flags & ~(O_RDONLY | O_WRONLY)) | O_RDWR;
 250           break;
 251         case '0':  /* unbuffered: handled later.  */
 252         case 'b':  /* 'binary' mode: ignored.  */
 253           break;
 254         default:
 255           scm_out_of_range (s_open_file, modes);
 256         }
 257       ptr++;
 258     }
 259   SCM_SYSCALL (fdes = open (file, flags, 0666));
 260   if (fdes == -1)
 261     {
 262       int en = errno;
 263
 264       scm_syserror_msg (s_open_file, "%s: %S",
 265                         scm_cons (scm_makfrom0str (strerror (en)),
 266                                   scm_cons (filename, SCM_EOL)),
 267                         en);
 268     }
 269   port = scm_fdes_to_port (fdes, mode, filename);
 270   return port;
 271 }
 272
 273 \f
 274 /* Building Guile ports from a file descriptor.  */
 275
 276 /* Build a Scheme port from an open file descriptor `fdes'.
 277    MODE indicates whether FILE is open for reading or writing; it uses
 278       the same notation as open-file's second argument.
 279    Use NAME as the port's filename.  */
 280
 281 SCM
 282 scm_fdes_to_port (int fdes, char *mode, SCM name)
 283 {
 284   long mode_bits = scm_mode_bits (mode);
 285   SCM port;
 286   scm_port *pt;
 287
 288   SCM_NEWCELL (port);
 289   SCM_DEFER_INTS;
 290   pt = scm_add_to_port_table (port);
 291   SCM_SETPTAB_ENTRY (port, pt);
 292   SCM_SETCAR (port, (scm_tc16_fport | mode_bits));
 293
 294   {
 295     struct scm_fport *fp
 296       = (struct scm_fport *) malloc (sizeof (struct scm_fport));
 297     if (fp == NULL)
 298       scm_memory_error ("scm_fdes_to_port");
 299     fp->fdes = fdes;
 300     pt->rw_random = (mode_bits & SCM_RDNG) && (mode_bits & SCM_WRTNG)
 301       && SCM_FDES_RANDOM_P (fdes);
 302     SCM_SETSTREAM (port, fp);
 303     if (mode_bits & SCM_BUF0)
 304       scm_fport_buffer_add (port, 0, 0);
 305     else
 306       scm_fport_buffer_add (port, -1, -1);
 307   }
 308   SCM_PTAB_ENTRY (port)->file_name = name;
 309   SCM_ALLOW_INTS;
 310   return port;
 311 }
 312
 313
 314 /* Check whether an fport's fdes can supply input.  */
 315 static int
 316 fport_input_waiting_p (SCM port)
 317 {
 318   int fdes = SCM_FSTREAM (port)->fdes;
 319
 320 #ifdef HAVE_SELECT
 321   struct timeval timeout;
 322   SELECT_TYPE read_set;
 323   SELECT_TYPE write_set;
 324   SELECT_TYPE except_set;
 325
 326   FD_ZERO (&read_set);
 327   FD_ZERO (&write_set);
 328   FD_ZERO (&except_set);
 329
 330   FD_SET (fdes, &read_set);
 331
 332   timeout.tv_sec = 0;
 333   timeout.tv_usec = 0;
 334
 335   if (select (SELECT_SET_SIZE,
 336               &read_set, &write_set, &except_set, &timeout)
 337       < 0)
 338     scm_syserror ("fport_input_waiting_p");
 339   return FD_ISSET (fdes, &read_set);
 340 #elif defined (FIONREAD)
 341   int remir;
 342   ioctl(fdes, FIONREAD, &remir);
 343   return remir;
 344 #else
 345   scm_misc_error ("fport_input_waiting_p",
 346                   "Not fully implemented on this platform",
 347                   SCM_EOL);
 348 #endif
 349 }
 350
 351 \f
 352 static int prinfport SCM_P ((SCM exp, SCM port, scm_print_state *pstate));
 353
 354 static int
 355 prinfport (exp, port, pstate)
 356      SCM exp;
 357      SCM port;
 358      scm_print_state *pstate;
 359 {
 360   SCM name;
 361   char * c;
 362   if (SCM_CLOSEDP (exp))
 363     {
 364       c = "file";
 365     }
 366   else
 367     {
 368       name = SCM_PTAB_ENTRY (exp)->file_name;
 369       if (SCM_NIMP (name) && SCM_ROSTRINGP (name))
 370         c = SCM_ROCHARS (name);
 371       else
 372         c = "file";
 373     }
 374
 375   scm_prinport (exp, port, c);
 376   return !0;
 377 }
 378
 379 #ifdef GUILE_ISELECT
 380 /* thread-local block for input on fport's fdes.  */
 381 static void
 382 fport_wait_for_input (SCM port)
 383 {
 384   int fdes = SCM_FSTREAM (port)->fdes;
 385
 386   if (!fport_input_waiting_p (port))
 387     {
 388       int n;
 389       SELECT_TYPE readfds;
 390       int flags = fcntl (fdes, F_GETFL);
 391
 392       if (flags == -1)
 393         scm_syserror ("scm_fdes_wait_for_input");
 394       if (!(flags & O_NONBLOCK))
 395         do
 396           {
 397             FD_ZERO (&readfds);
 398             FD_SET (fdes, &readfds);
 399             n = scm_internal_select (fdes + 1, &readfds, NULL, NULL, NULL);
 400           }
 401         while (n == -1 && errno == EINTR);
 402     }
 403 }
 404 #endif
 405
 406 static void local_fflush (SCM port);
 407
 408 /* fill a port's read-buffer with a single read.
 409    returns the first char and moves the read_pos pointer past it.
 410    or returns EOF if end of file.  */
 411 static int
 412 fport_fill_buffer (SCM port)
 413 {
 414   int count;
 415   scm_port *pt = SCM_PTAB_ENTRY (port);
 416   struct scm_fport *fp = SCM_FSTREAM (port);
 417
 418 #ifdef GUILE_ISELECT
 419   fport_wait_for_input (port);
 420 #endif
 421   SCM_SYSCALL (count = read (fp->fdes, pt->read_buf, pt->read_buf_size));
 422   if (count == -1)
 423     scm_syserror ("fport_fill_buffer");
 424   if (count == 0)
 425     return EOF;
 426   else
 427     {
 428       pt->read_pos = pt->read_buf + 1;
 429       pt->read_end = pt->read_buf + count;
 430       return (*(pt->read_buf));
 431     }
 432 }
 433
 434 static off_t
 435 local_seek (SCM port, off_t offset, int whence)
 436 {
 437   struct scm_fport *fp = SCM_FSTREAM (port);
 438   off_t result = lseek (fp->fdes, offset, whence);
 439
 440   if (result == -1)
 441     scm_syserror ("local_seek");
 442   return result;
 443 }
 444
 445 static void
 446 local_ftruncate (SCM port, off_t length)
 447 {
 448   struct scm_fport *fp = SCM_FSTREAM (port);
 449
 450   if (ftruncate (fp->fdes, length) == -1)
 451     scm_syserror ("ftruncate");
 452 }
 453
 454 /* becomes 1 when process is exiting: exception handling is disabled. */
 455 extern int terminating;
 456
 457 static void
 458 local_fflush (SCM port)
 459 {
 460   scm_port *pt = SCM_PTAB_ENTRY (port);
 461   struct scm_fport *fp = SCM_FSTREAM (port);
 462   char *ptr = pt->write_buf;
 463   int init_size = pt->write_pos - pt->write_buf;
 464   int remaining = init_size;
 465
 466   while (remaining > 0)
 467     {
 468       int count;
 469
 470       SCM_SYSCALL (count = write (fp->fdes, ptr, remaining));
 471       if (count < 0)
 472         {
 473           /* error.  assume nothing was written this call, but
 474              fix up the buffer for any previous successful writes.  */
 475           int done = init_size - remaining;
 476
 477           if (done > 0)
 478             {
 479               int i;
 480
 481               for (i = 0; i < remaining; i++)
 482                 {
 483                   *(pt->write_buf + i) = *(pt->write_buf + done + i);
 484                 }
 485               pt->write_pos = pt->write_buf + remaining;
 486             }
 487           if (!terminating)
 488             scm_syserror ("local_fflush");
 489           else
 490             {
 491               const char *msg = "Error: could not flush file-descriptor ";
 492               char buf[11];
 493
 494               write (2, msg, strlen (msg));
 495               sprintf (buf, "%d\n", fp->fdes);
 496               write (2, buf, strlen (buf));
 497
 498               count = remaining;
 499             }
 500         }
 501       ptr += count;
 502       remaining -= count;
 503     }
 504   pt->write_pos = pt->write_buf;
 505   pt->rw_active = 0;
 506 }
 507
 508 /* clear the read buffer and adjust the file position for unread bytes. */
 509 static void
 510 local_read_flush (SCM port, int offset)
 511 {
 512   struct scm_fport *fp = SCM_FSTREAM (port);
 513   scm_port *pt = SCM_PTAB_ENTRY (port);
 514
 515   offset += pt->read_end - pt->read_pos;
 516
 517   if (offset > 0)
 518     {
 519       pt->read_pos = pt->read_end;
 520       /* will throw error if unread-char used at beginning of file
 521          then attempting to write.  seems correct.  */
 522       if (lseek (fp->fdes, -offset, SEEK_CUR) == -1)
 523         scm_syserror ("local_read_flush");
 524     }
 525   pt->rw_active = 0;
 526 }
 527
 528 static int
 529 local_fclose (SCM port)
 530 {
 531   struct scm_fport *fp = SCM_FSTREAM (port);
 532   scm_port *pt = SCM_PTAB_ENTRY (port);
 533   int rv;
 534
 535   local_fflush (port);
 536   SCM_SYSCALL (rv = close (fp->fdes));
 537   if (rv == -1 && errno != EBADF)
 538     scm_syserror ("local_fclose");
 539   if (pt->read_buf == pt->putback_buf)
 540     pt->read_buf = pt->saved_read_buf;
 541   if (pt->read_buf != &pt->shortbuf)
 542     free (pt->read_buf);
 543   if (pt->write_buf != &pt->shortbuf)
 544     free (pt->write_buf);
 545   free ((char *) fp);
 546   return rv;
 547 }
 548
 549 scm_ptobfuns scm_fptob =
 550  {
 551   0,
 552   local_fclose,
 553   prinfport,
 554   0,
 555   local_fflush,
 556   local_read_flush,
 557   local_fclose,
 558   fport_fill_buffer,
 559   local_seek,
 560   local_ftruncate,
 561   fport_input_waiting_p,
 562 };
 563
 564 void
 565 scm_init_fports ()
 566 {
 567 #include "fports.x"
 568   scm_sysintern ("_IOFBF", SCM_MAKINUM (_IOFBF));
 569   scm_sysintern ("_IOLBF", SCM_MAKINUM (_IOLBF));
 570   scm_sysintern ("_IONBF", SCM_MAKINUM (_IONBF));
 571 }