bug#48007: computing derivations through inferior takes twice as long

bug#48007: computing derivations through inferior takes twice as long

[Ricardo Wurmus]

This bug report might be related to bug #48005.

In the Guix Workflow Language we are always looking up packages 
through an inferior Guix.  That Guix will in most cases be just 
the current Guix.  As I was looking for ways to speed the GWL up, 
I noticed that the use of inferiors itself contributes to a 
significant loss in performance.

Here is a simple manifest to demonstrate this:

--8<---------------cut here---------------start------------->8---
(use-modules (guix inferior)
             (ice-9 match))

(define inferior
  (open-inferior (format #false "~a/.config/guix" (getenv 
  "HOME"))))

(define packages
  (list "bash-minimal"
        "r-corrplot"
        "r-crosstalk"
        "r-data-table"
        "r-deseq2"
        "r-dt"
        "r-genomicalignments"
        "r-genomicranges"
        "r-ggplot2"
        "r-ggrepel"
        "r-gprofiler"
        "r-knitr"
        "r-minimal"
        "r-pheatmap"
        "r-plotly"
        "r-reshape2"
        "r-rmarkdown"
        "r-rsamtools"
        "r-rtracklayer"
        "r-s4vectors"
        "r-scales"
        "r-summarizedexperiment"
        "r-tximport"))

(match (getenv "INFERIOR")
  ("y"
   (packages->manifest
    (map (lambda (specification)
           (match (lookup-inferior-packages inferior 
           specification)
             ((first . rest) first)))
         packages)))
  (_
   (specifications->manifest packages)))
--8<---------------cut here---------------end--------------->8---

When INFERIOR is set to “y”, each package specification will be 
looked up in the current Guix via an inferior.  For any other 
values of INFERIOR the specifications are resolved with the 
current Guix (the very same Guix) directly.

Here are the timings:

--8<---------------cut here---------------start------------->8---
$ [env] export GUIX_PROFILING="object-cache 
add-data-to-store-cache rpc"
$ [env] time INFERIOR=n guix build -m manifest-test.scm -d
/gnu/store/mwg47gbmi98bbrywk07y5l2h9p6d1hz5-bash-minimal-5.0.16.drv
/gnu/store/kcjk6z128fa07pzp8irp6lbbyl3g16nr-r-corrplot-0.84.drv
/gnu/store/s6hflcww9gaq87g5vaaydd4lphw63xjm-r-crosstalk-1.1.1.drv
/gnu/store/qrjgag94sv9lq12028y9iv12j75bva6c-r-data-table-1.14.0.drv
/gnu/store/v6xw6pg33xa8pg19nw0cxhz9b7ps26v7-r-deseq2-1.30.1.drv
/gnu/store/q1achql92wnij108msymr9mkr8pv2z1h-r-dt-0.17.drv
/gnu/store/iym2kzpjiqch22yrhg5lnv9sfazdfphn-r-genomicalignments-1.26.0.drv
/gnu/store/k913mn4q11pchgi63xrm8lb3svvqjcix-r-genomicranges-1.42.0.drv
/gnu/store/zkpabp1qx6m5yam3f9kninnsxagsgwqh-r-ggplot2-3.3.3.drv
/gnu/store/b6w1p6rhbk8shz1ydc2yqb38ypm0ijq9-r-ggrepel-0.9.1.drv
/gnu/store/bwmmls5qkf9cfs9m73qzabnr7w5jc8ra-r-gprofiler-0.7.0.drv
/gnu/store/j1m8hb4449rkfh3ij1l4379j1lngjr06-r-knitr-1.31.drv
/gnu/store/7ig30kf3i65s3rdcw1qik7vsjvspkjxy-r-minimal-4.0.4.drv
/gnu/store/mwg8c42sfsvcrbjhbw7mbdcphhz9hq3x-r-pheatmap-1.0.12.drv
/gnu/store/xjg40q7a7yl3l9v99kqapjylfjwapwk7-r-plotly-4.9.3.drv
/gnu/store/fhs8as885izfb1r6as07sn6jpjgfbl58-r-reshape2-1.4.4.drv
/gnu/store/6bcny1hhf83k85js6x3w7h1w3660ii8m-r-rmarkdown-2.7.drv
/gnu/store/87pr587bk9rzfkrjmrm4bcfjz95p1n9c-r-rsamtools-2.6.0.drv
/gnu/store/l3ibbpd4h7gm565vidbpyamdnhb0czhp-r-rtracklayer-1.50.0.drv
/gnu/store/8rf8d204kavcxkw6z71kxd2mzzqzxsk1-r-s4vectors-0.28.1.drv
/gnu/store/4nxw4lhcvj3q9j5v6mq9ri4v4vwmxd6h-r-scales-1.1.1.drv
/gnu/store/vpf3vkj58vwz92nxcpppil6580c84bb1-r-summarizedexperiment-1.20.0.drv
/gnu/store/cx3cl0nxwvzpaj484q2xcnz3v7zc1015-r-tximport-1.18.0.drv
Store object cache:
  fresh caches:     2
  lookups:       4540
  hits:          3568 (78.6%)
  cache size:     971 entries

'add-data-to-store' cache:
  lookups:       3450
  hits:           492 (14.3%)
  .drv files:    2087 (60.5%)
  Scheme files:  1347 (39.0%)
Remote procedure call summary: 3412 RPCs
  built-in-builders              ...     1
  add-to-store/tree              ...    16
  add-to-store                   ...   177
  query-references               ...   260
  add-text-to-store              ...  2958

