From: "Nicolas Bértolo" <nicolasbertolo@gmail.com>
To: Andrea Corallo <akrl@sdf.org>
Cc: 41242@debbugs.gnu.org
Subject: bug#41242: Port feature/native-comp to Windows
Date: Wed, 20 May 2020 13:17:54 -0300 [thread overview]
Message-ID: <CAFnS-Omg59uV88jQHxs+yLzdk1+Y8U43jdHgnZm5wytoJ9QkCw@mail.gmail.com> (raw)
In-Reply-To: <xjfblmi1t6i.fsf@sdf.org>
[-- Attachment #1.1: Type: text/plain, Size: 133 bytes --]
> Thanks, I'll start going through them this evening I guess in patch
> chronological order.
Thank you.
Here's the latest version.
[-- Attachment #1.2: Type: text/html, Size: 240 bytes --]
[-- Attachment #2: 0003-Handle-setjmp-taking-two-arguments-in-Windows.patch --]
[-- Type: application/octet-stream, Size: 4674 bytes --]
From becf94b352a6c646d703eaa057b0870e6fda6532 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Nicol=C3=A1s=20B=C3=A9rtolo?= <nicolasbertolo@gmail.com>
Date: Fri, 8 May 2020 15:56:09 -0300
Subject: [PATCH 3/9] Handle setjmp() taking two arguments in Windows.
* src/comp.c: Add `define_setjmp_deps()` and `emit_setjmp()` which
abstract over this difference in behavior between operating systems.
WARNING: Not all cases are handled by this patch. The Mingw-64
setjmp.h header deals with many other combinations. I don't think it
is a good idea to replicate the logic of that header inside
emacs. (Maybe a few lines in the configure script could be added to
handle this problem?)
---
src/comp.c | 58 ++++++++++++++++++++++++++++++++++++++++++++++++------
1 file changed, 52 insertions(+), 6 deletions(-)
diff --git a/src/comp.c b/src/comp.c
index 00f9d4b74a..0d46628e6a 100644
--- a/src/comp.c
+++ b/src/comp.c
@@ -22,6 +22,7 @@
#ifdef HAVE_NATIVE_COMP
+#include <setjmp.h>
#include <stdlib.h>
#include <stdio.h>
#include <signal.h>
@@ -74,10 +75,15 @@ #define DECL_BLOCK(name, func) \
gcc_jit_block *(name) = \
gcc_jit_function_new_block ((func), STR (name))
-#ifdef HAVE__SETJMP
-#define SETJMP _setjmp
+#ifndef _WIN32
+# ifdef HAVE__SETJMP
+# define SETJMP _setjmp
+# else
+# define SETJMP setjmp
+# endif
#else
-#define SETJMP setjmp
+/* snippet from MINGW-64 setjmp.h */
+# define SETJMP _setjmp
#endif
#define SETJMP_NAME SETJMP
@@ -174,6 +180,9 @@ #define F_RELOC_MAX_SIZE 1500
gcc_jit_function *setcdr;
gcc_jit_function *check_type;
gcc_jit_function *check_impure;
+#ifdef _WIN32
+ gcc_jit_function *setjmp_ctx_func;
+#endif
Lisp_Object func_blocks_h; /* blk_name -> gcc_block. */
Lisp_Object exported_funcs_h; /* c-func-name -> gcc_jit_function *. */
Lisp_Object imported_funcs_h; /* subr_name -> gcc_jit_field *reloc_field. */
@@ -1474,6 +1483,29 @@ emit_limple_call_ref (Lisp_Object insn, bool direct)
direct);
}
+static gcc_jit_rvalue *
+emit_setjmp (gcc_jit_rvalue *buf)
+{
+#ifndef _WIN32
+ gcc_jit_rvalue *args[] = {buf};
+ return emit_call (intern_c_string (STR (SETJMP_NAME)), comp.int_type, 1, args,
+ false);
+#else
+ /* _setjmp (buf, __builtin_frame_address (0)) */
+ gcc_jit_rvalue *args[2];
+
+ args[0] = gcc_jit_context_new_rvalue_from_int (comp.ctxt, comp.unsigned_type, 0);
+
+ args[1] = gcc_jit_context_new_call(comp.ctxt,
+ NULL,
+ comp.setjmp_ctx_func,
+ 1, args);
+ args[0] = buf;
+ return emit_call (intern_c_string (STR (SETJMP_NAME)), comp.int_type, 2, args,
+ false);
+#endif
+}
+
/* Register an handler for a non local exit. */
static void
@@ -1500,8 +1532,7 @@ emit_limple_push_handler (gcc_jit_rvalue *handler, gcc_jit_rvalue *handler_type,
NULL);
gcc_jit_rvalue *res;
- res =
- emit_call (intern_c_string (STR (SETJMP_NAME)), comp.int_type, 1, args, false);
+ res = emit_setjmp(args[0]);
emit_cond_jump (res, handler_bb, guarded_bb);
}
@@ -2060,8 +2091,14 @@ #define ADD_IMPORTED(f_name, ret_type, nargs, args) \
args[1] = comp.int_type;
ADD_IMPORTED (push_handler, comp.handler_ptr_type, 2, args);
+#ifndef _WIN32
args[0] = gcc_jit_type_get_pointer (gcc_jit_struct_as_type (comp.jmp_buf_s));
ADD_IMPORTED (SETJMP_NAME, comp.int_type, 1, args);
+#else
+ args[0] = gcc_jit_type_get_pointer (gcc_jit_struct_as_type (comp.jmp_buf_s));
+ args[1] = comp.void_ptr_type;
+ ADD_IMPORTED (SETJMP_NAME, comp.int_type, 2, args);
+#endif
ADD_IMPORTED (record_unwind_protect_excursion, comp.void_type, 0, NULL);
@@ -2301,7 +2338,7 @@ define_jmp_buf (void)
gcc_jit_context_new_array_type (comp.ctxt,
NULL,
comp.char_type,
- sizeof (jmp_buf)),
+ sizeof (sys_jmp_buf)),
"stuff");
comp.jmp_buf_s =
gcc_jit_context_new_struct_type (comp.ctxt,
@@ -2969,6 +3006,14 @@ define_CHECK_IMPURE (void)
gcc_jit_block_end_with_void_return (err_block, NULL);
}
+static void
+define_setjmp_deps (void)
+{
+ comp.setjmp_ctx_func
+ = gcc_jit_context_get_builtin_function (comp.ctxt,
+ "__builtin_frame_address");
+}
+
/* Define a function to convert boolean into t or nil */
static void
@@ -3357,6 +3402,7 @@ DEFUN ("comp--compile-ctxt-to-file", Fcomp__compile_ctxt_to_file,
define_PSEUDOVECTORP ();
define_CHECK_TYPE ();
define_CHECK_IMPURE ();
+ define_setjmp_deps ();
define_bool_to_lisp_obj ();
define_setcar_setcdr ();
define_add1_sub1 ();
--
2.25.1.windows.1
[-- Attachment #3: 0004-Handle-LISP_WORDS_ARE_POINTERS-and-CHECK_LISP_OBJECT.patch --]
[-- Type: application/octet-stream, Size: 18158 bytes --]
From 44ce2cb89856709fa4581ed4e3b8091b2d2c351c Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Nicol=C3=A1s=20B=C3=A9rtolo?= <nicolasbertolo@gmail.com>
Date: Fri, 8 May 2020 14:30:14 -0300
Subject: [PATCH 4/9] Handle LISP_WORDS_ARE_POINTERS and
CHECK_LISP_OBJECT_TYPE.
* src/comp.c: Introduce the Lisp_X, Lisp_Word, and Lisp_Word_tag
types. These types are used instead of long or long long. Use
emacs_int_type and emacs_uint_types where appropriate.
(emit_coerce): Add special logic that handles the case when
Lisp_Object is a struct. This is necessary for handling the
--enable-check-lisp-object-type configure option.
* src/lisp.h: Since libgccjit does not support opaque unions, change
Lisp_X to be struct. This is done to ensure that the same types are
used in the same binary. It is probably unnecessary since only a
pointer to it is used.
---
src/comp.c | 328 ++++++++++++++++++++++++++++++++++++-----------------
src/lisp.h | 5 +-
2 files changed, 228 insertions(+), 105 deletions(-)
diff --git a/src/comp.c b/src/comp.c
index 0d46628e6a..0d5880ad3c 100644
--- a/src/comp.c
+++ b/src/comp.c
@@ -116,6 +116,16 @@ #define F_RELOC_MAX_SIZE 1500
gcc_jit_type *char_ptr_type;
gcc_jit_type *ptrdiff_type;
gcc_jit_type *uintptr_type;
+#if LISP_WORDS_ARE_POINTERS
+ gcc_jit_struct *lisp_X_s;
+ gcc_jit_type *lisp_X;
+#endif
+ gcc_jit_type *lisp_word_type;
+ gcc_jit_type *lisp_word_tag_type;
+#ifdef LISP_OBJECT_IS_STRUCT
+ gcc_jit_field *lisp_obj_i;
+ gcc_jit_struct *lisp_obj_s;
+#endif
gcc_jit_type *lisp_obj_type;
gcc_jit_type *lisp_obj_ptr_type;
/* struct Lisp_Cons */
@@ -158,7 +168,8 @@ #define F_RELOC_MAX_SIZE 1500
gcc_jit_field *cast_union_as_c_p;
gcc_jit_field *cast_union_as_v_p;
gcc_jit_field *cast_union_as_lisp_cons_ptr;
- gcc_jit_field *cast_union_as_lisp_obj;
+ gcc_jit_field *cast_union_as_lisp_word;
+ gcc_jit_field *cast_union_as_lisp_word_tag;
gcc_jit_field *cast_union_as_lisp_obj_ptr;
gcc_jit_function *func; /* Current function being compiled. */
bool func_has_non_local; /* From comp-func has-non-local slot. */
@@ -347,8 +358,10 @@ type_to_cast_field (gcc_jit_type *type)
field = comp.cast_union_as_c_p;
else if (type == comp.lisp_cons_ptr_type)
field = comp.cast_union_as_lisp_cons_ptr;
- else if (type == comp.lisp_obj_type)
- field = comp.cast_union_as_lisp_obj;
+ else if (type == comp.lisp_word_type)
+ field = comp.cast_union_as_lisp_word;
+ else if (type == comp.lisp_word_tag_type)
+ field = comp.cast_union_as_lisp_word_tag;
else if (type == comp.lisp_obj_ptr_type)
field = comp.cast_union_as_lisp_obj_ptr;
else
@@ -627,6 +640,31 @@ emit_coerce (gcc_jit_type *new_type, gcc_jit_rvalue *obj)
if (new_type == old_type)
return obj;
+#ifdef LISP_OBJECT_IS_STRUCT
+ if (old_type == comp.lisp_obj_type)
+ {
+ gcc_jit_rvalue *lwordobj =
+ gcc_jit_rvalue_access_field (obj, NULL, comp.lisp_obj_i);
+ return emit_coerce (new_type, lwordobj);
+ }
+
+ if (new_type == comp.lisp_obj_type)
+ {
+ gcc_jit_rvalue *lwordobj =
+ emit_coerce (comp.lisp_word_type, obj);
+
+ gcc_jit_lvalue *tmp_s
+ = gcc_jit_function_new_local (comp.func, NULL, comp.lisp_obj_type,
+ format_string ("lisp_obj_%td", i++));
+
+ gcc_jit_block_add_assignment (comp.block, NULL,
+ gcc_jit_lvalue_access_field (tmp_s, NULL,
+ comp.lisp_obj_i),
+ lwordobj);
+ return gcc_jit_lvalue_as_rvalue (tmp_s);
+ }
+#endif
+
gcc_jit_field *orig_field =
type_to_cast_field (old_type);
gcc_jit_field *dest_field = type_to_cast_field (new_type);
@@ -664,14 +702,8 @@ emit_binary_op (enum gcc_jit_binary_op op,
/* Should come with libgccjit. */
static gcc_jit_rvalue *
-emit_rvalue_from_long_long (long long n)
+emit_rvalue_from_long_long (gcc_jit_type *type, long long n)
{
-#ifndef WIDE_EMACS_INT
- xsignal1 (Qnative_ice,
- build_string ("emit_rvalue_from_long_long called in non wide int"
- " configuration"));
-#endif
-
emit_comment (format_string ("emit long long: %lld", n));
gcc_jit_rvalue *high =
@@ -697,7 +729,7 @@ emit_rvalue_from_long_long (long long n)
32));
return
- emit_coerce (comp.long_long_type,
+ emit_coerce (type,
emit_binary_op (
GCC_JIT_BINARY_OP_BITWISE_OR,
comp.unsigned_long_long_type,
@@ -712,29 +744,135 @@ emit_rvalue_from_long_long (long long n)
}
static gcc_jit_rvalue *
-emit_most_positive_fixnum (void)
+emit_rvalue_from_unsigned_long_long (gcc_jit_type *type, unsigned long long n)
+{
+ emit_comment (format_string ("emit unsigned long long: %llu", n));
+
+ gcc_jit_rvalue *high =
+ gcc_jit_context_new_rvalue_from_long (comp.ctxt,
+ comp.unsigned_long_long_type,
+ n >> 32);
+ gcc_jit_rvalue *low =
+ emit_binary_op (GCC_JIT_BINARY_OP_RSHIFT,
+ comp.unsigned_long_long_type,
+ emit_binary_op (GCC_JIT_BINARY_OP_LSHIFT,
+ comp.unsigned_long_long_type,
+ gcc_jit_context_new_rvalue_from_long (
+ comp.ctxt,
+ comp.unsigned_long_long_type,
+ n),
+ gcc_jit_context_new_rvalue_from_int (
+ comp.ctxt,
+ comp.unsigned_long_long_type,
+ 32)),
+ gcc_jit_context_new_rvalue_from_int (
+ comp.ctxt,
+ comp.unsigned_long_long_type,
+ 32));
+
+ return emit_coerce (
+ type,
+ emit_binary_op (
+ GCC_JIT_BINARY_OP_BITWISE_OR,
+ comp.unsigned_long_long_type,
+ emit_binary_op (
+ GCC_JIT_BINARY_OP_LSHIFT,
+ comp.unsigned_long_long_type,
+ high,
+ gcc_jit_context_new_rvalue_from_int (comp.ctxt,
+ comp.unsigned_long_long_type,
+ 32)),
+ low));
+}
+
+static gcc_jit_rvalue *
+emit_rvalue_from_emacs_uint (EMACS_UINT val)
+{
+ if (val != (long) val)
+ {
+ return gcc_jit_context_new_rvalue_from_long (comp.ctxt,
+ comp.emacs_uint_type,
+ val);
+ }
+ else
+ {
+ return emit_rvalue_from_unsigned_long_long (comp.emacs_uint_type, val);
+ }
+}
+
+static gcc_jit_rvalue *
+emit_rvalue_from_emacs_int (EMACS_INT val)
+{
+ if (val != (long) val)
+ {
+ return emit_rvalue_from_long_long (comp.emacs_int_type, val);
+ }
+ else
+ {
+ return gcc_jit_context_new_rvalue_from_long (comp.ctxt,
+ comp.emacs_int_type, val);
+ }
+}
+
+static gcc_jit_rvalue *
+emit_rvalue_from_lisp_word_tag (Lisp_Word_tag val)
{
-#if EMACS_INT_MAX > LONG_MAX
- return emit_rvalue_from_long_long (MOST_POSITIVE_FIXNUM);
+ if (val != (long) val)
+ {
+ return emit_rvalue_from_unsigned_long_long (comp.lisp_word_tag_type, val);
+ }
+ else
+ {
+ return gcc_jit_context_new_rvalue_from_long (comp.ctxt,
+ comp.lisp_word_tag_type,
+ val);
+ }
+}
+
+static gcc_jit_rvalue *
+emit_rvalue_from_lisp_word (Lisp_Word val)
+{
+#if LISP_WORDS_ARE_POINTERS
+ return gcc_jit_context_new_rvalue_from_ptr (comp.ctxt,
+ comp.lisp_word_type,
+ val);
#else
- return gcc_jit_context_new_rvalue_from_long (comp.ctxt,
- comp.emacs_int_type,
- MOST_POSITIVE_FIXNUM);
+ if (val != (long) val)
+ {
+ return emit_rvalue_from_unsigned_long_long (comp.lisp_word_type, val);
+ }
+ else
+ {
+ return gcc_jit_context_new_rvalue_from_long (comp.ctxt,
+ comp.lisp_word_type,
+ val);
+ }
#endif
}
static gcc_jit_rvalue *
-emit_most_negative_fixnum (void)
+emit_rvalue_from_lisp_obj (Lisp_Object obj)
{
-#if EMACS_INT_MAX > LONG_MAX
- return emit_rvalue_from_long_long (MOST_NEGATIVE_FIXNUM);
+#ifdef LISP_OBJECT_IS_STRUCT
+ return emit_coerce(comp.lisp_obj_type,
+ emit_rvalue_from_lisp_word (obj.i));
#else
- return gcc_jit_context_new_rvalue_from_long (comp.ctxt,
- comp.emacs_int_type,
- MOST_NEGATIVE_FIXNUM);
+ return emit_rvalue_from_lisp_word (obj);
#endif
}
+static gcc_jit_rvalue *
+emit_most_positive_fixnum (void)
+{
+ return emit_rvalue_from_emacs_int(MOST_POSITIVE_FIXNUM);
+}
+
+static gcc_jit_rvalue *
+emit_most_negative_fixnum (void)
+{
+ return emit_rvalue_from_emacs_int (MOST_NEGATIVE_FIXNUM);
+}
+
/*
Emit the equivalent of:
(typeof_ptr) ((uintptr) ptr + size_of_ptr_ref * i)
@@ -769,7 +907,7 @@ emit_ptr_arithmetic (gcc_jit_rvalue *ptr, gcc_jit_type *ptr_type,
emit_XLI (gcc_jit_rvalue *obj)
{
emit_comment ("XLI");
- return obj;
+ return emit_coerce (comp.emacs_int_type, obj);
}
static gcc_jit_lvalue *
@@ -779,54 +917,40 @@ emit_lval_XLI (gcc_jit_lvalue *obj)
return obj;
}
-/*
+
static gcc_jit_rvalue *
emit_XLP (gcc_jit_rvalue *obj)
{
emit_comment ("XLP");
- return gcc_jit_rvalue_access_field (obj,
- NULL,
- comp.lisp_obj_as_ptr);
+ return emit_coerce(comp.void_ptr_type, obj);
}
-static gcc_jit_lvalue *
-emit_lval_XLP (gcc_jit_lvalue *obj)
-{
- emit_comment ("lval_XLP");
+/* TODO */
+/* static gcc_jit_lvalue * */
+/* emit_lval_XLP (gcc_jit_lvalue *obj) */
+/* { */
+/* emit_comment ("lval_XLP"); */
+
+/* return gcc_jit_lvalue_access_field (obj, */
+/* NULL, */
+/* comp.lisp_obj_as_ptr); */
+/* } */
- return gcc_jit_lvalue_access_field (obj,
- NULL,
- comp.lisp_obj_as_ptr);
-} */
static gcc_jit_rvalue *
-emit_XUNTAG (gcc_jit_rvalue *a, gcc_jit_type *type, long long lisp_word_tag)
+emit_XUNTAG (gcc_jit_rvalue *a, gcc_jit_type *type, Lisp_Word_tag lisp_word_tag)
{
/* #define XUNTAG(a, type, ctype) ((ctype *)
((char *) XLP (a) - LISP_WORD_TAG (type))) */
emit_comment ("XUNTAG");
-#ifndef WIDE_EMACS_INT
return emit_coerce (
gcc_jit_type_get_pointer (type),
emit_binary_op (
GCC_JIT_BINARY_OP_MINUS,
- comp.emacs_int_type,
- emit_XLI (a),
- gcc_jit_context_new_rvalue_from_int (
- comp.ctxt,
- comp.emacs_int_type,
- lisp_word_tag)));
-#else
- return emit_coerce (
- gcc_jit_type_get_pointer (type),
- emit_binary_op (
- GCC_JIT_BINARY_OP_MINUS,
- comp.unsigned_long_long_type,
- /* FIXME Should be XLP. */
- emit_XLI (a),
- emit_rvalue_from_long_long (lisp_word_tag)));
-#endif
+ comp.uintptr_type,
+ emit_XLP (a),
+ emit_rvalue_from_lisp_word_tag(lisp_word_tag)));
}
static gcc_jit_rvalue *
@@ -853,7 +977,7 @@ emit_EQ (gcc_jit_rvalue *x, gcc_jit_rvalue *y)
}
static gcc_jit_rvalue *
-emit_TAGGEDP (gcc_jit_rvalue *obj, ptrdiff_t tag)
+emit_TAGGEDP (gcc_jit_rvalue *obj, Lisp_Word_tag tag)
{
/* (! (((unsigned) (XLI (a) >> (USE_LSB_TAG ? 0 : VALBITS)) \
- (unsigned) (tag)) \
@@ -1054,17 +1178,7 @@ emit_make_fixnum_LSB_TAG (gcc_jit_rvalue *n)
comp.emacs_int_type,
tmp, comp.lisp_int0);
- gcc_jit_lvalue *res = gcc_jit_function_new_local (comp.func,
- NULL,
- comp.lisp_obj_type,
- "lisp_obj_fixnum");
-
- gcc_jit_block_add_assignment (comp.block,
- NULL,
- emit_lval_XLI (res),
- tmp);
-
- return gcc_jit_lvalue_as_rvalue (res);
+ return emit_coerce (comp.lisp_obj_type, tmp);
}
static gcc_jit_rvalue *
@@ -1076,10 +1190,8 @@ emit_make_fixnum_MSB_TAG (gcc_jit_rvalue *n)
return XIL (n);
*/
- gcc_jit_rvalue *intmask =
- emit_coerce (comp.emacs_uint_type,
- emit_rvalue_from_long_long ((EMACS_INT_MAX
- >> (INTTYPEBITS - 1))));
+ gcc_jit_rvalue *intmask = emit_rvalue_from_emacs_uint (INTMASK);
+
n = emit_binary_op (GCC_JIT_BINARY_OP_BITWISE_AND,
comp.emacs_uint_type,
intmask, n);
@@ -1090,12 +1202,10 @@ emit_make_fixnum_MSB_TAG (gcc_jit_rvalue *n)
emit_binary_op (GCC_JIT_BINARY_OP_LSHIFT,
comp.emacs_uint_type,
comp.lisp_int0,
- gcc_jit_context_new_rvalue_from_int (
- comp.ctxt,
- comp.emacs_uint_type,
- VALBITS)),
+ emit_rvalue_from_emacs_uint(VALBITS)),
n);
- return emit_XLI (emit_coerce (comp.emacs_int_type, n));
+
+ return emit_coerce (comp.lisp_obj_type, n);
}
@@ -1114,17 +1224,10 @@ emit_const_lisp_obj (Lisp_Object obj)
emit_comment (format_string ("const lisp obj: %s",
SSDATA (Fprin1_to_string (obj, Qnil))));
- if (NIL_IS_ZERO && EQ (obj, Qnil))
+ if (EQ (obj, Qnil))
{
gcc_jit_rvalue *n;
-#ifdef WIDE_EMACS_INT
- eassert (NIL_IS_ZERO);
- n = emit_rvalue_from_long_long (0);
-#else
- n = gcc_jit_context_new_rvalue_from_ptr (comp.ctxt,
- comp.void_ptr_type,
- NULL);
-#endif
+ n = emit_rvalue_from_lisp_word ((Lisp_Word) iQnil);
return emit_coerce (comp.lisp_obj_type, n);
}
@@ -1345,16 +1448,7 @@ emit_mvar_val (Lisp_Object mvar)
/* We can still emit directly objects that are self-contained in a
word (read fixnums). */
emit_comment (SSDATA (Fprin1_to_string (constant, Qnil)));
- gcc_jit_rvalue *word;
-#ifdef WIDE_EMACS_INT
- word = emit_rvalue_from_long_long (constant);
-#else
- word =
- gcc_jit_context_new_rvalue_from_ptr (comp.ctxt,
- comp.void_ptr_type,
- XLP (constant));
-#endif
- return emit_coerce (comp.lisp_obj_type, word);
+ return emit_rvalue_from_lisp_obj(constant);
}
/* Other const objects are fetched from the reloc array. */
return emit_const_lisp_obj (constant);
@@ -2518,11 +2612,16 @@ define_cast_union (void)
NULL,
comp.lisp_cons_ptr_type,
"cons_ptr");
- comp.cast_union_as_lisp_obj =
+ comp.cast_union_as_lisp_word =
gcc_jit_context_new_field (comp.ctxt,
NULL,
- comp.lisp_obj_type,
- "lisp_obj");
+ comp.lisp_word_type,
+ "lisp_word");
+ comp.cast_union_as_lisp_word_tag =
+ gcc_jit_context_new_field (comp.ctxt,
+ NULL,
+ comp.lisp_word_tag_type,
+ "lisp_word_tag");
comp.cast_union_as_lisp_obj_ptr =
gcc_jit_context_new_field (comp.ctxt,
NULL,
@@ -2543,7 +2642,8 @@ define_cast_union (void)
comp.cast_union_as_c_p,
comp.cast_union_as_v_p,
comp.cast_union_as_lisp_cons_ptr,
- comp.cast_union_as_lisp_obj,
+ comp.cast_union_as_lisp_word,
+ comp.cast_union_as_lisp_word_tag,
comp.cast_union_as_lisp_obj_ptr };
comp.cast_union_type =
gcc_jit_context_new_union_type (comp.ctxt,
@@ -2810,8 +2910,8 @@ define_add1_sub1 (void)
GCC_JIT_COMPARISON_NE,
n_fixnum,
i == 0
- ? emit_most_positive_fixnum ()
- : emit_most_negative_fixnum ())),
+ ? emit_rvalue_from_emacs_int (MOST_POSITIVE_FIXNUM)
+ : emit_rvalue_from_emacs_int (MOST_NEGATIVE_FIXNUM))),
inline_block,
fcall_block);
@@ -3307,9 +3407,31 @@ DEFUN ("comp--init-ctxt", Fcomp__init_ctxt, Scomp__init_ctxt,
comp.emacs_uint_type = gcc_jit_context_get_int_type (comp.ctxt,
sizeof (EMACS_UINT),
false);
- /* No XLP is emitted for now so lets define this always as integer
- disregarding LISP_WORDS_ARE_POINTERS value. */
- comp.lisp_obj_type = comp.emacs_int_type;
+#if LISP_WORDS_ARE_POINTERS
+ comp.lisp_X_s = gcc_jit_context_new_opaque_struct (comp.ctxt,
+ NULL,
+ "Lisp_X");
+ comp.lisp_X = gcc_jit_struct_as_type(comp.lisp_X_s);
+ comp.lisp_word_type = gcc_jit_type_get_pointer(comp.lisp_X);
+#else
+ comp.lisp_word_type = comp.emacs_int_type;
+#endif
+ comp.lisp_word_tag_type
+ = gcc_jit_context_get_int_type (comp.ctxt, sizeof (Lisp_Word_tag), false);
+#ifdef LISP_OBJECT_IS_STRUCT
+ comp.lisp_obj_i = gcc_jit_context_new_field (comp.ctxt,
+ NULL,
+ comp.lisp_word_type,
+ "i");
+ comp.lisp_obj_s = gcc_jit_context_new_struct_type (comp.ctxt,
+ NULL,
+ "Lisp_Object",
+ 1,
+ &comp.lisp_obj_i);
+ comp.lisp_obj_type = gcc_jit_struct_as_type (comp.lisp_obj_s);
+#else
+ comp.lisp_obj_type = comp.lisp_word_type;
+#endif
comp.lisp_obj_ptr_type = gcc_jit_type_get_pointer (comp.lisp_obj_type);
comp.one =
gcc_jit_context_new_rvalue_from_int (comp.ctxt,
diff --git a/src/lisp.h b/src/lisp.h
index 834b3e586c..e242546d10 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -299,12 +299,12 @@ #define GCALIGNED(type) (alignof (type) % GCALIGNMENT == 0)
/* Lisp_Word is a scalar word suitable for holding a tagged pointer or
integer. Usually it is a pointer to a deliberately-incomplete type
- 'union Lisp_X'. However, it is EMACS_INT when Lisp_Objects and
+ 'struct Lisp_X'. However, it is EMACS_INT when Lisp_Objects and
pointers differ in width. */
#define LISP_WORDS_ARE_POINTERS (EMACS_INT_MAX == INTPTR_MAX)
#if LISP_WORDS_ARE_POINTERS
-typedef union Lisp_X *Lisp_Word;
+typedef struct Lisp_X *Lisp_Word;
#else
typedef EMACS_INT Lisp_Word;
#endif
@@ -573,6 +573,7 @@ #define ENUM_BF(TYPE) enum TYPE
#ifdef CHECK_LISP_OBJECT_TYPE
typedef struct Lisp_Object { Lisp_Word i; } Lisp_Object;
+# define LISP_OBJECT_IS_STRUCT
# define LISP_INITIALLY(w) {w}
# undef CHECK_LISP_OBJECT_TYPE
enum CHECK_LISP_OBJECT_TYPE { CHECK_LISP_OBJECT_TYPE = true };
--
2.25.1.windows.1
[-- Attachment #4: 0001-Determine-the-emacs-root-dir-only-when-necessary.patch --]
[-- Type: application/octet-stream, Size: 4341 bytes --]
From a7176a64d4d882874d4a81cc3924e03fa2a09ce8 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Nicol=C3=A1s=20B=C3=A9rtolo?= <nicolasbertolo@gmail.com>
Date: Wed, 13 May 2020 18:31:42 -0300
Subject: [PATCH 1/9] Determine the emacs root dir only when necessary.
* src/fileio.c: Introduce function emacs_root_dir(). Refactor
`expand-file-name` to use it.
* src/lisp.h: Separate emacs_root_dir() into dos_emacs_root_dir() and
w32_emacs_root_dir().
* src/msdos.c: Rename emacs_root_dir() to dos_emacs_root_dir().
* src/w32.c: Rename emacs_root_dir() to w32_emacs_root_dir().
---
src/fileio.c | 37 ++++++++++++++++++++++---------------
src/lisp.h | 11 +++++++----
src/msdos.c | 2 +-
src/w32.c | 2 +-
4 files changed, 31 insertions(+), 21 deletions(-)
diff --git a/src/fileio.c b/src/fileio.c
index 2f1d2f8243..e20fa93c65 100644
--- a/src/fileio.c
+++ b/src/fileio.c
@@ -781,6 +781,18 @@ user_homedir (char const *name)
return pw->pw_dir;
}
+static Lisp_Object
+emacs_root_dir()
+{
+#ifdef DOS
+ return build_string (dos_emacs_root_dir ());
+#elif defined(WINDOWSNT)
+ return build_string (w32_emacs_root_dir ());
+#else
+ return build_string ("/");
+#endif
+}
+
DEFUN ("expand-file-name", Fexpand_file_name, Sexpand_file_name, 1, 2, 0,
doc: /* Convert filename NAME to absolute, and canonicalize it.
Second arg DEFAULT-DIRECTORY is directory to start with if NAME is relative
@@ -851,21 +863,16 @@ DEFUN ("expand-file-name", Fexpand_file_name, Sexpand_file_name, 1, 2, 0,
}
/* As a last resort, we may have to use the root as
- default_directory below. */
- Lisp_Object root;
-#ifdef DOS_NT
- /* "/" is not considered a root directory on DOS_NT, so using it
- as default_directory causes an infinite recursion in, e.g.,
- the following:
+ default_directory below.
- (let (default-directory)
- (expand-file-name "a"))
+ "/" is not considered a root directory on DOS_NT, so using it
+ as default_directory causes an infinite recursion in, e.g.,
+ the following:
- To avoid this, we use the root of the current drive. */
- root = build_string (emacs_root_dir ());
-#else
- root = build_string ("/");
-#endif
+ (let (default-directory)
+ (expand-file-name "a"))
+
+ To avoid this, we use the root of the current drive. */
/* Use the buffer's default-directory if DEFAULT_DIRECTORY is omitted. */
if (NILP (default_directory))
@@ -891,13 +898,13 @@ DEFUN ("expand-file-name", Fexpand_file_name, Sexpand_file_name, 1, 2, 0,
Lisp_Object absdir
= STRINGP (Vinvocation_directory)
&& file_name_absolute_no_tilde_p (Vinvocation_directory)
- ? Vinvocation_directory : root;
+ ? Vinvocation_directory : emacs_root_dir();
default_directory = Fexpand_file_name (dir, absdir);
}
}
}
if (! STRINGP (default_directory))
- default_directory = root;
+ default_directory = emacs_root_dir();
handler = Ffind_file_name_handler (default_directory, Qexpand_file_name);
if (!NILP (handler))
diff --git a/src/lisp.h b/src/lisp.h
index 3d082911f5..834b3e586c 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -4719,10 +4719,13 @@ maybe_disable_address_randomization (int argc, char **argv)
extern void malloc_probe (size_t);
extern void syms_of_profiler (void);
-#ifdef DOS_NT
-/* Defined in msdos.c, w32.c. */
-extern char *emacs_root_dir (void);
-#endif /* DOS_NT */
+#ifdef MSDOS
+/* Defined in msdos.c. */
+extern char *dos_emacs_root_dir (void);
+#elif defined(WINDOWSNT)
+/* Defined in w32.c. */
+extern char *w32_emacs_root_dir (void);
+#endif /* MSDOS */
#ifdef HAVE_NATIVE_COMP
INLINE bool
diff --git a/src/msdos.c b/src/msdos.c
index b5f06c99c3..0827cc96cd 100644
--- a/src/msdos.c
+++ b/src/msdos.c
@@ -3350,7 +3350,7 @@ getdefdir (int drive, char *dst)
}
char *
-emacs_root_dir (void)
+dos_emacs_root_dir (void)
{
static char root_dir[4];
diff --git a/src/w32.c b/src/w32.c
index 0f69e652a5..1ec0094c8e 100644
--- a/src/w32.c
+++ b/src/w32.c
@@ -3147,7 +3147,7 @@ #define SET_ENV_BUF_SIZE (4 * MAX_PATH) /* to cover EMACSLOADPATH */
/* Called from expand-file-name when default-directory is not a string. */
char *
-emacs_root_dir (void)
+w32_emacs_root_dir (void)
{
static char root_dir[MAX_UTF8_PATH];
const char *p;
--
2.25.1.windows.1
[-- Attachment #5: 0002-Do-not-block-SIGIO-in-platforms-that-don-t-have-it.patch --]
[-- Type: application/octet-stream, Size: 909 bytes --]
From e8e224fbf97c6346a355820e62aa4239a9c63a86 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Nicol=C3=A1s=20B=C3=A9rtolo?= <nicolasbertolo@gmail.com>
Date: Fri, 8 May 2020 16:02:58 -0300
Subject: [PATCH 2/9] Do not block SIGIO in platforms that don't have it.
* src/comp.c (comp--compile-ctxt-to-file): Add a preprocessor check to
avoid blocking SIGIO in platforms that don't have it.
---
src/comp.c | 2 ++
1 file changed, 2 insertions(+)
diff --git a/src/comp.c b/src/comp.c
index e3a80adfa9..00f9d4b74a 100644
--- a/src/comp.c
+++ b/src/comp.c
@@ -3345,7 +3345,9 @@ DEFUN ("comp--compile-ctxt-to-file", Fcomp__compile_ctxt_to_file,
sigemptyset (&blocked);
sigaddset (&blocked, SIGALRM);
sigaddset (&blocked, SIGINT);
+#ifdef USABLE_SIGIO
sigaddset (&blocked, SIGIO);
+#endif
pthread_sigmask (SIG_BLOCK, &blocked, &oldset);
}
emit_ctxt_code ();
--
2.25.1.windows.1
[-- Attachment #6: 0005-Remove-a-layer-of-indirection-for-access-to-pure-sto.patch --]
[-- Type: application/octet-stream, Size: 3345 bytes --]
From 8dbe0c99ecbaa1b153ca6b3af02f9b5e96d63d0b Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Nicol=C3=A1s=20B=C3=A9rtolo?= <nicolasbertolo@gmail.com>
Date: Fri, 8 May 2020 16:23:10 -0300
Subject: [PATCH 5/9] Remove a layer of indirection for access to pure storage.
* src/comp.c: Taking the address of an array is the same as casting it
to a pointer. Therefore, the C expression `(EMACS_INT **) &pure` is in
fact adding a layer of indirection that is not necessary. The fix is
to cast the `pure` array to a pointer and store that in a void pointer
that is part of the compiled shared library.
---
src/comp.c | 19 +++++++++----------
1 file changed, 9 insertions(+), 10 deletions(-)
diff --git a/src/comp.c b/src/comp.c
index 0d5880ad3c..69525acfc0 100644
--- a/src/comp.c
+++ b/src/comp.c
@@ -38,7 +38,7 @@
/* C symbols emitted for the load relocation mechanism. */
#define CURRENT_THREAD_RELOC_SYM "current_thread_reloc"
-#define PURE_RELOC_SYM "pure_reloc"
+#define PURE_PTR_SYM "pure_ptr"
#define DATA_RELOC_SYM "d_reloc"
#define DATA_RELOC_IMPURE_SYM "d_reloc_imp"
#define DATA_RELOC_EPHEMERAL_SYM "d_reloc_eph"
@@ -152,7 +152,7 @@ #define F_RELOC_MAX_SIZE 1500
gcc_jit_type *thread_state_ptr_type;
gcc_jit_rvalue *current_thread_ref;
/* Other globals. */
- gcc_jit_rvalue *pure_ref;
+ gcc_jit_rvalue *pure_ptr;
/* libgccjit has really limited support for casting therefore this union will
be used for the scope. */
gcc_jit_type *cast_union_type;
@@ -1419,8 +1419,7 @@ emit_PURE_P (gcc_jit_rvalue *ptr)
GCC_JIT_BINARY_OP_MINUS,
comp.uintptr_type,
ptr,
- gcc_jit_lvalue_as_rvalue (
- gcc_jit_rvalue_dereference (comp.pure_ref, NULL))),
+ comp.pure_ptr),
gcc_jit_context_new_rvalue_from_int (comp.ctxt,
comp.uintptr_type,
PURESIZE));
@@ -2244,14 +2243,14 @@ emit_ctxt_code (void)
gcc_jit_type_get_pointer (comp.thread_state_ptr_type),
CURRENT_THREAD_RELOC_SYM));
- comp.pure_ref =
+ comp.pure_ptr =
gcc_jit_lvalue_as_rvalue (
gcc_jit_context_new_global (
comp.ctxt,
NULL,
GCC_JIT_GLOBAL_EXPORTED,
- gcc_jit_type_get_pointer (comp.void_ptr_type),
- PURE_RELOC_SYM));
+ comp.void_ptr_type,
+ PURE_PTR_SYM));
gcc_jit_context_new_global (
comp.ctxt,
@@ -3767,13 +3766,13 @@ load_comp_unit (struct Lisp_Native_Comp_Unit *comp_u, bool loading_dump,
{
struct thread_state ***current_thread_reloc =
dynlib_sym (handle, CURRENT_THREAD_RELOC_SYM);
- EMACS_INT ***pure_reloc = dynlib_sym (handle, PURE_RELOC_SYM);
+ void **pure_ptr = dynlib_sym (handle, PURE_PTR_SYM);
Lisp_Object *data_relocs = dynlib_sym (handle, DATA_RELOC_SYM);
Lisp_Object *data_imp_relocs = dynlib_sym (handle, DATA_RELOC_IMPURE_SYM);
void **freloc_link_table = dynlib_sym (handle, FUNC_LINK_TABLE_SYM);
if (!(current_thread_reloc
- && pure_reloc
+ && pure_ptr
&& data_relocs
&& data_imp_relocs
&& data_eph_relocs
@@ -3784,7 +3783,7 @@ load_comp_unit (struct Lisp_Native_Comp_Unit *comp_u, bool loading_dump,
xsignal1 (Qnative_lisp_file_inconsistent, comp_u->file);
*current_thread_reloc = ¤t_thread;
- *pure_reloc = (EMACS_INT **)&pure;
+ *pure_ptr = pure;
/* Imported functions. */
*freloc_link_table = freloc.link_table;
--
2.25.1.windows.1
[-- Attachment #7: 0008-Windows-Use-NUMBER_OF_PROCESSORS-environment-variabl.patch --]
[-- Type: application/octet-stream, Size: 1433 bytes --]
From 1fb5c38748c12735ee1d6eb6e794d61720e4fc11 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Nicol=C3=A1s=20B=C3=A9rtolo?= <nicolasbertolo@gmail.com>
Date: Wed, 13 May 2020 16:22:17 -0300
Subject: [PATCH 8/9] Windows: Use NUMBER_OF_PROCESSORS environment variable.
* lisp/emacs-lisp/comp.el (comp-effective-async-max-jobs): Use
NUMBER_OF_PROCESSORS environment variable if system is Windows NT,
"nproc" if it is in PATH or a default of 1.
---
lisp/emacs-lisp/comp.el | 8 +++++---
1 file changed, 5 insertions(+), 3 deletions(-)
diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el
index d32f93a1e1..26bb79fcd1 100644
--- a/lisp/emacs-lisp/comp.el
+++ b/lisp/emacs-lisp/comp.el
@@ -2208,9 +2208,11 @@ comp-async-runnings
(if (zerop comp-async-jobs-number)
(or num-cpus
(setf num-cpus
- ;; Half of the CPUs or at least one.
- ;; FIXME portable?
- (max 1 (/ (string-to-number (shell-command-to-string "nproc"))
+ (max 1 (/ (cond ((eq 'windows-nt system-type)
+ (string-to-number (getenv "NUMBER_OF_PROCESSORS")))
+ ((executable-find "nproc")
+ (string-to-number (shell-command-to-string "nproc")))
+ (t 1))
2))))
comp-async-jobs-number)))
--
2.25.1.windows.1
[-- Attachment #8: 0009-Improve-handling-of-native-compilation-units-still-i.patch --]
[-- Type: application/octet-stream, Size: 19739 bytes --]
From d5ee4185a9f23462cdb3fa34cafef508ddb9b81b Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Nicol=C3=A1s=20B=C3=A9rtolo?= <nicolasbertolo@gmail.com>
Date: Tue, 19 May 2020 15:57:31 -0300
Subject: [PATCH 9/9] Improve handling of native compilation units still in use
in Windows
When closing emacs will inspect all directories from which it loaded
native compilation units. If it finds a ".eln.old" file it will try to
delete it, if it fails that means that another Emacs instance is using it.
When compiling a file we rename the file that was in the output path
in case it has been loaded into another Emacs instance.
When deleting a package we move any ".eln" or ".eln.old" files in the
package folder that we can't delete to `package-user-dir`. Emacs will
check that directory when closing and delete them.
* lisp/emacs-lisp/comp.el (comp--replace-output-file): Function called
from C code to finish the compilation process. It performs renaming of
the old file if necessary.
* lisp/emacs-lisp/package.el (package--delete-directory): Function to
delete a package directory. It moves native compilation units that it
can't delete to `package-user-dir'.
* src/alloc.c (cleanup_vector): Call dispose_comp_unit().
(garbage_collect): Call finish_delayed_disposal_of_comp_units().
* src/comp.c: Restore the signal mask using unwind-protect. Store
loaded native compilation units in a hash table for disposal on
close. Store filenames of native compilation units GC'd in a linked
list to finish their disposal when the GC is over.
* src/comp.h: Introduce cfile member in Lisp_Native_Comp_Unit.
Add declarations of functions that: clean directories of unused native
compilation units, handle disposal of native compilation units.
* src/emacs.c (kill-emacs): Dispose all remaining compilation units
right right before calling exit().
* src/eval.c (internal_condition_case_3, internal_condition_case_4):
Add functions.
* src/lisp.h (internal_condition_case_3, internal_condition_case_4):
Add functions.
* src/pdumper.c (dump_do_dump_relocation): Set cfile to a copy of the
Lisp string specifying the file path.
---
lisp/emacs-lisp/comp.el | 25 ++++++
lisp/emacs-lisp/package.el | 27 +++++-
src/alloc.c | 5 +-
src/comp.c | 174 ++++++++++++++++++++++++++++++++++---
src/comp.h | 27 ++++++
src/emacs.c | 3 +
src/eval.c | 55 ++++++++++++
src/lisp.h | 2 +
src/pdumper.c | 3 +
9 files changed, 308 insertions(+), 13 deletions(-)
diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el
index 26bb79fcd1..ee72c92991 100644
--- a/lisp/emacs-lisp/comp.el
+++ b/lisp/emacs-lisp/comp.el
@@ -2183,6 +2183,31 @@ comp-hint-cons
\f
;; Some entry point support code.
+(defun comp--replace-output-file (outfile tmpfile)
+ "Replace OUTFILE with TMPFILE taking the necessary steps when
+dealing with shared libraries that may be loaded into Emacs"
+ (cond ((eq 'windows-nt system-type)
+ (ignore-errors (delete-file outfile))
+ (let ((retry t))
+ (while retry
+ (setf retry nil)
+ (condition-case _
+ (progn
+ ;; outfile maybe recreated by another Emacs in
+ ;; between the following two rename-file calls
+ (if (file-exists-p outfile)
+ (rename-file outfile (make-temp-file-internal
+ (file-name-sans-extension outfile)
+ nil ".eln.old" nil)
+ t))
+ (rename-file tmpfile outfile nil))
+ (file-already-exists (setf retry t))))))
+ ;; Remove the old eln instead of copying the new one into it
+ ;; to get a new inode and prevent crashes in case the old one
+ ;; is currently loaded.
+ (t (delete-file outfile)
+ (rename-file tmpfile outfile))))
+
(defvar comp-files-queue ()
"List of Elisp files to be compiled.")
diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el
index 95659840ad..c1c54b3c9a 100644
--- a/lisp/emacs-lisp/package.el
+++ b/lisp/emacs-lisp/package.el
@@ -2184,6 +2184,31 @@ package--newest-p
(equal (cadr (assq (package-desc-name pkg) package-alist))
pkg))
+(defun package--delete-directory (dir)
+ "Delete DIR recursively.
+In Windows move .eln and .eln.old files that can not be deleted to `package-user-dir'."
+ (cond ((eq 'windows-nt system-type)
+ (let ((retry t))
+ (while retry
+ (setf retry nil)
+ (condition-case err
+ (delete-directory dir t)
+ (file-error
+ (if (and (string= "Removing old name" (cadr err))
+ (string= "Permission denied" (caddr err))
+ (or (string-suffix-p ".eln" (cadddr err))
+ (string-suffix-p ".eln.old" (cadddr err))))
+ (progn
+ (rename-file (cadddr err)
+ (make-temp-file-internal
+ (concat package-user-dir
+ (file-name-base (cadddr err)))
+ nil ".eln.old" nil)
+ t)
+ (setf retry t))
+ (signal (car err) (cdr err))))))))
+ (t (delete-directory dir t))))
+
(defun package-delete (pkg-desc &optional force nosave)
"Delete package PKG-DESC.
@@ -2236,7 +2261,7 @@ package-delete
(package-desc-name pkg-used-elsewhere-by)))
(t
(add-hook 'post-command-hook #'package-menu--post-refresh)
- (delete-directory dir t)
+ (package--delete-directory dir)
;; Remove NAME-VERSION.signed and NAME-readme.txt files.
;;
;; NAME-readme.txt files are no longer created, but they
diff --git a/src/alloc.c b/src/alloc.c
index f2b80fac88..17f5e15b35 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -3119,8 +3119,7 @@ cleanup_vector (struct Lisp_Vector *vector)
{
struct Lisp_Native_Comp_Unit *cu =
PSEUDOVEC_STRUCT (vector, Lisp_Native_Comp_Unit);
- eassert (cu->handle);
- dynlib_close (cu->handle);
+ dispose_comp_unit (cu, true);
}
}
@@ -6119,6 +6118,8 @@ garbage_collect (void)
if (tot_after < tot_before)
malloc_probe (min (tot_before - tot_after, SIZE_MAX));
}
+
+ finish_delayed_disposal_of_comp_units ();
}
DEFUN ("garbage-collect", Fgarbage_collect, Sgarbage_collect, 0, 0, "",
diff --git a/src/comp.c b/src/comp.c
index b43d3eddb3..35e1ec0da3 100644
--- a/src/comp.c
+++ b/src/comp.c
@@ -413,6 +413,10 @@ #define THIRD(x) \
#define CALL1I(fun, arg) \
CALLN (Ffuncall, intern_c_string (STR (fun)), arg)
+/* Like call2 but stringify and intern. */
+#define CALL2I(fun, arg1, arg2) \
+ CALLN (Ffuncall, intern_c_string (STR (fun)), arg1, arg2)
+
#define DECL_BLOCK(name, func) \
gcc_jit_block *(name) = \
gcc_jit_function_new_block ((func), STR (name))
@@ -3830,6 +3834,14 @@ DEFUN ("comp--release-ctxt", Fcomp__release_ctxt, Scomp__release_ctxt,
return Qt;
}
+sigset_t oldset;
+
+static void restore_sigmask(void)
+{
+ pthread_sigmask (SIG_SETMASK, &oldset, 0);
+ unblock_input ();
+}
+
DEFUN ("comp--compile-ctxt-to-file", Fcomp__compile_ctxt_to_file,
Scomp__compile_ctxt_to_file,
1, 1, 0,
@@ -3851,6 +3863,8 @@ DEFUN ("comp--compile-ctxt-to-file", Fcomp__compile_ctxt_to_file,
CALL1I (comp-data-container-idx, CALL1I (comp-ctxt-d-ephemeral, Vcomp_ctxt));
sigset_t oldset;
+ ptrdiff_t count;
+
if (!noninteractive)
{
sigset_t blocked;
@@ -3863,6 +3877,8 @@ DEFUN ("comp--compile-ctxt-to-file", Fcomp__compile_ctxt_to_file,
sigaddset (&blocked, SIGIO);
#endif
pthread_sigmask (SIG_BLOCK, &blocked, &oldset);
+ count = SPECPDL_INDEX ();
+ record_unwind_protect_void(restore_sigmask);
}
emit_ctxt_code ();
@@ -3902,18 +3918,10 @@ DEFUN ("comp--compile-ctxt-to-file", Fcomp__compile_ctxt_to_file,
GCC_JIT_OUTPUT_KIND_DYNAMIC_LIBRARY,
SSDATA (tmp_file));
- /* Remove the old eln instead of copying the new one into it to get
- a new inode and prevent crashes in case the old one is currently
- loaded. */
- if (!NILP (Ffile_exists_p (out_file)))
- Fdelete_file (out_file, Qnil);
- Frename_file (tmp_file, out_file, Qnil);
+ CALL2I(comp--replace-output-file, out_file, tmp_file);
if (!noninteractive)
- {
- pthread_sigmask (SIG_SETMASK, &oldset, 0);
- unblock_input ();
- }
+ unbind_to(count, Qnil);
return out_file;
}
@@ -3974,6 +3982,138 @@ helper_PSEUDOVECTOR_TYPEP_XUNTAG (Lisp_Object a, enum pvec_type code)
code);
}
+\f
+/*********************************/
+/* Disposal of compilation units */
+/*********************************/
+
+#ifdef WINDOWSNT
+#define OLD_ELN_SUFFIX_REGEXP build_string("\\.eln\\.old$")
+
+static Lisp_Object all_loaded_comp_units;
+
+struct delayed_comp_unit_disposal
+{
+ struct delayed_comp_unit_disposal * next;
+ char * filename;
+};
+
+struct delayed_comp_unit_disposal * delayed_comp_unit_disposal_list;
+
+static Lisp_Object
+returnQnil (Lisp_Object arg)
+{
+ return Qnil;
+}
+
+static void
+clean_comp_unit_directory (Lisp_Object filepath)
+{
+ if (NILP (filepath))
+ return;
+ Lisp_Object files_in_dir;
+ files_in_dir = internal_condition_case_4(Fdirectory_files, filepath, Qt,
+ OLD_ELN_SUFFIX_REGEXP, Qnil, Qt, returnQnil);
+ FOR_EACH_TAIL(files_in_dir)
+ {
+ DeleteFile (SSDATA (XCAR (files_in_dir)));
+ }
+}
+
+void clean_package_user_dir_of_old_comp_units (void)
+{
+ Lisp_Object package_user_dir = find_symbol_value (intern ("package-user-dir"));
+ if (EQ(package_user_dir, Qunbound) || !STRINGP(package_user_dir))
+ return;
+
+ clean_comp_unit_directory(package_user_dir);
+}
+
+#endif
+
+void dispose_comp_unit (struct Lisp_Native_Comp_Unit * comp_handle, bool delay)
+{
+ eassert (comp_handle->handle);
+ dynlib_close (comp_handle->handle);
+#ifdef WINDOWSNT
+ if (!delay)
+ {
+ Lisp_Object dirname = internal_condition_case_1(Ffile_name_directory,
+ build_string (comp_handle->cfile),
+ Qt,
+ returnQnil);
+ if (!NILP(dirname))
+ clean_comp_unit_directory (dirname);
+ xfree (comp_handle->cfile);
+ comp_handle->cfile = NULL;
+ }
+ else
+ {
+ struct delayed_comp_unit_disposal * head;
+ head = xmalloc (sizeof (struct delayed_comp_unit_disposal));
+ head->next = delayed_comp_unit_disposal_list;
+ head->filename = comp_handle->cfile;
+ comp_handle->cfile = NULL;
+ delayed_comp_unit_disposal_list = head;
+ }
+#else
+ xfree (comp_handle->file);
+#endif
+}
+
+static void
+register_native_comp_unit (Lisp_Object comp_u)
+{
+#ifdef WINDOWSNT
+ static EMACS_UINT count;
+
+ if (XFIXNUM(Fhash_table_count(all_loaded_comp_units)) >= MOST_POSITIVE_FIXNUM)
+ return;
+
+ while (!NILP(Fgethash(make_fixnum(count), all_loaded_comp_units, Qnil)))
+ count = (count + 1) % MOST_POSITIVE_FIXNUM;
+
+ Fputhash(make_fixnum(count), comp_u, all_loaded_comp_units);
+#endif
+}
+
+void dispose_all_remaining_comp_units (void)
+{
+#ifdef WINDOWSNT
+ struct Lisp_Hash_Table *h = XHASH_TABLE (all_loaded_comp_units);
+
+ for (ptrdiff_t i = 0; i < HASH_TABLE_SIZE (h); ++i)
+ {
+ Lisp_Object k = HASH_KEY (h, i);
+ if (!EQ (k, Qunbound))
+ {
+ Lisp_Object val = HASH_VALUE (h, i);
+ struct Lisp_Native_Comp_Unit * cu = XNATIVE_COMP_UNIT(val);
+ dispose_comp_unit(cu, false);
+ }
+ }
+#endif
+}
+
+void finish_delayed_disposal_of_comp_units (void)
+{
+#ifdef WINDOWSNT
+ for (struct delayed_comp_unit_disposal * item = delayed_comp_unit_disposal_list;
+ delayed_comp_unit_disposal_list;
+ item = delayed_comp_unit_disposal_list)
+ {
+ delayed_comp_unit_disposal_list = item->next;
+ Lisp_Object dirname
+ = internal_condition_case_1 (Ffile_name_directory,
+ build_string (item->filename), Qt,
+ returnQnil);
+ clean_comp_unit_directory (dirname);
+ xfree(item->filename);
+ xfree(item);
+ }
+#endif
+}
+
\f
/***********************************/
/* Deferred compilation mechanism. */
@@ -4160,6 +4300,12 @@ load_comp_unit (struct Lisp_Native_Comp_Unit *comp_u, bool loading_dump,
d_vec_len = XFIXNUM (Flength (comp_u->data_impure_vec));
for (EMACS_INT i = 0; i < d_vec_len; i++)
data_imp_relocs[i] = AREF (comp_u->data_impure_vec, i);
+
+ /* If we register them while dumping we will get some entries in
+ the hash table that will be duplicated when pdumper calls
+ load_comp_unit. */
+ if (!will_dump_p())
+ register_native_comp_unit (comp_u_lisp_obj);
}
if (!loading_dump)
@@ -4273,6 +4419,9 @@ DEFUN ("native-elisp-load", Fnative_elisp_load, Snative_elisp_load, 1, 2, 0,
if (!comp_u->handle)
xsignal2 (Qnative_lisp_load_failed, file, build_string (dynlib_error ()));
comp_u->file = file;
+#ifdef WINDOWSNT
+ comp_u->cfile = xlispstrdup(file);
+#endif
comp_u->data_vec = Qnil;
load_comp_unit (comp_u, false, !NILP (late_load));
@@ -4417,6 +4566,11 @@ syms_of_comp (void)
staticpro (&delayed_sources);
delayed_sources = Qnil;
+#ifdef WINDOWSNT
+ staticpro (&all_loaded_comp_units);
+ all_loaded_comp_units = CALLN(Fmake_hash_table, QCweakness, Qvalue);
+#endif
+
DEFVAR_LISP ("comp-ctxt", Vcomp_ctxt,
doc: /* The compiler context. */);
Vcomp_ctxt = Qnil;
diff --git a/src/comp.h b/src/comp.h
index e6ab32ff8e..89ef740fe6 100644
--- a/src/comp.h
+++ b/src/comp.h
@@ -44,7 +44,15 @@ #define COMP_H
/* Same but for data that cannot be moved to pure space.
Must be the last lisp object here. */
Lisp_Object data_impure_vec;
+
dynlib_handle_ptr handle;
+#ifdef WINDOWSNT
+ /* We need to store a copy of the original file name in memory that
+ is not subject to GC because the function to dispose native
+ compilation units is called by the GC. By that time the `file'
+ string may have been sweeped. */
+ char * cfile;
+#endif
};
#ifdef HAVE_NATIVE_COMP
@@ -75,6 +83,14 @@ XNATIVE_COMP_UNIT (Lisp_Object a)
extern void maybe_defer_native_compilation (Lisp_Object function_name,
Lisp_Object definition);
+
+extern void dispose_comp_unit (struct Lisp_Native_Comp_Unit * comp_unit, bool delay);
+
+extern void finish_delayed_disposal_of_comp_units (void);
+
+extern void dispose_all_remaining_comp_units (void);
+
+extern void clean_package_user_dir_of_old_comp_units (void);
#else
static inline void
@@ -84,6 +100,17 @@ maybe_defer_native_compilation (Lisp_Object function_name,
extern void syms_of_comp (void);
+static inline void dispose_comp_unit (struct Lisp_Native_Comp_Unit * comp_handle)
+{
+ emacs_abort();
+}
+
+static inline void dispose_all_remaining_comp_units (void)
+{}
+
+static inline void clean_package_user_dir_of_old_comp_units (void)
+{}
+
#endif
#endif
diff --git a/src/emacs.c b/src/emacs.c
index e75cb58834..b7c89b44ec 100644
--- a/src/emacs.c
+++ b/src/emacs.c
@@ -2393,6 +2393,9 @@ DEFUN ("kill-emacs", Fkill_emacs, Skill_emacs, 0, 1, "P",
unlink (SSDATA (listfile));
}
+ dispose_all_remaining_comp_units();
+ clean_package_user_dir_of_old_comp_units();
+
if (FIXNUMP (arg))
exit_code = (XFIXNUM (arg) < 0
? XFIXNUM (arg) | INT_MIN
diff --git a/src/eval.c b/src/eval.c
index 1091b08255..a68fc90285 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -1419,6 +1419,61 @@ internal_condition_case_2 (Lisp_Object (*bfun) (Lisp_Object, Lisp_Object),
}
}
+/* Like internal_condition_case_1 but call BFUN with ARG1, ARG2, ARG3 as
+ its arguments. */
+
+Lisp_Object
+internal_condition_case_3 (Lisp_Object (*bfun) (Lisp_Object, Lisp_Object,
+ Lisp_Object),
+ Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3,
+ Lisp_Object handlers,
+ Lisp_Object (*hfun) (Lisp_Object))
+{
+ struct handler *c = push_handler (handlers, CONDITION_CASE);
+ if (sys_setjmp (c->jmp))
+ {
+ Lisp_Object val = handlerlist->val;
+ clobbered_eassert (handlerlist == c);
+ handlerlist = handlerlist->next;
+ return hfun (val);
+ }
+ else
+ {
+ Lisp_Object val = bfun (arg1, arg2, arg3);
+ eassert (handlerlist == c);
+ handlerlist = c->next;
+ return val;
+ }
+}
+
+/* Like internal_condition_case_1 but call BFUN with ARG1, ARG2, ARG3, ARG4 as
+ its arguments. */
+
+Lisp_Object
+internal_condition_case_4 (Lisp_Object (*bfun) (Lisp_Object, Lisp_Object,
+ Lisp_Object, Lisp_Object),
+ Lisp_Object arg1, Lisp_Object arg2,
+ Lisp_Object arg3, Lisp_Object arg4,
+ Lisp_Object handlers,
+ Lisp_Object (*hfun) (Lisp_Object))
+{
+ struct handler *c = push_handler (handlers, CONDITION_CASE);
+ if (sys_setjmp (c->jmp))
+ {
+ Lisp_Object val = handlerlist->val;
+ clobbered_eassert (handlerlist == c);
+ handlerlist = handlerlist->next;
+ return hfun (val);
+ }
+ else
+ {
+ Lisp_Object val = bfun (arg1, arg2, arg3, arg4);
+ eassert (handlerlist == c);
+ handlerlist = c->next;
+ return val;
+ }
+}
+
/* Like internal_condition_case but call BFUN with NARGS as first,
and ARGS as second argument. */
diff --git a/src/lisp.h b/src/lisp.h
index e242546d10..eeac20598c 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -4138,6 +4138,8 @@ xsignal (Lisp_Object error_symbol, Lisp_Object data)
extern Lisp_Object internal_condition_case (Lisp_Object (*) (void), Lisp_Object, Lisp_Object (*) (Lisp_Object));
extern Lisp_Object internal_condition_case_1 (Lisp_Object (*) (Lisp_Object), Lisp_Object, Lisp_Object, Lisp_Object (*) (Lisp_Object));
extern Lisp_Object internal_condition_case_2 (Lisp_Object (*) (Lisp_Object, Lisp_Object), Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object (*) (Lisp_Object));
+extern Lisp_Object internal_condition_case_3 (Lisp_Object (*) (Lisp_Object, Lisp_Object, Lisp_Object), Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object (*) (Lisp_Object));
+extern Lisp_Object internal_condition_case_4 (Lisp_Object (*) (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object), Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object (*) (Lisp_Object));
extern Lisp_Object internal_condition_case_n
(Lisp_Object (*) (ptrdiff_t, Lisp_Object *), ptrdiff_t, Lisp_Object *,
Lisp_Object, Lisp_Object (*) (Lisp_Object, ptrdiff_t, Lisp_Object *));
diff --git a/src/pdumper.c b/src/pdumper.c
index f837dfc38d..9b0bd472d6 100644
--- a/src/pdumper.c
+++ b/src/pdumper.c
@@ -5312,6 +5312,9 @@ dump_do_dump_relocation (const uintptr_t dump_base,
concat2 (Vinvocation_directory,
installation_state == LOCAL_BUILD
? XCDR (comp_u->file) : XCAR (comp_u->file));
+#ifdef WINDOWSNT
+ comp_u->cfile = xlispstrdup(comp_u->file);
+#endif
comp_u->handle = dynlib_open (SSDATA (comp_u->file));
if (!comp_u->handle)
error ("%s", dynlib_error ());
--
2.25.1.windows.1
[-- Attachment #9: 0007-Load-libgccjit-dynamically-in-Windows.patch --]
[-- Type: application/octet-stream, Size: 26333 bytes --]
From 6f5bc7a5e2a0a4ef5258ab246b387396cc1723de Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Nicol=C3=A1s=20B=C3=A9rtolo?= <nicolasbertolo@gmail.com>
Date: Mon, 11 May 2020 20:43:06 -0300
Subject: [PATCH 7/9] Load libgccjit dynamically in Windows.
* configure.ac: don't add linker flags if compiling on
Windows. Compile dynlib.c if modules or native compilation are
enabled. Always compile comp.c
* lisp/term/w32-win.el: Map 'gccjit to "libgccjit.dll" in
`dynamic-library-alist`.
* src/Makefile.in: Update comments. Update to handle changes in
configure.ac.
* src/comp.c: Add declarations of used libgccjit functions using
DEF_DLL_FN. Add calls to load_gccjit_if_necessary() where necessary.
Add `native-comp-available-p`
* src/comp.h: Remove Fnative_elisp_load. Add syms_of_comp().
* src/emacs.c (main): Always call syms_of_comp()
* src/w32.c (globals_of_w32): Clear Vlibrary_cache when starting
because the libraries loaded when dumping will not be loaded when
starting.
* src/w32fns.c: Add Qgccjit symbol.
---
configure.ac | 19 ++-
lisp/term/w32-win.el | 3 +-
src/Makefile.in | 9 +-
src/comp.c | 374 ++++++++++++++++++++++++++++++++++++++++++-
src/comp.h | 6 +-
src/emacs.c | 2 -
src/w32.c | 4 +
src/w32fns.c | 1 +
8 files changed, 398 insertions(+), 20 deletions(-)
diff --git a/configure.ac b/configure.ac
index 23b94cf6ca..ea0144f404 100644
--- a/configure.ac
+++ b/configure.ac
@@ -3666,6 +3666,7 @@ AC_DEFUN
LIBMODULES=
HAVE_MODULES=no
MODULES_OBJ=
+NEED_DYNLIB=no
case $opsys in
cygwin|mingw32) MODULES_SUFFIX=".dll" ;;
darwin) MODULES_SUFFIX=".dylib" ;;
@@ -3701,7 +3702,8 @@ AC_DEFUN
fi
if test "${HAVE_MODULES}" = yes; then
- MODULES_OBJ="dynlib.o emacs-module.o"
+ MODULES_OBJ="emacs-module.o"
+ NEED_DYNLIB=yes
AC_DEFINE(HAVE_MODULES, 1, [Define to 1 if dynamic modules are enabled])
AC_DEFINE_UNQUOTED(MODULES_SUFFIX, "$MODULES_SUFFIX",
[System extension for dynamic libraries])
@@ -3785,7 +3787,6 @@ AC_DEFUN
HAVE_NATIVE_COMP=no
LIBGCCJIT_LIB=
-COMP_OBJ=
if test "${with_nativecomp}" != "no"; then
emacs_save_LIBS=$LIBS
LIBS="-lgccjit"
@@ -3793,8 +3794,11 @@ AC_DEFUN
[AC_LINK_IFELSE([libgccjit_smoke_test], [], [libgccjit_not_found])])
LIBS=$emacs_save_LIBS
HAVE_NATIVE_COMP=yes
- LIBGCCJIT_LIB="-lgccjit -ldl"
- COMP_OBJ="comp.o"
+ # mingw32 loads the library dynamically.
+ if test "${opsys}" != "mingw32"; then
+ LIBGCCJIT_LIB="-lgccjit -ldl"
+ fi
+ NEED_DYNLIB=yes
AC_DEFINE(HAVE_NATIVE_COMP, 1, [Define to 1 if you have the libgccjit library (-lgccjit).])
fi
if test "${HAVE_NATIVE_COMP}" = yes && test "${HAVE_PDUMPER}" = no; then
@@ -3804,7 +3808,12 @@ AC_DEFUN
[System extension for native compiled elisp])
AC_SUBST(HAVE_NATIVE_COMP)
AC_SUBST(LIBGCCJIT_LIB)
-AC_SUBST(COMP_OBJ)
+
+DYNLIB_OBJ=
+if test "${NEED_DYNLIB}" = yes; then
+ DYNLIB_OBJ="dynlib.o"
+fi
+AC_SUBST(DYNLIB_OBJ)
### Use -lpng if available, unless '--with-png=no'.
HAVE_PNG=no
diff --git a/lisp/term/w32-win.el b/lisp/term/w32-win.el
index 5901e0295e..6b9716ca30 100644
--- a/lisp/term/w32-win.el
+++ b/lisp/term/w32-win.el
@@ -289,7 +289,8 @@ libgnutls-version
'(libxml2 "libxml2-2.dll" "libxml2.dll")
'(zlib "zlib1.dll" "libz-1.dll")
'(lcms2 "liblcms2-2.dll")
- '(json "libjansson-4.dll")))
+ '(json "libjansson-4.dll")
+ '(gccjit "libgccjit.dll")))
;;; multi-tty support
(defvar w32-initialized nil
diff --git a/src/Makefile.in b/src/Makefile.in
index 63f909ae14..85709184da 100644
--- a/src/Makefile.in
+++ b/src/Makefile.in
@@ -241,7 +241,7 @@ LIBZ =
## system-specific libs for dynamic modules, else empty
LIBMODULES = @LIBMODULES@
-## dynlib.o emacs-module.o if modules enabled, else empty
+## emacs-module.o if modules enabled, else empty
MODULES_OBJ = @MODULES_OBJ@
XRANDR_LIBS = @XRANDR_LIBS@
@@ -327,8 +327,9 @@ GMP_LIB =
GMP_OBJ = @GMP_OBJ@
LIBGCCJIT = @LIBGCCJIT_LIB@
-## dynlib.o comp.o if native compiler is enabled, otherwise empty.
-COMP_OBJ = @COMP_OBJ@
+
+## dynlib.o if necessary, else empty
+DYNLIB_OBJ = @DYNLIB_OBJ@
RUN_TEMACS = ./temacs
@@ -418,7 +419,7 @@ base_obj =
cmds.o casetab.o casefiddle.o indent.o search.o regex-emacs.o undo.o \
alloc.o pdumper.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 $(COMP_OBJ) \
+ syntax.o $(UNEXEC_OBJ) bytecode.o comp.o $(DYNLIB_OBJ) \
process.o gnutls.o callproc.o \
region-cache.o sound.o timefns.o atimer.o \
doprnt.o intervals.o textprop.o composite.o xml.o lcms.o $(NOTIFY_OBJ) \
diff --git a/src/comp.c b/src/comp.c
index 69525acfc0..b43d3eddb3 100644
--- a/src/comp.c
+++ b/src/comp.c
@@ -20,6 +20,8 @@
#include <config.h>
+#include "lisp.h"
+
#ifdef HAVE_NATIVE_COMP
#include <setjmp.h>
@@ -28,7 +30,6 @@
#include <signal.h>
#include <libgccjit.h>
-#include "lisp.h"
#include "puresize.h"
#include "window.h"
#include "dynlib.h"
@@ -36,6 +37,347 @@
#include "blockinput.h"
#include "sha512.h"
+\f
+/********************************/
+/* Dynamic loading of libgccjit */
+/********************************/
+
+#ifdef WINDOWSNT
+# include "w32common.h"
+
+#undef gcc_jit_block_add_assignment
+#undef gcc_jit_block_add_comment
+#undef gcc_jit_block_add_eval
+#undef gcc_jit_block_end_with_conditional
+#undef gcc_jit_block_end_with_jump
+#undef gcc_jit_block_end_with_return
+#undef gcc_jit_block_end_with_void_return
+#undef gcc_jit_context_acquire
+#undef gcc_jit_context_compile_to_file
+#undef gcc_jit_context_dump_reproducer_to_file
+#undef gcc_jit_context_dump_to_file
+#undef gcc_jit_context_get_builtin_function
+#undef gcc_jit_context_get_first_error
+#undef gcc_jit_context_get_int_type
+#undef gcc_jit_context_get_type
+#undef gcc_jit_context_new_array_access
+#undef gcc_jit_context_new_array_type
+#undef gcc_jit_context_new_binary_op
+#undef gcc_jit_context_new_call
+#undef gcc_jit_context_new_call_through_ptr
+#undef gcc_jit_context_new_comparison
+#undef gcc_jit_context_new_field
+#undef gcc_jit_context_new_function
+#undef gcc_jit_context_new_function_ptr_type
+#undef gcc_jit_context_new_global
+#undef gcc_jit_context_new_opaque_struct
+#undef gcc_jit_context_new_param
+#undef gcc_jit_context_new_rvalue_from_int
+#undef gcc_jit_context_new_rvalue_from_long
+#undef gcc_jit_context_new_rvalue_from_ptr
+#undef gcc_jit_context_new_struct_type
+#undef gcc_jit_context_new_unary_op
+#undef gcc_jit_context_new_union_type
+#undef gcc_jit_context_release
+#undef gcc_jit_context_set_bool_option
+#undef gcc_jit_context_set_int_option
+#undef gcc_jit_context_set_logfile
+#undef gcc_jit_function_get_param
+#undef gcc_jit_function_new_block
+#undef gcc_jit_function_new_local
+#undef gcc_jit_lvalue_access_field
+#undef gcc_jit_lvalue_as_rvalue
+#undef gcc_jit_lvalue_get_address
+#undef gcc_jit_param_as_lvalue
+#undef gcc_jit_param_as_rvalue
+#undef gcc_jit_rvalue_access_field
+#undef gcc_jit_rvalue_dereference
+#undef gcc_jit_rvalue_dereference_field
+#undef gcc_jit_rvalue_get_type
+#undef gcc_jit_struct_as_type
+#undef gcc_jit_struct_set_fields
+#undef gcc_jit_type_get_pointer
+
+/* In alphabetical order */
+DEF_DLL_FN (gcc_jit_rvalue *, gcc_jit_context_new_rvalue_from_int,
+ (gcc_jit_context *ctxt, gcc_jit_type *numeric_type, int value));
+DEF_DLL_FN (gcc_jit_rvalue *, gcc_jit_lvalue_as_rvalue,
+ (gcc_jit_lvalue *lvalue));
+DEF_DLL_FN (gcc_jit_rvalue *, gcc_jit_rvalue_access_field,
+ (gcc_jit_rvalue *struct_or_union, gcc_jit_location *loc,
+ gcc_jit_field *field));
+DEF_DLL_FN (void, gcc_jit_block_add_comment,
+ (gcc_jit_block *block, gcc_jit_location *loc, const char *text));
+DEF_DLL_FN (void, gcc_jit_context_release, (gcc_jit_context *ctxt));
+DEF_DLL_FN (const char *, gcc_jit_context_get_first_error,
+ (gcc_jit_context *ctxt));
+DEF_DLL_FN (gcc_jit_block *, gcc_jit_function_new_block,
+ (gcc_jit_function *func, const char *name));
+DEF_DLL_FN (gcc_jit_context *, gcc_jit_context_acquire, (void));
+DEF_DLL_FN (gcc_jit_field *, gcc_jit_context_new_field,
+ (gcc_jit_context *ctxt, gcc_jit_location *loc, gcc_jit_type *type,
+ const char *name));
+DEF_DLL_FN (gcc_jit_function *, gcc_jit_context_get_builtin_function,
+ (gcc_jit_context *ctxt, const char *name));
+DEF_DLL_FN (gcc_jit_function *, gcc_jit_context_new_function,
+ (gcc_jit_context *ctxt, gcc_jit_location *loc,
+ enum gcc_jit_function_kind kind, gcc_jit_type *return_type,
+ const char *name, int num_params, gcc_jit_param **params,
+ int is_variadic));
+DEF_DLL_FN (gcc_jit_lvalue *, gcc_jit_context_new_array_access,
+ (gcc_jit_context *ctxt, gcc_jit_location *loc, gcc_jit_rvalue *ptr,
+ gcc_jit_rvalue *index));
+DEF_DLL_FN (gcc_jit_lvalue *, gcc_jit_context_new_global,
+ (gcc_jit_context *ctxt, gcc_jit_location *loc,
+ enum gcc_jit_global_kind kind, gcc_jit_type *type,
+ const char *name));
+DEF_DLL_FN (gcc_jit_lvalue *, gcc_jit_function_new_local,
+ (gcc_jit_function *func, gcc_jit_location *loc, gcc_jit_type *type,
+ const char *name));
+DEF_DLL_FN (gcc_jit_lvalue *, gcc_jit_lvalue_access_field,
+ (gcc_jit_lvalue *struct_or_union, gcc_jit_location *loc,
+ gcc_jit_field *field));
+DEF_DLL_FN (gcc_jit_lvalue *, gcc_jit_param_as_lvalue, (gcc_jit_param *param));
+DEF_DLL_FN (gcc_jit_lvalue *, gcc_jit_rvalue_dereference,
+ (gcc_jit_rvalue *rvalue, gcc_jit_location *loc));
+DEF_DLL_FN (gcc_jit_lvalue *, gcc_jit_rvalue_dereference_field,
+ (gcc_jit_rvalue *ptr, gcc_jit_location *loc, gcc_jit_field *field));
+DEF_DLL_FN (gcc_jit_param *, gcc_jit_context_new_param,
+ (gcc_jit_context *ctxt, gcc_jit_location *loc, gcc_jit_type *type,
+ const char *name));
+DEF_DLL_FN (gcc_jit_param *, gcc_jit_function_get_param,
+ (gcc_jit_function *func, int index));
+DEF_DLL_FN (gcc_jit_rvalue *, gcc_jit_context_new_binary_op,
+ (gcc_jit_context *ctxt, gcc_jit_location *loc,
+ enum gcc_jit_binary_op op, gcc_jit_type *result_type,
+ gcc_jit_rvalue *a, gcc_jit_rvalue *b));
+DEF_DLL_FN (gcc_jit_rvalue *, gcc_jit_context_new_call,
+ (gcc_jit_context *ctxt, gcc_jit_location *loc,
+ gcc_jit_function *func, int numargs , gcc_jit_rvalue **args));
+DEF_DLL_FN (gcc_jit_rvalue *, gcc_jit_context_new_call_through_ptr,
+ (gcc_jit_context *ctxt, gcc_jit_location *loc,
+ gcc_jit_rvalue *fn_ptr, int numargs, gcc_jit_rvalue **args));
+DEF_DLL_FN (gcc_jit_rvalue *, gcc_jit_context_new_comparison,
+ (gcc_jit_context *ctxt, gcc_jit_location *loc,
+ enum gcc_jit_comparison op, gcc_jit_rvalue *a, gcc_jit_rvalue *b));
+DEF_DLL_FN (gcc_jit_rvalue *, gcc_jit_context_new_rvalue_from_long,
+ (gcc_jit_context *ctxt, gcc_jit_type *numeric_type, long value));
+DEF_DLL_FN (gcc_jit_rvalue *, gcc_jit_context_new_rvalue_from_ptr,
+ (gcc_jit_context *ctxt, gcc_jit_type *pointer_type, void *value));
+DEF_DLL_FN (gcc_jit_rvalue *, gcc_jit_context_new_unary_op,
+ (gcc_jit_context *ctxt, gcc_jit_location *loc,
+ enum gcc_jit_unary_op op, gcc_jit_type *result_type,
+ gcc_jit_rvalue *rvalue));
+DEF_DLL_FN (gcc_jit_rvalue *, gcc_jit_lvalue_get_address,
+ (gcc_jit_lvalue *lvalue, gcc_jit_location *loc));
+DEF_DLL_FN (gcc_jit_rvalue *, gcc_jit_param_as_rvalue, (gcc_jit_param *param));
+DEF_DLL_FN (gcc_jit_struct *, gcc_jit_context_new_opaque_struct,
+ (gcc_jit_context *ctxt, gcc_jit_location *loc, const char *name));
+DEF_DLL_FN (gcc_jit_struct *, gcc_jit_context_new_struct_type,
+ (gcc_jit_context *ctxt, gcc_jit_location *loc, const char *name,
+ int num_fields, gcc_jit_field **fields));
+DEF_DLL_FN (gcc_jit_type *, gcc_jit_context_get_int_type,
+ (gcc_jit_context *ctxt, int num_bytes, int is_signed));
+DEF_DLL_FN (gcc_jit_type *, gcc_jit_context_get_type,
+ (gcc_jit_context *ctxt, enum gcc_jit_types type_));
+DEF_DLL_FN (gcc_jit_type *, gcc_jit_context_new_array_type,
+ (gcc_jit_context *ctxt, gcc_jit_location *loc,
+ gcc_jit_type *element_type, int num_elements));
+DEF_DLL_FN (gcc_jit_type *, gcc_jit_context_new_function_ptr_type,
+ (gcc_jit_context *ctxt, gcc_jit_location *loc,
+ gcc_jit_type *return_type, int num_params,
+ gcc_jit_type **param_types, int is_variadic));
+DEF_DLL_FN (gcc_jit_type *, gcc_jit_context_new_union_type,
+ (gcc_jit_context *ctxt, gcc_jit_location *loc, const char *name,
+ int num_fields, gcc_jit_field **fields));
+DEF_DLL_FN (gcc_jit_type *, gcc_jit_rvalue_get_type, (gcc_jit_rvalue *rvalue));
+DEF_DLL_FN (gcc_jit_type *, gcc_jit_struct_as_type,
+ (gcc_jit_struct *struct_type));
+DEF_DLL_FN (gcc_jit_type *, gcc_jit_type_get_pointer, (gcc_jit_type *type));
+DEF_DLL_FN (void, gcc_jit_block_add_assignment,
+ (gcc_jit_block *block, gcc_jit_location *loc, gcc_jit_lvalue *lvalue,
+ gcc_jit_rvalue *rvalue));
+DEF_DLL_FN (void, gcc_jit_block_add_eval,
+ (gcc_jit_block *block, gcc_jit_location *loc,
+ gcc_jit_rvalue *rvalue));
+DEF_DLL_FN (void, gcc_jit_block_end_with_conditional,
+ (gcc_jit_block *block, gcc_jit_location *loc,
+ gcc_jit_rvalue *boolval, gcc_jit_block *on_true,
+ gcc_jit_block *on_false));
+DEF_DLL_FN (void, gcc_jit_block_end_with_jump,
+ (gcc_jit_block *block, gcc_jit_location *loc,
+ gcc_jit_block *target));
+DEF_DLL_FN (void, gcc_jit_block_end_with_return,
+ (gcc_jit_block *block, gcc_jit_location *loc,
+ gcc_jit_rvalue *rvalue));
+DEF_DLL_FN (void, gcc_jit_block_end_with_void_return,
+ (gcc_jit_block *block, gcc_jit_location *loc));
+DEF_DLL_FN (void, gcc_jit_context_compile_to_file,
+ (gcc_jit_context *ctxt, enum gcc_jit_output_kind output_kind,
+ const char *output_path));
+DEF_DLL_FN (void, gcc_jit_context_dump_reproducer_to_file,
+ (gcc_jit_context *ctxt, const char *path));
+DEF_DLL_FN (void, gcc_jit_context_dump_to_file,
+ (gcc_jit_context *ctxt, const char *path, int update_locations));
+DEF_DLL_FN (void, gcc_jit_context_set_bool_option,
+ (gcc_jit_context *ctxt, enum gcc_jit_bool_option opt, int value));
+DEF_DLL_FN (void, gcc_jit_context_set_int_option,
+ (gcc_jit_context *ctxt, enum gcc_jit_int_option opt, int value));
+DEF_DLL_FN (void, gcc_jit_context_set_logfile,
+ (gcc_jit_context *ctxt, FILE *logfile, int flags, int verbosity));
+DEF_DLL_FN (void, gcc_jit_struct_set_fields,
+ (gcc_jit_struct *struct_type, gcc_jit_location *loc, int num_fields,
+ gcc_jit_field **fields));
+
+static bool
+init_gccjit_functions (void)
+{
+ HMODULE library;
+
+ if (!(library = w32_delayed_load (Qgccjit)))
+ {
+ return false;
+ }
+
+ /* In alphabetical order */
+ LOAD_DLL_FN(library, gcc_jit_block_add_assignment);
+ LOAD_DLL_FN(library, gcc_jit_block_add_comment);
+ LOAD_DLL_FN(library, gcc_jit_block_add_eval);
+ LOAD_DLL_FN(library, gcc_jit_block_end_with_conditional);
+ LOAD_DLL_FN(library, gcc_jit_block_end_with_jump);
+ LOAD_DLL_FN(library, gcc_jit_block_end_with_return);
+ LOAD_DLL_FN(library, gcc_jit_block_end_with_void_return);
+ LOAD_DLL_FN(library, gcc_jit_context_acquire);
+ LOAD_DLL_FN(library, gcc_jit_context_compile_to_file);
+ LOAD_DLL_FN(library, gcc_jit_context_dump_reproducer_to_file);
+ LOAD_DLL_FN(library, gcc_jit_context_dump_to_file);
+ LOAD_DLL_FN(library, gcc_jit_context_get_builtin_function);
+ LOAD_DLL_FN(library, gcc_jit_context_get_first_error);
+ LOAD_DLL_FN(library, gcc_jit_context_get_int_type);
+ LOAD_DLL_FN(library, gcc_jit_context_get_type);
+ LOAD_DLL_FN(library, gcc_jit_context_new_array_access);
+ LOAD_DLL_FN(library, gcc_jit_context_new_array_type);
+ LOAD_DLL_FN(library, gcc_jit_context_new_binary_op);
+ LOAD_DLL_FN(library, gcc_jit_context_new_call);
+ LOAD_DLL_FN(library, gcc_jit_context_new_call_through_ptr);
+ LOAD_DLL_FN(library, gcc_jit_context_new_comparison);
+ LOAD_DLL_FN(library, gcc_jit_context_new_field);
+ LOAD_DLL_FN(library, gcc_jit_context_new_function);
+ LOAD_DLL_FN(library, gcc_jit_context_new_function_ptr_type);
+ LOAD_DLL_FN(library, gcc_jit_context_new_global);
+ LOAD_DLL_FN(library, gcc_jit_context_new_opaque_struct);
+ LOAD_DLL_FN(library, gcc_jit_context_new_param);
+ LOAD_DLL_FN(library, gcc_jit_context_new_rvalue_from_int);
+ LOAD_DLL_FN(library, gcc_jit_context_new_rvalue_from_long);
+ LOAD_DLL_FN(library, gcc_jit_context_new_rvalue_from_ptr);
+ LOAD_DLL_FN(library, gcc_jit_context_new_struct_type);
+ LOAD_DLL_FN(library, gcc_jit_context_new_unary_op);
+ LOAD_DLL_FN(library, gcc_jit_context_new_union_type);
+ LOAD_DLL_FN(library, gcc_jit_context_release);
+ LOAD_DLL_FN(library, gcc_jit_context_set_bool_option);
+ LOAD_DLL_FN(library, gcc_jit_context_set_int_option);
+ LOAD_DLL_FN(library, gcc_jit_context_set_logfile);
+ LOAD_DLL_FN(library, gcc_jit_function_get_param);
+ LOAD_DLL_FN(library, gcc_jit_function_new_block);
+ LOAD_DLL_FN(library, gcc_jit_function_new_local);
+ LOAD_DLL_FN(library, gcc_jit_lvalue_access_field);
+ LOAD_DLL_FN(library, gcc_jit_lvalue_as_rvalue);
+ LOAD_DLL_FN(library, gcc_jit_lvalue_get_address);
+ LOAD_DLL_FN(library, gcc_jit_param_as_lvalue);
+ LOAD_DLL_FN(library, gcc_jit_param_as_rvalue);
+ LOAD_DLL_FN(library, gcc_jit_rvalue_access_field);
+ LOAD_DLL_FN(library, gcc_jit_rvalue_dereference);
+ LOAD_DLL_FN(library, gcc_jit_rvalue_dereference_field);
+ LOAD_DLL_FN(library, gcc_jit_rvalue_get_type);
+ LOAD_DLL_FN(library, gcc_jit_struct_as_type);
+ LOAD_DLL_FN(library, gcc_jit_struct_set_fields);
+ LOAD_DLL_FN(library, gcc_jit_type_get_pointer);
+
+ return true;
+}
+
+/* In alphabetical order */
+#define gcc_jit_block_add_assignment fn_gcc_jit_block_add_assignment
+#define gcc_jit_block_add_comment fn_gcc_jit_block_add_comment
+#define gcc_jit_block_add_eval fn_gcc_jit_block_add_eval
+#define gcc_jit_block_end_with_conditional fn_gcc_jit_block_end_with_conditional
+#define gcc_jit_block_end_with_jump fn_gcc_jit_block_end_with_jump
+#define gcc_jit_block_end_with_return fn_gcc_jit_block_end_with_return
+#define gcc_jit_block_end_with_void_return fn_gcc_jit_block_end_with_void_return
+#define gcc_jit_context_acquire fn_gcc_jit_context_acquire
+#define gcc_jit_context_compile_to_file fn_gcc_jit_context_compile_to_file
+#define gcc_jit_context_dump_reproducer_to_file fn_gcc_jit_context_dump_reproducer_to_file
+#define gcc_jit_context_dump_to_file fn_gcc_jit_context_dump_to_file
+#define gcc_jit_context_get_builtin_function fn_gcc_jit_context_get_builtin_function
+#define gcc_jit_context_get_first_error fn_gcc_jit_context_get_first_error
+#define gcc_jit_context_get_int_type fn_gcc_jit_context_get_int_type
+#define gcc_jit_context_get_type fn_gcc_jit_context_get_type
+#define gcc_jit_context_new_array_access fn_gcc_jit_context_new_array_access
+#define gcc_jit_context_new_array_type fn_gcc_jit_context_new_array_type
+#define gcc_jit_context_new_binary_op fn_gcc_jit_context_new_binary_op
+#define gcc_jit_context_new_call fn_gcc_jit_context_new_call
+#define gcc_jit_context_new_call_through_ptr fn_gcc_jit_context_new_call_through_ptr
+#define gcc_jit_context_new_comparison fn_gcc_jit_context_new_comparison
+#define gcc_jit_context_new_field fn_gcc_jit_context_new_field
+#define gcc_jit_context_new_function fn_gcc_jit_context_new_function
+#define gcc_jit_context_new_function_ptr_type fn_gcc_jit_context_new_function_ptr_type
+#define gcc_jit_context_new_global fn_gcc_jit_context_new_global
+#define gcc_jit_context_new_opaque_struct fn_gcc_jit_context_new_opaque_struct
+#define gcc_jit_context_new_param fn_gcc_jit_context_new_param
+#define gcc_jit_context_new_rvalue_from_int fn_gcc_jit_context_new_rvalue_from_int
+#define gcc_jit_context_new_rvalue_from_long fn_gcc_jit_context_new_rvalue_from_long
+#define gcc_jit_context_new_rvalue_from_ptr fn_gcc_jit_context_new_rvalue_from_ptr
+#define gcc_jit_context_new_struct_type fn_gcc_jit_context_new_struct_type
+#define gcc_jit_context_new_unary_op fn_gcc_jit_context_new_unary_op
+#define gcc_jit_context_new_union_type fn_gcc_jit_context_new_union_type
+#define gcc_jit_context_release fn_gcc_jit_context_release
+#define gcc_jit_context_set_bool_option fn_gcc_jit_context_set_bool_option
+#define gcc_jit_context_set_int_option fn_gcc_jit_context_set_int_option
+#define gcc_jit_context_set_logfile fn_gcc_jit_context_set_logfile
+#define gcc_jit_function_get_param fn_gcc_jit_function_get_param
+#define gcc_jit_function_new_block fn_gcc_jit_function_new_block
+#define gcc_jit_function_new_local fn_gcc_jit_function_new_local
+#define gcc_jit_lvalue_access_field fn_gcc_jit_lvalue_access_field
+#define gcc_jit_lvalue_as_rvalue fn_gcc_jit_lvalue_as_rvalue
+#define gcc_jit_lvalue_get_address fn_gcc_jit_lvalue_get_address
+#define gcc_jit_param_as_lvalue fn_gcc_jit_param_as_lvalue
+#define gcc_jit_param_as_rvalue fn_gcc_jit_param_as_rvalue
+#define gcc_jit_rvalue_access_field fn_gcc_jit_rvalue_access_field
+#define gcc_jit_rvalue_dereference fn_gcc_jit_rvalue_dereference
+#define gcc_jit_rvalue_dereference_field fn_gcc_jit_rvalue_dereference_field
+#define gcc_jit_rvalue_get_type fn_gcc_jit_rvalue_get_type
+#define gcc_jit_struct_as_type fn_gcc_jit_struct_as_type
+#define gcc_jit_struct_set_fields fn_gcc_jit_struct_set_fields
+#define gcc_jit_type_get_pointer fn_gcc_jit_type_get_pointer
+
+#endif
+
+static bool
+load_gccjit_if_necessary (bool mandatory)
+{
+#ifdef WINDOWSNT
+ static bool tried_to_initialize_once;
+ static bool gccjit_initialized;
+
+ if (!tried_to_initialize_once)
+ {
+ tried_to_initialize_once = true;
+ Lisp_Object status;
+ gccjit_initialized = init_gccjit_functions ();
+ status = gccjit_initialized ? Qt : Qnil;
+ Vlibrary_cache = Fcons (Fcons (Qgccjit, status), Vlibrary_cache);
+ }
+
+ if (mandatory && !gccjit_initialized)
+ xsignal1(Qnative_compiler_error, build_string("libgccjit not found"));
+
+ return gccjit_initialized;
+#else
+ return true;
+#endif
+}
+
+\f
/* C symbols emitted for the load relocation mechanism. */
#define CURRENT_THREAD_RELOC_SYM "current_thread_reloc"
#define PURE_PTR_SYM "pure_ptr"
@@ -3328,6 +3670,8 @@ DEFUN ("comp--init-ctxt", Fcomp__init_ctxt, Scomp__init_ctxt,
doc: /* Initialize the native compiler context. Return t on success. */)
(void)
{
+ load_gccjit_if_necessary(true);
+
if (comp.ctxt)
{
xsignal1 (Qnative_ice,
@@ -3474,6 +3818,8 @@ DEFUN ("comp--release-ctxt", Fcomp__release_ctxt, Scomp__release_ctxt,
doc: /* Release the native compiler context. */)
(void)
{
+ load_gccjit_if_necessary(true);
+
if (comp.ctxt)
gcc_jit_context_release (comp.ctxt);
@@ -3490,6 +3836,8 @@ DEFUN ("comp--compile-ctxt-to-file", Fcomp__compile_ctxt_to_file,
doc: /* Compile as native code the current context to file. */)
(Lisp_Object base_name)
{
+ load_gccjit_if_necessary(true);
+
CHECK_STRING (base_name);
gcc_jit_context_set_int_option (comp.ctxt,
@@ -3660,6 +4008,9 @@ maybe_defer_native_compilation (Lisp_Object function_name,
fflush (f);
}
#endif
+ if (!load_gccjit_if_necessary(false))
+ return;
+
if (!comp_deferred_compilation
|| noninteractive
|| !NILP (Vpurify_flag)
@@ -3928,10 +4279,26 @@ DEFUN ("native-elisp-load", Fnative_elisp_load, Snative_elisp_load, 1, 2, 0,
return Qt;
}
+#endif /* HAVE_NATIVE_COMP */
+
+DEFUN ("native-comp-available-p", Fnative_comp_available_p,
+ Snative_comp_available_p, 0, 0, 0,
+ doc: /* Returns t if native compilation of Lisp files is available in
+this instance of Emacs. */)
+ (void)
+{
+#ifdef HAVE_NATIVE_COMP
+ return load_gccjit_if_necessary(false) ? Qt : Qnil;
+#else
+ return Qnil;
+#endif
+}
+
\f
void
syms_of_comp (void)
{
+#ifdef HAVE_NATIVE_COMP
/* Compiler control customizes. */
DEFVAR_BOOL ("comp-deferred-compilation", comp_deferred_compilation,
doc: /* If t compile asyncronously every .elc file loaded. */);
@@ -4073,6 +4440,7 @@ syms_of_comp (void)
doc: /* Hash table symbol-name -> function-value. For
internal use during */);
Vcomp_deferred_pending_h = CALLN (Fmake_hash_table, QCtest, Qeq);
-}
+#endif
-#endif /* HAVE_NATIVE_COMP */
+ defsubr (&Snative_comp_available_p);
+}
diff --git a/src/comp.h b/src/comp.h
index cbdcaccd5f..e6ab32ff8e 100644
--- a/src/comp.h
+++ b/src/comp.h
@@ -82,11 +82,7 @@ maybe_defer_native_compilation (Lisp_Object function_name,
Lisp_Object definition)
{}
-static inline Lisp_Object
-Fnative_elisp_load (Lisp_Object file, Lisp_Object late_load)
-{
- eassume (false);
-}
+extern void syms_of_comp (void);
#endif
diff --git a/src/emacs.c b/src/emacs.c
index 2c90825742..e75cb58834 100644
--- a/src/emacs.c
+++ b/src/emacs.c
@@ -1606,10 +1606,8 @@ main (int argc, char **argv)
init_json ();
#endif
-#ifdef HAVE_NATIVE_COMP
if (!initialized)
syms_of_comp ();
-#endif
no_loadup
= argmatch (argv, argc, "-nl", "--no-loadup", 6, NULL, &skip_args);
diff --git a/src/w32.c b/src/w32.c
index 1ec0094c8e..fd1f0e059e 100644
--- a/src/w32.c
+++ b/src/w32.c
@@ -10586,6 +10586,10 @@ globals_of_w32 (void)
#endif
w32_crypto_hprov = (HCRYPTPROV)0;
+
+ /* We need to forget about libraries that were loaded during the
+ dumping process (e.g. libgccjit) */
+ Vlibrary_cache = Qnil;
}
/* For make-serial-process */
diff --git a/src/w32fns.c b/src/w32fns.c
index e595b0285a..eeb73489dd 100644
--- a/src/w32fns.c
+++ b/src/w32fns.c
@@ -10462,6 +10462,7 @@ syms_of_w32fns (void)
DEFSYM (Qzlib, "zlib");
DEFSYM (Qlcms2, "lcms2");
DEFSYM (Qjson, "json");
+ DEFSYM (Qgccjit, "gccjit");
Fput (Qundefined_color, Qerror_conditions,
pure_list (Qundefined_color, Qerror));
--
2.25.1.windows.1
[-- Attachment #10: 0006-Workaround-the-32768-chars-command-line-limit-in-Win.patch --]
[-- Type: application/octet-stream, Size: 2422 bytes --]
From 5d0afae4f1ecc0577baf52545b8b656766a1d304 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Nicol=C3=A1s=20B=C3=A9rtolo?= <nicolasbertolo@gmail.com>
Date: Fri, 8 May 2020 14:04:06 -0300
Subject: [PATCH 6/9] Workaround the 32768 chars command line limit in Windows.
* lisp/emacs-lisp/comp.el (comp-run-async-workers): Pass the
compilation commands through a temporary file that is loaded by the
child process. This is also done all other operating systems, even
those that support long command lines. It should not be a problem
since libgccjit uses temporary files too.
---
lisp/emacs-lisp/comp.el | 6 +++++-
1 file changed, 5 insertions(+), 1 deletion(-)
diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el
index c2a95feec1..d32f93a1e1 100644
--- a/lisp/emacs-lisp/comp.el
+++ b/lisp/emacs-lisp/comp.el
@@ -2239,6 +2239,9 @@ comp-run-async-workers
(message "Compiling %s..." ,source-file)
(native-compile ,source-file ,(and load t))))
(source-file1 source-file) ;; Make the closure works :/
+ (temp-file (make-temp-file
+ (concat "emacs-async-comp-" (file-name-base source-file) "-")
+ nil ".el" (prin1-to-string expr)))
(load1 load)
(process (make-process
:name (concat "Compiling: " source-file)
@@ -2246,13 +2249,14 @@ comp-run-async-workers
:command (list
(expand-file-name invocation-name
invocation-directory)
- "--batch" "--eval" (prin1-to-string expr))
+ "--batch" "-l" temp-file)
:sentinel
(lambda (process _event)
(run-hook-with-args
'comp-async-cu-done-hook
source-file)
(accept-process-output process)
+ (ignore-errors (delete-file temp-file))
(when (and load1
(zerop (process-exit-status process)))
(native-elisp-load
--
2.25.1.windows.1
next prev parent reply other threads:[~2020-05-20 16:17 UTC|newest]
Thread overview: 149+ messages / expand[flat|nested] mbox.gz Atom feed top
2020-05-13 19:26 bug#41242: Port feature/native-comp to Windows Nicolas Bértolo
2020-05-13 19:36 ` Eli Zaretskii
2020-05-13 19:39 ` Eli Zaretskii
2020-05-13 20:01 ` Nicolas Bértolo
2020-05-13 22:25 ` Andrea Corallo
2020-05-14 13:42 ` Eli Zaretskii
2020-05-13 20:08 ` Andrea Corallo
2020-05-13 20:27 ` Andrea Corallo
2020-05-13 19:56 ` Andrea Corallo
2020-05-13 20:03 ` Nicolas Bértolo
2020-05-14 10:18 ` Andrea Corallo
2020-05-14 10:45 ` Eli Zaretskii
2020-05-14 11:17 ` Andrea Corallo
2020-05-14 14:32 ` Eli Zaretskii
2020-05-14 15:03 ` Andrea Corallo
2020-05-14 16:50 ` Nicolas Bértolo
2020-05-14 17:28 ` Eli Zaretskii
2020-05-14 17:35 ` Nicolas Bértolo
2020-05-14 17:56 ` Eli Zaretskii
2020-05-14 18:00 ` Nicolas Bértolo
2020-05-14 18:29 ` Eli Zaretskii
2020-05-14 18:35 ` Andrea Corallo
2020-05-14 18:29 ` Andrea Corallo
2020-05-14 18:59 ` Achim Gratz
2020-05-14 17:34 ` Andrea Corallo
2020-05-14 17:51 ` Nicolas Bértolo
2020-05-14 18:13 ` Andrea Corallo
2020-05-14 18:40 ` Nicolas Bértolo
2020-05-14 18:48 ` Andrea Corallo
2020-05-14 19:00 ` Nicolas Bértolo
2020-05-14 19:15 ` Andrea Corallo
2020-05-14 19:48 ` Nicolas Bértolo
2020-05-14 19:58 ` Andrea Corallo
2020-05-14 20:16 ` Nicolas Bértolo
2020-05-14 20:29 ` Andrea Corallo
2020-05-14 20:34 ` Nicolas Bértolo
2020-05-15 6:10 ` Eli Zaretskii
2020-05-14 19:16 ` Eli Zaretskii
2020-05-14 19:00 ` Eli Zaretskii
2020-05-14 19:36 ` Nicolas Bértolo
2020-05-15 6:08 ` Eli Zaretskii
2020-05-15 12:33 ` Nicolas Bértolo
2020-05-15 13:00 ` Eli Zaretskii
2020-05-15 19:44 ` Nicolas Bértolo
2020-05-16 6:22 ` Eli Zaretskii
2020-05-16 7:12 ` Andrea Corallo
2020-05-16 16:12 ` Nicolas Bértolo
2020-05-16 16:19 ` Eli Zaretskii
2020-05-16 16:31 ` Nicolas Bértolo
2020-05-16 16:42 ` Eli Zaretskii
2020-05-16 17:09 ` Nicolas Bértolo
2020-05-19 19:23 ` Nicolas Bértolo
2020-05-19 19:25 ` Nicolas Bértolo
2020-05-20 15:27 ` Eli Zaretskii
2020-05-20 15:46 ` Nicolas Bértolo
[not found] ` <83blmf13d1.fsf@gnu.org>
[not found] ` <xjfh7w7vyjk.fsf@sdf.org>
[not found] ` <83367r0zvb.fsf@gnu.org>
2020-05-23 10:37 ` Andrea Corallo
2020-05-23 11:03 ` Eli Zaretskii
2020-05-23 11:21 ` Andrea Corallo
2020-05-23 12:20 ` Eli Zaretskii
2020-05-23 12:54 ` Andrea Corallo
2020-05-23 14:41 ` Nicolas Bértolo
2020-05-23 15:11 ` Andrea Corallo
2020-05-23 15:26 ` Nicolas Bértolo
2020-05-23 16:00 ` Andrea Corallo
2020-05-23 16:04 ` Eli Zaretskii
2020-05-23 16:20 ` Nicolas Bértolo
2020-05-23 17:04 ` Eli Zaretskii
2020-05-23 17:20 ` Nicolas Bértolo
2020-05-23 17:35 ` Eli Zaretskii
2020-05-23 17:47 ` Nicolas Bértolo
2020-05-23 18:21 ` Eli Zaretskii
2020-05-23 18:29 ` Nicolas Bértolo
2020-05-23 18:37 ` Eli Zaretskii
2020-05-23 18:43 ` Nicolas Bértolo
2020-05-23 22:52 ` Nicolas Bértolo
2020-05-25 12:21 ` Andrea Corallo
2020-05-24 3:53 ` Richard Stallman
2020-05-23 17:56 ` Andrea Corallo
2020-05-23 15:52 ` Eli Zaretskii
2020-05-23 16:03 ` Nicolas Bértolo
2020-05-20 16:06 ` Andrea Corallo
2020-05-20 15:55 ` Eli Zaretskii
2020-05-20 16:12 ` Andrea Corallo
2020-05-20 16:17 ` Nicolas Bértolo [this message]
2020-05-20 17:24 ` Andrea Corallo
2020-05-20 17:29 ` Andrea Corallo
2020-05-20 17:59 ` Eli Zaretskii
2020-05-20 18:09 ` Andrea Corallo
2020-05-20 18:48 ` Nicolas Bértolo
2020-05-20 21:38 ` Andrea Corallo
2020-05-21 1:58 ` Nicolas Bértolo
2020-05-21 18:51 ` Andrea Corallo
2020-05-22 21:23 ` Andrea Corallo
2020-05-14 19:13 ` Eli Zaretskii
2020-05-14 17:14 ` Eli Zaretskii
2020-05-14 16:24 ` Nicolas Bértolo
2020-05-14 17:21 ` Eli Zaretskii
2020-05-20 16:44 ` Eli Zaretskii
2020-05-23 22:58 ` bug#41242: Port feature/native-comp to Windows - Improve handling of native compilation Andrea Corallo
2020-05-23 23:43 ` Nicolas Bértolo
2020-05-24 8:19 ` Andrea Corallo
2020-05-24 17:58 ` Nicolas Bértolo
2020-05-24 19:13 ` Andrea Corallo
2020-05-24 19:43 ` Nicolas Bértolo
2020-05-25 14:04 ` Andrea Corallo
2020-05-25 14:27 ` Nicolas Bértolo
2020-05-25 15:06 ` Andrea Corallo
2020-05-25 20:27 ` Andrea Corallo
2020-05-25 21:49 ` Nicolas Bértolo
2020-05-27 21:02 ` bug#41242: Port feature/native-comp to Windows - Determine the emacs root dir Andrea Corallo
2020-05-28 6:17 ` Eli Zaretskii
2020-05-29 0:39 ` Nicolas Bértolo
2020-05-29 12:12 ` Andrea Corallo
2020-05-29 13:54 ` Eli Zaretskii
2020-05-29 14:26 ` Andrea Corallo
2020-05-30 10:51 ` Andrea Corallo
2020-05-30 13:06 ` Nicolas Bértolo
2020-05-30 14:17 ` Andrea Corallo
2020-05-30 13:23 ` Nicolas Bértolo
2020-05-30 14:51 ` Andrea Corallo
2020-05-30 16:25 ` Nicolas Bértolo
2020-05-30 18:51 ` Andrea Corallo
2020-05-30 20:15 ` Nicolas Bértolo
2020-05-30 20:54 ` Nicolas Bértolo
2020-05-31 8:55 ` Andrea Corallo
2020-05-30 16:29 ` Eli Zaretskii
2020-05-30 14:15 ` bug#41242: Port feature/native-comp to Windows - Reduce the number of files probed when finding a lisp file Andrea Corallo
2020-05-31 15:34 ` Nicolas Bértolo
2020-05-31 22:41 ` Nicolas Bértolo
2020-06-01 7:21 ` Andrea Corallo
2020-06-01 13:56 ` Nicolas Bértolo
2020-06-01 19:24 ` Andrea Corallo
2020-06-02 0:42 ` Nicolas Bértolo
2020-06-02 14:43 ` Andrea Corallo
2020-06-02 15:02 ` Eli Zaretskii
2020-06-02 16:24 ` Andrea Corallo
2020-06-02 21:17 ` Nicolas Bértolo
2020-06-02 23:08 ` Andrea Corallo
2020-06-02 23:39 ` Nicolas Bértolo
2020-06-03 13:50 ` Andrea Corallo
2020-06-03 15:28 ` Nicolas Bértolo
2020-06-03 16:24 ` Andrea Corallo
2020-06-06 21:41 ` Andrea Corallo
2020-06-06 21:51 ` Nicolas Bértolo
2020-06-06 22:32 ` Andrea Corallo
2020-06-06 22:50 ` Nicolas Bértolo
2020-06-06 23:20 ` Andrea Corallo
2020-06-09 14:14 ` Nicolas Bértolo
2020-06-09 17:17 ` Andrea Corallo
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=CAFnS-Omg59uV88jQHxs+yLzdk1+Y8U43jdHgnZm5wytoJ9QkCw@mail.gmail.com \
--to=nicolasbertolo@gmail.com \
--cc=41242@debbugs.gnu.org \
--cc=akrl@sdf.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this external index
https://git.savannah.gnu.org/cgit/emacs.git
https://git.savannah.gnu.org/cgit/emacs/org-mode.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.