[Guile-commits] 23/58: elisp: Fix cross-compilation support.

[Andy Wingo]

wingo pushed a commit to branch lightning
in repository guile.

commit a72e29617640fbb4903244d6ea210641ceb2da9d
Author: Mark H Weaver <address@hidden>
Date:   Mon Jun 11 01:52:40 2018 -0400

    elisp: Fix cross-compilation support.
    
    * module/system/base/target.scm (with-native-target): New exported
    procedure.
    * module/language/elisp/spec.scm: In the top-level body expression, call
    'compile-and-load' within 'with-native-target' to compile native code.
    * module/language/elisp/compile-tree-il.scm
    (eval-when-compile, defmacro): Compile native code.
---
 module/language/elisp/compile-tree-il.scm | 11 ++++++++---
 module/language/elisp/spec.scm            | 14 +++++++++++---
 module/system/base/target.scm             | 10 ++++++++--
 3 files changed, 27 insertions(+), 8 deletions(-)

diff --git a/module/language/elisp/compile-tree-il.scm 
b/module/language/elisp/compile-tree-il.scm
index baa6b2a..0334e6f 100644
--- a/module/language/elisp/compile-tree-il.scm
+++ b/module/language/elisp/compile-tree-il.scm
@@ -1,6 +1,6 @@
 ;;; Guile Emacs Lisp
 
-;; Copyright (C) 2009, 2010, 2011, 2013 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2011, 2013, 2018 Free Software Foundation, Inc.
 
 ;; This program is free software; you can redistribute it and/or modify
 ;; it under the terms of the GNU General Public License as published by
@@ -25,6 +25,7 @@
   #:use-module (language tree-il)
   #:use-module (system base pmatch)
   #:use-module (system base compile)
+  #:use-module (system base target)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-8)
   #:use-module (srfi srfi-11)
@@ -460,7 +461,9 @@
                  (map compile-expr args))))
 
 (defspecial eval-when-compile (loc args)
-  (make-const loc (compile `(progn ,@args) #:from 'elisp #:to 'value)))
+  (make-const loc (with-native-target
+                   (lambda ()
+                     (compile `(progn ,@args) #:from 'elisp #:to 'value)))))
 
 (defspecial if (loc args)
   (pmatch args
@@ -702,7 +705,9 @@
                                           args
                                           body))))
                   (make-const loc name))))
-           (compile tree-il #:from 'tree-il #:to 'value)
+           (with-native-target
+            (lambda ()
+              (compile tree-il #:from 'tree-il #:to 'value)))
            tree-il)))))
 
 (defspecial defun (loc args)
diff --git a/module/language/elisp/spec.scm b/module/language/elisp/spec.scm
index 38a32c2..d8758ec 100644
--- a/module/language/elisp/spec.scm
+++ b/module/language/elisp/spec.scm
@@ -1,6 +1,6 @@
 ;;; Guile Emac Lisp
 
-;; Copyright (C) 2001, 2009, 2010 Free Software Foundation, Inc.
+;; Copyright (C) 2001, 2009, 2010, 2018 Free Software Foundation, Inc.
 
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
@@ -23,6 +23,7 @@
   #:use-module (language elisp parser)
   #:use-module (system base language)
   #:use-module (system base compile)
+  #:use-module (system base target)
   #:export (elisp))
 
 (define-language elisp
@@ -31,5 +32,12 @@
   #:printer   write
   #:compilers `((tree-il . ,compile-tree-il)))
 
-(compile-and-load (%search-load-path "language/elisp/boot.el")
-                  #:from 'elisp)
+;; Compile and load the Elisp boot code for the native host
+;; architecture.  We must specifically ask for native compilation here,
+;; because this module might be loaded in a dynamic environment where
+;; cross-compilation has been requested using 'with-target'.  For
+;; example, this happens when cross-compiling Guile itself.
+(with-native-target
+  (lambda ()
+    (compile-and-load (%search-load-path "language/elisp/boot.el")
+                      #:from 'elisp)))
diff --git a/module/system/base/target.scm b/module/system/base/target.scm
index 93616f4..2088cd8 100644
--- a/module/system/base/target.scm
+++ b/module/system/base/target.scm
@@ -1,6 +1,6 @@
 ;;; Compilation targets
 
-;; Copyright (C) 2011, 2012, 2013, 2014, 2017 Free Software Foundation, Inc.
+;; Copyright (C) 2011-2014,2017-2018 Free Software Foundation, Inc.
 
 ;; This library is free software; you can redistribute it and/or
 ;; modify it under the terms of the GNU Lesser General Public
@@ -22,7 +22,7 @@
 (define-module (system base target)
   #:use-module (rnrs bytevectors)
   #:use-module (ice-9 regex)
-  #:export (target-type with-target
+  #:export (target-type with-target with-native-target
 
             target-cpu target-vendor target-os
 
@@ -64,6 +64,12 @@
                   (%target-word-size (triplet-pointer-size target)))
       (thunk))))
 
+(define (with-native-target thunk)
+  (with-fluids ((%target-type %host-type)
+                (%target-endianness (native-endianness))
+                (%target-word-size %native-word-size))
+    (thunk)))
+
 (define (cpu-endianness cpu)
   "Return the endianness for CPU."
   (if (string=? cpu (triplet-cpu %host-type))