mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-06-09 13:30:26 +02:00
1999-07-13 Gary Houston <ghouston@easynet.co.uk>
* strports.c (scm_strprint_obj): simplify. start with initial buffer size of 0. (st_seek): don't allow string to be extended if seeking past the end of a read-only port. 1999-07-12 Gary Houston <ghouston@easynet.co.uk> * strports.c (st_seek): change the resize checks. * ports.c (scm_ftruncate): throw error if offset works out negative. * strports.c (st_flush): increase string size in blocks of SCM_WRITE_BLOCK instead of 1. set read_end to read_pos if it's greater and reset read_buf_size. (scm_mkstrport): set rw_randow if only writing, since read_buf needs to be maintained for output ports too (it holds the written part of the string, while write_buf may have unwritten buffer chars.) (st_truncate): rewritten. (top of file): added a few notes. 1999-07-06 Gary Houston <ghouston@easynet.co.uk> * strports.c (st_grow_port): set pt->read_pos. set pt->read_buf_size one less than pt->write_buf_size if there's an unwritten char at the end of the string. similarly for pt->read_end. (st_resize_port): renamed from st_grow_port. (st_seek): simplify by assuming that pt->write_pos == pt->read_pos. seek from read_end instead of write_end for SEEK_END. (st_ftruncate): calculate current length using readbuf, not write buf. (scm_strport_to_string): use read_buf_size for length. (stfill_buffer): don't re-initialise the readbuf. 1999-07-05 Gary Houston <ghouston@easynet.co.uk> * strports.c (scm_strport_to_string): new procedure. (scm_call_with_output_string, scm_strprint_obj): use scm_strport_to_string. used SCM_INUM0 instead of SCM_MAKINUM (0) in a few places.
This commit is contained in:
Gary Houston
parent
4dc7f07fde
commit
3fe6190f46
5 changed files with 142 additions and 56 deletions
1
THANKS
1
THANKS
|
|
@ -24,6 +24,7 @@ Bug reports and fixes from:
|
|||
David Lutterkort
|
||||
Christian Lynbech
|
||||
Russ McManus
|
||||
Eric Moore
|
||||
Nicolas Neuss
|
||||
Thien-Thi Nguyen
|
||||
Richard Polton
|
||||
|
|
|
|||
|
|
@ -1,3 +1,47 @@
|
|||
1999-07-13 Gary Houston <ghouston@easynet.co.uk>
|
||||
|
||||
* strports.c (scm_strprint_obj): simplify. start with initial
|
||||
buffer size of 0.
|
||||
(st_seek): don't allow string to be extended if seeking past
|
||||
the end of a read-only port.
|
||||
|
||||
1999-07-12 Gary Houston <ghouston@easynet.co.uk>
|
||||
|
||||
* strports.c (st_seek): change the resize checks.
|
||||
|
||||
* ports.c (scm_ftruncate): throw error if offset works out negative.
|
||||
|
||||
* strports.c (st_flush): increase string size in blocks of
|
||||
SCM_WRITE_BLOCK instead of 1. set read_end to read_pos if
|
||||
it's greater and reset read_buf_size.
|
||||
(scm_mkstrport): set rw_randow if only writing, since read_buf needs
|
||||
to be maintained for output ports too (it holds the written
|
||||
part of the string, while write_buf may have unwritten buffer
|
||||
chars.)
|
||||
(st_truncate): rewritten.
|
||||
(top of file): added a few notes.
|
||||
|
||||
1999-07-06 Gary Houston <ghouston@easynet.co.uk>
|
||||
|
||||
* strports.c (st_grow_port): set pt->read_pos. set
|
||||
pt->read_buf_size one less than pt->write_buf_size if there's
|
||||
an unwritten char at the end of the string. similarly for
|
||||
pt->read_end.
|
||||
(st_resize_port): renamed from st_grow_port.
|
||||
(st_seek): simplify by assuming that pt->write_pos == pt->read_pos.
|
||||
seek from read_end instead of write_end for SEEK_END.
|
||||
(st_ftruncate): calculate current length using readbuf, not write
|
||||
buf.
|
||||
(scm_strport_to_string): use read_buf_size for length.
|
||||
(stfill_buffer): don't re-initialise the readbuf.
|
||||
|
||||
1999-07-05 Gary Houston <ghouston@easynet.co.uk>
|
||||
|
||||
* strports.c (scm_strport_to_string): new procedure.
|
||||
(scm_call_with_output_string, scm_strprint_obj): use
|
||||
scm_strport_to_string.
|
||||
used SCM_INUM0 instead of SCM_MAKINUM (0) in a few places.
|
||||
|
||||
1999-07-08 Mikael Djurfeldt <mdj@mdj-pc.nada.kth.se>
|
||||
|
||||
* symbols.c (scm_gensym): Bugfix. (Thanks to Johannes Hjorth.)
|
||||
|
|
@ -421,7 +465,6 @@ Fri Jun 25 22:14:32 1999 Greg Badros <gjb@cs.washington.edu>
|
|||
|
||||
* strports.c (scm_call_with_output_string): get size from
|
||||
buffer instead of port stream.
|
||||
(scm_strprint_obj): likewise.
|
||||
(st_flush): new proc.
|
||||
|
||||
* ports.h (struct scm_port_table): added write_end member,
|
||||
|
|
|
|||
|
|
@ -1022,7 +1022,15 @@ scm_ftruncate (SCM port, SCM length)
|
|||
else if (pt->rw_active == SCM_PORT_WRITE)
|
||||
ptob->fflush (port);
|
||||
|
||||
ptob->ftruncate (port, scm_num2long (length, (char *)SCM_ARG2, s_ftruncate));
|
||||
{
|
||||
off_t c_length = scm_num2long (length, (char *)SCM_ARG2, s_ftruncate);
|
||||
|
||||
if (c_length < 0)
|
||||
scm_misc_error (s_ftruncate, "negative offset",
|
||||
scm_cons (length, SCM_EOL));
|
||||
|
||||
ptob->ftruncate (port, c_length);
|
||||
}
|
||||
return SCM_UNSPECIFIED;
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -58,6 +58,13 @@
|
|||
*
|
||||
*/
|
||||
|
||||
/* NOTES:
|
||||
write_buf/write_end point to the ends of the allocated string.
|
||||
read_buf/read_end in principle point to the part of the string which
|
||||
has been written to, but this is only updated after a flush.
|
||||
read_pos and write_pos in principle should be equal, but this is only true
|
||||
when rw_active is 0.
|
||||
*/
|
||||
|
||||
static int
|
||||
prinstpt (SCM exp, SCM port, scm_print_state *pstate)
|
||||
|
|
@ -69,37 +76,39 @@ prinstpt (SCM exp, SCM port, scm_print_state *pstate)
|
|||
static int
|
||||
stfill_buffer (SCM port)
|
||||
{
|
||||
SCM str = SCM_STREAM (port);
|
||||
scm_port *pt = SCM_PTAB_ENTRY (port);
|
||||
|
||||
pt->read_buf = SCM_ROCHARS (str);
|
||||
pt->read_buf_size = SCM_ROLENGTH (str);
|
||||
pt->read_end = pt->read_buf + pt->read_buf_size;
|
||||
|
||||
if (pt->read_pos >= pt->read_end)
|
||||
return EOF;
|
||||
else
|
||||
return scm_return_first (*(pt->read_pos++), port);
|
||||
}
|
||||
|
||||
/* change the size of a port's string to new_size. this doesn't
|
||||
change read_buf_size. */
|
||||
static void
|
||||
st_grow_port (scm_port *pt, off_t add)
|
||||
st_resize_port (scm_port *pt, off_t new_size)
|
||||
{
|
||||
off_t new_size = pt->write_buf_size + add;
|
||||
off_t index = pt->write_pos - pt->write_buf;
|
||||
|
||||
pt->write_buf_size = new_size;
|
||||
|
||||
scm_vector_set_length_x (pt->stream, SCM_MAKINUM (new_size));
|
||||
|
||||
scm_vector_set_length_x (pt->stream,
|
||||
SCM_MAKINUM (new_size));
|
||||
pt->read_buf_size = pt->write_buf_size = new_size;
|
||||
/* reset buffer in case reallocation moved the string. */
|
||||
{
|
||||
off_t index = pt->write_pos - pt->write_buf;
|
||||
|
||||
pt->read_buf = pt->write_buf = SCM_CHARS (pt->stream);
|
||||
pt->write_pos = pt->write_buf + index;
|
||||
pt->read_end = pt->write_end = pt->write_buf + pt->write_buf_size;
|
||||
pt->read_pos = pt->write_pos = pt->write_buf + index;
|
||||
pt->write_end = pt->write_buf + pt->write_buf_size;
|
||||
pt->read_end = pt->read_buf + pt->read_buf_size;
|
||||
}
|
||||
}
|
||||
|
||||
/* amount by which write_buf is expanded. */
|
||||
#define SCM_WRITE_BLOCK 80
|
||||
|
||||
/* ensure that write_pos < write_end by enlarging the buffer when
|
||||
necessary. update read_buf to account for written chars. */
|
||||
static void
|
||||
st_flush (SCM port)
|
||||
{
|
||||
|
|
@ -107,9 +116,14 @@ st_flush (SCM port)
|
|||
|
||||
if (pt->write_pos == pt->write_end)
|
||||
{
|
||||
st_grow_port (pt, 1);
|
||||
st_resize_port (pt, pt->write_buf_size + SCM_WRITE_BLOCK);
|
||||
}
|
||||
pt->read_pos = pt->write_pos;
|
||||
if (pt->read_pos > pt->read_end)
|
||||
{
|
||||
pt->read_end = (unsigned char *) pt->read_pos;
|
||||
pt->read_buf_size = pt->read_end - pt->read_buf;
|
||||
}
|
||||
pt->rw_active = 0;
|
||||
}
|
||||
|
||||
|
|
@ -128,29 +142,44 @@ st_seek (SCM port, off_t offset, int whence)
|
|||
scm_port *pt = SCM_PTAB_ENTRY (port);
|
||||
off_t target;
|
||||
|
||||
/* we can assume at this point that pt->write_pos == pt->read_pos. */
|
||||
switch (whence)
|
||||
{
|
||||
case SEEK_CUR:
|
||||
if (SCM_CAR (port) & SCM_WRTNG)
|
||||
target = pt->write_pos - pt->write_buf + offset;
|
||||
else
|
||||
target = pt->read_pos - pt->read_buf + offset;
|
||||
target = pt->read_pos - pt->read_buf + offset;
|
||||
break;
|
||||
case SEEK_END:
|
||||
target = pt->write_end - pt->write_buf + offset;
|
||||
target = pt->read_end - pt->read_buf + offset;
|
||||
break;
|
||||
default: /* SEEK_SET */
|
||||
target = offset;
|
||||
break;
|
||||
}
|
||||
if (target < 0)
|
||||
scm_misc_error ("st_seek", "negative offset",
|
||||
scm_cons (SCM_MAKINUM (target), EOF));
|
||||
if (target > pt->read_buf_size)
|
||||
scm_misc_error ("st_seek", "negative offset", SCM_EOL);
|
||||
if (target >= pt->write_buf_size)
|
||||
{
|
||||
st_grow_port (pt, target - pt->read_buf_size);
|
||||
if (!(SCM_CAR (port) & SCM_WRTNG))
|
||||
{
|
||||
if (target > pt->write_buf_size)
|
||||
{
|
||||
scm_misc_error ("st_seek", "seek past end of read-only strport",
|
||||
SCM_EOL);
|
||||
}
|
||||
}
|
||||
else
|
||||
{
|
||||
st_resize_port (pt, target + (target == pt->write_buf_size
|
||||
? SCM_WRITE_BLOCK
|
||||
: 0));
|
||||
}
|
||||
}
|
||||
pt->read_pos = pt->write_pos = pt->read_buf + target;
|
||||
if (pt->read_pos > pt->read_end)
|
||||
{
|
||||
pt->read_end = (unsigned char *) pt->read_pos;
|
||||
pt->read_buf_size = pt->read_end - pt->read_buf;
|
||||
}
|
||||
return target;
|
||||
}
|
||||
|
||||
|
|
@ -158,10 +187,17 @@ static void
|
|||
st_ftruncate (SCM port, off_t length)
|
||||
{
|
||||
scm_port *pt = SCM_PTAB_ENTRY (port);
|
||||
off_t old_len = pt->write_end - pt->write_buf;
|
||||
|
||||
if (length > pt->write_buf_size)
|
||||
st_resize_port (pt, length);
|
||||
|
||||
pt->read_buf_size = length;
|
||||
pt->read_end = pt->read_buf + length;
|
||||
if (pt->read_pos > pt->read_end)
|
||||
pt->read_pos = pt->read_end;
|
||||
|
||||
if (length != old_len)
|
||||
st_grow_port (pt, length - old_len);
|
||||
if (pt->write_pos > pt->read_end)
|
||||
pt->write_pos = pt->read_end;
|
||||
}
|
||||
|
||||
SCM
|
||||
|
|
@ -192,13 +228,30 @@ scm_mkstrport (pos, str, modes, caller)
|
|||
pt->read_pos = pt->write_pos = pt->read_buf + SCM_INUM (pos);
|
||||
pt->write_buf_size = pt->read_buf_size = str_len;
|
||||
pt->write_end = pt->read_end = pt->read_buf + pt->read_buf_size;
|
||||
pt->rw_random = (modes & SCM_RDNG) && (modes & SCM_WRTNG);
|
||||
|
||||
/* doesn't check (modes & SCM_RDNG), since the read_buf must be
|
||||
maintained even for output-only ports. */
|
||||
pt->rw_random = modes & SCM_WRTNG;
|
||||
|
||||
SCM_ALLOW_INTS;
|
||||
|
||||
/* ensure write_pos is writable. */
|
||||
if ((modes & SCM_WRTNG) && pt->write_pos == pt->write_end)
|
||||
st_flush (z);
|
||||
return z;
|
||||
}
|
||||
|
||||
/* create a new string from a string port's buffer. */
|
||||
SCM scm_strport_to_string (SCM port)
|
||||
{
|
||||
scm_port *pt = SCM_PTAB_ENTRY (port);
|
||||
|
||||
if (pt->rw_active == SCM_PORT_WRITE)
|
||||
st_flush (port);
|
||||
return scm_makfromstr (SCM_CHARS (SCM_STREAM (port)),
|
||||
pt->read_buf_size, 0);
|
||||
}
|
||||
|
||||
SCM_PROC(s_call_with_output_string, "call-with-output-string", 1, 0, 0, scm_call_with_output_string);
|
||||
|
||||
SCM
|
||||
|
|
@ -212,22 +265,8 @@ scm_call_with_output_string (proc)
|
|||
SCM_OPN | SCM_WRTNG,
|
||||
s_call_with_output_string);
|
||||
scm_apply (proc, p, scm_listofnull);
|
||||
{
|
||||
SCM answer;
|
||||
|
||||
/* can't use pt->write_pos, in case port position was changed with
|
||||
seek.
|
||||
|
||||
The port buffer protocol promises that you can always store at
|
||||
least one character at write_pos. This means that the
|
||||
underlying string always has one spare character at the end,
|
||||
that the user didn't write. Make sure we don't include that in
|
||||
the result. */
|
||||
answer = scm_makfromstr (SCM_CHARS (SCM_STREAM (p)),
|
||||
SCM_LENGTH (SCM_STREAM (p)) - 1,
|
||||
0);
|
||||
return answer;
|
||||
}
|
||||
return scm_strport_to_string (p);
|
||||
}
|
||||
|
||||
|
||||
|
|
@ -243,17 +282,11 @@ scm_strprint_obj (obj)
|
|||
SCM str;
|
||||
SCM port;
|
||||
|
||||
str = scm_makstr (64, 0);
|
||||
port = scm_mkstrport (SCM_MAKINUM (0), str, SCM_OPN | SCM_WRTNG, "scm_strprint_obj");
|
||||
str = scm_makstr (0, 0);
|
||||
port = scm_mkstrport (SCM_INUM0, str, SCM_OPN | SCM_WRTNG, "scm_strprint_obj");
|
||||
scm_prin1 (obj, port, 1);
|
||||
{
|
||||
scm_port *pt = SCM_PTAB_ENTRY (port);
|
||||
SCM answer;
|
||||
|
||||
answer = scm_makfromstr (SCM_CHARS (SCM_STREAM (port)),
|
||||
pt->write_pos - pt->write_buf,
|
||||
0);
|
||||
return answer;
|
||||
return scm_strport_to_string (port);
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -279,7 +312,7 @@ SCM
|
|||
scm_read_0str (expr)
|
||||
char *expr;
|
||||
{
|
||||
SCM port = scm_mkstrport (SCM_MAKINUM (0),
|
||||
SCM port = scm_mkstrport (SCM_INUM0,
|
||||
scm_makfrom0str (expr),
|
||||
SCM_OPN | SCM_RDNG,
|
||||
"scm_eval_0str");
|
||||
|
|
@ -308,7 +341,7 @@ SCM
|
|||
scm_eval_string (string)
|
||||
SCM string;
|
||||
{
|
||||
SCM port = scm_mkstrport (SCM_MAKINUM (0), string, SCM_OPN | SCM_RDNG,
|
||||
SCM port = scm_mkstrport (SCM_INUM0, string, SCM_OPN | SCM_RDNG,
|
||||
"scm_eval_0str");
|
||||
SCM form;
|
||||
SCM ans = SCM_UNSPECIFIED;
|
||||
|
|
|
|||
|
|
@ -51,6 +51,7 @@ extern scm_ptobfuns scm_stptob;
|
|||
|
||||
|
||||
extern SCM scm_mkstrport SCM_P ((SCM pos, SCM str, long modes, const char * caller));
|
||||
extern SCM scm_strport_to_string (SCM port);
|
||||
extern SCM scm_call_with_output_string SCM_P ((SCM proc));
|
||||
extern SCM scm_strprint_obj SCM_P ((SCM obj));
|
||||
extern SCM scm_call_with_input_string SCM_P ((SCM str, SCM proc));
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue