* gsubr.c (scm_gsubr_apply): Added dummy return to avoid compiler

[bpt/guile.git] / libguile / ioext.c

diff --git a/libguile/ioext.c b/libguile/ioext.c
index 3a4cdec..bcf0cd5 100644 (file)
--- a/libguile/ioext.c
+++ b/libguile/ioext.c
@@ -117,13 +117,13 @@ scm_read_delimited_x (delims, buf, gobble, port, start, end)
     {  
       int k;
 
-      c = scm_gen_getc (port);
+      c = scm_getc (port);
       for (k = 0; k < num_delims; k++)
        {
          if (cdelims[k] == c)
            {
              if (SCM_FALSEP (gobble))
-               scm_gen_ungetc (c, port);
+               scm_ungetc (c, port);
 
              return scm_cons (SCM_MAKICHR (c),
                               scm_long2num (j - cstart));
@@ -138,6 +138,14 @@ scm_read_delimited_x (delims, buf, gobble, port, start, end)
   return scm_cons (SCM_BOOL_F, scm_long2num (j - cstart));
 }
 
+/*
+ * %read-line uses a port's fgets method for fast line i/o.  It
+ * truncates any terminating newline from its input, and returns
+ * a cons of the string read and its terminating character.  Doing
+ * so makes it easy to implement the hairy `read-line' options
+ * efficiently in Scheme.
+ */
+
 SCM_PROC (s_read_line, "%read-line", 0, 1, 0, scm_read_line);
 
 SCM
@@ -145,6 +153,8 @@ scm_read_line (port)
      SCM port;
 {
   char *s;
+  int slen;
+  SCM line, term;
 
   if (SCM_UNBNDP (port))
     port = scm_cur_inp;
@@ -154,8 +164,27 @@ scm_read_line (port)
                  port, SCM_ARG1, s_read_line);
     }
 
-  s = scm_gen_read_line (port);
-  return (s == NULL ? SCM_EOF_VAL : scm_makfrom0str (s));
+  s = scm_do_read_line (port, &slen);
+
+  if (s == NULL)
+    term = line = SCM_EOF_VAL;
+  else
+    {
+      if (s[slen-1] == '\n')
+       {
+         term = SCM_MAKICHR ('\n');
+         line = scm_makfromstr (s, slen-1, 0);
+       }
+      else
+       {
+         /* Fix: we should check for eof on the port before assuming this. */
+         term = SCM_EOF_VAL;
+         line = scm_makfromstr (s, slen, 0);
+       }         
+      free (s);
+    }
+
+  return scm_cons (line, term);
 }
 
 SCM_PROC (s_write_line, "write-line", 1, 1, 0, scm_write_line);
@@ -172,16 +201,28 @@ scm_write_line (obj, port)
 SCM_PROC (s_ftell, "ftell", 1, 0, 0, scm_ftell);
 
 SCM 
-scm_ftell (port)
-     SCM port;
+scm_ftell (object)
+     SCM object;
 {
   long pos;
-  SCM_ASSERT (SCM_NIMP (port) && SCM_OPFPORTP (port), port, SCM_ARG1, s_ftell);
-  SCM_SYSCALL (pos = ftell ((FILE *)SCM_STREAM (port)));
+
+  object = SCM_COERCE_OUTPORT (object);
+
+  SCM_DEFER_INTS;
+  if (SCM_NIMP (object) && SCM_OPFPORTP (object))
+    {
+      SCM_SYSCALL (pos = ftell ((FILE *)SCM_STREAM (object)));
+      if (pos > 0 && SCM_CRDYP (object))
+       pos--;
+    }
+  else
+    {
+      SCM_ASSERT (SCM_INUMP (object), object, SCM_ARG1, s_ftell);
+      SCM_SYSCALL (pos = lseek (SCM_INUM (object), 0, SEEK_CUR));
+    }
   if (pos < 0)
     scm_syserror (s_ftell);
-  if (pos > 0 && SCM_CRDYP (port))
-    pos--;
+  SCM_ALLOW_INTS;
   return scm_long2num (pos);
 }
 
@@ -190,29 +231,35 @@ scm_ftell (port)
 SCM_PROC (s_fseek, "fseek", 3, 0, 0, scm_fseek);
 
 SCM 
