Re: bug#26339: closing bootloader serie.

Re: bug#26339: closing bootloader serie.

[Mathieu Othacehe]

> Does that make sense?

Yes, it is now much clearer, thank you !

My qemu virtualized ARM machine has been compiling for a week now
(is it normal to have so few substitutes btw ?) and is not over yet.

So, I'm really interested by the --target on guix system. Do you happend
to have a draft of your experiments :) ?

Mathieu

Re: bug#26339: closing bootloader serie.

[Ludovic Courtès]

[-- Attachment #1: Type: text/plain, Size: 1090 bytes --]

Hi,

Mathieu Othacehe <m.othacehe@gmail.com> skribis:

>> Does that make sense?
>
> Yes, it is now much clearer, thank you !
>
> My qemu virtualized ARM machine has been compiling for a week now
> (is it normal to have so few substitutes btw ?) and is not over yet.

It’s not normal to have so few substitutes.  ARM substitutes are always
lagging behind on our build farm, but hopefully we’ll get additional
ARM build machines soon.

> So, I'm really interested by the --target on guix system. Do you happend
> to have a draft of your experiments :) ?

Here’s a very crude patch that mixes a couple of experiments, i hope it
can be of any use to you.  :-)

For a start, I could polish the ‘let-system’ and ‘with-system’ patches,
if you want.

My idea was to eventually have a Shepherd service whose ‘start’ method
would be something like:

  (virtual-machine
    (with-system (target "arm-linux-gnueabihf")
      (operating-system
        …)))

IOW, a service that starts a GuixSD VM for another architecture.

Thoughts?

Ludo’.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: Type: text/x-patch, Size: 12056 bytes --]

Unstaged
modified   .dir-locals.el
@@ -72,6 +72,7 @@
    (eval . (put 'run-with-state 'scheme-indent-function 1))
    (eval . (put 'wrap-program 'scheme-indent-function 1))
    (eval . (put 'with-imported-modules 'scheme-indent-function 1))
+   (eval . (put 'let-system 'scheme-indent-function 1))
 
    (eval . (put 'call-with-container 'scheme-indent-function 1))
    (eval . (put 'container-excursion 'scheme-indent-function 1))
modified   gnu/services.scm
@@ -25,7 +25,8 @@
   #:use-module (guix profiles)
   #:use-module (guix sets)
   #:use-module (guix ui)
-  #:use-module ((guix utils) #:select (source-properties->location))
+  #:use-module ((guix utils) #:select (%current-target-system
+                                       source-properties->location))
   #:use-module (guix modules)
   #:use-module (gnu packages base)
   #:use-module (gnu packages bash)
@@ -265,6 +266,7 @@ This is a shorthand for (map (lambda (svc) ...) %base-services)."
 (define (system-derivation mentries mextensions)
   "Return as a monadic value the derivation of the 'system' directory
 containing the given entries."
+  (pk 'sysdrv (%current-target-system))
   (mlet %store-monad ((entries    mentries)
                       (extensions (sequence %store-monad mextensions)))
     (lower-object
modified   guix/gexp.scm
@@ -32,6 +32,7 @@
   #:export (gexp
             gexp?
             with-imported-modules
+            let-system
 
             gexp-input
             gexp-input?
@@ -167,7 +168,9 @@ returns its output file name of OBJ's OUTPUT."
     ((? derivation? drv)
      (derivation->output-path drv output))
     ((? string? file)
-     file)))
+     file)
+    (#f
+     thing)))
 
 (define (register-compiler! compiler)
   "Register COMPILER as a gexp compiler."
@@ -234,6 +237,51 @@ The expander specifies how an object is converted to its sexp representation."
     (return drv)))
 
 \f
