[bug#40908] [PATCH core-updates 0/5] Use Guile 3.0 in the initrd

[bug#40908] [PATCH core-updates 0/5] Use Guile 3.0 in the initrd

[Marius Bakke]

Guix,

These patches changes the initrd to use Guile 3.0.  By default it uses
%GUILE-STATIC-STRIPPED from (gnu packages make-bootstrap), which on the
core-updates branch refers to Guile 2.0.

It is suboptimal to define this new static Guile variant straight in
(gnu system linux-initrd), but adding it to (gnu packages guile) would
cause a cyclic module reference with (gnu packages make-bootstrap).

WDYT?

Marius Bakke (5):
  gnu: %guile-static: Rewrite in terms of 'make-guile-static'.
  gnu: %guile-static-stripped: Rewrite in terms of
    'make-guile-static-stripped'.
  gnu: make-bootstrap: Export MAKE-GUILE-STATIC and
    MAKE-GUILE-STATIC-STRIPPED.
  linux-initrd: Use Guile 3.0.
  gnu: make-bootstrap: Do not export %GUILE-STATIC-STRIPPED.

 gnu/local.mk                                  |   7 +-
 gnu/packages/make-bootstrap.scm               | 161 ++++----
 .../patches/guile-2.2-default-utf8.patch      |  82 ++++
 .../patches/guile-3.0-linux-syscalls.patch    | 353 ++++++++++++++++++
 .../patches/guile-3.0-relocatable.patch       |  79 ++++
 gnu/system/linux-initrd.scm                   |  10 +-
 6 files changed, 611 insertions(+), 81 deletions(-)
 create mode 100644 gnu/packages/patches/guile-2.2-default-utf8.patch
 create mode 100644 gnu/packages/patches/guile-3.0-linux-syscalls.patch
 create mode 100644 gnu/packages/patches/guile-3.0-relocatable.patch

-- 
2.26.2

[bug#40908] [PATCH core-updates 1/5] gnu: %guile-static: Rewrite in terms of 'make-guile-static'.

[Marius Bakke]

The derivation remains unchanged.

* gnu/packages/make-bootstrap.scm (make-guile-static): New procedure.
(%guile-static): Adjust accordingly.
---
 gnu/packages/make-bootstrap.scm | 124 ++++++++++++++++----------------
 1 file changed, 64 insertions(+), 60 deletions(-)

diff --git a/gnu/packages/make-bootstrap.scm b/gnu/packages/make-bootstrap.scm
index 5716ed3886..f4d7fd6a2a 100644
--- a/gnu/packages/make-bootstrap.scm
+++ b/gnu/packages/make-bootstrap.scm
@@ -676,70 +676,74 @@ for `sh' in $PATH, and without nscd, and with static NSS modules."
            #t))))
     (inputs `(("mes" ,%mes-minimal)))))
 
