summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorVibhav Pant <vibhavp@gmail.com>2020-08-21 14:04:35 +0530
committerVibhav Pant <vibhavp@gmail.com>2020-08-21 14:04:35 +0530
commitf0f8d7b82492e741950c363a03b886965c91b1b0 (patch)
tree19b716830b1ebabc0d7d75949c4e6800c0f104ad /src
parent9e64a087c4d167e7ec1c4e22bea3e6af53b563de (diff)
parentc818c29771d3cb51875643b2f6c894073e429dd2 (diff)
downloademacs-feature/native-comp-macos-fixes.tar.gz
Merge branch 'feature/native-comp' into feature/native-comp-macos-fixesfeature/native-comp-macos-fixes
Diffstat (limited to 'src')
-rw-r--r--src/Makefile.in6
-rw-r--r--src/ccl.c115
-rw-r--r--src/charset.c9
-rw-r--r--src/coding.c12
-rw-r--r--src/comp.c150
-rw-r--r--src/comp.h2
-rw-r--r--src/composite.c4
-rw-r--r--src/emacs.c16
-rw-r--r--src/fns.c30
-rw-r--r--src/font.c74
-rw-r--r--src/fontset.c27
-rw-r--r--src/ftfont.c12
-rw-r--r--src/hbfont.c11
-rw-r--r--src/image.c71
-rw-r--r--src/lisp.h18
-rw-r--r--src/lread.c214
-rw-r--r--src/macfont.m6
-rw-r--r--src/minibuf.c2
-rw-r--r--src/nsselect.m2
-rw-r--r--src/nsterm.m23
-rw-r--r--src/nsxwidget.m4
-rw-r--r--src/pdumper.c38
-rw-r--r--src/search.c13
-rw-r--r--src/syntax.c4
-rw-r--r--src/sysdep.c35
-rw-r--r--src/timefns.c33
-rw-r--r--src/window.c2
-rw-r--r--src/xdisp.c8
-rw-r--r--src/xfaces.c28
-rw-r--r--src/xfns.c13
-rw-r--r--src/xrdb.c4
-rw-r--r--src/xselect.c21
-rw-r--r--src/xterm.c21
-rw-r--r--src/xterm.h1
-rw-r--r--src/xwidget.c4
35 files changed, 599 insertions, 434 deletions
diff --git a/src/Makefile.in b/src/Makefile.in
index 63a4aa80e93..31a5a7e7709 100644
--- a/src/Makefile.in
+++ b/src/Makefile.in
@@ -587,7 +587,7 @@ endif
ifeq ($(DUMPING),pdumper)
$(pdmp): emacs$(EXEEXT)
LC_ALL=C $(RUN_TEMACS) -batch $(BUILD_DETAILS) -l loadup --temacs=pdump \
- --bin-dest $(BIN_DESTDIR) --lisp-dest $(LISP_DESTDIR)
+ --bin-dest $(BIN_DESTDIR) --eln-dest $(ELN_DESTDIR)
cp -f $@ $(bootstrap_pdmp)
endif
@@ -790,10 +790,6 @@ tags: TAGS ../lisp/TAGS $(lwlibdir)/TAGS
@$(MAKE) $(AM_V_NO_PD) -C ../lisp EMACS="$(bootstrap_exe)"\
THEFILE=$< $<c
-%.eln: %.el | bootstrap-emacs$(EXEEXT) $(bootstrap_pdmp)
- @$(MAKE) $(AM_V_NO_PD) -C ../lisp EMACS="$(bootstrap_exe)"\
- THEFILE=$< $<n
-
## VCSWITNESS points to the file that holds info about the current checkout.
## We use it as a heuristic to decide when to rebuild loaddefs.el.
## If empty it is ignored; the parent makefile can set it to some other value.
diff --git a/src/ccl.c b/src/ccl.c
index ef059ffff25..86debeef0e5 100644
--- a/src/ccl.c
+++ b/src/ccl.c
@@ -1142,19 +1142,52 @@ ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size
ccl_expr_self:
switch (op)
{
- case CCL_PLUS: reg[rrr] += i; break;
- case CCL_MINUS: reg[rrr] -= i; break;
- case CCL_MUL: reg[rrr] *= i; break;
- case CCL_DIV: reg[rrr] /= i; break;
+ case CCL_PLUS: INT_ADD_WRAPV (reg[rrr], i, &reg[rrr]); break;
+ case CCL_MINUS: INT_SUBTRACT_WRAPV (reg[rrr], i, &reg[rrr]); break;
+ case CCL_MUL: INT_MULTIPLY_WRAPV (reg[rrr], i, &reg[rrr]); break;
+ case CCL_DIV:
+ if (!i)
+ CCL_INVALID_CMD;
+ if (!INT_DIVIDE_OVERFLOW (reg[rrr], i))
+ reg[rrr] /= i;
+ break;
case CCL_MOD: reg[rrr] %= i; break;
+ if (!i)
+ CCL_INVALID_CMD;
+ reg[rrr] = i == -1 ? 0 : reg[rrr] % i;
+ break;
case CCL_AND: reg[rrr] &= i; break;
case CCL_OR: reg[rrr] |= i; break;
case CCL_XOR: reg[rrr] ^= i; break;
- case CCL_LSH: reg[rrr] <<= i; break;
- case CCL_RSH: reg[rrr] >>= i; break;
- case CCL_LSH8: reg[rrr] <<= 8; reg[rrr] |= i; break;
+ case CCL_LSH:
+ if (i < 0)
+ CCL_INVALID_CMD;
+ reg[rrr] = i < UINT_WIDTH ? (unsigned) reg[rrr] << i : 0;
+ break;
+ case CCL_RSH:
+ if (i < 0)
+ CCL_INVALID_CMD;
+ reg[rrr] = reg[rrr] >> min (i, INT_WIDTH - 1);
+ break;
+ case CCL_LSH8:
+ reg[rrr] = (unsigned) reg[rrr] << 8;
+ reg[rrr] |= i;
+ break;
case CCL_RSH8: reg[7] = reg[rrr] & 0xFF; reg[rrr] >>= 8; break;
- case CCL_DIVMOD: reg[7] = reg[rrr] % i; reg[rrr] /= i; break;
+ case CCL_DIVMOD:
+ if (!i)
+ CCL_INVALID_CMD;
+ if (i == -1)
+ {
+ reg[7] = 0;
+ INT_SUBTRACT_WRAPV (0, reg[rrr], &reg[rrr]);
+ }
+ else
+ {
+ reg[7] = reg[rrr] % i;
+ reg[rrr] /= i;
+ }
+ break;
case CCL_LS: reg[rrr] = reg[rrr] < i; break;
case CCL_GT: reg[rrr] = reg[rrr] > i; break;
case CCL_EQ: reg[rrr] = reg[rrr] == i; break;
@@ -1204,19 +1237,52 @@ ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size
ccl_set_expr:
switch (op)
{
- case CCL_PLUS: reg[rrr] = i + j; break;
- case CCL_MINUS: reg[rrr] = i - j; break;
- case CCL_MUL: reg[rrr] = i * j; break;
- case CCL_DIV: reg[rrr] = i / j; break;
- case CCL_MOD: reg[rrr] = i % j; break;
+ case CCL_PLUS: INT_ADD_WRAPV (i, j, &reg[rrr]); break;
+ case CCL_MINUS: INT_SUBTRACT_WRAPV (i, j, &reg[rrr]); break;
+ case CCL_MUL: INT_MULTIPLY_WRAPV (i, j, &reg[rrr]); break;
+ case CCL_DIV:
+ if (!j)
+ CCL_INVALID_CMD;
+ if (!INT_DIVIDE_OVERFLOW (i, j))
+ i /= j;
+ reg[rrr] = i;
+ break;
+ case CCL_MOD:
+ if (!j)
+ CCL_INVALID_CMD;
+ reg[rrr] = j == -1 ? 0 : i % j;
+ break;
case CCL_AND: reg[rrr] = i & j; break;
case CCL_OR: reg[rrr] = i | j; break;
case CCL_XOR: reg[rrr] = i ^ j; break;
- case CCL_LSH: reg[rrr] = i << j; break;
- case CCL_RSH: reg[rrr] = i >> j; break;
- case CCL_LSH8: reg[rrr] = (i << 8) | j; break;
+ case CCL_LSH:
+ if (j < 0)
+ CCL_INVALID_CMD;
+ reg[rrr] = j < UINT_WIDTH ? (unsigned) i << j : 0;
+ break;
+ case CCL_RSH:
+ if (j < 0)
+ CCL_INVALID_CMD;
+ reg[rrr] = i >> min (j, INT_WIDTH - 1);
+ break;
+ case CCL_LSH8:
+ reg[rrr] = ((unsigned) i << 8) | j;
+ break;
case CCL_RSH8: reg[rrr] = i >> 8; reg[7] = i & 0xFF; break;
- case CCL_DIVMOD: reg[rrr] = i / j; reg[7] = i % j; break;
+ case CCL_DIVMOD:
+ if (!j)
+ CCL_INVALID_CMD;
+ if (j == -1)
+ {
+ INT_SUBTRACT_WRAPV (0, reg[rrr], &reg[rrr]);
+ reg[7] = 0;
+ }
+ else
+ {
+ reg[rrr] = i / j;
+ reg[7] = i % j;
+ }
+ break;
case CCL_LS: reg[rrr] = i < j; break;
case CCL_GT: reg[rrr] = i > j; break;
case CCL_EQ: reg[rrr] = i == j; break;
@@ -1225,7 +1291,7 @@ ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size
case CCL_NE: reg[rrr] = i != j; break;
case CCL_DECODE_SJIS:
{
- i = (i << 8) | j;
+ i = ((unsigned) i << 8) | j;
SJIS_TO_JIS (i);
reg[rrr] = i >> 8;
reg[7] = i & 0xFF;
@@ -1233,7 +1299,7 @@ ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size
}
case CCL_ENCODE_SJIS:
{
- i = (i << 8) | j;
+ i = ((unsigned) i << 8) | j;
JIS_TO_SJIS (i);
reg[rrr] = i >> 8;
reg[7] = i & 0xFF;
@@ -2219,15 +2285,8 @@ Return index number of the registered CCL program. */)
/* Extend the table. */
Vccl_program_table = larger_vector (Vccl_program_table, 1, -1);
- {
- Lisp_Object elt = make_uninit_vector (4);
-
- ASET (elt, 0, name);
- ASET (elt, 1, ccl_prog);
- ASET (elt, 2, resolved);
- ASET (elt, 3, Qt);
- ASET (Vccl_program_table, idx, elt);
- }
+ ASET (Vccl_program_table, idx,
+ CALLN (Fvector, name, ccl_prog, resolved, Qt));
Fput (name, Qccl_program_idx, make_fixnum (idx));
return make_fixnum (idx);
diff --git a/src/charset.c b/src/charset.c
index 8635aad3ed6..520dd3a9605 100644
--- a/src/charset.c
+++ b/src/charset.c
@@ -1035,12 +1035,9 @@ usage: (define-charset-internal ...) */)
CHECK_FIXNAT (parent_max_code);
parent_code_offset = Fnth (make_fixnum (3), val);
CHECK_FIXNUM (parent_code_offset);
- val = make_uninit_vector (4);
- ASET (val, 0, make_fixnum (parent_charset->id));
- ASET (val, 1, parent_min_code);
- ASET (val, 2, parent_max_code);
- ASET (val, 3, parent_code_offset);
- ASET (attrs, charset_subset, val);
+ ASET (attrs, charset_subset,
+ CALLN (Fvector, make_fixnum (parent_charset->id),
+ parent_min_code, parent_max_code, parent_code_offset));
charset.method = CHARSET_METHOD_SUBSET;
/* Here, we just copy the parent's fast_map. It's not accurate,
diff --git a/src/coding.c b/src/coding.c
index 071124b4ef1..51bd441de9d 100644
--- a/src/coding.c
+++ b/src/coding.c
@@ -10856,20 +10856,17 @@ HIGHESTP non-nil means just return the highest priority one. */)
return Fnreverse (val);
}
-static const char *const suffixes[] = { "-unix", "-dos", "-mac" };
-
static Lisp_Object
make_subsidiaries (Lisp_Object base)
{
- Lisp_Object subsidiaries;
+ static char const suffixes[][8] = { "-unix", "-dos", "-mac" };
ptrdiff_t base_name_len = SBYTES (SYMBOL_NAME (base));
USE_SAFE_ALLOCA;
char *buf = SAFE_ALLOCA (base_name_len + 6);
- int i;
memcpy (buf, SDATA (SYMBOL_NAME (base)), base_name_len);
- subsidiaries = make_uninit_vector (3);
- for (i = 0; i < 3; i++)
+ Lisp_Object subsidiaries = make_nil_vector (3);
+ for (int i = 0; i < 3; i++)
{
strcpy (buf + base_name_len, suffixes[i]);
ASET (subsidiaries, i, intern (buf));
@@ -11829,8 +11826,7 @@ Each element is one element list of coding system name.
This variable is given to `completing-read' as COLLECTION argument.
Do not alter the value of this variable manually. This variable should be
-updated by the functions `make-coding-system' and
-`define-coding-system-alias'. */);
+updated by `define-coding-system-alias'. */);
Vcoding_system_alist = Qnil;
DEFVAR_LISP ("coding-category-list", Vcoding_category_list,
diff --git a/src/comp.c b/src/comp.c
index 704bd4b6b35..ff73245b8de 100644
--- a/src/comp.c
+++ b/src/comp.c
@@ -29,6 +29,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include <stdio.h>
#include <signal.h>
#include <libgccjit.h>
+#include <epaths.h>
#include "puresize.h"
#include "window.h"
@@ -393,6 +394,8 @@ load_gccjit_if_necessary (bool mandatory)
}
+#define ELN_FILENAME_HASH_LEN 64
+
/* C symbols emitted for the load relocation mechanism. */
#define CURRENT_THREAD_RELOC_SYM "current_thread_reloc"
#define PURE_RELOC_SYM "pure_reloc"
@@ -634,6 +637,16 @@ format_string (const char *format, ...)
return scratch_area;
}
+static Lisp_Object
+comp_hash_string (Lisp_Object string)
+{
+ Lisp_Object digest = make_uninit_string (SHA512_DIGEST_SIZE * 2);
+ sha512_buffer (SSDATA (string), SCHARS (string), SSDATA (digest));
+ hexbuf_digest (SSDATA (digest), SDATA (digest), SHA512_DIGEST_SIZE);
+
+ return digest;
+}
+
/* Produce a key hashing Vcomp_subr_list. */
void
@@ -641,10 +654,7 @@ hash_native_abi (void)
{
Lisp_Object string = Fmapconcat (intern_c_string ("subr-name"),
Vcomp_subr_list, build_string (" "));
- Lisp_Object digest = make_uninit_string (SHA512_DIGEST_SIZE * 2);
-
- sha512_buffer (SSDATA (string), SCHARS (string), SSDATA (digest));
- hexbuf_digest (SSDATA (digest), SDATA (digest), SHA512_DIGEST_SIZE);
+ Lisp_Object digest = comp_hash_string (string);
/* Check runs once. */
eassert (NILP (Vcomp_abi_hash));
@@ -652,8 +662,7 @@ hash_native_abi (void)
/* If 10 characters are usually sufficient for git I guess 16 are
fine for us here. */
Vcomp_native_path_postfix =
- concat3 (make_string ("eln-", 4),
- Vsystem_configuration,
+ concat2 (Vsystem_configuration,
concat2 (make_string ("-", 1),
Fsubstring_no_properties (Vcomp_abi_hash,
make_fixnum (0),
@@ -3852,6 +3861,71 @@ compile_function (Lisp_Object func)
/* Entry points exposed to lisp. */
/**********************************/
+/* In use by Fcomp_el_to_eln_filename. */
+static Lisp_Object loadsearch_re_list;
+
+DEFUN ("comp-el-to-eln-filename", Fcomp_el_to_eln_filename,
+ Scomp_el_to_eln_filename, 1, 2, 0,
+ doc: /* Given a source file return the corresponding .eln true filename.
+If BASE-DIR is nil use the first entry in `comp-eln-load-path'. */)
+ (Lisp_Object filename, Lisp_Object base_dir)
+{
+ CHECK_STRING (filename);
+
+ if (suffix_p (filename, ".gz"))
+ filename = Fsubstring (filename, Qnil, make_fixnum (-3));
+ filename = Fexpand_file_name (filename, Qnil);
+
+ /* We create eln filenames with an hash in order to look-up these
+ starting from the source filename, IOW have a relation
+ /absolute/path/filename.el -> eln-cache/filename-hash.eln.
+
+ As installing .eln files compiled during the build changes their
+ absolute path we need an hashing mechanism that is not sensitive
+ to that. For this we replace if match PATH_DUMPLOADSEARCH or
+ PATH_LOADSEARCH with '//' before generating the hash.
+
+ Another approach would be to hash using the source file content
+ but this may have a measurable performance impact. */
+
+ if (NILP (loadsearch_re_list))
+ {
+ Lisp_Object loadsearch_list =
+ Fcons (build_string (PATH_DUMPLOADSEARCH),
+ Fcons (build_string (PATH_LOADSEARCH), Qnil));
+ FOR_EACH_TAIL (loadsearch_list)
+ loadsearch_re_list =
+ Fcons (Fregexp_quote (XCAR (loadsearch_list)), loadsearch_re_list);
+ }
+ Lisp_Object loadsearch_res = loadsearch_re_list;
+ FOR_EACH_TAIL (loadsearch_res)
+ {
+ Lisp_Object match_idx =
+ Fstring_match (XCAR (loadsearch_res), filename, Qnil);
+ if (EQ (match_idx, make_fixnum (0)))
+ {
+ filename =
+ Freplace_match (build_string ("//"), Qt, Qt, filename, Qnil);
+ break;
+ }
+ }
+
+ Lisp_Object hash = Fsubstring (comp_hash_string (filename), Qnil,
+ make_fixnum (ELN_FILENAME_HASH_LEN));
+ filename = concat2 (Ffile_name_nondirectory (Fsubstring (filename, Qnil,
+ make_fixnum (-3))),
+ build_string ("-"));
+ filename = concat3 (filename, hash, build_string (NATIVE_ELISP_SUFFIX));
+ if (NILP (base_dir))
+ base_dir = XCAR (Vcomp_eln_load_path);
+
+ if (!file_name_absolute_p (SSDATA (base_dir)))
+ base_dir = Fexpand_file_name (base_dir, Vinvocation_directory);
+
+ return Fexpand_file_name (filename,
+ concat2 (base_dir, Vcomp_native_path_postfix));
+}
+
DEFUN ("comp--init-ctxt", Fcomp__init_ctxt, Scomp__init_ctxt,
0, 0, 0,
doc: /* Initialize the native compiler context. Return t on success. */)
@@ -4039,11 +4113,12 @@ DEFUN ("comp--compile-ctxt-to-file", Fcomp__compile_ctxt_to_file,
Scomp__compile_ctxt_to_file,
1, 1, 0,
doc: /* Compile as native code the current context to file. */)
- (Lisp_Object base_name)
+ (Lisp_Object file_name)
{
load_gccjit_if_necessary (true);
- CHECK_STRING (base_name);
+ CHECK_STRING (file_name);
+ Lisp_Object base_name = Fsubstring (file_name, Qnil, make_fixnum (-4));
gcc_jit_context_set_int_option (comp.ctxt,
GCC_JIT_INT_OPTION_OPTIMIZATION_LEVEL,
@@ -4105,19 +4180,18 @@ DEFUN ("comp--compile-ctxt-to-file", Fcomp__compile_ctxt_to_file,
AUTO_STRING (dot_so, NATIVE_ELISP_SUFFIX);
- Lisp_Object out_file = CALLN (Fconcat, base_name, dot_so);
Lisp_Object tmp_file =
Fmake_temp_file_internal (base_name, Qnil, dot_so, Qnil);
gcc_jit_context_compile_to_file (comp.ctxt,
GCC_JIT_OUTPUT_KIND_DYNAMIC_LIBRARY,
SSDATA (tmp_file));
- CALL2I (comp--replace-output-file, out_file, tmp_file);
+ CALL2I (comp--replace-output-file, file_name, tmp_file);
if (!noninteractive)
unbind_to (count, Qnil);
- return out_file;
+ return file_name;
}
DEFUN ("comp-libgccjit-version", Fcomp_libgccjit_version,
@@ -4462,7 +4536,11 @@ maybe_defer_native_compilation (Lisp_Object function_name,
concat2 (CALL1I (file-name-sans-extension, Vload_true_file_name),
build_pure_c_string (".el"));
if (NILP (Ffile_exists_p (src)))
- return;
+ {
+ src = concat2 (src, build_pure_c_string (".gz"));
+ if (NILP (Ffile_exists_p (src)))
+ return;
+ }
/* This is to have deferred compilaiton able to compile comp
dependecies breaking circularity. */
@@ -4497,6 +4575,27 @@ maybe_defer_native_compilation (Lisp_Object function_name,
/* Functions used to load eln files. */
/**************************************/
+/* Fixup the system eln-cache dir. This is the last entry in
+ `comp-eln-load-path'. */
+void
+fixup_eln_load_path (Lisp_Object directory)
+{
+ Lisp_Object last_cell = Qnil;
+ Lisp_Object tmp = Vcomp_eln_load_path;
+ FOR_EACH_TAIL (tmp)
+ if (CONSP (tmp))
+ last_cell = tmp;
+
+ Lisp_Object eln_cache_sys =
+ Ffile_name_directory (concat2 (Vinvocation_directory,
+ directory));
+ /* One directory up... */
+ eln_cache_sys =
+ Ffile_name_directory (Fsubstring (eln_cache_sys, Qnil,
+ make_fixnum (-1)));
+ Fsetcar (last_cell, eln_cache_sys);
+}
+
typedef char *(*comp_lit_str_func) (void);
/* Deserialize read and return static object. */
@@ -4869,7 +4968,13 @@ 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. */);
+ doc: /* If non-nil compile asyncronously all .elc files
+being loaded.
+
+Once compilation happened each function definition is updated to the
+native compiled one. */);
+ comp_deferred_compilation = true;
+
DEFSYM (Qcomp_speed, "comp-speed");
DEFSYM (Qcomp_debug, "comp-debug");
@@ -4971,6 +5076,7 @@ syms_of_comp (void)
build_pure_c_string ("eln file inconsistent with current runtime "
"configuration, please recompile"));
+ defsubr (&Scomp_el_to_eln_filename);
defsubr (&Scomp__init_ctxt);
defsubr (&Scomp__release_ctxt);
defsubr (&Scomp__compile_ctxt_to_file);
@@ -4989,6 +5095,8 @@ syms_of_comp (void)
comp.emitter_dispatcher = Qnil;
staticpro (&delayed_sources);
delayed_sources = Qnil;
+ staticpro (&loadsearch_re_list);
+ loadsearch_re_list = Qnil;
#ifdef WINDOWSNT
staticpro (&all_loaded_comp_units_h);
@@ -5015,6 +5123,22 @@ syms_of_comp (void)
internal use during */);
Vcomp_deferred_pending_h = CALLN (Fmake_hash_table, QCtest, Qeq);
+ DEFVAR_LISP ("comp-eln-to-el-h", Vcomp_eln_to_el_h,
+ doc: /* Hash table eln-filename -> el-filename. */);
+ Vcomp_eln_to_el_h = CALLN (Fmake_hash_table, QCtest, Qequal);
+
+ DEFVAR_LISP ("comp-eln-load-path", Vcomp_eln_load_path,
+ doc: /* List of eln cache directories.
+
+If a directory is non absolute is assumed to be relative to
+`invocation-directory'.
+The last directory of this list is assumed to be the system one. */);
+
+ /* Temporary value in use for boostrap. We can't do better as
+ `invocation-directory' is still unset, will be fixed up during
+ dump reload. */
+ Vcomp_eln_load_path = Fcons (build_string ("../eln-cache/"), Qnil);
+
#endif /* #ifdef HAVE_NATIVE_COMP */
defsubr (&Snative_comp_available_p);
diff --git a/src/comp.h b/src/comp.h
index 687e426b1ef..9270f8bf664 100644
--- a/src/comp.h
+++ b/src/comp.h
@@ -101,6 +101,8 @@ extern void dispose_all_remaining_comp_units (void);
extern void clean_package_user_dir_of_old_comp_units (void);
+extern void fixup_eln_load_path (Lisp_Object directory);
+
#else /* #ifdef HAVE_NATIVE_COMP */
static inline void
diff --git a/src/composite.c b/src/composite.c
index ec2b8328f78..984e0d9cda8 100644
--- a/src/composite.c
+++ b/src/composite.c
@@ -1258,7 +1258,7 @@ composition_reseat_it (struct composition_it *cmp_it, ptrdiff_t charpos,
is backward in the buffer, which can only happen if the
display routines were called to perform the bidi
reordering. But it doesn't harm to test for that, and
- avoid someon raising their brows and thinking it's a
+ avoid someone raising their brows and thinking it's a
subtle bug... */
if (bidi_level < 0)
direction = Qnil;
@@ -1939,7 +1939,7 @@ syms_of_composite (void)
staticpro (&gstring_hash_table);
staticpro (&gstring_work_headers);
- gstring_work_headers = make_uninit_vector (8);
+ gstring_work_headers = make_nil_vector (8);
for (i = 0; i < 8; i++)
ASET (gstring_work_headers, i, make_nil_vector (i + 2));
staticpro (&gstring_work);
diff --git a/src/emacs.c b/src/emacs.c
index 288ddb47bd7..8e52da75926 100644
--- a/src/emacs.c
+++ b/src/emacs.c
@@ -1643,23 +1643,27 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem
{
#ifdef NS_IMPL_COCOA
/* Started from GUI? */
- /* FIXME: Do the right thing if get_homedir returns "", or if
- chdir fails. */
- if (! inhibit_window_system && ! isatty (STDIN_FILENO) && ! ch_to_dir)
- chdir (get_homedir ());
+ bool go_home = (!ch_to_dir && !inhibit_window_system
+ && !isatty (STDIN_FILENO));
if (skip_args < argc)
{
if (!strncmp (argv[skip_args], "-psn", 4))
{
skip_args += 1;
- if (! ch_to_dir) chdir (get_homedir ());
+ go_home |= !ch_to_dir;
}
else if (skip_args+1 < argc && !strncmp (argv[skip_args+1], "-psn", 4))
{
skip_args += 2;
- if (! ch_to_dir) chdir (get_homedir ());
+ go_home |= !ch_to_dir;
}
}
+ if (go_home)
+ {
+ char const *home = get_homedir ();
+ if (*home && chdir (home) == 0)
+ emacs_wd = emacs_get_current_dir_name ();
+ }
#endif /* COCOA */
}
#endif /* HAVE_NS */
diff --git a/src/fns.c b/src/fns.c
index 91991782124..a3b8d6ef57d 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -1747,25 +1747,27 @@ changing the value of a sequence `foo'. */)
{
if (VECTORP (seq))
{
- ptrdiff_t i, n;
+ ptrdiff_t n = 0;
+ ptrdiff_t size = ASIZE (seq);
+ USE_SAFE_ALLOCA;
+ Lisp_Object *kept = SAFE_ALLOCA (size * sizeof *kept);
- for (i = n = 0; i < ASIZE (seq); ++i)
- if (NILP (Fequal (AREF (seq, i), elt)))
- ++n;
-
- if (n != ASIZE (seq))
+ for (ptrdiff_t i = 0; i < size; i++)
{
- struct Lisp_Vector *p = allocate_vector (n);
+ kept[n] = AREF (seq, i);
+ n += NILP (Fequal (AREF (seq, i), elt));
+ }
- for (i = n = 0; i < ASIZE (seq); ++i)
- if (NILP (Fequal (AREF (seq, i), elt)))
- p->contents[n++] = AREF (seq, i);
+ if (n != size)
+ seq = Fvector (n, kept);
- XSETVECTOR (seq, p);
- }
+ SAFE_FREE ();
}
else if (STRINGP (seq))
{
+ if (!CHARACTERP (elt))
+ return seq;
+
ptrdiff_t i, ibyte, nchars, nbytes, cbytes;
int c;
@@ -1784,7 +1786,7 @@ changing the value of a sequence `foo'. */)
cbytes = 1;
}
- if (!FIXNUMP (elt) || c != XFIXNUM (elt))
+ if (c != XFIXNUM (elt))
{
++nchars;
nbytes += cbytes;
@@ -1814,7 +1816,7 @@ changing the value of a sequence `foo'. */)
cbytes = 1;
}
- if (!FIXNUMP (elt) || c != XFIXNUM (elt))
+ if (c != XFIXNUM (elt))
{
unsigned char *from = SDATA (seq) + ibyte;
unsigned char *to = SDATA (tem) + nbytes;
diff --git a/src/font.c b/src/font.c
index ab00402b40b..5c01c7ff796 100644
--- a/src/font.c
+++ b/src/font.c
@@ -4847,21 +4847,18 @@ If the font is not OpenType font, CAPABILITY is nil. */)
(Lisp_Object font_object)
{
struct font *font = CHECK_FONT_GET_OBJECT (font_object);
- Lisp_Object val = make_uninit_vector (9);
-
- ASET (val, 0, AREF (font_object, FONT_NAME_INDEX));
- ASET (val, 1, AREF (font_object, FONT_FILE_INDEX));
- ASET (val, 2, make_fixnum (font->pixel_size));
- ASET (val, 3, make_fixnum (font->max_width));
- ASET (val, 4, make_fixnum (font->ascent));
- ASET (val, 5, make_fixnum (font->descent));
- ASET (val, 6, make_fixnum (font->space_width));
- ASET (val, 7, make_fixnum (font->average_width));
- if (font->driver->otf_capability)
- ASET (val, 8, Fcons (Qopentype, font->driver->otf_capability (font)));
- else
- ASET (val, 8, Qnil);
- return val;
+ return CALLN (Fvector,
+ AREF (font_object, FONT_NAME_INDEX),
+ AREF (font_object, FONT_FILE_INDEX),
+ make_fixnum (font->pixel_size),
+ make_fixnum (font->max_width),
+ make_fixnum (font->ascent),
+ make_fixnum (font->descent),
+ make_fixnum (font->space_width),
+ make_fixnum (font->average_width),
+ (font->driver->otf_capability
+ ? Fcons (Qopentype, font->driver->otf_capability (font))
+ : Qnil));
}
DEFUN ("font-get-glyphs", Ffont_get_glyphs, Sfont_get_glyphs, 3, 4, 0,
@@ -4889,7 +4886,7 @@ the corresponding element is nil. */)
{
struct font *font = CHECK_FONT_GET_OBJECT (font_object);
ptrdiff_t len;
- Lisp_Object *chars, vec;
+ Lisp_Object *chars;
USE_SAFE_ALLOCA;
if (NILP (object))
@@ -4957,7 +4954,7 @@ the corresponding element is nil. */)
else
wrong_type_argument (Qarrayp, object);
- vec = make_uninit_vector (len);
+ Lisp_Object vec = make_nil_vector (len);
for (ptrdiff_t i = 0; i < len; i++)
{
Lisp_Object g;
@@ -5168,24 +5165,23 @@ If the named font cannot be opened and loaded, return nil. */)
return Qnil;
font = XFONT_OBJECT (font_object);
- info = make_uninit_vector (14);
- ASET (info, 0, AREF (font_object, FONT_NAME_INDEX));
- ASET (info, 1, AREF (font_object, FONT_FULLNAME_INDEX));
- ASET (info, 2, make_fixnum (font->pixel_size));
- ASET (info, 3, make_fixnum (font->height));
- ASET (info, 4, make_fixnum (font->baseline_offset));
- ASET (info, 5, make_fixnum (font->relative_compose));
- ASET (info, 6, make_fixnum (font->default_ascent));
- ASET (info, 7, make_fixnum (font->max_width));
- ASET (info, 8, make_fixnum (font->ascent));
- ASET (info, 9, make_fixnum (font->descent));
- ASET (info, 10, make_fixnum (font->space_width));
- ASET (info, 11, make_fixnum (font->average_width));
- ASET (info, 12, AREF (font_object, FONT_FILE_INDEX));
- if (font->driver->otf_capability)
- ASET (info, 13, Fcons (Qopentype, font->driver->otf_capability (font)));
- else
- ASET (info, 13, Qnil);
+ info = CALLN (Fvector,
+ AREF (font_object, FONT_NAME_INDEX),
+ AREF (font_object, FONT_FULLNAME_INDEX),
+ make_fixnum (font->pixel_size),
+ make_fixnum (font->height),
+ make_fixnum (font->baseline_offset),
+ make_fixnum (font->relative_compose),
+ make_fixnum (font->default_ascent),
+ make_fixnum (font->max_width),
+ make_fixnum (font->ascent),
+ make_fixnum (font->descent),
+ make_fixnum (font->space_width),
+ make_fixnum (font->average_width),
+ AREF (font_object, FONT_FILE_INDEX),
+ (font->driver->otf_capability
+ ? Fcons (Qopentype, font->driver->otf_capability (font))
+ : Qnil));
#if 0
/* As font_object is still in FONT_OBJLIST of the entity, we can't
@@ -5203,7 +5199,7 @@ If the named font cannot be opened and loaded, return nil. */)
static Lisp_Object
build_style_table (const struct table_entry *entry, int nelement)
{
- Lisp_Object table = make_uninit_vector (nelement);
+ Lisp_Object table = make_nil_vector (nelement);
for (int i = 0; i < nelement; i++)
{
int j;
@@ -5494,10 +5490,8 @@ This variable cannot be set; trying to do so will signal an error. */);
make_symbol_constant (intern_c_string ("font-width-table"));
staticpro (&font_style_table);
- font_style_table = make_uninit_vector (3);
- ASET (font_style_table, 0, Vfont_weight_table);
- ASET (font_style_table, 1, Vfont_slant_table);
- ASET (font_style_table, 2, Vfont_width_table);
+ font_style_table = CALLN (Fvector, Vfont_weight_table, Vfont_slant_table,
+ Vfont_width_table);
DEFVAR_LISP ("font-log", Vfont_log, doc: /*
A list that logs font-related actions and results, for debugging.
diff --git a/src/fontset.c b/src/fontset.c
index c2bb8b21f26..8c86075c07e 100644
--- a/src/fontset.c
+++ b/src/fontset.c
@@ -252,14 +252,13 @@ set_fontset_fallback (Lisp_Object fontset, Lisp_Object fallback)
#define BASE_FONTSET_P(fontset) (NILP (FONTSET_BASE (fontset)))
-/* Macros for FONT-DEF and RFONT-DEF of fontset. */
-#define FONT_DEF_NEW(font_def, font_spec, encoding, repertory) \
- do { \
- (font_def) = make_uninit_vector (3); \
- ASET ((font_def), 0, font_spec); \
- ASET ((font_def), 1, encoding); \
- ASET ((font_def), 2, repertory); \
- } while (0)
+/* Definitions for FONT-DEF and RFONT-DEF of fontset. */
+static Lisp_Object
+font_def_new (Lisp_Object font_spec, Lisp_Object encoding,
+ Lisp_Object repertory)
+{
+ return CALLN (Fvector, font_spec, encoding, repertory);
+}
#define FONT_DEF_SPEC(font_def) AREF (font_def, 0)
#define FONT_DEF_ENCODING(font_def) AREF (font_def, 1)
@@ -1547,7 +1546,7 @@ appended. By default, FONT-SPEC overrides the previous settings. */)
repertory = CHARSET_SYMBOL_ID (repertory);
}
}
- FONT_DEF_NEW (font_def, font_spec, encoding, repertory);
+ font_def = font_def_new (font_spec, encoding, repertory);
}
else
font_def = Qnil;
@@ -1619,14 +1618,8 @@ appended. By default, FONT-SPEC overrides the previous settings. */)
if (charset)
{
- Lisp_Object arg;
-
- arg = make_uninit_vector (5);
- ASET (arg, 0, fontset);
- ASET (arg, 1, font_def);
- ASET (arg, 2, add);
- ASET (arg, 3, ascii_changed ? Qt : Qnil);
- ASET (arg, 4, range_list);
+ Lisp_Object arg = CALLN (Fvector, fontset, font_def, add,
+ ascii_changed ? Qt : Qnil, range_list);
map_charset_chars (set_fontset_font, Qnil, arg, charset,
CHARSET_MIN_CODE (charset),
diff --git a/src/ftfont.c b/src/ftfont.c
index 696f5e65341..a904007a329 100644
--- a/src/ftfont.c
+++ b/src/ftfont.c
@@ -2826,14 +2826,10 @@ ftfont_shape_by_flt (Lisp_Object lgstring, struct font *font,
LGLYPH_SET_ASCENT (lglyph, g->g.ascent >> 6);
LGLYPH_SET_DESCENT (lglyph, g->g.descent >> 6);
if (g->g.adjusted)
- {
- Lisp_Object vec = make_uninit_vector (3);
-
- ASET (vec, 0, make_fixnum (g->g.xoff >> 6));
- ASET (vec, 1, make_fixnum (g->g.yoff >> 6));
- ASET (vec, 2, make_fixnum (g->g.xadv >> 6));
- LGLYPH_SET_ADJUSTMENT (lglyph, vec);
- }
+ LGLYPH_SET_ADJUSTMENT (lglyph, CALLN (Fvector,
+ make_fixnum (g->g.xoff >> 6),
+ make_fixnum (g->g.yoff >> 6),
+ make_fixnum (g->g.xadv >> 6)));
}
return make_fixnum (i);
}
diff --git a/src/hbfont.c b/src/hbfont.c
index 4b3f64ef504..82b115e6868 100644
--- a/src/hbfont.c
+++ b/src/hbfont.c
@@ -594,13 +594,10 @@ hbfont_shape (Lisp_Object lgstring, Lisp_Object direction)
yoff = - lround (pos[i].y_offset * position_unit);
wadjust = lround (pos[i].x_advance * position_unit);
if (xoff || yoff || wadjust != metrics.width)
- {
- Lisp_Object vec = make_uninit_vector (3);
- ASET (vec, 0, make_fixnum (xoff));
- ASET (vec, 1, make_fixnum (yoff));
- ASET (vec, 2, make_fixnum (wadjust));
- LGLYPH_SET_ADJUSTMENT (lglyph, vec);
- }
+ LGLYPH_SET_ADJUSTMENT (lglyph, CALLN (Fvector,
+ make_fixnum (xoff),
+ make_fixnum (yoff),
+ make_fixnum (wadjust)));
}
return make_fixnum (glyph_len);
diff --git a/src/image.c b/src/image.c
index e236b389210..643b3d0a1f4 100644
--- a/src/image.c
+++ b/src/image.c
@@ -803,17 +803,23 @@ valid_image_p (Lisp_Object object)
{
Lisp_Object tail = XCDR (object);
FOR_EACH_TAIL_SAFE (tail)
- if (EQ (XCAR (tail), QCtype))
- {
- tail = XCDR (tail);
- if (CONSP (tail))
- {
- struct image_type const *type = lookup_image_type (XCAR (tail));
- if (type)
- return type->valid_p (object);
- }
- break;
- }
+ {
+ if (EQ (XCAR (tail), QCtype))
+ {
+ tail = XCDR (tail);
+ if (CONSP (tail))
+ {
+ struct image_type const *type =
+ lookup_image_type (XCAR (tail));
+ if (type)
+ return type->valid_p (object);
+ }
+ break;
+ }
+ tail = XCDR (tail);
+ if (! CONSP (tail))
+ return false;
+ }
}
return false;
@@ -899,7 +905,7 @@ parse_image_spec (Lisp_Object spec, struct image_keyword *keywords,
return false;
plist = XCDR (spec);
- while (CONSP (plist))
+ FOR_EACH_TAIL_SAFE (plist)
{
Lisp_Object key, value;
@@ -913,7 +919,6 @@ parse_image_spec (Lisp_Object spec, struct image_keyword *keywords,
if (!CONSP (plist))
return false;
value = XCAR (plist);
- plist = XCDR (plist);
/* Find key in KEYWORDS. Error if not found. */
for (i = 0; i < nkeywords; ++i)
@@ -921,7 +926,7 @@ parse_image_spec (Lisp_Object spec, struct image_keyword *keywords,
break;
if (i == nkeywords)
- continue;
+ goto maybe_done;
/* Record that we recognized the keyword. If a keyword
was found more than once, it's an error. */
@@ -1009,14 +1014,20 @@ parse_image_spec (Lisp_Object spec, struct image_keyword *keywords,
if (EQ (key, QCtype)
&& !(EQ (type, value) || EQ (type, Qnative_image)))
return false;
- }
- /* Check that all mandatory fields are present. */
- for (i = 0; i < nkeywords; ++i)
- if (keywords[i].count < keywords[i].mandatory_p)
- return false;
+ maybe_done:
+ if (EQ (XCDR (plist), Qnil))
+ {
+ /* Check that all mandatory fields are present. */
+ for (i = 0; i < nkeywords; ++i)
+ if (keywords[i].mandatory_p && keywords[i].count == 0)
+ return false;
+
+ return true;
+ }
+ }
- return NILP (plist);
+ return false;
}
@@ -1031,9 +1042,8 @@ image_spec_value (Lisp_Object spec, Lisp_Object key, bool *found)
eassert (valid_image_p (spec));
- for (tail = XCDR (spec);
- CONSP (tail) && CONSP (XCDR (tail));
- tail = XCDR (XCDR (tail)))
+ tail = XCDR (spec);
+ FOR_EACH_TAIL_SAFE (tail)
{
if (EQ (XCAR (tail), key))
{
@@ -1041,6 +1051,9 @@ image_spec_value (Lisp_Object spec, Lisp_Object key, bool *found)
*found = 1;
return XCAR (XCDR (tail));
}
+ tail = XCDR (tail);
+ if (! CONSP (tail))
+ break;
}
if (found)
@@ -1584,6 +1597,16 @@ make_image_cache (void)
return c;
}
+/* Compare two lists (one of which must be proper), comparing each
+ element with `eq'. */
+static bool
+equal_lists (Lisp_Object a, Lisp_Object b)
+{
+ while (CONSP (a) && CONSP (b) && EQ (XCAR (a), XCAR (b)))
+ a = XCDR (a), b = XCDR (b);
+
+ return EQ (a, b);
+}
/* Find an image matching SPEC in the cache, and return it. If no
image is found, return NULL. */
@@ -1610,7 +1633,7 @@ search_image_cache (struct frame *f, Lisp_Object spec, EMACS_UINT hash)
for (img = c->buckets[i]; img; img = img->next)
if (img->hash == hash
- && !NILP (Fequal (img->spec, spec))
+ && !equal_lists (img->spec, spec)
&& img->frame_foreground == FRAME_FOREGROUND_PIXEL (f)
&& img->frame_background == FRAME_BACKGROUND_PIXEL (f))
break;
diff --git a/src/lisp.h b/src/lisp.h
index 5f913b72b45..ddaeb0c1517 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -1812,7 +1812,8 @@ bool_vector_uchar_data (Lisp_Object a)
INLINE bool
bool_vector_bitref (Lisp_Object a, EMACS_INT i)
{
- eassume (0 <= i && i < bool_vector_size (a));
+ eassume (0 <= i);
+ eassert (i < bool_vector_size (a));
return !! (bool_vector_uchar_data (a)[i / BOOL_VECTOR_BITS_PER_CHAR]
& (1 << (i % BOOL_VECTOR_BITS_PER_CHAR)));
}
@@ -1828,11 +1829,11 @@ bool_vector_ref (Lisp_Object a, EMACS_INT i)
INLINE void
bool_vector_set (Lisp_Object a, EMACS_INT i, bool b)
{
- unsigned char *addr;
-
- eassume (0 <= i && i < bool_vector_size (a));
- addr = &bool_vector_uchar_data (a)[i / BOOL_VECTOR_BITS_PER_CHAR];
+ eassume (0 <= i);
+ eassert (i < bool_vector_size (a));
+ unsigned char *addr
+ = &bool_vector_uchar_data (a)[i / BOOL_VECTOR_BITS_PER_CHAR];
if (b)
*addr |= 1 << (i % BOOL_VECTOR_BITS_PER_CHAR);
else
@@ -3926,7 +3927,6 @@ build_string (const char *str)
extern Lisp_Object pure_cons (Lisp_Object, Lisp_Object);
extern Lisp_Object make_vector (ptrdiff_t, Lisp_Object);
-extern struct Lisp_Vector *allocate_vector (ptrdiff_t);
extern struct Lisp_Vector *allocate_nil_vector (ptrdiff_t);
/* Make an uninitialized vector for SIZE objects. NOTE: you must
@@ -3936,7 +3936,11 @@ extern struct Lisp_Vector *allocate_nil_vector (ptrdiff_t);
v = make_uninit_vector (3);
ASET (v, 0, obj0);
ASET (v, 1, Ffunction_can_gc ());
- ASET (v, 2, obj1); */
+ ASET (v, 2, obj1);
+
+ allocate_vector has a similar problem. */
+
+extern struct Lisp_Vector *allocate_vector (ptrdiff_t);
INLINE Lisp_Object
make_uninit_vector (ptrdiff_t size)
diff --git a/src/lread.c b/src/lread.c
index f5a7d44a1e0..521da4e1d81 100644
--- a/src/lread.c
+++ b/src/lread.c
@@ -1099,7 +1099,7 @@ close_infile_unwind (void *arg)
infile = prev_infile;
}
-static Lisp_Object
+static ATTRIBUTE_UNUSED Lisp_Object
parent_directory (Lisp_Object directory)
{
return Ffile_name_directory (Fsubstring (directory,
@@ -1231,8 +1231,7 @@ Return t if the file exists and loads successfully. */)
suffixes = CALLN (Fappend, suffixes, Vload_file_rep_suffixes);
}
- fd =
- openp (Vload_path, file, suffixes, &found, Qnil, load_prefer_newer);
+ fd = openp (Vload_path, file, suffixes, &found, Qnil, load_prefer_newer);
}
if (fd == -1)
@@ -1478,9 +1477,8 @@ Return t if the file exists and loads successfully. */)
same folder of their respective sources therfore not to break
packages we fake `load-file-name' here. The non faked
version of it is `load-true-file-name'. */
- specbind (Qload_file_name,
- concat2 (parent_directory (Ffile_name_directory (found)),
- Ffile_name_nondirectory (found)));
+ specbind (Qload_file_name, Fgethash (Ffile_name_nondirectory (found),
+ Vcomp_eln_to_el_h, Qnil));
}
else
specbind (Qload_file_name, found);
@@ -1608,118 +1606,52 @@ directories, make sure the PREDICATE function returns `dir-ok' for them. */)
return file;
}
-/* This function turns a list of suffixes into a list of middle dirs
- and suffixes. If the suffix is not NATIVE_ELISP_SUFFIX then its
- suffix is nil and it is added to the list as is. Instead, if it
- suffix is NATIVE_ELISP_SUFFIX then two elements are added to the
- list. The first one has middledir equal to nil and the second uses
- comp-native-path-postfix as middledir. This is because we'd like
- to search for dir/foo.eln before dir/middledir/foo.eln.
-
-For example, it turns this:
-
-(".eln" ".elc" ".elc.gz" ".el" ".el.gz")
+/* Look for a suitable .eln file to be loaded in place of FILENAME.
+ If found replace the content of FILENAME and FD. */
- into this:
-
-((nil . ".eln")
- (comp-native-path-postfix . ".eln")
- (nil . ".elc")
- (nil . ".elc.gz")
- (nil . ".el")
- (nil . ".el.gz"))
-*/
-static Lisp_Object
-openp_add_middle_dir_to_suffixes (Lisp_Object suffixes)
+static void
+maybe_swap_for_eln (Lisp_Object *filename, int *fd, struct timespec mtime)
{
- Lisp_Object tail = suffixes;
- Lisp_Object extended_suf = Qnil;
- FOR_EACH_TAIL_SAFE (tail)
- {
- /* suffixes may be a stack-based cons pointing to stack-based
- strings. We must copy the suffix if we are putting it into
- a heap-based cons to avoid a dangling reference. This would
- lead to crashes during the GC. */
- CHECK_STRING_CAR (tail);
- char * suf = SSDATA (XCAR (tail));
- Lisp_Object copied_suffix = build_string (suf);
#ifdef HAVE_NATIVE_COMP
- if (strcmp (NATIVE_ELISP_SUFFIX, suf) == 0)
- {
- CHECK_STRING (Vcomp_native_path_postfix);
- /* Here we add them in the opposite order so that nreverse
- corrects it. */
- extended_suf = Fcons (Fcons (Qnil, copied_suffix), extended_suf);
- extended_suf = Fcons (Fcons (Vcomp_native_path_postfix,
- copied_suffix),
- extended_suf);
- }
- else
-#endif
- extended_suf = Fcons (Fcons (Qnil, copied_suffix), extended_suf);
- }
+ struct stat eln_st;
- suffixes = Fnreverse (extended_suf);
- return suffixes;
-}
+ if (load_no_native
+ || !suffix_p (*filename, ".elc"))
+ return;
-/* This function takes a list of middledirs and suffixes and returns
- the maximum buffer space that this part of the filename will
- need. */
-static ptrdiff_t
-openp_max_middledir_and_suffix_len (Lisp_Object middledir_and_suffixes)
-{
- ptrdiff_t max_extra_len = 0;
- Lisp_Object tail = middledir_and_suffixes;
- FOR_EACH_TAIL_SAFE (tail)
+ /* Search eln in the eln-cache directories. */
+ Lisp_Object eln_path_tail = Vcomp_eln_load_path;
+ FOR_EACH_TAIL_SAFE (eln_path_tail)
{
- Lisp_Object middledir_and_suffix = XCAR (tail);
- Lisp_Object middledir = XCAR (middledir_and_suffix);
- Lisp_Object suffix = XCDR (middledir_and_suffix);
- ptrdiff_t len = SBYTES (suffix);
- if (!NILP (middledir))
- len += 2 + SBYTES (middledir); /* Add two slashes. */
- max_extra_len = max (max_extra_len, len);
- }
- return max_extra_len;
-}
+ Lisp_Object el_name =
+ Fsubstring (*filename, Qnil, make_fixnum (-1));
+ Lisp_Object eln_name =
+ Fcomp_el_to_eln_filename (el_name, XCAR (eln_path_tail));
+ int eln_fd = emacs_open (SSDATA (ENCODE_FILE (eln_name)), O_RDONLY, 0);
-/* This function completes the FN buffer with the middledir,
- basenameme, and suffix. It takes the directory length in DIRNAME,
- but it requires that it has been copied already to the start of
- the buffer.
-
- After this function the FN buffer will be (depending on middledir)
- dirname/middledir/basename.suffix
- or
- dirname/basename.suffix
-*/
-static ptrdiff_t
-openp_fill_filename_buffer (char *fn, ptrdiff_t dirnamelen,
- Lisp_Object basenamewext,
- Lisp_Object middledir_and_suffix)
-{
- Lisp_Object middledir = XCAR (middledir_and_suffix);
- Lisp_Object suffix = XCDR (middledir_and_suffix);
- ptrdiff_t basenamewext_len = SBYTES (basenamewext);
- ptrdiff_t fnlen, lsuffix = SBYTES (suffix);
- ptrdiff_t lmiddledir = 0;
- if (!NILP (middledir))
- {
- /* Add 1 for the slash. */
- lmiddledir = SBYTES (middledir) + 1;
- memcpy (fn + dirnamelen, SDATA (middledir),
- lmiddledir - 1);
- fn[dirnamelen + (lmiddledir - 1)] = '/';
+ if (eln_fd > 0)
+ {
+ if (fstat (eln_fd, &eln_st) || S_ISDIR (eln_st.st_mode))
+ emacs_close (eln_fd);
+ else
+ {
+ struct timespec eln_mtime = get_stat_mtime (&eln_st);
+ if (timespec_cmp (eln_mtime, mtime) > 0)
+ {
+ *filename = eln_name;
+ emacs_close (*fd);
+ *fd = eln_fd;
+ /* Store the eln -> el relation. */
+ Fputhash (Ffile_name_nondirectory (eln_name),
+ el_name, Vcomp_eln_to_el_h);
+ return;
+ }
+ else
+ emacs_close (eln_fd);
+ }
+ }
}
-
- memcpy (fn + dirnamelen + lmiddledir, SDATA (basenamewext),
- basenamewext_len);
- /* Make complete filename by appending SUFFIX. */
- memcpy (fn + dirnamelen + lmiddledir + basenamewext_len,
- SDATA (suffix), lsuffix + 1);
- fnlen = dirnamelen + lmiddledir + basenamewext_len + lsuffix;
- return fnlen;
+#endif
}
/* Search for a file whose name is STR, looking in directories
@@ -1759,21 +1691,23 @@ openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes,
ptrdiff_t want_length;
Lisp_Object filename;
Lisp_Object string, tail, encoded_fn, save_string;
- Lisp_Object middledir_and_suffixes;
- ptrdiff_t max_extra_len = 0;
+ ptrdiff_t max_suffix_len = 0;
int last_errno = ENOENT;
int save_fd = -1;
USE_SAFE_ALLOCA;
-
/* The last-modified time of the newest matching file found.
Initialize it to something less than all valid timestamps. */
struct timespec save_mtime = make_timespec (TYPE_MINIMUM (time_t), -1);
CHECK_STRING (str);
- middledir_and_suffixes = openp_add_middle_dir_to_suffixes (suffixes);
-
- max_extra_len = openp_max_middledir_and_suffix_len (middledir_and_suffixes);
+ tail = suffixes;
+ FOR_EACH_TAIL_SAFE (tail)
+ {
+ CHECK_STRING_CAR (tail);
+ max_suffix_len = max (max_suffix_len,
+ SBYTES (XCAR (tail)));
+ }
string = filename = encoded_fn = save_string = Qnil;
@@ -1790,7 +1724,7 @@ openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes,
executable. */
FOR_EACH_TAIL_SAFE (path)
{
- ptrdiff_t dirnamelen, prefixlen;
+ ptrdiff_t baselen, prefixlen;
if (EQ (path, just_use_str))
filename = str;
@@ -1807,40 +1741,35 @@ openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes,
continue;
}
-
/* Calculate maximum length of any filename made from
this path element/specified file name and any possible suffix. */
- want_length = max_extra_len + SBYTES (filename);
+ want_length = max_suffix_len + SBYTES (filename);
if (fn_size <= want_length)
{
fn_size = 100 + want_length;
fn = SAFE_ALLOCA (fn_size);
}
- Lisp_Object dirnamewslash = Ffile_name_directory (filename);
- Lisp_Object basenamewext = Ffile_name_nondirectory (filename);
-
/* Copy FILENAME's data to FN but remove starting /: if any. */
- prefixlen = ((SCHARS (dirnamewslash) > 2
- && SREF (dirnamewslash, 0) == '/'
- && SREF (dirnamewslash, 1) == ':')
+ prefixlen = ((SCHARS (filename) > 2
+ && SREF (filename, 0) == '/'
+ && SREF (filename, 1) == ':')
? 2 : 0);
- dirnamelen = SBYTES (dirnamewslash) - prefixlen;
- memcpy (fn, SDATA (dirnamewslash) + prefixlen, dirnamelen);
+ baselen = SBYTES (filename) - prefixlen;
+ memcpy (fn, SDATA (filename) + prefixlen, baselen);
- /* Loop over middledir_and_suffixes. */
- AUTO_LIST1 (empty_string_only, Fcons (Qnil, empty_unibyte_string));
- tail = NILP (middledir_and_suffixes) ? empty_string_only
- : middledir_and_suffixes;
+ /* Loop over suffixes. */
+ AUTO_LIST1 (empty_string_only, empty_unibyte_string);
+ tail = NILP (suffixes) ? empty_string_only : suffixes;
FOR_EACH_TAIL_SAFE (tail)
{
- Lisp_Object middledir_and_suffix = XCAR (tail);
- Lisp_Object suffix = XCDR (middledir_and_suffix);
+ Lisp_Object suffix = XCAR (tail);
+ ptrdiff_t fnlen, lsuffix = SBYTES (suffix);
Lisp_Object handler;
- ptrdiff_t fnlen = openp_fill_filename_buffer (fn, dirnamelen,
- basenamewext,
- middledir_and_suffix);
+ /* Make complete filename by appending SUFFIX. */
+ memcpy (fn + baselen, SDATA (suffix), lsuffix + 1);
+ fnlen = baselen + lsuffix;
/* Check that the file exists and is not a directory. */
/* We used to only check for handlers on non-absolute file names:
@@ -1962,9 +1891,11 @@ openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes,
}
else
{
+ maybe_swap_for_eln (&string, &fd, get_stat_mtime (&st));
/* We succeeded; return this descriptor and filename. */
if (storeptr)
*storeptr = string;
+
SAFE_FREE ();
return fd;
}
@@ -1973,6 +1904,7 @@ openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes,
/* No more suffixes. Return the newest. */
if (0 <= save_fd && ! CONSP (XCDR (tail)))
{
+ maybe_swap_for_eln (&save_string, &save_fd, save_mtime);
if (storeptr)
*storeptr = save_string;
SAFE_FREE ();
@@ -5030,11 +4962,8 @@ to the specified file name if a suffix is allowed or required. */);
Vload_suffixes =
Fcons (build_pure_c_string (MODULES_SECONDARY_SUFFIX), Vload_suffixes);
#endif
-#endif
-#ifdef HAVE_NATIVE_COMP
- Vload_suffixes = Fcons (build_pure_c_string (NATIVE_ELISP_SUFFIX), Vload_suffixes);
-#endif
+#endif
DEFVAR_LISP ("module-file-suffix", Vmodule_file_suffix,
doc: /* Suffix of loadable module file, or nil if modules are not supported. */);
#ifdef HAVE_MODULES
@@ -5228,6 +5157,11 @@ Note that if you customize this, obviously it will not affect files
that are loaded before your customizations are read! */);
load_prefer_newer = 0;
+ DEFVAR_BOOL ("load-no-native", load_no_native,
+ doc: /* Do not try to load the a .eln file in place of
+ a .elc one. */);
+ load_no_native = false;
+
/* Vsource_directory was initialized in init_lread. */
DEFSYM (Qcurrent_load_list, "current-load-list");
diff --git a/src/macfont.m b/src/macfont.m
index c7430d32772..904814647f9 100644
--- a/src/macfont.m
+++ b/src/macfont.m
@@ -3137,10 +3137,8 @@ macfont_shape (Lisp_Object lgstring, Lisp_Object direction)
wadjust = lround (gl->advance);
if (xoff != 0 || yoff != 0 || wadjust != metrics.width)
{
- Lisp_Object vec = make_uninit_vector (3);
- ASET (vec, 0, make_fixnum (xoff));
- ASET (vec, 1, make_fixnum (yoff));
- ASET (vec, 2, make_fixnum (wadjust));
+ Lisp_Object vec = CALLN (Fvector, make_fixnum (xoff),
+ make_fixnum (yoff), make_fixnum (wadjust));
LGLYPH_SET_ADJUSTMENT (lglyph, vec);
}
}
diff --git a/src/minibuf.c b/src/minibuf.c
index cb302c5a605..e18ff17abbf 100644
--- a/src/minibuf.c
+++ b/src/minibuf.c
@@ -251,7 +251,7 @@ read_minibuf_noninteractive (Lisp_Object prompt, bool expflag,
else
{
xfree (line);
- error ("Error reading from stdin");
+ xsignal1 (Qend_of_file, build_string ("Error reading from stdin"));
}
/* If Lisp form desired instead of string, parse it. */
diff --git a/src/nsselect.m b/src/nsselect.m
index 38ac66e9c7b..7b1937f5d99 100644
--- a/src/nsselect.m
+++ b/src/nsselect.m
@@ -114,7 +114,7 @@ clean_local_selection_data (Lisp_Object obj)
if (size == 1)
return clean_local_selection_data (AREF (obj, 0));
- copy = make_uninit_vector (size);
+ copy = make_nil_vector (size);
for (i = 0; i < size; i++)
ASET (copy, i, clean_local_selection_data (AREF (obj, i)));
return copy;
diff --git a/src/nsterm.m b/src/nsterm.m
index 9f5916d78ed..98c5b69d681 100644
--- a/src/nsterm.m
+++ b/src/nsterm.m
@@ -7669,11 +7669,8 @@ not_in_argv (NSString *arg)
/* macOS Sierra automatically enables tabbed windows. We can't
allow this to be enabled until it's available on a Free system.
Currently it only happens by accident and is buggy anyway. */
-#if defined (NS_IMPL_COCOA) \
- && MAC_OS_X_VERSION_MAX_ALLOWED >= 101200
-#if MAC_OS_X_VERSION_MIN_REQUIRED < 101200
+#ifdef NS_IMPL_COCOA
if ([win respondsToSelector: @selector(setTabbingMode:)])
-#endif
[win setTabbingMode: NSWindowTabbingModeDisallowed];
#endif
@@ -8424,25 +8421,17 @@ not_in_argv (NSString *arg)
- (void)windowDidChangeBackingProperties:(NSNotification *)notification
- /* Update the drawing buffer when the backing scale factor changes. */
+ /* Update the drawing buffer when the backing properties change. */
{
NSTRACE ("EmacsView windowDidChangeBackingProperties:]");
if (! [self wantsUpdateLayer])
return;
- CGFloat old = [[[notification userInfo]
- objectForKey:@"NSBackingPropertyOldScaleFactorKey"]
- doubleValue];
- CGFloat new = [[self window] backingScaleFactor];
-
- if (old != new)
- {
- NSRect frame = [self frame];
- [self createDrawingBuffer];
- ns_clear_frame (emacsframe);
- expose_frame (emacsframe, 0, 0, NSWidth (frame), NSHeight (frame));
- }
+ NSRect frame = [self frame];
+ [self createDrawingBuffer];
+ ns_clear_frame (emacsframe);
+ expose_frame (emacsframe, 0, 0, NSWidth (frame), NSHeight (frame));
}
#endif /* NS_DRAW_TO_BUFFER */
diff --git a/src/nsxwidget.m b/src/nsxwidget.m
index 370abee395c..e81ca7fc0cb 100644
--- a/src/nsxwidget.m
+++ b/src/nsxwidget.m
@@ -388,7 +388,7 @@ js_to_lisp (id value)
NSArray *nsarr = (NSArray *) value;
EMACS_INT n = nsarr.count;
Lisp_Object obj;
- struct Lisp_Vector *p = allocate_vector (n);
+ struct Lisp_Vector *p = allocate_nil_vector (n);
for (ptrdiff_t i = 0; i < n; ++i)
p->contents[i] = js_to_lisp ([nsarr objectAtIndex:i]);
@@ -401,7 +401,7 @@ js_to_lisp (id value)
NSArray *keys = nsdict.allKeys;
ptrdiff_t n = keys.count;
Lisp_Object obj;
- struct Lisp_Vector *p = allocate_vector (n);
+ struct Lisp_Vector *p = allocate_nil_vector (n);
for (ptrdiff_t i = 0; i < n; ++i)
{
diff --git a/src/pdumper.c b/src/pdumper.c
index 629d0969346..9c615a9a1a7 100644
--- a/src/pdumper.c
+++ b/src/pdumper.c
@@ -4903,14 +4903,19 @@ struct dump_bitset
};
static bool
-dump_bitset_init (struct dump_bitset *bitset, size_t number_bits)
+dump_bitsets_init (struct dump_bitset bitset[2], size_t number_bits)
{
- int xword_size = sizeof (bitset->bits[0]);
+ int xword_size = sizeof (bitset[0].bits[0]);
int bits_per_word = xword_size * CHAR_BIT;
ptrdiff_t words_needed = divide_round_up (number_bits, bits_per_word);
- bitset->number_words = words_needed;
- bitset->bits = calloc (words_needed, xword_size);
- return bitset->bits != NULL;
+ dump_bitset_word *bits = calloc (words_needed, 2 * xword_size);
+ if (!bits)
+ return false;
+ bitset[0].bits = bits;
+ bitset[0].number_words = bitset[1].number_words = words_needed;
+ bitset[1].bits = memset (bits + words_needed, UCHAR_MAX,
+ words_needed * xword_size);
+ return true;
}
static dump_bitset_word *
@@ -4971,7 +4976,7 @@ struct pdumper_loaded_dump_private
/* Copy of the header we read from the dump. */
struct dump_header header;
/* Mark bits for objects in the dump; used during GC. */
- struct dump_bitset mark_bits;
+ struct dump_bitset mark_bits, last_mark_bits;
/* Time taken to load the dump. */
double load_time;
/* Dump file name. */
@@ -5094,6 +5099,10 @@ pdumper_find_object_type_impl (const void *obj)
dump_off offset = ptrdiff_t_to_dump_off ((uintptr_t) obj - dump_public.start);
if (offset % DUMP_ALIGNMENT != 0)
return PDUMPER_NO_OBJECT;
+ ptrdiff_t bitno = offset / DUMP_ALIGNMENT;
+ if (offset < dump_private.header.discardable_start
+ && !dump_bitset_bit_set_p (&dump_private.last_mark_bits, bitno))
+ return PDUMPER_NO_OBJECT;
const struct dump_reloc *reloc =
dump_find_relocation (&dump_private.header.object_starts, offset);
return (reloc != NULL && dump_reloc_get_offset (*reloc) == offset)
@@ -5122,12 +5131,16 @@ pdumper_set_marked_impl (const void *obj)
eassert (offset < dump_private.header.cold_start);
eassert (offset < dump_private.header.discardable_start);
ptrdiff_t bitno = offset / DUMP_ALIGNMENT;
+ eassert (dump_bitset_bit_set_p (&dump_private.last_mark_bits, bitno));
dump_bitset_set_bit (&dump_private.mark_bits, bitno);
}
void
pdumper_clear_marks_impl (void)
{
+ dump_bitset_word *swap = dump_private.last_mark_bits.bits;
+ dump_private.last_mark_bits.bits = dump_private.mark_bits.bits;
+ dump_private.mark_bits.bits = swap;
dump_bitset_clear (&dump_private.mark_bits);
}
@@ -5249,9 +5262,13 @@ dump_do_dump_relocation (const uintptr_t dump_base,
{
fclose (file);
installation_state = INSTALLED;
+ fixup_eln_load_path (XCAR (comp_u->file));
}
else
- installation_state = LOCAL_BUILD;
+ {
+ installation_state = LOCAL_BUILD;
+ fixup_eln_load_path (XCDR (comp_u->file));
+ }
}
comp_u->file =
@@ -5423,7 +5440,7 @@ pdumper_load (const char *dump_filename, char *argv0, char const *original_pwd)
int dump_page_size;
dump_off adj_discardable_start;
- struct dump_bitset mark_bits;
+ struct dump_bitset mark_bits[2];
size_t mark_bits_needed;
struct dump_header header_buf = { 0 };
@@ -5537,7 +5554,7 @@ pdumper_load (const char *dump_filename, char *argv0, char const *original_pwd)
err = PDUMPER_LOAD_ERROR;
mark_bits_needed =
divide_round_up (header->discardable_start, DUMP_ALIGNMENT);
- if (!dump_bitset_init (&mark_bits, mark_bits_needed))
+ if (!dump_bitsets_init (mark_bits, mark_bits_needed))
goto out;
/* Point of no return. */
@@ -5545,7 +5562,8 @@ pdumper_load (const char *dump_filename, char *argv0, char const *original_pwd)
dump_base = (uintptr_t) sections[DS_HOT].mapping;
gflags.dumped_with_pdumper_ = true;
dump_private.header = *header;
- dump_private.mark_bits = mark_bits;
+ dump_private.mark_bits = mark_bits[0];
+ dump_private.last_mark_bits = mark_bits[1];
dump_public.start = dump_base;
dump_public.end = dump_public.start + dump_size;
diff --git a/src/search.c b/src/search.c
index 38c64caf7c0..6fb3716cd43 100644
--- a/src/search.c
+++ b/src/search.c
@@ -3271,7 +3271,7 @@ the buffer. If the buffer doesn't have a cache, the value is nil. */)
TYPE_MAXIMUM (ptrdiff_t), &nl_count_cache, NULL, true);
/* Create vector and populate it. */
- cache_newlines = make_uninit_vector (nl_count_cache);
+ cache_newlines = make_vector (nl_count_cache, make_fixnum (-1));
if (nl_count_cache)
{
@@ -3285,15 +3285,12 @@ the buffer. If the buffer doesn't have a cache, the value is nil. */)
break;
ASET (cache_newlines, i, make_fixnum (found - 1));
}
- /* Fill the rest of slots with an invalid position. */
- for ( ; i < nl_count_cache; i++)
- ASET (cache_newlines, i, make_fixnum (-1));
}
/* Now do the same, but without using the cache. */
find_newline1 (BEGV, BEGV_BYTE, ZV, ZV_BYTE,
TYPE_MAXIMUM (ptrdiff_t), &nl_count_buf, NULL, true);
- buf_newlines = make_uninit_vector (nl_count_buf);
+ buf_newlines = make_vector (nl_count_buf, make_fixnum (-1));
if (nl_count_buf)
{
for (from = BEGV, found = from, i = 0; from < ZV; from = found, i++)
@@ -3306,14 +3303,10 @@ the buffer. If the buffer doesn't have a cache, the value is nil. */)
break;
ASET (buf_newlines, i, make_fixnum (found - 1));
}
- for ( ; i < nl_count_buf; i++)
- ASET (buf_newlines, i, make_fixnum (-1));
}
/* Construct the value and return it. */
- val = make_uninit_vector (2);
- ASET (val, 0, cache_newlines);
- ASET (val, 1, buf_newlines);
+ val = CALLN (Fvector, cache_newlines, buf_newlines);
if (old != NULL)
set_buffer_internal_1 (old);
diff --git a/src/syntax.c b/src/syntax.c
index a03202d386c..9f77ea5f9b0 100644
--- a/src/syntax.c
+++ b/src/syntax.c
@@ -3617,9 +3617,9 @@ init_syntax_once (void)
DEFSYM (Qsyntax_table, "syntax-table");
/* Create objects which can be shared among syntax tables. */
- Vsyntax_code_object = make_uninit_vector (Smax);
+ Vsyntax_code_object = make_nil_vector (Smax);
for (i = 0; i < Smax; i++)
- ASET (Vsyntax_code_object, i, Fcons (make_fixnum (i), Qnil));
+ ASET (Vsyntax_code_object, i, list1 (make_fixnum (i)));
/* Now we are ready to set up this property, so we can
create syntax tables. */
diff --git a/src/sysdep.c b/src/sysdep.c
index 6b54ed3b6ec..a1050c4309a 100644
--- a/src/sysdep.c
+++ b/src/sysdep.c
@@ -49,10 +49,14 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
# include <cygwin/fs.h>
#endif
-#if defined DARWIN_OS || defined __FreeBSD__
+#if defined DARWIN_OS || defined __FreeBSD__ || defined __OpenBSD__
# include <sys/sysctl.h>
#endif
+#ifdef DARWIN_OS
+# include <libproc.h>
+#endif
+
#ifdef __FreeBSD__
/* Sparc/ARM machine/frame.h has 'struct frame' which conflicts with Emacs's
'struct frame', so rename it. */
@@ -3061,37 +3065,43 @@ list_system_processes (void)
return proclist;
}
-#elif defined DARWIN_OS || defined __FreeBSD__
+#elif defined DARWIN_OS || defined __FreeBSD__ || defined __OpenBSD__
Lisp_Object
list_system_processes (void)
{
#ifdef DARWIN_OS
int mib[] = {CTL_KERN, KERN_PROC, KERN_PROC_ALL};
+#elif defined __OpenBSD__
+ int mib[] = {CTL_KERN, KERN_PROC, KERN_PROC_ALL, 0,
+ sizeof (struct kinfo_proc), 4096};
#else
int mib[] = {CTL_KERN, KERN_PROC, KERN_PROC_PROC};
#endif
size_t len;
+ size_t mibsize = sizeof mib / sizeof mib[0];
struct kinfo_proc *procs;
size_t i;
Lisp_Object proclist = Qnil;
- if (sysctl (mib, 3, NULL, &len, NULL, 0) != 0 || len == 0)
+ if (sysctl (mib, mibsize, NULL, &len, NULL, 0) != 0 || len == 0)
return proclist;
procs = xmalloc (len);
- if (sysctl (mib, 3, procs, &len, NULL, 0) != 0 || len == 0)
+ if (sysctl (mib, mibsize, procs, &len, NULL, 0) != 0 || len == 0)
{
xfree (procs);
return proclist;
}
- len /= sizeof (struct kinfo_proc);
+ len /= sizeof procs[0];
for (i = 0; i < len; i++)
{
#ifdef DARWIN_OS
proclist = Fcons (INT_TO_INTEGER (procs[i].kp_proc.p_pid), proclist);
+#elif defined __OpenBSD__
+ proclist = Fcons (INT_TO_INTEGER (procs[i].p_pid), proclist);
#else
proclist = Fcons (INT_TO_INTEGER (procs[i].ki_pid), proclist);
#endif
@@ -3865,8 +3875,21 @@ system_process_attributes (Lisp_Object pid)
if (gr)
attrs = Fcons (Fcons (Qgroup, build_string (gr->gr_name)), attrs);
+ char pathbuf[PROC_PIDPATHINFO_MAXSIZE];
+ char *comm;
+
+ if (proc_pidpath (proc_id, pathbuf, sizeof(pathbuf)) > 0)
+ {
+ if ((comm = strrchr (pathbuf, '/')))
+ comm++;
+ else
+ comm = pathbuf;
+ }
+ else
+ comm = proc.kp_proc.p_comm;
+
decoded_comm = (code_convert_string_norecord
- (build_unibyte_string (proc.kp_proc.p_comm),
+ (build_unibyte_string (comm),
Vlocale_coding_system, 0));
attrs = Fcons (Fcons (Qcomm, decoded_comm), attrs);
diff --git a/src/timefns.c b/src/timefns.c
index 94cfddf0da9..71d5e10872a 100644
--- a/src/timefns.c
+++ b/src/timefns.c
@@ -1312,11 +1312,12 @@ or (if you need time as a string) `format-time-string'. */)
((size_t) -1) for MAXSIZE.
This function behaves like nstrftime, except it allows NUL
- bytes in FORMAT and it does not support nanoseconds. */
+ bytes in FORMAT. */
static size_t
emacs_nmemftime (char *s, size_t maxsize, const char *format,
size_t format_len, const struct tm *tp, timezone_t tz, int ns)
{
+ int saved_errno = errno;
size_t total = 0;
/* Loop through all the NUL-terminated strings in the format
@@ -1326,30 +1327,25 @@ emacs_nmemftime (char *s, size_t maxsize, const char *format,
'\0' byte so we must invoke it separately for each such string. */
for (;;)
{
- size_t len;
- size_t result;
-
+ errno = 0;
+ size_t result = nstrftime (s, maxsize, format, tp, tz, ns);
+ if (result == 0 && errno != 0)
+ return result;
if (s)
- s[0] = '\1';
-
- result = nstrftime (s, maxsize, format, tp, tz, ns);
-
- if (s)
- {
- if (result == 0 && s[0] != '\0')
- return 0;
- s += result + 1;
- }
+ s += result + 1;
maxsize -= result + 1;
total += result;
- len = strlen (format);
+ size_t len = strlen (format);
if (len == format_len)
- return total;
+ break;
total++;
format += len + 1;
format_len -= len + 1;
}
+
+ errno = saved_errno;
+ return total;
}
static Lisp_Object
@@ -1379,10 +1375,11 @@ format_time_string (char const *format, ptrdiff_t formatlen,
while (true)
{
- buf[0] = '\1';
+ errno = 0;
len = emacs_nmemftime (buf, size, format, formatlen, tmp, tz, ns);
- if ((0 < len && len < size) || (len == 0 && buf[0] == '\0'))
+ if (len != 0 || errno == 0)
break;
+ eassert (errno == ERANGE);
/* Buffer was too small, so make it bigger and try again. */
len = emacs_nmemftime (NULL, SIZE_MAX, format, formatlen, tmp, tz, ns);
diff --git a/src/window.c b/src/window.c
index e2dea8b70ef..ef58f43a0bd 100644
--- a/src/window.c
+++ b/src/window.c
@@ -7465,7 +7465,7 @@ saved by this function. */)
data->minibuf_selected_window = minibuf_level > 0 ? minibuf_selected_window : Qnil;
data->root_window = FRAME_ROOT_WINDOW (f);
data->focus_frame = FRAME_FOCUS_FRAME (f);
- Lisp_Object tem = make_uninit_vector (n_windows);
+ Lisp_Object tem = make_nil_vector (n_windows);
data->saved_windows = tem;
for (ptrdiff_t i = 0; i < n_windows; i++)
ASET (tem, i, make_nil_vector (VECSIZE (struct saved_window)));
diff --git a/src/xdisp.c b/src/xdisp.c
index 4fe1c4288af..ad03ac46054 100644
--- a/src/xdisp.c
+++ b/src/xdisp.c
@@ -180,8 +180,8 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
present (non-empty) only if the corresponding display margin is
shown in the window. If the glyph array for a marginal area is not
present its beginning and end coincide, i.e. such arrays are
- actually empty (they contain no glyphs). Frame glyph matrics, used
- on text-mode terminals (see below) never have marginal areas, they
+ actually empty (they contain no glyphs). Frame glyph matrices, used
+ on text-mode terminals (see below) never have marginal areas; they
treat the entire frame-wide row of glyphs as a single large "text
area".
@@ -7555,7 +7555,7 @@ get_next_display_element (struct it *it)
/* Merge `nobreak-space' into the current face. */
face_id = merge_faces (it->w, Qnobreak_space, 0,
it->face_id);
- XSETINT (it->ctl_chars[0], ' ');
+ XSETINT (it->ctl_chars[0], it->c);
ctl_len = 1;
goto display_control;
}
@@ -7568,7 +7568,7 @@ get_next_display_element (struct it *it)
/* Merge `nobreak-space' into the current face. */
face_id = merge_faces (it->w, Qnobreak_hyphen, 0,
it->face_id);
- XSETINT (it->ctl_chars[0], '-');
+ XSETINT (it->ctl_chars[0], it->c);
ctl_len = 1;
goto display_control;
}
diff --git a/src/xfaces.c b/src/xfaces.c
index 2c6e593f631..06d2f994de6 100644
--- a/src/xfaces.c
+++ b/src/xfaces.c
@@ -1572,22 +1572,18 @@ the face font sort order. */)
for (i = nfonts - 1; i >= 0; --i)
{
Lisp_Object font = AREF (vec, i);
- Lisp_Object v = make_uninit_vector (8);
- int point;
- Lisp_Object spacing;
-
- ASET (v, 0, AREF (font, FONT_FAMILY_INDEX));
- ASET (v, 1, FONT_WIDTH_SYMBOLIC (font));
- point = PIXEL_TO_POINT (XFIXNUM (AREF (font, FONT_SIZE_INDEX)) * 10,
- FRAME_RES_Y (f));
- ASET (v, 2, make_fixnum (point));
- ASET (v, 3, FONT_WEIGHT_SYMBOLIC (font));
- ASET (v, 4, FONT_SLANT_SYMBOLIC (font));
- spacing = Ffont_get (font, QCspacing);
- ASET (v, 5, (NILP (spacing) || EQ (spacing, Qp)) ? Qnil : Qt);
- ASET (v, 6, Ffont_xlfd_name (font, Qnil));
- ASET (v, 7, AREF (font, FONT_REGISTRY_INDEX));
-
+ int point = PIXEL_TO_POINT (XFIXNUM (AREF (font, FONT_SIZE_INDEX)) * 10,
+ FRAME_RES_Y (f));
+ Lisp_Object spacing = Ffont_get (font, QCspacing);
+ Lisp_Object v = CALLN (Fvector,
+ AREF (font, FONT_FAMILY_INDEX),
+ FONT_WIDTH_SYMBOLIC (font),
+ make_fixnum (point),
+ FONT_WEIGHT_SYMBOLIC (font),
+ FONT_SLANT_SYMBOLIC (font),
+ NILP (spacing) || EQ (spacing, Qp) ? Qnil : Qt,
+ Ffont_xlfd_name (font, Qnil),
+ AREF (font, FONT_REGISTRY_INDEX));
result = Fcons (v, result);
}
diff --git a/src/xfns.c b/src/xfns.c
index 09dcbbfb92d..78f977bf0aa 100644
--- a/src/xfns.c
+++ b/src/xfns.c
@@ -5890,7 +5890,8 @@ If WINDOW-ID is non-nil, change the property of that window instead
elsize = element_format == 32 ? sizeof (long) : element_format >> 3;
data = xnmalloc (nelements, elsize);
- x_fill_property_data (FRAME_X_DISPLAY (f), value, data, element_format);
+ x_fill_property_data (FRAME_X_DISPLAY (f), value, data, nelements,
+ element_format);
}
else
{
@@ -6196,10 +6197,10 @@ Otherwise, the return value is a vector with the following fields:
{
XFree (tmp_data);
- prop_attr = make_uninit_vector (3);
- ASET (prop_attr, 0, make_fixnum (actual_type));
- ASET (prop_attr, 1, make_fixnum (actual_format));
- ASET (prop_attr, 2, make_fixnum (bytes_remaining / (actual_format >> 3)));
+ prop_attr = CALLN (Fvector,
+ make_fixnum (actual_type),
+ make_fixnum (actual_format),
+ make_fixnum (bytes_remaining / (actual_format >> 3)));
}
unblock_input ();
@@ -8027,7 +8028,7 @@ If this equals the symbol 'resize-mode', Emacs uses GTK's resize mode to
always trigger an immediate resize of the child frame. This method is
deprecated by GTK and may not work in future versions of that toolkit.
It also may freeze Emacs when used with other desktop environments. It
-avoids, however, the unpleasent flicker induced by the hiding approach.
+avoids, however, the unpleasant flicker induced by the hiding approach.
This variable is considered a temporary workaround and will be hopefully
eliminated in future versions of Emacs. */);
diff --git a/src/xrdb.c b/src/xrdb.c
index e3a1fcb15a9..3d7f715c88f 100644
--- a/src/xrdb.c
+++ b/src/xrdb.c
@@ -289,9 +289,9 @@ get_user_app (const char *class)
/* Check in the home directory. This is a bit of a hack; let's
hope one's home directory doesn't contain ':' or '%'. */
char const *home = get_homedir ();
- db = search_magic_path (home, class, "%L/%N");
+ db = search_magic_path (home, class, "/%L/%N");
if (! db)
- db = search_magic_path (home, class, "%N");
+ db = search_magic_path (home, class, "/%N");
}
return db;
diff --git a/src/xselect.c b/src/xselect.c
index 48d6215a7bb..383aebf96c8 100644
--- a/src/xselect.c
+++ b/src/xselect.c
@@ -1594,7 +1594,7 @@ selection_data_to_lisp_data (struct x_display_info *dpyinfo,
return x_atom_to_symbol (dpyinfo, (Atom) idata[0]);
else
{
- Lisp_Object v = make_uninit_vector (size / sizeof (int));
+ Lisp_Object v = make_nil_vector (size / sizeof (int));
for (i = 0; i < size / sizeof (int); i++)
ASET (v, i, x_atom_to_symbol (dpyinfo, (Atom) idata[i]));
@@ -1653,7 +1653,7 @@ selection_data_to_lisp_data (struct x_display_info *dpyinfo,
else
{
ptrdiff_t i;
- Lisp_Object v = make_uninit_vector (size / X_LONG_SIZE);
+ Lisp_Object v = make_nil_vector (size / X_LONG_SIZE);
if (type == XA_INTEGER)
{
@@ -1860,7 +1860,7 @@ clean_local_selection_data (Lisp_Object obj)
Lisp_Object copy;
if (size == 1)
return clean_local_selection_data (AREF (obj, 0));
- copy = make_uninit_vector (size);
+ copy = make_nil_vector (size);
for (i = 0; i < size; i++)
ASET (copy, i, clean_local_selection_data (AREF (obj, i)));
return copy;
@@ -2276,23 +2276,28 @@ x_check_property_data (Lisp_Object data)
DPY is the display use to look up X atoms.
DATA is a Lisp list of values to be converted.
- RET is the C array that contains the converted values. It is assumed
- it is big enough to hold all values.
+ RET is the C array that contains the converted values.
+ NELEMENTS_MAX is the number of values that will fit in RET.
+ Any excess values in DATA are ignored.
FORMAT is 8, 16 or 32 and denotes char/short/long for each C value to
be stored in RET. Note that long is used for 32 even if long is more
than 32 bits (see man pages for XChangeProperty, XGetWindowProperty and
XClientMessageEvent). */
void
-x_fill_property_data (Display *dpy, Lisp_Object data, void *ret, int format)
+x_fill_property_data (Display *dpy, Lisp_Object data, void *ret,
+ int nelements_max, int format)
{
unsigned long val;
unsigned long *d32 = (unsigned long *) ret;
unsigned short *d16 = (unsigned short *) ret;
unsigned char *d08 = (unsigned char *) ret;
+ int nelements;
Lisp_Object iter;
- for (iter = data; CONSP (iter); iter = XCDR (iter))
+ for (iter = data, nelements = 0;
+ CONSP (iter) && nelements < nelements_max;
+ iter = XCDR (iter), nelements++)
{
Lisp_Object o = XCAR (iter);
@@ -2593,7 +2598,9 @@ x_send_client_event (Lisp_Object display, Lisp_Object dest, Lisp_Object from,
event.xclient.window = to_root ? FRAME_OUTER_WINDOW (f) : wdest;
memset (event.xclient.data.l, 0, sizeof (event.xclient.data.l));
+ /* event.xclient.data can hold 20 chars, 10 shorts, or 5 longs. */
x_fill_property_data (dpyinfo->display, values, event.xclient.data.b,
+ 5 * 32 / event.xclient.format,
event.xclient.format);
/* If event mask is 0 the event is sent to the client that created
diff --git a/src/xterm.c b/src/xterm.c
index 6340700cb89..2e0407aff40 100644
--- a/src/xterm.c
+++ b/src/xterm.c
@@ -8760,6 +8760,20 @@ handle_one_xevent (struct x_display_info *dpyinfo,
goto OTHER;
case FocusIn:
+ /* Some WMs (e.g. Mutter in Gnome Shell), don't unmap
+ minimized/iconified windows; thus, for those WMs we won't get
+ a MapNotify when unminimizing/deconifying. Check here if we
+ are deconizing a window (Bug42655). */
+ f = any;
+ if (f && FRAME_ICONIFIED_P (f))
+ {
+ SET_FRAME_VISIBLE (f, 1);
+ SET_FRAME_ICONIFIED (f, false);
+ f->output_data.x->has_been_visible = true;
+ inev.ie.kind = DEICONIFY_EVENT;
+ XSETFRAME (inev.ie.frame_or_window, f);
+ }
+
x_detect_focus_change (dpyinfo, any, event, &inev.ie);
goto OTHER;
@@ -9907,6 +9921,13 @@ x_uncatch_errors (void)
{
struct x_error_message_stack *tmp;
+ /* In rare situations when running Emacs run in daemon mode,
+ shutting down an emacsclient via delete-frame can cause
+ x_uncatch_errors to be called when x_error_message is set to
+ NULL. */
+ if (x_error_message == NULL)
+ return;
+
block_input ();
/* The display may have been closed before this function is called.
diff --git a/src/xterm.h b/src/xterm.h
index bc10043c54c..db8d5847814 100644
--- a/src/xterm.h
+++ b/src/xterm.h
@@ -1207,6 +1207,7 @@ extern int x_check_property_data (Lisp_Object);
extern void x_fill_property_data (Display *,
Lisp_Object,
void *,
+ int,
int);
extern Lisp_Object x_property_data_to_lisp (struct frame *,
const unsigned char *,
diff --git a/src/xwidget.c b/src/xwidget.c
index c61f5bef88d..154b3e9c82c 100644
--- a/src/xwidget.c
+++ b/src/xwidget.c
@@ -343,7 +343,7 @@ webkit_js_to_lisp (JSCValue *value)
memory_full (SIZE_MAX);
ptrdiff_t n = dlen;
- struct Lisp_Vector *p = allocate_vector (n);
+ struct Lisp_Vector *p = allocate_nil_vector (n);
for (ptrdiff_t i = 0; i < n; ++i)
{
@@ -361,7 +361,7 @@ webkit_js_to_lisp (JSCValue *value)
Lisp_Object obj;
if (PTRDIFF_MAX < n)
memory_full (n);
- struct Lisp_Vector *p = allocate_vector (n);
+ struct Lisp_Vector *p = allocate_nil_vector (n);
for (ptrdiff_t i = 0; i < n; ++i)
{