+;;;
+;;; System dependencies.
+;;;
+
+;; Binding form for the current system and cross-compilation target.
+(define-record-type <system-binding>
+  (system-binding proc)
+  system-binding?
+  (proc system-binding-proc))
+
+(define-syntax let-system
+  (syntax-rules ()
+    "Introduce a system binding in a gexp.  The simplest form is:
+
+  (let-system system
+    (cond ((string=? system \"x86_64-linux\") ...)
+          (else ...)))
+
+which binds SYSTEM to the currently targeted system.  The second form is
+similar, but it also shows the cross-compilation target:
+
+  (let-system (system target)
+    ...)
+
+Here TARGET is bound to the cross-compilation triplet or #f."
+    ((_ (system target) exp0 exp ...)
+     (system-binding (lambda (system target)
+                       exp0 exp ...)))
+    ((_ system exp0 exp ...)
+     (system-binding (lambda (system target)
+                       exp0 exp ...)))))
+
+(define-gexp-compiler (system-binding-compiler (binding <system-binding>)
+                                               system target)
+  (match binding
+    (($ <system-binding> proc)
+     (let ((obj (proc system target)))
+       (match (and (struct? obj) (lookup-compiler obj))
+         (#f
+          (with-monad %store-monad
+            (return obj)))
+         (lower
+          (lower obj system #:target target)))))))
+
+\f
 ;;;
 ;;; File declarations.
 ;;;
@@ -485,14 +533,16 @@ corresponding input list as a monadic value.  When TARGET is true, use it as
 the cross-compilation target triplet."
   (with-monad %store-monad
     (sequence %store-monad
-              (map (match-lambda
-                     (((? struct? thing) sub-drv ...)
-                      (mlet %store-monad ((drv (lower-object
-                                                thing system #:target target)))
-                        (return `(,drv ,@sub-drv))))
-                     (input
-                      (return input)))
-                   inputs))))
+              (filter-map (match-lambda
+                            (((? struct? thing) sub-drv ...)
+                             (mlet %store-monad ((drv (lower-object
+                                                       thing system #:target target)))
+                               (if drv
+                                   (return `(,drv ,@sub-drv))
+                                   (return #f))))
+                            (input
+                             (return input)))
+                          inputs))))
 
 (define* (lower-reference-graphs graphs #:key system target)
   "Given GRAPHS, a list of (FILE-NAME INPUT ...) lists for use as a
@@ -817,6 +867,51 @@ environment."
                          (identifier-syntax modules)))
     body ...))
 
+;; (define-syntax alpha-rename
+;;   (syntax-rules (lambda begin)
+;;     ((_ (lambda (bindings ...) body ...) (env ...))
+;;      (lambda (y ...)
+;;        (alpha-rename (begin body ...)
+;;                      ((bindings ...) env ...))))
+;;     ((_ (begin exp ...) (env ...))
+;;      (begin (alpha-rename exp (env ...)) ...))
+;;     ((_ id (env ...))
+;;      (letrec-syntax ((lookup (syntax-rules (id)
+;;                                ((_ ((id alpha) _ (... ...)))
+;;                                 alpha)
+;;                                ((_ (_ rest (... ...)))
+;;                                 (lookup (rest (... ...))))
+;;                                ((_ ())
+;;                                 id))))
+;;        (lookup (env ...))))))
+
+(define-syntax alpha-rename
+  (lambda (s)
+    (syntax-case s (lambda begin)
+      ((_ (lambda (bindings ...) body ...) (env ...))
+       (with-syntax (((formals ...)
+                      (generate-temporaries #'(bindings ...))))
+         #'(lambda (formals ...)
+             (alpha-rename (begin body ...)
+                           (((bindings formals) ...) env ...)))))
+      ((_ (begin exp ...) (env ...))
+       #'(begin (alpha-rename exp (env ...)) ...))
+      ((_ (proc arg ...) (env ...))
+       #'((alpha-rename proc (env ...))
+          (alpha-rename arg (env ...))
+          ...))
+      ((_ id (env ...))
+       (identifier? (pk #'(env ...) #'id))
+       #'(letrec-syntax ((lookup (syntax-rules (id)
+                                   ((_ ((id alpha) _ (... ...)))
+                                    alpha)
+                                   ((_ (_ rest (... ...)))
+                                    (lookup (rest (... ...))))
+                                   ((_ ())
+                                    id))))
+           (lookup (env ...)))))))
+
+
 (define-syntax gexp
   (lambda (s)
     (define (collect-escapes exp)
modified   guix/profiles.scm
@@ -1211,7 +1211,8 @@ the entries in MANIFEST."
                              (hooks %default-profile-hooks)
                              (locales? #t)
                              (allow-collisions? #f)
-                             system target)
+                             system
+                             (target (%current-target-system)))
   "Return a derivation that builds a profile (aka. 'user environment') with
 the given MANIFEST.  The profile includes additional derivations returned by
 the monadic procedures listed in HOOKS--such as an Info 'dir' file, etc.
modified   guix/scripts/system.scm
@@ -931,7 +931,8 @@ resulting from command-line parsing."
                              #:install-bootloader? bootloader?
                              #:target target #:device device
                              #:gc-root (assoc-ref opts 'gc-root)))))
-        #:system system))))
+        #:system system
+        #:target "arm-linux-gnueabihf"))))
 
 (define (process-command command args opts)
   "Process COMMAND, one of the 'guix system' sub-commands.  ARGS is its
@@ -1010,15 +1011,15 @@ argument list and OPTS is the option alist."
            (fail))))
       args))
 
-  (with-error-handling
-    (let* ((opts     (parse-command-line args %options
-                                         (list %default-options)
-                                         #:argument-handler
-                                         parse-sub-command))
-           (args     (option-arguments opts))
-           (command  (assoc-ref opts 'action)))
-      (parameterize ((%graft? (assoc-ref opts 'graft?)))
-        (process-command command args opts)))))
+  (let* ((opts     (parse-command-line args %options
+                                       (list %default-options)
+                                       #:argument-handler
+                                       parse-sub-command))
+         (args     (option-arguments opts))
+         (command  (assoc-ref opts 'action)))
+    (parameterize ((%graft? (assoc-ref opts 'graft?))
+                   (%current-target-system "arm-linux-gnueabihf"))
+      (process-command command args opts))))
 
 ;;; Local Variables:
 ;;; eval: (put 'call-with-service-upgrade-info 'scheme-indent-function 1)
modified   guix/store.scm
@@ -1136,18 +1136,24 @@ topological order."
   boolean)
 
 (define substitutable-paths
-  (operation (query-substitutable-paths (store-path-list paths))
-             "Return the subset of PATHS that is substitutable."
-             store-path-list))
+  (let ((proc (operation (query-substitutable-paths (store-path-list paths))
+                         "Return the subset of PATHS that is substitutable."
+                         store-path-list)))
+    (lambda (store lst)
+      (pk 's-p lst)
+      (proc store lst))))
 
 (define substitutable-path-info
-  (operation (query-substitutable-path-infos (store-path-list paths))
-             "Return information about the subset of PATHS that is
+  (let ((proc (operation (query-substitutable-path-infos (store-path-list paths))
+                         "Return information about the subset of PATHS that is
 substitutable.  For each substitutable path, a `substitutable?' object is
 returned; thus, the resulting list can be shorter than PATHS.  Furthermore,
 that there is no guarantee that the order of the resulting list matches the
 order of PATHS."
-             substitutable-path-list))
+                         substitutable-path-list)))
+    (lambda (store lst)
+      (pk 'subst-p-i lst)
+      (proc store lst))))
 
 (define built-in-builders
   (let ((builders (operation (built-in-builders)
@@ -1428,7 +1434,8 @@ where FILE is the entry's absolute file name and STAT is the result of
 (define* (run-with-store store mval
                          #:key
                          (guile-for-build (%guile-for-build))
-                         (system (%current-system)))
+                         (system (%current-system))
+                         target)
   "Run MVAL, a monadic value in the store monad, in STORE, an open store
 connection, and return the result."
   ;; Initialize the dynamic bindings here to avoid bad surprises.  The
@@ -1436,7 +1443,7 @@ connection, and return the result."
   ;; bind-time and not at call time, which can be disconcerting.
   (parameterize ((%guile-for-build guile-for-build)
                  (%current-system system)
-                 (%current-target-system #f))
+                 (%current-target-system target))
     (call-with-values (lambda ()
                         (run-with-state mval store))
       (lambda (result store)
modified   tests/gexp.scm
@@ -258,6 +258,23 @@
            (((thing "out"))
             (eq? thing file))))))
 
+(test-assert "let-system"
+  (list `(begin ,(%current-system) #t) '() '())
+  (let ((exp  #~(begin
+                  #$(let-system system system)
+                  #t)))
+    (list (gexp->sexp* exp)
+          (gexp-inputs exp)
+          (gexp-native-inputs exp))))
+
+(test-assert "let-system, target"
+  (list `(begin ,(%current-system) #t))
+  (let ((exp #~(list #$@(let-system (system target)
+                          (list system target)))))
+    (list (gexp->sexp* exp)
+          (gexp-inputs exp)
+          (gexp-native-inputs exp))))
+
 (test-assert "ungexp + ungexp-native"
   (let* ((exp    (gexp (list (ungexp-native %bootstrap-guile)
                              (ungexp coreutils)

GuixSD on armhf.

[Mathieu Othacehe]

Hi Ludo,

> IOW, a service that starts a GuixSD VM for another architecture.
>
> Thoughts?

Thanks for this patch ! For now I'm still trying to build a GuixSD image
directly on an armhf system.

About that, i made some progress, but i'm now stuck on
"load-in-linux-vm" part of system generation. This part is starting a
qemu machine, inside the qemu machine i'm using for this dev. It takes
about half an hour, just to boot !

Does anyone know how could I speed this up, by buying or renting a
powerful arm machine ? by skipping somehow load-in-linux-vm part ?

Thanks,

Mathieu

Re: GuixSD on armhf.

[Chris Marusich]

[-- Attachment #1: Type: text/plain, Size: 1116 bytes --]

Mathieu Othacehe <m.othacehe@gmail.com> writes:

> Hi Ludo,
>
>> IOW, a service that starts a GuixSD VM for another architecture.
>>
>> Thoughts?
>
> Thanks for this patch ! For now I'm still trying to build a GuixSD image
> directly on an armhf system.
>
> About that, i made some progress, but i'm now stuck on
> "load-in-linux-vm" part of system generation. This part is starting a
> qemu machine, inside the qemu machine i'm using for this dev. It takes
> about half an hour, just to boot !
>
> Does anyone know how could I speed this up, by buying or renting a
> powerful arm machine ? by skipping somehow load-in-linux-vm part ?
>
> Thanks,
>
> Mathieu

I may be totally out of context here, but I'll just mention that we
apparently have some procedures for running builders in "containers"
rather than a qemu virtual machine.  Perhaps you can avoid one of those
load-in-linux-vm calls by running something in a container instead.

Check out:

    guix/gnu/build/linux-container.scm
    guix/gnu/system/linux-container.scm

You might find something you can use.

-- 
Chris

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 832 bytes --]

Re: GuixSD on armhf.

[Ludovic Courtès]

Heya,

Mathieu Othacehe <m.othacehe@gmail.com> skribis:

>> IOW, a service that starts a GuixSD VM for another architecture.
>>
>> Thoughts?
>
> Thanks for this patch ! For now I'm still trying to build a GuixSD image
> directly on an armhf system.
>
> About that, i made some progress, but i'm now stuck on
> "load-in-linux-vm" part of system generation. This part is starting a
> qemu machine, inside the qemu machine i'm using for this dev. It takes
> about half an hour, just to boot !

Perhaps you’ll need real hardware, though I don’t know whether the cheap
SoCs are much faster than QEMU on x86_64.  :-)

I just got an Olimex A20 OLinuXino and I’d like to have it run GuixSD at
some point!

Ludo’.