[bug#53895] [PATCH 5/5] WIP: guix: cpu: Add detection for aarch64 CPUs.

[Efraim Flashner]

* guix/cpu.scm (current-cpu): Extend existing implementation to also
read cpuinfo from aarch64 machines.
(cpu->gcc-architecture): Add case for aarch64.
---
 guix/cpu.scm | 70 ++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 70 insertions(+)

diff --git a/guix/cpu.scm b/guix/cpu.scm
index 6d44599822..d4dbd5f6b8 100644
--- a/guix/cpu.scm
+++ b/guix/cpu.scm
@@ -66,25 +66,47 @@ (define (prefix? prefix)
           (match (read-line port)
             ((? eof-object?)
              #f)
+            ;; vendor for x86_64 and i686
             ((? (prefix? "vendor_id") str)
              (match (string-tokenize str)
                (("vendor_id" ":" vendor)
                 (loop vendor family model))))
+            ;; vendor for aarch64 and armhf
+            ((? (prefix? "CPU implementer") str)
+             (match (string-tokenize str)
+               (("CPU" "implementer" ":" vendor)
+                (loop vendor family model))))
+            ;; family for x86_64 and i686
             ((? (prefix? "cpu family") str)
              (match (string-tokenize str)
                (("cpu" "family" ":" family)
                 (loop vendor (string->number family) model))))
+            ;; model for x86_64 and i686
             ((? (prefix? "model") str)
              (match (string-tokenize str)
                (("model" ":" model)
                 (loop vendor family (string->number model)))
                (_
                 (loop vendor family model))))
+            ;; model for aarch64 and armhf
+            ((? (prefix? "CPU part") str)
+             (match (string-tokenize str)
+               (("CPU" "part" ":" model)
+                (loop vendor family (string->number (string-append "#x" 
(string-drop model 2)))))
+               (_
+                (loop vendor family model))))
+            ;; flags for x86_64 and i686
             ((? (prefix? "flags") str)
              (match (string-tokenize str)
                (("flags" ":" flags ...)
                 (cpu (utsname:machine (uname))
                      vendor family model (list->set flags)))))
+            ;; flags for aarch64 and armhf
+            ((? (prefix? "Features") str)
+             (match (string-tokenize str)
+               (("Features" ":" flags ...)
+                (cpu (utsname:machine (uname))
+                     vendor family model (list->set flags)))))
             (_
              (loop vendor family model))))))))
 
@@ -192,6 +214,54 @@ (define (cpu->gcc-architecture cpu)
          ;; TODO: Recognize CENTAUR/CYRIX/NSC?
 
          "x86_64"))
+    ("aarch64"
+     (pk (cpu-architecture cpu)(cpu-vendor cpu)(cpu-family cpu) (cpu-model 
cpu)(cpu-flags cpu))
+     ;; Currently returns ("aarch64" #f #f #f #<<set> vhash: #<vhash 329666c0 
9 pairs> insert: #<procedure %insert (t-5ce36f5c768e728-317 
t-5ce36f5c768e728-319)> ref: #<procedure vhash-assoc (key vhash #:optional 
equal? hash)>>)
+     ;; Transcribed from GCC's list of aarch64 processors in aarch64-cores.def
+     (match (cpu-vendor cpu)
+       ("0x41"
+        (match (cpu-model cpu)
+          ((or #xd02 #xd04 #xd03 #xd07 #xd08 #xd09)
+           "armv8-a")
+          ((or #xd05 #xd0a #xd0b #xd0e #xd0d #xd41 #xd42 #xd4b #xd46 #xd43 
#xd44 #xd41 #xd0c #xd4a)
+           "armv8.2-a")
+          (#xd40
+           "armv8.4-a")
+          (#xd15
+           "armv8-r")
+          ((or #xd46 #xd47 #xd48)
+           "armv9-a")))
+       ("0x42"
+        "armv8.1-a")
+       ("0x43"
+        (match (cpu-model cpu)
+          ((or #x0a0 #x0a1 #x0a2 #x0a3)
+           "armv8-a")
+          ((or #x0b0 #x0b1 #x0b2 #x0b3 #x0b4 #x0b5)
+           "armv8.2-a")
+          (#x0b8
+           "armv8.3-a")))
+       ("0x46"
+        "armv8.2-a")
+       ("0x48"
+        "armv8.2-a")
+       ("0x50"
+        "armv8-a")
+       ("0x51"
+        (match (cpu-model cpu)
+          (#xC00
+           "armv8-a")
+          (#x516
+           "armv8.1-a")
+          (#xC01
+           "armv8.4-a")))
+       ("0x53"
+        "armv8-a")
+       ("0x68"
+        "armv8-a")
+       (_
+        "armv8-a"))
+     "armv8-a")
     (architecture
      ;; TODO: AArch64.
      architecture)))
-- 
2.34.0