Hi Rob,
Rob Browning <r...@defaultvalue.org> writes:
> Rob Browning <r...@defaultvalue.org> writes:
>
>> I haven't tried to track it down yet, but if the only underlying way to
>> get a fixed block of data out of an OPEN_BOTH port is read-char, then
>> that might explain much of the difference.
>
> And this, in popen.scm was why I started wondering about that:
>
> (call-with-values (lambda ()
> (apply open-process mode command args))
> (lambda (read-port write-port pid)
> (let ((port (or (and read-port write-port
> (make-rw-port read-port write-port))
> read-port
> write-port
> (%make-void-port mode)))
> (pipe-info (make-pipe-info pid)))
>
> I *think* OPEN_BOTH triggers make-rw-port here, which creates a
> soft-port.
Exactly. It's a Guile legacy soft port which works one byte at a time.
Terrible. I've known about this issue for years, but until recently
these legacy soft ports were the only kind of Scheme-level custom port
that supported read+write mode.
> I'd guess that what I might really want instead is for it to be able to
> create a native, bidirectional binary-port (using the two pipes
> internally).
Indeed. The good news is that we now have R6RS custom binary
input/outputs ports, which use an efficient internal interface based on
bytevectors, and perform much better.
See below for a draft reimplementation of the OPEN_BOTH mode of
open-pipe* based on R6RS custom binary input/output. On my machine it
increases the speed of your test by a factor of ~1k.
Let me know how it works for you.
Regards,
Mark
>From 4612e23994a012ef97e345a927fe9d0f232e78ab Mon Sep 17 00:00:00 2001
From: Mark H Weaver <m...@netris.org>
Date: Mon, 8 Apr 2019 06:23:08 -0400
Subject: [PATCH] DRAFT: open-pipe*: Improve performance of OPEN_BOTH mode.
* module/ice-9/popen.scm (make-rw-port): Re-implement using R6RS custom
binary input/output ports.
---
module/ice-9/popen.scm | 59 ++++++++++++++++++++++++++++++++----------
1 file changed, 46 insertions(+), 13 deletions(-)
diff --git a/module/ice-9/popen.scm b/module/ice-9/popen.scm
index b166e9d0f..c8ce0e2e0 100644
--- a/module/ice-9/popen.scm
+++ b/module/ice-9/popen.scm
@@ -1,7 +1,7 @@
;; popen emulation, for non-stdio based ports.
;;;; Copyright (C) 1998, 1999, 2000, 2001, 2003, 2006, 2010, 2011, 2012,
-;;;; 2013 Free Software Foundation, Inc.
+;;;; 2013, 2019 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
@@ -19,10 +19,12 @@
;;;;
(define-module (ice-9 popen)
- :use-module (ice-9 threads)
- :use-module (srfi srfi-9)
- :export (port/pid-table open-pipe* open-pipe close-pipe open-input-pipe
- open-output-pipe open-input-output-pipe))
+ #:use-module (rnrs bytevectors)
+ #:use-module (ice-9 binary-ports)
+ #:use-module (ice-9 threads)
+ #:use-module (srfi srfi-9)
+ #:export (port/pid-table open-pipe* open-pipe close-pipe open-input-pipe
+ open-output-pipe open-input-output-pipe))
(eval-when (expand load eval)
(load-extension (string-append "libguile-" (effective-version))
@@ -34,14 +36,45 @@
(pid pipe-info-pid set-pipe-info-pid!))
(define (make-rw-port read-port write-port)
- (make-soft-port
- (vector
- (lambda (c) (write-char c write-port))
- (lambda (s) (display s write-port))
- (lambda () (force-output write-port))
- (lambda () (read-char read-port))
- (lambda () (close-port read-port) (close-port write-port)))
- "r+"))
+ (define buffer #vu8())
+ (define position 0)
+ (define (read! bv start count)
+ (if (< position (bytevector-length buffer))
+ (let* ((available (- (bytevector-length buffer) position))
+ (transfer-size (min count available)))
+ (when (zero? transfer-size)
+ (error "(ice-9 popen) rw-port read!: zero transfer-size, should not happen"))
+ (bytevector-copy! buffer position bv start transfer-size)
+ (if (= transfer-size available)
+ (begin (set! buffer #vu8())
+ (set! position 0))
+ (set! position (+ position transfer-size)))
+ transfer-size)
+ (let ((read-result (get-bytevector-some read-port)))
+ (if (eof-object? read-result)
+ 0 ; return 0 to indicate eof
+ (begin
+ (set! buffer read-result)
+ (set! position 0)
+ (read! bv start count))))))
+ (define (write! bv start count)
+ (put-bytevector write-port bv start count)
+ count)
+ (define (close)
+ (set! buffer #vu8())
+ (set! position 0)
+ (close-port read-port)
+ (close-port write-port))
+ (define rw-port
+ (make-custom-binary-input/output-port "ice-9-popen-rw-port"
+ read!
+ write!
+ #f ;get-position
+ #f ;set-position!
+ close))
+ (setvbuf read-port 'block 65536)
+ (set-port-encoding! rw-port (port-encoding read-port))
+ rw-port)
;; a guardian to ensure the cleanup is done correctly when
;; an open pipe is gc'd or a close-port is used.
--
2.21.0
