10/20: commencement: Add bootstrap-mes-rewired-next.

[guix-commits]

janneke pushed a commit to branch wip-arm-bootstrap
in repository guix.

commit 0070fa8d64bcf31448ee2b5817fad5337d17106f
Author: Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
AuthorDate: Tue Dec 15 12:10:06 2020 +0100

    commencement: Add bootstrap-mes-rewired-next.
    
    * gnu/packages/commencement.scm (%bootstrap-mes-rewired-next): New variable.
---
 gnu/packages/commencement.scm | 77 +++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 77 insertions(+)

diff --git a/gnu/packages/commencement.scm b/gnu/packages/commencement.scm
index 272e666..7771ee6 100644
--- a/gnu/packages/commencement.scm
+++ b/gnu/packages/commencement.scm
@@ -380,6 +380,83 @@ $MES -e '(mescc)' module/mescc.scm -- \"$@\"
                          (close guile.mes)))
                      #t))))))
 
+(define %bootstrap-mes-rewired-next
+  (package
+    (inherit mes-next)
+    (name "bootstrap-mes-rewired-next")
+    (source #f)
+    (native-inputs `(("mes" ,%bootstrap-mes)
+                     ("gash" ,gash-boot)))
+    (inputs '())
+    (propagated-inputs '())
+    (outputs '("out"))
+    (build-system trivial-build-system)
+    (arguments
+     `(#:guile ,%bootstrap-guile
+       #:modules ((guix build utils))
+
+       #:builder (begin
+                   (use-modules (guix build utils)
+                                (srfi srfi-26))
+
+                   (let* ((mes (assoc-ref %build-inputs "mes"))
+                          (gash (assoc-ref %build-inputs "gash"))
+                          (mes-bin (string-append mes "/bin"))
+                          (guile (string-append mes-bin "/mes"))
+                          (mes-module (string-append mes "/share/mes/module"))
+                          (out (assoc-ref %outputs "out"))
+                          (bin (string-append out "/bin"))
+                          (mescc (string-append bin "/mescc"))
+                          (module (string-append out "/share/mes/module")))
+                     (define (rewire file)
+                       (substitute* file
+                         ((mes) out)
+                         (("/gnu/store[^ ]+mes-minimal-[^/)}\"]*") out)
+                         (("/gnu/store[^ ]+guile-[^/]*/bin/guile") guile)
+                         (("/gnu/store[^ ]+bash-[^/)}\"]*") gash)))
+
+                     (mkdir-p bin)
+                     (for-each (lambda (file) (install-file file bin))
+                               (find-files mes-bin))
+                     (mkdir-p module)
+                     (copy-recursively (string-append mes-module "/mes")
+                                       (string-append module "/mes"))
+                     (copy-recursively (string-append mes-module "/srfi")
+                                       (string-append module "/srfi"))
+                     (for-each rewire
+                               ;; Cannot easily rewire "mes" because it
+                               ;; contains NUL characters; would require
+                               ;; remove-store-references alike trick
+                               (filter (negate (compose
+                                                (cute member <> '("mes" 
"mes-gcc"))
+                                                basename))
+                                       (find-files bin)))
+                     (rewire (string-append module "/mes/boot-0.scm"))
+
+                     (delete-file mescc)
+                     (with-output-to-file mescc
+                       (lambda _
+                         (display (string-append
+                                   "\
+#! " gash "/bin/sh
+LANG=C
+LC_ALL=C
+export LANG LC_ALL
+
+MES_PREFIX=${MES_REWIRED_PREFIX-" out "/share/mes}
+MES=" bin "/mes
+export MES MES_PREFIX
+
+MES_ARENA=${MES_REWIRED_ARENA-10000000}
+MES_MAX_ARENA=${MES_REWIRED_ARENA-10000000}
+MES_STACK=${MES_REWIRED_STACK-1000000}
+export MES_ARENA MES_MAX_ARENA MES_STACK
+
+$MES -e '(mescc)' module/mescc.scm -- \"$@\"
+"))))
+                     (chmod mescc #o555)
+                     #t))))))
+
 (define mes-boot
   (package
     (inherit mes)