From: Christopher Baines <mail@cbaines.net>
To: 68266@debbugs.gnu.org
Cc: "Ludovic Courtès" <ludo@gnu.org>
Subject: [bug#68266] [PATCH 4/7] gnu: Memozise cross-kernel-headers results.
Date: Fri, 5 Jan 2024 16:40:46 +0000 [thread overview]
Message-ID: <4c720cbfb79b514b7ebae3a2f29998f198aa845f.1704472849.git.mail@cbaines.net> (raw)
In-Reply-To: <13f83a0db585e81572240e35dfef473aa73fe996.1704472849.git.mail@cbaines.net>
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
next prev parent reply other threads:[~2024-01-05 16:42 UTC|newest]
Thread overview: 19+ messages / expand[flat|nested] mbox.gz Atom feed top
2024-01-05 16:35 [bug#68266] [PATCH 0/7] Memoize packages associated with cross building Christopher Baines
2024-01-05 16:40 ` [bug#68266] [PATCH 1/7] gnu: Memozise make-ld-wrapper results Christopher Baines
2024-01-05 16:40 ` [bug#68266] [PATCH 2/7] gnu: Memozise cross-binutils results Christopher Baines
2024-01-05 16:40 ` [bug#68266] [PATCH 3/7] gnu: Memozise cross-gcc results Christopher Baines
2024-01-05 16:40 ` Christopher Baines [this message]
2024-01-05 16:40 ` [bug#68266] [PATCH 5/7] gnu: Memozise cross-mig results Christopher Baines
2024-01-05 16:40 ` [bug#68266] [PATCH 6/7] gnu: Memozise cross-libc results Christopher Baines
2024-01-05 16:40 ` [bug#68266] [PATCH 7/7] packages: rust: Memoize make-rust-sysroot results Christopher Baines
2024-01-12 14:13 ` Ludovic Courtès
2024-01-12 17:57 ` Christopher Baines
2024-01-13 16:15 ` Efraim Flashner
2024-01-15 16:54 ` Ludovic Courtès
2024-01-08 17:22 ` [bug#68266] [PATCH 1/7] gnu: Memozise make-ld-wrapper results Ludovic Courtès
2024-01-08 19:01 ` Christopher Baines
2024-01-09 23:10 ` Ludovic Courtès
2024-01-10 12:28 ` Christopher Baines
2024-01-10 12:57 ` [bug#68266] [PATCH v2] guix: store: Add report-object-cache-duplication Christopher Baines
2024-01-12 14:22 ` Ludovic Courtès
2024-01-12 18:26 ` Christopher Baines
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=4c720cbfb79b514b7ebae3a2f29998f198aa845f.1704472849.git.mail@cbaines.net \
--to=mail@cbaines.net \
--cc=68266@debbugs.gnu.org \
--cc=ludo@gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this external index
https://git.savannah.gnu.org/cgit/guix.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.