From 3f4048f6c8f7b711892bcb7cfdc8b75a54548ed2 Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Wed, 18 Jun 2025 11:06:12 +0200 Subject: [PATCH] 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 @@ -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 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)