From: Nickolas Lloyd Date: Sat, 12 Nov 2016 23:48:04 +0000 (-0500) Subject: Add bytecode JIT compilation capabilities X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=e0b099f10d916396fc638c25c847ad82e500df69;p=emacs.git Add bytecode JIT compilation capabilities This change adds several functions that utilize GNU libjit to compile byte-compiled lisp functions to machine code. The functionality is exposed in two ways: specific functions can be JIT compiled from lisp with the `jit-compile' function, or JIT compilation can be enabled globally by setting `byte-code-jit-on' to non-nil. Once the function has been JIT compiled, the machine-code version will be executed in place of the bytecode version. * src/bytecode-jit.c (native_varref, native_ifnil, native_ifnonnil) (native_car, native_eq, native_memq, native_cdr, native_varset) (native_unbind_to, byte_code_quit, native_save_excursion) (native_save_restriction, native_save_window_excursion, native_catch) (native_pophandler, native_pushhandler1, native_pushhandler2) (native_unwind_protect, native_temp_output_buffer_setup, native_nth) (native_symbolp, native_consp, native_stringp, native_listp, native_not) (native_add1, native_eqlsign, native_negate, native_point, native_point_max) (native_point_min, native_current_column, native_interactive_p) (native_char_syntax, native_elt, native_car_safe, native_cdr_safe) (native_number_p, native_integer_p, emacs_jit_init, jit_exec, jit_byte_code__) (jit_byte_code, Fjit_compile, syms_of_bytecode_jit): New file encapsulating JIT compilation functionality and execution functionality. * src/bytecode.c: * src/bytecode.h: Extract useful data structures and macro definitions into a separate header to allow sharing between src/bytecode{,-jit}.c. ; * src/Makefile.in: Add src/bytecode-jit.o to Makefile recipe. ; * src/lisp.h: Add function prototypes for new JIT functions. ; * src/emacs.c: Call syms_of_bytecode_jit to initialize JIT-related symbols. --- diff --git a/configure.ac b/configure.ac index cd4d1c0f8e0..114e92d501a 100644 --- a/configure.ac +++ b/configure.ac @@ -354,6 +354,7 @@ OPTION_DEFAULT_ON([selinux],[don't compile with SELinux support]) 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([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)])], @@ -3350,6 +3351,18 @@ if test "${HAVE_ZLIB}" = "yes"; then fi AC_SUBST(LIBZ) +HAVE_LIBJIT=no +LIBJIT= +if test "${with_libjit}" != "no"; then + OLIBS=$LIBS + 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 diff --git a/src/Makefile.in b/src/Makefile.in index d54670932d3..4ae8ae6f52a 100644 --- a/src/Makefile.in +++ b/src/Makefile.in @@ -238,6 +238,9 @@ LIBXML2_CFLAGS = @LIBXML2_CFLAGS@ 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 @@ -370,6 +373,7 @@ ALL_CFLAGS=-Demacs $(MYCPPFLAGS) -I. -I$(srcdir) \ $(SETTINGS_CFLAGS) $(FREETYPE_CFLAGS) $(FONTCONFIG_CFLAGS) \ $(LIBOTF_CFLAGS) $(M17N_FLT_CFLAGS) $(DEPFLAGS) \ $(LIBGNUTLS_CFLAGS) $(NOTIFY_CFLAGS) $(CAIRO_CFLAGS) \ + $(LIBJIT_CFLAGS) \ $(WARN_CFLAGS) $(WERROR_CFLAGS) $(CFLAGS) ALL_OBJC_CFLAGS=$(ALL_CFLAGS) $(GNU_OBJC_CFLAGS) @@ -392,7 +396,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) \ @@ -484,7 +488,7 @@ 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) \ - $(NOTIFY_LIBS) $(LIB_MATH) $(LIBZ) $(LIBMODULES) + $(NOTIFY_LIBS) $(LIB_MATH) $(LIBZ) $(LIBJIT) $(LIBMODULES) $(leimdir)/leim-list.el: bootstrap-emacs$(EXEEXT) $(MAKE) -C ../leim leim-list.el EMACS="$(bootstrap_exe)" diff --git a/src/bytecode-jit.c b/src/bytecode-jit.c new file mode 100644 index 00000000000..3860ade916f --- /dev/null +++ b/src/bytecode-jit.c @@ -0,0 +1,2131 @@ +/* JIT compilation of byte code produced by bytecomp.el. + Copyright (C) 1985-1988, 1993, 2000-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 . */ + +#include + +#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 + +#ifdef CHECK_FRAME_FONT +#include "frame.h" +#include "xterm.h" +#endif + +/* Fetch the next byte from the bytecode stream. */ + +#ifdef BYTE_CODE_SAFE +#define FETCH (eassert (stack.byte_string_start == SDATA (stack.byte_string)), *stack.pc++) +#else +#define FETCH *stack.pc++ +#endif + +/* 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)) + +/* Pop a value off the execution stack. */ + +#define POP (*top--) + +/* Discard n values from the execution stack. */ + +#define DISCARD(n) (top -= (n)) + +/* Get the value which is at the top of the execution stack, but don't + pop it. */ + +#define TOP (*top) + +#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. */ + +#ifdef 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 (NILP (Ffunctionp (handler)) + ? unwind_body : bcall0, + 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; + +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) + + jit_context = jit_context_create(); + + 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_varref, jit_type_Lisp_Object, jit_type_Lisp_Object); + 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_car, jit_type_Lisp_Object, jit_type_Lisp_Object); + JIT_SIG (native_eq, jit_type_Lisp_Object, jit_type_Lisp_Object, jit_type_Lisp_Object); + JIT_SIG (native_memq, jit_type_Lisp_Object, jit_type_Lisp_Object, jit_type_Lisp_Object); + JIT_SIG (native_cdr, jit_type_Lisp_Object, 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 (native_unbind_to, jit_type_Lisp_Object, jit_type_nuint, jit_type_Lisp_Object); + JIT_SIG (unbind_to, jit_type_Lisp_Object, jit_type_nuint, jit_type_Lisp_Object); + JIT_SIG (byte_code_quit, jit_type_void); + JIT_SIG (native_save_excursion, jit_type_void); + JIT_SIG (native_save_window_excursion, jit_type_Lisp_Object, jit_type_Lisp_Object); + JIT_SIG (native_save_restriction, jit_type_void); + JIT_SIG (native_catch, jit_type_Lisp_Object, jit_type_Lisp_Object, jit_type_Lisp_Object); + 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_temp_output_buffer_setup, jit_type_Lisp_Object, jit_type_Lisp_Object); + JIT_SIG (native_nth, jit_type_Lisp_Object, jit_type_Lisp_Object, jit_type_Lisp_Object); + JIT_SIG (native_symbolp, jit_type_Lisp_Object, jit_type_Lisp_Object); + JIT_SIG (native_consp, jit_type_Lisp_Object, jit_type_Lisp_Object); + JIT_SIG (native_stringp, jit_type_Lisp_Object, jit_type_Lisp_Object); + JIT_SIG (native_listp, jit_type_Lisp_Object, jit_type_Lisp_Object); + JIT_SIG (native_not, jit_type_Lisp_Object, jit_type_Lisp_Object); + JIT_SIG (native_add1, jit_type_Lisp_Object, jit_type_Lisp_Object, jit_type_sys_bool); + JIT_SIG (native_eqlsign, jit_type_Lisp_Object, jit_type_Lisp_Object, jit_type_Lisp_Object); + JIT_SIG (arithcompare, jit_type_Lisp_Object, jit_type_Lisp_Object, jit_type_Lisp_Object, jit_type_nuint); + JIT_SIG (native_negate, jit_type_Lisp_Object, jit_type_Lisp_Object); + JIT_SIG (native_point, jit_type_Lisp_Object); + JIT_SIG (native_point_max, jit_type_Lisp_Object); + JIT_SIG (native_point_min, jit_type_Lisp_Object); + JIT_SIG (native_current_column, jit_type_Lisp_Object); + JIT_SIG (native_interactive_p, jit_type_Lisp_Object); + JIT_SIG (native_char_syntax, jit_type_Lisp_Object, jit_type_Lisp_Object); + JIT_SIG (native_elt, jit_type_Lisp_Object, jit_type_Lisp_Object, jit_type_Lisp_Object); + JIT_SIG (native_car_safe, jit_type_Lisp_Object, jit_type_Lisp_Object); + JIT_SIG (native_cdr_safe, jit_type_Lisp_Object, jit_type_Lisp_Object); + JIT_SIG (native_number_p, jit_type_Lisp_Object, jit_type_Lisp_Object); + JIT_SIG (native_integer_p, jit_type_Lisp_Object, jit_type_Lisp_Object); +} + +static 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 *) = + (Lisp_Object (*)(Lisp_Object *))AREF (byte_code, COMPILED_JIT_ID); + return func (top); + } +} + +static void +jit_byte_code__ (Lisp_Object byte_code) +{ + ptrdiff_t count = SPECPDL_INDEX (); + int op; + Lisp_Object *vectorp; +#ifdef BYTE_CODE_SAFE + ptrdiff_t const_length; + Lisp_Object *stacke; +#endif + ptrdiff_t bytestr_length; + struct byte_stack stack; + Lisp_Object bytestr; + Lisp_Object vector; + Lisp_Object maxdepth; + Lisp_Object *top; + enum handlertype type; + + /* jit-specific variables */ + jit_function_t this_func; + jit_type_t params[1]; + jit_type_t signature; + jit_label_t *labels; + jit_value_t stackv; + + /* 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_ID]) + { + return; + } + else if (!jit_context) + { + /* jit is not yet initialized */ + emacs_jit_init (); + } + + 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); + +#ifdef 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; + + stack.byte_string = bytestr; + stack.pc = stack.byte_string_start = SDATA (bytestr); + if (MAX_ALLOCA / word_size <= XFASTINT (maxdepth)) + memory_full (SIZE_MAX); +#if BYTE_MAINTAIN_TOP + stack.top = NULL; +#endif + stack.next = byte_stack_list; + byte_stack_list = &stack; + + /* prepare for jit */ + jit_context_build_start (jit_context); + params[0] = jit_type_void_ptr; + signature = jit_type_create_signature (jit_abi_cdecl, jit_type_nuint, params, 1, 1); + this_func = jit_function_create (jit_context, signature); + stackv = jit_value_get_param (this_func, 0); + 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 (stack.pc < stack.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 (stack.pc >= stack.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 (this_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 (stack.pc - stack.byte_string_start) +#define JIT_NEED_STACK jit_value_ref (this_func, stackv) +#define JIT_NEXT \ + do { \ + if (!jit_insn_branch ( \ + this_func, \ + &labels[JIT_PC])) \ + emacs_abort (); \ + } while (0) + +#define JIT_INC(v, n) \ + do { \ + jit_value_t i = \ + jit_insn_add_relative ( \ + this_func, \ + v, \ + (jit_nint )n); \ + if (!i) \ + emacs_abort (); \ + else if (!jit_insn_store ( \ + this_func, \ + v, \ + i)) \ + emacs_abort (); \ + } while (0) + +#define JIT_PUSH(v) \ + do { \ + JIT_INC (stackv, sizeof (Lisp_Object)); \ + if (!jit_insn_store_relative ( \ + this_func, \ + stackv, \ + (jit_nint )0, \ + v)) \ + emacs_abort (); \ + } while (0) + +#define JIT_TOP(v) \ + do { \ + v = jit_insn_load_relative ( \ + this_func, \ + stackv, \ + (jit_nint )0, \ + jit_type_Lisp_Object); \ + if (!v) \ + emacs_abort (); \ + } while (0) + +#define JIT_POP(v) \ + do { \ + JIT_TOP (v); \ + JIT_INC (stackv, -sizeof (Lisp_Object)); \ + } while (0) + +#define JIT_CALL(f, args, n) \ + jit_insn_call_native ( \ + this_func, \ + #f, \ + (void*)&f, \ + f##_sig, \ + args, \ + n, \ + JIT_CALL_NOTHROW) + +#define JIT_CALL_ARGS(r, f, ...) \ + do { \ + jit_value_t params[] = \ + { \ + __VA_ARGS__ \ + }; \ + r = JIT_CALL ( \ + f, \ + params, \ + sizeof (params) / sizeof (params[0])); \ + } while (0) + +#define JIT_CONSTANT(t, v) \ + jit_value_create_nint_constant ( \ + this_func, \ + t, \ + v) + +#define JIT_CALL_WITH_STACK_N(f, n) \ + do { \ + jit_type_t params[n]; \ + jit_value_t args[n]; \ + jit_value_t ret; \ + jit_type_t f##_sig; \ + int i; \ + for (i = 0; i < n; i++) \ + params[i] = jit_type_Lisp_Object; \ + JIT_SIG_ (f, jit_type_Lisp_Object, params); \ + JIT_NEED_STACK; \ + for (i = 1; i <= n; i++) \ + JIT_POP (args[n-i]); \ + ret = JIT_CALL (f, args, n); \ + JIT_PUSH (ret); \ + } while (0) + +#define JIT_CALL_WITH_STACK_MANY(f, n) \ + do { \ + jit_value_t ret; \ + jit_type_t f##_sig; \ + JIT_SIG ( \ + f, \ + jit_type_Lisp_Object, \ + jit_type_nuint, \ + jit_type_void_ptr); \ + JIT_NEED_STACK; \ + JIT_INC (stackv, -(n - 1) * sizeof (Lisp_Object)); \ + JIT_CALL_ARGS ( \ + ret, \ + f, \ + JIT_CONSTANT (jit_type_nuint, n), \ + stackv); \ + JIT_INC (stackv, -sizeof (Lisp_Object)); \ + JIT_PUSH (ret); \ + } while (0) + +#ifndef BYTE_CODE_THREADED + /* create a new block and attach a label to it */ + jit_insn_label (this_func, &labels[JIT_PC]); +#endif + + FIRST + { + 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_value_t v1, v2; + JIT_NEED_STACK; + v1 = JIT_CONSTANT (jit_type_nuint, vectorp[op]); + JIT_CALL_ARGS (v2, native_varref, v1); + JIT_PUSH (v2); + JIT_NEXT; + NEXT; + } + + CASE (Bcar): + { + JIT_CALL_WITH_STACK_N (native_car, 1); + JIT_NEXT; + NEXT; + } + + CASE (Beq): + { + JIT_CALL_WITH_STACK_N (native_eq, 2); + JIT_NEXT; + NEXT; + } + + CASE (Bmemq): + { + JIT_CALL_WITH_STACK_N (native_memq, 2); + JIT_NEXT; + NEXT; + } + + CASE (Bcdr): + { + JIT_CALL_WITH_STACK_N (native_cdr, 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_value_t sym, val, x; + JIT_NEED_STACK; + sym = JIT_CONSTANT (jit_type_Lisp_Object, vectorp[op]); + JIT_POP (val); + JIT_CALL_ARGS (x, native_varset, sym, val); + JIT_NEXT; + NEXT; + } + + CASE (Bdup): + { + jit_value_t x; + JIT_NEED_STACK; + JIT_TOP (x); + JIT_PUSH (x); + 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_value_t v1, v2, x; + JIT_NEED_STACK; + v1 = JIT_CONSTANT (jit_type_Lisp_Object, vectorp[op]); + JIT_POP (v2); + JIT_CALL_ARGS (x, specbind, v1, v2); + JIT_NEXT; + NEXT; + } + + CASE (Bcall6): + op = FETCH; + goto docall; + + CASE (Bcall7): + op = FETCH2; + goto docall; + + CASE (Bcall): + CASE (Bcall1): + CASE (Bcall2): + CASE (Bcall3): + CASE (Bcall4): + CASE (Bcall5): + op -= Bcall; + docall: + { + JIT_NEED_STACK; + JIT_CALL_WITH_STACK_MANY (Ffuncall, op + 1); + 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 (native_unbind_to, 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 (unbind_to, args, 2); + JIT_NEXT; + NEXT; + } + + CASE (Bgoto): + { + jit_value_t v; + op = FETCH2; + CHECK_RANGE (op); + JIT_CALL (byte_code_quit, NULL, 0); + jit_insn_branch ( + this_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 += (stack.pc - stack.byte_string_start); + } + CHECK_RANGE (op); + JIT_NEED_STACK; + JIT_POP (v2); + if (insn == Bgotoifnil || insn == BRgotoifnil + || insn == Bgotoifnilelsepop || insn == BRgotoifnilelsepop) + JIT_CALL_ARGS (v3, native_ifnil, v2); + else + JIT_CALL_ARGS (v3, native_ifnonnil, v2); + if (insn == Bgotoifnilelsepop || insn == Bgotoifnonnilelsepop + || insn == BRgotoifnilelsepop || insn == BRgotoifnonnilelsepop) + JIT_PUSH (v2); + jit_insn_branch_if ( + this_func, + v3, + &labels[op]); + if (insn == Bgotoifnilelsepop || insn == Bgotoifnonnilelsepop + || insn == BRgotoifnilelsepop || insn == BRgotoifnonnilelsepop) + JIT_INC (stackv, -sizeof (Lisp_Object)); + JIT_NEXT; + NEXT; + } + + CASE (BRgoto): + { + op = FETCH - 128; + const int dest = (stack.pc - stack.byte_string_start) + op; + JIT_CALL (byte_code_quit, NULL, 0); + jit_insn_branch ( + this_func, + &labels[dest]); + NEXT; + } + + CASE (Breturn): + { + jit_value_t v; + JIT_NEED_STACK; + JIT_POP (v); + jit_insn_return (this_func, v); + NEXT; + } + + CASE (Bdiscard): + { + JIT_NEED_STACK; + JIT_INC (stackv, -sizeof (Lisp_Object)); + JIT_NEXT; + NEXT; + } + + CASE (Bconstant2): + { + jit_value_t v = JIT_CONSTANT (jit_type_Lisp_Object, vectorp[FETCH2]); + JIT_NEED_STACK; + JIT_PUSH (v); + 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_window_excursion): /* Obsolete since 24.1. */ + { + JIT_CALL_WITH_STACK_N (native_save_window_excursion, 1); + JIT_NEXT; + NEXT; + } + + CASE (Bsave_restriction): + JIT_CALL (native_save_restriction, NULL, 0); + JIT_NEXT; + NEXT; + + CASE (Bcatch): /* Obsolete since 24.4. */ + { + JIT_CALL_WITH_STACK_N (native_catch, 2); + JIT_NEXT; + NEXT; + } + + CASE (Bpushcatch): /* New in 24.4. */ + type = CATCHER; + goto pushhandler; + CASE (Bpushconditioncase): /* New in 24.4. */ + type = CONDITION_CASE; + pushhandler: + { + jit_label_t new_label; + jit_value_t tag, stackp, jmp, result, result2, typev; + int dest = FETCH2; + JIT_NEED_STACK; + JIT_POP (tag); + stackp = jit_insn_address_of (this_func, stackv); + typev = JIT_CONSTANT (jit_type_nint, type); + JIT_CALL_ARGS (jmp, native_pushhandler1, stackp, tag, typev); + 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 (this_func, "setjmp", f, + setjmp_sig, args, n, + JIT_CALL_NOTHROW); + } while (0); + jit_insn_branch_if_not (this_func, result, &labels[JIT_PC]); + JIT_CALL (native_pushhandler2, &stackp, 1); + jit_insn_branch (this_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; + JIT_POP (handler); + JIT_CALL (native_unwind_protect, &handler, 1); + JIT_NEXT; + NEXT; + } + + CASE (Bcondition_case): /* Obsolete since 24.4. */ + { + JIT_CALL_WITH_STACK_N (internal_lisp_condition_case, 3); + JIT_NEXT; + NEXT; + } + + CASE (Btemp_output_buffer_setup): /* Obsolete since 24.1. */ + { + JIT_NEED_STACK; + JIT_CALL_WITH_STACK_N (native_temp_output_buffer_setup, 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, x; + JIT_NEED_STACK; + JIT_SIG (temp_output_buffer_show, + jit_type_void, + jit_type_Lisp_Object); + JIT_POP (v1); + JIT_POP (v2); + 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 (x, native_unbind_to, c, q); + JIT_NEXT; + NEXT; + } + + CASE (Bnth): + { + JIT_CALL_WITH_STACK_N (native_nth, 2); + JIT_NEXT; + NEXT; + } + + CASE (Bsymbolp): + CASE (Bconsp): + CASE (Bstringp): + CASE (Blistp): + CASE (Bnot): + { + jit_value_t v1, v2; + JIT_NEED_STACK; + JIT_POP (v1); + switch (op) + { + case Bsymbolp: + JIT_CALL_ARGS (v2, native_symbolp, v1); + break; + case Bconsp: + JIT_CALL_ARGS (v2, native_consp, v1); + break; + case Bstringp: + JIT_CALL_ARGS (v2, native_stringp, v1); + break; + case Blistp: + JIT_CALL_ARGS (v2, native_listp, v1); + break; + case Bnot: + default: + JIT_CALL_ARGS (v2, native_not, v1); + break; + } + JIT_PUSH (v2); + JIT_NEXT; + NEXT; + } + + CASE (Bcons): + { + JIT_CALL_WITH_STACK_N (Fcons, 2); + JIT_NEXT; + NEXT; + } + + CASE (Blist1): + { + JIT_CALL_WITH_STACK_N (list1, 1); + JIT_NEXT; + NEXT; + } + + CASE (Blist2): + { + JIT_CALL_WITH_STACK_N (list2, 2); + JIT_NEXT; + NEXT; + } + + CASE (Blist3): + CASE (Blist4): + CASE (BlistN): + { + size_t temp; + if (op == BlistN) + { + temp = FETCH; + } + else + { + if (op == Blist3) + temp = 3; + else + temp = 4; + } + JIT_CALL_WITH_STACK_MANY (Flist, temp); + JIT_NEXT; + NEXT; + } + + CASE (Blength): + { + JIT_CALL_WITH_STACK_N (Flength, 1); + JIT_NEXT; + NEXT; + } + + CASE (Baref): + { + JIT_CALL_WITH_STACK_N (Faref, 2); + JIT_NEXT; + NEXT; + } + + CASE (Baset): + { + JIT_CALL_WITH_STACK_N (Faset, 3); + JIT_NEXT; + NEXT; + } + + CASE (Bsymbol_value): + { + JIT_CALL_WITH_STACK_N (Fsymbol_value, 1); + JIT_NEXT; + NEXT; + } + CASE (Bsymbol_function): + { + JIT_CALL_WITH_STACK_N (Fsymbol_function, 1); + JIT_NEXT; + NEXT; + } + + CASE (Bset): + { + JIT_CALL_WITH_STACK_N (Fset, 2); + JIT_NEXT; + NEXT; + } + + CASE (Bfset): + { + JIT_CALL_WITH_STACK_N (Ffset, 2); + JIT_NEXT; + NEXT; + } + + CASE (Bget): + { + JIT_CALL_WITH_STACK_N (Fget, 2); + JIT_NEXT; + NEXT; + } + + CASE (Bsubstring): + { + JIT_CALL_WITH_STACK_N (Fsubstring, 3); + JIT_NEXT; + NEXT; + } + + CASE (Bconcat2): + CASE (Bconcat3): + CASE (Bconcat4): + CASE (BconcatN): + { + size_t n; + if (op == BconcatN) + n = FETCH; + else + n = op - Bconcat2 + 2; + JIT_CALL_WITH_STACK_MANY (Fconcat, n); + JIT_NEXT; + NEXT; + } + + CASE (Bsub1): + { + jit_value_t v1, v2; + JIT_NEED_STACK; + JIT_POP (v1); + JIT_CALL_ARGS (v2, native_add1, v1, JIT_CONSTANT (jit_type_sys_bool, 0)); + JIT_PUSH (v2); + JIT_NEXT; + NEXT; + } + + CASE (Badd1): + { + jit_value_t v1, v2; + JIT_NEED_STACK; + JIT_POP (v1); + JIT_CALL_ARGS (v2, native_add1, v1, JIT_CONSTANT (jit_type_sys_bool, 1)); + JIT_PUSH (v2); + JIT_NEXT; + NEXT; + } + + CASE (Beqlsign): + { + JIT_CALL_WITH_STACK_N (native_eqlsign, 2); + JIT_NEXT; + NEXT; + } + + CASE (Bgtr): + CASE (Blss): + CASE (Bleq): + CASE (Bgeq): + { + jit_value_t v1, v2, v3, 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]); + JIT_POP (v2); + JIT_POP (v1); + JIT_CALL_ARGS (v3, arithcompare, v1, v2, c); + JIT_PUSH (v3); + JIT_NEXT; + NEXT; + } + + CASE (Bdiff): + { + JIT_CALL_WITH_STACK_MANY (Fminus, 2); + JIT_NEXT; + NEXT; + } + + CASE (Bnegate): + { + JIT_CALL_WITH_STACK_N (native_negate, 1); + JIT_NEXT; + NEXT; + } + + CASE (Bplus): + { + JIT_CALL_WITH_STACK_MANY (Fplus, 2); + JIT_NEXT; + NEXT; + } + + CASE (Bmax): + { + JIT_CALL_WITH_STACK_MANY (Fmax, 2); + JIT_NEXT; + NEXT; + } + + CASE (Bmin): + { + JIT_CALL_WITH_STACK_MANY (Fmin, 2); + JIT_NEXT; + NEXT; + } + + CASE (Bmult): + { + JIT_CALL_WITH_STACK_MANY (Ftimes, 2); + JIT_NEXT; + NEXT; + } + + CASE (Bquo): + { + JIT_CALL_WITH_STACK_MANY (Fquo, 2); + JIT_NEXT; + NEXT; + } + + CASE (Brem): + { + JIT_CALL_WITH_STACK_N (Frem, 2); + JIT_NEXT; + NEXT; + } + + CASE (Bpoint): + { + JIT_CALL_WITH_STACK_N (native_point, 0); + JIT_NEXT; + NEXT; + } + + CASE (Bgoto_char): + { + JIT_CALL_WITH_STACK_N (Fgoto_char, 1); + JIT_NEXT; + NEXT; + } + + CASE (Binsert): + { + JIT_CALL_WITH_STACK_MANY (Finsert, 1); + JIT_NEXT; + NEXT; + } + + CASE (BinsertN): + { + /* FETCH must not appear in the macro reference below, otherwise + the macro expansion will contain multiple instances OF FETCH */ + Lisp_Object n = FETCH; + JIT_CALL_WITH_STACK_MANY (Finsert, n); + JIT_NEXT; + NEXT; + } + + CASE (Bpoint_max): + { + JIT_CALL_WITH_STACK_N (native_point_max, 0); + JIT_NEXT; + NEXT; + } + + CASE (Bpoint_min): + { + JIT_CALL_WITH_STACK_N (native_point_min, 0); + JIT_NEXT; + NEXT; + } + + CASE (Bchar_after): + { + JIT_CALL_WITH_STACK_N (Fchar_after, 1); + JIT_NEXT; + NEXT; + } + + CASE (Bfollowing_char): + { + JIT_CALL_WITH_STACK_N (Ffollowing_char, 0); + JIT_NEXT; + NEXT; + } + + CASE (Bpreceding_char): + { + JIT_CALL_WITH_STACK_N (Fprevious_char, 0); + JIT_NEXT; + NEXT; + } + + CASE (Bcurrent_column): + { + JIT_CALL_WITH_STACK_N (native_current_column, 0); + 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; + } + + CASE (Beolp): + { + JIT_CALL_WITH_STACK_N (Feolp, 0); + JIT_NEXT; + NEXT; + } + + CASE (Beobp): + { + JIT_CALL_WITH_STACK_N (Feobp, 0); + JIT_NEXT; + NEXT; + } + + CASE (Bbolp): + { + JIT_CALL_WITH_STACK_N (Fbolp, 0); + JIT_NEXT; + NEXT; + } + + CASE (Bbobp): + { + JIT_CALL_WITH_STACK_N (Fbobp, 0); + JIT_NEXT; + NEXT; + } + + CASE (Bcurrent_buffer): + { + JIT_CALL_WITH_STACK_N (Fcurrent_buffer, 0); + JIT_NEXT; + NEXT; + } + + CASE (Bset_buffer): + { + JIT_CALL_WITH_STACK_N (Fset_buffer, 1); + JIT_NEXT; + NEXT; + } + + CASE (Binteractive_p): /* Obsolete since 24.1. */ + { + JIT_CALL_WITH_STACK_N (native_interactive_p, 0); + JIT_NEXT; + NEXT; + } + + CASE (Bforward_char): + { + JIT_CALL_WITH_STACK_N (Fforward_char, 1); + JIT_NEXT; + NEXT; + } + + CASE (Bforward_word): + { + JIT_CALL_WITH_STACK_N (Fforward_word, 1); + JIT_NEXT; + NEXT; + } + + CASE (Bskip_chars_forward): + { + JIT_CALL_WITH_STACK_N (Fskip_chars_forward, 2); + JIT_NEXT; + NEXT; + } + + CASE (Bskip_chars_backward): + { + JIT_CALL_WITH_STACK_N (Fskip_chars_backward, 2); + JIT_NEXT; + NEXT; + } + + CASE (Bforward_line): + { + JIT_CALL_WITH_STACK_N (Fforward_line, 1); + JIT_NEXT; + NEXT; + } + + CASE (Bchar_syntax): + { + JIT_CALL_WITH_STACK_N (native_char_syntax, 1); + JIT_NEXT; + NEXT; + } + + CASE (Bbuffer_substring): + { + JIT_CALL_WITH_STACK_N (Fbuffer_substring, 2); + JIT_NEXT; + NEXT; + } + + CASE (Bdelete_region): + { + JIT_CALL_WITH_STACK_N (Fdelete_region, 2); + JIT_NEXT; + NEXT; + } + + CASE (Bnarrow_to_region): + { + JIT_CALL_WITH_STACK_N (Fnarrow_to_region, 2); + JIT_NEXT; + NEXT; + } + + CASE (Bwiden): + { + JIT_CALL_WITH_STACK_N (Fwiden, 0); + JIT_NEXT; + NEXT; + } + + CASE (Bend_of_line): + { + JIT_CALL_WITH_STACK_N (Fend_of_line, 1); + JIT_NEXT; + NEXT; + } + + CASE (Bset_marker): + { + JIT_CALL_WITH_STACK_N (Fset_marker, 3); + JIT_NEXT; + NEXT; + } + + CASE (Bmatch_beginning): + { + JIT_CALL_WITH_STACK_N (Fmatch_beginning, 1); + JIT_NEXT; + NEXT; + } + + CASE (Bmatch_end): + { + JIT_CALL_WITH_STACK_N (Fmatch_end, 1); + JIT_NEXT; + NEXT; + } + + CASE (Bupcase): + { + JIT_CALL_WITH_STACK_N (Fupcase, 1); + JIT_NEXT; + NEXT; + } + + CASE (Bdowncase): + { + JIT_CALL_WITH_STACK_N (Fdowncase, 1); + JIT_NEXT; + NEXT; + } + + CASE (Bstringeqlsign): + { + JIT_CALL_WITH_STACK_N (Fstring_equal, 2); + JIT_NEXT; + NEXT; + } + + CASE (Bstringlss): + { + JIT_CALL_WITH_STACK_N (Fstring_lessp, 2); + JIT_NEXT; + NEXT; + } + + CASE (Bequal): + { + JIT_CALL_WITH_STACK_N (Fequal, 2); + JIT_NEXT; + NEXT; + } + + CASE (Bnthcdr): + { + JIT_CALL_WITH_STACK_N (Fnthcdr, 2); + JIT_NEXT; + NEXT; + } + + CASE (Belt): + { + JIT_CALL_WITH_STACK_N (native_elt, 2); + JIT_NEXT; + NEXT; + } + + CASE (Bmember): + { + JIT_CALL_WITH_STACK_N (Fmember, 2); + JIT_NEXT; + NEXT; + } + + CASE (Bassq): + { + JIT_CALL_WITH_STACK_N (Fassq, 2); + JIT_NEXT; + NEXT; + } + + CASE (Bnreverse): + { + JIT_CALL_WITH_STACK_N (Fnreverse, 1); + JIT_NEXT; + NEXT; + } + + CASE (Bsetcar): + { + JIT_CALL_WITH_STACK_N (Fsetcar, 2); + JIT_NEXT; + NEXT; + } + + CASE (Bsetcdr): + { + JIT_CALL_WITH_STACK_N (Fsetcdr, 2); + JIT_NEXT; + NEXT; + } + + CASE (Bcar_safe): + { + JIT_CALL_WITH_STACK_N (native_car_safe, 1); + JIT_NEXT; + NEXT; + } + + CASE (Bcdr_safe): + { + JIT_CALL_WITH_STACK_N (native_cdr_safe, 1); + JIT_NEXT; + NEXT; + } + + CASE (Bnconc): + { + JIT_CALL_WITH_STACK_MANY (Fnconc, 2); + JIT_NEXT; + NEXT; + } + + CASE (Bnumberp): + { + JIT_CALL_WITH_STACK_N (native_number_p, 1); + JIT_NEXT; + NEXT; + } + + CASE (Bintegerp): + { + JIT_CALL_WITH_STACK_N (native_integer_p, 1); + JIT_NEXT; + NEXT; + } + +#ifdef 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 ((stack.pc - 1) - stack.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 (stackv, -offs * sizeof (Lisp_Object)); + JIT_TOP (v1); + JIT_INC (stackv, 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; + JIT_TOP (v1); + if (offs != 0) + JIT_INC (stackv, -(offs + 1) * sizeof (Lisp_Object)); + JIT_PUSH (v1); + JIT_INC (stackv, (offs - 1) * sizeof (Lisp_Object)); + JIT_NEXT; + NEXT; + } + CASE (BdiscardN): + { + op = FETCH; + JIT_NEED_STACK; + if (op & 0x80) + { + jit_value_t v1; + op &= 0x7F; + JIT_TOP (v1); + JIT_INC (stackv, -(op + 1) * sizeof (Lisp_Object)); + JIT_PUSH (v1); + } + else + JIT_INC (stackv, -op * sizeof (Lisp_Object)); + JIT_NEXT; + NEXT; + } + + CASE_DEFAULT + CASE (Bconstant): + { + jit_value_t c; +#ifdef 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: + byte_stack_list = byte_stack_list->next; + + { + int err = !jit_function_compile (this_func); + jit_context_build_end (jit_context); + if (err) + emacs_abort (); + ASET (byte_code, COMPILED_JIT_ID, (Lisp_Object )jit_function_to_closure (this_func)); + } +} + +Lisp_Object +jit_byte_code (Lisp_Object byte_code, Lisp_Object args_template, + ptrdiff_t nargs, Lisp_Object *args) +{ + if (AREF (byte_code, COMPILED_JIT_ID)) + return jit_exec (byte_code, args_template, nargs, args); + else if (!byte_code_jit_on) + return exec_byte_code (AREF (byte_code, COMPILED_BYTECODE), + AREF (byte_code, COMPILED_CONSTANTS), + AREF (byte_code, COMPILED_STACK_DEPTH), + args_template, nargs, args); + else + { + jit_byte_code__ (byte_code); + return jit_exec (byte_code, args_template, nargs, args); + } +} + +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; +} diff --git a/src/bytecode.c b/src/bytecode.c index 9ae2e820d51..b6b7484440f 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -35,6 +35,7 @@ by Hallvard: #include +#include "bytecode.h" #include "lisp.h" #include "blockinput.h" #include "character.h" @@ -48,24 +49,6 @@ by Hallvard: #include "xterm.h" #endif -/* - * define BYTE_CODE_SAFE to enable some minor sanity checking (useful for - * debugging the byte compiler...) - * - * define BYTE_CODE_METER to enable generation of a byte-op usage histogram. - */ -/* #define BYTE_CODE_SAFE */ -/* #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 BYTE_CODE_SAFE && !defined BYTE_CODE_METER) -#define BYTE_CODE_THREADED -#endif - #ifdef BYTE_CODE_METER @@ -88,246 +71,8 @@ by Hallvard: } #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 - -#ifdef 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. */ +/* Declared in bytecode.h */ struct byte_stack *byte_stack_list; @@ -384,27 +129,6 @@ relocate_byte_stack (void) #define TOP (*top) -/* 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) - /* Check for jumping out of range. */ #ifdef BYTE_CODE_SAFE @@ -449,7 +173,7 @@ If the third argument is incorrect, Emacs may crash. */) return exec_byte_code (bytestr, vector, maxdepth, Qnil, 0, NULL); } -static void +void bcall0 (Lisp_Object f) { Ffuncall (1, &f); diff --git a/src/bytecode.h b/src/bytecode.h new file mode 100644 index 00000000000..020fc2ebe07 --- /dev/null +++ b/src/bytecode.h @@ -0,0 +1,283 @@ +#include "lisp.h" + +/* + * define BYTE_CODE_SAFE to enable some minor sanity checking (useful for + * debugging the byte compiler...) + * + * define BYTE_CODE_METER to enable generation of a byte-op usage histogram. + */ +/* #define BYTE_CODE_SAFE */ +/* #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 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 (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 + +#ifdef 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. */ + +extern 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); diff --git a/src/data.c b/src/data.c index 3a51129d182..e00e019fec1 100644 --- a/src/data.c +++ b/src/data.c @@ -3495,6 +3495,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 2480dfc603a..a8be9851d10 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -1396,6 +1396,7 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem syms_of_buffer (); syms_of_bytecode (); + syms_of_bytecode_jit (); syms_of_callint (); syms_of_casefiddle (); syms_of_casetab (); diff --git a/src/eval.c b/src/eval.c index fe6460d53bb..44557b2a958 100644 --- a/src/eval.c +++ b/src/eval.c @@ -2852,11 +2852,8 @@ 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); + return jit_byte_code (fun, syms_left, + nargs, arg_vector); } lexenv = Qnil; } @@ -2918,10 +2915,7 @@ 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); + val = jit_byte_code (fun, Qnil, 0, 0); } return unbind_to (count, val); diff --git a/src/lisp.h b/src/lisp.h index b61855a89de..9a8ff63f5a4 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -2811,6 +2811,11 @@ CHECK_VECTOR (Lisp_Object x) CHECK_TYPE (VECTORP (x), Qvectorp, x); } INLINE void +CHECK_COMPILED (Lisp_Object x) +{ + CHECK_TYPE (COMPILEDP (x), Qcompiledp, x); +} +INLINE void CHECK_BOOL_VECTOR (Lisp_Object x) { CHECK_TYPE (BOOL_VECTOR_P (x), Qbool_vector_p, x); @@ -3173,6 +3178,7 @@ struct handler enum handlertype type; Lisp_Object tag_or_ch; Lisp_Object val; + Lisp_Object *stack; struct handler *next; struct handler *nextfree; @@ -4207,6 +4213,10 @@ extern void relocate_byte_stack (void); extern Lisp_Object exec_byte_code (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, ptrdiff_t, Lisp_Object *); +/* Defined in bytecode-jit.c */ +extern void syms_of_bytecode_jit (void); +extern Lisp_Object jit_byte_code (Lisp_Object, Lisp_Object, ptrdiff_t, Lisp_Object *); + /* Defined in macros.c. */ extern void init_macros (void); extern void syms_of_macros (void);