summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--configure.ac13
-rw-r--r--src/Makefile.in10
-rw-r--r--src/alloc.c53
-rw-r--r--src/bytecode-jit.c1606
-rw-r--r--src/bytecode.c253
-rw-r--r--src/bytecode.h320
-rw-r--r--src/data.c1
-rw-r--r--src/emacs.c3
-rw-r--r--src/eval.c18
-rw-r--r--src/lisp.h20
-rw-r--r--src/lread.c6
11 files changed, 2036 insertions, 267 deletions
diff --git a/configure.ac b/configure.ac
index dcba7eb2c24..0c9f70369c6 100644
--- a/configure.ac
+++ b/configure.ac
@@ -356,6 +356,7 @@ OPTION_DEFAULT_ON([gnutls],[don't use -lgnutls for SSL/TLS support])
OPTION_DEFAULT_ON([zlib],[don't compile with zlib decompression support])
OPTION_DEFAULT_OFF([modules],[compile with dynamic modules support])
OPTION_DEFAULT_ON([threads],[don't compile with elisp threading support])
+OPTION_DEFAULT_OFF([libjit],[compile with emacs lisp jit support])
AC_ARG_WITH([file-notification],[AS_HELP_STRING([--with-file-notification=LIB],
[use a file notification library (LIB one of: yes, inotify, kqueue, gfile, w32, no)])],
@@ -3416,6 +3417,17 @@ if test "${HAVE_ZLIB}" = "yes"; then
fi
AC_SUBST(LIBZ)
+HAVE_LIBJIT=no
+LIBJIT=
+if test "${with_libjit}" != "no"; then
+ LIBJIT_REQUIRED=0.0.1
+ LIBJIT_MODULES="libjit >= $LIBJIT_REQUIRED"
+ EMACS_CHECK_MODULES([LIBJIT], [$LIBJIT_MODULES])
+ if test "${HAVE_LIBJIT}" = "yes"; then
+ AC_DEFINE([HAVE_LIBJIT], 1, [Define to 1 if you have the libjit library (-ljit).])
+ fi
+fi
+
### Dynamic modules support
LIBMODULES=
HAVE_MODULES=no
@@ -5332,6 +5344,7 @@ AS_ECHO([" Does Emacs use -lXaw3d? ${HAVE_XAW3D
Does Emacs use toolkit scroll bars? ${USE_TOOLKIT_SCROLL_BARS}
Does Emacs support Xwidgets (requires gtk3)? ${HAVE_XWIDGETS}
Does Emacs have threading support in lisp? ${threads_enabled}
+ Does Emacs have lisp JIT support? ${HAVE_LIBJIT}
"])
if test -n "${EMACSDATA}"; then
diff --git a/src/Makefile.in b/src/Makefile.in
index ab319837249..e5e534296dc 100644
--- a/src/Makefile.in
+++ b/src/Makefile.in
@@ -237,6 +237,9 @@ GETADDRINFO_A_LIBS = @GETADDRINFO_A_LIBS@
LIBZ = @LIBZ@
+LIBJIT = @LIBJIT_LIBS@
+LIBJIT_CFLAGS = @LIBJIT_CFLAGS@
+
## system-specific libs for dynamic modules, else empty
LIBMODULES = @LIBMODULES@
## dynlib.o emacs-module.o if modules enabled, else empty
@@ -375,7 +378,7 @@ EMACS_CFLAGS=-Demacs $(MYCPPFLAGS) -I. -I$(srcdir) \
$(LIBOTF_CFLAGS) $(M17N_FLT_CFLAGS) $(DEPFLAGS) \
$(LIBSYSTEMD_CFLAGS) \
$(LIBGNUTLS_CFLAGS) $(NOTIFY_CFLAGS) $(CAIRO_CFLAGS) \
- $(WERROR_CFLAGS)
+ $(WERROR_CFLAGS) $(LIBJIT_CFLAGS)
ALL_CFLAGS = $(EMACS_CFLAGS) $(WARN_CFLAGS) $(CFLAGS)
ALL_OBJC_CFLAGS = $(EMACS_CFLAGS) \
$(filter-out $(NON_OBJC_CFLAGS),$(WARN_CFLAGS)) $(CFLAGS) \
@@ -400,7 +403,7 @@ base_obj = dispnew.o frame.o scroll.o xdisp.o menu.o $(XMENU_OBJ) window.o \
cmds.o casetab.o casefiddle.o indent.o search.o regex.o undo.o \
alloc.o data.o doc.o editfns.o callint.o \
eval.o floatfns.o fns.o font.o print.o lread.o $(MODULES_OBJ) \
- syntax.o $(UNEXEC_OBJ) bytecode.o \
+ syntax.o $(UNEXEC_OBJ) bytecode.o bytecode-jit.o \
process.o gnutls.o callproc.o \
region-cache.o sound.o atimer.o \
doprnt.o intervals.o textprop.o composite.o xml.o $(NOTIFY_OBJ) \
@@ -495,7 +498,8 @@ LIBES = $(LIBS) $(W32_LIBS) $(LIBS_GNUSTEP) $(LIBX_BASE) $(LIBIMAGE) \
$(LIBS_TERMCAP) $(GETLOADAVG_LIBS) $(SETTINGS_LIBS) $(LIBSELINUX_LIBS) \
$(FREETYPE_LIBS) $(FONTCONFIG_LIBS) $(LIBOTF_LIBS) $(M17N_FLT_LIBS) \
$(LIBGNUTLS_LIBS) $(LIB_PTHREAD) $(GETADDRINFO_A_LIBS) \
- $(NOTIFY_LIBS) $(LIB_MATH) $(LIBZ) $(LIBMODULES) $(LIBSYSTEMD_LIBS)
+ $(NOTIFY_LIBS) $(LIB_MATH) $(LIBZ) $(LIBMODULES) $(LIBSYSTEMD_LIBS) \
+ $(LIBJIT)
$(leimdir)/leim-list.el: bootstrap-emacs$(EXEEXT)
$(MAKE) -C ../leim leim-list.el EMACS="$(bootstrap_exe)"
diff --git a/src/alloc.c b/src/alloc.c
index e909d312c4e..a2302a6f462 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -30,6 +30,10 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <pthread.h>
#endif
+#ifdef HAVE_LIBJIT
+#include <jit.h>
+#endif
+
#include "lisp.h"
#include "dispextern.h"
#include "intervals.h"
@@ -3184,6 +3188,16 @@ cleanup_vector (struct Lisp_Vector *vector)
finalize_one_mutex ((struct Lisp_Mutex *) vector);
else if (PSEUDOVECTOR_TYPEP (&vector->header, PVEC_CONDVAR))
finalize_one_condvar ((struct Lisp_CondVar *) vector);
+ else if (PSEUDOVECTOR_TYPEP (&vector->header, PVEC_COMPILED)
+ && vector->contents[COMPILED_JIT_CTXT] != (Lisp_Object )NULL)
+ {
+#ifdef HAVE_LIBJIT
+ jit_context_t ctxt = (jit_context_t )vector->contents[COMPILED_JIT_CTXT];
+ jit_context_destroy (ctxt);
+#endif
+ vector->contents[COMPILED_JIT_CTXT] = (Lisp_Object )NULL;
+ vector->contents[COMPILED_JIT_CLOSURE] = (Lisp_Object )NULL;
+ }
}
/* Reclaim space used by unmarked vectors. */
@@ -3422,23 +3436,6 @@ usage: (vector &rest OBJECTS) */)
return val;
}
-void
-make_byte_code (struct Lisp_Vector *v)
-{
- /* Don't allow the global zero_vector to become a byte code object. */
- eassert (0 < v->header.size);
-
- if (v->header.size > 1 && STRINGP (v->contents[1])
- && STRING_MULTIBYTE (v->contents[1]))
- /* BYTECODE-STRING must have been produced by Emacs 20.2 or the
- earlier because they produced a raw 8-bit string for byte-code
- and now such a byte-code string is loaded as multibyte while
- raw 8-bit characters converted to multibyte form. Thus, now we
- must convert them back to the original unibyte form. */
- v->contents[1] = Fstring_as_unibyte (v->contents[1]);
- XSETPVECTYPE (v, PVEC_COMPILED);
-}
-
DEFUN ("make-byte-code", Fmake_byte_code, Smake_byte_code, 4, MANY, 0,
doc: /* Create a byte-code object with specified arguments as elements.
The arguments should be the ARGLIST, bytecode-string BYTE-CODE, constant
@@ -3457,8 +3454,12 @@ stack before executing the byte-code.
usage: (make-byte-code ARGLIST BYTE-CODE CONSTANTS DEPTH &optional DOCSTRING INTERACTIVE-SPEC &rest ELEMENTS) */)
(ptrdiff_t nargs, Lisp_Object *args)
{
- Lisp_Object val = make_uninit_vector (nargs);
+ Lisp_Object val = make_uninit_vector (max(nargs, COMPILED_JIT_CLOSURE + 1));
struct Lisp_Vector *p = XVECTOR (val);
+ size_t size = min(nargs, COMPILED_JIT_CLOSURE);
+
+ /* Don't allow the global zero_vector to become a byte code object. */
+ eassert (0 < nargs);
/* We used to purecopy everything here, if purify-flag was set. This worked
OK for Emacs-23, but with Emacs-24's lexical binding code, it can be
@@ -3469,7 +3470,21 @@ usage: (make-byte-code ARGLIST BYTE-CODE CONSTANTS DEPTH &optional DOCSTRING INT
to be setcar'd). */
memcpy (p->contents, args, nargs * sizeof *args);
- make_byte_code (p);
+
+ if (STRINGP (p->contents[COMPILED_BYTECODE])
+ && STRING_MULTIBYTE (p->contents[COMPILED_BYTECODE]))
+ /* BYTECODE-STRING must have been produced by Emacs 20.2 or the
+ earlier because they produced a raw 8-bit string for byte-code
+ and now such a byte-code string is loaded as multibyte while
+ raw 8-bit characters converted to multibyte form. Thus, now we
+ must convert them back to the original unibyte form. */
+ p->contents[COMPILED_BYTECODE] = Fstring_as_unibyte (p->contents[COMPILED_BYTECODE]);
+
+ /* set rest size so that total footprint = COMPILED_JIT_CLOSURE + 1 */
+ XSETPVECTYPESIZE (p, PVEC_COMPILED, size, COMPILED_JIT_CLOSURE + 1 - size);
+ p->contents[COMPILED_INTERPRETER] = (Lisp_Object )exec_byte_code;
+ p->contents[COMPILED_JIT_CTXT] = (Lisp_Object )NULL;
+ p->contents[COMPILED_JIT_CLOSURE] = (Lisp_Object )NULL;
XSETCOMPILED (val, p);
return val;
}
diff --git a/src/bytecode-jit.c b/src/bytecode-jit.c
new file mode 100644
index 00000000000..f97083395dd
--- /dev/null
+++ b/src/bytecode-jit.c
@@ -0,0 +1,1606 @@
+/* JIT compilation of byte code produced by bytecomp.el.
+ Copyright (C) 2016 Free Software Foundation, Inc.
+
+This file is part of GNU Emacs.
+
+GNU Emacs is free software: you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation, either version 3 of the License, or (at
+your option) any later version.
+
+GNU Emacs is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
+
+#include <config.h>
+
+#ifdef HAVE_LIBJIT
+#include "bytecode.h"
+#include "lisp.h"
+#include "blockinput.h"
+#include "character.h"
+#include "buffer.h"
+#include "keyboard.h"
+#include "syntax.h"
+#include "window.h"
+
+#include <stdarg.h>
+#include <jit.h>
+
+/* Fetch the next byte from the bytecode stream. */
+
+#define FETCH *pc++
+
+/* Fetch two bytes from the bytecode stream and make a 16-bit number
+ out of them. */
+
+#define FETCH2 (op = FETCH, op + (FETCH << 8))
+
+/* Push x onto the execution stack. This used to be #define PUSH(x)
+ (*++stackp = (x)) This oddity is necessary because Alliant can't be
+ bothered to compile the preincrement operator properly, as of 4/91.
+ -JimB */
+
+#define PUSH(x) (top++, *top = (x))
+
+#undef BEFORE_POTENTIAL_GC
+#undef AFTER_POTENTIAL_GC
+#define BEFORE_POTENTIAL_GC() ((void )0)
+#define AFTER_POTENTIAL_GC() ((void )0)
+
+/* Check for jumping out of range. */
+
+#if BYTE_CODE_SAFE
+
+#define CHECK_RANGE(ARG) \
+ if (ARG >= bytestr_length) emacs_abort ()
+
+#else /* not BYTE_CODE_SAFE */
+
+#define CHECK_RANGE(ARG)
+
+#endif /* not BYTE_CODE_SAFE */
+
+/* A version of the QUIT macro which makes sure that the stack top is
+ set before signaling `quit'. */
+
+#define BYTE_CODE_QUIT \
+ do { \
+ if (!NILP (Vquit_flag) && NILP (Vinhibit_quit)) \
+ { \
+ Lisp_Object flag = Vquit_flag; \
+ Vquit_flag = Qnil; \
+ BEFORE_POTENTIAL_GC (); \
+ if (EQ (Vthrow_on_input, flag)) \
+ Fthrow (Vthrow_on_input, Qt); \
+ Fsignal (Qquit, Qnil); \
+ AFTER_POTENTIAL_GC (); \
+ } \
+ else if (pending_signals) \
+ process_pending_signals (); \
+ } while (0)
+
+/* Global jit context */
+jit_context_t jit_context = NULL;
+
+#define jit_type_Lisp_Object jit_type_nuint
+
+jit_type_t native_varref_sig;
+static Lisp_Object
+native_varref (Lisp_Object v1)
+{
+ Lisp_Object v2;
+
+ if (SYMBOLP (v1))
+ {
+ if (XSYMBOL (v1)->redirect != SYMBOL_PLAINVAL
+ || (v2 = SYMBOL_VAL (XSYMBOL (v1)),
+ EQ (v2, Qunbound)))
+ {
+ v2 = Fsymbol_value (v1);
+ }
+ }
+ else
+ {
+ v2 = Fsymbol_value (v1);
+ }
+ return v2;
+}
+
+jit_type_t native_ifnil_sig;
+static bool
+native_ifnil (Lisp_Object v1)
+{
+ maybe_gc ();
+ if (NILP (v1))
+ {
+ BYTE_CODE_QUIT;
+ return true;
+ }
+ else
+ return false;
+}
+
+jit_type_t native_ifnonnil_sig;
+static bool
+native_ifnonnil (Lisp_Object v1)
+{
+ maybe_gc ();
+ if (!NILP (v1))
+ {
+ BYTE_CODE_QUIT;
+ return true;
+ }
+ else
+ return false;
+
+}
+
+jit_type_t native_car_sig;
+static Lisp_Object
+native_car (Lisp_Object v1)
+{
+ if (CONSP (v1))
+ return XCAR (v1);
+ else if (NILP (v1))
+ return Qnil;
+ else
+ {
+ wrong_type_argument (Qlistp, v1);
+ }
+}
+
+jit_type_t native_eq_sig;
+static Lisp_Object
+native_eq (Lisp_Object v1, Lisp_Object v2)
+{
+ return EQ (v1, v2) ? Qt : Qnil;
+}
+
+jit_type_t native_memq_sig;
+static Lisp_Object
+native_memq (Lisp_Object v1, Lisp_Object v2)
+{
+ v1 = Fmemq (v1, v2);
+ return v1;
+}
+
+jit_type_t native_cdr_sig;
+static Lisp_Object
+native_cdr (Lisp_Object v1)
+{
+ if (CONSP (v1))
+ return XCDR (v1);
+ else if (NILP (v1))
+ return Qnil;
+ else
+ {
+ wrong_type_argument (Qlistp, v1);
+ }
+}
+
+jit_type_t native_varset_sig;
+static void
+native_varset (Lisp_Object sym, Lisp_Object val)
+{
+ /* Inline the most common case. */
+ if (SYMBOLP (sym)
+ && !EQ (val, Qunbound)
+ && !XSYMBOL (sym)->redirect
+ && !SYMBOL_CONSTANT_P (sym))
+ SET_SYMBOL_VAL (XSYMBOL (sym), val);
+ else
+ {
+ set_internal (sym, val, Qnil, 0);
+ }
+}
+
+jit_type_t specbind_sig;
+jit_type_t Ffuncall_sig;
+
+jit_type_t native_unbind_to_sig;
+static Lisp_Object
+native_unbind_to (ptrdiff_t x, Lisp_Object q)
+{
+ return unbind_to (SPECPDL_INDEX () - x, q);
+}
+
+jit_type_t unbind_to_sig;
+
+jit_type_t byte_code_quit_sig;
+static void
+byte_code_quit (void)
+{
+ maybe_gc ();
+ BYTE_CODE_QUIT;
+}
+
+jit_type_t native_save_excursion_sig;
+static void
+native_save_excursion (void)
+{
+ record_unwind_protect (save_excursion_restore,
+ save_excursion_save ());
+}
+
+jit_type_t native_save_restriction_sig;
+static void
+native_save_restriction (void)
+{
+ record_unwind_protect (save_restriction_restore,
+ save_restriction_save ());
+}
+
+
+jit_type_t native_save_window_excursion_sig;
+static Lisp_Object
+native_save_window_excursion (Lisp_Object v1)
+{
+ ptrdiff_t count1 = SPECPDL_INDEX ();
+ record_unwind_protect (restore_window_configuration,
+ Fcurrent_window_configuration (Qnil));
+ v1 = Fprogn (v1);
+ unbind_to (count1, v1);
+ return v1;
+}
+
+jit_type_t native_catch_sig;
+static Lisp_Object
+native_catch (Lisp_Object v2, Lisp_Object v1)
+{
+ return internal_catch (v2, eval_sub, v1);
+}
+
+jit_type_t native_pophandler_sig;
+static void
+native_pophandler (void)
+{
+ handlerlist = handlerlist->next;
+}
+
+jit_type_t native_pushhandler1_sig;
+static void *
+native_pushhandler1 (Lisp_Object **stack, Lisp_Object tag,
+ int type)
+{
+ struct handler *c = push_handler (tag, type);
+ c->stack = *stack;
+ return c->jmp;
+}
+
+jit_type_t native_pushhandler2_sig;
+static void
+native_pushhandler2 (Lisp_Object **stack)
+{
+ struct handler *c = handlerlist;
+ native_pophandler ();
+ *stack = c->stack;
+ (*stack)++;
+ **stack = c->val;
+}
+
+jit_type_t native_unwind_protect_sig;
+static void
+native_unwind_protect (Lisp_Object handler)
+{
+ record_unwind_protect (FUNCTIONP (handler) ? bcall0 : prog_ignore, handler);
+}
+
+jit_type_t native_temp_output_buffer_setup_sig;
+static Lisp_Object
+native_temp_output_buffer_setup (Lisp_Object x)
+{
+ CHECK_STRING (x);
+ temp_output_buffer_setup (SSDATA (x));
+ return Vstandard_output;
+}
+
+jit_type_t native_nth_sig;
+static Lisp_Object
+native_nth (Lisp_Object v1, Lisp_Object v2)
+{
+ EMACS_INT n;
+ CHECK_NUMBER (v1);
+ n = XINT (v1);
+ immediate_quit = 1;
+ while (--n >= 0 && CONSP (v2))
+ v2 = XCDR (v2);
+ immediate_quit = 0;
+ return CAR (v2);
+}
+
+jit_type_t native_symbolp_sig;
+jit_type_t native_consp_sig;
+jit_type_t native_stringp_sig;
+jit_type_t native_listp_sig;
+jit_type_t native_not_sig;
+static Lisp_Object
+native_symbolp (Lisp_Object v1)
+{
+ return SYMBOLP (v1) ? Qt : Qnil;
+}
+static Lisp_Object
+native_consp (Lisp_Object v1)
+{
+ return CONSP (v1) ? Qt : Qnil;
+}
+static Lisp_Object
+native_stringp (Lisp_Object v1)
+{
+ return STRINGP (v1) ? Qt : Qnil;
+}
+static Lisp_Object
+native_listp (Lisp_Object v1)
+{
+ return CONSP (v1) || NILP (v1) ? Qt : Qnil;
+}
+static Lisp_Object
+native_not (Lisp_Object v1)
+{
+ return NILP (v1) ? Qt : Qnil;
+}
+
+jit_type_t native_add1_sig;
+static Lisp_Object
+native_add1 (Lisp_Object v1, bool add)
+{
+ if (INTEGERP (v1))
+ {
+ XSETINT (v1, XINT (v1) + (add ? 1 : -1));
+ return v1;
+ }
+ else if (add)
+ return Fadd1 (v1);
+ else
+ return Fsub1 (v1);
+}
+
+jit_type_t native_eqlsign_sig;
+static Lisp_Object
+native_eqlsign (Lisp_Object v1, Lisp_Object v2)
+{
+ CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (v1);
+ CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (v2);
+ if (FLOATP (v1) || FLOATP (v2))
+ {
+ double f1, f2;
+
+ f1 = (FLOATP (v1) ? XFLOAT_DATA (v1) : XINT (v1));
+ f2 = (FLOATP (v2) ? XFLOAT_DATA (v2) : XINT (v2));
+ return (f1 == f2 ? Qt : Qnil);
+ }
+ else
+ return (XINT (v1) == XINT (v2) ? Qt : Qnil);
+}
+
+jit_type_t arithcompare_sig;
+jit_type_t native_negate_sig;
+static Lisp_Object
+native_negate (Lisp_Object v)
+{
+ if (INTEGERP (v))
+ {
+ XSETINT (v, - XINT (v));
+ return v;
+ }
+ else
+ return Fminus (1, &v);
+}
+
+jit_type_t native_point_sig;
+static Lisp_Object
+native_point (void)
+{
+ Lisp_Object v1;
+ XSETFASTINT (v1, PT);
+ return v1;
+}
+
+jit_type_t native_point_max_sig;
+static Lisp_Object
+native_point_max (void)
+{
+ Lisp_Object v1;
+ XSETFASTINT (v1, ZV);
+ return v1;
+}
+
+jit_type_t native_point_min_sig;
+static Lisp_Object
+native_point_min (void)
+{
+ Lisp_Object v1;
+ XSETFASTINT (v1, BEGV);
+ return v1;
+}
+
+jit_type_t native_current_column_sig;
+static Lisp_Object
+native_current_column (void)
+{
+ Lisp_Object v1;
+ XSETFASTINT (v1, current_column ());
+ return v1;
+}
+
+jit_type_t native_interactive_p_sig;
+static Lisp_Object
+native_interactive_p (void)
+{
+ return call0 (intern ("interactive-p"));
+}
+
+jit_type_t native_char_syntax_sig;
+static Lisp_Object
+native_char_syntax (Lisp_Object v)
+{
+ int c;
+
+ CHECK_CHARACTER (v);
+ c = XFASTINT (v);
+ if (NILP (BVAR (current_buffer, enable_multibyte_characters)))
+ MAKE_CHAR_MULTIBYTE (c);
+ XSETFASTINT (v, syntax_code_spec[SYNTAX (c)]);
+ return v;
+}
+
+jit_type_t native_elt_sig;
+static Lisp_Object
+native_elt (Lisp_Object v1, Lisp_Object v2)
+{
+ if (CONSP (v2))
+ {
+ /* Exchange args and then do nth. */
+ EMACS_INT n;
+ CHECK_NUMBER (v2);
+ n = XINT (v2);
+ immediate_quit = 1;
+ while (--n >= 0 && CONSP (v1))
+ v1 = XCDR (v1);
+ immediate_quit = 0;
+ return CAR (v1);
+ }
+ else
+ return Felt (v1, v2);
+}
+
+jit_type_t native_car_safe_sig;
+static Lisp_Object
+native_car_safe (Lisp_Object v)
+{
+ return CAR_SAFE (v);
+}
+jit_type_t native_cdr_safe_sig;
+static Lisp_Object
+native_cdr_safe (Lisp_Object v)
+{
+ return CDR_SAFE (v);
+}
+
+jit_type_t native_number_p_sig;
+static Lisp_Object
+native_number_p (Lisp_Object v)
+{
+ return NUMBERP (v) ? Qt : Qnil;
+}
+jit_type_t native_integer_p_sig;
+static Lisp_Object
+native_integer_p (Lisp_Object v)
+{
+ return INTEGERP (v) ? Qt : Qnil;
+}
+
+jit_type_t setjmp_sig;
+
+struct emacs_jit_context
+{
+ jit_context_t libjit_ctxt;
+ jit_function_t func;
+ jit_type_t stack_many;
+ jit_type_t stack_n[4];
+ jit_value_t stack;
+};
+
+static bool jit_initialized = false;
+
+static void
+emacs_jit_start (struct emacs_jit_context *ctxt)
+{
+#define JIT_SIG_(f, ret, params) \
+ f = jit_type_create_signature (jit_abi_cdecl, ret, params, \
+ sizeof (params) / sizeof (params[0]), 1);
+#define JIT_SIG(f, ret, ...) \
+ do { \
+ jit_type_t params[] = \
+ { \
+ __VA_ARGS__ \
+ }; \
+ JIT_SIG_ (f, ret, params); \
+ } while (0)
+
+ ctxt->libjit_ctxt = jit_context_create ();
+ jit_type_t jit_type_Lisp_Object_ptr =
+ jit_type_create_pointer (jit_type_Lisp_Object, 1);
+ jit_type_t func_sig;
+ JIT_SIG (func_sig, jit_type_Lisp_Object, jit_type_Lisp_Object_ptr);
+ ctxt->func = jit_function_create (ctxt->libjit_ctxt, func_sig);
+ jit_function_set_optimization_level (ctxt->func,
+ jit_function_get_max_optimization_level ());
+ ctxt->stack = jit_value_get_param (ctxt->func, 0);
+
+ JIT_SIG (ctxt->stack_many, jit_type_Lisp_Object,
+ jit_type_nuint, jit_type_Lisp_Object_ptr);
+
+ jit_type_t params[] = {
+ jit_type_Lisp_Object,
+ jit_type_Lisp_Object,
+ jit_type_Lisp_Object,
+ jit_type_Lisp_Object
+ };
+ int i;
+ for (i = 0; i < sizeof (params) / sizeof (params[0]); i++)
+ {
+ ctxt->stack_n[i] =
+ jit_type_create_signature (jit_abi_cdecl, jit_type_Lisp_Object,
+ params, i, 1);
+ }
+#undef JIT_SIG
+#undef JIT_SIG_
+}
+
+static void
+emacs_jit_init (void)
+{
+#define JIT_SIG_(f, ret, params) \
+ do { \
+ f##_sig = \
+ jit_type_create_signature ( \
+ jit_abi_cdecl, \
+ ret, \
+ params, \
+ sizeof (params) / sizeof (params[0]), \
+ 1); \
+ } while (0)
+#define JIT_SIG(f, ret, ...) \
+ do { \
+ jit_type_t params[] = \
+ { \
+ __VA_ARGS__ \
+ }; \
+ JIT_SIG_ (f, ret, params); \
+ } while (0)
+
+ do {
+ jit_type_t params[] =
+ {
+ jit_type_void_ptr,
+#if !defined (HAVE__SETJMP) && defined (HAVE_SIGSETJMP)
+ jit_type_sys_int
+#endif
+ };
+ setjmp_sig = jit_type_create_signature (jit_abi_cdecl,
+ jit_type_sys_int, params,
+#if !defined (HAVE__SETJMP) && defined (HAVE_SIGSETJMP)
+ 2,
+#else
+ 1,
+#endif
+ 1);
+ } while (0);
+ JIT_SIG (native_ifnil, jit_type_sys_bool, jit_type_Lisp_Object);
+ JIT_SIG (native_ifnonnil, jit_type_sys_bool, jit_type_Lisp_Object);
+ JIT_SIG (native_varset, jit_type_void, jit_type_Lisp_Object, jit_type_Lisp_Object);
+ JIT_SIG (specbind, jit_type_void, jit_type_Lisp_Object, jit_type_Lisp_Object);
+ JIT_SIG (Ffuncall, jit_type_Lisp_Object, jit_type_nuint, jit_type_void_ptr);
+ JIT_SIG (byte_code_quit, jit_type_void);
+ JIT_SIG (native_save_excursion, jit_type_void);
+ JIT_SIG (native_save_restriction, jit_type_void);
+ JIT_SIG (native_pophandler, jit_type_void);
+ JIT_SIG (native_pushhandler1, jit_type_void_ptr, jit_type_create_pointer (jit_type_void_ptr, 1), jit_type_Lisp_Object, jit_type_nint);
+ JIT_SIG (native_pushhandler2, jit_type_void, jit_type_create_pointer (jit_type_void_ptr, 1));
+ JIT_SIG (native_unwind_protect, jit_type_void, jit_type_Lisp_Object);
+ JIT_SIG (native_add1, jit_type_Lisp_Object, jit_type_Lisp_Object, jit_type_sys_bool);
+ JIT_SIG (arithcompare, jit_type_Lisp_Object, jit_type_Lisp_Object, jit_type_Lisp_Object, jit_type_nuint);
+
+ jit_initialized = true;
+}
+
+Lisp_Object
+jit_exec (Lisp_Object byte_code, Lisp_Object args_template, ptrdiff_t nargs, Lisp_Object *args)
+{
+ Lisp_Object *top;
+ Lisp_Object maxdepth = XVECTOR (byte_code)->contents[COMPILED_STACK_DEPTH];
+
+ CHECK_NATNUM (maxdepth);
+ if (MAX_ALLOCA / word_size <= XFASTINT (maxdepth))
+ memory_full (SIZE_MAX);
+ top = alloca ((XFASTINT (maxdepth) + 1) * sizeof *top);
+
+ if (INTEGERP (args_template))
+ {
+ ptrdiff_t at = XINT (args_template);
+ bool rest = (at & 128) != 0;
+ int mandatory = at & 127;
+ ptrdiff_t nonrest = at >> 8;
+ eassert (mandatory <= nonrest);
+ if (nargs <= nonrest)
+ {
+ ptrdiff_t i;
+ for (i = 0 ; i < nargs; i++, args++)
+ PUSH (*args);
+ if (nargs < mandatory)
+ /* Too few arguments. */
+ Fsignal (Qwrong_number_of_arguments,
+ list2 (Fcons (make_number (mandatory),
+ rest ? Qand_rest : make_number (nonrest)),
+ make_number (nargs)));
+ else
+ {
+ for (; i < nonrest; i++)
+ PUSH (Qnil);
+ if (rest)
+ PUSH (Qnil);
+ }
+ }
+ else if (rest)
+ {
+ ptrdiff_t i;
+ for (i = 0 ; i < nonrest; i++, args++)
+ PUSH (*args);
+ PUSH (Flist (nargs - nonrest, args));
+ }
+ else
+ /* Too many arguments. */
+ Fsignal (Qwrong_number_of_arguments,
+ list2 (Fcons (make_number (mandatory), make_number (nonrest)),
+ make_number (nargs)));
+ }
+ else if (! NILP (args_template))
+ /* We should push some arguments on the stack. */
+ {
+ error ("Unknown args template!");
+ }
+
+ {
+ Lisp_Object (*func)(Lisp_Object *) =
+ (void *)AREF (byte_code, COMPILED_JIT_CLOSURE);
+ return func (top);
+ }
+}
+
+static inline
+void jit_inc (struct emacs_jit_context *ctxt, jit_value_t v, long n)
+{
+ jit_value_t i = jit_insn_add_relative (ctxt->func, v, (jit_nint )n);
+ if (!i || !jit_insn_store (ctxt->func, v, i))
+ emacs_abort ();
+}
+
+static inline
+void jit_push (struct emacs_jit_context *ctxt, jit_value_t v)
+{
+ jit_inc (ctxt, ctxt->stack, sizeof (Lisp_Object));
+ if (!jit_insn_store_relative (ctxt->func, ctxt->stack, (jit_nint )0, v))
+ emacs_abort ();
+}
+
+static inline
+jit_value_t jit_top (struct emacs_jit_context *ctxt)
+{
+ jit_value_t v = jit_insn_load_relative (ctxt->func, ctxt->stack,
+ (jit_nint )0, jit_type_Lisp_Object);
+ if (!v)
+ emacs_abort ();
+ return v;
+}
+
+static inline
+jit_value_t jit_pop (struct emacs_jit_context *ctxt)
+{
+ jit_value_t v = jit_top (ctxt);
+ jit_inc (ctxt, ctxt->stack, -sizeof (Lisp_Object));
+ return v;
+}
+
+static inline
+jit_value_t jit_call (struct emacs_jit_context *ctxt, void *f,
+ const char *name, jit_type_t sig, jit_value_t *args,
+ size_t nargs)
+{
+ return jit_insn_call_native (ctxt->func, name, f, sig, args, nargs,
+ JIT_CALL_NOTHROW);
+}
+
+static inline
+jit_value_t jit_call_vaarg (struct emacs_jit_context *ctxt, void *f,
+ const char *name, jit_type_t sig, ...)
+{
+ jit_value_t *args;
+ int i, count;
+ va_list ap;
+
+ /* Determine the number of passed arguments. */
+ va_start (ap, sig);
+ for (count = 0; va_arg (ap, jit_value_t) != NULL; count++);
+ va_end (ap);
+
+ /* Collect args and setup the call */
+ args = (count > 0) ? alloca (count * sizeof (*args)) : NULL;
+ va_start (ap, sig);
+ for (i = 0; i < count; i++)
+ args[i] = va_arg (ap, jit_value_t);
+ va_end (ap);
+
+ return jit_call (ctxt, f, name, sig, args, count);
+}
+
+static inline
+void jit_call_with_stack_n (struct emacs_jit_context *ctxt, void *f,
+ const char *name, int n)
+{
+ jit_value_t *args = (n > 0) ? alloca (n * sizeof (*args)) : NULL;
+ int i;
+
+ for (i = 1; i <= n; i++)
+ args[n-i] = jit_pop (ctxt);
+ jit_push (ctxt, jit_call (ctxt, f, name, ctxt->stack_n[n], args, n));
+}
+
+#define JIT_CONSTANT(f, t, v) \
+ jit_value_create_nint_constant (f, t, v)
+
+static inline
+void jit_call_with_stack_many (struct emacs_jit_context *ctxt, void *f,
+ const char *name, int n)
+{
+ jit_inc (ctxt, ctxt->stack, -(n - 1) * sizeof (Lisp_Object));
+ jit_insn_store_relative (ctxt->func, ctxt->stack, (jit_nint )0,
+ jit_call_vaarg (ctxt, f, name, ctxt->stack_many,
+ JIT_CONSTANT (ctxt->func,
+ jit_type_nuint, n),
+ ctxt->stack, NULL));
+}
+
+#undef JIT_CONSTANT
+
+struct {
+ void * const ptr;
+ const char * const name;
+ int n;
+} static const functions[256] = {
+#undef DEFINE_FIXED
+#define DEFINE_FIXED(bname, value, fname, num) \
+ [value] = { .ptr = (void *)(&fname), .name = #fname, .n = num },
+#define DEFINE(bname, value)
+
+ BYTE_CODES
+
+#undef DEFINE_FIXED
+#undef DEFINE
+#define DEFINE_FIXED(bname, value, fname, num) DEFINE (bname, value)
+};
+
+void
+jit_byte_code__ (Lisp_Object byte_code)
+{
+ ptrdiff_t count = SPECPDL_INDEX ();
+ int op;
+ Lisp_Object *vectorp;
+#if BYTE_CODE_SAFE
+ ptrdiff_t const_length;
+ Lisp_Object *stacke;
+#endif
+ ptrdiff_t bytestr_length;
+ Lisp_Object bytestr;
+ Lisp_Object vector;
+ Lisp_Object maxdepth;
+ enum handlertype type;
+
+ unsigned char *byte_string_start, *pc;
+
+ /* jit-specific variables */
+ struct emacs_jit_context ctxt;
+ jit_label_t *labels;
+
+ /* ensure this is a byte-coded function _before_ doing anything else */
+ CHECK_COMPILED (byte_code);
+
+ /* check if function has already been compiled */
+ if (XVECTOR (byte_code)->contents[COMPILED_JIT_CTXT] != (Lisp_Object )NULL)
+ return;
+ if (!jit_initialized)
+ emacs_jit_init ();
+
+ emacs_jit_start (&ctxt);
+
+ bytestr = XVECTOR (byte_code)->contents[COMPILED_BYTECODE];
+ vector = XVECTOR (byte_code)->contents[COMPILED_CONSTANTS];
+ maxdepth = XVECTOR (byte_code)->contents[COMPILED_STACK_DEPTH];
+ CHECK_STRING (bytestr);
+ CHECK_VECTOR (vector);
+ CHECK_NATNUM (maxdepth);
+
+#if BYTE_CODE_SAFE
+ const_length = ASIZE (vector);
+#endif
+
+ if (STRING_MULTIBYTE (bytestr))
+ /* BYTESTR must have been produced by Emacs 20.2 or the earlier
+ because they produced a raw 8-bit string for byte-code and now
+ such a byte-code string is loaded as multibyte while raw 8-bit
+ characters converted to multibyte form. Thus, now we must
+ convert them back to the originally intended unibyte form. */
+ bytestr = Fstring_as_unibyte (bytestr);
+
+ bytestr_length = SBYTES (bytestr);
+ vectorp = XVECTOR (vector)->contents;
+
+ pc = byte_string_start = SDATA (bytestr);
+ if (MAX_ALLOCA / word_size <= XFASTINT (maxdepth))
+ memory_full (SIZE_MAX);
+
+ /* prepare for jit */
+ jit_context_build_start (ctxt.libjit_ctxt);
+ labels = alloca (sizeof (*labels) * SBYTES (bytestr));
+ {
+ /* give each instruction a label. the labels won't be initialized
+ until we attach code to them, but they work as a placeholder. */
+ int i;
+ for (i = 0; i < SBYTES (bytestr); i++)
+ labels[i] = jit_label_undefined;
+ }
+
+ while (pc < byte_string_start + bytestr_length)
+ {
+#ifndef BYTE_CODE_THREADED
+ op = FETCH;
+#endif
+
+ /* The interpreter can be compiled one of two ways: as an
+ ordinary switch-based interpreter, or as a threaded
+ interpreter. The threaded interpreter relies on GCC's
+ computed goto extension, so it is not available everywhere.
+ Threading provides a performance boost. These macros are how
+ we allow the code to be compiled both ways. */
+#ifdef BYTE_CODE_THREADED
+ /* The CASE macro introduces an instruction's body. It is
+ either a label or a case label. */
+#define CASE(OP) insn_ ## OP
+ /* NEXT is invoked at the end of an instruction to go to the
+ next instruction. It is either a computed goto, or a
+ plain break. */
+#define NEXT \
+ do { \
+ if (pc >= byte_string_start + bytestr_length) \
+ goto exit; \
+ else \
+ { \
+ /* Create a new block and attach a label to it. */ \
+ /* Since fetching the instruction incrememnts pc, do */ \
+ /* this before we fetch the instruction, so pc is right. */ \
+ jit_insn_label (ctxt.func, &labels[JIT_PC]); \
+ op = FETCH; \
+ goto *(targets[op]); \
+ } \
+ } while (0)
+ /* FIRST is like NEXT, but is only used at the start of the
+ interpreter body. In the switch-based interpreter it is the
+ switch, so the threaded definition must include a semicolon. */
+#define FIRST NEXT;
+ /* Most cases are labeled with the CASE macro, above.
+ CASE_DEFAULT is one exception; it is used if the interpreter
+ being built requires a default case. The threaded
+ interpreter does not, because the dispatch table is
+ completely filled. */
+#define CASE_DEFAULT
+ /* This introduces an instruction that is known to call abort. */
+#define CASE_ABORT CASE (Bstack_ref): CASE (default)
+#else
+ /* See above for the meaning of the various defines. */
+#define CASE(OP) case OP
+#define NEXT break
+#define FIRST switch (op)
+#define CASE_DEFAULT case 255: default:
+#define CASE_ABORT case 0
+#endif
+
+#ifdef BYTE_CODE_THREADED
+
+ /* A convenience define that saves us a lot of typing and makes
+ the table clearer. */
+#define LABEL(OP) [OP] = &&insn_ ## OP
+
+#if 4 < __GNUC__ + (6 <= __GNUC_MINOR__)
+# pragma GCC diagnostic push
+# pragma GCC diagnostic ignored "-Woverride-init"
+#elif defined __clang__
+# pragma GCC diagnostic push
+# pragma GCC diagnostic ignored "-Winitializer-overrides"
+#endif
+
+ /* This is the dispatch table for the threaded interpreter. */
+ static const void *const targets[256] =
+ {
+ [0 ... (Bconstant - 1)] = &&insn_default,
+ [Bconstant ... 255] = &&insn_Bconstant,
+
+#define DEFINE(name, value) LABEL (name) ,
+ BYTE_CODES
+#undef DEFINE
+ };
+
+#if 4 < __GNUC__ + (6 <= __GNUC_MINOR__) || defined __clang__
+# pragma GCC diagnostic pop
+#endif
+
+#endif
+
+#define JIT_PC (pc - byte_string_start)
+#define JIT_NEED_STACK jit_value_ref (ctxt.func, ctxt.stack)
+#define JIT_NEXT \
+ do { \
+ if (!jit_insn_branch ( \
+ ctxt.func, \
+ &labels[JIT_PC])) \
+ emacs_abort (); \
+ } while (0)
+
+#define JIT_INC(v, n) \
+ jit_inc (&ctxt, v, n)
+
+#define JIT_PUSH(v) \
+ jit_push (&ctxt, v)
+
+#define JIT_TOP() \
+ jit_top (&ctxt)
+
+#define JIT_POP() \
+ jit_pop (&ctxt)
+
+#define JIT_CALL(f, args, n) \
+ jit_call (&ctxt, (void *)&f, #f, f##_sig, args, n)
+
+#define JIT_CALL_ARGS(f, ...) \
+ jit_call_vaarg (&ctxt, (void *)&f, #f, f##_sig, __VA_ARGS__, NULL)
+
+#define JIT_CONSTANT(t, v) \
+ jit_value_create_nint_constant ( \
+ ctxt.func, \
+ t, \
+ v)
+
+#define JIT_CALL_WITH_STACK_N(f, n) \
+ jit_call_with_stack_n (&ctxt, (void *)&f, #f, n)
+
+#define JIT_CALL_WITH_STACK_MANY(f, n) \
+ jit_call_with_stack_many (&ctxt, (void *)&f, #f, n)
+
+#ifndef BYTE_CODE_THREADED
+ /* create a new block and attach a label to it */
+ jit_insn_label (ctxt.func, &labels[JIT_PC]);
+#endif
+
+ FIRST
+ {
+ CASE (Bcall):
+ CASE (Bcall1):
+ CASE (Bcall2):
+ CASE (Bcall3):
+ CASE (Bcall4):
+ CASE (Bcall5):
+ CASE (Bcall6):
+ CASE (Bcall7):
+ CASE (Blist3):
+ CASE (Blist4):
+ CASE (BlistN):
+ CASE (Bconcat2):
+ CASE (Bconcat3):
+ CASE (Bconcat4):
+ CASE (BconcatN):
+ CASE (Bdiff):
+ CASE (Bplus):
+ CASE (Bmax):
+ CASE (Bmin):
+ CASE (Bmult):
+ CASE (Bquo):
+ CASE (Binsert):
+ CASE (BinsertN):
+ CASE (Bnconc):
+ {
+ int args = functions[op].n;
+ if (args < 0)
+ {
+ if (args == -1)
+ args = FETCH;
+ else if (args == -2)
+ args = FETCH2;
+ if (op == Bcall6 || op == Bcall7)
+ args += 1;
+ }
+ JIT_NEED_STACK;
+ jit_call_with_stack_many (&ctxt, functions[op].ptr,
+ functions[op].name, args);
+ JIT_NEXT;
+ NEXT;
+ }
+ CASE (Blist1):
+ CASE (Blist2):
+ CASE (Bcar):
+ CASE (Beq):
+ CASE (Bmemq):
+ CASE (Bcdr):
+ CASE (Bsave_window_excursion): /* Obsolete since 24.1. */
+ CASE (Bcatch): /* Obsolete since 24.4. */
+ CASE (Bcondition_case): /* Obsolete since 24.4. */
+ CASE (Btemp_output_buffer_setup): /* Obsolete since 24.1. */
+ CASE (Bnth):
+ CASE (Bsymbolp):
+ CASE (Bconsp):
+ CASE (Bstringp):
+ CASE (Blistp):
+ CASE (Bnot):
+ CASE (Bcons):
+ CASE (Blength):
+ CASE (Baref):
+ CASE (Baset):
+ CASE (Bsymbol_value):
+ CASE (Bsymbol_function):
+ CASE (Bset):
+ CASE (Bfset):
+ CASE (Bget):
+ CASE (Bsubstring):
+ CASE (Beqlsign):
+ CASE (Bnegate):
+ CASE (Brem):
+ CASE (Bpoint):
+ CASE (Bgoto_char):
+ CASE (Bpoint_max):
+ CASE (Bpoint_min):
+ CASE (Bchar_after):
+ CASE (Bfollowing_char):
+ CASE (Bpreceding_char):
+ CASE (Bcurrent_column):
+ CASE (Beolp):
+ CASE (Beobp):
+ CASE (Bbolp):
+ CASE (Bbobp):
+ CASE (Bcurrent_buffer):
+ CASE (Bset_buffer):
+ CASE (Binteractive_p): /* Obsolete since 24.1. */
+ CASE (Bforward_char):
+ CASE (Bforward_word):
+ CASE (Bskip_chars_forward):
+ CASE (Bskip_chars_backward):
+ CASE (Bforward_line):
+ CASE (Bchar_syntax):
+ CASE (Bbuffer_substring):
+ CASE (Bdelete_region):
+ CASE (Bnarrow_to_region):
+ CASE (Bwiden):
+ CASE (Bend_of_line):
+ CASE (Bset_marker):
+ CASE (Bmatch_beginning):
+ CASE (Bmatch_end):
+ CASE (Bupcase):
+ CASE (Bdowncase):
+ CASE (Bstringeqlsign):
+ CASE (Bstringlss):
+ CASE (Bequal):
+ CASE (Bnthcdr):
+ CASE (Belt):
+ CASE (Bmember):
+ CASE (Bassq):
+ CASE (Bnreverse):
+ CASE (Bsetcar):
+ CASE (Bsetcdr):
+ CASE (Bcar_safe):
+ CASE (Bcdr_safe):
+ CASE (Bnumberp):
+ CASE (Bintegerp):
+ {
+ JIT_NEED_STACK;
+ jit_call_with_stack_n (&ctxt, functions[op].ptr,
+ functions[op].name, functions[op].n);
+ JIT_NEXT;
+ NEXT;
+ }
+
+ CASE (Bvarref7):
+ op = FETCH2;
+ goto varref;
+
+ CASE (Bvarref):
+ CASE (Bvarref1):
+ CASE (Bvarref2):
+ CASE (Bvarref3):
+ CASE (Bvarref4):
+ CASE (Bvarref5):
+ op = op - Bvarref;
+ goto varref;
+
+ /* This seems to be the most frequently executed byte-code
+ among the Bvarref's, so avoid a goto here. */
+ CASE (Bvarref6):
+ op = FETCH;
+ varref:
+ {
+ JIT_NEED_STACK;
+ JIT_PUSH (JIT_CONSTANT (jit_type_nuint, vectorp[op]));
+ JIT_CALL_WITH_STACK_N (native_varref, 1);
+ JIT_NEXT;
+ NEXT;
+ }
+
+ CASE (Bvarset):
+ CASE (Bvarset1):
+ CASE (Bvarset2):
+ CASE (Bvarset3):
+ CASE (Bvarset4):
+ CASE (Bvarset5):
+ op -= Bvarset;
+ goto varset;
+
+ CASE (Bvarset7):
+ op = FETCH2;
+ goto varset;
+
+ CASE (Bvarset6):
+ op = FETCH;
+ varset:
+ {
+ JIT_NEED_STACK;
+ JIT_CALL_ARGS (native_varset, JIT_CONSTANT (jit_type_Lisp_Object,
+ vectorp[op]),
+ JIT_POP ());
+
+ JIT_NEXT;
+ NEXT;
+ }
+
+ CASE (Bdup):
+ {
+ JIT_NEED_STACK;
+ JIT_PUSH (JIT_TOP ());
+ JIT_NEXT;
+ NEXT;
+ }
+
+ /* ------------------ */
+
+ CASE (Bvarbind6):
+ op = FETCH;
+ goto varbind;
+
+ CASE (Bvarbind7):
+ op = FETCH2;
+ goto varbind;
+
+ CASE (Bvarbind):
+ CASE (Bvarbind1):
+ CASE (Bvarbind2):
+ CASE (Bvarbind3):
+ CASE (Bvarbind4):
+ CASE (Bvarbind5):
+ op -= Bvarbind;
+ varbind:
+ {
+ JIT_NEED_STACK;
+ JIT_CALL_ARGS (specbind,
+ JIT_CONSTANT (jit_type_Lisp_Object,
+ vectorp[op]),
+ JIT_POP ());
+ JIT_NEXT;
+ NEXT;
+ }
+
+
+ CASE (Bunbind6):
+ op = FETCH;
+ goto dounbind;
+
+ CASE (Bunbind7):
+ op = FETCH2;
+ goto dounbind;
+
+ CASE (Bunbind):
+ CASE (Bunbind1):
+ CASE (Bunbind2):
+ CASE (Bunbind3):
+ CASE (Bunbind4):
+ CASE (Bunbind5):
+ op -= Bunbind;
+ dounbind:
+ {
+ jit_value_t args[] =
+ {
+ JIT_CONSTANT (jit_type_nuint, op),
+ JIT_CONSTANT (jit_type_Lisp_Object, Qnil)
+ };
+ jit_call (&ctxt, (void *)&native_unbind_to, "native_unbind_to",
+ ctxt.stack_many, args, 2);
+ JIT_NEXT;
+ NEXT;
+ }
+
+ CASE (Bunbind_all): /* Obsolete. Never used. */
+ /* To unbind back to the beginning of this frame. Not used yet,
+ but will be needed for tail-recursion elimination. */
+ {
+ jit_value_t args[] =
+ {
+ JIT_CONSTANT (jit_type_nuint, count),
+ JIT_CONSTANT (jit_type_Lisp_Object, Qnil)
+ };
+ jit_call (&ctxt, (void *)&unbind_to, "unbind_to",
+ ctxt.stack_many, args, 2);
+ JIT_NEXT;
+ NEXT;
+ }
+
+ CASE (Bgoto):
+ {
+ op = FETCH2;
+ CHECK_RANGE (op);
+ JIT_CALL (byte_code_quit, NULL, 0);
+ jit_insn_branch (
+ ctxt.func,
+ &labels[op]);
+ NEXT;
+ }
+
+ CASE (Bgotoifnil):
+ CASE (BRgotoifnil):
+ CASE (Bgotoifnonnil):
+ CASE (BRgotoifnonnil):
+ CASE (Bgotoifnilelsepop):
+ CASE (BRgotoifnilelsepop):
+ CASE (Bgotoifnonnilelsepop):
+ CASE (BRgotoifnonnilelsepop):
+ {
+ jit_value_t v2, v3;
+ int insn = op;
+ if (insn >= Bgotoifnil && insn <= Bgotoifnonnilelsepop)
+ op = FETCH2;
+ else
+ {
+ op = FETCH - 128;
+ op += (pc - byte_string_start);
+ }
+ CHECK_RANGE (op);
+ JIT_NEED_STACK;
+ v2 = JIT_POP ();
+ if (insn == Bgotoifnil || insn == BRgotoifnil
+ || insn == Bgotoifnilelsepop || insn == BRgotoifnilelsepop)
+ v3 = JIT_CALL_ARGS (native_ifnil, v2);
+ else
+ v3 = JIT_CALL_ARGS (native_ifnonnil, v2);
+ if (insn == Bgotoifnilelsepop || insn == Bgotoifnonnilelsepop
+ || insn == BRgotoifnilelsepop || insn == BRgotoifnonnilelsepop)
+ JIT_PUSH (v2);
+ jit_insn_branch_if (
+ ctxt.func,
+ v3,
+ &labels[op]);
+ if (insn == Bgotoifnilelsepop || insn == Bgotoifnonnilelsepop
+ || insn == BRgotoifnilelsepop || insn == BRgotoifnonnilelsepop)
+ JIT_INC (ctxt.stack, -sizeof (Lisp_Object));
+ JIT_NEXT;
+ NEXT;
+ }
+
+ CASE (BRgoto):
+ {
+ op = FETCH - 128;
+ const int dest = (pc - byte_string_start) + op;
+ JIT_CALL (byte_code_quit, NULL, 0);
+ jit_insn_branch (
+ ctxt.func,
+ &labels[dest]);
+ NEXT;
+ }
+
+ CASE (Breturn):
+ {
+ JIT_NEED_STACK;
+ jit_insn_return (ctxt.func, JIT_POP ());
+ NEXT;
+ }
+
+ CASE (Bdiscard):
+ {
+ JIT_NEED_STACK;
+ JIT_INC (ctxt.stack, -sizeof (Lisp_Object));
+ JIT_NEXT;
+ NEXT;
+ }
+
+ CASE (Bconstant2):
+ {
+ JIT_NEED_STACK;
+ JIT_PUSH (JIT_CONSTANT (jit_type_Lisp_Object, vectorp[FETCH2]));
+ JIT_NEXT;
+ NEXT;
+ }
+
+ CASE (Bsave_excursion):
+ {
+ JIT_CALL (native_save_excursion, NULL, 0);
+ JIT_NEXT;
+ NEXT;
+ }
+
+ CASE (Bsave_current_buffer): /* Obsolete since ??. */
+ CASE (Bsave_current_buffer_1):
+ {
+ jit_type_t record_unwind_current_buffer_sig;
+ JIT_SIG (record_unwind_current_buffer, jit_type_void);
+ JIT_CALL (record_unwind_current_buffer, NULL, 0);
+ JIT_NEXT;
+ NEXT;
+ }
+
+ CASE (Bsave_restriction):
+ JIT_CALL (native_save_restriction, NULL, 0);
+ JIT_NEXT;
+ NEXT;
+
+ CASE (Bpushcatch): /* New in 24.4. */
+ type = CATCHER;
+ goto pushhandler;
+ CASE (Bpushconditioncase): /* New in 24.4. */
+ type = CONDITION_CASE;
+ pushhandler:
+ {
+ jit_value_t stackp, jmp, result, result2;
+ int dest = FETCH2;
+ JIT_NEED_STACK;
+ stackp = jit_insn_address_of (ctxt.func, ctxt.stack);
+ jmp = JIT_CALL_ARGS (native_pushhandler1, stackp, JIT_POP (),
+ JIT_CONSTANT (jit_type_nint, type));
+ do {
+ void *f;
+ int n;
+ jit_value_t args[2] = { jmp };
+#ifdef HAVE__SETJMP
+ f = (void *)&_setjmp;
+ n = 1;
+#elif defined HAVE_SIGSETJMP
+ f = (void *)&sigsetjmp;
+ n = 2;
+ args[1] = JIT_CONSTANT (jit_type_sys_int, 0);
+#else
+ f = (void *)&setjmp;
+ n = 1;
+#endif
+ result = jit_insn_call_native (ctxt.func, "setjmp", f,
+ setjmp_sig, args, n,
+ JIT_CALL_NOTHROW);
+ } while (0);
+ jit_insn_branch_if_not (ctxt.func, result, &labels[JIT_PC]);
+ JIT_CALL (native_pushhandler2, &stackp, 1);
+ jit_insn_branch (ctxt.func, &labels[dest]);
+ NEXT;
+ }
+
+ CASE (Bpophandler): /* New in 24.4. */
+ {
+ JIT_CALL (native_pophandler, NULL, 0);
+ JIT_NEXT;
+ NEXT;
+ }
+
+ CASE (Bunwind_protect): /* FIXME: avoid closure for lexbind. */
+ {
+ jit_value_t handler;
+ JIT_NEED_STACK;
+ handler = JIT_POP ();
+ JIT_CALL (native_unwind_protect, &handler, 1);
+ JIT_NEXT;
+ NEXT;
+ }
+
+ CASE (Btemp_output_buffer_show): /* Obsolete since 24.1. */
+ {
+ jit_type_t temp_output_buffer_show_sig;
+ jit_value_t v1, v2, c, q;
+ JIT_NEED_STACK;
+ JIT_SIG (temp_output_buffer_show,
+ jit_type_void,
+ jit_type_Lisp_Object);
+ v1 = JIT_POP ();
+ v2 = JIT_POP ();
+ JIT_CALL (temp_output_buffer_show, &v2, 1);
+ JIT_PUSH (v1);
+ c = JIT_CONSTANT (jit_type_nuint, 1);
+ q = JIT_CONSTANT (jit_type_Lisp_Object, Qnil);
+ JIT_CALL_ARGS (native_unbind_to, c, q);
+ JIT_NEXT;
+ NEXT;
+ }
+
+ CASE (Bsub1):
+ {
+ JIT_NEED_STACK;
+ JIT_PUSH (JIT_CALL_ARGS (native_add1, JIT_POP (),
+ JIT_CONSTANT (jit_type_sys_bool, 0)));
+ JIT_NEXT;
+ NEXT;
+ }
+
+ CASE (Badd1):
+ {
+ JIT_NEED_STACK;
+ JIT_PUSH (JIT_CALL_ARGS (native_add1, JIT_POP (),
+ JIT_CONSTANT (jit_type_sys_bool, 1)));
+ JIT_NEXT;
+ NEXT;
+ }
+
+ CASE (Bgtr):
+ CASE (Blss):
+ CASE (Bleq):
+ CASE (Bgeq):
+ {
+ jit_value_t v1, v2, c;
+ enum Arith_Comparison v[] =
+ {
+ ARITH_GRTR,
+ ARITH_LESS,
+ ARITH_LESS_OR_EQUAL,
+ ARITH_GRTR_OR_EQUAL
+ };
+ JIT_NEED_STACK;
+ c = JIT_CONSTANT (jit_type_nuint, v[op-Bgtr]);
+ v2 = JIT_POP ();
+ v1 = JIT_POP ();
+ JIT_PUSH (JIT_CALL_ARGS (arithcompare, v1, v2, c));
+ JIT_NEXT;
+ NEXT;
+ }
+
+ CASE (Bindent_to):
+ {
+ JIT_PUSH (JIT_CONSTANT (jit_type_Lisp_Object, Qnil));
+ JIT_CALL_WITH_STACK_N (Findent_to, 2);
+ JIT_NEXT;
+ NEXT;
+ }
+
+#if BYTE_CODE_SAFE
+ /* These are intentionally written using 'case' syntax,
+ because they are incompatible with the threaded
+ interpreter. */
+
+ case Bset_mark:
+ error ("set-mark is an obsolete bytecode");
+ break;
+ case Bscan_buffer:
+ error ("scan-buffer is an obsolete bytecode");
+ break;
+#endif
+
+ CASE_ABORT:
+ /* Actually this is Bstack_ref with offset 0, but we use Bdup
+ for that instead. */
+ /* CASE (Bstack_ref): */
+ call3 (Qerror,
+ build_string ("Invalid byte opcode: op=%s, ptr=%d"),
+ make_number (op),
+ make_number (pc - 1 - byte_string_start));
+
+ /* Handy byte-codes for lexical binding. */
+ CASE (Bstack_ref1):
+ CASE (Bstack_ref2):
+ CASE (Bstack_ref3):
+ CASE (Bstack_ref4):
+ CASE (Bstack_ref5):
+ CASE (Bstack_ref6):
+ CASE (Bstack_ref7):
+ {
+ jit_value_t v1;
+ int offs = op - Bstack_ref;
+ if (offs == 6)
+ offs = FETCH;
+ else if (offs == 7)
+ offs = FETCH2;
+
+ JIT_NEED_STACK;
+ JIT_INC (ctxt.stack, -offs * sizeof (Lisp_Object));
+ v1 = JIT_TOP ();
+ JIT_INC (ctxt.stack, offs * sizeof (Lisp_Object));
+ JIT_PUSH (v1);
+ JIT_NEXT;
+ NEXT;
+ }
+ CASE (Bstack_set):
+ CASE (Bstack_set2):
+ /* stack-set-0 = discard; stack-set-1 = discard-1-preserve-tos. */
+ {
+ jit_value_t v1;
+ int offs = (op == Bstack_set) ? FETCH : FETCH2;
+ JIT_NEED_STACK;
+ v1 = JIT_TOP ();
+ if (offs != 0)
+ JIT_INC (ctxt.stack, -(offs + 1) * sizeof (Lisp_Object));
+ JIT_PUSH (v1);
+ JIT_INC (ctxt.stack, (offs - 1) * sizeof (Lisp_Object));
+ JIT_NEXT;
+ NEXT;
+ }
+ CASE (BdiscardN):
+ {
+ op = FETCH;
+ JIT_NEED_STACK;
+ if (op & 0x80)
+ {
+ jit_value_t v1;
+ op &= 0x7F;
+ v1 = JIT_TOP ();
+ JIT_INC (ctxt.stack, -(op + 1) * sizeof (Lisp_Object));
+ JIT_PUSH (v1);
+ }
+ else
+ JIT_INC (ctxt.stack, -op * sizeof (Lisp_Object));
+ JIT_NEXT;
+ NEXT;
+ }
+
+ CASE_DEFAULT
+ CASE (Bconstant):
+ {
+ jit_value_t c;
+#if BYTE_CODE_SAFE
+ if (op < Bconstant)
+ {
+ emacs_abort ();
+ }
+ if ((op -= Bconstant) >= const_length)
+ {
+ emacs_abort ();
+ }
+#endif
+ c = JIT_CONSTANT (jit_type_Lisp_Object, vectorp[op - Bconstant]);
+ JIT_PUSH (c);
+ JIT_NEXT;
+ NEXT;
+ }
+ }
+ }
+
+ exit:
+
+ {
+ int err = !jit_function_compile (ctxt.func);
+ jit_context_build_end (ctxt.libjit_ctxt);
+ if (err)
+ emacs_abort ();
+ ASET (byte_code, COMPILED_INTERPRETER, (Lisp_Object )jit_exec);
+ ASET (byte_code, COMPILED_JIT_CTXT, (Lisp_Object )ctxt.libjit_ctxt);
+ ASET (byte_code, COMPILED_JIT_CLOSURE,
+ (Lisp_Object )jit_function_to_closure (ctxt.func));
+ }
+}
+
+DEFUN ("jit-compile", Fjit_compile, Sjit_compile, 1, 1, 0,
+ doc: /* Function used internally in byte-compiled code.
+ The first argument, BYTECODE, is a compiled byte code object. */)
+ (Lisp_Object byte_code)
+{
+ jit_byte_code__ (byte_code);
+ return byte_code;
+}
+
+void
+syms_of_bytecode_jit (void)
+{
+ defsubr (&Sjit_compile);
+ DEFVAR_BOOL ("byte-code-jit-on", byte_code_jit_on,
+ doc: /* If non-nil, compile byte-code to machine code
+ before execution. */);
+ byte_code_jit_on = 0;
+}
+#endif /* HAVE_LIBJIT */
diff --git a/src/bytecode.c b/src/bytecode.c
index 0f7420c19ee..a6019f7c1a5 100644
--- a/src/bytecode.c
+++ b/src/bytecode.c
@@ -19,6 +19,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <config.h>
+#include "bytecode.h"
#include "lisp.h"
#include "blockinput.h"
#include "character.h"
@@ -32,25 +33,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
# pragma GCC diagnostic ignored "-Wclobbered"
#endif
-/* Define BYTE_CODE_SAFE true to enable some minor sanity checking,
- useful for debugging the byte compiler. It defaults to false. */
-
-#ifndef BYTE_CODE_SAFE
-# define BYTE_CODE_SAFE false
-#endif
-
-/* Define BYTE_CODE_METER to generate a byte-op usage histogram. */
-/* #define BYTE_CODE_METER */
-
-/* If BYTE_CODE_THREADED is defined, then the interpreter will be
- indirect threaded, using GCC's computed goto extension. This code,
- as currently implemented, is incompatible with BYTE_CODE_SAFE and
- BYTE_CODE_METER. */
-#if (defined __GNUC__ && !defined __STRICT_ANSI__ && !defined __CHKP__ \
- && !BYTE_CODE_SAFE && !defined BYTE_CODE_METER)
-#define BYTE_CODE_THREADED
-#endif
-
#ifdef BYTE_CODE_METER
@@ -74,212 +56,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
}
#endif /* BYTE_CODE_METER */
-
-/* Byte codes: */
-
-#define BYTE_CODES \
-DEFINE (Bstack_ref, 0) /* Actually, Bstack_ref+0 is not implemented: use dup. */ \
-DEFINE (Bstack_ref1, 1) \
-DEFINE (Bstack_ref2, 2) \
-DEFINE (Bstack_ref3, 3) \
-DEFINE (Bstack_ref4, 4) \
-DEFINE (Bstack_ref5, 5) \
-DEFINE (Bstack_ref6, 6) \
-DEFINE (Bstack_ref7, 7) \
-DEFINE (Bvarref, 010) \
-DEFINE (Bvarref1, 011) \
-DEFINE (Bvarref2, 012) \
-DEFINE (Bvarref3, 013) \
-DEFINE (Bvarref4, 014) \
-DEFINE (Bvarref5, 015) \
-DEFINE (Bvarref6, 016) \
-DEFINE (Bvarref7, 017) \
-DEFINE (Bvarset, 020) \
-DEFINE (Bvarset1, 021) \
-DEFINE (Bvarset2, 022) \
-DEFINE (Bvarset3, 023) \
-DEFINE (Bvarset4, 024) \
-DEFINE (Bvarset5, 025) \
-DEFINE (Bvarset6, 026) \
-DEFINE (Bvarset7, 027) \
-DEFINE (Bvarbind, 030) \
-DEFINE (Bvarbind1, 031) \
-DEFINE (Bvarbind2, 032) \
-DEFINE (Bvarbind3, 033) \
-DEFINE (Bvarbind4, 034) \
-DEFINE (Bvarbind5, 035) \
-DEFINE (Bvarbind6, 036) \
-DEFINE (Bvarbind7, 037) \
-DEFINE (Bcall, 040) \
-DEFINE (Bcall1, 041) \
-DEFINE (Bcall2, 042) \
-DEFINE (Bcall3, 043) \
-DEFINE (Bcall4, 044) \
-DEFINE (Bcall5, 045) \
-DEFINE (Bcall6, 046) \
-DEFINE (Bcall7, 047) \
-DEFINE (Bunbind, 050) \
-DEFINE (Bunbind1, 051) \
-DEFINE (Bunbind2, 052) \
-DEFINE (Bunbind3, 053) \
-DEFINE (Bunbind4, 054) \
-DEFINE (Bunbind5, 055) \
-DEFINE (Bunbind6, 056) \
-DEFINE (Bunbind7, 057) \
- \
-DEFINE (Bpophandler, 060) \
-DEFINE (Bpushconditioncase, 061) \
-DEFINE (Bpushcatch, 062) \
- \
-DEFINE (Bnth, 070) \
-DEFINE (Bsymbolp, 071) \
-DEFINE (Bconsp, 072) \
-DEFINE (Bstringp, 073) \
-DEFINE (Blistp, 074) \
-DEFINE (Beq, 075) \
-DEFINE (Bmemq, 076) \
-DEFINE (Bnot, 077) \
-DEFINE (Bcar, 0100) \
-DEFINE (Bcdr, 0101) \
-DEFINE (Bcons, 0102) \
-DEFINE (Blist1, 0103) \
-DEFINE (Blist2, 0104) \
-DEFINE (Blist3, 0105) \
-DEFINE (Blist4, 0106) \
-DEFINE (Blength, 0107) \
-DEFINE (Baref, 0110) \
-DEFINE (Baset, 0111) \
-DEFINE (Bsymbol_value, 0112) \
-DEFINE (Bsymbol_function, 0113) \
-DEFINE (Bset, 0114) \
-DEFINE (Bfset, 0115) \
-DEFINE (Bget, 0116) \
-DEFINE (Bsubstring, 0117) \
-DEFINE (Bconcat2, 0120) \
-DEFINE (Bconcat3, 0121) \
-DEFINE (Bconcat4, 0122) \
-DEFINE (Bsub1, 0123) \
-DEFINE (Badd1, 0124) \
-DEFINE (Beqlsign, 0125) \
-DEFINE (Bgtr, 0126) \
-DEFINE (Blss, 0127) \
-DEFINE (Bleq, 0130) \
-DEFINE (Bgeq, 0131) \
-DEFINE (Bdiff, 0132) \
-DEFINE (Bnegate, 0133) \
-DEFINE (Bplus, 0134) \
-DEFINE (Bmax, 0135) \
-DEFINE (Bmin, 0136) \
-DEFINE (Bmult, 0137) \
- \
-DEFINE (Bpoint, 0140) \
-/* Was Bmark in v17. */ \
-DEFINE (Bsave_current_buffer, 0141) /* Obsolete. */ \
-DEFINE (Bgoto_char, 0142) \
-DEFINE (Binsert, 0143) \
-DEFINE (Bpoint_max, 0144) \
-DEFINE (Bpoint_min, 0145) \
-DEFINE (Bchar_after, 0146) \
-DEFINE (Bfollowing_char, 0147) \
-DEFINE (Bpreceding_char, 0150) \
-DEFINE (Bcurrent_column, 0151) \
-DEFINE (Bindent_to, 0152) \
-DEFINE (Beolp, 0154) \
-DEFINE (Beobp, 0155) \
-DEFINE (Bbolp, 0156) \
-DEFINE (Bbobp, 0157) \
-DEFINE (Bcurrent_buffer, 0160) \
-DEFINE (Bset_buffer, 0161) \
-DEFINE (Bsave_current_buffer_1, 0162) /* Replacing Bsave_current_buffer. */ \
-DEFINE (Binteractive_p, 0164) /* Obsolete since Emacs-24.1. */ \
- \
-DEFINE (Bforward_char, 0165) \
-DEFINE (Bforward_word, 0166) \
-DEFINE (Bskip_chars_forward, 0167) \
-DEFINE (Bskip_chars_backward, 0170) \
-DEFINE (Bforward_line, 0171) \
-DEFINE (Bchar_syntax, 0172) \
-DEFINE (Bbuffer_substring, 0173) \
-DEFINE (Bdelete_region, 0174) \
-DEFINE (Bnarrow_to_region, 0175) \
-DEFINE (Bwiden, 0176) \
-DEFINE (Bend_of_line, 0177) \
- \
-DEFINE (Bconstant2, 0201) \
-DEFINE (Bgoto, 0202) \
-DEFINE (Bgotoifnil, 0203) \
-DEFINE (Bgotoifnonnil, 0204) \
-DEFINE (Bgotoifnilelsepop, 0205) \
-DEFINE (Bgotoifnonnilelsepop, 0206) \
-DEFINE (Breturn, 0207) \
-DEFINE (Bdiscard, 0210) \
-DEFINE (Bdup, 0211) \
- \
-DEFINE (Bsave_excursion, 0212) \
-DEFINE (Bsave_window_excursion, 0213) /* Obsolete since Emacs-24.1. */ \
-DEFINE (Bsave_restriction, 0214) \
-DEFINE (Bcatch, 0215) \
- \
-DEFINE (Bunwind_protect, 0216) \
-DEFINE (Bcondition_case, 0217) \
-DEFINE (Btemp_output_buffer_setup, 0220) /* Obsolete since Emacs-24.1. */ \
-DEFINE (Btemp_output_buffer_show, 0221) /* Obsolete since Emacs-24.1. */ \
- \
-DEFINE (Bunbind_all, 0222) /* Obsolete. Never used. */ \
- \
-DEFINE (Bset_marker, 0223) \
-DEFINE (Bmatch_beginning, 0224) \
-DEFINE (Bmatch_end, 0225) \
-DEFINE (Bupcase, 0226) \
-DEFINE (Bdowncase, 0227) \
- \
-DEFINE (Bstringeqlsign, 0230) \
-DEFINE (Bstringlss, 0231) \
-DEFINE (Bequal, 0232) \
-DEFINE (Bnthcdr, 0233) \
-DEFINE (Belt, 0234) \
-DEFINE (Bmember, 0235) \
-DEFINE (Bassq, 0236) \
-DEFINE (Bnreverse, 0237) \
-DEFINE (Bsetcar, 0240) \
-DEFINE (Bsetcdr, 0241) \
-DEFINE (Bcar_safe, 0242) \
-DEFINE (Bcdr_safe, 0243) \
-DEFINE (Bnconc, 0244) \
-DEFINE (Bquo, 0245) \
-DEFINE (Brem, 0246) \
-DEFINE (Bnumberp, 0247) \
-DEFINE (Bintegerp, 0250) \
- \
-DEFINE (BRgoto, 0252) \
-DEFINE (BRgotoifnil, 0253) \
-DEFINE (BRgotoifnonnil, 0254) \
-DEFINE (BRgotoifnilelsepop, 0255) \
-DEFINE (BRgotoifnonnilelsepop, 0256) \
- \
-DEFINE (BlistN, 0257) \
-DEFINE (BconcatN, 0260) \
-DEFINE (BinsertN, 0261) \
- \
-/* Bstack_ref is code 0. */ \
-DEFINE (Bstack_set, 0262) \
-DEFINE (Bstack_set2, 0263) \
-DEFINE (BdiscardN, 0266) \
- \
-DEFINE (Bconstant, 0300)
-
-enum byte_code_op
-{
-#define DEFINE(name, value) name = value,
- BYTE_CODES
-#undef DEFINE
-
-#if BYTE_CODE_SAFE
- Bscan_buffer = 0153, /* No longer generated as of v18. */
- Bset_mark = 0163, /* this loser is no longer generated as of v18 */
-#endif
-};
/* Fetch the next byte from the bytecode stream. */
@@ -316,10 +93,10 @@ the third, MAXDEPTH, the maximum stack depth used in this function.
If the third argument is incorrect, Emacs may crash. */)
(Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth)
{
- return exec_byte_code (bytestr, vector, maxdepth, Qnil, 0, NULL);
+ return exec_byte_code__ (bytestr, vector, maxdepth, Qnil, 0, NULL);
}
-static void
+void
bcall0 (Lisp_Object f)
{
Ffuncall (1, &f);
@@ -334,8 +111,8 @@ bcall0 (Lisp_Object f)
executing BYTESTR. */
Lisp_Object
-exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
- Lisp_Object args_template, ptrdiff_t nargs, Lisp_Object *args)
+exec_byte_code__ (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
+ Lisp_Object args_template, ptrdiff_t nargs, Lisp_Object *args)
{
#ifdef BYTE_CODE_METER
int volatile this_op = 0;
@@ -463,7 +240,6 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
{
[0 ... (Bconstant - 1)] = &&insn_default,
[Bconstant ... 255] = &&insn_Bconstant,
-
#define DEFINE(name, value) LABEL (name) ,
BYTE_CODES
#undef DEFINE
@@ -1436,6 +1212,25 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
return result;
}
+Lisp_Object
+exec_byte_code (Lisp_Object byte_code, Lisp_Object args_template,
+ ptrdiff_t nargs, Lisp_Object *args)
+{
+#ifdef HAVE_LIBJIT
+ if (byte_code_jit_on)
+ {
+ jit_byte_code__ (byte_code);
+ return jit_exec (byte_code, args_template, nargs, args);
+ }
+ else
+#endif
+ return exec_byte_code__ (AREF (byte_code, COMPILED_BYTECODE),
+ AREF (byte_code, COMPILED_CONSTANTS),
+ AREF (byte_code, COMPILED_STACK_DEPTH),
+ args_template, nargs, args);
+}
+
+
/* `args_template' has the same meaning as in exec_byte_code() above. */
Lisp_Object
get_byte_code_arity (Lisp_Object args_template)
diff --git a/src/bytecode.h b/src/bytecode.h
new file mode 100644
index 00000000000..18c9c267069
--- /dev/null
+++ b/src/bytecode.h
@@ -0,0 +1,320 @@
+/* Shared definitions for src/bytecode{,-jit}.c
+ Copyright (C) 2016 Free Software Foundation, Inc.
+
+This file is part of GNU Emacs.
+
+GNU Emacs is free software: you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation, either version 3 of the License, or (at
+your option) any later version.
+
+GNU Emacs is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
+
+#include <config.h>
+
+#include "lisp.h"
+
+/* Define BYTE_CODE_SAFE true to enable some minor sanity checking,
+ useful for debugging the byte compiler. It defaults to false. */
+
+#ifndef BYTE_CODE_SAFE
+# define BYTE_CODE_SAFE false
+#endif
+
+/* Define BYTE_CODE_METER to generate a byte-op usage histogram. */
+/* #define BYTE_CODE_METER */
+
+/* If BYTE_CODE_THREADED is defined, then the interpreter will be
+ indirect threaded, using GCC's computed goto extension. This code,
+ as currently implemented, is incompatible with BYTE_CODE_SAFE and
+ BYTE_CODE_METER. */
+#if (defined __GNUC__ && !defined __STRICT_ANSI__ && !defined __CHKP__ \
+ && !BYTE_CODE_SAFE && !defined BYTE_CODE_METER)
+#define BYTE_CODE_THREADED
+#endif
+
+/* Byte codes: */
+
+#define BYTE_CODES \
+ DEFINE (Bstack_ref, 0) /* Actually, Bstack_ref+0 is not implemented: use dup. */ \
+ DEFINE (Bstack_ref1, 1) \
+ DEFINE (Bstack_ref2, 2) \
+ DEFINE (Bstack_ref3, 3) \
+ DEFINE (Bstack_ref4, 4) \
+ DEFINE (Bstack_ref5, 5) \
+ DEFINE (Bstack_ref6, 6) \
+ DEFINE (Bstack_ref7, 7) \
+ DEFINE (Bvarref, 010) \
+ DEFINE (Bvarref1, 011) \
+ DEFINE (Bvarref2, 012) \
+ DEFINE (Bvarref3, 013) \
+ DEFINE (Bvarref4, 014) \
+ DEFINE (Bvarref5, 015) \
+ DEFINE (Bvarref6, 016) \
+ DEFINE (Bvarref7, 017) \
+ DEFINE (Bvarset, 020) \
+ DEFINE (Bvarset1, 021) \
+ DEFINE (Bvarset2, 022) \
+ DEFINE (Bvarset3, 023) \
+ DEFINE (Bvarset4, 024) \
+ DEFINE (Bvarset5, 025) \
+ DEFINE (Bvarset6, 026) \
+ DEFINE (Bvarset7, 027) \
+ DEFINE (Bvarbind, 030) \
+ DEFINE (Bvarbind1, 031) \
+ DEFINE (Bvarbind2, 032) \
+ DEFINE (Bvarbind3, 033) \
+ DEFINE (Bvarbind4, 034) \
+ DEFINE (Bvarbind5, 035) \
+ DEFINE (Bvarbind6, 036) \
+ DEFINE (Bvarbind7, 037) \
+ DEFINE_MANY (Bcall, 040, Ffuncall, 1) \
+ DEFINE_MANY (Bcall1, 041, Ffuncall, 2) \
+ DEFINE_MANY (Bcall2, 042, Ffuncall, 3) \
+ DEFINE_MANY (Bcall3, 043, Ffuncall, 4) \
+ DEFINE_MANY (Bcall4, 044, Ffuncall, 5) \
+ DEFINE_MANY (Bcall5, 045, Ffuncall, 6) \
+ DEFINE_MANY (Bcall6, 046, Ffuncall, -1) \
+ DEFINE_MANY (Bcall7, 047, Ffuncall, -2) \
+ DEFINE (Bunbind, 050) \
+ DEFINE (Bunbind1, 051) \
+ DEFINE (Bunbind2, 052) \
+ DEFINE (Bunbind3, 053) \
+ DEFINE (Bunbind4, 054) \
+ DEFINE (Bunbind5, 055) \
+ DEFINE (Bunbind6, 056) \
+ DEFINE (Bunbind7, 057) \
+ \
+ DEFINE (Bpophandler, 060) \
+ DEFINE (Bpushconditioncase, 061) \
+ DEFINE (Bpushcatch, 062) \
+ \
+ DEFINE_FIXED (Bnth, 070, native_nth, 2) \
+ DEFINE_FIXED (Bsymbolp, 071, native_symbolp, 1) \
+ DEFINE_FIXED (Bconsp, 072, native_consp, 1) \
+ DEFINE_FIXED (Bstringp, 073, native_stringp, 1) \
+ DEFINE_FIXED (Blistp, 074, native_listp, 1) \
+ DEFINE_FIXED (Beq, 075, native_eq, 2) \
+ DEFINE_FIXED (Bmemq, 076, native_memq, 2) \
+ DEFINE_FIXED (Bnot, 077, native_not, 1) \
+ DEFINE_FIXED (Bcar, 0100, native_car, 1) \
+ DEFINE_FIXED (Bcdr, 0101, native_cdr, 1) \
+ DEFINE_FIXED (Bcons, 0102, Fcons, 2) \
+ DEFINE_FIXED (Blist1, 0103, list1, 1) \
+ DEFINE_FIXED (Blist2, 0104, list2, 2) \
+ DEFINE_MANY (Blist3, 0105, Flist, 3) \
+ DEFINE_MANY (Blist4, 0106, Flist, 4) \
+ DEFINE_FIXED (Blength, 0107, Flength, 1) \
+ DEFINE_FIXED (Baref, 0110, Faref, 2) \
+ DEFINE_FIXED (Baset, 0111, Faset, 3) \
+ DEFINE_FIXED (Bsymbol_value, 0112, Fsymbol_value, 1) \
+ DEFINE_FIXED (Bsymbol_function, 0113, Fsymbol_function, 1) \
+ DEFINE_FIXED (Bset, 0114, Fset, 2) \
+ DEFINE_FIXED (Bfset, 0115, Ffset, 2) \
+ DEFINE_FIXED (Bget, 0116, Fget, 2) \
+ DEFINE_FIXED (Bsubstring, 0117, Fsubstring, 3) \
+ DEFINE_MANY (Bconcat2, 0120, Fconcat, 2) \
+ DEFINE_MANY (Bconcat3, 0121, Fconcat, 3) \
+ DEFINE_MANY (Bconcat4, 0122, Fconcat, 4) \
+ DEFINE (Bsub1, 0123) \
+ DEFINE (Badd1, 0124) \
+ DEFINE_FIXED (Beqlsign, 0125, native_eqlsign, 2) \
+ DEFINE (Bgtr, 0126) \
+ DEFINE (Blss, 0127) \
+ DEFINE (Bleq, 0130) \
+ DEFINE (Bgeq, 0131) \
+ DEFINE_MANY (Bdiff, 0132, Fminus, 2) \
+ DEFINE_FIXED (Bnegate, 0133, native_negate, 1) \
+ DEFINE_MANY (Bplus, 0134, Fplus, 2) \
+ DEFINE_MANY (Bmax, 0135, Fmax, 2) \
+ DEFINE_MANY (Bmin, 0136, Fmin, 2) \
+ DEFINE_MANY (Bmult, 0137, Ftimes, 2) \
+ \
+ DEFINE_FIXED (Bpoint, 0140, native_point, 0) \
+ /* Was Bmark in v17. */ \
+ DEFINE (Bsave_current_buffer, 0141) /* Obsolete. */ \
+ DEFINE_FIXED (Bgoto_char, 0142, Fgoto_char, 1) \
+ DEFINE_MANY (Binsert, 0143, Finsert, 1) \
+ DEFINE_FIXED (Bpoint_max, 0144, native_point_max, 0) \
+ DEFINE_FIXED (Bpoint_min, 0145, native_point_min, 0) \
+ DEFINE_FIXED (Bchar_after, 0146, Fchar_after, 1) \
+ DEFINE_FIXED (Bfollowing_char, 0147, Ffollowing_char, 0) \
+ DEFINE_FIXED (Bpreceding_char, 0150, Fprevious_char, 0) \
+ DEFINE_FIXED (Bcurrent_column, 0151, native_current_column, 0) \
+ DEFINE (Bindent_to, 0152) \
+ DEFINE_FIXED (Beolp, 0154, Feolp, 0) \
+ DEFINE_FIXED (Beobp, 0155, Feobp, 0) \
+ DEFINE_FIXED (Bbolp, 0156, Fbolp, 0) \
+ DEFINE_FIXED (Bbobp, 0157, Fbobp, 0) \
+ DEFINE_FIXED (Bcurrent_buffer, 0160, Fcurrent_buffer, 0) \
+ DEFINE_FIXED (Bset_buffer, 0161, Fset_buffer, 1) \
+ DEFINE (Bsave_current_buffer_1, 0162) /* Replacing Bsave_current_buffer. */ \
+ DEFINE_FIXED (Binteractive_p, 0164, native_interactive_p, 0) /* Obsolete since Emacs-24.1. */ \
+ \
+ DEFINE_FIXED (Bforward_char, 0165, Fforward_char, 1) \
+ DEFINE_FIXED (Bforward_word, 0166, Fforward_word, 1) \
+ DEFINE_FIXED (Bskip_chars_forward, 0167, Fskip_chars_forward, 2) \
+ DEFINE_FIXED (Bskip_chars_backward, 0170, Fskip_chars_backward, 2) \
+ DEFINE_FIXED (Bforward_line, 0171, Fforward_line, 1) \
+ DEFINE_FIXED (Bchar_syntax, 0172, native_char_syntax, 1) \
+ DEFINE_FIXED (Bbuffer_substring, 0173, Fbuffer_substring, 2) \
+ DEFINE_FIXED (Bdelete_region, 0174, Fdelete_region, 2) \
+ DEFINE_FIXED (Bnarrow_to_region, 0175, Fnarrow_to_region, 2) \
+ DEFINE_FIXED (Bwiden, 0176, Fwiden, 0) \
+ DEFINE_FIXED (Bend_of_line, 0177, Fend_of_line, 1) \
+ \
+ DEFINE (Bconstant2, 0201) \
+ DEFINE (Bgoto, 0202) \
+ DEFINE (Bgotoifnil, 0203) \
+ DEFINE (Bgotoifnonnil, 0204) \
+ DEFINE (Bgotoifnilelsepop, 0205) \
+ DEFINE (Bgotoifnonnilelsepop, 0206) \
+ DEFINE (Breturn, 0207) \
+ DEFINE (Bdiscard, 0210) \
+ DEFINE (Bdup, 0211) \
+ \
+ DEFINE (Bsave_excursion, 0212) \
+ DEFINE_FIXED (Bsave_window_excursion, 0213, native_save_window_excursion, 1) /* Obsolete since Emacs-24.1. */ \
+ DEFINE (Bsave_restriction, 0214) \
+ DEFINE_FIXED (Bcatch, 0215, native_catch, 2) \
+ \
+ DEFINE (Bunwind_protect, 0216) \
+ DEFINE_FIXED (Bcondition_case, 0217, internal_lisp_condition_case, 3) \
+ DEFINE_FIXED (Btemp_output_buffer_setup, 0220, native_temp_output_buffer_setup, 1) /* Obsolete since Emacs-24.1. */ \
+ DEFINE (Btemp_output_buffer_show, 0221) /* Obsolete since Emacs-24.1. */ \
+ \
+ DEFINE (Bunbind_all, 0222) /* Obsolete. Never used. */ \
+ \
+ DEFINE_FIXED (Bset_marker, 0223, Fset_marker, 3) \
+ DEFINE_FIXED (Bmatch_beginning, 0224, Fmatch_beginning, 1) \
+ DEFINE_FIXED (Bmatch_end, 0225, Fmatch_end, 1) \
+ DEFINE_FIXED (Bupcase, 0226, Fupcase, 1) \
+ DEFINE_FIXED (Bdowncase, 0227, Fdowncase, 1) \
+ \
+ DEFINE_FIXED (Bstringeqlsign, 0230, Fstring_equal, 2) \
+ DEFINE_FIXED (Bstringlss, 0231, Fstring_lessp, 2) \
+ DEFINE_FIXED (Bequal, 0232, Fequal, 2) \
+ DEFINE_FIXED (Bnthcdr, 0233, Fnthcdr, 2) \
+ DEFINE_FIXED (Belt, 0234, native_elt, 2) \
+ DEFINE_FIXED (Bmember, 0235, Fmember, 2) \
+ DEFINE_FIXED (Bassq, 0236, Fassq, 2) \
+ DEFINE_FIXED (Bnreverse, 0237, Fnreverse, 1) \
+ DEFINE_FIXED (Bsetcar, 0240, Fsetcar, 2) \
+ DEFINE_FIXED (Bsetcdr, 0241, Fsetcdr, 2) \
+ DEFINE_FIXED (Bcar_safe, 0242, native_car_safe, 1) \
+ DEFINE_FIXED (Bcdr_safe, 0243, native_cdr_safe, 1) \
+ DEFINE_MANY (Bnconc, 0244, Fnconc, 2) \
+ DEFINE_MANY (Bquo, 0245, Fquo, 2) \
+ DEFINE_FIXED (Brem, 0246, Frem, 2) \
+ DEFINE_FIXED (Bnumberp, 0247, native_number_p, 1) \
+ DEFINE_FIXED (Bintegerp, 0250, native_integer_p, 1) \
+ \
+ DEFINE (BRgoto, 0252) \
+ DEFINE (BRgotoifnil, 0253) \
+ DEFINE (BRgotoifnonnil, 0254) \
+ DEFINE (BRgotoifnilelsepop, 0255) \
+ DEFINE (BRgotoifnonnilelsepop, 0256) \
+ \
+ DEFINE_MANY (BlistN, 0257, Flist, -1) \
+ DEFINE_MANY (BconcatN, 0260, Fconcat, -1) \
+ DEFINE_MANY (BinsertN, 0261, Finsert, -1) \
+ \
+ /* Bstack_ref is code 0. */ \
+ DEFINE (Bstack_set, 0262) \
+ DEFINE (Bstack_set2, 0263) \
+ DEFINE (BdiscardN, 0266) \
+ \
+ DEFINE (Bconstant, 0300)
+
+enum byte_code_op
+{
+#define DEFINE_FIXED(bname, value, fname, num) DEFINE (bname, value)
+#define DEFINE_MANY(bname, value, fname, num) \
+ DEFINE_FIXED (bname, value, fname, num)
+#define DEFINE(name, value) name = value,
+ BYTE_CODES
+#undef DEFINE
+
+#if BYTE_CODE_SAFE
+ Bscan_buffer = 0153, /* No longer generated as of v18. */
+ Bset_mark = 0163, /* this loser is no longer generated as of v18 */
+#endif
+};
+
+/* Whether to maintain a `top' and `bottom' field in the stack frame. */
+#define BYTE_MAINTAIN_TOP BYTE_CODE_SAFE
+
+/* Structure describing a value stack used during byte-code execution
+ in Fbyte_code. */
+
+struct byte_stack
+{
+ /* Program counter. This points into the byte_string below
+ and is relocated when that string is relocated. */
+ const unsigned char *pc;
+
+ /* Top and bottom of stack. The bottom points to an area of memory
+ allocated with alloca in Fbyte_code. */
+#if BYTE_MAINTAIN_TOP
+ Lisp_Object *top, *bottom;
+#endif
+
+ /* The string containing the byte-code, and its current address.
+ Storing this here protects it from GC because mark_byte_stack
+ marks it. */
+ Lisp_Object byte_string;
+ const unsigned char *byte_string_start;
+
+ /* Next entry in byte_stack_list. */
+ struct byte_stack *next;
+};
+
+/* A list of currently active byte-code execution value stacks.
+ Fbyte_code adds an entry to the head of this list before it starts
+ processing byte-code, and it removes the entry again when it is
+ done. Signaling an error truncates the list.
+
+ byte_stack_list is a macro defined in thread.h. */
+/* struct byte_stack *byte_stack_list; */
+
+/* Actions that must be performed before and after calling a function
+ that might GC. */
+
+#if !BYTE_MAINTAIN_TOP
+#define BEFORE_POTENTIAL_GC() ((void)0)
+#define AFTER_POTENTIAL_GC() ((void)0)
+#else
+#define BEFORE_POTENTIAL_GC() stack.top = top
+#define AFTER_POTENTIAL_GC() stack.top = NULL
+#endif
+
+/* Garbage collect if we have consed enough since the last time.
+ We do this at every branch, to avoid loops that never GC. */
+
+#define MAYBE_GC() \
+ do { \
+ BEFORE_POTENTIAL_GC (); \
+ maybe_gc (); \
+ AFTER_POTENTIAL_GC (); \
+ } while (0)
+
+extern void
+bcall0 (Lisp_Object f);
+
+extern Lisp_Object
+exec_byte_code__ (Lisp_Object, Lisp_Object, Lisp_Object,
+ Lisp_Object, ptrdiff_t, Lisp_Object *);
+
+#ifdef HAVE_LIBJIT
+extern void
+jit_byte_code__ (Lisp_Object);
+
+extern Lisp_Object
+jit_exec (Lisp_Object, Lisp_Object, ptrdiff_t, Lisp_Object *);
+#endif
diff --git a/src/data.c b/src/data.c
index 8e07bf01b44..c73f04cf638 100644
--- a/src/data.c
+++ b/src/data.c
@@ -3578,6 +3578,7 @@ syms_of_data (void)
DEFSYM (Qsequencep, "sequencep");
DEFSYM (Qbufferp, "bufferp");
DEFSYM (Qvectorp, "vectorp");
+ DEFSYM (Qcompiledp, "compiledp");
DEFSYM (Qbool_vector_p, "bool-vector-p");
DEFSYM (Qchar_or_string_p, "char-or-string-p");
DEFSYM (Qmarkerp, "markerp");
diff --git a/src/emacs.c b/src/emacs.c
index 28b395c4fb4..fa2b6ebb9c6 100644
--- a/src/emacs.c
+++ b/src/emacs.c
@@ -1457,6 +1457,9 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem
syms_of_buffer ();
syms_of_bytecode ();
+#ifdef HAVE_LIBJIT
+ syms_of_bytecode_jit ();
+#endif
syms_of_callint ();
syms_of_casefiddle ();
syms_of_casetab ();
diff --git a/src/eval.c b/src/eval.c
index 22b02b49521..54a646b69e9 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -2962,11 +2962,11 @@ funcall_lambda (Lisp_Object fun, ptrdiff_t nargs,
and constants vector yet, fetch them from the file. */
if (CONSP (AREF (fun, COMPILED_BYTECODE)))
Ffetch_bytecode (fun);
- return exec_byte_code (AREF (fun, COMPILED_BYTECODE),
- AREF (fun, COMPILED_CONSTANTS),
- AREF (fun, COMPILED_STACK_DEPTH),
- syms_left,
- nargs, arg_vector);
+ Lisp_Object (*interpreter)(Lisp_Object, Lisp_Object,
+ ptrdiff_t, Lisp_Object *) =
+ (void *)AREF (fun, COMPILED_INTERPRETER);
+ return interpreter (fun, syms_left,
+ nargs, arg_vector);
}
lexenv = Qnil;
}
@@ -3040,10 +3040,10 @@ funcall_lambda (Lisp_Object fun, ptrdiff_t nargs,
and constants vector yet, fetch them from the file. */
if (CONSP (AREF (fun, COMPILED_BYTECODE)))
Ffetch_bytecode (fun);
- val = exec_byte_code (AREF (fun, COMPILED_BYTECODE),
- AREF (fun, COMPILED_CONSTANTS),
- AREF (fun, COMPILED_STACK_DEPTH),
- Qnil, 0, 0);
+ Lisp_Object (*interpreter)(Lisp_Object, Lisp_Object,
+ ptrdiff_t, Lisp_Object *) =
+ (void *)AREF (fun, COMPILED_INTERPRETER);
+ val = interpreter (fun, Qnil, 0, 0);
}
return unbind_to (count, val);
diff --git a/src/lisp.h b/src/lisp.h
index 1ac38164c27..44b59f6bac5 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -2657,7 +2657,10 @@ enum Lisp_Compiled
COMPILED_CONSTANTS = 2,
COMPILED_STACK_DEPTH = 3,
COMPILED_DOC_STRING = 4,
- COMPILED_INTERACTIVE = 5
+ COMPILED_INTERACTIVE = 5,
+ COMPILED_INTERPRETER = 6,
+ COMPILED_JIT_CTXT = 7,
+ COMPILED_JIT_CLOSURE = 8
};
/* Flag bits in a character. These also get used in termhooks.h.
@@ -2769,6 +2772,11 @@ CHECK_STRING_CAR (Lisp_Object x)
{
CHECK_TYPE (STRINGP (XCAR (x)), Qstringp, XCAR (x));
}
+INLINE void
+CHECK_COMPILED (Lisp_Object x)
+{
+ CHECK_TYPE (COMPILEDP (x), Qcompiledp, x);
+}
/* This is a bit special because we always need size afterwards. */
INLINE ptrdiff_t
CHECK_VECTOR_OR_STRING (Lisp_Object x)
@@ -3101,6 +3109,7 @@ struct handler
enum handlertype type;
Lisp_Object tag_or_ch;
Lisp_Object val;
+ Lisp_Object *stack;
struct handler *next;
struct handler *nextfree;
@@ -3602,7 +3611,6 @@ build_string (const char *str)
}
extern Lisp_Object pure_cons (Lisp_Object, Lisp_Object);
-extern void make_byte_code (struct Lisp_Vector *);
extern struct Lisp_Vector *allocate_vector (EMACS_INT);
/* Make an uninitialized vector for SIZE objects. NOTE: you must
@@ -4159,10 +4167,14 @@ extern int read_bytecode_char (bool);
/* Defined in bytecode.c. */
extern void syms_of_bytecode (void);
-extern Lisp_Object exec_byte_code (Lisp_Object, Lisp_Object, Lisp_Object,
- Lisp_Object, ptrdiff_t, Lisp_Object *);
+extern Lisp_Object exec_byte_code (Lisp_Object, Lisp_Object, ptrdiff_t, Lisp_Object *);
extern Lisp_Object get_byte_code_arity (Lisp_Object);
+/* Defined in bytecode-jit.c */
+#ifdef HAVE_LIBJIT
+extern void syms_of_bytecode_jit (void);
+#endif
+
/* Defined in macros.c. */
extern void init_macros (void);
extern void syms_of_macros (void);
diff --git a/src/lread.c b/src/lread.c
index 094aa628eec..f0a764f2dea 100644
--- a/src/lread.c
+++ b/src/lread.c
@@ -2755,14 +2755,14 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list)
{
/* Accept compiled functions at read-time so that we don't have to
build them using function calls. */
- Lisp_Object tmp;
+ Lisp_Object tmp, ret;
struct Lisp_Vector *vec;
tmp = read_vector (readcharfun, 1);
vec = XVECTOR (tmp);
if (vec->header.size == 0)
invalid_syntax ("Empty byte-code object");
- make_byte_code (vec);
- return tmp;
+ ret = Fmake_byte_code (vec->header.size, vec->contents);
+ return ret;
}
if (c == '(')
{
View Lorry Controller Status