-/* Copyright (C) 1995, 1996, 1997, 1998 Free Software Foundation, Inc.
+/* Copyright (C) 1995, 1996, 1997, 1998, 1999 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
static unsigned char *
scm_do_read_line (SCM port, int *len_p)
{
- struct scm_port_table *pt = SCM_PTAB_ENTRY (port);
+ scm_port *pt = SCM_PTAB_ENTRY (port);
unsigned char *end;
/* I thought reading lines was simple. Mercy me. */
- /* If there are any pushed-back characters, read the line character
- by character. */
- if (SCM_CRDYP (port))
- {
- int buf_size = 60;
- /* Invariant: buf always has buf_size + 1 characters allocated;
- the `+ 1' is for the final '\0'. */
- unsigned char *buf = malloc (buf_size + 1);
- int buf_len = 0;
- int c;
-
- while ((c = scm_getc (port)) != EOF)
- {
- if (buf_len >= buf_size)
- {
- buf = realloc (buf, buf_size * 2 + 1);
- buf_size *= 2;
- }
-
- buf[buf_len++] = c;
-
- if (c == '\n')
- break;
- }
-
- /* Since SCM_CRDYP returned true, we ought to have gotten at
- least one character. */
- if (buf_len == 0)
- abort ();
-
- buf[buf_len] = '\0';
-
- *len_p = buf_len;
- return buf;
- }
-
- /* The common case: no unread characters, and the buffer contains
- a complete line. This needs to be fast. */
+ /* The common case: the buffer contains a complete line.
+ This needs to be fast. */
if ((end = memchr (pt->read_pos, '\n', (pt->read_end - pt->read_pos)))
!= 0)
{
int buf_len = (end + 1) - pt->read_pos;
/* Allocate a buffer of the perfect size. */
- unsigned char *buf = malloc (buf_len + 1);
+ unsigned char *buf = scm_must_malloc (buf_len + 1, "%read-line");
memcpy (buf, pt->read_pos, buf_len);
pt->read_pos += buf_len;
return buf;
}
- /* There are no unread characters, and the buffer contains no newlines. */
+ /* The buffer contains no newlines. */
{
/* When live, len is always the number of characters in the
current buffer that are part of the current line. */
int buf_size = (len < 50) ? 60 : len * 2;
/* Invariant: buf always has buf_size + 1 characters allocated;
the `+ 1' is for the final '\0'. */
- unsigned char *buf = malloc (buf_size + 1);
+ unsigned char *buf = scm_must_malloc (buf_size + 1, "%read-line");
int buf_len = 0;
- int c;
for (;;)
{
if (buf_len + len > buf_size)
{
int new_size = (buf_len + len) * 2;
- buf = realloc (buf, new_size + 1);
+ buf = scm_must_realloc (buf, buf_size + 1, new_size + 1,
+ "%read-line");
buf_size = new_size;
}
if (end)
break;
- /* Get more characters. I think having fill_buffer return a
- character is not terribly graceful... */
- c = (scm_ptobs[SCM_PTOBNUM (port)].fill_buffer) (port);
- if (c == EOF)
+ /* Get more characters. */
+ if (scm_fill_input (port) == EOF)
{
/* If we're missing a final newline in the file, return
what we did get, sans newline. */
return 0;
}
- /* ... because it makes us duplicate code here... */
- if (buf_len + 1 > buf_size)
- {
- int new_size = buf_size * 2;
- buf = realloc (buf, new_size + 1);
- buf_size = new_size;
- }
-
- /* ... and this is really a duplication of the memcpy and
- memchr calls, on a single-byte buffer. */
- buf[buf_len++] = c;
- if (c == '\n')
- break;
-
/* Search the buffer for newlines. */
if ((end = memchr (pt->read_pos, '\n',
(len = (pt->read_end - pt->read_pos))))
}
/* I wonder how expensive this realloc is. */
- buf = realloc (buf, buf_len + 1);
+ buf = scm_must_realloc (buf, buf_size + 1, buf_len + 1, "%read-line");
buf[buf_len] = '\0';
*len_p = buf_len;
return buf;
scm_read_line (port)
SCM port;
{
+ scm_port *pt;
char *s;
int slen;
SCM line, term;
port, SCM_ARG1, s_read_line);
}
+ pt = SCM_PTAB_ENTRY (port);
+ if (pt->rw_active == SCM_PORT_WRITE)
+ scm_ptobs[SCM_PTOBNUM (port)].flush (port);
+
s = scm_do_read_line (port, &slen);
if (s == NULL)
term = SCM_MAKICHR ('\n');
s[slen-1] = '\0';
line = scm_take_str (s, slen-1);
+ scm_done_malloc (-1);
SCM_INCLINE (port);
}
else
/* Fix: we should check for eof on the port before assuming this. */
term = SCM_EOF_VAL;
line = scm_take_str (s, slen);
+ SCM_COL (port) += slen;
}
}
+ if (pt->rw_random)
+ pt->rw_active = SCM_PORT_READ;
+
return scm_cons (line, term);
}
scm_ftell (object)
SCM object;
{
- if (SCM_INUMP (object))
- {
- int fdes = SCM_INUM (object);
- fpos_t pos;
-
- pos = lseek (fdes, 0, SEEK_CUR);
- if (pos == -1)
- scm_syserror (s_ftell);
- return scm_long2num (pos);
- }
- else
- {
- struct scm_fport *fp;
- struct scm_port_table *pt;
- int fdes;
- fpos_t pos;
-
- object = SCM_COERCE_OUTPORT (object);
- SCM_ASSERT (SCM_NIMP (object) && SCM_OPFPORTP (object),
- object, SCM_ARG1, s_ftell);
- fp = SCM_FSTREAM (object);
- pt = SCM_PTAB_ENTRY (object);
- fdes = fp->fdes;
- pos = lseek (fdes, 0, SEEK_CUR);
- if (pos == -1)
- scm_syserror (s_ftell);
- /* the seek will only have succeeded if fdes is random access,
- in which case only one buffer can be filled. */
- if (pt->write_pos > pt->write_buf)
- {
- pos += pt->write_pos - pt->write_buf;
- }
- else
- {
- pos -= pt->read_end - pt->read_pos;
- if (SCM_CRDYP (object))
- pos -= SCM_N_READY_CHARS (object);
- }
- return scm_long2num (pos);
- }
-}
-
-/* clear the three buffers in a port. */
-#define SCM_CLEAR_BUFFERS(port, pt)\
-{\
- if (pt->write_pos > pt->write_buf)\
- scm_fflush (port);\
- pt->read_pos = pt->read_end = pt->read_buf;\
- pt->write_needs_seek = 0;\
- SCM_CLRDY (port);\
+ return scm_seek (object, SCM_INUM0, SCM_MAKINUM (SEEK_CUR));
}
SCM_PROC (s_fseek, "fseek", 3, 0, 0, scm_fseek);
SCM offset;
SCM whence;
{
- int rv;
- long loff;
-
- object = SCM_COERCE_OUTPORT (object);
-
- loff = scm_num2long (offset, (char *)SCM_ARG2, s_fseek);
- SCM_ASSERT (SCM_INUMP (whence), whence, SCM_ARG3, s_fseek);
- if (SCM_NIMP (object) && SCM_OPFPORTP (object))
- {
- struct scm_fport *fp = SCM_FSTREAM (object);
- struct scm_port_table *pt = SCM_PTAB_ENTRY (object);
+ scm_seek (object, offset, whence);
- /* clear the three buffers. the write buffer should be flushed
- before changing the position. */
- if (fp->random)
- {
- SCM_CLEAR_BUFFERS (object, pt);
- } /* if not random, lseek will fail. */
- rv = lseek (fp->fdes, loff, SCM_INUM (whence));
- if (rv == -1)
- scm_syserror (s_fseek);
- }
- else
- {
- SCM_ASSERT (SCM_INUMP (object), object, SCM_ARG1, s_fseek);
- rv = lseek (SCM_INUM (object), loff, SCM_INUM (whence));
- if (rv == -1)
- scm_syserror (s_fseek);
- }
return SCM_UNSPECIFIED;
}
newfd = fp->fdes;
if (oldfd != newfd)
{
- struct scm_port_table *pt = SCM_PTAB_ENTRY (new);
-
- /* must flush to old fdes. don't clear all buffers here
- in case dup2 fails. */
- if (pt->write_pos > pt->write_buf)
- scm_fflush (new);
+ scm_port *pt = SCM_PTAB_ENTRY (new);
+ scm_port *old_pt = SCM_PTAB_ENTRY (old);
+ scm_ptob_descriptor *ptob = &scm_ptobs[SCM_PTOBNUM (new)];
+
+ /* must flush to old fdes. */
+ if (pt->rw_active == SCM_PORT_WRITE)
+ ptob->flush (new);
+ else if (pt->rw_active == SCM_PORT_READ)
+ scm_end_input (new);
ans = dup2 (oldfd, newfd);
if (ans == -1)
scm_syserror (s_redirect_port);
- fp->random = SCM_FDES_RANDOM_P (fp->fdes);
+ pt->rw_random = old_pt->rw_random;
/* continue using existing buffers, even if inappropriate. */
- SCM_CLEAR_BUFFERS (new, pt);
}
return SCM_UNSPECIFIED;
}
void
scm_init_ioext ()
{
- /* fseek() symbols. */
- scm_sysintern ("SEEK_SET", SCM_MAKINUM (SEEK_SET));
- scm_sysintern ("SEEK_CUR", SCM_MAKINUM (SEEK_CUR));
- scm_sysintern ("SEEK_END", SCM_MAKINUM (SEEK_END));
-
#include "ioext.x"
}
HCoop / bpt / guile.git / blobdiff