diff mbox series

[bug#68266,1/7] gnu: Memozise make-ld-wrapper results.

Message ID 13f83a0db585e81572240e35dfef473aa73fe996.1704472849.git.mail@cbaines.net
State New
Headers show
Series Memoize packages associated with cross building. | expand

Commit Message

Christopher Baines Jan. 5, 2024, 4:40 p.m. UTC 
To ensure that it just returns a single package record for some given
arguments, as this helps to avoid poor performance of the store connection
object cache.

* gnu/packages/base.scm (make-ld-wrapper): Move code to
make-ld-wrapper/implementation and call it.
(make-ld-wrapper/implementation) New procedure.

Change-Id: Id6fc805a4a7ffbc5ff0a5174eafcdf2c7c46854d
---
 gnu/packages/base.scm | 126 ++++++++++++++++++++++--------------------
 1 file changed, 66 insertions(+), 60 deletions(-)


base-commit: 5279bd453f354cbbaafff44e46c6fa03a39bc10a

Comments

Ludovic Courtès Jan. 8, 2024, 5:22 p.m. UTC | #1 
Hi,

Christopher Baines <mail@cbaines.net> skribis:

> To ensure that it just returns a single package record for some given
> arguments, as this helps to avoid poor performance of the store connection
> object cache.
>
> * gnu/packages/base.scm (make-ld-wrapper): Move code to
> make-ld-wrapper/implementation and call it.
> (make-ld-wrapper/implementation) New procedure.
>
> Change-Id: Id6fc805a4a7ffbc5ff0a5174eafcdf2c7c46854d

Do you have figures before and after the change?

The reason I’m asking is that (gnu packages commencement) arranges to
not call ‘make-ld-wrapper’ repeatedly already.  For instance, there’s:

  (define-public ld-wrapper
    ;; The final 'ld' wrapper, which uses the final Guile and Binutils.
    (make-ld-wrapper "ld-wrapper"
                     #:binutils binutils-final
                     #:guile guile-final
                     #:bash bash-final))

and from there on we manipulate a single <package> record.

Thanks,
Ludo’.
Christopher Baines Jan. 8, 2024, 7:01 p.m. UTC | #2 
Ludovic Courtès <ludo@gnu.org> writes:

> Hi,
>
> Christopher Baines <mail@cbaines.net> skribis:
>
>> To ensure that it just returns a single package record for some given
>> arguments, as this helps to avoid poor performance of the store connection
>> object cache.
>>
>> * gnu/packages/base.scm (make-ld-wrapper): Move code to
>> make-ld-wrapper/implementation and call it.
>> (make-ld-wrapper/implementation) New procedure.
>>
>> Change-Id: Id6fc805a4a7ffbc5ff0a5174eafcdf2c7c46854d
>
> Do you have figures before and after the change?
>
> The reason I’m asking is that (gnu packages commencement) arranges to
> not call ‘make-ld-wrapper’ repeatedly already.  For instance, there’s:
>
>   (define-public ld-wrapper
>     ;; The final 'ld' wrapper, which uses the final Guile and Binutils.
>     (make-ld-wrapper "ld-wrapper"
>                      #:binutils binutils-final
>                      #:guile guile-final
>                      #:bash bash-final))
>
> and from there on we manipulate a single <package> record.

I believe the reason packages from make-ld-wrapper were showing up
multiple times in the cache for me is linked to it's use in the
cross-base module, as part of the cross-gcc procedure.

A later commit does change cross-gcc to return a single package record
for some given arguments, so that probably resolves the biggest misuse
of make-ld-wrapper.

I think there's other cases (in the llvm and mold modules) where it
looks like it's called multiple times with the same arguments, so maybe
that's an argument for having memoization around make-ld-wrapper even
though it's not needed for all uses.
diff mbox series

Patch

diff --git a/gnu/packages/base.scm b/gnu/packages/base.scm
index 8b25af6a5e..929bf9f422 100644
--- a/gnu/packages/base.scm
+++ b/gnu/packages/base.scm
@@ -66,6 +66,7 @@  (define-module (gnu packages base)
   #:use-module (guix gexp)
   #:use-module (guix packages)
   #:use-module (guix download)
+  #:use-module (guix memoization)
   #:use-module (guix git-download)
   #:use-module (guix build-system gnu)
   #:use-module (guix build-system trivial)
@@ -715,68 +716,73 @@  (define* (make-ld-wrapper name #:key
 wrapper for the cross-linker for that target, called 'TARGET-ld'.  To use a
 different linker than the default \"ld\", such as \"ld.gold\" the linker name
 can be provided via the LINKER argument."
-  ;; Note: #:system->target-triplet is a procedure so that the evaluation of
-  ;; its result can be delayed until the 'arguments' field is evaluated, thus
-  ;; in a context where '%current-system' is accurate.
-  (package
-    (name name)
-    (version "0")
-    (source #f)
-    (build-system trivial-build-system)
-    (inputs `(("binutils" ,binutils)
-              ("guile"    ,guile)
-              ("bash"     ,bash)
-              ("wrapper"  ,(search-path %load-path
-                                        "gnu/packages/ld-wrapper.in"))))
-    (arguments
-     (let ((target (target (%current-system))))
-       `(#:guile ,guile-for-build
-         #:modules ((guix build utils))
-         #:builder (begin
-                     (use-modules (guix build utils)
-                                  (system base compile))
-
-                     (let* ((out (assoc-ref %outputs "out"))
-                            (bin (string-append out "/bin"))
-                            (ld  ,(if target
-                                      `(string-append bin "/" ,target "-"
-                                                      ,linker)
-                                      `(string-append bin "/" ,linker)))
-                            (go  (string-append ld ".go")))
-
-                       (setvbuf (current-output-port)
-                                (cond-expand (guile-2.0 _IOLBF)
-                                             (else 'line)))
-                       (format #t "building ~s/bin/ld wrapper in ~s~%"
-                               (assoc-ref %build-inputs "binutils")
-                               out)
-
-                       (mkdir-p bin)
-                       (copy-file (assoc-ref %build-inputs "wrapper") ld)
-                       (substitute* ld
-                         (("@SELF@")
-                          ld)
-                         (("@GUILE@")
-                          (string-append (assoc-ref %build-inputs "guile")
-                                         "/bin/guile"))
-                         (("@BASH@")
-                          (string-append (assoc-ref %build-inputs "bash")
-                                         "/bin/bash"))
-                         (("@LD@")
-                          (string-append (assoc-ref %build-inputs "binutils")
-                                         ,(if target
-                                              (string-append "/bin/"
-                                                             target "-" linker)
-                                              (string-append "/bin/" linker)))))
-                       (chmod ld #o555)
-                       (compile-file ld #:output-file go))))))
-    (synopsis "The linker wrapper")
-    (description
-     "The linker wrapper (or @code{ld-wrapper}) wraps the linker to add any
+  (make-ld-wrapper/implementation name target binutils linker
+                                  guile bash guile-for-build))
+
+(define make-ld-wrapper/implementation
+  (mlambda (name target binutils linker guile bash guile-for-build)
+    ;; Note: #:system->target-triplet is a procedure so that the evaluation of
+    ;; its result can be delayed until the 'arguments' field is evaluated,
+    ;; thus in a context where '%current-system' is accurate.
+    (package
+      (name name)
+      (version "0")
+      (source #f)
+      (build-system trivial-build-system)
+      (inputs `(("binutils" ,binutils)
+                ("guile"    ,guile)
+                ("bash"     ,bash)
+                ("wrapper"  ,(search-path %load-path
+                                          "gnu/packages/ld-wrapper.in"))))
+      (arguments
+       (let ((target (target (%current-system))))
+         `(#:guile ,guile-for-build
+           #:modules ((guix build utils))
+           #:builder (begin
+                       (use-modules (guix build utils)
+                                    (system base compile))
+
+                       (let* ((out (assoc-ref %outputs "out"))
+                              (bin (string-append out "/bin"))
+                              (ld  ,(if target
+                                        `(string-append bin "/" ,target "-"
+                                                        ,linker)
+                                        `(string-append bin "/" ,linker)))
+                              (go  (string-append ld ".go")))
+
+                         (setvbuf (current-output-port)
+                                  (cond-expand (guile-2.0 _IOLBF)
+                                               (else 'line)))
+                         (format #t "building ~s/bin/ld wrapper in ~s~%"
+                                 (assoc-ref %build-inputs "binutils")
+                                 out)
+
+                         (mkdir-p bin)
+                         (copy-file (assoc-ref %build-inputs "wrapper") ld)
+                         (substitute* ld
+                           (("@SELF@")
+                            ld)
+                           (("@GUILE@")
+                            (string-append (assoc-ref %build-inputs "guile")
+                                           "/bin/guile"))
+                           (("@BASH@")
+                            (string-append (assoc-ref %build-inputs "bash")
+                                           "/bin/bash"))
+                           (("@LD@")
+                            (string-append (assoc-ref %build-inputs "binutils")
+                                           ,(if target
+                                                (string-append "/bin/"
+                                                               target "-" linker)
+                                                (string-append "/bin/" linker)))))
+                         (chmod ld #o555)
+                         (compile-file ld #:output-file go))))))
+      (synopsis "The linker wrapper")
+      (description
+       "The linker wrapper (or @code{ld-wrapper}) wraps the linker to add any
 missing @code{-rpath} flags, and to detect any misuse of libraries outside of
 the store.")
-    (home-page "https://www.gnu.org/software/guix//")
-    (license gpl3+)))
+      (home-page "https://www.gnu.org/software/guix//")
+      (license gpl3+))))
 
 (define-public %glibc/hurd-configure-flags
   ;; 'configure' in glibc 2.35 omits to pass '-ffreestanding' when detecting