+(define* (make-guile-static guile patches)
+  (package-with-relocatable-glibc
+   (static-package
+    (package
+      (inherit guile)
+      (source
+       (origin (inherit (package-source guile))
+               (patches (append (map search-patch patches)
+                                (origin-patches (package-source guile))))))
+      (name (string-append (package-name guile) "-static"))
+      (synopsis "Statically-linked and relocatable Guile")
+
+      ;; Remove the 'debug' output (see above for the reason.)
+      (outputs (delete "debug" (package-outputs guile)))
+
+      (inputs
+       `(("libunistring:static" ,libunistring "static")
+         ,@(package-inputs guile)))
+
+      (propagated-inputs
+       `(("bdw-gc" ,libgc/static-libs)
+         ,@(alist-delete "bdw-gc"
+                         (package-propagated-inputs guile))))
+      (arguments
+       (substitute-keyword-arguments (package-arguments guile)
+         ((#:configure-flags flags '())
+          ;; When `configure' checks for ltdl availability, it
+          ;; doesn't try to link using libtool, and thus fails
+          ;; because of a missing -ldl.  Work around that.
+          ''("LDFLAGS=-ldl"))
+         ((#:phases phases '%standard-phases)
+          `(modify-phases ,phases
+
+             ;; Do not record the absolute file name of 'sh' in
+             ;; (ice-9 popen).  This makes 'open-pipe' unusable in
+             ;; a build chroot ('open-pipe*' is fine) but avoids
+             ;; keeping a reference to Bash.
+             (delete 'pre-configure)
+
+             (add-before 'configure 'static-guile
+               (lambda _
+                 (substitute* "libguile/Makefile.in"
+                   ;; Create a statically-linked `guile'
+                   ;; executable.
+                   (("^guile_LDFLAGS =")
+                    "guile_LDFLAGS = -all-static")
+
+                   ;; Add `-ldl' *after* libguile-2.0.la.
+                   (("^guile_LDADD =(.*)$" _ ldadd)
+                    (string-append "guile_LDADD = "
+                                   (string-trim-right ldadd)
+                                   " -ldl\n")))))))
+         ((#:tests? _ #f)
+          ;; There are uses of `dynamic-link' in
+          ;; {foreign,coverage}.test that don't fly here.
+          #f)
+         ((#:parallel-build? _ #f)
+          ;; Work around the fact that the Guile build system is
+          ;; not deterministic when parallel-build is enabled.
+          #f)))))))
+
 (define %guile-static
   ;; A statically-linked Guile that is relocatable--i.e., it can search
   ;; .scm and .go files relative to its installation directory, rather
   ;; than in hard-coded configure-time paths.
-  (let* ((patches (cons* (search-patch "guile-relocatable.patch")
-                         (search-patch "guile-default-utf8.patch")
-                         (search-patch "guile-linux-syscalls.patch")
-                         (origin-patches (package-source guile-2.0))))
-         (source  (origin (inherit (package-source guile-2.0))
-                    (patches patches)))
-         (guile (package (inherit guile-2.0)
-                  (name (string-append (package-name guile-2.0) "-static"))
-                  (source source)
-                  (synopsis "Statically-linked and relocatable Guile")
-
-                  ;; Remove the 'debug' output (see above for the reason.)
-                  (outputs (delete "debug" (package-outputs guile-2.0)))
-
-                  (inputs
-                   `(("libunistring:static" ,libunistring "static")
-                     ,@(package-inputs guile-2.2)))
-
-                  (propagated-inputs
-                   `(("bdw-gc" ,libgc/static-libs)
-                     ,@(alist-delete "bdw-gc"
-                                     (package-propagated-inputs guile-2.0))))
-                  (arguments
-                   (substitute-keyword-arguments (package-arguments guile-2.0)
-                     ((#:configure-flags flags '())
-                      ;; When `configure' checks for ltdl availability, it
-                      ;; doesn't try to link using libtool, and thus fails
-                      ;; because of a missing -ldl.  Work around that.
-                      ''("LDFLAGS=-ldl"))
-                     ((#:phases phases '%standard-phases)
-                      `(modify-phases ,phases
-
-                         ;; Do not record the absolute file name of 'sh' in
-                         ;; (ice-9 popen).  This makes 'open-pipe' unusable in
-                         ;; a build chroot ('open-pipe*' is fine) but avoids
-                         ;; keeping a reference to Bash.
-                         (delete 'pre-configure)
-
-                         (add-before 'configure 'static-guile
-                           (lambda _
-                             (substitute* "libguile/Makefile.in"
-                               ;; Create a statically-linked `guile'
-                               ;; executable.
-                               (("^guile_LDFLAGS =")
-                                "guile_LDFLAGS = -all-static")
-
-                               ;; Add `-ldl' *after* libguile-2.0.la.
-                               (("^guile_LDADD =(.*)$" _ ldadd)
-                                (string-append "guile_LDADD = "
-                                               (string-trim-right ldadd)
-                                               " -ldl\n")))))))
-                     ((#:tests? _ #f)
-                      ;; There are uses of `dynamic-link' in
-                      ;; {foreign,coverage}.test that don't fly here.
-                      #f)
-                     ((#:parallel-build? _ #f)
-                      ;; Work around the fact that the Guile build system is
-                      ;; not deterministic when parallel-build is enabled.
-                      #f))))))
-    (package-with-relocatable-glibc (static-package guile))))
+  (make-guile-static guile-2.0 '("guile-relocatable.patch"
+                                 "guile-default-utf8.patch"
+                                 "guile-linux-syscalls.patch")))
 
 (define %guile-static-stripped
   ;; A stripped static Guile binary, for use during bootstrap.
-- 
2.26.2

[bug#40908] [PATCH core-updates 2/5] gnu: %guile-static-stripped: Rewrite in terms of 'make-guile-static-stripped'.

[Marius Bakke]

The derivation changes slightly, but the end result is bit-identical.

* gnu/packages/make-bootstrap.scm (make-guile-static-stripped): New procedure.
(%guile-static-stripped): Adjust accordingly.
---
 gnu/packages/make-bootstrap.scm | 28 ++++++++++++++++------------
 1 file changed, 16 insertions(+), 12 deletions(-)

diff --git a/gnu/packages/make-bootstrap.scm b/gnu/packages/make-bootstrap.scm
index f4d7fd6a2a..d336818299 100644
--- a/gnu/packages/make-bootstrap.scm
+++ b/gnu/packages/make-bootstrap.scm
@@ -745,30 +745,30 @@ for `sh' in $PATH, and without nscd, and with static NSS modules."
                                  "guile-default-utf8.patch"
                                  "guile-linux-syscalls.patch")))
 
-(define %guile-static-stripped
-  ;; A stripped static Guile binary, for use during bootstrap.
-  (package (inherit %guile-static)
-    (name "guile-static-stripped")
+(define* (make-guile-static-stripped static-guile)
+  (package
+    (inherit static-guile)
+    (name (string-append (package-name static-guile) "-stripped"))
     (build-system trivial-build-system)
     (arguments
      ;; The end result should depend on nothing but itself.
      `(#:allowed-references ("out")
        #:modules ((guix build utils))
        #:builder
-       (let ()
+       (let ((version ,(version-major+minor (package-version static-guile))))
          (use-modules (guix build utils))
 
          (let* ((in     (assoc-ref %build-inputs "guile"))
                 (out    (assoc-ref %outputs "out"))
                 (guile1 (string-append in "/bin/guile"))
                 (guile2 (string-append out "/bin/guile")))
-           (mkdir-p (string-append out "/share/guile/2.0"))
-           (copy-recursively (string-append in "/share/guile/2.0")
-                             (string-append out "/share/guile/2.0"))
+           (mkdir-p (string-append out "/share/guile/" version))
+           (copy-recursively (string-append in "/share/guile/" version)
+                             (string-append out "/share/guile/" version))
 
-           (mkdir-p (string-append out "/lib/guile/2.0/ccache"))
-           (copy-recursively (string-append in "/lib/guile/2.0/ccache")
-                             (string-append out "/lib/guile/2.0/ccache"))
+           (mkdir-p (string-append out "/lib/guile/" version "/ccache"))
+           (copy-recursively (string-append in "/lib/guile/" version "/ccache")
+                             (string-append out "/lib/guile/" version "/ccache"))
 
            (mkdir (string-append out "/bin"))
            (copy-file guile1 guile2)
@@ -789,10 +789,14 @@ for `sh' in $PATH, and without nscd, and with static NSS modules."
                  '((invoke guile2 "--version")))
 
            #t))))
-    (inputs `(("guile" ,%guile-static)))
+    (inputs `(("guile" ,static-guile)))
     (outputs '("out"))
     (synopsis "Minimal statically-linked and relocatable Guile")))
 
+(define %guile-static-stripped
+  ;; A stripped static Guile binary, for use during bootstrap.
+  (make-guile-static-stripped %guile-static))
+
 (define (tarball-package pkg)
   "Return a package containing a tarball of PKG."
   (package (inherit pkg)
-- 
2.26.2

[bug#40908] [PATCH core-updates 3/5] gnu: make-bootstrap: Export MAKE-GUILE-STATIC and MAKE-GUILE-STATIC-STRIPPED.

[Marius Bakke]

* gnu/packages/make-bootstrap.scm (make-guile-static,
make-guile-static-stripped): Export.
---
 gnu/packages/make-bootstrap.scm | 5 ++++-
 1 file changed, 4 insertions(+), 1 deletion(-)

diff --git a/gnu/packages/make-bootstrap.scm b/gnu/packages/make-bootstrap.scm
index d336818299..443e778824 100644
--- a/gnu/packages/make-bootstrap.scm
+++ b/gnu/packages/make-bootstrap.scm
@@ -45,7 +45,10 @@
   #:use-module (gnu packages multiprecision)
   #:use-module (ice-9 match)
   #:use-module (srfi srfi-1)
-  #:export (%bootstrap-binaries-tarball
+  #:export (make-guile-static
+            make-guile-static-stripped
+
+            %bootstrap-binaries-tarball
             %linux-libre-headers-bootstrap-tarball
             %binutils-bootstrap-tarball
             %glibc-bootstrap-tarball
-- 
2.26.2

[bug#40908] [PATCH core-updates 4/5] linux-initrd: Use Guile 3.0.

[Marius Bakke]

* gnu/packages/patches/guile-2.2-default-utf8.patch: New file, extracted from
commit 2acfe022a740f79b593348cc6362cc4ee8f33bb4.
* gnu/packages/patches/guile-3.0-linux-syscalls.patch,
gnu/packages/patches/guile-3.0-relocatable.patch: New files.
* gnu/local.mk (dist_patch_DATA): Adjust accordingly.  Move all Guile patches
together while at it.
* gnu/system/linux-initrd.scm (guile-static-stripped): New variable.
(expression->initrd)[guile]: Change from %GUILE-STATIC-STRIPPED to custom
variant using the above patches.
---
 gnu/local.mk                                  |   7 +-
 .../patches/guile-2.2-default-utf8.patch      |  82 ++++
 .../patches/guile-3.0-linux-syscalls.patch    | 353 ++++++++++++++++++
 .../patches/guile-3.0-relocatable.patch       |  79 ++++
 gnu/system/linux-initrd.scm                   |  10 +-
 5 files changed, 526 insertions(+), 5 deletions(-)
 create mode 100644 gnu/packages/patches/guile-2.2-default-utf8.patch
 create mode 100644 gnu/packages/patches/guile-3.0-linux-syscalls.patch
 create mode 100644 gnu/packages/patches/guile-3.0-relocatable.patch

diff --git a/gnu/local.mk b/gnu/local.mk
index b3d6054b50..2a1bbcd3fb 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -1026,11 +1026,14 @@ dist_patch_DATA =						\
   %D%/packages/patches/guile-1.8-cpp-4.5.patch			\
   %D%/packages/patches/guile-2.2-skip-oom-test.patch            \
   %D%/packages/patches/guile-default-utf8.patch			\
+  %D%/packages/patches/guile-2.2-default-utf8.patch		\
+  %D%/packages/patches/guile-relocatable.patch			\
+  %D%/packages/patches/guile-3.0-relocatable.patch		\
+  %D%/packages/patches/guile-linux-syscalls.patch		\
+  %D%/packages/patches/guile-3.0-linux-syscalls.patch		\
   %D%/packages/patches/guile-gdbm-ffi-support-gdbm-1.14.patch	\
   %D%/packages/patches/guile-json-cross.patch			\
-  %D%/packages/patches/guile-linux-syscalls.patch		\
   %D%/packages/patches/guile-present-coding.patch		\
-  %D%/packages/patches/guile-relocatable.patch			\
   %D%/packages/patches/guile-rsvg-pkgconfig.patch		\
   %D%/packages/patches/guile-emacs-fix-configure.patch		\
   %D%/packages/patches/guile-sqlite3-fix-cross-compilation.patch \
diff --git a/gnu/packages/patches/guile-2.2-default-utf8.patch b/gnu/packages/patches/guile-2.2-default-utf8.patch
new file mode 100644
index 0000000000..f55a6430c1
--- /dev/null
+++ b/gnu/packages/patches/guile-2.2-default-utf8.patch
@@ -0,0 +1,82 @@
+This hack makes Guile default to UTF-8.  This avoids calls to
+`iconv_open'; `iconv_open' tries to open shared objects that aren't
+available during bootstrap, so using UTF-8 avoids that (and UTF-8 has
+built-in conversions in glibc, too.)
+
+diff --git a/libguile/bytevectors.c b/libguile/bytevectors.c
+index 0ac5ea6a6..f73301e2f 100644
+--- a/libguile/bytevectors.c
++++ b/libguile/bytevectors.c
+@@ -1931,7 +1931,7 @@ utf_encoding_name (char *name, size_t utf_width, SCM endianness)
+   if (scm_i_is_narrow_string (str))                                     \
+     {                                                                   \
+       err = mem_iconveh (scm_i_string_chars (str), c_strlen,            \
+-                         "ISO-8859-1", c_utf_name,                      \
++                         "UTF-8", c_utf_name,                      \
+                          iconveh_question_mark, NULL,                   \
+                          &c_utf, &c_utf_len);                           \
+       if (SCM_UNLIKELY (err))                                           \
+diff --git a/libguile/ports.c b/libguile/ports.c
+index 45e62f4e4..42012f3aa 100644
+--- a/libguile/ports.c
++++ b/libguile/ports.c
+@@ -974,7 +974,9 @@ canonicalize_encoding (const char *enc)
+   char *ret;
+   int i;
+ 
+-  if (!enc || encoding_matches (enc, sym_ISO_8859_1))
++  if (enc == NULL)
++    return sym_UTF_8;
++  if (encoding_matches (enc, sym_ISO_8859_1))
+     return sym_ISO_8859_1;
+   if (encoding_matches (enc, sym_UTF_8))
+     return sym_UTF_8;
+@@ -4198,7 +4200,7 @@ scm_init_ports (void)
+     scm_c_define ("%default-port-conversion-strategy",
+                   scm_make_fluid_with_default (sym_substitute));
+   /* Use the locale as the default port encoding.  */
+-  scm_i_set_default_port_encoding (locale_charset ());
++  scm_i_set_default_port_encoding ("UTF-8");
+ 
+   scm_c_register_extension ("libguile-" SCM_EFFECTIVE_VERSION,
+                             "scm_init_ice_9_ports",
+diff --git a/libguile/strings.c b/libguile/strings.c
+index 056b4c99f..63a6c050d 100644
+--- a/libguile/strings.c
++++ b/libguile/strings.c
+@@ -1579,7 +1579,7 @@ scm_i_default_string_failed_conversion_handler (void)
+ SCM
+ scm_from_locale_stringn (const char *str, size_t len)
+ {
+-  return scm_from_stringn (str, len, locale_charset (),
++  return scm_from_stringn (str, len, "UTF-8",
+                            scm_i_default_string_failed_conversion_handler ());
+ }
+ 
+@@ -1907,7 +1907,7 @@ char *
+ scm_to_locale_stringn (SCM str, size_t *lenp)
+ {
+   return scm_to_stringn (str, lenp,
+-                         locale_charset (),
++                         "UTF-8",
+                          scm_i_default_string_failed_conversion_handler ());
+ }
+ 
+@@ -2195,7 +2195,7 @@ scm_to_stringn (SCM str, size_t *lenp, const char *encoding,
+     scm_wrong_type_arg_msg (NULL, 0, str, "string");
+ 
+   if (encoding == NULL)
+-    encoding = "ISO-8859-1";
++    encoding = "UTF-8";
+ 
+   if (c_strcasecmp (encoding, "UTF-8") == 0)
+     /* This is the most common case--e.g., when calling libc bindings
+@@ -2247,7 +2247,7 @@ scm_to_stringn (SCM str, size_t *lenp, const char *encoding,
+   if (scm_i_is_narrow_string (str))
+     {
+       ret = mem_iconveh (scm_i_string_chars (str), ilen,
+-                         "ISO-8859-1", encoding,
++                         "UTF-8", encoding,
+                          (enum iconv_ilseq_handler) handler, NULL,
+                          &buf, &len);
+ 
diff --git a/gnu/packages/patches/guile-3.0-linux-syscalls.patch b/gnu/packages/patches/guile-3.0-linux-syscalls.patch
new file mode 100644
index 0000000000..55d6a2ab52
--- /dev/null
+++ b/gnu/packages/patches/guile-3.0-linux-syscalls.patch
@@ -0,0 +1,353 @@
+From 9d670c8045830a64fcbc6aac6ae6fd37335a7348 Mon Sep 17 00:00:00 2001
+From: Marius Bakke <marius@devup.no>
+Date: Thu, 19 Mar 2020 12:49:31 +0100
+Subject: [PATCH] port linux syscalls
+
+---
+ libguile/posix.c | 330 +++++++++++++++++++++++++++++++++++++++++++++++
+ 1 file changed, 330 insertions(+)
+
+diff --git a/libguile/posix.c b/libguile/posix.c
+index a1520abc4..61d57cdb9 100644
+--- a/libguile/posix.c
++++ b/libguile/posix.c
+@@ -2375,6 +2375,336 @@ scm_init_popen (void)
+ }
+ #endif /* HAVE_START_CHILD */
+ 
++\f
++/* Linux! */
++#ifdef __linux__
++
++#include <sys/mount.h>
++#include <sys/syscall.h>
++
++#include "libguile/foreign.h"
++#include "libguile/bytevectors.h"
++#include <libguile/variable.h>
++
++SCM_DEFINE (scm_mount, "mount", 3, 2, 0,
++	    (SCM source, SCM target, SCM type, SCM flags, SCM data),
++	    "Mount file system of @var{type} specified by @var{source} "
++	    "on @var{target}.")
++#define FUNC_NAME s_scm_mount
++{
++  int err;
++  char *c_source, *c_target, *c_type, *c_data;
++  unsigned long c_flags;
++
++  c_source = scm_to_locale_string (source);
++  c_target = scm_to_locale_string (target);
++  c_type = scm_to_locale_string (type);
++  c_flags = SCM_UNBNDP (flags) ? 0 : scm_to_ulong (flags);
++
++  if (SCM_UNBNDP (data) || scm_is_false (data))
++    c_data = NULL;
++  else
++    c_data = scm_to_locale_string (data);
++
++  err = mount (c_source, c_target, c_type, c_flags, c_data);
++  if (err != 0)
++    err = errno;
++
++  free (c_source);
++  free (c_target);
++  free (c_type);
++
++  if (c_data != NULL)
++    free (c_data);
++
++  if (err != 0)
++    {
++      errno = err;
++      SCM_SYSERROR;
++    }
++
++  return SCM_UNSPECIFIED;
++}
++#undef FUNC_NAME
++
++SCM_DEFINE (scm_umount, "umount", 1, 0, 0,
++	    (SCM target),
++	    "Unmount the file system on @var{target}.")
++#define FUNC_NAME s_scm_umount
++{
++  int err;
++  char *c_target;
++
++  c_target = scm_to_locale_string (target);
++
++  err = umount (c_target);
++  if (err != 0)
++    err = errno;
++
++  free (c_target);
++
++  if (err != 0)
++    {
++      errno = err;
++      SCM_SYSERROR;
++    }
++
++  return SCM_UNSPECIFIED;
++}
++#undef FUNC_NAME
++
++/* Linux's module installation syscall.  See `kernel/module.c' in Linux;
++   the function itself is part of the GNU libc.
++
++   Load the LEN bytes at MODULE as a kernel module, with arguments from
++   ARGS, a space-separated list of options.  */
++extern long init_module (void *module, unsigned long len, const char *args);
++
++/* Load a kernel module from FD.  FLAGS must be a bitwise or of
++   MODULE_INIT_* constants.  The GNU libc doesn't provide a wrapper for
++   this one so we use 'syscall'.  */
++static int
++finit_module (int fd, const char *args, int flags)
++{
++  return syscall (SYS_finit_module, fd, args, flags);
++}
++
++
++SCM_DEFINE (scm_load_linux_module, "load-linux-module", 1, 1, 0,
++	    (SCM data, SCM options),
++	    "Load the Linux kernel module whose contents are in bytevector "
++	    "DATA (the contents of a @code{.ko} file), with the arguments "
++	    "from the OPTIONS string.")
++#define FUNC_NAME s_scm_load_linux_module
++{
++  long err;
++  void *c_data;
++  unsigned long c_len;
++  char *c_options;
++
++  SCM_VALIDATE_BYTEVECTOR (SCM_ARG1, data);
++
++  c_data = SCM_BYTEVECTOR_CONTENTS (data);
++  c_len = SCM_BYTEVECTOR_LENGTH (data);
++  c_options =
++    scm_to_locale_string (SCM_UNBNDP (options) ? scm_nullstr : options);
++
++  err = init_module (c_data, c_len, c_options);
++
++  free (c_options);
++
++  if (err != 0)
++    SCM_SYSERROR;
++
++  return SCM_UNSPECIFIED;
++}
++#undef FUNC_NAME
++
++SCM_DEFINE (scm_load_linux_module_fd, "load-linux-module/fd", 1, 2, 0,
++	    (SCM fd, SCM options, SCM flags),
++	    "Load the Linux kernel module from the file at FD, "
++	    "with the arguments from the OPTIONS string, and "
++            "optionally the given FLAGS.")
++#define FUNC_NAME s_scm_load_linux_module_fd
++{
++  long err;
++  int c_fd, c_flags;
++  char *c_options;
++
++  c_fd = scm_to_int (fd);
++  c_options =
++    scm_to_locale_string (SCM_UNBNDP (options) ? scm_nullstr : options);
++  c_flags = SCM_UNBNDP (flags) ? 0 : scm_to_int (flags);
++
++  err = finit_module (c_fd, c_options, c_flags);
++
++  free (c_options);
++
++  if (err != 0)
++    SCM_SYSERROR;
++
++  return SCM_UNSPECIFIED;
++}
++#undef FUNC_NAME
++
++
++/* Rebooting, halting, and all that.  */
++
++#include <sys/reboot.h>
++
++SCM_VARIABLE_INIT (flag_RB_AUTOBOOT, "RB_AUTOBOOT",
++		   scm_from_int (RB_AUTOBOOT));
++SCM_VARIABLE_INIT (flag_RB_HALT_SYSTEM, "RB_HALT_SYSTEM",
++		   scm_from_int (RB_HALT_SYSTEM));
++SCM_VARIABLE_INIT (flag_RB_ENABLE_CAD, "RB_ENABLE_CAD",
++		   scm_from_int (RB_ENABLE_CAD));
++SCM_VARIABLE_INIT (flag_RB_DISABLE_CAD, "RB_DISABLE_CAD",
++		   scm_from_int (RB_DISABLE_CAD));
++SCM_VARIABLE_INIT (flag_RB_POWER_OFF, "RB_POWER_OFF",
++		   scm_from_int (RB_POWER_OFF));
++SCM_VARIABLE_INIT (flag_RB_SW_SUSPEND, "RB_SW_SUSPEND",
++		   scm_from_int (RB_SW_SUSPEND));
++SCM_VARIABLE_INIT (flag_RB_KEXEC, "RB_KEXEC",
++		   scm_from_int (RB_KEXEC));
++
++SCM_DEFINE (scm_reboot, "reboot", 0, 1, 0,
++	    (SCM command),
++	    "Reboot the system.  @var{command} must be one of the @code{RB_} "
++	    "constants; if omitted, @var{RB_AUTOBOOT} is used, thus "
++	    "performing a hard reset.")
++#define FUNC_NAME s_scm_reboot
++{
++  int c_command;
++
++  if (SCM_UNBNDP (command))
++    c_command = RB_AUTOBOOT;
++  else
++    c_command = scm_to_int (command);
++
++  reboot (c_command);
++
++  return SCM_UNSPECIFIED;			  /* likely unreached */
++}
++#undef FUNC_NAME
++
++/* Linux network interfaces.  See <linux/if.h>.  */
++
++#include <linux/if.h>
++#include <linux/sockios.h>
++#include "libguile/socket.h"
++
++SCM_VARIABLE_INIT (flag_IFF_UP, "IFF_UP",
++		   scm_from_int (IFF_UP));
++SCM_VARIABLE_INIT (flag_IFF_BROADCAST, "IFF_BROADCAST",
++		   scm_from_int (IFF_BROADCAST));
++SCM_VARIABLE_INIT (flag_IFF_DEBUG, "IFF_DEBUG",
++		   scm_from_int (IFF_DEBUG));
++SCM_VARIABLE_INIT (flag_IFF_LOOPBACK, "IFF_LOOPBACK",
++		   scm_from_int (IFF_LOOPBACK));
++SCM_VARIABLE_INIT (flag_IFF_POINTOPOINT, "IFF_POINTOPOINT",
++		   scm_from_int (IFF_POINTOPOINT));
++SCM_VARIABLE_INIT (flag_IFF_NOTRAILERS, "IFF_NOTRAILERS",
++		   scm_from_int (IFF_NOTRAILERS));
++SCM_VARIABLE_INIT (flag_IFF_RUNNING, "IFF_RUNNING",
++		   scm_from_int (IFF_RUNNING));
++SCM_VARIABLE_INIT (flag_IFF_NOARP, "IFF_NOARP",
++		   scm_from_int (IFF_NOARP));
++SCM_VARIABLE_INIT (flag_IFF_PROMISC, "IFF_PROMISC",
++		   scm_from_int (IFF_PROMISC));
++SCM_VARIABLE_INIT (flag_IFF_ALLMULTI, "IFF_ALLMULTI",
++		   scm_from_int (IFF_ALLMULTI));
++
++SCM_DEFINE (scm_set_network_interface_address, "set-network-interface-address",
++	    3, 0, 0,
++	    (SCM socket, SCM name, SCM address),
++	    "Configure network interface @var{name}.")
++#define FUNC_NAME s_scm_set_network_interface_address
++{
++  char *c_name;
++  struct ifreq ifr;
++  struct sockaddr *c_address;
++  size_t sa_len;
++  int fd, err;
++
++  socket = SCM_COERCE_OUTPORT (socket);
++  SCM_VALIDATE_OPFPORT (1, socket);
++  fd = SCM_FPORT_FDES (socket);
++
++  memset (&ifr, 0, sizeof ifr);
++  c_name = scm_to_locale_string (name);
++  c_address = scm_to_sockaddr (address, &sa_len);
++
++  strncpy (ifr.ifr_name, c_name, sizeof ifr.ifr_name - 1);
++  memcpy (&ifr.ifr_addr, c_address, sa_len);
++
++  err = ioctl (fd, SIOCSIFADDR, &ifr);
++  if (err != 0)
++    err = errno;
++
++  free (c_name);
++  free (c_address);
++
++  if (err != 0)
++    {
++      errno = err;
++      SCM_SYSERROR;
++    }
++
++  return SCM_UNSPECIFIED;
++}
++#undef FUNC_NAME
++
++SCM_DEFINE (scm_set_network_interface_flags, "set-network-interface-flags",
++	    3, 0, 0,
++	    (SCM socket, SCM name, SCM flags),
++	    "Change the flags of network interface @var{name} to "
++	    "@var{flags}.")
++#define FUNC_NAME s_scm_set_network_interface_flags
++{
++  struct ifreq ifr;
++  char *c_name;
++  int fd, err;
++
++  socket = SCM_COERCE_OUTPORT (socket);
++  SCM_VALIDATE_OPFPORT (1, socket);
++  fd = SCM_FPORT_FDES (socket);
++
++  memset (&ifr, 0, sizeof ifr);
++  c_name = scm_to_locale_string (name);
++  strncpy (ifr.ifr_name, c_name, sizeof ifr.ifr_name - 1);
++  ifr.ifr_flags = scm_to_short (flags);
++
++  err = ioctl (fd, SIOCSIFFLAGS, &ifr);
++  if (err != 0)
++    err = errno;
++
++  free (c_name);
++
++  if (err != 0)
++    {
++      errno = err;
++      SCM_SYSERROR;
++    }
++
++  return SCM_UNSPECIFIED;
++}
++#undef FUNC_NAME
++
++SCM_DEFINE (scm_network_interface_flags, "network-interface-flags",
++	    2, 0, 0,
++	    (SCM socket, SCM name),
++	    "Return the flags of network interface @var{name}.")
++#define FUNC_NAME s_scm_network_interface_flags
++{
++  struct ifreq ifr;
++  char *c_name;
++  int fd, err;
++
++  socket = SCM_COERCE_OUTPORT (socket);
++  SCM_VALIDATE_OPFPORT (1, socket);
++  fd = SCM_FPORT_FDES (socket);
++
++  memset (&ifr, 0, sizeof ifr);
++  c_name = scm_to_locale_string (name);
++  strncpy (ifr.ifr_name, c_name, sizeof ifr.ifr_name - 1);
++
++  err = ioctl (fd, SIOCGIFFLAGS, &ifr);
++  if (err != 0)
++    err = errno;
++
++  free (c_name);
++
++  if (err != 0)
++    {
++      errno = err;
++      SCM_SYSERROR;
++    }
++
++  return scm_from_short (ifr.ifr_flags);
++}
++#undef FUNC_NAME
++#endif
++
+ void
+ scm_init_posix ()
+ {
+-- 
+2.25.2
+
diff --git a/gnu/packages/patches/guile-3.0-relocatable.patch b/gnu/packages/patches/guile-3.0-relocatable.patch
new file mode 100644
index 0000000000..2ffc79fa70
--- /dev/null
+++ b/gnu/packages/patches/guile-3.0-relocatable.patch
@@ -0,0 +1,79 @@
+From 5bd112b292a2b177a479099cc06e998747025587 Mon Sep 17 00:00:00 2001
+From: Marius Bakke <marius@devup.no>
+Date: Thu, 19 Mar 2020 12:49:02 +0100
+Subject: [PATCH] add guile relocatable
+
+---
+ libguile/load.c | 35 +++++++++++++++++++++++++++++------
+ 1 file changed, 29 insertions(+), 6 deletions(-)
+
+diff --git a/libguile/load.c b/libguile/load.c
+index e95c36db1..53d27b0b4 100644
+--- a/libguile/load.c
++++ b/libguile/load.c
+@@ -27,6 +27,7 @@
+ #include <stat-time.h>
+ #include <string.h>
+ #include <stdio.h>
++#include <libgen.h>
+ #include <sys/types.h>
+ #include <sys/stat.h>
+ #include <unistd.h>
+@@ -334,6 +335,32 @@ scm_init_load_path ()
+   SCM cpath = SCM_EOL;
+ 
+ #ifdef SCM_LIBRARY_DIR
++  char *program, *bin_dir, *prefix, *module_dir, *ccache_dir;
++
++  /* Determine the source and compiled module directories at run-time,
++     relative to the executable's location.
++
++     Note: Use /proc/self/exe instead of argv[0] because the latter is
++     not necessarily an absolute, nor a valid file name.  */
++
++  program = scm_gc_malloc_pointerless (256, "string");
++  readlink ("/proc/self/exe", program, 256);
++
++  bin_dir = dirname (strdupa (program));
++
++  prefix = scm_gc_malloc_pointerless (strlen (bin_dir) + 4, "string");
++  strcpy (prefix, bin_dir);
++  strcat (prefix, "/..");
++  prefix = canonicalize_file_name (prefix);
++
++  module_dir = scm_gc_malloc_pointerless (strlen (prefix) + 50, "string");
++  strcpy (module_dir, prefix);
++  strcat (module_dir, "/share/guile/" SCM_EFFECTIVE_VERSION);
++
++  ccache_dir = scm_gc_malloc_pointerless (strlen (prefix) + 50, "string");
++  strcpy (ccache_dir, prefix);
++  strcat (ccache_dir, "/lib/guile/" SCM_EFFECTIVE_VERSION "/ccache");
++
+   env = scm_i_mirror_backslashes (getenv ("GUILE_SYSTEM_PATH"));
+   if (env && strcmp (env, "") == 0)
+     /* special-case interpret system-path=="" as meaning no system path instead
+@@ -342,10 +369,7 @@ scm_init_load_path ()
+   else if (env)
+     path = scm_parse_path (scm_from_locale_string (env), path);
+   else
+-    path = scm_list_4 (scm_from_utf8_string (SCM_LIBRARY_DIR),
+-                       scm_from_utf8_string (SCM_SITE_DIR),
+-                       scm_from_utf8_string (SCM_GLOBAL_SITE_DIR),
+-                       scm_from_utf8_string (SCM_PKGDATA_DIR));
++    path = scm_list_1 (scm_from_locale_string (module_dir));
+ 
+   env = scm_i_mirror_backslashes (getenv ("GUILE_SYSTEM_COMPILED_PATH"));
+   if (env && strcmp (env, "") == 0)
+@@ -355,8 +379,7 @@ scm_init_load_path ()
+     cpath = scm_parse_path (scm_from_locale_string (env), cpath);
+   else
+     {
+-      cpath = scm_list_2 (scm_from_utf8_string (SCM_CCACHE_DIR),
+-                          scm_from_utf8_string (SCM_SITE_CCACHE_DIR));
++      cpath = scm_list_1 (scm_from_locale_string (ccache_dir));
+     }
+ 
+ #endif /* SCM_LIBRARY_DIR */
+-- 
+2.25.2
+
diff --git a/gnu/system/linux-initrd.scm b/gnu/system/linux-initrd.scm
index dcc9b6b937..818aac63f3 100644
--- a/gnu/system/linux-initrd.scm
+++ b/gnu/system/linux-initrd.scm
@@ -36,7 +36,7 @@
   #:use-module ((gnu packages xorg)
                 #:select (console-setup xkeyboard-config))
   #:use-module ((gnu packages make-bootstrap)
-                #:select (%guile-static-stripped))
+                #:select (make-guile-static make-guile-static-stripped))
   #:use-module (gnu system file-systems)
   #:use-module (gnu system mapped-devices)
   #:use-module (gnu system keyboard)
@@ -59,10 +59,14 @@
 ;;;
 ;;; Code:
 
-
 (define* (expression->initrd exp
                              #:key
-                             (guile %guile-static-stripped)
+                             (guile (make-guile-static-stripped
+                                     (make-guile-static
+                                      guile-3.0
+                                      '("guile-2.2-default-utf8.patch"
+                                        "guile-3.0-linux-syscalls.patch"
+                                        "guile-3.0-relocatable.patch"))))
                              (gzip gzip)
                              (name "guile-initrd")
                              (system (%current-system)))
-- 
2.26.2

[bug#40908] [PATCH core-updates 5/5] gnu: make-bootstrap: Do not export %GUILE-STATIC-STRIPPED.

[Marius Bakke]

* gnu/packages/make-bootstrap.scm (%guile-static-stripped): Remove export.
---
 gnu/packages/make-bootstrap.scm | 4 +---
 1 file changed, 1 insertion(+), 3 deletions(-)

diff --git a/gnu/packages/make-bootstrap.scm b/gnu/packages/make-bootstrap.scm
index 443e778824..981c7aa24e 100644
--- a/gnu/packages/make-bootstrap.scm
+++ b/gnu/packages/make-bootstrap.scm
@@ -56,9 +56,7 @@
             %guile-bootstrap-tarball
             %mescc-tools-bootstrap-tarball
             %mes-bootstrap-tarball
-            %bootstrap-tarballs
-
-            %guile-static-stripped))
+            %bootstrap-tarballs))
 
 ;;; Commentary:
 ;;;
-- 
2.26.2

[bug#40908] [PATCH core-updates 4/5] linux-initrd: Use Guile 3.0.

[Marius Bakke]

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

Marius Bakke <mbakke@fastmail.com> writes:

> * gnu/packages/patches/guile-2.2-default-utf8.patch: New file, extracted from
> commit 2acfe022a740f79b593348cc6362cc4ee8f33bb4.
> * gnu/packages/patches/guile-3.0-linux-syscalls.patch,
> gnu/packages/patches/guile-3.0-relocatable.patch: New files.
> * gnu/local.mk (dist_patch_DATA): Adjust accordingly.  Move all Guile patches
> together while at it.
> * gnu/system/linux-initrd.scm (guile-static-stripped): New variable.

Whoops, I inlined this variable at the last minute and forgot to adjust
the commit message.  The patch also accidentally removes a newline,
I've fixed that locally.

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

[bug#40908] [PATCH core-updates 4/5] linux-initrd: Use Guile 3.0.

[Ludovic Courtès]

Hi,

Marius Bakke <mbakke@fastmail.com> skribis:

> +++ b/gnu/packages/patches/guile-3.0-linux-syscalls.patch
> @@ -0,0 +1,353 @@
> +From 9d670c8045830a64fcbc6aac6ae6fd37335a7348 Mon Sep 17 00:00:00 2001
> +From: Marius Bakke <marius@devup.no>
> +Date: Thu, 19 Mar 2020 12:49:31 +0100
> +Subject: [PATCH] port linux syscalls
> +
> +---
> + libguile/posix.c | 330 +++++++++++++++++++++++++++++++++++++++++++++++
> + 1 file changed, 330 insertions(+)

[...]

> --- /dev/null
> +++ b/gnu/packages/patches/guile-3.0-relocatable.patch
> @@ -0,0 +1,79 @@
> +From 5bd112b292a2b177a479099cc06e998747025587 Mon Sep 17 00:00:00 2001
> +From: Marius Bakke <marius@devup.no>
> +Date: Thu, 19 Mar 2020 12:49:02 +0100
> +Subject: [PATCH] add guile relocatable
> +
> +---

For these two patches, could you preserve the same or a similar heading
as the original patches?

Thanks!

Ludo’.

[bug#40908] [PATCH core-updates 5/5] gnu: make-bootstrap: Do not export %GUILE-STATIC-STRIPPED.

[Ludovic Courtès]

Hi,

Marius Bakke <mbakke@fastmail.com> skribis:

> * gnu/packages/make-bootstrap.scm (%guile-static-stripped): Remove export.
> ---
>  gnu/packages/make-bootstrap.scm | 4 +---
>  1 file changed, 1 insertion(+), 3 deletions(-)
>
> diff --git a/gnu/packages/make-bootstrap.scm b/gnu/packages/make-bootstrap.scm
> index 443e778824..981c7aa24e 100644
> --- a/gnu/packages/make-bootstrap.scm
> +++ b/gnu/packages/make-bootstrap.scm
> @@ -56,9 +56,7 @@
>              %guile-bootstrap-tarball
>              %mescc-tools-bootstrap-tarball
>              %mes-bootstrap-tarball
> -            %bootstrap-tarballs
> -
> -            %guile-static-stripped))

Are you sure it’s unused?

Actually, what about simply adding ‘%guile-3.0-static-stripped’ right in
this file?  I think it would work, right?  And we could also keep
‘make-guile-static’ private.

Apart from this, the patch series LGTM!  Pretty exciting to have a JIT
in the initrd.  ;-)

Thanks,
Ludo’.

[bug#40908] [PATCH core-updates 4/5] linux-initrd: Use Guile 3.0.

[Marius Bakke]

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

Ludovic Courtès <ludo@gnu.org> writes:

> Hi,
>
> Marius Bakke <mbakke@fastmail.com> skribis:
>
>> +++ b/gnu/packages/patches/guile-3.0-linux-syscalls.patch
>> @@ -0,0 +1,353 @@
>> +From 9d670c8045830a64fcbc6aac6ae6fd37335a7348 Mon Sep 17 00:00:00 2001
>> +From: Marius Bakke <marius@devup.no>
>> +Date: Thu, 19 Mar 2020 12:49:31 +0100
>> +Subject: [PATCH] port linux syscalls
>> +
>> +---
>> + libguile/posix.c | 330 +++++++++++++++++++++++++++++++++++++++++++++++
>> + 1 file changed, 330 insertions(+)
>
> [...]
>
>> --- /dev/null
>> +++ b/gnu/packages/patches/guile-3.0-relocatable.patch
>> @@ -0,0 +1,79 @@
>> +From 5bd112b292a2b177a479099cc06e998747025587 Mon Sep 17 00:00:00 2001
>> +From: Marius Bakke <marius@devup.no>
>> +Date: Thu, 19 Mar 2020 12:49:02 +0100
>> +Subject: [PATCH] add guile relocatable
>> +
>> +---
>
> For these two patches, could you preserve the same or a similar heading
> as the original patches?

Derp, I'm usually the one complaining about patch headers!

I've fixed this now, thanks for noticing.

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

bug#40908: [PATCH core-updates 5/5] gnu: make-bootstrap: Do not export %GUILE-STATIC-STRIPPED.

[Marius Bakke]

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

Ludovic Courtès <ludo@gnu.org> writes:

> Hi,
>
> Marius Bakke <mbakke@fastmail.com> skribis:
>
>> * gnu/packages/make-bootstrap.scm (%guile-static-stripped): Remove export.
>> ---
>>  gnu/packages/make-bootstrap.scm | 4 +---
>>  1 file changed, 1 insertion(+), 3 deletions(-)
>>
>> diff --git a/gnu/packages/make-bootstrap.scm b/gnu/packages/make-bootstrap.scm
>> index 443e778824..981c7aa24e 100644
>> --- a/gnu/packages/make-bootstrap.scm
>> +++ b/gnu/packages/make-bootstrap.scm
>> @@ -56,9 +56,7 @@
>>              %guile-bootstrap-tarball
>>              %mescc-tools-bootstrap-tarball
>>              %mes-bootstrap-tarball
>> -            %bootstrap-tarballs
>> -
>> -            %guile-static-stripped))
>
> Are you sure it’s unused?
>
> Actually, what about simply adding ‘%guile-3.0-static-stripped’ right in
> this file?  I think it would work, right?  And we could also keep
> ‘make-guile-static’ private.

Right, that is better.  Done!

> Apart from this, the patch series LGTM!  Pretty exciting to have a JIT
> in the initrd.  ;-)

Heh, my main motivation for these patches was to remove scary warnings
about incompatible bytecode during boot, but we also boot faster as a
side effect!  :-)

Patches pushed!

I think we are pretty close to actually merging this branch now..!

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