1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 20:00:19 +02:00

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.
This commit is contained in:
Mark H Weaver 2018-06-11 01:52:40 -04:00 committed by Andy Wingo
parent a44c2a679f
commit a72e296176
3 changed files with 27 additions and 8 deletions

View file

@ -1,6 +1,6 @@
;;; Guile Emacs Lisp ;;; 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 ;; 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 ;; it under the terms of the GNU General Public License as published by
@ -25,6 +25,7 @@
#:use-module (language tree-il) #:use-module (language tree-il)
#:use-module (system base pmatch) #:use-module (system base pmatch)
#:use-module (system base compile) #:use-module (system base compile)
#:use-module (system base target)
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
#:use-module (srfi srfi-8) #:use-module (srfi srfi-8)
#:use-module (srfi srfi-11) #:use-module (srfi srfi-11)
@ -460,7 +461,9 @@
(map compile-expr args)))) (map compile-expr args))))
(defspecial eval-when-compile (loc 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) (defspecial if (loc args)
(pmatch args (pmatch args
@ -702,7 +705,9 @@
args args
body)))) body))))
(make-const loc name)))) (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))))) tree-il)))))
(defspecial defun (loc args) (defspecial defun (loc args)

View file

@ -1,6 +1,6 @@
;;; Guile Emac Lisp ;;; 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 ;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public ;;;; modify it under the terms of the GNU Lesser General Public
@ -23,6 +23,7 @@
#:use-module (language elisp parser) #:use-module (language elisp parser)
#:use-module (system base language) #:use-module (system base language)
#:use-module (system base compile) #:use-module (system base compile)
#:use-module (system base target)
#:export (elisp)) #:export (elisp))
(define-language elisp (define-language elisp
@ -31,5 +32,12 @@
#:printer write #:printer write
#:compilers `((tree-il . ,compile-tree-il))) #:compilers `((tree-il . ,compile-tree-il)))
(compile-and-load (%search-load-path "language/elisp/boot.el") ;; Compile and load the Elisp boot code for the native host
#:from 'elisp) ;; 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)))

View file

@ -1,6 +1,6 @@
;;; Compilation targets ;;; 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 ;; This library is free software; you can redistribute it and/or
;; modify it under the terms of the GNU Lesser General Public ;; modify it under the terms of the GNU Lesser General Public
@ -22,7 +22,7 @@
(define-module (system base target) (define-module (system base target)
#:use-module (rnrs bytevectors) #:use-module (rnrs bytevectors)
#:use-module (ice-9 regex) #:use-module (ice-9 regex)
#:export (target-type with-target #:export (target-type with-target with-native-target
target-cpu target-vendor target-os target-cpu target-vendor target-os
@ -64,6 +64,12 @@
(%target-word-size (triplet-pointer-size target))) (%target-word-size (triplet-pointer-size target)))
(thunk)))) (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) (define (cpu-endianness cpu)
"Return the endianness for CPU." "Return the endianness for CPU."
(if (string=? cpu (triplet-cpu %host-type)) (if (string=? cpu (triplet-cpu %host-type))