-scm_fseek (port, offset, whence)
-     SCM port;
+scm_fseek (object, offset, whence)
+     SCM object;
      SCM offset;
      SCM whence;
 {
   int rv;
   long loff;
 
-  SCM_ASSERT (SCM_NIMP (port) && SCM_OPFPORTP (port), port, SCM_ARG1, s_fseek);
+  object = SCM_COERCE_OUTPORT (object);
+
   loff = scm_num2long (offset, (char *)SCM_ARG2, s_fseek);
-  SCM_ASSERT (SCM_INUMP (whence) && (SCM_INUM (whence) < 3) && (SCM_INUM (whence) >= 0),
-         whence, SCM_ARG3, s_fseek);
-  
-  SCM_CLRDY (port);                    /* Clear ungetted char */
-  /* Values of whence are interned in scm_init_ioext.  */
-  rv = fseek ((FILE *)SCM_STREAM (port), loff, SCM_INUM (whence));
-  if (rv != 0)
+  SCM_ASSERT (SCM_INUMP (whence), whence, SCM_ARG3, s_fseek);
+  SCM_DEFER_INTS;
+  if (SCM_NIMP (object) && SCM_OPFPORTP (object))
+    {
+      SCM_CLRDY (object);                      /* Clear ungetted char */
+      rv = fseek ((FILE *)SCM_STREAM (object), loff, SCM_INUM (whence));
+    }
+  else
+    {
+      SCM_ASSERT (SCM_INUMP (object), object, SCM_ARG1, s_fseek);
+      rv = lseek (SCM_INUM (object), loff, SCM_INUM (whence));
+    }
+  if (rv < 0)
     scm_syserror (s_fseek);
+  SCM_ALLOW_INTS;
   return SCM_UNSPECIFIED;
 }
 
-
-
 SCM_PROC (s_freopen, "freopen", 3, 0, 0, scm_freopen);
 
 SCM 
@@ -229,6 +276,7 @@ scm_freopen (filename, modes, port)
 
   SCM_COERCE_SUBSTR (filename);
   SCM_COERCE_SUBSTR (modes);
+  port = SCM_COERCE_OUTPORT (port);
   SCM_DEFER_INTS;
   SCM_ASSERT (SCM_NIMP (port) && SCM_FPORTP (port), port, SCM_ARG3, s_freopen);
   SCM_SYSCALL (f = freopen (SCM_ROCHARS (filename), SCM_ROCHARS (modes),
@@ -262,6 +310,9 @@ scm_redirect_port (old, new)
 {
   int ans, oldfd, newfd;
 
+  old = SCM_COERCE_OUTPORT (old);
+  new = SCM_COERCE_OUTPORT (new);
+
   SCM_DEFER_INTS;
   SCM_ASSERT (SCM_NIMP (old) && SCM_OPPORTP (old), old, SCM_ARG1, s_redirect_port);
   SCM_ASSERT (SCM_NIMP (new) && SCM_OPPORTP (new), new, SCM_ARG2, s_redirect_port);
@@ -284,6 +335,8 @@ scm_dup_to_fdes (SCM fd_or_port, SCM fd)
 {
   int oldfd, newfd, rv;
 
+  fd_or_port = SCM_COERCE_OUTPORT (fd_or_port);
+
   SCM_DEFER_INTS;
   if (SCM_INUMP (fd_or_port))
     oldfd = SCM_INUM (fd_or_port);
@@ -326,6 +379,9 @@ scm_fileno (port)
      SCM port;
 {
   int fd;
+
+  port = SCM_COERCE_OUTPORT (port);
+
   SCM_ASSERT (SCM_NIMP (port) && SCM_OPFPORTP (port), port, SCM_ARG1, s_fileno);
   fd = fileno ((FILE *)SCM_STREAM (port));
   if (fd == -1)
@@ -340,6 +396,9 @@ scm_isatty_p (port)
      SCM port;
 {
   int rv;
+
+  port = SCM_COERCE_OUTPORT (port);
+
   SCM_ASSERT (SCM_NIMP (port) && SCM_OPFPORTP (port), port, SCM_ARG1, s_isatty);
   rv = fileno ((FILE *)SCM_STREAM (port));
   if (rv == -1)
@@ -399,6 +458,8 @@ scm_primitive_move_to_fdes (port, fd)
   int new_fd;
   int rv;
 
+  port = SCM_COERCE_OUTPORT (port);
+
   SCM_ASSERT (SCM_NIMP (port) && SCM_OPFPORTP (port), port, SCM_ARG1, s_primitive_move_to_fdes);
   SCM_ASSERT (SCM_INUMP (fd), fd, SCM_ARG2, s_primitive_move_to_fdes);
   SCM_DEFER_INTS;