Package: guix-patches;
Reported by: Christopher Baines <mail <at> cbaines.net>
Date: Fri, 5 Jan 2024 16:38:02 UTC
Severity: normal
Tags: patch
Message #26 received at 68266 <at> debbugs.gnu.org (full text, mbox):
From: Christopher Baines <mail <at> cbaines.net> To: 68266 <at> debbugs.gnu.org Subject: [PATCH 4/7] gnu: Memozise cross-kernel-headers results. Date: Fri, 5 Jan 2024 16:40:46 +0000
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/cross-base.scm (cross-kernel-headers*): Move code to
cross-kernel-headers/implementation and call it.
(cross-kernel-headers/implementation) New procedure.
Change-Id: I345604c089e7a8a9884c07f39c95f960760e86db
---
gnu/packages/cross-base.scm | 306 ++++++++++++++++++------------------
1 file changed, 157 insertions(+), 149 deletions(-)
diff --git a/gnu/packages/cross-base.scm b/gnu/packages/cross-base.scm
index a4e361b476..f966e2f5ac 100644
--- a/gnu/packages/cross-base.scm
+++ b/gnu/packages/cross-base.scm
@@ -407,10 +407,19 @@ (define* (cross-gcc target
libc))
(define* (cross-kernel-headers . args)
+ "Return headers depending on TARGET."
(if (or (= (length args) 1) (contains-keyword? args))
(apply cross-kernel-headers* args)
(apply cross-kernel-headers/deprecated args)))
+(define* (cross-kernel-headers* target
+ #:key
+ (linux-headers linux-libre-headers)
+ (xgcc (cross-gcc target))
+ (xbinutils (cross-binutils target)))
+ (cross-kernel-headers/implementation target
+ linux-headers xgcc xbinutils))
+
(define* (cross-kernel-headers/deprecated target
#:optional
(linux-headers linux-libre-headers)
@@ -486,159 +495,158 @@ (define* (cross-mig target
(modify-inputs (package-native-inputs mig)
(prepend xgcc xbinutils)))))
-(define* (cross-kernel-headers* target
- #:key
- (linux-headers linux-libre-headers)
- (xgcc (cross-gcc target))
- (xbinutils (cross-binutils target)))
- "Return headers depending on TARGET."
-
- (define xlinux-headers
(package
- (inherit linux-headers)
- (name (string-append (package-name linux-headers)
- "-cross-" target))
(arguments
- (substitute-keyword-arguments
- `(#:implicit-cross-inputs? #f
- ,@(package-arguments linux-headers))
- ((#:phases phases)
- `(modify-phases ,phases
- (replace 'build
- (lambda _
- (setenv "ARCH" ,(platform-linux-architecture
- (lookup-platform-by-target target)))
- (format #t "`ARCH' set to `~a' (cross compiling)~%"
- (getenv "ARCH"))
-
- (invoke "make" ,(system->defconfig target))
- (invoke "make" "mrproper"
- ,@(if (version>=? (package-version linux-headers) "5.3")
- '("headers")
- '("headers_check")))))))))
- (native-inputs `(("cross-gcc" ,xgcc)
- ("cross-binutils" ,xbinutils)
- ,@(package-native-inputs linux-headers)))))
-
- (define xmig
- (cross-mig target #:xgcc xgcc #:xbinutils xbinutils))
-
- (define xgnumach-headers
- (cross-gnumach-headers target #:xgcc xgcc #:xbinutils xbinutils))
-
- (define xhurd-headers
- (package
- (inherit hurd-headers)
- (name (string-append (package-name hurd-headers)
- "-cross-" target))
-
- (arguments
- (substitute-keyword-arguments (package-arguments hurd-headers)
- ((#:configure-flags flags)
- `(cons* ,(string-append "--build=" (%current-system))
- ,(string-append "--host=" target)
- ,flags))))
-
- (native-inputs `(("cross-gcc" ,xgcc)
- ("cross-binutils" ,xbinutils)
- ("cross-mig" ,xmig)
- ,@(alist-delete "mig" (package-native-inputs hurd-headers))))))
-
- (define xglibc/hurd-headers
- (package
- (inherit glibc/hurd-headers)
- (name (string-append (package-name glibc/hurd-headers)
- "-cross-" target))
-
- (arguments
- (substitute-keyword-arguments
- `(#:modules ((guix build gnu-build-system)
- (guix build utils)
- (srfi srfi-26))
- ,@(package-arguments glibc/hurd-headers))
- ((#:phases phases)
- `(modify-phases ,phases
- (add-after 'unpack 'set-cross-headers-path
- (lambda* (#:key inputs #:allow-other-keys)
- (let* ((mach (assoc-ref inputs "gnumach-headers"))
- (hurd (assoc-ref inputs "hurd-headers"))
- (cpath (string-append mach "/include:"
- hurd "/include")))
- (for-each (cut setenv <> cpath)
- ',%gcc-cross-include-paths)
- #t)))))
- ((#:configure-flags flags)
- `(cons* ,(string-append "--build=" (%current-system))
- ,(string-append "--host=" target)
- ,flags))))
-
- (propagated-inputs `(("gnumach-headers" ,xgnumach-headers)
- ("hurd-headers" ,xhurd-headers)))
-
- (native-inputs `(("cross-gcc" ,xgcc)
- ("cross-binutils" ,xbinutils)
- ("cross-mig" ,xmig)
- ,@(alist-delete "mig"(package-native-inputs glibc/hurd-headers))))))
-
- (define xhurd-minimal
- (package
- (inherit hurd-minimal)
- (name (string-append (package-name hurd-minimal)
- "-cross-" target))
- (arguments
- (substitute-keyword-arguments
- `(#:modules ((guix build gnu-build-system)
- (guix build utils)
- (srfi srfi-26))
- ,@(package-arguments hurd-minimal))
- ((#:configure-flags flags)
- `(cons* ,(string-append "--build=" (%current-system))
- ,(string-append "--host=" target)
- ,flags))
- ((#:phases phases)
#~(modify-phases #$phases
- (add-after 'unpack 'delete-shared-target
- ;; Cannot create shared libraries due to missing crt1.o
- (lambda _
- (substitute* "Makeconf"
- (("(targets := \\$\\(libname\\)\\.a) \\$\\(libname\\)\\.so" all static)
- static)
- (("\\$\\(DESTDIR\\)\\$\\(libdir\\)/\\$\\(libname\\)\\.so\\.\\$\\(hurd-version\\)")
- "")
- (("^libs: .*\\.so\\..*" all)
- (string-append "# " all)))))
- (add-before 'configure 'set-cross-headers-path
- (lambda* (#:key inputs #:allow-other-keys)
- (let* ((glibc-headers (assoc-ref inputs "cross-glibc-hurd-headers"))
- (mach-headers (assoc-ref inputs "cross-gnumach-headers"))
- (cpath (string-append glibc-headers "/include"
- ":" mach-headers "/include")))
- (for-each (cut setenv <> cpath)
- '#$%gcc-cross-include-paths)
- #t)))))))
-
- (inputs `(("cross-glibc-hurd-headers" ,xglibc/hurd-headers)
- ("cross-gnumach-headers" ,xgnumach-headers)))
- (native-inputs `(("cross-gcc" ,xgcc)
- ("cross-binutils" ,xbinutils)
- ("cross-mig" ,xmig)
- ,@(alist-delete "mig"
- (package-native-inputs hurd-minimal))))))
-
- (define xhurd-core-headers
- (package
- (inherit hurd-core-headers)
- (name (string-append (package-name hurd-core-headers)
- "-cross-" target))
-
- (inputs `(("gnumach-headers" ,xgnumach-headers)
- ("hurd-headers" ,xhurd-headers)
- ("hurd-minimal" ,xhurd-minimal)))))
-
- (match target
- ((or "i586-pc-gnu" "i586-gnu") xhurd-core-headers)
- (_ xlinux-headers)))
+(define cross-kernel-headers/implementation
+ (mlambda (target linux-headers xgcc xbinutils)
+ (define xlinux-headers
+ (package
+ (inherit linux-headers)
+ (name (string-append (package-name linux-headers)
+ "-cross-" target))
+ (arguments
+ (substitute-keyword-arguments
+ `(#:implicit-cross-inputs? #f
+ ,@(package-arguments linux-headers))
+ ((#:phases phases)
+ `(modify-phases ,phases
+ (replace 'build
+ (lambda _
+ (setenv "ARCH" ,(platform-linux-architecture
+ (lookup-platform-by-target target)))
+ (format #t "`ARCH' set to `~a' (cross compiling)~%"
+ (getenv "ARCH"))
+
+ (invoke "make" ,(system->defconfig target))
+ (invoke "make" "mrproper"
+ ,@(if (version>=? (package-version linux-headers) "5.3")
+ '("headers")
+ '("headers_check")))))))))
+ (native-inputs `(("cross-gcc" ,xgcc)
+ ("cross-binutils" ,xbinutils)
+ ,@(package-native-inputs linux-headers)))))
+
+ (define xmig
+ (cross-mig target #:xgcc xgcc #:xbinutils xbinutils))
+
+ (define xgnumach-headers
+ (cross-gnumach-headers target #:xgcc xgcc #:xbinutils xbinutils))
+
+ (define xhurd-headers
+ (package
+ (inherit hurd-headers)
+ (name (string-append (package-name hurd-headers)
+ "-cross-" target))
+
+ (arguments
+ (substitute-keyword-arguments (package-arguments hurd-headers)
+ ((#:configure-flags flags)
+ `(cons* ,(string-append "--build=" (%current-system))
+ ,(string-append "--host=" target)
+ ,flags))))
+
+ (native-inputs `(("cross-gcc" ,xgcc)
+ ("cross-binutils" ,xbinutils)
+ ("cross-mig" ,xmig)
+ ,@(alist-delete "mig" (package-native-inputs hurd-headers))))))
+
+ (define xglibc/hurd-headers
+ (package
+ (inherit glibc/hurd-headers)
+ (name (string-append (package-name glibc/hurd-headers)
+ "-cross-" target))
+
+ (arguments
+ (substitute-keyword-arguments
+ `(#:modules ((guix build gnu-build-system)
+ (guix build utils)
+ (srfi srfi-26))
+ ,@(package-arguments glibc/hurd-headers))
+ ((#:phases phases)
+ `(modify-phases ,phases
+ (add-after 'unpack 'set-cross-headers-path
+ (lambda* (#:key inputs #:allow-other-keys)
+ (let* ((mach (assoc-ref inputs "gnumach-headers"))
+ (hurd (assoc-ref inputs "hurd-headers"))
+ (cpath (string-append mach "/include:"
+ hurd "/include")))
+ (for-each (cut setenv <> cpath)
+ ',%gcc-cross-include-paths)
+ #t)))))
+ ((#:configure-flags flags)
+ `(cons* ,(string-append "--build=" (%current-system))
+ ,(string-append "--host=" target)
+ ,flags))))
+
+ (propagated-inputs `(("gnumach-headers" ,xgnumach-headers)
+ ("hurd-headers" ,xhurd-headers)))
+
+ (native-inputs `(("cross-gcc" ,xgcc)
+ ("cross-binutils" ,xbinutils)
+ ("cross-mig" ,xmig)
+ ,@(alist-delete "mig"(package-native-inputs glibc/hurd-headers))))))
+
+ (define xhurd-minimal
+ (package
+ (inherit hurd-minimal)
+ (name (string-append (package-name hurd-minimal)
+ "-cross-" target))
+ (arguments
+ (substitute-keyword-arguments
+ `(#:modules ((guix build gnu-build-system)
+ (guix build utils)
+ (srfi srfi-26))
+ ,@(package-arguments hurd-minimal))
+ ((#:configure-flags flags)
+ `(cons* ,(string-append "--build=" (%current-system))
+ ,(string-append "--host=" target)
+ ,flags))
+ ((#:phases phases)
+ #~(modify-phases #$phases
+ (add-after 'unpack 'delete-shared-target
+ ;; Cannot create shared libraries due to missing crt1.o
+ (lambda _
+ (substitute* "Makeconf"
+ (("(targets := \\$\\(libname\\)\\.a) \\$\\(libname\\)\\.so" all static)
+ static)
+ (("\\$\\(DESTDIR\\)\\$\\(libdir\\)/\\$\\(libname\\)\\.so\\.\\$\\(hurd-version\\)")
+ "")
+ (("^libs: .*\\.so\\..*" all)
+ (string-append "# " all)))))
+ (add-before 'configure 'set-cross-headers-path
+ (lambda* (#:key inputs #:allow-other-keys)
+ (let* ((glibc-headers (assoc-ref inputs "cross-glibc-hurd-headers"))
+ (mach-headers (assoc-ref inputs "cross-gnumach-headers"))
+ (cpath (string-append glibc-headers "/include"
+ ":" mach-headers "/include")))
+ (for-each (cut setenv <> cpath)
+ '#$%gcc-cross-include-paths)
+ #t)))))))
+
+ (inputs `(("cross-glibc-hurd-headers" ,xglibc/hurd-headers)
+ ("cross-gnumach-headers" ,xgnumach-headers)))
+
+ (native-inputs `(("cross-gcc" ,xgcc)
+ ("cross-binutils" ,xbinutils)
+ ("cross-mig" ,xmig)
+ ,@(alist-delete "mig"
+ (package-native-inputs hurd-minimal))))))
+
+ (define xhurd-core-headers
+ (package
+ (inherit hurd-core-headers)
+ (name (string-append (package-name hurd-core-headers)
+ "-cross-" target))
+
+ (inputs `(("gnumach-headers" ,xgnumach-headers)
+ ("hurd-headers" ,xhurd-headers)
+ ("hurd-minimal" ,xhurd-minimal)))))
+
+ (match target
+ ((or "i586-pc-gnu" "i586-gnu") xhurd-core-headers)
+ (_ xlinux-headers))))
(define* (cross-libc . args)
(if (or (= (length args) 1) (contains-keyword? args))
--
2.41.0
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.