diff options
author | Liliana Marie Prikler <liliana.prikler@gmail.com> | 2023-07-14 07:46:15 +0200 |
---|---|---|
committer | Liliana Marie Prikler <liliana.prikler@gmail.com> | 2023-07-14 07:46:15 +0200 |
commit | d67507cacf934b970f67567bced4e044c3ca9753 (patch) | |
tree | b1c3160946ceaf74a9a24c7360d28036230210e1 /guix | |
parent | 3b3d9a13dd2bd67f34c890047680a1ce6e3af28e (diff) | |
parent | dd4c1992103a65b8fbdc80fe07a9fe9be822769a (diff) | |
download | guix-d67507cacf934b970f67567bced4e044c3ca9753.tar guix-d67507cacf934b970f67567bced4e044c3ca9753.tar.gz |
Merge branch 'master' into gnome-team
Diffstat (limited to 'guix')
-rw-r--r-- | guix/avahi.scm | 20 | ||||
-rw-r--r-- | guix/build/git.scm | 2 | ||||
-rw-r--r-- | guix/cache.scm | 4 | ||||
-rw-r--r-- | guix/cpu.scm | 130 | ||||
-rw-r--r-- | guix/import/cran.scm | 1 | ||||
-rw-r--r-- | guix/scripts/locate.scm | 31 | ||||
-rw-r--r-- | guix/scripts/refresh.scm | 33 | ||||
-rw-r--r-- | guix/transformations.scm | 37 |
8 files changed, 164 insertions, 94 deletions
diff --git a/guix/avahi.scm b/guix/avahi.scm index cb0c85f9f4..574fe0b850 100644 --- a/guix/avahi.scm +++ b/guix/avahi.scm @@ -49,11 +49,17 @@ (port avahi-service-port) (txt avahi-service-txt)) +(define never + ;; Never true. + (const #f)) + (define* (avahi-publish-service-thread name #:key type port - (stop-loop? (const #f)) - (timeout 100) + (stop-loop? never) + (timeout (if (eq? stop-loop? never) + #f + 500)) (txt '())) "Publish the service TYPE using Avahi, for the given PORT, on all interfaces and for all protocols. Also, advertise the given TXT record list. @@ -78,7 +84,9 @@ when STOP-LOOP? procedure returns true." client-flag/ignore-user-config) client-callback))) (while (not (stop-loop?)) - (iterate-simple-poll poll timeout)))))) + (if timeout + (iterate-simple-poll poll timeout) + (iterate-simple-poll poll))))))) (define (interface->ip-address interface) "Return the local IP address of the given INTERFACE." @@ -89,10 +97,6 @@ when STOP-LOOP? procedure returns true." (close-port socket) ip)) -(define never - ;; Never true. - (const #f)) - (define* (avahi-browse-service-thread proc #:key types @@ -101,7 +105,7 @@ when STOP-LOOP? procedure returns true." (stop-loop? never) (timeout (if (eq? stop-loop? never) #f - 100))) + 500))) "Browse services which type is part of the TYPES list, using Avahi. The search is restricted to services with the given FAMILY. Each time a service is found or removed, PROC is called and passed as argument the corresponding diff --git a/guix/build/git.scm b/guix/build/git.scm index 669e38cd32..deda10fee8 100644 --- a/guix/build/git.scm +++ b/guix/build/git.scm @@ -52,7 +52,7 @@ recursively. Return #t on success, #f otherwise." (delete-file-recursively directory) #f)) (with-directory-excursion directory - (invoke git-command "init") + (invoke git-command "init" "--initial-branch=main") (invoke git-command "remote" "add" "origin" url) (if (zero? (system* git-command "fetch" "--depth" "1" "origin" commit)) (invoke git-command "checkout" "FETCH_HEAD") diff --git a/guix/cache.scm b/guix/cache.scm index be0de90e67..6a91c7d3ef 100644 --- a/guix/cache.scm +++ b/guix/cache.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2020, 2021 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2013-2017, 2020-2021, 2023 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2022 Simon Tournier <zimon.toutoune@gmail.com> ;;; ;;; This file is part of GNU Guix. @@ -55,7 +55,7 @@ time\" computed as its timestamp + TTL seconds. Call TIMESTAMP to obtain the relevant timestamp from the result of 'stat'." (lambda (file) - (match (stat file #f) + (match (false-if-exception (lstat file)) (#f 0) ;FILE may have been deleted in the meantime (st (+ (timestamp st) ttl))))) diff --git a/guix/cpu.scm b/guix/cpu.scm index 45e1abeed7..29ad883584 100644 --- a/guix/cpu.scm +++ b/guix/cpu.scm @@ -32,7 +32,8 @@ cpu-model cpu-flags - cpu->gcc-architecture)) + cpu->gcc-architecture + gcc-architecture->micro-architecture-level)) ;;; Commentary: ;;; @@ -114,19 +115,19 @@ corresponds to CPU, a record as returned by 'current-cpu'." (match (cpu-architecture cpu) ("x86_64" ;; Transcribed from GCC's 'host_detect_local_cpu' in driver-i386.cc. - (or (and (equal? "GenuineIntel" (cpu-vendor cpu)) - (= 6 (cpu-family cpu)) ;the "Pentium Pro" family - (letrec-syntax ((if-flags (syntax-rules (=>) - ((_) - #f) - ((_ (flags ... => name) rest ...) - (if (every (lambda (flag) - (set-contains? (cpu-flags cpu) - flag)) - '(flags ...)) - name - (if-flags rest ...)))))) + (letrec-syntax ((if-flags (syntax-rules (=>) + ((_) + #f) + ((_ (flags ... => name) rest ...) + (if (every (lambda (flag) + (set-contains? (cpu-flags cpu) + flag)) + '(flags ...)) + name + (if-flags rest ...)))))) + (or (and (equal? "GenuineIntel" (cpu-vendor cpu)) + (= 6 (cpu-family cpu)) ;the "Pentium Pro" family (if-flags ("avx" "raoint" => "grandridge") ("avx" "amx_fp16" => "graniterapids") ("avx" "avxvnniint8" => "sierraforest") @@ -152,20 +153,9 @@ corresponds to CPU, a record as returned by 'current-cpu'." ("ssse3" "movbe" => "bonnell") ("ssse3" => "core2") ("longmode" => "x86-64") - ("lm" => "x86-64")))) - - (and (equal? "AuthenticAMD" (cpu-vendor cpu)) - (letrec-syntax ((if-flags (syntax-rules (=>) - ((_) - #f) - ((_ (flags ... => name) rest ...) - (if (every (lambda (flag) - (set-contains? (cpu-flags cpu) - flag)) - '(flags ...)) - name - (if-flags rest ...)))))) + ("lm" => "x86-64"))) + (and (equal? "AuthenticAMD" (cpu-vendor cpu)) (or (and (= 22 (cpu-family cpu)) (if-flags ("movbe" => "btver2"))) (and (= 6 (cpu-family cpu)) @@ -192,42 +182,18 @@ corresponds to CPU, a record as returned by 'current-cpu'." ("lm" => "k8") ("mmx" "3dnow" => "k6-3") ("mmx" => "k6") - (_ => "pentium"))))) + (_ => "pentium")))) - ;; Fallback case for non-Intel processors or for Intel processors not - ;; recognized above. - (letrec-syntax ((if-flags (syntax-rules (=>) - ((_) - #f) - ((_ (flags ... => name) rest ...) - (if (every (lambda (flag) - (set-contains? (cpu-flags cpu) - flag)) - '(flags ...)) - name - (if-flags rest ...)))))) + ;; Fallback case for non-Intel processors or for processors not + ;; recognized above. (if (and (= 7 (cpu-family cpu)) (= #x3b (cpu-model cpu))) "lujiazui" - (if-flags ("avx512" => "knl") - ("adx" => "broadwell") - ("avx2" => "haswell") - ;; TODO: tigerlake, cooperlake, etc. - ("avx" => "sandybridge") - ("sse4_2" "gfni" => "tremont") - ("sse4_2" "sgx" => "goldmont-plus") - ("sse4_2" "xsave" => "goldmont") - ("sse4_2" "movbe" => "silvermont") - ("sse4_2" => "nehalem") - ("ssse3" "movbe" => "bonnell") - ("ssse3" "sse3" "longmode" => "nocona") - ("ssse3" "sse3" "lm" => "nocona") - ("ssse3" "sse3" => "prescott") - ("ssse3" => "core2")))) + (cpu->micro-architecture-level cpu)) ;; TODO: Recognize CENTAUR/CYRIX/NSC? - "x86_64")) + "x86_64"))) ("aarch64" ;; Transcribed from GCC's list of aarch64 processors in aarch64-cores.def ;; What to do with big.LITTLE cores? @@ -285,3 +251,57 @@ corresponds to CPU, a record as returned by 'current-cpu'." (architecture ;; TODO: More architectures architecture))) + +(define (cpu->micro-architecture-level cpu) + "Return a micro-architecture name, suitable for generalized optimizations that +correspond roughly to CPU, a record as returned by 'current-cpu'." + (match (cpu-architecture cpu) + ("x86_64" + (or (letrec-syntax ((if-flags (syntax-rules (=>) + ((_) + #f) + ((_ (flags ... => name) rest ...) + (if (every (lambda (flag) + (set-contains? (cpu-flags cpu) + flag)) + '(flags ...)) + name + (if-flags rest ...)))))) + + (if-flags + ;; https://gitlab.com/x86-psABIs/x86-64-ABI/-/blob/master/x86-64-ABI/low-level-sys-info.tex + ;; v4: AVX512F, AVX512BW, AVX512CD, AVX512DQ, AVX512VL + ;; v3: AVX, AVX2, BMI1, BMI2, F16C, FMA, LZCNT, MOVBE, OSXSAVE + ;; v2: CMPXCHG16B, LAHF, SAHF, POPCNT, SSE3, SSE4.1, SSE4.2, SSSE3 + ("avx512f" "avx512bw" "abx512cd" "abx512dq" "avx512vl" + "avx" "avx2" "bmi1" "bmi2" "f16c" "fma" "movbe" + "popcnt" "sse3" "sse4_1" "sse4_2" "ssse3" => "x86_64-v4") + ("avx" "avx2" "bmi1" "bmi2" "f16c" "fma" "movbe" + "popcnt" "sse3" "sse4_1" "sse4_2" "ssse3" => "x86_64-v3") + ("popcnt" "sse3" "sse4_1" "sse4_2" "ssse3" => "x86_64-v2") + (_ => "x86_64-v1"))) + "x86_64-v1")) + (architecture + ;; TODO: More architectures + architecture))) + +(define (gcc-architecture->micro-architecture-level gcc-architecture) + "Return a matching psABI micro-architecture, allowing optimizations for x86_64 +CPUs for compilers which don't allow for more focused optimizing." + ;; Matching gcc-architectures isn't an easy task, with the rule-of-thumb being + ;; 'Haswell and higher' qualify for x86_64-v3. + ;; https://gitlab.com/x86-psABIs/x86-64-ABI/-/blob/master/x86-64-ABI/low-level-sys-info.tex + (match gcc-architecture + ((or "grandridge" "graniterapids" "sierraforest" "tigerlake" + "sapphirerapids" "cooperlake" "icelake-server" "icelake-client" + "cannonlake" "knm" "knl" "skylake-avx512" "alderlake" "skylake" + "broadwell" "haswell" + "znver4" "znver3" "znver2" "znver1" "bdver4") + "x86_64-v3") + ((or "sandybridge" "tremont" "goldmont-plus" "goldmont" "silvermont" + "nehalem" "bonnell" "core2" + "btver2" "athalon" "k8-sse3" "k8" "bdver3" "bdver2" "bdver1" "btver1" + "amdfam10" + "lujiazui" "x86-64") + "x86_64-v1") + (_ gcc-architecture))) diff --git a/guix/import/cran.scm b/guix/import/cran.scm index 18a1396cf5..59c65f9fa5 100644 --- a/guix/import/cran.scm +++ b/guix/import/cran.scm @@ -431,6 +431,7 @@ empty list when the FIELD cannot be found." ("whoami" "coreutils") ("x11" "libx11") ("xml2" "libxml2") + ("zlib-devel" "zlib") (_ sysname))) (define cran-guix-name (cut guix-name "r-" <>)) diff --git a/guix/scripts/locate.scm b/guix/scripts/locate.scm index aeaffa3d34..79af533fd9 100644 --- a/guix/scripts/locate.scm +++ b/guix/scripts/locate.scm @@ -418,19 +418,24 @@ for each package to insert." (() entries) ((profile . rest) - (let* ((manifest (profile-manifest profile)) - (entries visited - (fold2 (lambda (entry lst visited) - (let ((item (manifest-entry-item entry))) - (if (set-contains? visited item) - (values lst visited) - (values (cons entry lst) - (set-insert item - visited))))) - entries - visited - (manifest-transitive-entries manifest)))) - (loop visited rest entries)))))) + (match (false-if-exception (profile-manifest profile)) + (#f + ;; PROFILE's manifest is unreadable for some reason such as an + ;; unsupported version. + (loop visited rest entries)) + (manifest + (let ((entries visited + (fold2 (lambda (entry lst visited) + (let ((item (manifest-entry-item entry))) + (if (set-contains? visited item) + (values lst visited) + (values (cons entry lst) + (set-insert item + visited))))) + entries + visited + (manifest-transitive-entries manifest)))) + (loop visited rest entries)))))))) (define (insert-manifest-entry db entry) "Insert a manifest ENTRY into DB." diff --git a/guix/scripts/refresh.scm b/guix/scripts/refresh.scm index 9676271542..f5cb18af22 100644 --- a/guix/scripts/refresh.scm +++ b/guix/scripts/refresh.scm @@ -6,7 +6,7 @@ ;;; Copyright © 2016 Ben Woodcroft <donttrustben@gmail.com> ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com> ;;; Copyright © 2018 Efraim Flashner <efraim@flashner.co.il> -;;; Copyright © 2019 Ricardo Wurmus <rekado@elephly.net> +;;; Copyright © 2019, 2023 Ricardo Wurmus <rekado@elephly.net> ;;; Copyright © 2020 Simon Tournier <zimon.toutoune@gmail.com> ;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev> ;;; Copyright © 2022 Hartmut Goebel <h.goebel@crazy-compilers.com> @@ -589,16 +589,27 @@ all are dependent packages: ~{~a~^ ~}~%") (or (assoc-ref opts 'keyring) (string-append (config-directory) "/upstream/trustedkeys.kbx")))) - (for-each - (lambda (update) - (update-package store - (update-spec-package update) - (update-spec-version update) - updaters - #:key-server (%openpgp-key-server) - #:key-download key-download - #:warn? warn?)) - update-specs) + (let* ((spec-line + (compose location->string + package-location + update-spec-package)) + ;; Sort the specs so that we update packages from the + ;; bottom of the file to the top. This way we can be + ;; sure that the package locations are always correct + ;; and never shifted due to previous edits. + (sorted-update-specs + (sort update-specs + (lambda (a b) (string> (spec-line a) (spec-line b)))))) + (for-each + (lambda (update) + (update-package store + (update-spec-package update) + (update-spec-version update) + updaters + #:key-server (%openpgp-key-server) + #:key-download key-download + #:warn? warn?)) + sorted-update-specs)) (return #t))) (else (for-each (cut check-for-package-update <> updaters diff --git a/guix/transformations.scm b/guix/transformations.scm index a289f81219..92d9c89c0e 100644 --- a/guix/transformations.scm +++ b/guix/transformations.scm @@ -2,6 +2,7 @@ ;;; Copyright © 2016-2023 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2021 Marius Bakke <marius@gnu.org> ;;; Copyright © 2023 Sarthak Shah <shahsarthakw@gmail.com> +;;; Copyright © 2023 Efraim Flashner <efraim@flashner.co.il> ;;; ;;; This file is part of GNU Guix. ;;; @@ -32,7 +33,9 @@ #:autoload (guix upstream) (package-latest-release upstream-source-version upstream-source-signature-urls) - #:autoload (guix cpu) (current-cpu cpu->gcc-architecture) + #:autoload (guix cpu) (current-cpu + cpu->gcc-architecture + gcc-architecture->micro-architecture-level) #:use-module (guix utils) #:use-module (guix memoization) #:use-module (guix gexp) @@ -516,7 +519,9 @@ system that builds code for MICRO-ARCHITECTURE; otherwise raise an error." 'compiler-cpu-architectures) p)) (_ #f)) - (bag-build-inputs lowered)))) + (bag-build-inputs lowered))) + (psabi (gcc-architecture->micro-architecture-level + micro-architecture))) (unless compiler (raise (formatted-message (G_ "failed to determine which compiler is used")))) @@ -528,8 +533,11 @@ system that builds code for MICRO-ARCHITECTURE; otherwise raise an error." (G_ "failed to determine whether ~a supports ~a") (package-full-name compiler) micro-architecture))) - (unless (member micro-architecture - (or (assoc-ref lst architecture) '())) + (unless (or (member micro-architecture + (or (assoc-ref lst architecture) '())) + (and (string=? (package-name compiler) "go") + (member psabi + (or (assoc-ref lst architecture) '())))) (raise (make-compound-condition (formatted-message @@ -556,6 +564,27 @@ micro-architectures: (bag (inherit lowered) + (arguments + (substitute-keyword-arguments (bag-arguments lowered) + ;; We add the tuning parameter after the default GO flags are set. + ((#:phases phases '%standard-phases) + #~(modify-phases #$phases + (add-after 'setup-go-environment 'set-microarchitecture + (lambda _ + (cond + ((string-prefix? "arm" #$psabi) + (setenv "GOARM" (string-take-right #$psabi 1)) + (format #t "Setting GOARM to ~s." + (getenv "GOARM"))) + ((string-prefix? "powerpc" #$psabi) + (setenv "GOPPC64" #$psabi) + (format #t "Setting GOPPC64 to ~s." + (getenv "GOPPC64"))) + ((string-prefix? "x86_64" #$psabi) + (setenv "GOAMD" (string-take-right #$psabi 2)) + (format #t "Setting GOAMD to ~s.\n" + (getenv "GOAMD"))) + (else #t)))))))) (build-inputs ;; Arrange so that the compiler wrapper comes first in $PATH. `(("tuning-compiler" ,(tuning-compiler micro-architecture)) |