commit 09d746dad36e4780d379f975a84b1b076da78c50 (HEAD, refs/remotes/origin/master) Author: Eli Zaretskii Date: Fri Mar 22 11:02:46 2019 +0300 Revert "Revert "Revert "Rely on conservative stack scanning to find "emacs_value"s""" This reverts commit 093d3e78d21d3d6c718997368ef4b31f9884401c, which reverted ee7ad83f20903208404a84b58b7a478b62924570, which reverted 3eb93c07f7a60ac9ce8a16f10c3afd5a3a31243a. diff --git a/src/emacs-module.c b/src/emacs-module.c index 530a8ebefe..2bb1062574 100644 --- a/src/emacs-module.c +++ b/src/emacs-module.c @@ -25,6 +25,7 @@ along with GNU Emacs. If not, see . */ #include #include #include +#include #include "lisp.h" #include "dynlib.h" @@ -65,18 +66,6 @@ along with GNU Emacs. If not, see . */ #include "w32term.h" #endif -/* True if Lisp_Object and emacs_value have the same representation. - This is typically true unless WIDE_EMACS_INT. In practice, having - the same sizes and alignments and maximums should be a good enough - proxy for equality of representation. */ -enum - { - plain_values - = (sizeof (Lisp_Object) == sizeof (emacs_value) - && alignof (Lisp_Object) == alignof (emacs_value) - && INTPTR_MAX == EMACS_INT_MAX) - }; - /* Function prototype for the module init function. */ typedef int (*emacs_init_function) (struct emacs_runtime *); @@ -87,6 +76,43 @@ typedef int (*emacs_init_function) (struct emacs_runtime *); typedef void (*emacs_finalizer_function) (void *); +/* Memory management. */ + +/* An `emacs_value' is just a pointer to a structure holding an + internal Lisp object. */ +struct emacs_value_tag { Lisp_Object v; }; + +/* Local value objects use a simple fixed-sized block allocation + scheme without explicit deallocation. All local values are + deallocated when the lifetime of their environment ends. Keep + track of a current frame from which new values are allocated, + appending further dynamically-allocated frames if necessary. */ + +enum { value_frame_size = 512 }; + +/* A block from which `emacs_value' object can be allocated. */ +struct emacs_value_frame +{ + /* Storage for values. */ + struct emacs_value_tag objects[value_frame_size]; + + /* Index of the next free value in `objects'. */ + int offset; + + /* Pointer to next frame, if any. */ + struct emacs_value_frame *next; +}; + +/* A structure that holds an initial frame (so that the first local + values require no dynamic allocation) and keeps track of the + current frame. */ +static struct emacs_value_storage +{ + struct emacs_value_frame initial; + struct emacs_value_frame *current; +} global_storage; + + /* Private runtime and environment members. */ /* The private part of an environment stores the current non local exit state @@ -99,12 +125,9 @@ struct emacs_env_private /* Dedicated storage for non-local exit symbol and data so that storage is always available for them, even in an out-of-memory situation. */ - Lisp_Object non_local_exit_symbol, non_local_exit_data; + struct emacs_value_tag non_local_exit_symbol, non_local_exit_data; - /* List of values allocated from this environment. The code uses - this only if the user gave the -module-assertions command-line - option. */ - Lisp_Object values; + struct emacs_value_storage storage; }; /* The private parts of an `emacs_runtime' object contain the initial @@ -118,6 +141,7 @@ struct emacs_runtime_private /* Forward declarations. */ static Lisp_Object value_to_lisp (emacs_value); +static emacs_value allocate_emacs_value (emacs_env *, struct emacs_value_storage *, Lisp_Object); static emacs_value lisp_to_value (emacs_env *, Lisp_Object); static enum emacs_funcall_exit module_non_local_exit_check (emacs_env *); static void module_assert_thread (void); @@ -139,16 +163,7 @@ static void module_non_local_exit_throw_1 (emacs_env *, static void module_out_of_memory (emacs_env *); static void module_reset_handlerlist (struct handler **); -/* We used to return NULL when emacs_value was a different type from - Lisp_Object, but nowadays we just use Qnil instead. Although they - happen to be the same thing in the current implementation, module - code should not assume this. */ -verify (NIL_IS_ZERO); -static emacs_value const module_nil = 0; - static bool module_assertions = false; -static emacs_env *global_env; -static struct emacs_env_private global_env_private; /* Convenience macros for non-local exit handling. */ @@ -293,7 +308,7 @@ module_get_environment (struct emacs_runtime *ert) static emacs_value module_make_global_ref (emacs_env *env, emacs_value ref) { - MODULE_FUNCTION_BEGIN (module_nil); + MODULE_FUNCTION_BEGIN (NULL); struct Lisp_Hash_Table *h = XHASH_TABLE (Vmodule_refs_hash); Lisp_Object new_obj = value_to_lisp (ref); EMACS_UINT hashcode; @@ -313,7 +328,7 @@ module_make_global_ref (emacs_env *env, emacs_value ref) hash_put (h, new_obj, make_fixed_natnum (1), hashcode); } - return lisp_to_value (module_assertions ? global_env : env, new_obj); + return allocate_emacs_value (env, &global_storage, new_obj); } static void @@ -341,23 +356,16 @@ module_free_global_ref (emacs_env *env, emacs_value ref) if (module_assertions) { - Lisp_Object globals = global_env_private.values; - Lisp_Object prev = Qnil; ptrdiff_t count = 0; - for (Lisp_Object tail = globals; CONSP (tail); - tail = XCDR (tail)) + for (struct emacs_value_frame *frame = &global_storage.initial; + frame != NULL; frame = frame->next) { - emacs_value global = xmint_pointer (XCAR (tail)); - if (global == ref) + for (int i = 0; i < frame->offset; ++i) { - if (NILP (prev)) - global_env_private.values = XCDR (globals); - else - XSETCDR (prev, XCDR (tail)); - return; + if (&frame->objects[i] == ref) + return; + ++count; } - ++count; - prev = tail; } module_abort ("Global value was not found in list of %"pD"d globals", count); @@ -388,9 +396,8 @@ module_non_local_exit_get (emacs_env *env, emacs_value *sym, emacs_value *data) struct emacs_env_private *p = env->private_members; if (p->pending_non_local_exit != emacs_funcall_exit_return) { - /* FIXME: lisp_to_value can exit non-locally. */ - *sym = lisp_to_value (env, p->non_local_exit_symbol); - *data = lisp_to_value (env, p->non_local_exit_data); + *sym = &p->non_local_exit_symbol; + *data = &p->non_local_exit_data; } return p->pending_non_local_exit; } @@ -434,7 +441,7 @@ module_make_function (emacs_env *env, ptrdiff_t min_arity, ptrdiff_t max_arity, emacs_subr subr, const char *documentation, void *data) { - MODULE_FUNCTION_BEGIN (module_nil); + MODULE_FUNCTION_BEGIN (NULL); if (! (0 <= min_arity && (max_arity < 0 @@ -467,7 +474,7 @@ static emacs_value module_funcall (emacs_env *env, emacs_value fun, ptrdiff_t nargs, emacs_value args[]) { - MODULE_FUNCTION_BEGIN (module_nil); + MODULE_FUNCTION_BEGIN (NULL); /* Make a new Lisp_Object array starting with the function as the first arg, because that's what Ffuncall takes. */ @@ -488,14 +495,14 @@ module_funcall (emacs_env *env, emacs_value fun, ptrdiff_t nargs, static emacs_value module_intern (emacs_env *env, const char *name) { - MODULE_FUNCTION_BEGIN (module_nil); + MODULE_FUNCTION_BEGIN (NULL); return lisp_to_value (env, intern (name)); } static emacs_value module_type_of (emacs_env *env, emacs_value value) { - MODULE_FUNCTION_BEGIN (module_nil); + MODULE_FUNCTION_BEGIN (NULL); return lisp_to_value (env, Ftype_of (value_to_lisp (value))); } @@ -528,7 +535,7 @@ module_extract_integer (emacs_env *env, emacs_value n) static emacs_value module_make_integer (emacs_env *env, intmax_t n) { - MODULE_FUNCTION_BEGIN (module_nil); + MODULE_FUNCTION_BEGIN (NULL); return lisp_to_value (env, make_int (n)); } @@ -544,7 +551,7 @@ module_extract_float (emacs_env *env, emacs_value f) static emacs_value module_make_float (emacs_env *env, double d) { - MODULE_FUNCTION_BEGIN (module_nil); + MODULE_FUNCTION_BEGIN (NULL); return lisp_to_value (env, make_float (d)); } @@ -581,7 +588,7 @@ module_copy_string_contents (emacs_env *env, emacs_value value, char *buffer, static emacs_value module_make_string (emacs_env *env, const char *str, ptrdiff_t length) { - MODULE_FUNCTION_BEGIN (module_nil); + MODULE_FUNCTION_BEGIN (NULL); if (! (0 <= length && length <= STRING_BYTES_BOUND)) overflow_error (); /* FIXME: AUTO_STRING_WITH_LEN requires STR to be NUL-terminated, @@ -594,7 +601,7 @@ module_make_string (emacs_env *env, const char *str, ptrdiff_t length) static emacs_value module_make_user_ptr (emacs_env *env, emacs_finalizer_function fin, void *ptr) { - MODULE_FUNCTION_BEGIN (module_nil); + MODULE_FUNCTION_BEGIN (NULL); return lisp_to_value (env, make_user_ptr (fin, ptr)); } @@ -656,7 +663,7 @@ module_vec_set (emacs_env *env, emacs_value vec, ptrdiff_t i, emacs_value val) static emacs_value module_vec_get (emacs_env *env, emacs_value vec, ptrdiff_t i) { - MODULE_FUNCTION_BEGIN (module_nil); + MODULE_FUNCTION_BEGIN (NULL); Lisp_Object lvec = value_to_lisp (vec); check_vec_index (lvec, i); return lisp_to_value (env, AREF (lvec, i)); @@ -699,9 +706,11 @@ module_signal_or_throw (struct emacs_env_private *env) case emacs_funcall_exit_return: return; case emacs_funcall_exit_signal: - xsignal (env->non_local_exit_symbol, env->non_local_exit_data); + xsignal (value_to_lisp (&env->non_local_exit_symbol), + value_to_lisp (&env->non_local_exit_data)); case emacs_funcall_exit_throw: - Fthrow (env->non_local_exit_symbol, env->non_local_exit_data); + Fthrow (value_to_lisp (&env->non_local_exit_symbol), + value_to_lisp (&env->non_local_exit_data)); default: eassume (false); } @@ -777,17 +786,12 @@ funcall_module (Lisp_Object function, ptrdiff_t nargs, Lisp_Object *arglist) record_unwind_protect_ptr (finalize_environment_unwind, env); USE_SAFE_ALLOCA; - ATTRIBUTE_MAY_ALIAS emacs_value *args; - if (plain_values && ! module_assertions) - /* FIXME: The cast below is incorrect because the argument array - is not declared as const, so module functions can modify it. - Either declare it as const, or remove this branch. */ - args = (emacs_value *) arglist; - else + emacs_value *args = nargs > 0 ? SAFE_ALLOCA (nargs * sizeof *args) : NULL; + for (ptrdiff_t i = 0; i < nargs; ++i) { - args = SAFE_ALLOCA (nargs * sizeof *args); - for (ptrdiff_t i = 0; i < nargs; i++) - args[i] = lisp_to_value (env, arglist[i]); + args[i] = lisp_to_value (env, arglist[i]); + if (! args[i]) + memory_full (sizeof *args[i]); } emacs_value ret = func->subr (env, nargs, args, func->data); @@ -867,8 +871,8 @@ module_non_local_exit_signal_1 (emacs_env *env, Lisp_Object sym, if (p->pending_non_local_exit == emacs_funcall_exit_return) { p->pending_non_local_exit = emacs_funcall_exit_signal; - p->non_local_exit_symbol = sym; - p->non_local_exit_data = data; + p->non_local_exit_symbol.v = sym; + p->non_local_exit_data.v = data; } } @@ -880,8 +884,8 @@ module_non_local_exit_throw_1 (emacs_env *env, Lisp_Object tag, if (p->pending_non_local_exit == emacs_funcall_exit_return) { p->pending_non_local_exit = emacs_funcall_exit_throw; - p->non_local_exit_symbol = tag; - p->non_local_exit_data = value; + p->non_local_exit_symbol.v = tag; + p->non_local_exit_data.v = value; } } @@ -898,54 +902,8 @@ module_out_of_memory (emacs_env *env) /* Value conversion. */ -/* We represent Lisp objects differently depending on whether the user - gave -module-assertions. If assertions are disabled, emacs_value - objects are Lisp_Objects cast to emacs_value. If assertions are - enabled, emacs_value objects are pointers to Lisp_Object objects - allocated from the free store; they are never freed, which ensures - that their addresses are unique and can be used for liveness - checking. */ - -/* Unique Lisp_Object used to mark those emacs_values which are really - just containers holding a Lisp_Object that does not fit as an emacs_value, - either because it is an integer out of range, or is not properly aligned. - Used only if !plain_values. */ -static Lisp_Object ltv_mark; - -/* Convert V to the corresponding internal object O, such that - V == lisp_to_value_bits (O). Never fails. */ -static Lisp_Object -value_to_lisp_bits (emacs_value v) -{ - if (plain_values || USE_LSB_TAG) - return XPL (v); - - /* With wide EMACS_INT and when tag bits are the most significant, - reassembling integers differs from reassembling pointers in two - ways. First, save and restore the least-significant bits of the - integer, not the most-significant bits. Second, sign-extend the - integer when restoring, but zero-extend pointers because that - makes TAG_PTR faster. */ - - intptr_t i = (intptr_t) v; - EMACS_UINT tag = i & ((1 << GCTYPEBITS) - 1); - EMACS_UINT untagged = i - tag; - switch (tag) - { - case_Lisp_Int: - { - bool negative = tag & 1; - EMACS_UINT sign_extension - = negative ? VALMASK & ~(INTPTR_MAX >> INTTYPEBITS): 0; - uintptr_t u = i; - intptr_t all_but_sign = u >> GCTYPEBITS; - untagged = sign_extension + all_but_sign; - break; - } - } - - return XIL ((tag << VALBITS) + untagged); -} +/* Convert an `emacs_value' to the corresponding internal object. + Never fails. */ /* If V was computed from lisp_to_value (O), then return O. Exits non-locally only if the stack overflows. */ @@ -956,91 +914,134 @@ value_to_lisp (emacs_value v) { /* Check the liveness of the value by iterating over all live environments. */ - void *vptr = v; - ATTRIBUTE_MAY_ALIAS Lisp_Object *optr = vptr; ptrdiff_t num_environments = 0; ptrdiff_t num_values = 0; for (Lisp_Object environments = Vmodule_environments; CONSP (environments); environments = XCDR (environments)) { emacs_env *env = xmint_pointer (XCAR (environments)); - for (Lisp_Object values = env->private_members->values; - CONSP (values); values = XCDR (values)) + struct emacs_env_private *priv = env->private_members; + /* The value might be one of the nonlocal exit values. Note + that we don't check whether a nonlocal exit is currently + pending, because the module might have cleared the flag + in the meantime. */ + if (&priv->non_local_exit_symbol == v + || &priv->non_local_exit_data == v) + goto ok; + for (struct emacs_value_frame *frame = &priv->storage.initial; + frame != NULL; frame = frame->next) { - Lisp_Object *p = xmint_pointer (XCAR (values)); - if (p == optr) - return *p; - ++num_values; + for (int i = 0; i < frame->offset; ++i) + { + if (&frame->objects[i] == v) + goto ok; + ++num_values; + } } ++num_environments; } + /* Also check global values. */ + for (struct emacs_value_frame *frame = &global_storage.initial; + frame != NULL; frame = frame->next) + { + for (int i = 0; i < frame->offset; ++i) + { + if (&frame->objects[i] == v) + goto ok; + ++num_values; + } + } module_abort (("Emacs value not found in %"pD"d values " "of %"pD"d environments"), num_values, num_environments); } - Lisp_Object o = value_to_lisp_bits (v); - if (! plain_values && CONSP (o) && EQ (XCDR (o), ltv_mark)) - o = XCAR (o); - return o; + ok: return v->v; } -/* Attempt to convert O to an emacs_value. Do not do any checking - or allocate any storage; the caller should prevent or detect - any resulting bit pattern that is not a valid emacs_value. */ +/* Convert an internal object to an `emacs_value'. Allocate storage + from the environment; return NULL if allocation fails. */ static emacs_value -lisp_to_value_bits (Lisp_Object o) +lisp_to_value (emacs_env *env, Lisp_Object o) { - if (plain_values || USE_LSB_TAG) - return XLP (o); + struct emacs_env_private *p = env->private_members; + if (p->pending_non_local_exit != emacs_funcall_exit_return) + return NULL; + return allocate_emacs_value (env, &p->storage, o); +} - /* Compress O into the space of a pointer, possibly losing information. */ - EMACS_UINT u = XLI (o); - if (FIXNUMP (o)) - { - uintptr_t i = (u << VALBITS) + XTYPE (o); - return (emacs_value) i; - } - else +/* Must be called for each frame before it can be used for allocation. */ +static void +initialize_frame (struct emacs_value_frame *frame) +{ + frame->offset = 0; + frame->next = NULL; +} + +/* Must be called for any storage object before it can be used for + allocation. */ +static void +initialize_storage (struct emacs_value_storage *storage) +{ + initialize_frame (&storage->initial); + storage->current = &storage->initial; +} + +/* Must be called for any initialized storage object before its + lifetime ends. Free all dynamically-allocated frames. */ +static void +finalize_storage (struct emacs_value_storage *storage) +{ + struct emacs_value_frame *next = storage->initial.next; + while (next != NULL) { - char *p = XLP (o); - void *v = p - (u & ~VALMASK) + XTYPE (o); - return v; + struct emacs_value_frame *current = next; + next = current->next; + free (current); } } -/* Convert O to an emacs_value. Allocate storage if needed; this can - signal if memory is exhausted. Must be an injective function. */ +/* Allocate a new value from STORAGE and stores OBJ in it. Return + NULL if allocation fails and use ENV for non local exit reporting. */ static emacs_value -lisp_to_value (emacs_env *env, Lisp_Object o) +allocate_emacs_value (emacs_env *env, struct emacs_value_storage *storage, + Lisp_Object obj) { - if (module_assertions) + eassert (storage->current); + eassert (storage->current->offset < value_frame_size); + eassert (! storage->current->next); + if (storage->current->offset == value_frame_size - 1) { - /* Add the new value to the list of values allocated from this - environment. The value is actually a pointer to the - Lisp_Object cast to emacs_value. We make a copy of the - object on the free store to guarantee unique addresses. */ - ATTRIBUTE_MAY_ALIAS Lisp_Object *optr = xmalloc (sizeof o); - *optr = o; - void *vptr = optr; - ATTRIBUTE_MAY_ALIAS emacs_value ret = vptr; - struct emacs_env_private *priv = env->private_members; - priv->values = Fcons (make_mint_ptr (ret), priv->values); - return ret; + storage->current->next = malloc (sizeof *storage->current->next); + if (! storage->current->next) + { + module_out_of_memory (env); + return NULL; + } + initialize_frame (storage->current->next); + storage->current = storage->current->next; } + emacs_value value = storage->current->objects + storage->current->offset; + value->v = obj; + ++storage->current->offset; + return value; +} - emacs_value v = lisp_to_value_bits (o); - - if (! EQ (o, value_to_lisp_bits (v))) +/* Mark all objects allocated from local environments so that they + don't get garbage-collected. */ +void +mark_modules (void) +{ + for (Lisp_Object tem = Vmodule_environments; CONSP (tem); tem = XCDR (tem)) { - /* Package the incompressible object pointer inside a pair - that is compressible. */ - Lisp_Object pair = Fcons (o, ltv_mark); - v = (emacs_value) ((intptr_t) XCONS (pair) + Lisp_Cons); + emacs_env *env = xmint_pointer (XCAR (tem)); + struct emacs_env_private *priv = env->private_members; + for (struct emacs_value_frame *frame = &priv->storage.initial; + frame != NULL; + frame = frame->next) + for (int i = 0; i < frame->offset; ++i) + mark_object (frame->objects[i].v); } - - eassert (EQ (o, value_to_lisp (v))); - return v; } @@ -1059,7 +1060,7 @@ initialize_environment (emacs_env *env, struct emacs_env_private *priv) env = xmalloc (sizeof *env); priv->pending_non_local_exit = emacs_funcall_exit_return; - priv->values = priv->non_local_exit_symbol = priv->non_local_exit_data = Qnil; + initialize_storage (&priv->storage); env->size = sizeof *env; env->private_members = priv; env->make_global_ref = module_make_global_ref; @@ -1100,11 +1101,9 @@ initialize_environment (emacs_env *env, struct emacs_env_private *priv) static void finalize_environment (emacs_env *env) { + finalize_storage (&env->private_members->storage); eassert (xmint_pointer (XCAR (Vmodule_environments)) == env); Vmodule_environments = XCDR (Vmodule_environments); - if (module_assertions) - /* There is always at least the global environment. */ - eassert (CONSP (Vmodule_environments)); } static void @@ -1122,20 +1121,6 @@ finalize_runtime_unwind (void *raw_ert) finalize_environment (ert->private_members->env); } -void -mark_modules (void) -{ - for (Lisp_Object tail = Vmodule_environments; CONSP (tail); - tail = XCDR (tail)) - { - emacs_env *env = xmint_pointer (XCAR (tail)); - struct emacs_env_private *priv = env->private_members; - mark_object (priv->non_local_exit_symbol); - mark_object (priv->non_local_exit_data); - mark_object (priv->values); - } -} - /* Non-local exit handling. */ @@ -1175,8 +1160,7 @@ init_module_assertions (bool enable) /* If enabling module assertions, use a hidden environment for storing the globals. This environment is never freed. */ module_assertions = enable; - if (enable) - global_env = initialize_environment (NULL, &global_env_private); + initialize_storage (&global_storage); } static _Noreturn void @@ -1199,13 +1183,6 @@ module_abort (const char *format, ...) void syms_of_module (void) { - if (!plain_values) - { - ltv_mark = Fcons (Qnil, Qnil); - staticpro (<v_mark); - } - eassert (NILP (value_to_lisp (module_nil))); - DEFSYM (Qmodule_refs_hash, "module-refs-hash"); DEFVAR_LISP ("module-refs-hash", Vmodule_refs_hash, doc: /* Module global reference table. */); diff --git a/test/data/emacs-module/mod-test.c b/test/data/emacs-module/mod-test.c index 47ea159d0e..a39e41afee 100644 --- a/test/data/emacs-module/mod-test.c +++ b/test/data/emacs-module/mod-test.c @@ -94,7 +94,7 @@ Fmod_test_signal (emacs_env *env, ptrdiff_t nargs, emacs_value args[], assert (env->non_local_exit_check (env) == emacs_funcall_exit_return); env->non_local_exit_signal (env, env->intern (env, "error"), env->make_integer (env, 56)); - return env->intern (env, "nil"); + return NULL; } @@ -106,7 +106,7 @@ Fmod_test_throw (emacs_env *env, ptrdiff_t nargs, emacs_value args[], assert (env->non_local_exit_check (env) == emacs_funcall_exit_return); env->non_local_exit_throw (env, env->intern (env, "tag"), env->make_integer (env, 65)); - return env->intern (env, "nil"); + return NULL; } @@ -304,7 +304,7 @@ Fmod_test_invalid_finalizer (emacs_env *env, ptrdiff_t nargs, emacs_value *args, { current_env = env; env->make_user_ptr (env, invalid_finalizer, NULL); - return env->funcall (env, env->intern (env, "garbage-collect"), 0, NULL); + return env->intern (env, "nil"); } static void diff --git a/test/src/emacs-module-tests.el b/test/src/emacs-module-tests.el index e30980b599..35aaaa64b6 100644 --- a/test/src/emacs-module-tests.el +++ b/test/src/emacs-module-tests.el @@ -265,7 +265,8 @@ during garbage collection." (skip-unless (file-executable-p mod-test-emacs)) (module--test-assertion (rx "Module function called during garbage collection\n") - (mod-test-invalid-finalizer))) + (mod-test-invalid-finalizer) + (garbage-collect))) (ert-deftest module/describe-function-1 () "Check that Bug#30163 is fixed." commit 89fa7c4555f1c44c93ecdca23047bbfe3840cc33 Author: Federico Tedin Date: Tue Mar 12 21:34:31 2019 -0300 Correctly handle packages without description in describe-package * lisp/emacs-lisp/package.el (describe-package-1): Do not call insert if package description is nil (Bug#34147). diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 4c75fa1e72..61cf690697 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -2484,7 +2484,8 @@ The description is read from the installed package files." (insert ?\n))) (setq readme-string (buffer-string)) t) - (insert readme-string)) + (insert (or readme-string + "This package does not provide a description."))) )))) (defun package-install-button-action (button) commit a0b1c40233408f805eff6b440dbbe2bcba2994ee Author: Federico Tedin Date: Tue Mar 12 20:06:49 2019 -0300 Make edebug-eval-expression support code completion * lisp/emacs-lisp/edebug.el (edebug-eval-expression): Use read--expression instead of read-from-minibuffer. (Bug#34065) diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index 2cd8e48d6e..8b4cb1adc7 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -3602,9 +3602,7 @@ Return the result of the last expression." "Evaluate an expression in the outside environment. If interactive, prompt for the expression. Print result in minibuffer." - (interactive (list (read-from-minibuffer - "Eval: " nil read-expression-map t - 'read-expression-history))) + (interactive (list (read--expression "Eval: "))) (princ (edebug-outside-excursion (setq values (cons (edebug-eval expr) values)) commit 76fea1eba1332440eab2e3daecce053daccd3782 Author: Stefan Monnier Date: Thu Mar 21 23:55:28 2019 -0400 Fix misuses of NULL when talking about the NUL character * lisp/subr.el (inhibit-null-byte-detection): Make it an obsolete alias. * src/coding.c (setup_coding_system): Use new name. (detect_coding): Rename null_byte_found => nul_byte_found. (detect_coding_system): Use new name. Rename null_byte_found => nul_byte_found. (Fdefine_coding_system_internal): Use new name. (syms_of_coding): Rename inhibit-null-byte-detection to inhibit-nul-byte-detection. * src/w16select.c (get_clipboard_data): null_char => nul_char. * src/json.c (check_string_without_embedded_nuls): Rename from check_string_without_embedded_nulls. (Fjson_parse_string): Adjust accordingly. * src/coding.h (enum define_coding_undecided_arg_index) (enum coding_attr_index): ...null_byte... => ...nul_byte.... * lisp/info.el (info-insert-file-contents, Info-insert-dir): * lisp/international/mule.el (define-coding-system): * lisp/vc/vc-git.el (vc-git--call): * doc/lispref/nonascii.texi (Lisp and Coding Systems): Use the new name. diff --git a/doc/lispref/files.texi b/doc/lispref/files.texi index 7bc1cc454b..af16b1cf4b 100644 --- a/doc/lispref/files.texi +++ b/doc/lispref/files.texi @@ -550,7 +550,7 @@ the functions in the list @code{after-insert-file-functions}. (@pxref{Coding Systems}) used for decoding the file's contents, including end-of-line conversion. However, if the file contains null bytes, it is by default visited without any code conversions. -@xref{Lisp and Coding Systems, inhibit-null-byte-detection}. +@xref{Lisp and Coding Systems, inhibit-nul-byte-detection}. If @var{visit} is non-@code{nil}, this function additionally marks the buffer as unmodified and sets up various fields in the buffer so that it diff --git a/doc/lispref/nonascii.texi b/doc/lispref/nonascii.texi index 11a77bd147..9c64c3cf2c 100644 --- a/doc/lispref/nonascii.texi +++ b/doc/lispref/nonascii.texi @@ -1378,7 +1378,7 @@ operates on the contents of @var{string} instead of bytes in the buffer. @end defun @cindex null bytes, and decoding text -@defvar inhibit-null-byte-detection +@defvar inhibit-nul-byte-detection If this variable has a non-@code{nil} value, null bytes are ignored when detecting the encoding of a region or a string. This allows the encoding of text that contains null bytes to be correctly detected, diff --git a/doc/lispref/processes.texi b/doc/lispref/processes.texi index 7b02759b30..6be311b563 100644 --- a/doc/lispref/processes.texi +++ b/doc/lispref/processes.texi @@ -1789,7 +1789,7 @@ system comes from @code{coding-system-for-read}, if that is non-@code{nil}; or else from the defaulting mechanism (@pxref{Default Coding Systems}). If the text output by a process contains null bytes, Emacs by default uses @code{no-conversion} for it; see -@ref{Lisp and Coding Systems, inhibit-null-byte-detection}, for how to +@ref{Lisp and Coding Systems, inhibit-nul-byte-detection}, for how to control this behavior. @strong{Warning:} Coding systems such as @code{undecided}, which diff --git a/etc/NEWS b/etc/NEWS index 372d3cd70f..3380be75f9 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1354,6 +1354,9 @@ Now, such rx expressions generate an error. * Lisp Changes in Emacs 27.1 ++++ +** inhibit-null-byte-detection is renamed to inhibit-nul-byte-detection + +++ ** 'self-insert-command' takes the char to insert as (optional) argument. diff --git a/lisp/info.el b/lisp/info.el index c650d88257..f2a064abb6 100644 --- a/lisp/info.el +++ b/lisp/info.el @@ -642,14 +642,14 @@ Do the right thing if the file has been compressed or zipped." (insert-file-contents-literally fullname visit) (let ((inhibit-read-only t) (coding-system-for-write 'no-conversion) - (inhibit-null-byte-detection t) ; Index nodes include null bytes + (inhibit-nul-byte-detection t) ; Index nodes include null bytes (default-directory (or (file-name-directory fullname) default-directory))) (or (consp decoder) (setq decoder (list decoder))) (apply #'call-process-region (point-min) (point-max) (car decoder) t t nil (cdr decoder)))) - (let ((inhibit-null-byte-detection t)) ; Index nodes include null bytes + (let ((inhibit-nul-byte-detection t)) ; Index nodes include null bytes (insert-file-contents fullname visit))) ;; Clear the caches of modified Info files. @@ -1377,7 +1377,7 @@ is non-nil)." ;; Index nodes include null bytes. DIR ;; files should not have indices, but who ;; knows... - (let ((inhibit-null-byte-detection t)) + (let ((inhibit-nul-byte-detection t)) (insert-file-contents file) (setq Info-dir-file-name file) (push (current-buffer) buffers) diff --git a/lisp/international/mule.el b/lisp/international/mule.el index 281e5297d6..ba30fee496 100644 --- a/lisp/international/mule.el +++ b/lisp/international/mule.el @@ -819,10 +819,10 @@ VALUE is a CCL program name defined by `define-ccl-program'. The CCL program reads a character sequence and writes a byte sequence as an encoding result. -`:inhibit-null-byte-detection' +`:inhibit-nul-byte-detection' VALUE non-nil means Emacs ignore null bytes on code detection. -See the variable `inhibit-null-byte-detection'. This attribute +See the variable `inhibit-nul-byte-detection'. This attribute is meaningful only when `:coding-type' is `undecided'. `:inhibit-iso-escape-detection' @@ -867,7 +867,7 @@ non-ASCII files. This attribute is meaningful only when :ccl-encoder :valids)) ((eq coding-type 'undecided) - '(:inhibit-null-byte-detection + '(:inhibit-nul-byte-detection :inhibit-iso-escape-detection :prefer-utf-8)))))) @@ -920,8 +920,8 @@ non-ASCII files. This attribute is meaningful only when (cons :name (cons name (cons :docstring (cons (purecopy docstring) props))))) (setcdr (assq :plist common-attrs) props) - (apply 'define-coding-system-internal - name (mapcar 'cdr (append common-attrs spec-attrs))))) + (apply #'define-coding-system-internal + name (mapcar #'cdr (append common-attrs spec-attrs))))) (defun coding-system-doc-string (coding-system) "Return the documentation string for CODING-SYSTEM." diff --git a/lisp/subr.el b/lisp/subr.el index 6c0ad00afa..f48ca545c9 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -1511,6 +1511,8 @@ be a list of the form returned by `event-start' and `event-end'." (make-obsolete-variable 'x-gtk-use-window-move nil "26.1") (defvaralias 'messages-buffer-max-lines 'message-log-max) +(define-obsolete-variable-alias 'inhibit-null-byte-detection + 'inhibit-nul-byte-detection "27.1") ;;;; Alternate names for functions - these are not being phased out. diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el index 6b8ed7e2c1..0f8c9c836c 100644 --- a/lisp/vc/vc-git.el +++ b/lisp/vc/vc-git.el @@ -1629,9 +1629,9 @@ The difference to vc-do-command is that this function always invokes (defun vc-git--call (buffer command &rest args) ;; We don't need to care the arguments. If there is a file name, it ;; is always a relative one. This works also for remote - ;; directories. We enable `inhibit-null-byte-detection', otherwise + ;; directories. We enable `inhibit-nul-byte-detection', otherwise ;; Tramp's eol conversion might be confused. - (let ((inhibit-null-byte-detection t) + (let ((inhibit-nul-byte-detection t) (coding-system-for-read (or coding-system-for-read vc-git-log-output-coding-system)) (coding-system-for-write diff --git a/src/alloc.c b/src/alloc.c index 8fb514f78f..f929a37271 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -1814,7 +1814,7 @@ static char const string_overrun_cookie[GC_STRING_OVERRUN_COOKIE_SIZE] = #define GC_STRING_EXTRA (GC_STRING_OVERRUN_COOKIE_SIZE) /* Exact bound on the number of bytes in a string, not counting the - terminating null. A string cannot contain more bytes than + terminating NUL. A string cannot contain more bytes than STRING_BYTES_BOUND, nor can it be so long that the size_t arithmetic in allocate_string_data would overflow while it is calculating a value to be passed to malloc. */ diff --git a/src/bidi.c b/src/bidi.c index a62b888432..c530d49c10 100644 --- a/src/bidi.c +++ b/src/bidi.c @@ -2335,7 +2335,7 @@ bidi_resolve_weak (struct bidi_it *bidi_it) and make it L right away, to avoid the potentially costly loop below. This is important when the buffer has a long series of - control characters, like binary nulls, and no + control characters, like binary NULs, and no R2L characters at all. */ && new_level == 0 && !bidi_explicit_dir_char (bidi_it->ch) @@ -2993,7 +2993,7 @@ bidi_resolve_neutral (struct bidi_it *bidi_it) } /* The next two "else if" clauses are shortcuts for the important special case when we have a long sequence of - neutral or WEAK_BN characters, such as whitespace or nulls or + neutral or WEAK_BN characters, such as whitespace or NULs or other control characters, on the base embedding level of the paragraph, and that sequence goes all the way to the end of the paragraph and follows a character whose resolved diff --git a/src/bignum.c b/src/bignum.c index 14c4cdb82a..4118601e10 100644 --- a/src/bignum.c +++ b/src/bignum.c @@ -271,7 +271,7 @@ bignum_to_uintmax (Lisp_Object x) /* Yield an upper bound on the buffer size needed to contain a C string representing the NUM in base BASE. This includes any - preceding '-' and the terminating null. */ + preceding '-' and the terminating NUL. */ static ptrdiff_t mpz_bufsize (mpz_t const num, int base) { @@ -336,7 +336,7 @@ bignum_to_string (Lisp_Object num, int base) /* Create a bignum by scanning NUM, with digits in BASE. NUM must consist of an optional '-', a nonempty sequence - of base-BASE digits, and a terminating null byte, and + of base-BASE digits, and a terminating NUL byte, and the represented number must not be in fixnum range. */ Lisp_Object diff --git a/src/callint.c b/src/callint.c index 9993e732fb..88a3c348d0 100644 --- a/src/callint.c +++ b/src/callint.c @@ -714,7 +714,7 @@ invoke it. If KEYS is omitted or nil, the return value of default: { /* How many bytes are left unprocessed in the specs string? - (Note that this excludes the trailing null byte.) */ + (Note that this excludes the trailing NUL byte.) */ ptrdiff_t bytes_left = string_len - (tem - string); unsigned letter; diff --git a/src/coding.c b/src/coding.c index a216460fc2..905c7ced84 100644 --- a/src/coding.c +++ b/src/coding.c @@ -5719,7 +5719,7 @@ setup_coding_system (Lisp_Object coding_system, struct coding_system *coding) coding->common_flags |= CODING_REQUIRE_DETECTION_MASK; coding->spec.undecided.inhibit_nbd = (encode_inhibit_flag - (AREF (attrs, coding_attr_undecided_inhibit_null_byte_detection))); + (AREF (attrs, coding_attr_undecided_inhibit_nul_byte_detection))); coding->spec.undecided.inhibit_ied = (encode_inhibit_flag (AREF (attrs, coding_attr_undecided_inhibit_iso_escape_detection))); @@ -6514,9 +6514,9 @@ detect_coding (struct coding_system *coding) { int c, i; struct coding_detection_info detect_info; - bool null_byte_found = 0, eight_bit_found = 0; + bool nul_byte_found = 0, eight_bit_found = 0; bool inhibit_nbd = inhibit_flag (coding->spec.undecided.inhibit_nbd, - inhibit_null_byte_detection); + inhibit_nul_byte_detection); bool inhibit_ied = inhibit_flag (coding->spec.undecided.inhibit_ied, inhibit_iso_escape_detection); bool prefer_utf_8 = coding->spec.undecided.prefer_utf_8; @@ -6529,7 +6529,7 @@ detect_coding (struct coding_system *coding) if (c & 0x80) { eight_bit_found = 1; - if (null_byte_found) + if (nul_byte_found) break; } else if (c < 0x20) @@ -6544,7 +6544,7 @@ detect_coding (struct coding_system *coding) if (! (detect_info.rejected & CATEGORY_MASK_ISO_7_ELSE)) { /* We didn't find an 8-bit code. We may - have found a null-byte, but it's very + have found a NUL-byte, but it's very rare that a binary file conforms to ISO-2022. */ src = src_end; @@ -6556,7 +6556,7 @@ detect_coding (struct coding_system *coding) } else if (! c && !inhibit_nbd) { - null_byte_found = 1; + nul_byte_found = 1; if (eight_bit_found) break; } @@ -6588,7 +6588,7 @@ detect_coding (struct coding_system *coding) coding->head_ascii++; } - if (null_byte_found || eight_bit_found + if (nul_byte_found || eight_bit_found || coding->head_ascii < coding->src_bytes || detect_info.found) { @@ -6606,7 +6606,7 @@ detect_coding (struct coding_system *coding) } else { - if (null_byte_found) + if (nul_byte_found) { detect_info.checked |= ~CATEGORY_MASK_UTF_16; detect_info.rejected |= ~CATEGORY_MASK_UTF_16; @@ -6679,7 +6679,7 @@ detect_coding (struct coding_system *coding) else found = CODING_ID_NAME (this->id); } - else if (null_byte_found) + else if (nul_byte_found) found = Qno_conversion; else if ((detect_info.rejected & CATEGORY_MASK_ANY) == CATEGORY_MASK_ANY) @@ -8448,7 +8448,7 @@ from_unicode (Lisp_Object str) Lisp_Object from_unicode_buffer (const wchar_t *wstr) { - /* We get one of the two final null bytes for free. */ + /* We get one of the two final NUL bytes for free. */ ptrdiff_t len = 1 + sizeof (wchar_t) * wcslen (wstr); AUTO_STRING_WITH_LEN (str, (char *) wstr, len); return from_unicode (str); @@ -8461,7 +8461,7 @@ to_unicode (Lisp_Object str, Lisp_Object *buf) /* We need to make another copy (in addition to the one made by code_convert_string_norecord) to ensure that the final string is _doubly_ zero terminated --- that is, that the string is - terminated by two zero bytes and one utf-16le null character. + terminated by two zero bytes and one utf-16le NUL character. Because strings are already terminated with a single zero byte, we just add one additional zero. */ str = make_uninit_string (SBYTES (*buf) + 1); @@ -8577,7 +8577,7 @@ detect_coding_system (const unsigned char *src, ptrdiff_t id; struct coding_detection_info detect_info; enum coding_category base_category; - bool null_byte_found = 0, eight_bit_found = 0; + bool nul_byte_found = 0, eight_bit_found = 0; if (NILP (coding_system)) coding_system = Qundecided; @@ -8604,7 +8604,7 @@ detect_coding_system (const unsigned char *src, struct coding_system *this UNINIT; int c, i; bool inhibit_nbd = inhibit_flag (coding.spec.undecided.inhibit_nbd, - inhibit_null_byte_detection); + inhibit_nul_byte_detection); bool inhibit_ied = inhibit_flag (coding.spec.undecided.inhibit_ied, inhibit_iso_escape_detection); bool prefer_utf_8 = coding.spec.undecided.prefer_utf_8; @@ -8616,7 +8616,7 @@ detect_coding_system (const unsigned char *src, if (c & 0x80) { eight_bit_found = 1; - if (null_byte_found) + if (nul_byte_found) break; } else if (c < 0x20) @@ -8631,7 +8631,7 @@ detect_coding_system (const unsigned char *src, if (! (detect_info.rejected & CATEGORY_MASK_ISO_7_ELSE)) { /* We didn't find an 8-bit code. We may - have found a null-byte, but it's very + have found a NUL-byte, but it's very rare that a binary file confirm to ISO-2022. */ src = src_end; @@ -8643,7 +8643,7 @@ detect_coding_system (const unsigned char *src, } else if (! c && !inhibit_nbd) { - null_byte_found = 1; + nul_byte_found = 1; if (eight_bit_found) break; } @@ -8654,7 +8654,7 @@ detect_coding_system (const unsigned char *src, coding.head_ascii++; } - if (null_byte_found || eight_bit_found + if (nul_byte_found || eight_bit_found || coding.head_ascii < coding.src_bytes || detect_info.found) { @@ -8669,7 +8669,7 @@ detect_coding_system (const unsigned char *src, } else { - if (null_byte_found) + if (nul_byte_found) { detect_info.checked |= ~CATEGORY_MASK_UTF_16; detect_info.rejected |= ~CATEGORY_MASK_UTF_16; @@ -8716,7 +8716,7 @@ detect_coding_system (const unsigned char *src, } if ((detect_info.rejected & CATEGORY_MASK_ANY) == CATEGORY_MASK_ANY - || null_byte_found) + || nul_byte_found) { detect_info.found = CATEGORY_MASK_RAW_TEXT; id = CODING_SYSTEM_ID (Qno_conversion); @@ -8818,7 +8818,7 @@ detect_coding_system (const unsigned char *src, { if (detect_info.found & ~CATEGORY_MASK_UTF_16) { - if (null_byte_found) + if (nul_byte_found) normal_eol = EOL_SEEN_LF; else normal_eol = detect_eol (coding.source, src_bytes, @@ -10478,8 +10478,8 @@ usage: (define-coding-system-internal ...) */) { if (nargs < coding_arg_undecided_max) goto short_args; - ASET (attrs, coding_attr_undecided_inhibit_null_byte_detection, - args[coding_arg_undecided_inhibit_null_byte_detection]); + ASET (attrs, coding_attr_undecided_inhibit_nul_byte_detection, + args[coding_arg_undecided_inhibit_nul_byte_detection]); ASET (attrs, coding_attr_undecided_inhibit_iso_escape_detection, args[coding_arg_undecided_inhibit_iso_escape_detection]); ASET (attrs, coding_attr_undecided_prefer_utf_8, @@ -11234,18 +11234,18 @@ to explicitly specify some coding system that doesn't use ISO-2022 escape sequence (e.g., `latin-1') on reading by \\[universal-coding-system-argument]. */); inhibit_iso_escape_detection = 0; - DEFVAR_BOOL ("inhibit-null-byte-detection", - inhibit_null_byte_detection, - doc: /* If non-nil, Emacs ignores null bytes on code detection. + DEFVAR_BOOL ("inhibit-nul-byte-detection", + inhibit_nul_byte_detection, + doc: /* If non-nil, Emacs ignores NUL bytes on code detection. By default, Emacs treats it as binary data, and does not attempt to decode it. The effect is as if you specified `no-conversion' for reading that text. -Set this to non-nil when a regular text happens to include null bytes. -Examples are Index nodes of Info files and null-byte delimited output -from GNU Find and GNU Grep. Emacs will then ignore the null bytes and +Set this to non-nil when a regular text happens to include NUL bytes. +Examples are Index nodes of Info files and NUL-byte delimited output +from GNU Find and GNU Grep. Emacs will then ignore the NUL bytes and decode text as usual. */); - inhibit_null_byte_detection = 0; + inhibit_nul_byte_detection = 0; DEFVAR_BOOL ("disable-ascii-optimization", disable_ascii_optimization, doc: /* If non-nil, Emacs does not optimize code decoder for ASCII files. @@ -11304,7 +11304,7 @@ internal character representation. */); "automatic conversion on decoding."); plist[15] = args[coding_arg_eol_type] = Qnil; args[coding_arg_plist] = CALLMANY (Flist, plist); - args[coding_arg_undecided_inhibit_null_byte_detection] = make_fixnum (0); + args[coding_arg_undecided_inhibit_nul_byte_detection] = make_fixnum (0); args[coding_arg_undecided_inhibit_iso_escape_detection] = make_fixnum (0); Fdefine_coding_system_internal (coding_arg_undecided_max, args); diff --git a/src/coding.h b/src/coding.h index 58e12d6176..e38c0ee396 100644 --- a/src/coding.h +++ b/src/coding.h @@ -82,7 +82,7 @@ enum define_coding_ccl_arg_index enum define_coding_undecided_arg_index { - coding_arg_undecided_inhibit_null_byte_detection = coding_arg_max, + coding_arg_undecided_inhibit_nul_byte_detection = coding_arg_max, coding_arg_undecided_inhibit_iso_escape_detection, coding_arg_undecided_prefer_utf_8, coding_arg_undecided_max @@ -137,7 +137,7 @@ enum coding_attr_index coding_attr_emacs_mule_full, - coding_attr_undecided_inhibit_null_byte_detection, + coding_attr_undecided_inhibit_nul_byte_detection, coding_attr_undecided_inhibit_iso_escape_detection, coding_attr_undecided_prefer_utf_8, @@ -351,7 +351,7 @@ struct emacs_mule_spec struct undecided_spec { - /* Inhibit null byte detection. 1 means always inhibit, + /* Inhibit NUL byte detection. 1 means always inhibit, -1 means do not inhibit, 0 means rely on user variable. */ int inhibit_nbd; diff --git a/src/dired.c b/src/dired.c index 17a21b07e3..493758292b 100644 --- a/src/dired.c +++ b/src/dired.c @@ -930,7 +930,7 @@ file_attributes (int fd, char const *name, struct stat s; /* An array to hold the mode string generated by filemodestring, - including its terminating space and null byte. */ + including its terminating space and NUL byte. */ char modes[sizeof "-rwxr-xr-x "]; char *uname = NULL, *gname = NULL; diff --git a/src/dispextern.h b/src/dispextern.h index 894753669d..7947dc2dba 100644 --- a/src/dispextern.h +++ b/src/dispextern.h @@ -1937,7 +1937,7 @@ struct bidi_string_data { Lisp_Object lstring; /* Lisp string to reorder, or nil */ const unsigned char *s; /* string data, or NULL if reordering buffer */ ptrdiff_t schars; /* the number of characters in the string, - excluding the terminating null */ + excluding the terminating NUL */ ptrdiff_t bufpos; /* buffer position of lstring, or 0 if N/A */ bool_bf from_disp_str : 1; /* True means the string comes from a display property */ diff --git a/src/doc.c b/src/doc.c index 3e43d6db06..372e376c62 100644 --- a/src/doc.c +++ b/src/doc.c @@ -233,7 +233,7 @@ get_doc_string (Lisp_Object filepos, bool unibyte, bool definition) } /* Scan the text and perform quoting with ^A (char code 1). - ^A^A becomes ^A, ^A0 becomes a null char, and ^A_ becomes a ^_. */ + ^A^A becomes ^A, ^A0 becomes a NUL char, and ^A_ becomes a ^_. */ from = get_doc_string_buffer + offset; to = get_doc_string_buffer + offset; while (from != p) diff --git a/src/doprnt.c b/src/doprnt.c index d0c703398f..5fb7063404 100644 --- a/src/doprnt.c +++ b/src/doprnt.c @@ -35,7 +35,7 @@ along with GNU Emacs. If not, see . */ sequence. . It accepts a pointer to the end of the format string, so the format string - could include embedded null characters. + could include embedded NUL characters. . It signals an error if the length of the formatted string is about to overflow ptrdiff_t or size_t, to avoid producing strings longer than what @@ -123,7 +123,7 @@ along with GNU Emacs. If not, see . */ to fit and return BUFSIZE - 1; if this truncates a multibyte sequence, store '\0' into the sequence's first byte. Returns the number of bytes stored into BUFFER, excluding - the terminating null byte. Output is always null-terminated. + the terminating NUL byte. Output is always NUL-terminated. String arguments are passed as C strings. Integers are passed as C integers. */ diff --git a/src/editfns.c b/src/editfns.c index d6ad7474fe..ac9b871835 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -3086,7 +3086,7 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message) : FLT_RADIX == 16 ? 4 : -1)), - /* Maximum number of bytes (including terminating null) generated + /* Maximum number of bytes (including terminating NUL) generated by any format, if precision is no more than USEFUL_PRECISION_MAX. On all practical hosts, %Lf is the worst case. */ SPRINTF_BUFSIZE = (sizeof "-." + (LDBL_MAX_10_EXP + 1) diff --git a/src/emacs-module.c b/src/emacs-module.c index 4e2411cb29..530a8ebefe 100644 --- a/src/emacs-module.c +++ b/src/emacs-module.c @@ -584,7 +584,7 @@ module_make_string (emacs_env *env, const char *str, ptrdiff_t length) MODULE_FUNCTION_BEGIN (module_nil); if (! (0 <= length && length <= STRING_BYTES_BOUND)) overflow_error (); - /* FIXME: AUTO_STRING_WITH_LEN requires STR to be null-terminated, + /* FIXME: AUTO_STRING_WITH_LEN requires STR to be NUL-terminated, but we shouldn't require that. */ AUTO_STRING_WITH_LEN (lstr, str, length); return lisp_to_value (env, diff --git a/src/emacs.c b/src/emacs.c index e16e230b4a..68835cac98 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -2639,7 +2639,7 @@ decode_env_path (const char *evarname, const char *defalt, bool empty) } } else if (cnv_result != 0 && d > path_utf8) - d[-1] = '\0'; /* remove last semi-colon and null-terminate PATH */ + d[-1] = '\0'; /* remove last semi-colon and NUL-terminate PATH */ } while (q); path_copy = path_utf8; #else /* MSDOS */ diff --git a/src/fileio.c b/src/fileio.c index 7b9446c7e1..4ee125d7de 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -1639,7 +1639,7 @@ file_name_absolute_p (const char *filename) } /* Put into BUF the concatenation of DIR and FILE, with an intervening - directory separator if needed. Return a pointer to the null byte + directory separator if needed. Return a pointer to the NUL byte at the end of the concatenated string. */ char * splice_dir_file (char *buf, char const *dir, char const *file) diff --git a/src/filelock.c b/src/filelock.c index 64310f5c53..5cec199620 100644 --- a/src/filelock.c +++ b/src/filelock.c @@ -296,7 +296,7 @@ typedef struct /* Write the name of the lock file for FNAME into LOCKNAME. Length will be that of FNAME plus two more for the leading ".#", plus one - for the null. */ + for the NUL. */ #define MAKE_LOCK_NAME(lockname, fname) \ (lockname = SAFE_ALLOCA (SBYTES (fname) + 2 + 1), \ fill_in_lock_file_name (lockname, fname)) diff --git a/src/fns.c b/src/fns.c index 6573124a93..b97b132b0f 100644 --- a/src/fns.c +++ b/src/fns.c @@ -412,7 +412,7 @@ Symbols are also allowed; their print names are used instead. */) while ((cmp = filevercmp (p1, p2)) == 0) { - /* If the strings are identical through their first null bytes, + /* If the strings are identical through their first NUL bytes, skip past identical prefixes and try again. */ ptrdiff_t size = strlen (p1) + 1; p1 += size; diff --git a/src/font.c b/src/font.c index 9220fb1cd2..5ca89c97dc 100644 --- a/src/font.c +++ b/src/font.c @@ -1007,7 +1007,7 @@ font_expand_wildcards (Lisp_Object *field, int n) } -/* Parse NAME (null terminated) as XLFD and store information in FONT +/* Parse NAME (NUL terminated) as XLFD and store information in FONT (font-spec or font-entity). Size property of FONT is set as follows: specified XLFD fields FONT property @@ -1353,7 +1353,7 @@ font_unparse_xlfd (Lisp_Object font, int pixel_size, char *name, int nbytes) return len < nbytes ? len : -1; } -/* Parse NAME (null terminated) and store information in FONT +/* Parse NAME (NUL terminated) and store information in FONT (font-spec or font-entity). NAME is supplied in either the Fontconfig or GTK font name format. If NAME is successfully parsed, return 0. Otherwise return -1. @@ -1725,7 +1725,7 @@ font_unparse_fcname (Lisp_Object font, int pixel_size, char *name, int nbytes) #endif -/* Parse NAME (null terminated) and store information in FONT +/* Parse NAME (NUL terminated) and store information in FONT (font-spec or font-entity). If NAME is successfully parsed, return 0. Otherwise return -1. */ diff --git a/src/insdel.c b/src/insdel.c index fd725ac878..1231bb2682 100644 --- a/src/insdel.c +++ b/src/insdel.c @@ -708,7 +708,7 @@ insert_char (int c) insert ((char *) str, len); } -/* Insert the null-terminated string S before point. */ +/* Insert the NUL-terminated string S before point. */ void insert_string (const char *s) diff --git a/src/json.c b/src/json.c index b5fb3fee05..5e1439f881 100644 --- a/src/json.c +++ b/src/json.c @@ -229,7 +229,7 @@ json_make_string (const char *data, ptrdiff_t size) Qutf_8_unix, Qt, false, true, true); } -/* Create a multibyte Lisp string from the null-terminated UTF-8 +/* Create a multibyte Lisp string from the NUL-terminated UTF-8 string beginning at DATA. If the string is not a valid UTF-8 string, an unspecified string is returned. Note that all callers below either pass only value UTF-8 strings or use this function for @@ -301,10 +301,10 @@ json_release_object (void *object) } /* Signal an error if OBJECT is not a string, or if OBJECT contains - embedded null characters. */ + embedded NUL characters. */ static void -check_string_without_embedded_nulls (Lisp_Object object) +check_string_without_embedded_nuls (Lisp_Object object) { CHECK_STRING (object); CHECK_TYPE (memchr (SDATA (object), '\0', SBYTES (object)) == NULL, @@ -381,8 +381,8 @@ lisp_to_json_toplevel_1 (Lisp_Object lisp, { Lisp_Object key = json_encode (HASH_KEY (h, i)); /* We can't specify the length, so the string must be - null-terminated. */ - check_string_without_embedded_nulls (key); + NUL-terminated. */ + check_string_without_embedded_nuls (key); const char *key_str = SSDATA (key); /* Reject duplicate keys. These are possible if the hash table test is not `equal'. */ @@ -432,8 +432,8 @@ lisp_to_json_toplevel_1 (Lisp_Object lisp, CHECK_SYMBOL (key_symbol); Lisp_Object key = SYMBOL_NAME (key_symbol); /* We can't specify the length, so the string must be - null-terminated. */ - check_string_without_embedded_nulls (key); + NUL-terminated. */ + check_string_without_embedded_nuls (key); key_str = SSDATA (key); /* In plists, ensure leading ":" in keys is stripped. It will be reconstructed later in `json_to_lisp'.*/ @@ -568,7 +568,7 @@ false values, t, numbers, strings, or other vectors hashtables, alists or plists. t will be converted to the JSON true value. Vectors will be converted to JSON arrays, whereas hashtables, alists and plists are converted to JSON objects. Hashtable keys must be strings without -embedded null characters and must be unique within each object. Alist +embedded NUL characters and must be unique within each object. Alist and plist keys must be symbols; if a key is duplicate, the first instance is used. @@ -945,7 +945,7 @@ usage: (json-parse-string STRING &rest ARGS) */) Lisp_Object string = args[0]; Lisp_Object encoded = json_encode (string); - check_string_without_embedded_nulls (encoded); + check_string_without_embedded_nuls (encoded); struct json_configuration conf = {json_object_hashtable, QCnull, QCfalse}; json_parse_args (nargs - 1, args + 1, &conf, true); diff --git a/src/keyboard.c b/src/keyboard.c index 362bd66387..8fb6db987b 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -737,7 +737,8 @@ void force_auto_save_soon (void) { last_auto_save = - auto_save_interval - 1; - + /* FIXME: What's the relationship between forcing auto-save and adding + a buffer-switch event? */ record_asynch_buffer_change (); } #endif @@ -6191,7 +6192,7 @@ parse_modifiers_uncached (Lisp_Object symbol, ptrdiff_t *modifier_end) static Lisp_Object apply_modifiers_uncached (int modifiers, char *base, int base_len, int base_len_byte) { - /* Since BASE could contain nulls, we can't use intern here; we have + /* Since BASE could contain NULs, we can't use intern here; we have to use Fintern, which expects a genuine Lisp_String, and keeps a reference to it. */ char new_mods[sizeof "A-C-H-M-S-s-up-down-drag-double-triple-"]; diff --git a/src/lisp.h b/src/lisp.h index 8ec892f17b..c33c311b4a 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -1530,11 +1530,11 @@ STRING_MULTIBYTE (Lisp_Object str) } /* An upper bound on the number of bytes in a Lisp string, not - counting the terminating null. This a tight enough bound to + counting the terminating NUL. This a tight enough bound to prevent integer overflow errors that would otherwise occur during string size calculations. A string cannot contain more bytes than a fixnum can represent, nor can it be so long that C pointer - arithmetic stops working on the string plus its terminating null. + arithmetic stops working on the string plus its terminating NUL. Although the actual size limit (see STRING_BYTES_MAX in alloc.c) may be a bit smaller than STRING_BYTES_BOUND, calculating it here would expose alloc.c internal details that we'd rather keep @@ -3045,7 +3045,7 @@ CHECK_INTEGER (Lisp_Object x) /* Define a built-in function for calling from Lisp. `lname' should be the name to give the function in Lisp, - as a null-terminated C string. + as a NUL-terminated C string. `fnname' should be the name of the function in C. By convention, it starts with F. `sname' should be the name for the C constant structure @@ -4729,7 +4729,7 @@ extern char *xlispstrdup (Lisp_Object) ATTRIBUTE_MALLOC; extern void dupstring (char **, char const *); /* Make DEST a copy of STRING's data. Return a pointer to DEST's terminating - null byte. This is like stpcpy, except the source is a Lisp string. */ + NUL byte. This is like stpcpy, except the source is a Lisp string. */ INLINE char * lispstpcpy (char *dest, Lisp_Object string) @@ -4933,7 +4933,7 @@ enum : list4 (a, b, c, d)) /* Declare NAME as an auto Lisp string if possible, a GC-based one if not. - Take its unibyte value from the null-terminated string STR, + Take its unibyte value from the NUL-terminated string STR, an expression that should not have side effects. STR's value is not necessarily copied. The resulting Lisp string should not be modified or given text properties or made visible to @@ -4943,8 +4943,8 @@ enum AUTO_STRING_WITH_LEN (name, str, strlen (str)) /* Declare NAME as an auto Lisp string if possible, a GC-based one if not. - Take its unibyte value from the null-terminated string STR with length LEN. - STR may have side effects and may contain null bytes. + Take its unibyte value from the NUL-terminated string STR with length LEN. + STR may have side effects and may contain NUL bytes. STR's value is not necessarily copied. The resulting Lisp string should not be modified or given text properties or made visible to user code. */ diff --git a/src/lread.c b/src/lread.c index 8b0d693daf..2d64b638ff 100644 --- a/src/lread.c +++ b/src/lread.c @@ -2659,7 +2659,7 @@ free_contents (void *p) static Lisp_Object read_integer (Lisp_Object readcharfun, EMACS_INT radix) { - /* Room for sign, leading 0, other digits, trailing null byte. + /* Room for sign, leading 0, other digits, trailing NUL byte. Also, room for invalid syntax diagnostic. */ size_t len = max (1 + 1 + UINTMAX_WIDTH + 1, sizeof "integer, radix " + INT_STRLEN_BOUND (EMACS_INT)); diff --git a/src/module-env-25.h b/src/module-env-25.h index 675010b995..d8f8eb6811 100644 --- a/src/module-env-25.h +++ b/src/module-env-25.h @@ -88,13 +88,13 @@ EMACS_ATTRIBUTE_NONNULL(1); /* Copy the content of the Lisp string VALUE to BUFFER as an utf8 - null-terminated string. + NUL-terminated string. SIZE must point to the total size of the buffer. If BUFFER is NULL or if SIZE is not big enough, write the required buffer size to SIZE and return true. - Note that SIZE must include the last null byte (e.g. "abc" needs + Note that SIZE must include the last NUL byte (e.g. "abc" needs a buffer of size 4). Return true if the string was successfully copied. */ diff --git a/src/syntax.c b/src/syntax.c index 5c38e92026..edfdae2259 100644 --- a/src/syntax.c +++ b/src/syntax.c @@ -3477,10 +3477,7 @@ internalize_parse_state (Lisp_Object external, struct lisp_parse_state *state) else { tem = Fcar (external); - if (!NILP (tem)) - state->depth = XFIXNUM (tem); - else - state->depth = 0; + state->depth = FIXNUMP (tem) ? XFIXNUM (tem) : 0; external = Fcdr (external); external = Fcdr (external); diff --git a/src/sysdep.c b/src/sysdep.c index fe5a44ea2d..57ea8220ca 100644 --- a/src/sysdep.c +++ b/src/sysdep.c @@ -257,12 +257,12 @@ get_current_dir_name_or_unreachable (void) char *pwd; - /* The maximum size of a directory name, including the terminating null. + /* The maximum size of a directory name, including the terminating NUL. Leave room so that the caller can append a trailing slash. */ ptrdiff_t dirsize_max = min (PTRDIFF_MAX, SIZE_MAX) - 1; /* The maximum size of a buffer for a file name, including the - terminating null. This is bounded by MAXPATHLEN, if available. */ + terminating NUL. This is bounded by MAXPATHLEN, if available. */ ptrdiff_t bufsize_max = dirsize_max; #ifdef MAXPATHLEN bufsize_max = min (bufsize_max, MAXPATHLEN); @@ -3435,7 +3435,7 @@ system_process_attributes (Lisp_Object pid) if (nread) { - /* We don't want trailing null characters. */ + /* We don't want trailing NUL characters. */ for (p = cmdline + nread; cmdline < p && !p[-1]; p--) continue; diff --git a/src/termcap.c b/src/termcap.c index 9e081baa62..7dc0d57288 100644 --- a/src/termcap.c +++ b/src/termcap.c @@ -162,7 +162,7 @@ tgetst1 (char *ptr, char **area) else ret = *area; - /* Copy the string value, stopping at null or colon. + /* Copy the string value, stopping at NUL or colon. Also process ^ and \ abbreviations. */ p = ptr; r = ret; @@ -424,7 +424,7 @@ tgetent (char *bp, const char *name) return -1; buf.size = BUFSIZE; - /* Add 1 to size to ensure room for terminating null. */ + /* Add 1 to size to ensure room for terminating NUL. */ buf.beg = xmalloc (buf.size + 1); term = indirect ? indirect : (char *)name; @@ -480,7 +480,7 @@ tgetent (char *bp, const char *name) *bp1 = '\0'; /* Does this entry refer to another terminal type's entry? - If something is found, copy it into heap and null-terminate it. */ + If something is found, copy it into heap and NUL-terminate it. */ tc_search_point = find_capability (tc_search_point, "tc"); term = tgetst1 (tc_search_point, 0); } @@ -618,7 +618,7 @@ gobble_line (int fd, register struct termcap_buffer *bufp, char *append_end) { ptrdiff_t ptr_offset = bufp->ptr - buf; ptrdiff_t append_end_offset = append_end - buf; - /* Add 1 to size to ensure room for terminating null. */ + /* Add 1 to size to ensure room for terminating NUL. */ ptrdiff_t size = bufp->size + 1; bufp->beg = buf = xpalloc (buf, &size, 1, -1, 1); bufp->size = size - 1; diff --git a/src/timefns.c b/src/timefns.c index 5beeaf57a2..514fa24f8b 100644 --- a/src/timefns.c +++ b/src/timefns.c @@ -1133,7 +1133,7 @@ or (if you need time as a string) `format-time-string'. */) determine how many bytes would be written, use NULL for S and ((size_t) -1) for MAXSIZE. - This function behaves like nstrftime, except it allows null + This function behaves like nstrftime, except it allows NUL bytes in FORMAT and it does not support nanoseconds. */ static size_t emacs_nmemftime (char *s, size_t maxsize, const char *format, @@ -1141,8 +1141,8 @@ emacs_nmemftime (char *s, size_t maxsize, const char *format, { size_t total = 0; - /* Loop through all the null-terminated strings in the format - argument. Normally there's just one null-terminated string, but + /* Loop through all the NUL-terminated strings in the format + argument. Normally there's just one NUL-terminated string, but there can be arbitrarily many, concatenated together, if the format contains '\0' bytes. nstrftime stops at the first '\0' byte so we must invoke it separately for each such string. */ diff --git a/src/unexmacosx.c b/src/unexmacosx.c index 53a30e3627..a94c0cccb6 100644 --- a/src/unexmacosx.c +++ b/src/unexmacosx.c @@ -447,7 +447,7 @@ unexec_regions_recorder (task_t task, void *rr, unsigned type, while (num && num_unexec_regions < MAX_UNEXEC_REGIONS) { - /* Subtract the size of trailing null bytes from filesize. It + /* Subtract the size of trailing NUL bytes from filesize. It can be smaller than vmsize in segment commands. In such a case, trailing bytes are initialized with zeros. */ for (p = ranges->address + ranges->size; p > ranges->address; p--) diff --git a/src/w16select.c b/src/w16select.c index b935b9f4f5..3eb219954a 100644 --- a/src/w16select.c +++ b/src/w16select.c @@ -220,7 +220,7 @@ set_clipboard_data (unsigned Format, void *Data, unsigned Size, int Raw) /* need to know final size after '\r' chars are inserted (the standard CF_OEMTEXT clipboard format uses CRLF line endings, while Emacs uses just LF internally). */ - truelen = Size + 1; /* +1 for the terminating null */ + truelen = Size + 1; /* +1 for the terminating NUL */ if (!Raw) { @@ -243,7 +243,7 @@ set_clipboard_data (unsigned Format, void *Data, unsigned Size, int Raw) { dosmemput (Data, Size, xbuf_addr); - /* Terminate with a null, otherwise Windows does strange things + /* Terminate with a NUL, otherwise Windows does strange things when the text size is an integral multiple of 32 bytes. */ _farpokeb (_dos_ds, xbuf_addr + Size, '\0'); } @@ -255,7 +255,7 @@ set_clipboard_data (unsigned Format, void *Data, unsigned Size, int Raw) while (Size--) { /* Don't allow them to put binary data into the clipboard, since - it will cause yanked data to be truncated at the first null. */ + it will cause yanked data to be truncated at the first NUL. */ if (*dp == '\0') return 2; if (*dp == '\n') @@ -263,7 +263,7 @@ set_clipboard_data (unsigned Format, void *Data, unsigned Size, int Raw) _farnspokeb (buf_offset++, *dp++); } - /* Terminate with a null, otherwise Windows does strange things + /* Terminate with a NUL, otherwise Windows does strange things when the text size is an integral multiple of 32 bytes. */ _farnspokeb (buf_offset, '\0'); } @@ -354,13 +354,13 @@ get_clipboard_data (unsigned Format, void *Data, unsigned Size, int Raw) __dpmi_int (0x2f, ®s); if (regs.x.ax != 0) { - unsigned char null_char = '\0'; + unsigned char nul_char = '\0'; unsigned long xbuf_beg = xbuf_addr; /* If last_clipboard_text is NULL, we don't want to slow down the next loop by an additional test. */ register unsigned char *lcdp = - last_clipboard_text == NULL ? &null_char : last_clipboard_text; + last_clipboard_text == NULL ? &nul_char : last_clipboard_text; /* Copy data from low memory, remove CR characters before LF if needed. */ @@ -383,7 +383,7 @@ get_clipboard_data (unsigned Format, void *Data, unsigned Size, int Raw) /* Windows reportedly rounds up the size of clipboard data (passed in SIZE) to a multiple of 32, and removes trailing spaces from each line without updating SIZE. We therefore - bail out when we see the first null character. */ + bail out when we see the first NUL character. */ else if (c == '\0') break; } @@ -392,7 +392,7 @@ get_clipboard_data (unsigned Format, void *Data, unsigned Size, int Raw) last time set_clipboard_data was called, pretend there's no data in the clipboard. This is so we don't pass our own text from the clipboard (which might be troublesome if the killed - text includes null characters). */ + text includes NUL characters). */ if (last_clipboard_text && xbuf_addr - xbuf_beg == (long)(lcdp - last_clipboard_text)) dp = (unsigned char *)Data + 1; diff --git a/src/w32.c b/src/w32.c index f3e88afd5b..082a66b738 100644 --- a/src/w32.c +++ b/src/w32.c @@ -5941,7 +5941,7 @@ is_symlink (const char *filename) /* If NAME identifies a symbolic link, copy into BUF the file name of the symlink's target. Copy at most BUF_SIZE bytes, and do NOT - null-terminate the target name, even if it fits. Return the number + NUL-terminate the target name, even if it fits. Return the number of bytes copied, or -1 if NAME is not a symlink or any error was encountered while resolving it. The file name copied into BUF is encoded in the current ANSI codepage. */ @@ -6045,10 +6045,10 @@ readlink (const char *name, char *buf, size_t buf_size) size_t size_to_copy = buf_size; /* According to MSDN, PrintNameLength does not include the - terminating null character. */ + terminating NUL character. */ lwname = alloca ((lwname_len + 1) * sizeof(WCHAR)); memcpy (lwname, lwname_src, lwname_len); - lwname[lwname_len/sizeof(WCHAR)] = 0; /* null-terminate */ + lwname[lwname_len/sizeof(WCHAR)] = 0; /* NUL-terminate */ filename_from_utf16 (lwname, resolved); dostounix_filename (resolved); lname_size = strlen (resolved) + 1; @@ -9384,7 +9384,7 @@ w32_read_registry (HKEY rootkey, Lisp_Object lkey, Lisp_Object lname) /* Convert input strings to UTF-16. */ encoded_key = code_convert_string_norecord (lkey, Qutf_16le, 1); memcpy (key_w, SSDATA (encoded_key), SBYTES (encoded_key)); - /* wchar_t strings need to be terminated by 2 null bytes. */ + /* wchar_t strings need to be terminated by 2 NUL bytes. */ key_w [SBYTES (encoded_key)/2] = L'\0'; encoded_vname = code_convert_string_norecord (lname, Qutf_16le, 1); memcpy (value_w, SSDATA (encoded_vname), SBYTES (encoded_vname)); @@ -9476,7 +9476,7 @@ w32_read_registry (HKEY rootkey, Lisp_Object lkey, Lisp_Object lname) case REG_SZ: if (use_unicode) { - /* pvalue ends with 2 null bytes, but we need only one, + /* pvalue ends with 2 NUL bytes, but we need only one, and AUTO_STRING_WITH_LEN will add it. */ if (pvalue[vsize - 1] == '\0') vsize -= 2; @@ -9485,7 +9485,7 @@ w32_read_registry (HKEY rootkey, Lisp_Object lkey, Lisp_Object lname) } else { - /* Don't waste a byte on the terminating null character, + /* Don't waste a byte on the terminating NUL character, since make_unibyte_string will add one anyway. */ if (pvalue[vsize - 1] == '\0') vsize--; diff --git a/src/w32fns.c b/src/w32fns.c index 1fbf32760d..25900c54c8 100644 --- a/src/w32fns.c +++ b/src/w32fns.c @@ -7965,7 +7965,7 @@ DEFUN ("system-move-file-to-trash", Fsystem_move_file_to_trash, { SHFILEOPSTRUCTW file_op_w; /* We need one more element beyond MAX_PATH because this is - a list of file names, with the last element double-null + a list of file names, with the last element double-NUL terminated. */ wchar_t tmp_path_w[MAX_PATH + 1]; @@ -9724,7 +9724,7 @@ get_dll_version (const char *dll_name) /* Return the number of bytes in UTF-8 encoded string STR that corresponds to at most LIM characters. If STR ends before LIM characters, return the number of bytes in STR including the - terminating null byte. */ + terminating NUL byte. */ static int utf8_mbslen_lim (const char *str, int lim) { diff --git a/src/w32proc.c b/src/w32proc.c index ab0bf0fff0..8e878e6ef3 100644 --- a/src/w32proc.c +++ b/src/w32proc.c @@ -2002,9 +2002,9 @@ sys_spawnve (int mode, char *cmdname, char **argv, char **envp) } /* we have to do some conjuring here to put argv and envp into the - form CreateProcess wants... argv needs to be a space separated/null - terminated list of parameters, and envp is a null - separated/double-null terminated list of parameters. + form CreateProcess wants... argv needs to be a space separated/NUL + terminated list of parameters, and envp is a NUL + separated/double-NUL terminated list of parameters. Additionally, zero-length args and args containing whitespace or quote chars need to be wrapped in double quotes - for this to work, @@ -3393,10 +3393,10 @@ If LCID (a 16-bit number) is not a valid locale, the result is nil. */) got_full = GetLocaleInfo (XFIXNUM (lcid), XFIXNUM (longform), full_name, sizeof (full_name)); - /* GetLocaleInfo's return value includes the terminating null + /* GetLocaleInfo's return value includes the terminating NUL character, when the returned information is a string, whereas make_unibyte_string needs the string length without the - terminating null. */ + terminating NUL. */ if (got_full) return make_unibyte_string (full_name, got_full - 1); } diff --git a/src/w32select.c b/src/w32select.c index 1c84cb47eb..af4f0496ed 100644 --- a/src/w32select.c +++ b/src/w32select.c @@ -803,7 +803,7 @@ DEFUN ("w32-get-clipboard-data", Fw32_get_clipboard_data, (void) ignored; /* Don't pass our own text from the clipboard (which might be - troublesome if the killed text includes null characters). */ + troublesome if the killed text includes NUL characters). */ if (!NILP (current_text)) return ret; diff --git a/src/xdisp.c b/src/xdisp.c index 3172b3be89..a88fc698b8 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -10568,7 +10568,7 @@ message_log_check_duplicate (ptrdiff_t prev_bol_byte, ptrdiff_t this_bol_byte) /* Display an echo area message M with a specified length of NBYTES - bytes. The string may include null characters. If M is not a + bytes. The string may include NUL characters. If M is not a string, clear out any existing message, and let the mini-buffer text show through. @@ -10672,7 +10672,7 @@ message3_nolog (Lisp_Object m) } -/* Display a null-terminated echo area message M. If M is 0, clear +/* Display a NUL-terminated echo area message M. If M is 0, clear out any existing message, and let the mini-buffer text show through. The buffer M must continue to exist until after the echo area gets @@ -24272,7 +24272,7 @@ are the selected window and the WINDOW's buffer). */) return unbind_to (count, str); } -/* Write a null-terminated, right justified decimal representation of +/* Write a NUL-terminated, right justified decimal representation of the positive integer D to BUF using a minimal field width WIDTH. */ static void @@ -24302,7 +24302,7 @@ pint2str (register char *buf, register int width, register ptrdiff_t d) } } -/* Write a null-terminated, right justified decimal and "human +/* Write a NUL-terminated, right justified decimal and "human readable" representation of the nonnegative integer D to BUF using a minimal field width WIDTH. D should be smaller than 999.5e24. */ @@ -24522,7 +24522,7 @@ decode_mode_spec (struct window *w, register int c, int field_width, produce strings from numerical values, so limit preposterously large values of FIELD_WIDTH to avoid overrunning the buffer's end. The size of the buffer is enough for FRAME_MESSAGE_BUF_SIZE - bytes plus the terminating null. */ + bytes plus the terminating NUL. */ int width = min (field_width, FRAME_MESSAGE_BUF_SIZE (f)); struct buffer *b = current_buffer; diff --git a/src/xfont.c b/src/xfont.c index e40a31004f..5ecbd6de33 100644 --- a/src/xfont.c +++ b/src/xfont.c @@ -132,7 +132,7 @@ compare_font_names (const void *name1, const void *name2) /* Decode XLFD as iso-8859-1 into OUTPUT, and return the byte length of the decoding result. LEN is the byte length of XLFD, or -1 if - XLFD is NULL terminated. The caller must assure that OUTPUT is at + XLFD is NUL terminated. The caller must assure that OUTPUT is at least twice (plus 1) as large as XLFD. */ static ptrdiff_t commit 57a60db2b88dfa5dea41a3a05b736cd7cd17a953 Author: Basil L. Contovounesios Date: Thu Mar 21 21:50:12 2019 +0000 ; Eval overlooked lambda in recent Eshell changes * lisp/eshell/em-dirs.el (eshell-dirs-initialize): Reveal lambda overlooked in 2019-03-20T12:51:31-04:00!monnier@iro.umontreal.ca. diff --git a/lisp/eshell/em-dirs.el b/lisp/eshell/em-dirs.el index 7a22867625..937bc981c5 100644 --- a/lisp/eshell/em-dirs.el +++ b/lisp/eshell/em-dirs.el @@ -175,7 +175,7 @@ Thus, this does not include the current directory.") (setq eshell-variable-aliases-list (append eshell-variable-aliases-list - `(("-" (lambda (indices) + `(("-" ,(lambda (indices) (if (not indices) (unless (ring-empty-p eshell-last-dir-ring) (expand-file-name commit 07cf97979057a04c853c580e528258a4ad3e52e0 Author: Nicolas Petton Date: Thu Mar 21 21:10:15 2019 +0100 * etc/NEWS: Document seq-contains-p. diff --git a/etc/NEWS b/etc/NEWS index 6b132eb41d..372d3cd70f 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -390,6 +390,9 @@ buffers. New convenience functions 'seq-first' and 'seq-rest' give easy access to respectively the first and all but the first elements of sequences. +The new predicate function 'seq-contains-p' should be used instead of +the now obsolete 'seq-contains'. + --- ** Follow mode In the current follow group of windows, "ghost" cursors are no longer commit 40714862a388c12f5b2b6d4a9da8be9ef2be2111 Author: Nicolas Petton Date: Thu Mar 21 21:07:55 2019 +0100 * lisp/emacs-lisp/seq.el (seq-difference): Inverse a conditional for clarity. diff --git a/lisp/emacs-lisp/seq.el b/lisp/emacs-lisp/seq.el index 0b99b663dd..3413cd1513 100644 --- a/lisp/emacs-lisp/seq.el +++ b/lisp/emacs-lisp/seq.el @@ -430,9 +430,9 @@ Equality is defined by TESTFN if non-nil or by `equal' if nil." "Return a list of the elements that appear in SEQUENCE1 but not in SEQUENCE2. Equality is defined by TESTFN if non-nil or by `equal' if nil." (seq-reduce (lambda (acc elt) - (if (not (seq-contains-p sequence2 elt testfn)) - (cons elt acc) - acc)) + (if (seq-contains-p sequence2 elt testfn) + acc + (cons elt acc))) (seq-reverse sequence1) '())) commit 287cc58f39e9ca8f9ef31b31556f50c25feadaea Author: Nicolas Petton Date: Wed Mar 20 21:44:01 2019 +0100 New seq-contains-p predicate (Bug#34852) * lisp/emacs-lisp/seq.el (seq-contains-p): New predicate function. It is a replacement for seq-contains which cannot be used as a predicate when a sequence contains nil values as it returns the element found. (seq-contains): Make obsolete. * test/lisp/emacs-lisp/seq-tests.el (test-seq-contains-p): (test-seq-intersection-with-nil, test-seq-set-equal-p-with-nil, test-difference-with-nil): Add regression tests. * doc/lispref/sequences.texi (Sequence Functions): Document seq-contains-p. diff --git a/doc/lispref/sequences.texi b/doc/lispref/sequences.texi index 0c3c4e3b28..a7f270c068 100644 --- a/doc/lispref/sequences.texi +++ b/doc/lispref/sequences.texi @@ -782,10 +782,11 @@ before being sorted. @var{function} is a function of one argument. @end defun -@defun seq-contains sequence elt &optional function - This function returns the first element in @var{sequence} that is equal to -@var{elt}. If the optional argument @var{function} is non-@code{nil}, -it is a function of two arguments to use instead of the default @code{equal}. +@defun seq-contains-p sequence elt &optional function + This function returns non-@code{nil} if at least one element in +@var{sequence} is equal to @var{elt}. If the optional argument +@var{function} is non-@code{nil}, it is a function of two arguments to +use instead of the default @code{equal}. @example @group diff --git a/lisp/emacs-lisp/seq.el b/lisp/emacs-lisp/seq.el index 4a811d7895..0b99b663dd 100644 --- a/lisp/emacs-lisp/seq.el +++ b/lisp/emacs-lisp/seq.el @@ -356,6 +356,7 @@ found or not." count)) (cl-defgeneric seq-contains (sequence elt &optional testfn) + (declare (obsolete seq-contains-p "27.1")) "Return the first element in SEQUENCE that is equal to ELT. Equality is defined by TESTFN if non-nil or by `equal' if nil." (seq-some (lambda (e) @@ -363,11 +364,20 @@ Equality is defined by TESTFN if non-nil or by `equal' if nil." e)) sequence)) +(cl-defgeneric seq-contains-p (sequence elt &optional testfn) + "Return non-nil if SEQUENCE contains an element equal to ELT. +Equality is defined by TESTFN if non-nil or by `equal' if nil." + (catch 'seq--break + (seq-doseq (e sequence) + (when (funcall (or testfn #'equal) e elt) + (throw 'seq--break t))) + nil)) + (cl-defgeneric seq-set-equal-p (sequence1 sequence2 &optional testfn) "Return non-nil if SEQUENCE1 and SEQUENCE2 contain the same elements, regardless of order. Equality is defined by TESTFN if non-nil or by `equal' if nil." - (and (seq-every-p (lambda (item1) (seq-contains sequence2 item1 testfn)) sequence1) - (seq-every-p (lambda (item2) (seq-contains sequence1 item2 testfn)) sequence2))) + (and (seq-every-p (lambda (item1) (seq-contains-p sequence2 item1 testfn)) sequence1) + (seq-every-p (lambda (item2) (seq-contains-p sequence1 item2 testfn)) sequence2))) (cl-defgeneric seq-position (sequence elt &optional testfn) "Return the index of the first element in SEQUENCE that is equal to ELT. @@ -385,7 +395,7 @@ Equality is defined by TESTFN if non-nil or by `equal' if nil." TESTFN is used to compare elements, or `equal' if TESTFN is nil." (let ((result '())) (seq-doseq (elt sequence) - (unless (seq-contains result elt testfn) + (unless (seq-contains-p result elt testfn) (setq result (cons elt result)))) (nreverse result))) @@ -410,7 +420,7 @@ negative integer or 0, nil is returned." "Return a list of the elements that appear in both SEQUENCE1 and SEQUENCE2. Equality is defined by TESTFN if non-nil or by `equal' if nil." (seq-reduce (lambda (acc elt) - (if (seq-contains sequence2 elt testfn) + (if (seq-contains-p sequence2 elt testfn) (cons elt acc) acc)) (seq-reverse sequence1) @@ -420,7 +430,7 @@ Equality is defined by TESTFN if non-nil or by `equal' if nil." "Return a list of the elements that appear in SEQUENCE1 but not in SEQUENCE2. Equality is defined by TESTFN if non-nil or by `equal' if nil." (seq-reduce (lambda (acc elt) - (if (not (seq-contains sequence2 elt testfn)) + (if (not (seq-contains-p sequence2 elt testfn)) (cons elt acc) acc)) (seq-reverse sequence1) diff --git a/test/lisp/emacs-lisp/seq-tests.el b/test/lisp/emacs-lisp/seq-tests.el index d8f00cfea4..ef05e2b389 100644 --- a/test/lisp/emacs-lisp/seq-tests.el +++ b/test/lisp/emacs-lisp/seq-tests.el @@ -185,6 +185,18 @@ Evaluate BODY for each created sequence. (with-test-sequences (seq '(3 4 5 6)) (should (= 5 (seq-contains seq 5))))) +(ert-deftest test-seq-contains-p () + (with-test-sequences (seq '(3 4 5 6)) + (should (eq (seq-contains-p seq 3) t)) + (should-not (seq-contains-p seq 7))) + (with-test-sequences (seq '()) + (should-not (seq-contains-p seq 3)) + (should-not (seq-contains-p seq nil)))) + +(ert-deftest test-seq-contains-p-with-nil () + (should (seq-contains-p [nil] nil)) + (should (seq-contains-p '(nil) nil))) + (ert-deftest test-seq-every-p () (with-test-sequences (seq '(43 54 22 1)) (should (seq-every-p (lambda (elt) t) seq)) @@ -436,5 +448,18 @@ Evaluate BODY for each created sequence. (should (equal (seq-rest lst) '(2 3))) (should (equal (seq-rest vec) [2 3])))) +;; Regression tests for bug#34852 +(progn + (ert-deftest test-seq-intersection-with-nil () + (should (equal (seq-intersection '(1 2 nil) '(1 nil)) '(1 nil)))) + + (ert-deftest test-seq-set-equal-p-with-nil () + (should (seq-set-equal-p '("a" "b" nil) + '(nil "b" "a")))) + + (ert-deftest test-difference-with-nil () + (should (equal (seq-difference '(1 nil) '(2 nil)) + '(1))))) + (provide 'seq-tests) ;;; seq-tests.el ends here commit 093d3e78d21d3d6c718997368ef4b31f9884401c Author: Eli Zaretskii Date: Thu Mar 21 21:29:52 2019 +0200 Revert "Revert "Rely on conservative stack scanning to find "emacs_value"s"" This reverts commit ee7ad83f20903208404a84b58b7a478b62924570. There was no consensus on reverting 3eb93c07f7a60ac9ce8a16f10c3afd5a3a31243a, so doing that will have to wait until the discussion ends. diff --git a/src/emacs-module.c b/src/emacs-module.c index df9a491a86..4e2411cb29 100644 --- a/src/emacs-module.c +++ b/src/emacs-module.c @@ -25,7 +25,6 @@ along with GNU Emacs. If not, see . */ #include #include #include -#include #include "lisp.h" #include "dynlib.h" @@ -66,6 +65,18 @@ along with GNU Emacs. If not, see . */ #include "w32term.h" #endif +/* True if Lisp_Object and emacs_value have the same representation. + This is typically true unless WIDE_EMACS_INT. In practice, having + the same sizes and alignments and maximums should be a good enough + proxy for equality of representation. */ +enum + { + plain_values + = (sizeof (Lisp_Object) == sizeof (emacs_value) + && alignof (Lisp_Object) == alignof (emacs_value) + && INTPTR_MAX == EMACS_INT_MAX) + }; + /* Function prototype for the module init function. */ typedef int (*emacs_init_function) (struct emacs_runtime *); @@ -76,43 +87,6 @@ typedef int (*emacs_init_function) (struct emacs_runtime *); typedef void (*emacs_finalizer_function) (void *); -/* Memory management. */ - -/* An `emacs_value' is just a pointer to a structure holding an - internal Lisp object. */ -struct emacs_value_tag { Lisp_Object v; }; - -/* Local value objects use a simple fixed-sized block allocation - scheme without explicit deallocation. All local values are - deallocated when the lifetime of their environment ends. Keep - track of a current frame from which new values are allocated, - appending further dynamically-allocated frames if necessary. */ - -enum { value_frame_size = 512 }; - -/* A block from which `emacs_value' object can be allocated. */ -struct emacs_value_frame -{ - /* Storage for values. */ - struct emacs_value_tag objects[value_frame_size]; - - /* Index of the next free value in `objects'. */ - int offset; - - /* Pointer to next frame, if any. */ - struct emacs_value_frame *next; -}; - -/* A structure that holds an initial frame (so that the first local - values require no dynamic allocation) and keeps track of the - current frame. */ -static struct emacs_value_storage -{ - struct emacs_value_frame initial; - struct emacs_value_frame *current; -} global_storage; - - /* Private runtime and environment members. */ /* The private part of an environment stores the current non local exit state @@ -125,9 +99,12 @@ struct emacs_env_private /* Dedicated storage for non-local exit symbol and data so that storage is always available for them, even in an out-of-memory situation. */ - struct emacs_value_tag non_local_exit_symbol, non_local_exit_data; + Lisp_Object non_local_exit_symbol, non_local_exit_data; - struct emacs_value_storage storage; + /* List of values allocated from this environment. The code uses + this only if the user gave the -module-assertions command-line + option. */ + Lisp_Object values; }; /* The private parts of an `emacs_runtime' object contain the initial @@ -141,7 +118,6 @@ struct emacs_runtime_private /* Forward declarations. */ static Lisp_Object value_to_lisp (emacs_value); -static emacs_value allocate_emacs_value (emacs_env *, struct emacs_value_storage *, Lisp_Object); static emacs_value lisp_to_value (emacs_env *, Lisp_Object); static enum emacs_funcall_exit module_non_local_exit_check (emacs_env *); static void module_assert_thread (void); @@ -163,7 +139,16 @@ static void module_non_local_exit_throw_1 (emacs_env *, static void module_out_of_memory (emacs_env *); static void module_reset_handlerlist (struct handler **); +/* We used to return NULL when emacs_value was a different type from + Lisp_Object, but nowadays we just use Qnil instead. Although they + happen to be the same thing in the current implementation, module + code should not assume this. */ +verify (NIL_IS_ZERO); +static emacs_value const module_nil = 0; + static bool module_assertions = false; +static emacs_env *global_env; +static struct emacs_env_private global_env_private; /* Convenience macros for non-local exit handling. */ @@ -308,7 +293,7 @@ module_get_environment (struct emacs_runtime *ert) static emacs_value module_make_global_ref (emacs_env *env, emacs_value ref) { - MODULE_FUNCTION_BEGIN (NULL); + MODULE_FUNCTION_BEGIN (module_nil); struct Lisp_Hash_Table *h = XHASH_TABLE (Vmodule_refs_hash); Lisp_Object new_obj = value_to_lisp (ref); EMACS_UINT hashcode; @@ -328,7 +313,7 @@ module_make_global_ref (emacs_env *env, emacs_value ref) hash_put (h, new_obj, make_fixed_natnum (1), hashcode); } - return allocate_emacs_value (env, &global_storage, new_obj); + return lisp_to_value (module_assertions ? global_env : env, new_obj); } static void @@ -356,16 +341,23 @@ module_free_global_ref (emacs_env *env, emacs_value ref) if (module_assertions) { + Lisp_Object globals = global_env_private.values; + Lisp_Object prev = Qnil; ptrdiff_t count = 0; - for (struct emacs_value_frame *frame = &global_storage.initial; - frame != NULL; frame = frame->next) + for (Lisp_Object tail = globals; CONSP (tail); + tail = XCDR (tail)) { - for (int i = 0; i < frame->offset; ++i) + emacs_value global = xmint_pointer (XCAR (tail)); + if (global == ref) { - if (&frame->objects[i] == ref) - return; - ++count; + if (NILP (prev)) + global_env_private.values = XCDR (globals); + else + XSETCDR (prev, XCDR (tail)); + return; } + ++count; + prev = tail; } module_abort ("Global value was not found in list of %"pD"d globals", count); @@ -396,8 +388,9 @@ module_non_local_exit_get (emacs_env *env, emacs_value *sym, emacs_value *data) struct emacs_env_private *p = env->private_members; if (p->pending_non_local_exit != emacs_funcall_exit_return) { - *sym = &p->non_local_exit_symbol; - *data = &p->non_local_exit_data; + /* FIXME: lisp_to_value can exit non-locally. */ + *sym = lisp_to_value (env, p->non_local_exit_symbol); + *data = lisp_to_value (env, p->non_local_exit_data); } return p->pending_non_local_exit; } @@ -441,7 +434,7 @@ module_make_function (emacs_env *env, ptrdiff_t min_arity, ptrdiff_t max_arity, emacs_subr subr, const char *documentation, void *data) { - MODULE_FUNCTION_BEGIN (NULL); + MODULE_FUNCTION_BEGIN (module_nil); if (! (0 <= min_arity && (max_arity < 0 @@ -474,7 +467,7 @@ static emacs_value module_funcall (emacs_env *env, emacs_value fun, ptrdiff_t nargs, emacs_value args[]) { - MODULE_FUNCTION_BEGIN (NULL); + MODULE_FUNCTION_BEGIN (module_nil); /* Make a new Lisp_Object array starting with the function as the first arg, because that's what Ffuncall takes. */ @@ -495,14 +488,14 @@ module_funcall (emacs_env *env, emacs_value fun, ptrdiff_t nargs, static emacs_value module_intern (emacs_env *env, const char *name) { - MODULE_FUNCTION_BEGIN (NULL); + MODULE_FUNCTION_BEGIN (module_nil); return lisp_to_value (env, intern (name)); } static emacs_value module_type_of (emacs_env *env, emacs_value value) { - MODULE_FUNCTION_BEGIN (NULL); + MODULE_FUNCTION_BEGIN (module_nil); return lisp_to_value (env, Ftype_of (value_to_lisp (value))); } @@ -535,7 +528,7 @@ module_extract_integer (emacs_env *env, emacs_value n) static emacs_value module_make_integer (emacs_env *env, intmax_t n) { - MODULE_FUNCTION_BEGIN (NULL); + MODULE_FUNCTION_BEGIN (module_nil); return lisp_to_value (env, make_int (n)); } @@ -551,7 +544,7 @@ module_extract_float (emacs_env *env, emacs_value f) static emacs_value module_make_float (emacs_env *env, double d) { - MODULE_FUNCTION_BEGIN (NULL); + MODULE_FUNCTION_BEGIN (module_nil); return lisp_to_value (env, make_float (d)); } @@ -588,7 +581,7 @@ module_copy_string_contents (emacs_env *env, emacs_value value, char *buffer, static emacs_value module_make_string (emacs_env *env, const char *str, ptrdiff_t length) { - MODULE_FUNCTION_BEGIN (NULL); + MODULE_FUNCTION_BEGIN (module_nil); if (! (0 <= length && length <= STRING_BYTES_BOUND)) overflow_error (); /* FIXME: AUTO_STRING_WITH_LEN requires STR to be null-terminated, @@ -601,7 +594,7 @@ module_make_string (emacs_env *env, const char *str, ptrdiff_t length) static emacs_value module_make_user_ptr (emacs_env *env, emacs_finalizer_function fin, void *ptr) { - MODULE_FUNCTION_BEGIN (NULL); + MODULE_FUNCTION_BEGIN (module_nil); return lisp_to_value (env, make_user_ptr (fin, ptr)); } @@ -663,7 +656,7 @@ module_vec_set (emacs_env *env, emacs_value vec, ptrdiff_t i, emacs_value val) static emacs_value module_vec_get (emacs_env *env, emacs_value vec, ptrdiff_t i) { - MODULE_FUNCTION_BEGIN (NULL); + MODULE_FUNCTION_BEGIN (module_nil); Lisp_Object lvec = value_to_lisp (vec); check_vec_index (lvec, i); return lisp_to_value (env, AREF (lvec, i)); @@ -706,11 +699,9 @@ module_signal_or_throw (struct emacs_env_private *env) case emacs_funcall_exit_return: return; case emacs_funcall_exit_signal: - xsignal (value_to_lisp (&env->non_local_exit_symbol), - value_to_lisp (&env->non_local_exit_data)); + xsignal (env->non_local_exit_symbol, env->non_local_exit_data); case emacs_funcall_exit_throw: - Fthrow (value_to_lisp (&env->non_local_exit_symbol), - value_to_lisp (&env->non_local_exit_data)); + Fthrow (env->non_local_exit_symbol, env->non_local_exit_data); default: eassume (false); } @@ -786,12 +777,17 @@ funcall_module (Lisp_Object function, ptrdiff_t nargs, Lisp_Object *arglist) record_unwind_protect_ptr (finalize_environment_unwind, env); USE_SAFE_ALLOCA; - emacs_value *args = nargs > 0 ? SAFE_ALLOCA (nargs * sizeof *args) : NULL; - for (ptrdiff_t i = 0; i < nargs; ++i) + ATTRIBUTE_MAY_ALIAS emacs_value *args; + if (plain_values && ! module_assertions) + /* FIXME: The cast below is incorrect because the argument array + is not declared as const, so module functions can modify it. + Either declare it as const, or remove this branch. */ + args = (emacs_value *) arglist; + else { - args[i] = lisp_to_value (env, arglist[i]); - if (! args[i]) - memory_full (sizeof *args[i]); + args = SAFE_ALLOCA (nargs * sizeof *args); + for (ptrdiff_t i = 0; i < nargs; i++) + args[i] = lisp_to_value (env, arglist[i]); } emacs_value ret = func->subr (env, nargs, args, func->data); @@ -871,8 +867,8 @@ module_non_local_exit_signal_1 (emacs_env *env, Lisp_Object sym, if (p->pending_non_local_exit == emacs_funcall_exit_return) { p->pending_non_local_exit = emacs_funcall_exit_signal; - p->non_local_exit_symbol.v = sym; - p->non_local_exit_data.v = data; + p->non_local_exit_symbol = sym; + p->non_local_exit_data = data; } } @@ -884,8 +880,8 @@ module_non_local_exit_throw_1 (emacs_env *env, Lisp_Object tag, if (p->pending_non_local_exit == emacs_funcall_exit_return) { p->pending_non_local_exit = emacs_funcall_exit_throw; - p->non_local_exit_symbol.v = tag; - p->non_local_exit_data.v = value; + p->non_local_exit_symbol = tag; + p->non_local_exit_data = value; } } @@ -902,8 +898,54 @@ module_out_of_memory (emacs_env *env) /* Value conversion. */ -/* Convert an `emacs_value' to the corresponding internal object. - Never fails. */ +/* We represent Lisp objects differently depending on whether the user + gave -module-assertions. If assertions are disabled, emacs_value + objects are Lisp_Objects cast to emacs_value. If assertions are + enabled, emacs_value objects are pointers to Lisp_Object objects + allocated from the free store; they are never freed, which ensures + that their addresses are unique and can be used for liveness + checking. */ + +/* Unique Lisp_Object used to mark those emacs_values which are really + just containers holding a Lisp_Object that does not fit as an emacs_value, + either because it is an integer out of range, or is not properly aligned. + Used only if !plain_values. */ +static Lisp_Object ltv_mark; + +/* Convert V to the corresponding internal object O, such that + V == lisp_to_value_bits (O). Never fails. */ +static Lisp_Object +value_to_lisp_bits (emacs_value v) +{ + if (plain_values || USE_LSB_TAG) + return XPL (v); + + /* With wide EMACS_INT and when tag bits are the most significant, + reassembling integers differs from reassembling pointers in two + ways. First, save and restore the least-significant bits of the + integer, not the most-significant bits. Second, sign-extend the + integer when restoring, but zero-extend pointers because that + makes TAG_PTR faster. */ + + intptr_t i = (intptr_t) v; + EMACS_UINT tag = i & ((1 << GCTYPEBITS) - 1); + EMACS_UINT untagged = i - tag; + switch (tag) + { + case_Lisp_Int: + { + bool negative = tag & 1; + EMACS_UINT sign_extension + = negative ? VALMASK & ~(INTPTR_MAX >> INTTYPEBITS): 0; + uintptr_t u = i; + intptr_t all_but_sign = u >> GCTYPEBITS; + untagged = sign_extension + all_but_sign; + break; + } + } + + return XIL ((tag << VALBITS) + untagged); +} /* If V was computed from lisp_to_value (O), then return O. Exits non-locally only if the stack overflows. */ @@ -914,134 +956,91 @@ value_to_lisp (emacs_value v) { /* Check the liveness of the value by iterating over all live environments. */ + void *vptr = v; + ATTRIBUTE_MAY_ALIAS Lisp_Object *optr = vptr; ptrdiff_t num_environments = 0; ptrdiff_t num_values = 0; for (Lisp_Object environments = Vmodule_environments; CONSP (environments); environments = XCDR (environments)) { emacs_env *env = xmint_pointer (XCAR (environments)); - struct emacs_env_private *priv = env->private_members; - /* The value might be one of the nonlocal exit values. Note - that we don't check whether a nonlocal exit is currently - pending, because the module might have cleared the flag - in the meantime. */ - if (&priv->non_local_exit_symbol == v - || &priv->non_local_exit_data == v) - goto ok; - for (struct emacs_value_frame *frame = &priv->storage.initial; - frame != NULL; frame = frame->next) + for (Lisp_Object values = env->private_members->values; + CONSP (values); values = XCDR (values)) { - for (int i = 0; i < frame->offset; ++i) - { - if (&frame->objects[i] == v) - goto ok; - ++num_values; - } - } - ++num_environments; - } - /* Also check global values. */ - for (struct emacs_value_frame *frame = &global_storage.initial; - frame != NULL; frame = frame->next) - { - for (int i = 0; i < frame->offset; ++i) - { - if (&frame->objects[i] == v) - goto ok; + Lisp_Object *p = xmint_pointer (XCAR (values)); + if (p == optr) + return *p; ++num_values; } + ++num_environments; } module_abort (("Emacs value not found in %"pD"d values " "of %"pD"d environments"), num_values, num_environments); } - ok: return v->v; + Lisp_Object o = value_to_lisp_bits (v); + if (! plain_values && CONSP (o) && EQ (XCDR (o), ltv_mark)) + o = XCAR (o); + return o; } -/* Convert an internal object to an `emacs_value'. Allocate storage - from the environment; return NULL if allocation fails. */ +/* Attempt to convert O to an emacs_value. Do not do any checking + or allocate any storage; the caller should prevent or detect + any resulting bit pattern that is not a valid emacs_value. */ static emacs_value -lisp_to_value (emacs_env *env, Lisp_Object o) +lisp_to_value_bits (Lisp_Object o) { - struct emacs_env_private *p = env->private_members; - if (p->pending_non_local_exit != emacs_funcall_exit_return) - return NULL; - return allocate_emacs_value (env, &p->storage, o); -} + if (plain_values || USE_LSB_TAG) + return XLP (o); -/* Must be called for each frame before it can be used for allocation. */ -static void -initialize_frame (struct emacs_value_frame *frame) -{ - frame->offset = 0; - frame->next = NULL; -} - -/* Must be called for any storage object before it can be used for - allocation. */ -static void -initialize_storage (struct emacs_value_storage *storage) -{ - initialize_frame (&storage->initial); - storage->current = &storage->initial; -} - -/* Must be called for any initialized storage object before its - lifetime ends. Free all dynamically-allocated frames. */ -static void -finalize_storage (struct emacs_value_storage *storage) -{ - struct emacs_value_frame *next = storage->initial.next; - while (next != NULL) + /* Compress O into the space of a pointer, possibly losing information. */ + EMACS_UINT u = XLI (o); + if (FIXNUMP (o)) { - struct emacs_value_frame *current = next; - next = current->next; - free (current); + uintptr_t i = (u << VALBITS) + XTYPE (o); + return (emacs_value) i; + } + else + { + char *p = XLP (o); + void *v = p - (u & ~VALMASK) + XTYPE (o); + return v; } } -/* Allocate a new value from STORAGE and stores OBJ in it. Return - NULL if allocation fails and use ENV for non local exit reporting. */ +/* Convert O to an emacs_value. Allocate storage if needed; this can + signal if memory is exhausted. Must be an injective function. */ static emacs_value -allocate_emacs_value (emacs_env *env, struct emacs_value_storage *storage, - Lisp_Object obj) +lisp_to_value (emacs_env *env, Lisp_Object o) { - eassert (storage->current); - eassert (storage->current->offset < value_frame_size); - eassert (! storage->current->next); - if (storage->current->offset == value_frame_size - 1) + if (module_assertions) { - storage->current->next = malloc (sizeof *storage->current->next); - if (! storage->current->next) - { - module_out_of_memory (env); - return NULL; - } - initialize_frame (storage->current->next); - storage->current = storage->current->next; + /* Add the new value to the list of values allocated from this + environment. The value is actually a pointer to the + Lisp_Object cast to emacs_value. We make a copy of the + object on the free store to guarantee unique addresses. */ + ATTRIBUTE_MAY_ALIAS Lisp_Object *optr = xmalloc (sizeof o); + *optr = o; + void *vptr = optr; + ATTRIBUTE_MAY_ALIAS emacs_value ret = vptr; + struct emacs_env_private *priv = env->private_members; + priv->values = Fcons (make_mint_ptr (ret), priv->values); + return ret; } - emacs_value value = storage->current->objects + storage->current->offset; - value->v = obj; - ++storage->current->offset; - return value; -} -/* Mark all objects allocated from local environments so that they - don't get garbage-collected. */ -void -mark_modules (void) -{ - for (Lisp_Object tem = Vmodule_environments; CONSP (tem); tem = XCDR (tem)) + emacs_value v = lisp_to_value_bits (o); + + if (! EQ (o, value_to_lisp_bits (v))) { - emacs_env *env = xmint_pointer (XCAR (tem)); - struct emacs_env_private *priv = env->private_members; - for (struct emacs_value_frame *frame = &priv->storage.initial; - frame != NULL; - frame = frame->next) - for (int i = 0; i < frame->offset; ++i) - mark_object (frame->objects[i].v); + /* Package the incompressible object pointer inside a pair + that is compressible. */ + Lisp_Object pair = Fcons (o, ltv_mark); + v = (emacs_value) ((intptr_t) XCONS (pair) + Lisp_Cons); } + + eassert (EQ (o, value_to_lisp (v))); + return v; } @@ -1060,7 +1059,7 @@ initialize_environment (emacs_env *env, struct emacs_env_private *priv) env = xmalloc (sizeof *env); priv->pending_non_local_exit = emacs_funcall_exit_return; - initialize_storage (&priv->storage); + priv->values = priv->non_local_exit_symbol = priv->non_local_exit_data = Qnil; env->size = sizeof *env; env->private_members = priv; env->make_global_ref = module_make_global_ref; @@ -1101,9 +1100,11 @@ initialize_environment (emacs_env *env, struct emacs_env_private *priv) static void finalize_environment (emacs_env *env) { - finalize_storage (&env->private_members->storage); eassert (xmint_pointer (XCAR (Vmodule_environments)) == env); Vmodule_environments = XCDR (Vmodule_environments); + if (module_assertions) + /* There is always at least the global environment. */ + eassert (CONSP (Vmodule_environments)); } static void @@ -1121,6 +1122,20 @@ finalize_runtime_unwind (void *raw_ert) finalize_environment (ert->private_members->env); } +void +mark_modules (void) +{ + for (Lisp_Object tail = Vmodule_environments; CONSP (tail); + tail = XCDR (tail)) + { + emacs_env *env = xmint_pointer (XCAR (tail)); + struct emacs_env_private *priv = env->private_members; + mark_object (priv->non_local_exit_symbol); + mark_object (priv->non_local_exit_data); + mark_object (priv->values); + } +} + /* Non-local exit handling. */ @@ -1160,7 +1175,8 @@ init_module_assertions (bool enable) /* If enabling module assertions, use a hidden environment for storing the globals. This environment is never freed. */ module_assertions = enable; - initialize_storage (&global_storage); + if (enable) + global_env = initialize_environment (NULL, &global_env_private); } static _Noreturn void @@ -1183,6 +1199,13 @@ module_abort (const char *format, ...) void syms_of_module (void) { + if (!plain_values) + { + ltv_mark = Fcons (Qnil, Qnil); + staticpro (<v_mark); + } + eassert (NILP (value_to_lisp (module_nil))); + DEFSYM (Qmodule_refs_hash, "module-refs-hash"); DEFVAR_LISP ("module-refs-hash", Vmodule_refs_hash, doc: /* Module global reference table. */); diff --git a/test/data/emacs-module/mod-test.c b/test/data/emacs-module/mod-test.c index a39e41afee..47ea159d0e 100644 --- a/test/data/emacs-module/mod-test.c +++ b/test/data/emacs-module/mod-test.c @@ -94,7 +94,7 @@ Fmod_test_signal (emacs_env *env, ptrdiff_t nargs, emacs_value args[], assert (env->non_local_exit_check (env) == emacs_funcall_exit_return); env->non_local_exit_signal (env, env->intern (env, "error"), env->make_integer (env, 56)); - return NULL; + return env->intern (env, "nil"); } @@ -106,7 +106,7 @@ Fmod_test_throw (emacs_env *env, ptrdiff_t nargs, emacs_value args[], assert (env->non_local_exit_check (env) == emacs_funcall_exit_return); env->non_local_exit_throw (env, env->intern (env, "tag"), env->make_integer (env, 65)); - return NULL; + return env->intern (env, "nil"); } @@ -304,7 +304,7 @@ Fmod_test_invalid_finalizer (emacs_env *env, ptrdiff_t nargs, emacs_value *args, { current_env = env; env->make_user_ptr (env, invalid_finalizer, NULL); - return env->intern (env, "nil"); + return env->funcall (env, env->intern (env, "garbage-collect"), 0, NULL); } static void diff --git a/test/src/emacs-module-tests.el b/test/src/emacs-module-tests.el index 35aaaa64b6..e30980b599 100644 --- a/test/src/emacs-module-tests.el +++ b/test/src/emacs-module-tests.el @@ -265,8 +265,7 @@ during garbage collection." (skip-unless (file-executable-p mod-test-emacs)) (module--test-assertion (rx "Module function called during garbage collection\n") - (mod-test-invalid-finalizer) - (garbage-collect))) + (mod-test-invalid-finalizer))) (ert-deftest module/describe-function-1 () "Check that Bug#30163 is fixed." commit ee7ad83f20903208404a84b58b7a478b62924570 Author: Philipp Stephani Date: Fri Sep 21 19:28:08 2018 +0200 Revert "Rely on conservative stack scanning to find "emacs_value"s" This reverts commit 3eb93c07f7a60ac9ce8a16f10c3afd5a3a31243a. There was no consensus for that commit, see https://lists.gnu.org/archive/html/emacs-devel/2016-01/msg00150.html. Also, reverting this commit should fix Bug#31238. diff --git a/src/emacs-module.c b/src/emacs-module.c index 4e2411cb29..df9a491a86 100644 --- a/src/emacs-module.c +++ b/src/emacs-module.c @@ -25,6 +25,7 @@ along with GNU Emacs. If not, see . */ #include #include #include +#include #include "lisp.h" #include "dynlib.h" @@ -65,18 +66,6 @@ along with GNU Emacs. If not, see . */ #include "w32term.h" #endif -/* True if Lisp_Object and emacs_value have the same representation. - This is typically true unless WIDE_EMACS_INT. In practice, having - the same sizes and alignments and maximums should be a good enough - proxy for equality of representation. */ -enum - { - plain_values - = (sizeof (Lisp_Object) == sizeof (emacs_value) - && alignof (Lisp_Object) == alignof (emacs_value) - && INTPTR_MAX == EMACS_INT_MAX) - }; - /* Function prototype for the module init function. */ typedef int (*emacs_init_function) (struct emacs_runtime *); @@ -87,6 +76,43 @@ typedef int (*emacs_init_function) (struct emacs_runtime *); typedef void (*emacs_finalizer_function) (void *); +/* Memory management. */ + +/* An `emacs_value' is just a pointer to a structure holding an + internal Lisp object. */ +struct emacs_value_tag { Lisp_Object v; }; + +/* Local value objects use a simple fixed-sized block allocation + scheme without explicit deallocation. All local values are + deallocated when the lifetime of their environment ends. Keep + track of a current frame from which new values are allocated, + appending further dynamically-allocated frames if necessary. */ + +enum { value_frame_size = 512 }; + +/* A block from which `emacs_value' object can be allocated. */ +struct emacs_value_frame +{ + /* Storage for values. */ + struct emacs_value_tag objects[value_frame_size]; + + /* Index of the next free value in `objects'. */ + int offset; + + /* Pointer to next frame, if any. */ + struct emacs_value_frame *next; +}; + +/* A structure that holds an initial frame (so that the first local + values require no dynamic allocation) and keeps track of the + current frame. */ +static struct emacs_value_storage +{ + struct emacs_value_frame initial; + struct emacs_value_frame *current; +} global_storage; + + /* Private runtime and environment members. */ /* The private part of an environment stores the current non local exit state @@ -99,12 +125,9 @@ struct emacs_env_private /* Dedicated storage for non-local exit symbol and data so that storage is always available for them, even in an out-of-memory situation. */ - Lisp_Object non_local_exit_symbol, non_local_exit_data; + struct emacs_value_tag non_local_exit_symbol, non_local_exit_data; - /* List of values allocated from this environment. The code uses - this only if the user gave the -module-assertions command-line - option. */ - Lisp_Object values; + struct emacs_value_storage storage; }; /* The private parts of an `emacs_runtime' object contain the initial @@ -118,6 +141,7 @@ struct emacs_runtime_private /* Forward declarations. */ static Lisp_Object value_to_lisp (emacs_value); +static emacs_value allocate_emacs_value (emacs_env *, struct emacs_value_storage *, Lisp_Object); static emacs_value lisp_to_value (emacs_env *, Lisp_Object); static enum emacs_funcall_exit module_non_local_exit_check (emacs_env *); static void module_assert_thread (void); @@ -139,16 +163,7 @@ static void module_non_local_exit_throw_1 (emacs_env *, static void module_out_of_memory (emacs_env *); static void module_reset_handlerlist (struct handler **); -/* We used to return NULL when emacs_value was a different type from - Lisp_Object, but nowadays we just use Qnil instead. Although they - happen to be the same thing in the current implementation, module - code should not assume this. */ -verify (NIL_IS_ZERO); -static emacs_value const module_nil = 0; - static bool module_assertions = false; -static emacs_env *global_env; -static struct emacs_env_private global_env_private; /* Convenience macros for non-local exit handling. */ @@ -293,7 +308,7 @@ module_get_environment (struct emacs_runtime *ert) static emacs_value module_make_global_ref (emacs_env *env, emacs_value ref) { - MODULE_FUNCTION_BEGIN (module_nil); + MODULE_FUNCTION_BEGIN (NULL); struct Lisp_Hash_Table *h = XHASH_TABLE (Vmodule_refs_hash); Lisp_Object new_obj = value_to_lisp (ref); EMACS_UINT hashcode; @@ -313,7 +328,7 @@ module_make_global_ref (emacs_env *env, emacs_value ref) hash_put (h, new_obj, make_fixed_natnum (1), hashcode); } - return lisp_to_value (module_assertions ? global_env : env, new_obj); + return allocate_emacs_value (env, &global_storage, new_obj); } static void @@ -341,23 +356,16 @@ module_free_global_ref (emacs_env *env, emacs_value ref) if (module_assertions) { - Lisp_Object globals = global_env_private.values; - Lisp_Object prev = Qnil; ptrdiff_t count = 0; - for (Lisp_Object tail = globals; CONSP (tail); - tail = XCDR (tail)) + for (struct emacs_value_frame *frame = &global_storage.initial; + frame != NULL; frame = frame->next) { - emacs_value global = xmint_pointer (XCAR (tail)); - if (global == ref) + for (int i = 0; i < frame->offset; ++i) { - if (NILP (prev)) - global_env_private.values = XCDR (globals); - else - XSETCDR (prev, XCDR (tail)); - return; + if (&frame->objects[i] == ref) + return; + ++count; } - ++count; - prev = tail; } module_abort ("Global value was not found in list of %"pD"d globals", count); @@ -388,9 +396,8 @@ module_non_local_exit_get (emacs_env *env, emacs_value *sym, emacs_value *data) struct emacs_env_private *p = env->private_members; if (p->pending_non_local_exit != emacs_funcall_exit_return) { - /* FIXME: lisp_to_value can exit non-locally. */ - *sym = lisp_to_value (env, p->non_local_exit_symbol); - *data = lisp_to_value (env, p->non_local_exit_data); + *sym = &p->non_local_exit_symbol; + *data = &p->non_local_exit_data; } return p->pending_non_local_exit; } @@ -434,7 +441,7 @@ module_make_function (emacs_env *env, ptrdiff_t min_arity, ptrdiff_t max_arity, emacs_subr subr, const char *documentation, void *data) { - MODULE_FUNCTION_BEGIN (module_nil); + MODULE_FUNCTION_BEGIN (NULL); if (! (0 <= min_arity && (max_arity < 0 @@ -467,7 +474,7 @@ static emacs_value module_funcall (emacs_env *env, emacs_value fun, ptrdiff_t nargs, emacs_value args[]) { - MODULE_FUNCTION_BEGIN (module_nil); + MODULE_FUNCTION_BEGIN (NULL); /* Make a new Lisp_Object array starting with the function as the first arg, because that's what Ffuncall takes. */ @@ -488,14 +495,14 @@ module_funcall (emacs_env *env, emacs_value fun, ptrdiff_t nargs, static emacs_value module_intern (emacs_env *env, const char *name) { - MODULE_FUNCTION_BEGIN (module_nil); + MODULE_FUNCTION_BEGIN (NULL); return lisp_to_value (env, intern (name)); } static emacs_value module_type_of (emacs_env *env, emacs_value value) { - MODULE_FUNCTION_BEGIN (module_nil); + MODULE_FUNCTION_BEGIN (NULL); return lisp_to_value (env, Ftype_of (value_to_lisp (value))); } @@ -528,7 +535,7 @@ module_extract_integer (emacs_env *env, emacs_value n) static emacs_value module_make_integer (emacs_env *env, intmax_t n) { - MODULE_FUNCTION_BEGIN (module_nil); + MODULE_FUNCTION_BEGIN (NULL); return lisp_to_value (env, make_int (n)); } @@ -544,7 +551,7 @@ module_extract_float (emacs_env *env, emacs_value f) static emacs_value module_make_float (emacs_env *env, double d) { - MODULE_FUNCTION_BEGIN (module_nil); + MODULE_FUNCTION_BEGIN (NULL); return lisp_to_value (env, make_float (d)); } @@ -581,7 +588,7 @@ module_copy_string_contents (emacs_env *env, emacs_value value, char *buffer, static emacs_value module_make_string (emacs_env *env, const char *str, ptrdiff_t length) { - MODULE_FUNCTION_BEGIN (module_nil); + MODULE_FUNCTION_BEGIN (NULL); if (! (0 <= length && length <= STRING_BYTES_BOUND)) overflow_error (); /* FIXME: AUTO_STRING_WITH_LEN requires STR to be null-terminated, @@ -594,7 +601,7 @@ module_make_string (emacs_env *env, const char *str, ptrdiff_t length) static emacs_value module_make_user_ptr (emacs_env *env, emacs_finalizer_function fin, void *ptr) { - MODULE_FUNCTION_BEGIN (module_nil); + MODULE_FUNCTION_BEGIN (NULL); return lisp_to_value (env, make_user_ptr (fin, ptr)); } @@ -656,7 +663,7 @@ module_vec_set (emacs_env *env, emacs_value vec, ptrdiff_t i, emacs_value val) static emacs_value module_vec_get (emacs_env *env, emacs_value vec, ptrdiff_t i) { - MODULE_FUNCTION_BEGIN (module_nil); + MODULE_FUNCTION_BEGIN (NULL); Lisp_Object lvec = value_to_lisp (vec); check_vec_index (lvec, i); return lisp_to_value (env, AREF (lvec, i)); @@ -699,9 +706,11 @@ module_signal_or_throw (struct emacs_env_private *env) case emacs_funcall_exit_return: return; case emacs_funcall_exit_signal: - xsignal (env->non_local_exit_symbol, env->non_local_exit_data); + xsignal (value_to_lisp (&env->non_local_exit_symbol), + value_to_lisp (&env->non_local_exit_data)); case emacs_funcall_exit_throw: - Fthrow (env->non_local_exit_symbol, env->non_local_exit_data); + Fthrow (value_to_lisp (&env->non_local_exit_symbol), + value_to_lisp (&env->non_local_exit_data)); default: eassume (false); } @@ -777,17 +786,12 @@ funcall_module (Lisp_Object function, ptrdiff_t nargs, Lisp_Object *arglist) record_unwind_protect_ptr (finalize_environment_unwind, env); USE_SAFE_ALLOCA; - ATTRIBUTE_MAY_ALIAS emacs_value *args; - if (plain_values && ! module_assertions) - /* FIXME: The cast below is incorrect because the argument array - is not declared as const, so module functions can modify it. - Either declare it as const, or remove this branch. */ - args = (emacs_value *) arglist; - else + emacs_value *args = nargs > 0 ? SAFE_ALLOCA (nargs * sizeof *args) : NULL; + for (ptrdiff_t i = 0; i < nargs; ++i) { - args = SAFE_ALLOCA (nargs * sizeof *args); - for (ptrdiff_t i = 0; i < nargs; i++) - args[i] = lisp_to_value (env, arglist[i]); + args[i] = lisp_to_value (env, arglist[i]); + if (! args[i]) + memory_full (sizeof *args[i]); } emacs_value ret = func->subr (env, nargs, args, func->data); @@ -867,8 +871,8 @@ module_non_local_exit_signal_1 (emacs_env *env, Lisp_Object sym, if (p->pending_non_local_exit == emacs_funcall_exit_return) { p->pending_non_local_exit = emacs_funcall_exit_signal; - p->non_local_exit_symbol = sym; - p->non_local_exit_data = data; + p->non_local_exit_symbol.v = sym; + p->non_local_exit_data.v = data; } } @@ -880,8 +884,8 @@ module_non_local_exit_throw_1 (emacs_env *env, Lisp_Object tag, if (p->pending_non_local_exit == emacs_funcall_exit_return) { p->pending_non_local_exit = emacs_funcall_exit_throw; - p->non_local_exit_symbol = tag; - p->non_local_exit_data = value; + p->non_local_exit_symbol.v = tag; + p->non_local_exit_data.v = value; } } @@ -898,54 +902,8 @@ module_out_of_memory (emacs_env *env) /* Value conversion. */ -/* We represent Lisp objects differently depending on whether the user - gave -module-assertions. If assertions are disabled, emacs_value - objects are Lisp_Objects cast to emacs_value. If assertions are - enabled, emacs_value objects are pointers to Lisp_Object objects - allocated from the free store; they are never freed, which ensures - that their addresses are unique and can be used for liveness - checking. */ - -/* Unique Lisp_Object used to mark those emacs_values which are really - just containers holding a Lisp_Object that does not fit as an emacs_value, - either because it is an integer out of range, or is not properly aligned. - Used only if !plain_values. */ -static Lisp_Object ltv_mark; - -/* Convert V to the corresponding internal object O, such that - V == lisp_to_value_bits (O). Never fails. */ -static Lisp_Object -value_to_lisp_bits (emacs_value v) -{ - if (plain_values || USE_LSB_TAG) - return XPL (v); - - /* With wide EMACS_INT and when tag bits are the most significant, - reassembling integers differs from reassembling pointers in two - ways. First, save and restore the least-significant bits of the - integer, not the most-significant bits. Second, sign-extend the - integer when restoring, but zero-extend pointers because that - makes TAG_PTR faster. */ - - intptr_t i = (intptr_t) v; - EMACS_UINT tag = i & ((1 << GCTYPEBITS) - 1); - EMACS_UINT untagged = i - tag; - switch (tag) - { - case_Lisp_Int: - { - bool negative = tag & 1; - EMACS_UINT sign_extension - = negative ? VALMASK & ~(INTPTR_MAX >> INTTYPEBITS): 0; - uintptr_t u = i; - intptr_t all_but_sign = u >> GCTYPEBITS; - untagged = sign_extension + all_but_sign; - break; - } - } - - return XIL ((tag << VALBITS) + untagged); -} +/* Convert an `emacs_value' to the corresponding internal object. + Never fails. */ /* If V was computed from lisp_to_value (O), then return O. Exits non-locally only if the stack overflows. */ @@ -956,91 +914,134 @@ value_to_lisp (emacs_value v) { /* Check the liveness of the value by iterating over all live environments. */ - void *vptr = v; - ATTRIBUTE_MAY_ALIAS Lisp_Object *optr = vptr; ptrdiff_t num_environments = 0; ptrdiff_t num_values = 0; for (Lisp_Object environments = Vmodule_environments; CONSP (environments); environments = XCDR (environments)) { emacs_env *env = xmint_pointer (XCAR (environments)); - for (Lisp_Object values = env->private_members->values; - CONSP (values); values = XCDR (values)) + struct emacs_env_private *priv = env->private_members; + /* The value might be one of the nonlocal exit values. Note + that we don't check whether a nonlocal exit is currently + pending, because the module might have cleared the flag + in the meantime. */ + if (&priv->non_local_exit_symbol == v + || &priv->non_local_exit_data == v) + goto ok; + for (struct emacs_value_frame *frame = &priv->storage.initial; + frame != NULL; frame = frame->next) { - Lisp_Object *p = xmint_pointer (XCAR (values)); - if (p == optr) - return *p; - ++num_values; + for (int i = 0; i < frame->offset; ++i) + { + if (&frame->objects[i] == v) + goto ok; + ++num_values; + } } ++num_environments; } + /* Also check global values. */ + for (struct emacs_value_frame *frame = &global_storage.initial; + frame != NULL; frame = frame->next) + { + for (int i = 0; i < frame->offset; ++i) + { + if (&frame->objects[i] == v) + goto ok; + ++num_values; + } + } module_abort (("Emacs value not found in %"pD"d values " "of %"pD"d environments"), num_values, num_environments); } - Lisp_Object o = value_to_lisp_bits (v); - if (! plain_values && CONSP (o) && EQ (XCDR (o), ltv_mark)) - o = XCAR (o); - return o; + ok: return v->v; } -/* Attempt to convert O to an emacs_value. Do not do any checking - or allocate any storage; the caller should prevent or detect - any resulting bit pattern that is not a valid emacs_value. */ +/* Convert an internal object to an `emacs_value'. Allocate storage + from the environment; return NULL if allocation fails. */ static emacs_value -lisp_to_value_bits (Lisp_Object o) +lisp_to_value (emacs_env *env, Lisp_Object o) { - if (plain_values || USE_LSB_TAG) - return XLP (o); + struct emacs_env_private *p = env->private_members; + if (p->pending_non_local_exit != emacs_funcall_exit_return) + return NULL; + return allocate_emacs_value (env, &p->storage, o); +} - /* Compress O into the space of a pointer, possibly losing information. */ - EMACS_UINT u = XLI (o); - if (FIXNUMP (o)) - { - uintptr_t i = (u << VALBITS) + XTYPE (o); - return (emacs_value) i; - } - else +/* Must be called for each frame before it can be used for allocation. */ +static void +initialize_frame (struct emacs_value_frame *frame) +{ + frame->offset = 0; + frame->next = NULL; +} + +/* Must be called for any storage object before it can be used for + allocation. */ +static void +initialize_storage (struct emacs_value_storage *storage) +{ + initialize_frame (&storage->initial); + storage->current = &storage->initial; +} + +/* Must be called for any initialized storage object before its + lifetime ends. Free all dynamically-allocated frames. */ +static void +finalize_storage (struct emacs_value_storage *storage) +{ + struct emacs_value_frame *next = storage->initial.next; + while (next != NULL) { - char *p = XLP (o); - void *v = p - (u & ~VALMASK) + XTYPE (o); - return v; + struct emacs_value_frame *current = next; + next = current->next; + free (current); } } -/* Convert O to an emacs_value. Allocate storage if needed; this can - signal if memory is exhausted. Must be an injective function. */ +/* Allocate a new value from STORAGE and stores OBJ in it. Return + NULL if allocation fails and use ENV for non local exit reporting. */ static emacs_value -lisp_to_value (emacs_env *env, Lisp_Object o) +allocate_emacs_value (emacs_env *env, struct emacs_value_storage *storage, + Lisp_Object obj) { - if (module_assertions) + eassert (storage->current); + eassert (storage->current->offset < value_frame_size); + eassert (! storage->current->next); + if (storage->current->offset == value_frame_size - 1) { - /* Add the new value to the list of values allocated from this - environment. The value is actually a pointer to the - Lisp_Object cast to emacs_value. We make a copy of the - object on the free store to guarantee unique addresses. */ - ATTRIBUTE_MAY_ALIAS Lisp_Object *optr = xmalloc (sizeof o); - *optr = o; - void *vptr = optr; - ATTRIBUTE_MAY_ALIAS emacs_value ret = vptr; - struct emacs_env_private *priv = env->private_members; - priv->values = Fcons (make_mint_ptr (ret), priv->values); - return ret; + storage->current->next = malloc (sizeof *storage->current->next); + if (! storage->current->next) + { + module_out_of_memory (env); + return NULL; + } + initialize_frame (storage->current->next); + storage->current = storage->current->next; } + emacs_value value = storage->current->objects + storage->current->offset; + value->v = obj; + ++storage->current->offset; + return value; +} - emacs_value v = lisp_to_value_bits (o); - - if (! EQ (o, value_to_lisp_bits (v))) +/* Mark all objects allocated from local environments so that they + don't get garbage-collected. */ +void +mark_modules (void) +{ + for (Lisp_Object tem = Vmodule_environments; CONSP (tem); tem = XCDR (tem)) { - /* Package the incompressible object pointer inside a pair - that is compressible. */ - Lisp_Object pair = Fcons (o, ltv_mark); - v = (emacs_value) ((intptr_t) XCONS (pair) + Lisp_Cons); + emacs_env *env = xmint_pointer (XCAR (tem)); + struct emacs_env_private *priv = env->private_members; + for (struct emacs_value_frame *frame = &priv->storage.initial; + frame != NULL; + frame = frame->next) + for (int i = 0; i < frame->offset; ++i) + mark_object (frame->objects[i].v); } - - eassert (EQ (o, value_to_lisp (v))); - return v; } @@ -1059,7 +1060,7 @@ initialize_environment (emacs_env *env, struct emacs_env_private *priv) env = xmalloc (sizeof *env); priv->pending_non_local_exit = emacs_funcall_exit_return; - priv->values = priv->non_local_exit_symbol = priv->non_local_exit_data = Qnil; + initialize_storage (&priv->storage); env->size = sizeof *env; env->private_members = priv; env->make_global_ref = module_make_global_ref; @@ -1100,11 +1101,9 @@ initialize_environment (emacs_env *env, struct emacs_env_private *priv) static void finalize_environment (emacs_env *env) { + finalize_storage (&env->private_members->storage); eassert (xmint_pointer (XCAR (Vmodule_environments)) == env); Vmodule_environments = XCDR (Vmodule_environments); - if (module_assertions) - /* There is always at least the global environment. */ - eassert (CONSP (Vmodule_environments)); } static void @@ -1122,20 +1121,6 @@ finalize_runtime_unwind (void *raw_ert) finalize_environment (ert->private_members->env); } -void -mark_modules (void) -{ - for (Lisp_Object tail = Vmodule_environments; CONSP (tail); - tail = XCDR (tail)) - { - emacs_env *env = xmint_pointer (XCAR (tail)); - struct emacs_env_private *priv = env->private_members; - mark_object (priv->non_local_exit_symbol); - mark_object (priv->non_local_exit_data); - mark_object (priv->values); - } -} - /* Non-local exit handling. */ @@ -1175,8 +1160,7 @@ init_module_assertions (bool enable) /* If enabling module assertions, use a hidden environment for storing the globals. This environment is never freed. */ module_assertions = enable; - if (enable) - global_env = initialize_environment (NULL, &global_env_private); + initialize_storage (&global_storage); } static _Noreturn void @@ -1199,13 +1183,6 @@ module_abort (const char *format, ...) void syms_of_module (void) { - if (!plain_values) - { - ltv_mark = Fcons (Qnil, Qnil); - staticpro (<v_mark); - } - eassert (NILP (value_to_lisp (module_nil))); - DEFSYM (Qmodule_refs_hash, "module-refs-hash"); DEFVAR_LISP ("module-refs-hash", Vmodule_refs_hash, doc: /* Module global reference table. */); diff --git a/test/data/emacs-module/mod-test.c b/test/data/emacs-module/mod-test.c index 47ea159d0e..a39e41afee 100644 --- a/test/data/emacs-module/mod-test.c +++ b/test/data/emacs-module/mod-test.c @@ -94,7 +94,7 @@ Fmod_test_signal (emacs_env *env, ptrdiff_t nargs, emacs_value args[], assert (env->non_local_exit_check (env) == emacs_funcall_exit_return); env->non_local_exit_signal (env, env->intern (env, "error"), env->make_integer (env, 56)); - return env->intern (env, "nil"); + return NULL; } @@ -106,7 +106,7 @@ Fmod_test_throw (emacs_env *env, ptrdiff_t nargs, emacs_value args[], assert (env->non_local_exit_check (env) == emacs_funcall_exit_return); env->non_local_exit_throw (env, env->intern (env, "tag"), env->make_integer (env, 65)); - return env->intern (env, "nil"); + return NULL; } @@ -304,7 +304,7 @@ Fmod_test_invalid_finalizer (emacs_env *env, ptrdiff_t nargs, emacs_value *args, { current_env = env; env->make_user_ptr (env, invalid_finalizer, NULL); - return env->funcall (env, env->intern (env, "garbage-collect"), 0, NULL); + return env->intern (env, "nil"); } static void diff --git a/test/src/emacs-module-tests.el b/test/src/emacs-module-tests.el index e30980b599..35aaaa64b6 100644 --- a/test/src/emacs-module-tests.el +++ b/test/src/emacs-module-tests.el @@ -265,7 +265,8 @@ during garbage collection." (skip-unless (file-executable-p mod-test-emacs)) (module--test-assertion (rx "Module function called during garbage collection\n") - (mod-test-invalid-finalizer))) + (mod-test-invalid-finalizer) + (garbage-collect))) (ert-deftest module/describe-function-1 () "Check that Bug#30163 is fixed." commit 107215596c1a8edfb239a88850d822642bc0e4af Author: Eli Zaretskii Date: Thu Mar 21 17:55:16 2019 +0200 Avoid duplicate entries in process-environment after re-dumping * src/pdumper.c (Fdump_emacs_portable): Reset process-environment to nil. (Bug#34936) diff --git a/src/pdumper.c b/src/pdumper.c index fbf17d1629..f459d971c3 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -4025,6 +4025,12 @@ types. */) Lisp_Object symbol = intern ("command-line-processed"); specbind (symbol, Qnil); + /* Reset process-environment -- this is for when they re-dump a + pdump-restored emacs, since set_initial_environment wants always + to cons it from scratch. */ + Vprocess_environment = Qnil; + garbage_collect (); + CHECK_STRING (filename); filename = Fexpand_file_name (filename, Qnil); filename = ENCODE_FILE (filename); commit c569cceb2d334564d320d2b4098c855db7eb88a0 Author: Stefan Monnier Date: Thu Mar 21 08:27:39 2019 -0400 * doc: Recommend putting '-' as last char in Emacs charset regexps * doc/lispref/searching.texi (Regexp Special): * doc/emacs/search.texi (Regexps): Recommend - as last char in [...]. diff --git a/doc/emacs/search.texi b/doc/emacs/search.texi index 9c58ef471f..a1c987c125 100644 --- a/doc/emacs/search.texi +++ b/doc/emacs/search.texi @@ -974,11 +974,10 @@ character class inside a character alternative. For instance, elisp, The Emacs Lisp Reference Manual}, for a list of character classes. -To include a @samp{]} in a character set, you must make it the first -character. For example, @samp{[]a]} matches @samp{]} or @samp{a}. To -include a @samp{-}, write @samp{-} as the first or last character of the -set, or put it after a range. Thus, @samp{[]-]} matches both @samp{]} -and @samp{-}. +To include a @samp{]} in a character set, you must make it the first character. +For example, @samp{[]a]} matches @samp{]} or @samp{a}. To include a @samp{-}, +write @samp{-} as the last character of the set, tho you can also put it first +or after a range. Thus, @samp{[]-]} matches both @samp{]} and @samp{-}. To include @samp{^} in a set, put it anywhere but at the beginning of the set. (At the beginning, it complements the set---see below.) diff --git a/doc/lispref/searching.texi b/doc/lispref/searching.texi index 740be2a31f..0f312915f9 100644 --- a/doc/lispref/searching.texi +++ b/doc/lispref/searching.texi @@ -406,13 +406,13 @@ Note also that the usual regexp special characters are not special inside a character alternative. A completely different set of characters is special inside character alternatives: @samp{]}, @samp{-} and @samp{^}. -To include a @samp{]} in a character alternative, you must make it the -first character. For example, @samp{[]a]} matches @samp{]} or @samp{a}. -To include a @samp{-}, write @samp{-} as the first or last character of -the character alternative, or put it after a range. Thus, @samp{[]-]} -matches both @samp{]} and @samp{-}. (As explained below, you cannot -use @samp{\]} to include a @samp{]} inside a character alternative, -since @samp{\} is not special there.) +To include a @samp{]} in a character alternative, you must make it the first +character. For example, @samp{[]a]} matches @samp{]} or @samp{a}. To include +a @samp{-}, write @samp{-} as the last character of the character alternative, +tho you can also put it first or after a range. Thus, @samp{[]-]} matches both +@samp{]} and @samp{-}. (As explained below, you cannot use @samp{\]} to +include a @samp{]} inside a character alternative, since @samp{\} is not +special there.) To include @samp{^} in a character alternative, put it anywhere but at the beginning.