real	0m3.970s
user	0m4.055s
sys	0m0.173s
$ [env] time INFERIOR=y guix build -m manifest-test.scm -d
/gnu/store/mwg47gbmi98bbrywk07y5l2h9p6d1hz5-bash-minimal-5.0.16.drv
/gnu/store/hmk49rhbfqw2ss55392a7kq34xqg18i7-r-corrplot-0.84.drv
/gnu/store/sg8a3pvzxaq2qd4z918mdb2y0vq6w8mg-r-crosstalk-1.1.1.drv
/gnu/store/n3vk2kkq7zza7pfrjqqbv6xaxhnzdn2x-r-data-table-1.14.0.drv
/gnu/store/44fqdg0s6bcmcgafvgafycf2x82rfl7y-r-deseq2-1.30.1.drv
/gnu/store/03snyvyp9fr3nchrln6qhdca00i7lrsz-r-dt-0.17.drv
/gnu/store/rl48alwm40sl4b04rnk4cck2h4crr8gc-r-genomicalignments-1.26.0.drv
/gnu/store/ryl6hjflgpb72xl91jvp0ab6sl5cblc4-r-genomicranges-1.42.0.drv
/gnu/store/1hbg746cvi8s7vn03glzx46m0pdih5pw-r-ggplot2-3.3.3.drv
/gnu/store/nwvkjb314hh7z7vag0mk870isynp0hda-r-ggrepel-0.9.1.drv
/gnu/store/kvvygkc7vnznrqp4n2rvgsbz9z2jd6ns-r-gprofiler-0.7.0.drv
/gnu/store/0jv2zf34b2p1ddpxnzv5smq4717i4hfq-r-knitr-1.31.drv
/gnu/store/zgi8sfw54jv7wb33q9cs18ff1vlfy0fm-r-minimal-4.0.4.drv
/gnu/store/7w4jp2skqy0vn8i4pr26l94mw8vs8knc-r-pheatmap-1.0.12.drv
/gnu/store/xshkhmd8gpjkmi7npz0bw02wgb8mkysg-r-plotly-4.9.3.drv
/gnu/store/5jqkb3khygfc2y96nff92hfslc2c53yz-r-reshape2-1.4.4.drv
/gnu/store/x0fzqyjg1hq7a4n0wglr9sl71bzxwz0q-r-rmarkdown-2.7.drv
/gnu/store/3v78408vx5x28nb3cf42jarr7fy3b16v-r-rsamtools-2.6.0.drv
/gnu/store/qp4hjddv5sjxiiss0m55q4cv88k520gd-r-rtracklayer-1.50.0.drv
/gnu/store/pgfahjz3wfnppc07z0qbcsdc6mmpri0l-r-s4vectors-0.28.1.drv
/gnu/store/aq317mqb3rbc2rnq2y15k781q5qvf9ia-r-scales-1.1.1.drv
/gnu/store/w9dirjkx523398mhkjw0v4hxgq7x0b8s-r-summarizedexperiment-1.20.0.drv
/gnu/store/rfmzii8xsc3fk63s332ix2qgxpvdvrgf-r-tximport-1.18.0.drv
Store object cache:
  fresh caches:     1
  lookups:         23
  hits:             0 (0.0%)
  cache size:      23 entries

'add-data-to-store' cache:
  lookups:          0
  hits:             0 (100.0%)
  .drv files:       0 (100.0%)
  Scheme files:     0 (100.0%)
Remote procedure call summary: 0 RPCs

real	0m7.951s
user	0m2.191s
sys	0m0.240s
--8<---------------cut here---------------end--------------->8---

Note that nothing is built.  This is merely to compute already 
existing derivations.  Computing the same derivations through an 
inferior Guix takes about twice as long.
I’ll note that in the inferior case there are no 
“add-data-to-store” calls compared to 2958 calls in the direct 
case.  I don’t know what to make of this.  Is that information 
lost as we cross over to the inferior Guix…?  Or are there really 
different / fewer RPCs?

Things look similar when we actually instantiate the manifest:

--8<---------------cut here---------------start------------->8---
$ [env] time INFERIOR=n guix package -m manifest-test.scm -p 
/tmp/foo
The following packages will be installed:
   bash-minimal           5.0.16
   r-corrplot             0.84
   r-crosstalk            1.1.1
   r-data-table           1.14.0
   r-deseq2               1.30.1
   r-dt                   0.17
   r-genomicalignments    1.26.0
   r-genomicranges        1.42.0
   r-ggplot2              3.3.3
   r-ggrepel              0.9.1
   r-gprofiler            0.7.0
   r-knitr                1.31
   r-minimal              4.0.4
   r-pheatmap             1.0.12
   r-plotly               4.9.3
   r-reshape2             1.4.4
   r-rmarkdown            2.7
   r-rsamtools            2.6.0
   r-rtracklayer          1.50.0
   r-s4vectors            0.28.1
   r-scales               1.1.1
   r-summarizedexperiment 1.20.0
   r-tximport             1.18.0

nothing to be done
Store object cache:
  fresh caches:     2
  lookups:      41381
  hits:         40249 (97.3%)
  cache size:    1131 entries

'add-data-to-store' cache:
  lookups:       6083
  hits:          2950 (48.5%)
  .drv files:    3407 (56.0%)
  Scheme files:  2659 (43.7%)
Remote procedure call summary: 3897 RPCs
  built-in-builders              ...     1
  add-to-store/tree              ...    22
  add-to-store                   ...   178
  query-references               ...   563
  add-text-to-store              ...  3133

real	0m12.697s
user	0m15.873s
sys	0m0.197s
$ [env] time INFERIOR=y guix package -m manifest-test.scm -p 
/tmp/foo
The following packages will be installed:
   bash-minimal           5.0.16
   r-corrplot             0.84
   r-crosstalk            1.1.1
   r-data-table           1.14.0
   r-deseq2               1.30.1
   r-dt                   0.17
   r-genomicalignments    1.26.0
   r-genomicranges        1.42.0
   r-ggplot2              3.3.3
   r-ggrepel              0.9.1
   r-gprofiler            0.7.0
   r-knitr                1.31
   r-minimal              4.0.4
   r-pheatmap             1.0.12
   r-plotly               4.9.3
   r-reshape2             1.4.4
   r-rmarkdown            2.7
   r-rsamtools            2.6.0
   r-rtracklayer          1.50.0
   r-s4vectors            0.28.1
   r-scales               1.1.1
   r-summarizedexperiment 1.20.0
   r-tximport             1.18.0

nothing to be done
Store object cache:
  fresh caches:     2
  lookups:      27162
  hits:         26425 (97.3%)
  cache size:     736 entries

'add-data-to-store' cache:
  lookups:        887
  hits:            52 (5.9%)
  .drv files:     550 (62.0%)
  Scheme files:   331 (37.3%)
Remote procedure call summary: 1011 RPCs
  built-in-builders              ...     1
  add-to-store/tree              ...    11
  query-references               ...    51
  add-to-store                   ...   113
  add-text-to-store              ...   835

real	0m19.504s
user	0m4.014s
sys	0m0.411s
--8<---------------cut here---------------end--------------->8---

The first case with 12 seconds reproduces bug #48005.  The second 
case (going through the inferior) is much slower with over 19 
seconds; if we squint this is also close to twice the amount of 
time compared to the “direct” computation.

-- 
Ricardo

bug#48007: computing derivations through inferior takes twice as long

[Ludovic Courtès]

[-- Attachment #1: Type: text/plain, Size: 1320 bytes --]

Hi!

Ricardo Wurmus <rekado@elephly.net> skribis:

> When INFERIOR is set to “y”, each package specification will be 
> looked up in the current Guix via an inferior.  For any other 
> values of INFERIOR the specifications are resolved with the 
> current Guix (the very same Guix) directly.
>
> Here are the timings:
>
> $ [env] export GUIX_PROFILING="object-cache 
> add-data-to-store-cache rpc"
> $ [env] time INFERIOR=n guix build -m manifest-test.scm -d
> /gnu/store/mwg47gbmi98bbrywk07y5l2h9p6d1hz5-bash-minimal-5.0.16.drv
> /gnu/store/kcjk6z128fa07pzp8irp6lbbyl3g16nr-r-corrplot-0.84.drv

[...]

> $ [env] time INFERIOR=y guix build -m manifest-test.scm -d

With the manifest you gave in this message, I get roughly these
wall-clock times as of 3993d33d1c0129b1ca6f0fd122fe2bbe48e4f093 for:

  guix build -m the-manifest.scm -n

  INFERIOR=n   4.1s
  INFERIOR=y  36.9s

With the patch below, it’s down to:

  INFERIOR=y   9.3s

The trick is to ensure the inferior maintains its object cache across
calls.  The patch needs to be cleaned up because it peeks into
internals, but we should be able to do something along these lines and
optimize a couple of other things.

If you can give it a spin on a more representative example, that’s
great!

Thanks,
Ludo’.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: Type: text/x-patch, Size: 1552 bytes --]

diff --git a/guix/inferior.scm b/guix/inferior.scm
index 572114f626..f6866d2083 100644
--- a/guix/inferior.scm
+++ b/guix/inferior.scm
@@ -188,6 +188,8 @@ (define* (port->inferior pipe #:optional (close close-port))
        (inferior-eval '(use-modules (srfi srfi-34)) result)
        (inferior-eval '(define %package-table (make-hash-table))
                       result)
+       (inferior-eval '(define %previous-object-cache #f)
+                      result)
        result))
     (_
      #f)))
@@ -559,6 +561,10 @@ (define (inferior-eval-with-store inferior store code)
            (let ((store (if (defined? 'port->connection)
                             (port->connection socket #:version ,proto)
                             (open-connection))))
+             (when %previous-object-cache
+               (set-store-connection-cache! store (@@ (guix store) %object-cache-id)
+                                            %previous-object-cache))
+
              (dynamic-wind
                (const #t)
                (lambda ()
@@ -570,6 +576,9 @@ (define (inferior-eval-with-store inferior store code)
                             `(store-protocol-error ,(error-message c))))
                    `(result ,(proc store))))
                (lambda ()
+                 (set! %previous-object-cache
+                       (store-connection-cache store
+                                               (@@ (guix store) %object-cache-id)))
                  (close-connection store)
                  (close-port socket)))))
         inferior)

bug#48007: computing derivations through inferior takes twice as long

[Ricardo Wurmus]

Ludovic Courtès <ludo@gnu.org> writes:

> The trick is to ensure the inferior maintains its object cache across
> calls.  The patch needs to be cleaned up because it peeks into
> internals, but we should be able to do something along these lines and
> optimize a couple of other things.

Yeah, this makes sense.  Excellent!

> If you can give it a spin on a more representative example, that’s
> great!

I tried it in the GWL with the big RNAseq workflow I adopted from PiGx
and the step to generate job scripts (which reference inferior packages)
became considerably faster.  There is still potential for improvement,
but this change is the difference between not too bad (15 seconds) and
unusable (> 5 minutes).

Thank you!

-- 
Ricardo

bug#48007: computing derivations through inferior takes twice as long

[Ludovic Courtès]

Hi,

Ricardo Wurmus <rekado@elephly.net> skribis:

> I tried it in the GWL with the big RNAseq workflow I adopted from PiGx
> and the step to generate job scripts (which reference inferior packages)
> became considerably faster.  There is still potential for improvement,
> but this change is the difference between not too bad (15 seconds) and
> unusable (> 5 minutes).

Good, that’s a step in the right direction.

I’ve sent in this issue a cleaned up patch series that achieves the same
result, plus some micro-optimizations.  It’d be great if you could
confirm it still works for you.

Thanks,
Ludo’.

bug#48007: computing derivations through inferior takes twice as long

[Ricardo Wurmus]

Ludovic Courtès <ludo@gnu.org> writes:

> Ricardo Wurmus <rekado@elephly.net> skribis:
>
>> I tried it in the GWL with the big RNAseq workflow I adopted from PiGx
>> and the step to generate job scripts (which reference inferior packages)
>> became considerably faster.  There is still potential for improvement,
>> but this change is the difference between not too bad (15 seconds) and
>> unusable (> 5 minutes).
>
> Good, that’s a step in the right direction.
>
> I’ve sent in this issue a cleaned up patch series that achieves the same
> result, plus some micro-optimizations.  It’d be great if you could
> confirm it still works for you.

These patches look great to me and they work.
My real-world test case is now down to about 12 seconds.

Thanks!

-- 
Ricardo

bug#48007: computing derivations through inferior takes twice as long

[Ludovic Courtès]

Ricardo Wurmus <rekado@elephly.net> skribis:

> These patches look great to me and they work.
> My real-world test case is now down to about 12 seconds.

Good!  Fixed the typo you mentioned on IRC and pushed as
e778910bdfc68c60a5be59aac93049d32feae904.

To summarize, the INFERIOR=y case still takes about twice as long as the
INFERIOR=n case (before that it was actually 9 times slower).

I suppose this is mostly due to the round trips between the inferior and
the parent (one per package).  We’d have to analyze more closely, for
example with ‘perf timechart’, where the wait times are.  It’ll always
be slower than without an inferior though.

Last, we should improve the baseline (4s here for the manifest you
gave).  That’s the tricky part.

Thanks,
Ludo’.

bug#48007: [PATCH 1/4] inferior: Create the store proxy listening socket only once.

[Ludovic Courtès]

Previously, each 'inferior-eval-with-store' call would have the calling
process create a temporary directory with a listening socket in there.
Now that listening socket is created once and reused in subsequent
calls.

* guix/inferior.scm (<inferior>)[bridge-file-name, bridge-socket]: New
fields.
(port->inferior): Adjust accordingly.
(close-inferior): Close 'inferior-bridge-socket' and delete
'inferior-bridge-file-name' if set.
(open-store-bridge!, ensure-store-bridge!): New procedures.
(inferior-eval-with-store): Use them.
---
 guix/inferior.scm | 154 ++++++++++++++++++++++++++++------------------
 1 file changed, 93 insertions(+), 61 deletions(-)

diff --git a/guix/inferior.scm b/guix/inferior.scm
index 572114f626..a997c3ead4 100644
--- a/guix/inferior.scm
+++ b/guix/inferior.scm
@@ -25,7 +25,6 @@ (define-module (guix inferior)
                 #:select (source-properties->location))
   #:use-module ((guix utils)
                 #:select (%current-system
-                          call-with-temporary-directory
                           version>? version-prefix?
                           cache-directory))
   #:use-module ((guix store)
@@ -36,6 +35,8 @@ (define-module (guix inferior)
                           &store-protocol-error))
   #:use-module ((guix derivations)
                 #:select (read-derivation-from-file))
+  #:use-module ((guix build syscalls)
+                #:select (mkdtemp!))
   #:use-module (guix gexp)
   #:use-module (guix search-paths)
   #:use-module (guix profiles)
@@ -112,14 +113,21 @@ (define-module (guix inferior)
 
 ;; Inferior Guix process.
 (define-record-type <inferior>
-  (inferior pid socket close version packages table)
+  (inferior pid socket close version packages table
+            bridge-file-name bridge-socket)
   inferior?
   (pid      inferior-pid)
   (socket   inferior-socket)
   (close    inferior-close-socket)               ;procedure
   (version  inferior-version)                    ;REPL protocol version
   (packages inferior-package-promise)            ;promise of inferior packages
-  (table    inferior-package-table))             ;promise of vhash
+  (table    inferior-package-table)              ;promise of vhash
+
+  ;; Bridging with a store.
+  (bridge-file-name inferior-bridge-file-name     ;#f | string
+                    set-inferior-bridge-file-name!)
+  (bridge-socket    inferior-bridge-socket        ;#f | port
+                    set-inferior-bridge-socket!))
 
 (define (write-inferior inferior port)
   (match inferior
@@ -172,7 +180,8 @@ (define* (port->inferior pipe #:optional (close close-port))
     (('repl-version 0 rest ...)
      (letrec ((result (inferior 'pipe pipe close (cons 0 rest)
                                 (delay (%inferior-packages result))
-                                (delay (%inferior-package-table result)))))
+                                (delay (%inferior-package-table result))
+                                #f #f)))
 
        ;; For protocol (0 1) and later, send the protocol version we support.
        (match rest
@@ -205,7 +214,13 @@ (define pipe
 (define (close-inferior inferior)
   "Close INFERIOR."
   (let ((close (inferior-close-socket inferior)))
-    (close (inferior-socket inferior))))
+    (close (inferior-socket inferior))
+
+    ;; Close and delete the store bridge, if any.
+    (when (inferior-bridge-socket inferior)
+      (close-port (inferior-bridge-socket inferior))
+      (delete-file (inferior-bridge-file-name inferior))
+      (rmdir (dirname (inferior-bridge-file-name inferior))))))
 
 ;; Non-self-quoting object of the inferior.
 (define-record-type <inferior-object>
@@ -524,67 +539,84 @@ (define (proxy client backend)                    ;adapted from (guix ssh)
        (unless (port-closed? client)
          (loop))))))
 
+(define (open-store-bridge! inferior)
+  "Open a \"store bridge\" for INFERIOR--a named socket in /tmp that will be
+used to proxy store RPCs from the inferior to the store of the calling
+process."
+  ;; Create a named socket in /tmp to let INFERIOR connect to it and use it as
+  ;; its store.  This ensures the inferior uses the same store, with the same
+  ;; options, the same per-session GC roots, etc.
+  ;; FIXME: This strategy doesn't work for remote inferiors (SSH).
+  (define directory
+    (mkdtemp! (string-append (or (getenv "TMPDIR") "/tmp")
+                             "/guix-inferior.XXXXXX")))
+
+  (chmod directory #o700)
+  (let ((name   (string-append directory "/inferior"))
+        (socket (socket AF_UNIX SOCK_STREAM 0)))
+    (bind socket AF_UNIX name)
+    (listen socket 2)
+    (set-inferior-bridge-file-name! inferior name)
+    (set-inferior-bridge-socket! inferior socket)))
+
+(define (ensure-store-bridge! inferior)
+  "Ensure INFERIOR has a connected bridge."
+  (or (inferior-bridge-socket inferior)
+      (begin
+        (open-store-bridge! inferior)
+        (inferior-bridge-socket inferior))))
+
 (define (inferior-eval-with-store inferior store code)
   "Evaluate CODE in INFERIOR, passing it STORE as its argument.  CODE must
 thus be the code of a one-argument procedure that accepts a store."
-  ;; Create a named socket in /tmp and let INFERIOR connect to it and use it
-  ;; as its store.  This ensures the inferior uses the same store, with the
-  ;; same options, the same per-session GC roots, etc.
-  ;; FIXME: This strategy doesn't work for remote inferiors (SSH).
-  (call-with-temporary-directory
-   (lambda (directory)
-     (chmod directory #o700)
-     (let* ((name     (string-append directory "/inferior"))
-            (socket   (socket AF_UNIX SOCK_STREAM 0))
-            (major    (store-connection-major-version store))
-            (minor    (store-connection-minor-version store))
-            (proto    (logior major minor)))
-       (bind socket AF_UNIX name)
-       (listen socket 1024)
-       (send-inferior-request
-        `(let ((proc   ,code)
-               (socket (socket AF_UNIX SOCK_STREAM 0))
-               (error? (if (defined? 'store-protocol-error?)
-                           store-protocol-error?
-                           nix-protocol-error?))
-               (error-message (if (defined? 'store-protocol-error-message)
-                                  store-protocol-error-message
-                                  nix-protocol-error-message)))
-           (connect socket AF_UNIX ,name)
+  (let* ((major    (store-connection-major-version store))
+         (minor    (store-connection-minor-version store))
+         (proto    (logior major minor)))
+    (ensure-store-bridge! inferior)
+    (send-inferior-request
+     `(let ((proc   ,code)
+            (socket (socket AF_UNIX SOCK_STREAM 0))
+            (error? (if (defined? 'store-protocol-error?)
+                        store-protocol-error?
+                        nix-protocol-error?))
+            (error-message (if (defined? 'store-protocol-error-message)
+                               store-protocol-error-message
+                               nix-protocol-error-message)))
+        (connect socket AF_UNIX
+                 ,(inferior-bridge-file-name inferior))
 
-           ;; 'port->connection' appeared in June 2018 and we can hardly
-           ;; emulate it on older versions.  Thus fall back to
-           ;; 'open-connection', at the risk of talking to the wrong daemon or
-           ;; having our build result reclaimed (XXX).
-           (let ((store (if (defined? 'port->connection)
-                            (port->connection socket #:version ,proto)
-                            (open-connection))))
-             (dynamic-wind
-               (const #t)
-               (lambda ()
-                 ;; Serialize '&store-protocol-error' conditions.  The
-                 ;; exception serialization mechanism that
-                 ;; 'read-repl-response' expects is unsuitable for SRFI-35
-                 ;; error conditions, hence this special case.
-                 (guard (c ((error? c)
-                            `(store-protocol-error ,(error-message c))))
-                   `(result ,(proc store))))
-               (lambda ()
-                 (close-connection store)
-                 (close-port socket)))))
-        inferior)
-       (match (accept socket)
-         ((client . address)
-          (proxy client (store-connection-socket store))))
-       (close-port socket)
+        ;; 'port->connection' appeared in June 2018 and we can hardly
+        ;; emulate it on older versions.  Thus fall back to
+        ;; 'open-connection', at the risk of talking to the wrong daemon or
+        ;; having our build result reclaimed (XXX).
+        (let ((store (if (defined? 'port->connection)
+                         (port->connection socket #:version ,proto)
+                         (open-connection))))
+          (dynamic-wind
+            (const #t)
+            (lambda ()
+              ;; Serialize '&store-protocol-error' conditions.  The
+              ;; exception serialization mechanism that
+              ;; 'read-repl-response' expects is unsuitable for SRFI-35
+              ;; error conditions, hence this special case.
+              (guard (c ((error? c)
+                         `(store-protocol-error ,(error-message c))))
+                `(result ,(proc store))))
+            (lambda ()
+              (close-connection store)
+              (close-port socket)))))
+     inferior)
+    (match (accept (inferior-bridge-socket inferior))
+      ((client . address)
+       (proxy client (store-connection-socket store))))
 
-       (match (read-inferior-response inferior)
-         (('store-protocol-error message)
-          (raise (condition
-                  (&store-protocol-error (message message)
-                                         (status 1)))))
-         (('result result)
-          result))))))
+    (match (read-inferior-response inferior)
+      (('store-protocol-error message)
+       (raise (condition
+               (&store-protocol-error (message message)
+                                      (status 1)))))
+      (('result result)
+       result))))
 
 (define* (inferior-package-derivation store package
                                       #:optional

base-commit: 3993d33d1c0129b1ca6f0fd122fe2bbe48e4f093
-- 
2.34.0

bug#48007: [PATCH 2/4] inferior: Keep the store bridge connected.

[Ludovic Courtès]

Previously, each 'inferior-eval-with-store' would lead the inferior to
connect to the named socket the parent is listening to.  With this
change, the connection is established once for all and reused
afterwards.

* guix/inferior.scm (<inferior>)[bridge-file-name]: Remove.
(open-bidirectional-pipe): New procedure.
(inferior-pipe): Use it instead of 'open-pipe*' and return two values.
(port->inferior): Adjust call to 'inferior'.
(open-inferior): Adjust to 'inferior-pipe' changes.
(close-inferior): Remove 'inferior-bridge-file-name' handling.
(open-store-bridge!): Switch back to 'call-with-temporary-directory'.
Define '%bridge-socket' in the inferior, connected to the caller.
(proxy): Change first argument to be an inferior.  Add 'reponse-port'
and call to 'drain-input'.  Pass 'reponse-port' to 'select' and use it
as a loop termination clause.
(inferior-eval-with-store): Remove 'socket' and 'connect' calls from the
inferior code, and use '%bridge-socket' instead.
---
 guix/inferior.scm | 167 +++++++++++++++++++++++++++++-----------------
 1 file changed, 104 insertions(+), 63 deletions(-)

diff --git a/guix/inferior.scm b/guix/inferior.scm
index a997c3ead4..1c19527b8f 100644
--- a/guix/inferior.scm
+++ b/guix/inferior.scm
@@ -25,6 +25,7 @@ (define-module (guix inferior)
                 #:select (source-properties->location))
   #:use-module ((guix utils)
                 #:select (%current-system
+                          call-with-temporary-directory
                           version>? version-prefix?
                           cache-directory))
   #:use-module ((guix store)
@@ -35,8 +36,6 @@ (define-module (guix inferior)
                           &store-protocol-error))
   #:use-module ((guix derivations)
                 #:select (read-derivation-from-file))
-  #:use-module ((guix build syscalls)
-                #:select (mkdtemp!))
   #:use-module (guix gexp)
   #:use-module (guix search-paths)
   #:use-module (guix profiles)
@@ -56,7 +55,6 @@ (define-module (guix inferior)
   #:use-module (srfi srfi-71)
   #:autoload   (ice-9 ftw) (scandir)
   #:use-module (ice-9 match)
-  #:use-module (ice-9 popen)
   #:use-module (ice-9 vlist)
   #:use-module (ice-9 binary-ports)
   #:use-module ((rnrs bytevectors) #:select (string->utf8))
@@ -114,7 +112,7 @@ (define-module (guix inferior)
 ;; Inferior Guix process.
 (define-record-type <inferior>
   (inferior pid socket close version packages table
-            bridge-file-name bridge-socket)
+            bridge-socket)
   inferior?
   (pid      inferior-pid)
   (socket   inferior-socket)
@@ -124,8 +122,6 @@ (define-record-type <inferior>
   (table    inferior-package-table)              ;promise of vhash
 
   ;; Bridging with a store.
-  (bridge-file-name inferior-bridge-file-name     ;#f | string
-                    set-inferior-bridge-file-name!)
   (bridge-socket    inferior-bridge-socket        ;#f | port
                     set-inferior-bridge-socket!))
 
@@ -138,37 +134,69 @@ (define (write-inferior inferior port)
 
 (set-record-type-printer! <inferior> write-inferior)
 
+(define (open-bidirectional-pipe command . args)
+  "Open a bidirectional pipe to COMMAND invoked with ARGS and return it, as a
+regular file port (socket).
+
+This is equivalent to (open-pipe* OPEN_BOTH ...) except that the result is a
+regular file port that can be passed to 'select' ('open-pipe*' returns a
+custom binary port)."
+  (match (socketpair AF_UNIX SOCK_STREAM 0)
+    ((parent . child)
+     (match (primitive-fork)
+       (0
+        (dynamic-wind
+          (lambda ()
+            #t)
+          (lambda ()
+            (close-port parent)
+            (close-fdes 0)
+            (close-fdes 1)
+            (dup2 (fileno child) 0)
+            (dup2 (fileno child) 1)
+            ;; Mimic 'open-pipe*'.
+            (unless (file-port? (current-error-port))
+              (close-fdes 2)
+              (dup2 (open-fdes "/dev/null" O_WRONLY) 2))
+            (apply execlp command command args))
+          (lambda ()
+            (primitive-_exit 127))))
+       (pid
+        (close-port child)
+        (values parent pid))))))
+
 (define* (inferior-pipe directory command error-port)
-  "Return an input/output pipe on the Guix instance in DIRECTORY.  This runs
-'DIRECTORY/COMMAND repl' if it exists, or falls back to some other method if
-it's an old Guix."
-  (let ((pipe (with-error-to-port error-port
-                (lambda ()
-                  (open-pipe* OPEN_BOTH
-                              (string-append directory "/" command)
-                              "repl" "-t" "machine")))))
+  "Return two values: an input/output pipe on the Guix instance in DIRECTORY
+and its PID.  This runs 'DIRECTORY/COMMAND repl' if it exists, or falls back
+to some other method if it's an old Guix."
+  (let ((pipe pid (with-error-to-port error-port
+                    (lambda ()
+                      (open-bidirectional-pipe
+                       (string-append directory "/" command)
+                       "repl" "-t" "machine")))))
     (if (eof-object? (peek-char pipe))
         (begin
-          (close-pipe pipe)
+          (close-port pipe)
 
           ;; Older versions of Guix didn't have a 'guix repl' command, so
           ;; emulate it.
           (with-error-to-port error-port
             (lambda ()
-              (open-pipe* OPEN_BOTH "guile"
-                          "-L" (string-append directory "/share/guile/site/"
-                                              (effective-version))
-                          "-C" (string-append directory "/share/guile/site/"
-                                              (effective-version))
-                          "-C" (string-append directory "/lib/guile/"
-                                              (effective-version) "/site-ccache")
-                          "-c"
-                          (object->string
-                           `(begin
-                              (primitive-load ,(search-path %load-path
-                                                            "guix/repl.scm"))
-                              ((@ (guix repl) machine-repl))))))))
-        pipe)))
+              (open-bidirectional-pipe
+               "guile"
+               "-L" (string-append directory "/share/guile/site/"
+                                   (effective-version))
+               "-C" (string-append directory "/share/guile/site/"
+                                   (effective-version))
+               "-C" (string-append directory "/lib/guile/"
+                                   (effective-version) "/site-ccache")
+               "-c"
+               (object->string
+                `(begin
+                   (primitive-load ,(search-path %load-path
+                                                 "guix/repl.scm"))
+                   ((@ (guix repl) machine-repl))))))))
+        (values pipe pid))))
 
 (define* (port->inferior pipe #:optional (close close-port))
   "Given PIPE, an input/output port, return an inferior that talks over PIPE.
@@ -181,7 +209,7 @@ (define* (port->inferior pipe #:optional (close close-port))
      (letrec ((result (inferior 'pipe pipe close (cons 0 rest)
                                 (delay (%inferior-packages result))
                                 (delay (%inferior-package-table result))
-                                #f #f)))
+                                #f)))
 
        ;; For protocol (0 1) and later, send the protocol version we support.
        (match rest
@@ -206,10 +234,11 @@ (define* (open-inferior directory
                         (error-port (%make-void-port "w")))
   "Open the inferior Guix in DIRECTORY, running 'DIRECTORY/COMMAND repl' or
 equivalent.  Return #f if the inferior could not be launched."
-  (define pipe
-    (inferior-pipe directory command error-port))
-
-  (port->inferior pipe close-pipe))
+  (let ((pipe pid (inferior-pipe directory command error-port)))
+    (port->inferior pipe
+                    (lambda (port)
+                      (close-port port)
+                      (waitpid pid)))))
 
 (define (close-inferior inferior)
   "Close INFERIOR."
@@ -218,9 +247,7 @@ (define (close-inferior inferior)
 
     ;; Close and delete the store bridge, if any.
     (when (inferior-bridge-socket inferior)
-      (close-port (inferior-bridge-socket inferior))
-      (delete-file (inferior-bridge-file-name inferior))
-      (rmdir (dirname (inferior-bridge-file-name inferior))))))
+      (close-port (inferior-bridge-socket inferior)))))
 
 ;; Non-self-quoting object of the inferior.
 (define-record-type <inferior-object>
@@ -512,22 +539,32 @@ (define (inferior-package-provenance package)
                                                 'package-provenance))))
                              (or provenance (const #f)))))
 
-(define (proxy client backend)                    ;adapted from (guix ssh)
-  "Proxy communication between CLIENT and BACKEND until CLIENT closes the
-connection, at which point CLIENT is closed (both CLIENT and BACKEND must be
-input/output ports.)"
+(define (proxy inferior store)                    ;adapted from (guix ssh)
+  "Proxy communication between INFERIOR and STORE, until the connection to
+STORE is closed or INFERIOR has data available for input (a REPL response)."
+  (define client
+    (inferior-bridge-socket inferior))
+  (define backend
+    (store-connection-socket store))
+  (define response-port
+    (inferior-socket inferior))
+
   ;; Use buffered ports so that 'get-bytevector-some' returns up to the
   ;; whole buffer like read(2) would--see <https://bugs.gnu.org/30066>.
   (setvbuf client 'block 65536)
   (setvbuf backend 'block 65536)
 
+  ;; RESPONSE-PORT may typically contain a leftover newline that 'read' didn't
+  ;; consume.  Drain it so that 'select' doesn't immediately stop.
+  (drain-input response-port)
+
   (let loop ()
-    (match (select (list client backend) '() '())
+    (match (select (list client backend response-port) '() '())
       ((reads () ())
        (when (memq client reads)
          (match (get-bytevector-some client)
            ((? eof-object?)
-            (close-port client))
+            #t)
            (bv
             (put-bytevector backend bv)
             (force-output backend))))
@@ -536,7 +573,8 @@ (define (proxy client backend)                    ;adapted from (guix ssh)
            (bv
             (put-bytevector client bv)
             (force-output client))))
-       (unless (port-closed? client)
+       (unless (or (port-closed? client)
+                   (memq response-port reads))
          (loop))))))
 
 (define (open-store-bridge! inferior)
@@ -547,17 +585,25 @@ (define (open-store-bridge! inferior)
   ;; its store.  This ensures the inferior uses the same store, with the same
   ;; options, the same per-session GC roots, etc.
   ;; FIXME: This strategy doesn't work for remote inferiors (SSH).
-  (define directory
-    (mkdtemp! (string-append (or (getenv "TMPDIR") "/tmp")
-                             "/guix-inferior.XXXXXX")))
+  (call-with-temporary-directory
+   (lambda (directory)
+     (chmod directory #o700)
+     (let ((name   (string-append directory "/inferior"))
+           (socket (socket AF_UNIX SOCK_STREAM 0)))
+       (bind socket AF_UNIX name)
+       (listen socket 2)
 
-  (chmod directory #o700)
-  (let ((name   (string-append directory "/inferior"))
-        (socket (socket AF_UNIX SOCK_STREAM 0)))
-    (bind socket AF_UNIX name)
-    (listen socket 2)
-    (set-inferior-bridge-file-name! inferior name)
-    (set-inferior-bridge-socket! inferior socket)))
+       (send-inferior-request
+        `(define %bridge-socket
+           (let ((socket (socket AF_UNIX SOCK_STREAM 0)))
+             (connect socket AF_UNIX ,name)
+             socket))
+        inferior)
+       (match (accept socket)
+         ((client . address)
+          (close-port socket)
+          (set-inferior-bridge-socket! inferior client)))
+       (read-inferior-response inferior)))))
 
 (define (ensure-store-bridge! inferior)
   "Ensure INFERIOR has a connected bridge."
@@ -575,22 +621,19 @@ (define (inferior-eval-with-store inferior store code)
     (ensure-store-bridge! inferior)
     (send-inferior-request
      `(let ((proc   ,code)
-            (socket (socket AF_UNIX SOCK_STREAM 0))
             (error? (if (defined? 'store-protocol-error?)
                         store-protocol-error?
                         nix-protocol-error?))
             (error-message (if (defined? 'store-protocol-error-message)
                                store-protocol-error-message
                                nix-protocol-error-message)))
-        (connect socket AF_UNIX
-                 ,(inferior-bridge-file-name inferior))
 
         ;; 'port->connection' appeared in June 2018 and we can hardly
         ;; emulate it on older versions.  Thus fall back to
         ;; 'open-connection', at the risk of talking to the wrong daemon or
         ;; having our build result reclaimed (XXX).
         (let ((store (if (defined? 'port->connection)
-                         (port->connection socket #:version ,proto)
+                         (port->connection %bridge-socket #:version ,proto)
                          (open-connection))))
           (dynamic-wind
             (const #t)
@@ -603,12 +646,10 @@ (define (inferior-eval-with-store inferior store code)
                          `(store-protocol-error ,(error-message c))))
                 `(result ,(proc store))))
             (lambda ()
-              (close-connection store)
-              (close-port socket)))))
+              (unless (defined? 'port->connection)
+                (close-port store))))))
      inferior)
-    (match (accept (inferior-bridge-socket inferior))
-      ((client . address)
-       (proxy client (store-connection-socket store))))
+    (proxy inferior store)
 
     (match (read-inferior-response inferior)
       (('store-protocol-error message)
-- 
2.34.0

bug#48007: computing derivations through inferior takes twice as long

[Ludovic Courtès]

Hi,

Ludovic Courtès <ludo@gnu.org> skribis:

> Previously, each 'inferior-eval-with-store' would lead the inferior to
> connect to the named socket the parent is listening to.  With this
> change, the connection is established once for all and reused
> afterwards.
>
> * guix/inferior.scm (<inferior>)[bridge-file-name]: Remove.
> (open-bidirectional-pipe): New procedure.
> (inferior-pipe): Use it instead of 'open-pipe*' and return two values.
> (port->inferior): Adjust call to 'inferior'.
> (open-inferior): Adjust to 'inferior-pipe' changes.
> (close-inferior): Remove 'inferior-bridge-file-name' handling.
> (open-store-bridge!): Switch back to 'call-with-temporary-directory'.
> Define '%bridge-socket' in the inferior, connected to the caller.
> (proxy): Change first argument to be an inferior.  Add 'reponse-port'
> and call to 'drain-input'.  Pass 'reponse-port' to 'select' and use it
> as a loop termination clause.
> (inferior-eval-with-store): Remove 'socket' and 'connect' calls from the
> inferior code, and use '%bridge-socket' instead.

[...]

> +(define (open-bidirectional-pipe command . args)
> +  "Open a bidirectional pipe to COMMAND invoked with ARGS and return it, as a
> +regular file port (socket).
> +
> +This is equivalent to (open-pipe* OPEN_BOTH ...) except that the result is a
> +regular file port that can be passed to 'select' ('open-pipe*' returns a
> +custom binary port)."
> +  (match (socketpair AF_UNIX SOCK_STREAM 0)
> +    ((parent . child)
> +     (match (primitive-fork)

I noticed that there’s at least one case where this is used from a
multi-threaded program, and as we know, fork + threads don’t go well
together:

--8<---------------cut here---------------start------------->8---
$ make as-derivation
[…]
@ build-succeeded /gnu/store/n5jfi8pn1aq1ykmnq75xhr8ba2m7161l-profile.drv -
warning: call to primitive-fork while multiple threads are running;
         further behavior unspecified.  See "Processes" in the
         manual, for more information.
warning: call to primitive-fork while multiple threads are running;
         further behavior unspecified.  See "Processes" in the
         manual, for more information.
warning: call to primitive-fork while multiple threads are running;
         further behavior unspecified.  See "Processes" in the
         manual, for more information.
--8<---------------cut here---------------end--------------->8---

The threads are created in ‘build-aux/cuirass/evaluate.scm’.

In practice it’s OK because the code above calls ‘exec’ right away;
still, it’s annoying.

Ludo’.

bug#48007: [PATCH 3/4] inferior: Inferior caches store connections.

[Ludovic Courtès]

Fixes <https://issues.guix.gnu.org/48007>.
Reported by Ricardo Wurmus <rekado@elephly.net>.

Previously, at each 'inferior-eval-with-store' call, the inferior would
create a new <store-connection> object with empty caches.  Consequently,
when repeatedly calling 'inferior-package-derivation', we would not
benefit from any caching and instead recompute all the derivations for
every package.  This patch fixes it by caching <store-connection>
objects in the inferior.

* guix/inferior.scm (port->inferior): Define '%store-table' in the inferior.
(inferior-eval-with-store): Cache store connections in %STORE-TABLE.
Remove now unneeded 'dynamic-wind' with 'close-port' call.
---
 guix/inferior.scm | 54 +++++++++++++++++++++++++++++------------------
 1 file changed, 33 insertions(+), 21 deletions(-)

diff --git a/guix/inferior.scm b/guix/inferior.scm
index 1c19527b8f..64dd1ce9b6 100644
--- a/guix/inferior.scm
+++ b/guix/inferior.scm
@@ -225,6 +225,8 @@ (define* (port->inferior pipe #:optional (close close-port))
        (inferior-eval '(use-modules (srfi srfi-34)) result)
        (inferior-eval '(define %package-table (make-hash-table))
                       result)
+       (inferior-eval '(define %store-table (make-hash-table))
+                      result)
        result))
     (_
      #f)))
@@ -617,7 +619,12 @@ (define (inferior-eval-with-store inferior store code)
 thus be the code of a one-argument procedure that accepts a store."
   (let* ((major    (store-connection-major-version store))
          (minor    (store-connection-minor-version store))
-         (proto    (logior major minor)))
+         (proto    (logior major minor))
+
+         ;; The address of STORE itself is not a good identifier because it
+         ;; keeps changing through the use of "functional caches".  The
+         ;; address of its socket port makes more sense.
+         (store-id (object-address (store-connection-socket store))))
     (ensure-store-bridge! inferior)
     (send-inferior-request
      `(let ((proc   ,code)
@@ -628,26 +635,31 @@ (define (inferior-eval-with-store inferior store code)
                                store-protocol-error-message
                                nix-protocol-error-message)))
 
-        ;; 'port->connection' appeared in June 2018 and we can hardly
-        ;; emulate it on older versions.  Thus fall back to
-        ;; 'open-connection', at the risk of talking to the wrong daemon or
-        ;; having our build result reclaimed (XXX).
-        (let ((store (if (defined? 'port->connection)
-                         (port->connection %bridge-socket #:version ,proto)
-                         (open-connection))))
-          (dynamic-wind
-            (const #t)
-            (lambda ()
-              ;; Serialize '&store-protocol-error' conditions.  The
-              ;; exception serialization mechanism that
-              ;; 'read-repl-response' expects is unsuitable for SRFI-35
-              ;; error conditions, hence this special case.
-              (guard (c ((error? c)
-                         `(store-protocol-error ,(error-message c))))
-                `(result ,(proc store))))
-            (lambda ()
-              (unless (defined? 'port->connection)
-                (close-port store))))))
+        ;; Cache connections to STORE-ID.  This ensures that the caches within
+        ;; <store-connection> (in particular the object cache) are reused
+        ;; across calls to 'inferior-eval-with-store', which makes a
+        ;; significant different when it is called repeatedly.
+        (let ((store (or (hashv-ref %store-table ,store-id)
+
+                         ;; 'port->connection' appeared in June 2018 and we
+                         ;; can hardly emulate it on older versions.  Thus
+                         ;; fall back to 'open-connection', at the risk of
+                         ;; talking to the wrong daemon or having our build
+                         ;; result reclaimed (XXX).
+                         (let ((store (if (defined? 'port->connection)
+                                          (port->connection %bridge-socket
+                                                            #:version ,proto)
+                                          (open-connection))))
+                           (hashv-set! %store-table ,store-id store)
+                           store))))
+
+          ;; Serialize '&store-protocol-error' conditions.  The
+          ;; exception serialization mechanism that
+          ;; 'read-repl-response' expects is unsuitable for SRFI-35
+          ;; error conditions, hence this special case.
+          (guard (c ((error? c)
+                     `(store-protocol-error ,(error-message c))))
+            `(result ,(proc store)))))
      inferior)
     (proxy inferior store)
 
-- 
2.34.0

bug#48007: [PATCH 4/4] inferior: Move initialization bits away from 'inferior-eval-with-store'.

[Ludovic Courtès]

* guix/inferior.scm (port->inferior): In the inferior, define
'cached-store-connection', 'store-protocol-error?', and
'store-protocol-error-message'.
(inferior-eval-with-store): Use them.
---
 guix/inferior.scm | 76 ++++++++++++++++++++++++++---------------------
 1 file changed, 42 insertions(+), 34 deletions(-)

diff --git a/guix/inferior.scm b/guix/inferior.scm
index 64dd1ce9b6..fc253dcc4f 100644
--- a/guix/inferior.scm
+++ b/guix/inferior.scm
@@ -225,7 +225,39 @@ (define* (port->inferior pipe #:optional (close close-port))
        (inferior-eval '(use-modules (srfi srfi-34)) result)
        (inferior-eval '(define %package-table (make-hash-table))
                       result)
-       (inferior-eval '(define %store-table (make-hash-table))
+       (inferior-eval '(begin
+                         (define %store-table (make-hash-table))
+                         (define (cached-store-connection store-id version)
+                           ;; Cache connections to store ID.  This ensures that
+                           ;; the caches within <store-connection> (in
+                           ;; particular the object cache) are reused across
+                           ;; calls to 'inferior-eval-with-store', which makes a
+                           ;; significant different when it is called
+                           ;; repeatedly.
+                           (or (hashv-ref %store-table store-id)
+
+                               ;; 'port->connection' appeared in June 2018 and
+                               ;; we can hardly emulate it on older versions.
+                               ;; Thus fall back to 'open-connection', at the
+                               ;; risk of talking to the wrong daemon or having
+                               ;; our build result reclaimed (XXX).
+                               (let ((store (if (defined? 'port->connection)
+                                                (port->connection %bridge-socket
+                                                                  #:version
+                                                                  version)
+                                                (open-connection))))
+                                 (hashv-set! %store-table store-id store)
+                                 store))))
+                      result)
+       (inferior-eval '(begin
+                         (define store-protocol-error?
+                           (if (defined? 'store-protocol-error?)
+                               store-protocol-error?
+                               nix-protocol-error?))
+                         (define store-protocol-error-message
+                           (if (defined? 'store-protocol-error-message)
+                               store-protocol-error-message
+                               nix-protocol-error-message)))
                       result)
        result))
     (_
@@ -627,39 +659,15 @@ (define (inferior-eval-with-store inferior store code)
          (store-id (object-address (store-connection-socket store))))
     (ensure-store-bridge! inferior)
     (send-inferior-request
-     `(let ((proc   ,code)
-            (error? (if (defined? 'store-protocol-error?)
-                        store-protocol-error?
-                        nix-protocol-error?))
-            (error-message (if (defined? 'store-protocol-error-message)
-                               store-protocol-error-message
-                               nix-protocol-error-message)))
-
-        ;; Cache connections to STORE-ID.  This ensures that the caches within
-        ;; <store-connection> (in particular the object cache) are reused
-        ;; across calls to 'inferior-eval-with-store', which makes a
-        ;; significant different when it is called repeatedly.
-        (let ((store (or (hashv-ref %store-table ,store-id)
-
-                         ;; 'port->connection' appeared in June 2018 and we
-                         ;; can hardly emulate it on older versions.  Thus
-                         ;; fall back to 'open-connection', at the risk of
-                         ;; talking to the wrong daemon or having our build
-                         ;; result reclaimed (XXX).
-                         (let ((store (if (defined? 'port->connection)
-                                          (port->connection %bridge-socket
-                                                            #:version ,proto)
-                                          (open-connection))))
-                           (hashv-set! %store-table ,store-id store)
-                           store))))
-
-          ;; Serialize '&store-protocol-error' conditions.  The
-          ;; exception serialization mechanism that
-          ;; 'read-repl-response' expects is unsuitable for SRFI-35
-          ;; error conditions, hence this special case.
-          (guard (c ((error? c)
-                     `(store-protocol-error ,(error-message c))))
-            `(result ,(proc store)))))
+     `(let ((proc  ,code)
+            (store (cached-store-connection ,store-id ,proto)))
+        ;; Serialize '&store-protocol-error' conditions.  The exception
+        ;; serialization mechanism that 'read-repl-response' expects is
+        ;; unsuitable for SRFI-35 error conditions, hence this special case.
+        (guard (c ((store-protocol-error? c)
+                   `(store-protocol-error
+                     ,(store-protocol-error-message c))))
+          `(result ,(proc store))))
      inferior)
     (proxy inferior store)
 
-- 
2.34.0