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

@@ -485,81 +485,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 */
 
@@ -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

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")
 

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 (%make-transcoded-port port)))
-  (let ((result ((@@ (ice-9 binary-ports) %make-transcoded-port) port)))
     (set-port-encoding! result (transcoder-codec transcoder))
     (case (transcoder-error-handling-mode transcoder)
       ((raise)