aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2021-12-03 22:20:25 +0100
committerLudovic Courtès <ludo@gnu.org>2022-01-01 15:23:24 +0100
commita644f88d28ff9914cd3147ea085804f230acf499 (patch)
tree73c4a0b0305bbc65dfbb03ecfe2183b4ffff514b
parentf39d594e88c32dbd2d3660d66899b6215817b654 (diff)
downloadguix-a644f88d28ff9914cd3147ea085804f230acf499.tar.gz
guix-a644f88d28ff9914cd3147ea085804f230acf499.zip
Add (guix cpu).
* guix/cpu.scm: New file. * Makefile.am (MODULES): Add it.
-rw-r--r--Makefile.am1
-rw-r--r--guix/cpu.scm143
2 files changed, 144 insertions, 0 deletions
diff --git a/Makefile.am b/Makefile.am
index 8c5682a1c6..3f06ef8991 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -81,6 +81,7 @@ MODULES = \
guix/base64.scm \
guix/ci.scm \
guix/cpio.scm \
+ guix/cpu.scm \
guix/deprecation.scm \
guix/docker.scm \
guix/records.scm \
diff --git a/guix/cpu.scm b/guix/cpu.scm
new file mode 100644
index 0000000000..e1911f52a8
--- /dev/null
+++ b/guix/cpu.scm
@@ -0,0 +1,143 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2021 Ludovic Courtès <ludo@gnu.org>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (guix cpu)
+ #:use-module (guix sets)
+ #:use-module (guix memoization)
+ #:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-9)
+ #:use-module (ice-9 match)
+ #:use-module (ice-9 rdelim)
+ #:export (current-cpu
+ cpu?
+ cpu-architecture
+ cpu-family
+ cpu-model
+ cpu-flags
+
+ cpu->gcc-architecture))
+
+;;; Commentary:
+;;;
+;;; This module provides tools to determine the micro-architecture supported
+;;; by the CPU and to map it to a name known to GCC's '-march'.
+;;;
+;;; Code:
+
+;; CPU description.
+(define-record-type <cpu>
+ (cpu architecture family model flags)
+ cpu?
+ (architecture cpu-architecture) ;string, from 'uname'
+ (family cpu-family) ;integer
+ (model cpu-model) ;integer
+ (flags cpu-flags)) ;set of strings
+
+(define current-cpu
+ (mlambda ()
+ "Return a <cpu> record representing the host CPU."
+ (define (prefix? prefix)
+ (lambda (str)
+ (string-prefix? prefix str)))
+
+ (call-with-input-file "/proc/cpuinfo"
+ (lambda (port)
+ (let loop ((family #f)
+ (model #f))
+ (match (read-line port)
+ ((? eof-object?)
+ #f)
+ ((? (prefix? "cpu family") str)
+ (match (string-tokenize str)
+ (("cpu" "family" ":" family)
+ (loop (string->number family) model))))
+ ((? (prefix? "model") str)
+ (match (string-tokenize str)
+ (("model" ":" model)
+ (loop family (string->number model)))
+ (_
+ (loop family model))))
+ ((? (prefix? "flags") str)
+ (match (string-tokenize str)
+ (("flags" ":" flags ...)
+ (cpu (utsname:machine (uname))
+ family model (list->set flags)))))
+ (_
+ (loop family model))))))))
+
+(define (cpu->gcc-architecture cpu)
+ "Return the architecture name, suitable for GCC's '-march' flag, that
+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.c.
+ (or (and (= 6 (cpu-family cpu)) ;the "Pentium Pro" family
+ (letrec-syntax ((model (syntax-rules (=>)
+ ((_) #f)
+ ((_ (candidate => integers ...) rest
+ ...)
+ (or (and (= (cpu-model cpu) integers)
+ candidate)
+ ...
+ (model rest ...))))))
+ (model ("bonnel" => #x1c #x26)
+ ("silvermont" => #x37 #x4a #x4d #x5a #x5d)
+ ("core2" => #x0f #x17 #x1d)
+ ("nehalem" => #x1a #x1e #x1f #x2e)
+ ("westmere" => #x25 #x2c #x2f)
+ ("sandybridge" => #x2a #x2d)
+ ("ivybridge" => #x3a #x3e)
+ ("haswell" => #x3c #x3f #x45 #x46)
+ ("broadwell" => #x3d #x47 #x4f #x56)
+ ("skylake" => #x4e #x5e #x8e #x9e)
+ ("skylake-avx512" => #x55) ;TODO: cascadelake
+ ("knl" => #x57)
+ ("cannonlake" => #x66)
+ ("knm" => #x85))))
+
+ ;; 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 ...))))))
+ (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" => "core2")))
+
+ ;; TODO: Recognize AMD models (bdver*, znver*, etc.)?
+
+ "x86_64"))
+ (architecture
+ ;; TODO: AArch64.
+ architecture)))