From patchwork Fri Jan 5 16:40:46 2024 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Christopher Baines X-Patchwork-Id: 58388 Return-Path: X-Original-To: patchwork@mira.cbaines.net Delivered-To: patchwork@mira.cbaines.net Received: by mira.cbaines.net (Postfix, from userid 113) id 7997B27BBE2; Fri, 5 Jan 2024 16:42:42 +0000 (GMT) X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-2.9 required=5.0 tests=BAYES_00,MAILING_LIST_MULTI, SPF_HELO_PASS autolearn=unavailable autolearn_force=no version=3.4.6 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTPS id B91FA27BBE9 for ; Fri, 5 Jan 2024 16:42:40 +0000 (GMT) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1rLnGt-00088d-Sa; Fri, 05 Jan 2024 11:42:11 -0500 Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1rLnGi-00082Q-J0 for guix-patches@gnu.org; Fri, 05 Jan 2024 11:42:03 -0500 Received: from debbugs.gnu.org ([2001:470:142:5::43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1rLnGg-00036V-UV; Fri, 05 Jan 2024 11:42:00 -0500 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1rLnGl-0003vw-97; Fri, 05 Jan 2024 11:42:03 -0500 X-Loop: help-debbugs@gnu.org Subject: [bug#68266] [PATCH 4/7] gnu: Memozise cross-kernel-headers results. Resent-From: Christopher Baines Original-Sender: "Debbugs-submit" Resent-CC: ludo@gnu.org, guix-patches@gnu.org Resent-Date: Fri, 05 Jan 2024 16:42:03 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 68266 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 68266@debbugs.gnu.org Cc: Ludovic =?utf-8?q?Court=C3=A8s?= X-Debbugs-Original-Xcc: Ludovic =?utf-8?q?Court=C3=A8s?= Received: via spool by 68266-submit@debbugs.gnu.org id=B68266.170447286515023 (code B ref 68266); Fri, 05 Jan 2024 16:42:03 +0000 Received: (at 68266) by debbugs.gnu.org; 5 Jan 2024 16:41:05 +0000 Received: from localhost ([127.0.0.1]:57738 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1rLnFo-0003uA-7R for submit@debbugs.gnu.org; Fri, 05 Jan 2024 11:41:05 -0500 Received: from mira.cbaines.net ([2a01:7e00:e000:2f8:fd4d:b5c7:13fb:3d27]:41563) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1rLnFh-0003s0-5T for 68266@debbugs.gnu.org; Fri, 05 Jan 2024 11:41:00 -0500 Received: from localhost (unknown [217.155.61.229]) by mira.cbaines.net (Postfix) with ESMTPSA id 501D827BBEB for <68266@debbugs.gnu.org>; Fri, 5 Jan 2024 16:40:52 +0000 (GMT) Received: from localhost (localhost [local]) by localhost (OpenSMTPD) with ESMTPA id badd81b3 for <68266@debbugs.gnu.org>; Fri, 5 Jan 2024 16:40:51 +0000 (UTC) From: Christopher Baines Date: Fri, 5 Jan 2024 16:40:46 +0000 Message-ID: <4c720cbfb79b514b7ebae3a2f29998f198aa845f.1704472849.git.mail@cbaines.net> X-Mailer: git-send-email 2.41.0 In-Reply-To: <13f83a0db585e81572240e35dfef473aa73fe996.1704472849.git.mail@cbaines.net> References: <13f83a0db585e81572240e35dfef473aa73fe996.1704472849.git.mail@cbaines.net> MIME-Version: 1.0 X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org X-getmail-retrieved-from-mailbox: Patches 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))