distro: Add a statically-linked, relocatable Guile 2.0 package.
* distro/packages/base.scm (%guile-static, %guile-static-stripped): New variables. * distro/patches/guile-relocatable.patch: New file. * Makefile.am (dist_patch_DATA): Add it.
This commit is contained in:
Ludovic Courtès
parent
4004f95379
commit
df1fab5837
|
|
@ -50,6 +50,7 @@ dist_patch_DATA = \
|
|||
distro/patches/binutils-ld-new-dtags.patch \
|
||||
distro/patches/diffutils-gets-undeclared.patch \
|
||||
distro/patches/guile-1.8-cpp-4.5.patch \
|
||||
distro/patches/guile-relocatable.patch \
|
||||
distro/patches/libtool-skip-tests.patch \
|
||||
distro/patches/m4-gets-undeclared.patch \
|
||||
distro/patches/m4-readlink-EINVAL.patch \
|
||||
|
|
|
|||
|
|
@ -1997,4 +1997,104 @@ store.")
|
|||
(license #f)
|
||||
(home-page #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 ((guile (package (inherit guile-2.0)
|
||||
(inputs
|
||||
`(("patch/relocatable"
|
||||
,(search-patch "guile-relocatable.patch"))
|
||||
,@(package-inputs guile-2.0)))
|
||||
(arguments
|
||||
`(;; 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.
|
||||
#:configure-flags '("LDFLAGS=-ldl")
|
||||
|
||||
#:phases (alist-cons-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"))))
|
||||
%standard-phases)
|
||||
|
||||
;; Allow Guile to be relocated, as is needed during
|
||||
;; bootstrap.
|
||||
#:patches
|
||||
(list (assoc-ref %build-inputs "patch/relocatable"))
|
||||
|
||||
;; There are uses of `dynamic-link' in
|
||||
;; {foreign,coverage}.test that don't fly here.
|
||||
#:tests? #f)))))
|
||||
(static-package guile (current-source-location))))
|
||||
|
||||
(define %guile-static-stripped
|
||||
;; A stripped static Guile binary, for use during bootstrap.
|
||||
(package (inherit %guile-static)
|
||||
(name "guile-static-stripped")
|
||||
(build-system trivial-build-system)
|
||||
(arguments
|
||||
`(#:modules ((guix build utils))
|
||||
#:builder
|
||||
(let ()
|
||||
(use-modules (ice-9 ftw)
|
||||
(guix build utils))
|
||||
|
||||
(define (copy-recursively source destination)
|
||||
;; Copy SOURCE directory to DESTINATION.
|
||||
(with-directory-excursion source
|
||||
(file-system-fold (const #t)
|
||||
(lambda (file stat result) ; leaf
|
||||
(format #t "copying `~s/~s' to `~s'...~%"
|
||||
source file destination)
|
||||
(copy-file file
|
||||
(string-append destination
|
||||
"/" file)))
|
||||
(lambda (dir stat result) ; down
|
||||
(let ((dir (string-append destination
|
||||
"/" dir)))
|
||||
(unless (file-exists? dir)
|
||||
(mkdir dir))))
|
||||
(lambda (dir stat result) ; up
|
||||
result)
|
||||
(const #t) ; skip
|
||||
(lambda (file stat errno result)
|
||||
(format (current-error-port)
|
||||
"i/o error: ~a: ~a~%" file
|
||||
(strerror errno)))
|
||||
#t
|
||||
".")))
|
||||
|
||||
(let ((in (assoc-ref %build-inputs "guile"))
|
||||
(out (assoc-ref %outputs "out")))
|
||||
(mkdir out)
|
||||
(mkdir (string-append out "/share"))
|
||||
(mkdir (string-append out "/share/guile"))
|
||||
(mkdir (string-append out "/share/guile/2.0"))
|
||||
(copy-recursively (string-append in "/share/guile/2.0")
|
||||
(string-append out "/share/guile/2.0"))
|
||||
|
||||
(mkdir (string-append out "/lib"))
|
||||
(mkdir (string-append out "/lib/guile"))
|
||||
(mkdir (string-append out "/lib/guile/2.0"))
|
||||
(mkdir (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 (string-append out "/bin"))
|
||||
(copy-file (string-append in "/bin/guile")
|
||||
(string-append out "/bin/guile"))
|
||||
#t))))
|
||||
(inputs `(("guile" ,%guile-static)))))
|
||||
|
||||
;;; base.scm ends here
|
||||
|
|
|
|||
|
|
@ -0,0 +1,60 @@
|
|||
This patch changes Guile to use a default search path relative to the
|
||||
location of the `guile' binary, allowing it to be relocated.
|
||||
|
||||
diff --git a/libguile/load.c b/libguile/load.c
|
||||
index af2ca45..751c903 100644
|
||||
--- a/libguile/load.c
|
||||
+++ b/libguile/load.c
|
||||
@@ -26,6 +26,7 @@
|
||||
|
||||
#include <string.h>
|
||||
#include <stdio.h>
|
||||
+#include <libgen.h>
|
||||
|
||||
#include "libguile/_scm.h"
|
||||
#include "libguile/private-gc.h" /* scm_getenv_int */
|
||||
@@ -255,6 +256,26 @@ scm_init_load_path ()
|
||||
SCM cpath = SCM_EOL;
|
||||
|
||||
#ifdef SCM_LIBRARY_DIR
|
||||
+ char *bin_dir, *prefix, *module_dir, *ccache_dir;
|
||||
+
|
||||
+ /* Determine the source and compiled module directories at run-time,
|
||||
+ relative to the executable's location. */
|
||||
+
|
||||
+ bin_dir = dirname (strdupa (program_invocation_name));
|
||||
+
|
||||
+ 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/2.0");
|
||||
+
|
||||
+ ccache_dir = scm_gc_malloc_pointerless (strlen (prefix) + 50, "string");
|
||||
+ strcpy (ccache_dir, prefix);
|
||||
+ strcat (ccache_dir, "/lib/guile/2.0/ccache");
|
||||
+
|
||||
env = getenv ("GUILE_SYSTEM_PATH");
|
||||
if (env && strcmp (env, "") == 0)
|
||||
/* special-case interpret system-path=="" as meaning no system path instead
|
||||
@@ -263,7 +284,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_locale_string (SCM_LIBRARY_DIR),
|
||||
+ path = scm_list_4 (scm_from_locale_string (module_dir),
|
||||
scm_from_locale_string (SCM_SITE_DIR),
|
||||
scm_from_locale_string (SCM_GLOBAL_SITE_DIR),
|
||||
scm_from_locale_string (SCM_PKGDATA_DIR));
|
||||
@@ -276,7 +297,7 @@ scm_init_load_path ()
|
||||
cpath = scm_parse_path (scm_from_locale_string (env), cpath);
|
||||
else
|
||||
{
|
||||
- cpath = scm_list_2 (scm_from_locale_string (SCM_CCACHE_DIR),
|
||||
+ cpath = scm_list_2 (scm_from_locale_string (ccache_dir),
|
||||
scm_from_locale_string (SCM_SITE_CCACHE_DIR));
|
||||
}
|
||||
|
||||
|
|
@ -264,6 +264,10 @@
|
|||
;; This trick allows use of the `scm_c_read' optimization.
|
||||
(socket PF_UNIX SOCK_STREAM 0)))
|
||||
(a (make-socket-address PF_UNIX file)))
|
||||
|
||||
;; Enlarge the receive buffer.
|
||||
(setsockopt s SOL_SOCKET SO_RCVBUF (* 12 1024))
|
||||
|
||||
(connect s a)
|
||||
(write-int %worker-magic-1 s)
|
||||
(let ((r (read-int s)))
|
||||
|
|
|
|||
|
|
@ -588,6 +588,26 @@ FIELD/DEFAULT-VALUE tuples."
|
|||
(hash-set! cache args results)
|
||||
(apply values results)))))))
|
||||
|
||||
(define-syntax hash-set-proc
|
||||
(syntax-rules (eq? eqv? equal?)
|
||||
((_ eq?) hashq-set!)
|
||||
((_ eqv?) hashv-set!)
|
||||
((_ equal?) hash-set!)))
|
||||
|
||||
(define-syntax hash-ref*
|
||||
(syntax-rules (eq? eqv? equal?)
|
||||
((_ table key eq?) (hashq-ref table key))
|
||||
((_ table key eqv?) (hashv-ref table key))
|
||||
((_ table key equal?) (hash-ref table key))))
|
||||
|
||||
(define-syntax memoizing-lambda
|
||||
(syntax-rules ()
|
||||
((_ ((arg type) ...) body ...)
|
||||
(let ((cache (make-weak-key-hash-table 100)))
|
||||
(lambda (arg ...)
|
||||
(or (and (hash-ref* cache)))
|
||||
)))))
|
||||
|
||||
(define (gnu-triplet->nix-system triplet)
|
||||
"Return the Nix system type corresponding to TRIPLET, a GNU triplet as
|
||||
returned by `config.guess'."
|
||||
|
|
|
|||
Loading…
Reference in New Issue