wingo pushed a commit to branch wip-whippet
in repository guile.
commit 923bfdc7edc99149e7487860059e586592893876
Author: Andy Wingo <wi...@pobox.com>
AuthorDate: Wed Jun 18 16:33:36 2025 +0200
String ports have managed streams
* libguile/strports.c (stream_bytevector, stream_pos, stream_len)
(stream_set_bytevector, stream_set_pos, stream_set_len)
(make_stream): New helpers.
* libguile/strports.c (string_port_read):
(string_port_write):
(string_port_seek):
(string_port_truncate):
(scm_mkstrport):
(scm_strport_to_string): Adapt.
(scm_make_string_port_type): Indicate that the stream is managed.
---
libguile/strports.c | 132 ++++++++++++++++++++++++++++++++++++----------------
1 file changed, 91 insertions(+), 41 deletions(-)
diff --git a/libguile/strports.c b/libguile/strports.c
index 4cb2b9119..bb7a3f7d2 100644
--- a/libguile/strports.c
+++ b/libguile/strports.c
@@ -1,4 +1,4 @@
-/* Copyright 1995,1996,1998-2003,2005-2006,2009-2014,2016-2019
+/* Copyright 1995,1996,1998-2003,2005-2006,2009-2014,2016-2019,2025
Free Software Foundation, Inc.
This file is part of Guile.
@@ -44,6 +44,7 @@
#include "syscalls.h"
#include "threads.h"
#include "variable.h"
+#include "vectors.h"
#include "strports.h"
@@ -58,28 +59,71 @@ SCM_SYMBOL (sym_UTF_8, "UTF-8");
scm_t_port_type *scm_string_port_type;
-struct string_port {
- SCM bytevector;
- size_t pos;
- size_t len;
-};
+// String port stream is a 3-vector: #(bytevector pos len).
+static SCM
+stream_bytevector (SCM stream)
+{
+ return SCM_SIMPLE_VECTOR_REF (stream, 0);
+}
+
+static SCM
+stream_pos (SCM stream)
+{
+ return SCM_SIMPLE_VECTOR_REF (stream, 1);
+}
+
+static SCM
+stream_len (SCM stream)
+{
+ return SCM_SIMPLE_VECTOR_REF (stream, 2);
+}
+
+static SCM
+stream_set_bytevector (SCM stream, SCM bv)
+{
+ return SCM_SIMPLE_VECTOR_SET (stream, 0, bv);
+}
+
+static SCM
+stream_set_pos (SCM stream, SCM pos)
+{
+ return SCM_SIMPLE_VECTOR_SET (stream, 1, pos);
+}
+
+static SCM
+stream_set_len (SCM stream, SCM len)
+{
+ return SCM_SIMPLE_VECTOR_SET (stream, 2, len);
+}
+
+static SCM
+make_stream (SCM bv, SCM pos, SCM len)
+{
+ SCM ret = scm_c_make_vector (3, SCM_BOOL_F);
+ stream_set_bytevector (ret, bv);
+ stream_set_pos (ret, pos);
+ stream_set_len (ret, len);
+ return ret;
+}
static size_t
string_port_read (SCM port, SCM dst, size_t start, size_t count)
{
- struct string_port *stream = (void *) SCM_STREAM (port);
+ SCM stream = SCM_PACK (scm_port_stream (scm_to_port (port)));
+ size_t pos = scm_to_size_t (stream_pos (stream));
+ size_t len = scm_to_size_t (stream_len (stream));
- if (stream->pos >= stream->len)
+ if (pos >= len)
return 0;
- if (count > stream->len - stream->pos)
- count = stream->len - stream->pos;
+ if (count > len - pos)
+ count = len - pos;
memcpy (SCM_BYTEVECTOR_CONTENTS (dst) + start,
- SCM_BYTEVECTOR_CONTENTS (stream->bytevector) + stream->pos,
+ SCM_BYTEVECTOR_CONTENTS (stream_bytevector (stream)) + pos,
count);
- stream->pos += count;
+ stream_set_pos (stream, scm_from_size_t (pos + count));
return count;
}
@@ -89,32 +133,34 @@ static size_t
string_port_write (SCM port, SCM src, size_t start, size_t count)
#define FUNC_NAME "string_port_write"
{
- struct string_port *stream = (void *) SCM_STREAM (port);
- size_t old_size = SCM_BYTEVECTOR_LENGTH (stream->bytevector);
+ SCM stream = SCM_PACK (scm_port_stream (scm_to_port (port)));
+ size_t old_size = SCM_BYTEVECTOR_LENGTH (stream_bytevector (stream));
+ size_t pos = scm_to_size_t (stream_pos (stream));
+ size_t len = scm_to_size_t (stream_len (stream));
- if (count > old_size - stream->pos)
+ if (count > old_size - pos)
{
SCM new_bv;
size_t new_size;
- if (INT_ADD_OVERFLOW (stream->pos, count))
+ if (INT_ADD_OVERFLOW (pos, count))
scm_num_overflow (FUNC_NAME);
/* If (old_size * 2) overflows, it's harmless. */
- new_size = MAX (old_size * 2, stream->pos + count);
+ new_size = MAX (old_size * 2, pos + count);
new_bv = scm_c_make_bytevector (new_size);
memcpy (SCM_BYTEVECTOR_CONTENTS (new_bv),
- SCM_BYTEVECTOR_CONTENTS (stream->bytevector),
- stream->len);
- stream->bytevector = new_bv;
+ SCM_BYTEVECTOR_CONTENTS (stream_bytevector (stream)),
+ len);
+ stream_set_bytevector (stream, new_bv);
}
- memcpy (SCM_BYTEVECTOR_CONTENTS (stream->bytevector) + stream->pos,
+ memcpy (SCM_BYTEVECTOR_CONTENTS (stream_bytevector (stream)) + pos,
SCM_BYTEVECTOR_CONTENTS (src) + start,
count);
- stream->pos += count;
- if (stream->pos > stream->len)
- stream->len = stream->pos;
+ stream_set_pos (stream, scm_from_size_t (pos + count));
+ if (pos + count > len)
+ stream_set_len (stream, stream_pos (stream));
return count;
}
@@ -124,16 +170,18 @@ static scm_t_off
string_port_seek (SCM port, scm_t_off offset, int whence)
#define FUNC_NAME "string_port_seek"
{
- struct string_port *stream = (void *) SCM_STREAM (port);
+ SCM stream = SCM_PACK (scm_port_stream (scm_to_port (port)));
size_t base;
scm_t_off target;
+ size_t pos = scm_to_size_t (stream_pos (stream));
+ size_t len = scm_to_size_t (stream_len (stream));
if (whence == SEEK_CUR)
- base = stream->pos;
+ base = pos;
else if (whence == SEEK_SET)
base = 0;
else if (whence == SEEK_END)
- base = stream->len;
+ base = len;
else
scm_wrong_type_arg_msg (FUNC_NAME, 0, port, "invalid `seek' parameter");
@@ -142,8 +190,8 @@ string_port_seek (SCM port, scm_t_off offset, int whence)
scm_num_overflow (FUNC_NAME);
target = (scm_t_off) base + offset;
- if (target >= 0 && target <= stream->len)
- stream->pos = target;
+ if (target >= 0 && target <= len)
+ stream_set_pos (stream, scm_from_size_t ((size_t) target));
else
scm_out_of_range (FUNC_NAME, scm_from_off_t (offset));
@@ -155,10 +203,12 @@ static void
string_port_truncate (SCM port, scm_t_off length)
#define FUNC_NAME "string_port_truncate"
{
- struct string_port *stream = (void *) SCM_STREAM (port);
+ SCM stream = SCM_PACK (scm_port_stream (scm_to_port (port)));
+ size_t pos = scm_to_size_t (stream_pos (stream));
+ size_t len = scm_to_size_t (stream_len (stream));
- if (0 <= length && stream->pos <= length && length <= stream->len)
- stream->len = length;
+ if (0 <= length && pos <= length && length <= len)
+ stream_set_len (stream, scm_from_size_t (length));
else
scm_out_of_range (FUNC_NAME, scm_from_off_t (length));
}
@@ -176,7 +226,7 @@ scm_mkstrport (SCM pos, SCM str, long modes, const char
*caller)
{
SCM buf;
size_t len, byte_pos;
- struct string_port *stream;
+ SCM stream;
if (!((modes & SCM_WRTNG) || (modes & SCM_RDNG)))
scm_misc_error ("scm_mkstrport", "port must read or write", SCM_EOL);
@@ -203,10 +253,7 @@ scm_mkstrport (SCM pos, SCM str, long modes, const char
*caller)
(scm_substring (str, SCM_INUM0, pos));
}
- stream = scm_gc_typed_calloc (struct string_port);
- stream->bytevector = buf;
- stream->pos = byte_pos;
- stream->len = len;
+ stream = make_stream (buf, scm_from_size_t (byte_pos), scm_from_size_t
(len));
return
scm_c_make_port_with_encoding (scm_string_port_type, modes, sym_UTF_8,
@@ -220,15 +267,17 @@ SCM
scm_strport_to_string (SCM port)
{
signed char *ptr;
- struct string_port *stream = (void *) SCM_STREAM (port);
+ SCM stream = SCM_PACK (scm_port_stream (scm_to_port (port)));
scm_flush (port);
- if (stream->len == 0)
+ if (stream_len (stream) == SCM_INUM0)
return scm_nullstr;
- ptr = SCM_BYTEVECTOR_CONTENTS (stream->bytevector);
- return scm_from_port_stringn ((char *) ptr, stream->len, port);
+ ptr = SCM_BYTEVECTOR_CONTENTS (stream_bytevector (stream));
+ return scm_from_port_stringn ((char *) ptr,
+ scm_to_size_t (stream_len (stream)),
+ port);
}
SCM_DEFINE (scm_object_to_string, "object->string", 1, 1, 0,
@@ -400,6 +449,7 @@ scm_make_string_port_type ()
scm_t_port_type *ptob = scm_make_port_type ("string",
string_port_read,
string_port_write);
+ scm_set_port_stream_mode (ptob, SCM_PORT_STREAM_MANAGED);
scm_set_port_seek (ptob, string_port_seek);
scm_set_port_truncate (ptob, string_port_truncate);
