wingo pushed a commit to branch wip-whippet
in repository guile.
commit 3f4048f6c8f7b711892bcb7cfdc8b75a54548ed2
Author: Andy Wingo <wi...@pobox.com>
AuthorDate: Wed Jun 18 11:06:12 2025 +0200
Move transcoded ports implementation to Scheme
* libguile/r6rs-ports.c: Remove private transcoded ports implementation.
* module/ice-9/binary-ports.scm: Remove stale comment.
* module/rnrs/io/ports.scm (%make-transcoded-port): New implementation
based on custom ports.
---
libguile/r6rs-ports.c | 77 -------------------------------------------
module/ice-9/binary-ports.scm | 3 --
module/rnrs/io/ports.scm | 25 ++++++++++++--
3 files changed, 22 insertions(+), 83 deletions(-)
diff --git a/libguile/r6rs-ports.c b/libguile/r6rs-ports.c
index da47d2189..f754694eb 100644
--- a/libguile/r6rs-ports.c
+++ b/libguile/r6rs-ports.c
@@ -486,81 +486,6 @@ SCM scm_make_custom_binary_input_output_port (SCM id, SCM
read_proc,
-
-/* Transcoded ports. */
-
-static scm_t_port_type *transcoded_port_type = 0;
-
-#define SCM_TRANSCODED_PORT_BINARY_PORT(_port) SCM_PACK (SCM_STREAM (_port))
-
-static inline SCM
-make_transcoded_port (SCM binary_port, unsigned long mode)
-{
- return scm_c_make_port (transcoded_port_type, mode,
- SCM_UNPACK (binary_port));
-}
-
-static size_t
-transcoded_port_write (SCM port, SCM src, size_t start, size_t count)
-{
- SCM bport = SCM_TRANSCODED_PORT_BINARY_PORT (port);
- scm_c_write_bytes (bport, src, start, count);
- return count;
-}
-
-static size_t
-transcoded_port_read (SCM port, SCM dst, size_t start, size_t count)
-{
- SCM bport = SCM_TRANSCODED_PORT_BINARY_PORT (port);
- return scm_c_read_bytes (bport, dst, start, count);
-}
-
-static void
-transcoded_port_close (SCM port)
-{
- scm_close_port (SCM_TRANSCODED_PORT_BINARY_PORT (port));
-}
-
-static inline void
-initialize_transcoded_ports (void)
-{
- transcoded_port_type =
- scm_make_port_type ("r6rs-transcoded-port", transcoded_port_read,
- transcoded_port_write);
- scm_set_port_close (transcoded_port_type, transcoded_port_close);
- scm_set_port_needs_close_on_gc (transcoded_port_type, 1);
-}
-
-SCM_INTERNAL SCM scm_i_make_transcoded_port (SCM);
-
-SCM_DEFINE (scm_i_make_transcoded_port,
- "%make-transcoded-port", 1, 0, 0,
- (SCM port),
- "Return a new port which reads and writes to @var{port}")
-#define FUNC_NAME s_scm_i_make_transcoded_port
-{
- SCM result;
- unsigned long mode = 0;
-
- SCM_VALIDATE_PORT (SCM_ARG1, port);
-
- if (scm_is_true (scm_output_port_p (port)))
- mode |= SCM_WRTNG;
- if (scm_is_true (scm_input_port_p (port)))
- mode |= SCM_RDNG;
-
- result = make_transcoded_port (port, mode);
-
- /* FIXME: We should actually close `port' "in a special way" here,
- according to R6RS. As there is no way to do that in Guile without
- rendering the underlying port unusable for our purposes as well, we
- just leave it open. */
-
- return result;
-}
-#undef FUNC_NAME
-
-
/* Textual I/O */
SCM_DEFINE (scm_get_string_n_x,
@@ -610,8 +535,6 @@ scm_register_r6rs_ports (void)
"scm_init_r6rs_ports",
(scm_t_extension_init_func) scm_init_r6rs_ports,
NULL);
-
- initialize_transcoded_ports ();
}
void
diff --git a/module/ice-9/binary-ports.scm b/module/ice-9/binary-ports.scm
index cb8fe1efe..d68813bbc 100644
--- a/module/ice-9/binary-ports.scm
+++ b/module/ice-9/binary-ports.scm
@@ -50,9 +50,6 @@
call-with-input-bytevector
call-with-output-bytevector))
-;; Note that this extension also defines %make-transcoded-port, which is
-;; not exported but is used by (rnrs io ports).
-
(load-extension (string-append "libguile-" (effective-version))
"scm_init_r6rs_ports")
diff --git a/module/rnrs/io/ports.scm b/module/rnrs/io/ports.scm
index d7cb89e36..4db5b649b 100644
--- a/module/rnrs/io/ports.scm
+++ b/module/rnrs/io/ports.scm
@@ -1,6 +1,6 @@
;;;; ports.scm --- R6RS port API -*- coding: utf-8 -*-
-;;;; Copyright (C) 2009-2011, 2013, 2019, 2023 Free Software Foundation, Inc.
+;;;; Copyright (C) 2009-2011, 2013, 2019, 2023, 2025 Free Software Foundation,
Inc.
;;;;
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
@@ -112,6 +112,7 @@
&i/o-encoding i/o-encoding-error?
make-i/o-encoding-error i/o-encoding-error-char)
(import (ice-9 binary-ports)
+ (only (ice-9 custom-ports) make-custom-port)
(only (ice-9 textual-ports)
make-custom-textual-input-port
make-custom-textual-output-port
@@ -297,12 +298,30 @@ I/O in Guile."
(lookahead-u8 port)
(lookahead-char port))))
+(define (%make-transcoded-port other)
+ "Return a new port which reads and writes to @var{other}."
+ (define (read port bv start count)
+ (let ((n (get-bytevector-n! other bv start count)))
+ (if (eof-object? n)
+ 0
+ n)))
+ (define (write port bv start count)
+ (put-bytevector other bv start count)
+ count)
+ ;; FIXME: We should actually close `other' "in a special way" here,
+ ;; according to R6RS. As there is no way to do that in Guile without
+ ;; rendering the underlying port unusable for our purposes as well, we
+ ;; just leave it open.
+ (make-custom-port #:id "r6rs-transcoded-port"
+ #:read (and (input-port? other) read)
+ #:write (and (output-port? other) write)
+ #:close (lambda (p) (close-port other))))
+
(define (transcoded-port port transcoder)
"Return a new textual port based on @var{port}, using
@var{transcoder} to encode and decode data written to or
read from its underlying binary port @var{port}."
- ;; Hackily get at %make-transcoded-port.
- (let ((result ((@@ (ice-9 binary-ports) %make-transcoded-port) port)))
+ (let ((result (%make-transcoded-port port)))
(set-port-encoding! result (transcoder-codec transcoder))
(case (transcoder-error-handling-mode transcoder)
((raise)
