wingo pushed a commit to branch wip-whippet
in repository guile.
commit 765245119b63c514782aeced73c2a766943a6a9a
Author: Andy Wingo <wi...@pobox.com>
AuthorDate: Wed Jun 18 16:30:03 2025 +0200
Rework representation of ports
Instead of a 4-word object that has a tag, stream, pt, and ptob, just
add tag, stream, and ptob fields to pt. Also add a "stream mode",
indicating to the GC how the stream should be traced.
* libguile/custom-ports.c (scm_init_custom_ports): Indicate that streams
are managed.
* libguile/fports.c (scm_make_fptob): Streams are managed.
* libguile/ports-internal.h (scm_t_port_type): Add enum to indicate
stream management.
(scm_t_port): Add type-and-flags, stream, and ptob members.
* libguile/ports.c (scm_port_stream, scm_port_type): New helpers.
(scm_make_port_type): Init stream mode to CONSERVATIVE.
(scm_set_port_stream_mode): New API.
(scm_c_make_port_with_encoding): Adapt to new port representation.
(scm_init_ports): Void ports have unmanaged streams.
* libguile/ports.h (scm_is_port, scm_to_port, scm_from_port): New inline
functions.
(SCM_PORT, SCM_STREAM, SCM_PORT_TYPE): Rework in terms of new functions.
(SCM_SETSTREAM): Remove.
(enum scm_port_stream_mode): New.
(scm_set_port_stream_mode): New.
---
libguile/custom-ports.c | 6 +++++-
libguile/fports.c | 1 +
libguile/ports-internal.h | 7 +++++++
libguile/ports.c | 41 ++++++++++++++++++++++++++++++++---------
libguile/ports.h | 40 +++++++++++++++++++++++++++++++++++-----
5 files changed, 80 insertions(+), 15 deletions(-)
diff --git a/libguile/custom-ports.c b/libguile/custom-ports.c
index 6e2b2ea99..5abd47d06 100644
--- a/libguile/custom-ports.c
+++ b/libguile/custom-ports.c
@@ -1,4 +1,4 @@
-/* Copyright 2023
+/* Copyright 2023, 2025
Free Software Foundation, Inc.
This file is part of Guile.
@@ -176,6 +176,10 @@ scm_init_custom_ports (void)
custom_port_type_with_close_on_gc =
scm_make_port_type ("custom-port", NULL, NULL);
+ scm_set_port_stream_mode (custom_port_type, SCM_PORT_STREAM_MANAGED);
+ scm_set_port_stream_mode (custom_port_type_with_close_on_gc,
+ SCM_PORT_STREAM_MANAGED);
+
#define INIT_PORT_TYPE(c_name, scm_name) \
scm_set_port_##c_name (custom_port_type, custom_port_##c_name); \
scm_set_port_##c_name (custom_port_type_with_close_on_gc, \
diff --git a/libguile/fports.c b/libguile/fports.c
index 79a48e899..97a7db50a 100644
--- a/libguile/fports.c
+++ b/libguile/fports.c
@@ -742,6 +742,7 @@ static scm_t_port_type *
scm_make_fptob ()
{
scm_t_port_type *ptob = scm_make_port_type ("file", fport_read, fport_write);
+ scm_set_port_stream_mode (ptob, SCM_PORT_STREAM_MANAGED);
scm_set_port_print (ptob, fport_print);
scm_set_port_needs_close_on_gc (ptob, 1);
diff --git a/libguile/ports-internal.h b/libguile/ports-internal.h
index 8433c5903..c085e9924 100644
--- a/libguile/ports-internal.h
+++ b/libguile/ports-internal.h
@@ -65,6 +65,7 @@ struct scm_t_port_type
void (*truncate) (SCM port, scm_t_off length);
unsigned flags;
+ enum scm_port_stream_mode stream_mode;
/* GOOPS tomfoolery. */
SCM input_class, output_class, input_output_class;
@@ -315,6 +316,12 @@ scm_port_buffer_putback (SCM buf, const uint8_t *src,
size_t count,
struct scm_t_port
{
+ scm_t_bits tag_and_flags;
+ scm_t_port_type *ptob;
+
+ /* Implementation-specific data; can be managed or not. */
+ scm_t_bits stream;
+
/* Source location information. */
SCM file_name;
SCM position;
diff --git a/libguile/ports.c b/libguile/ports.c
index 9bf38f77e..e79ee48ff 100644
--- a/libguile/ports.c
+++ b/libguile/ports.c
@@ -134,6 +134,20 @@ static const scm_t_wchar UNICODE_REPLACEMENT_CHARACTER =
0xFFFD;
+scm_t_bits
+scm_port_stream (struct scm_t_port *port)
+{
+ return port->stream;
+}
+
+scm_t_port_type*
+scm_port_type (struct scm_t_port *port)
+{
+ return port->ptob;
+}
+
+
+
static void
release_port (SCM port)
{
@@ -247,11 +261,18 @@ scm_make_port_type (char *name,
desc->read_wait_fd = default_read_wait_fd;
desc->write_wait_fd = default_write_wait_fd;
desc->random_access_p = default_random_access_p;
+ desc->stream_mode = SCM_PORT_STREAM_CONSERVATIVE;
scm_make_port_classes (desc);
return desc;
}
+void
+scm_set_port_stream_mode (scm_t_port_type *ptob, enum scm_port_stream_mode
mode)
+{
+ ptob->stream_mode = mode;
+}
+
static SCM
trampoline_to_c_read (SCM port, SCM dst, SCM start, SCM count)
#define FUNC_NAME "port-read"
@@ -779,15 +800,13 @@ scm_c_make_port_with_encoding (scm_t_port_type *ptob,
unsigned long mode_bits,
SCM encoding, SCM conversion_strategy,
scm_t_bits stream)
{
- SCM ret;
- scm_t_port *pt;
+ scm_t_port *pt = scm_gc_typed_calloc (scm_t_port);
+ pt->tag_and_flags = scm_tc7_port | mode_bits | SCM_OPN;
+ pt->ptob = ptob;
+ pt->stream = stream;
- pt = scm_gc_typed_calloc (scm_t_port);
-
- ret = scm_words (scm_tc7_port | mode_bits | SCM_OPN, 4);
- SCM_SET_CELL_WORD_1 (ret, stream);
- SCM_SET_CELL_WORD_2 (ret, (scm_t_bits) pt);
- SCM_SET_CELL_WORD_3 (ret, (scm_t_bits) ptob);
+ /* FIXME: if ptob->stream_mode is SCM_PORT_STREAM_CONSERVATIVE, then
+ * disable evacuation. */
pt->encoding = encoding;
pt->conversion_strategy = conversion_strategy;
@@ -805,7 +824,9 @@ scm_c_make_port_with_encoding (scm_t_port_type *ptob,
unsigned long mode_bits,
pt->alist = SCM_EOL;
- if (SCM_PORT_TYPE (ret)->flags & SCM_PORT_TYPE_NEEDS_CLOSE_ON_GC)
+ SCM ret = scm_from_port (pt);
+
+ if (ptob->flags & SCM_PORT_TYPE_NEEDS_CLOSE_ON_GC)
{
scm_i_add_port_finalizer (SCM_I_CURRENT_THREAD, ret);
pt->close_handle = scm_c_make_ephemeron (ret, SCM_BOOL_T);
@@ -4195,6 +4216,8 @@ scm_init_ports (void)
scm_void_port_type = scm_make_port_type ("void", void_port_read,
void_port_write);
+ scm_set_port_stream_mode (scm_void_port_type,
+ SCM_PORT_STREAM_UNMANAGED);
cur_inport_fluid = scm_make_fluid ();
cur_outport_fluid = scm_make_fluid ();
diff --git a/libguile/ports.h b/libguile/ports.h
index 362236310..f55604772 100644
--- a/libguile/ports.h
+++ b/libguile/ports.h
@@ -64,11 +64,32 @@
typedef struct scm_t_port_type scm_t_port_type;
typedef struct scm_t_port scm_t_port;
-#define SCM_STREAM(port) (SCM_CELL_WORD_1 (port))
-#define SCM_SETSTREAM(port, stream) (SCM_SET_CELL_WORD_1 (port, stream))
-#define SCM_PORT(x) ((scm_t_port *) SCM_CELL_WORD_2 (x))
-#define SCM_PORT_TYPE(port) ((scm_t_port_type *) SCM_CELL_WORD_3 (port))
-
+static inline int
+scm_is_port (SCM x)
+{
+ return SCM_PORTP (x);
+}
+
+static inline scm_t_port*
+scm_to_port (SCM x)
+{
+ if (!scm_is_port (x))
+ abort ();
+ return (scm_t_port*) SCM_UNPACK_POINTER (x);
+}
+
+static inline SCM
+scm_from_port (scm_t_port *x)
+{
+ return SCM_PACK_POINTER (x);
+}
+
+SCM_API scm_t_bits scm_port_stream (scm_t_port *port);
+SCM_API scm_t_port_type* scm_port_type (scm_t_port *port);
+
+#define SCM_PORT(x) scm_to_port (x)
+#define SCM_STREAM(port) scm_port_stream (scm_to_port (port))
+#define SCM_PORT_TYPE(port) scm_port_type (scm_to_port (port))
#define SCM_VALIDATE_PORT(pos, port) \
SCM_MAKE_VALIDATE_MSG (pos, port, PORTP, "port")
@@ -96,11 +117,20 @@ typedef struct scm_t_port scm_t_port;
+enum scm_port_stream_mode
+ {
+ SCM_PORT_STREAM_CONSERVATIVE,
+ SCM_PORT_STREAM_MANAGED,
+ SCM_PORT_STREAM_UNMANAGED
+ };
+
/* Port types, and their vtables. */
SCM_API scm_t_port_type *scm_make_port_type
(char *name,
size_t (*read) (SCM port, SCM dst, size_t start, size_t count),
size_t (*write) (SCM port, SCM src, size_t start, size_t count));
+SCM_API void scm_set_port_stream_mode (scm_t_port_type *ptob,
+ enum scm_port_stream_mode mode);
SCM_API void scm_set_port_scm_read (scm_t_port_type *ptob, SCM read);
SCM_API void scm_set_port_scm_write (scm_t_port_type *ptob, SCM write);
SCM_API void scm_set_port_read_wait_fd (scm_t_port_type *ptob,
