mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-04-30 03:40:34 +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:
parent
a44c2a679f
commit
a72e296176
3 changed files with 27 additions and 8 deletions
|
@ -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)
|
||||
|
|
|
@ -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)))
|
||||
|
|
|
@ -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))
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue