;; here, so that any code that cares about the difference will
;; see the same transformation.
;; First arg is a function:
- (`(,(and fun (or `funcall `apply `mapcar `mapatoms `mapconcat `mapc))
+ (`(,(and fun (or 'funcall 'apply 'mapcar 'mapatoms 'mapconcat 'mapc))
',(and f `(lambda . ,_)) . ,args)
(macroexp--warn-and-return
+ (nth 1 f)
(format "%s quoted with ' rather than with #'"
(list 'lambda (nth 1 f) '...))
(macroexp--expand-all `(,fun ,f . ,args))))
;; Second arg is a function:
- (`(,(and fun (or `sort)) ,arg1 ',(and f `(lambda . ,_)) . ,args)
+ (`(,(and fun (or 'sort)) ,arg1 ',(and f `(lambda . ,_)) . ,args)
(macroexp--warn-and-return
+ (nth 1 f)
(format "%s quoted with ' rather than with #'"
(list 'lambda (nth 1 f) '...))
(macroexp--expand-all `(,fun ,arg1 ,f . ,args))))
to return them to the OS).
However, if there was overflow in pure space, `garbage-collect'
returns nil, because real GC can't be done.
- See Info node `(elisp)Garbage Collection'. */
- attributes: noinline)
+ See Info node `(elisp)Garbage Collection'. */)
(void)
{
- void *end;
+ ptrdiff_t count = SPECPDL_INDEX ();
- SET_STACK_TOP_ADDRESS (&end);
- /* return garbage_collect_1 (end); */
- return unbind_to (count, garbage_collect_1 (end));
+ struct gcstat gcst;
+ specbind (Qsymbols_with_pos_enabled, Qnil);
- return Qnil;
+ if (!garbage_collect_1 (&gcst))
- return CALLMANY (Flist, total);
++ return unbind_to (count, Qnil);
+
+ Lisp_Object total[] = {
+ list4 (Qconses, make_fixnum (sizeof (struct Lisp_Cons)),
+ make_int (gcst.total_conses),
+ make_int (gcst.total_free_conses)),
+ list4 (Qsymbols, make_fixnum (sizeof (struct Lisp_Symbol)),
+ make_int (gcst.total_symbols),
+ make_int (gcst.total_free_symbols)),
+ list4 (Qstrings, make_fixnum (sizeof (struct Lisp_String)),
+ make_int (gcst.total_strings),
+ make_int (gcst.total_free_strings)),
+ list3 (Qstring_bytes, make_fixnum (1),
+ make_int (gcst.total_string_bytes)),
+ list3 (Qvectors,
+ make_fixnum (header_size + sizeof (Lisp_Object)),
+ make_int (gcst.total_vectors)),
+ list4 (Qvector_slots, make_fixnum (word_size),
+ make_int (gcst.total_vector_slots),
+ make_int (gcst.total_free_vector_slots)),
+ list4 (Qfloats, make_fixnum (sizeof (struct Lisp_Float)),
+ make_int (gcst.total_floats),
+ make_int (gcst.total_free_floats)),
+ list4 (Qintervals, make_fixnum (sizeof (struct interval)),
+ make_int (gcst.total_intervals),
+ make_int (gcst.total_free_intervals)),
+ list3 (Qbuffers, make_fixnum (sizeof (struct buffer)),
+ make_int (gcst.total_buffers)),
+
+ #ifdef DOUG_LEA_MALLOC
+ list4 (Qheap, make_fixnum (1024),
+ make_int ((mallinfo ().uordblks + 1023) >> 10),
+ make_int ((mallinfo ().fordblks + 1023) >> 10)),
+ #endif
+ };
++ return unbind_to (count, CALLMANY (Flist, total));
}
/* Mark Lisp objects in glyph matrix MATRIX. Currently the
{
Lisp_Object val = ptr->contents[i];
- if (FIXNUMP (val) || (BARE_SYMBOL_P (val)
- && XBARE_SYMBOL (val)->u.s.gcmarkbit))
+ if (FIXNUMP (val) ||
- (SYMBOLP (val) && symbol_marked_p (XSYMBOL (val))))
++ (BARE_SYMBOL_P (val) && symbol_marked_p (XBARE_SYMBOL (val))))
continue;
if (SUB_CHAR_TABLE_P (val))
{
DEFSYM (Qstring, "string");
DEFSYM (Qcons, "cons");
DEFSYM (Qmarker, "marker");
+ DEFSYM (Qsymbol_with_pos, "symbol-with-pos");
DEFSYM (Qoverlay, "overlay");
DEFSYM (Qfinalizer, "finalizer");
- #ifdef HAVE_MODULES
DEFSYM (Qmodule_function, "module-function");
+ #ifdef HAVE_MODULES
DEFSYM (Quser_ptr, "user-ptr");
#endif
DEFSYM (Qfloat, "float");
EMACS_UINT hash_code;
ptrdiff_t start_of_bucket, i;
+ if (SYMBOL_WITH_POS_P (key))
+ key = SYMBOL_WITH_POS_SYM (key);
+ hash_rehash_if_needed (h);
+
hash_code = h->test.hashfn (&h->test, key);
eassert ((hash_code & ~INTMASK) == 0);
if (hash)
/* Defined in data.c. */
extern _Noreturn void wrong_type_argument (Lisp_Object, Lisp_Object);
-
+extern bool symbols_with_pos_enabled;
- #ifdef CANNOT_DUMP
- enum { might_dump = false };
- #elif defined DOUG_LEA_MALLOC
/* Defined in emacs.c. */
- extern bool might_dump;
- #endif
- /* True means Emacs has already been initialized.
- Used during startup to detect startup of dumped Emacs. */
+
+ /* Set after Emacs has started up the first time.
+ Prevents reinitialization of the Lisp world and keymaps on
+ subsequent starts. */
extern bool initialized;
+ extern struct gflags
+ {
+ /* True means this Emacs instance was born to dump. */
+ #if defined HAVE_PDUMPER || defined HAVE_UNEXEC
+ bool will_dump_ : 1;
+ bool will_bootstrap_ : 1;
+ #endif
+ #ifdef HAVE_PDUMPER
+ /* Set in an Emacs process that will likely dump with pdumper; all
+ Emacs processes may dump with pdumper, however. */
+ bool will_dump_with_pdumper_ : 1;
+ /* Set in an Emacs process that has been restored from a portable
+ dump. */
+ bool dumped_with_pdumper_ : 1;
+ #endif
+ #ifdef HAVE_UNEXEC
+ bool will_dump_with_unexec_ : 1;
+ /* Set in an Emacs process that has been restored from an unexec
+ dump. */
+ bool dumped_with_unexec_ : 1;
+ /* We promise not to unexec: useful for hybrid malloc. */
+ bool will_not_unexec_ : 1;
+ #endif
+ } gflags;
+
+ INLINE bool
+ will_dump_p (void)
+ {
+ #if HAVE_PDUMPER || defined HAVE_UNEXEC
+ return gflags.will_dump_;
+ #else
+ return false;
+ #endif
+ }
+
+ INLINE bool
+ will_bootstrap_p (void)
+ {
+ #if HAVE_PDUMPER || defined HAVE_UNEXEC
+ return gflags.will_bootstrap_;
+ #else
+ return false;
+ #endif
+ }
+
+ INLINE bool
+ will_dump_with_pdumper_p (void)
+ {
+ #if HAVE_PDUMPER
+ return gflags.will_dump_with_pdumper_;
+ #else
+ return false;
+ #endif
+ }
+
+ INLINE bool
+ dumped_with_pdumper_p (void)
+ {
+ #if HAVE_PDUMPER
+ return gflags.dumped_with_pdumper_;
+ #else
+ return false;
+ #endif
+ }
+
+ INLINE bool
+ will_dump_with_unexec_p (void)
+ {
+ #ifdef HAVE_UNEXEC
+ return gflags.will_dump_with_unexec_;
+ #else
+ return false;
+ #endif
+ }
+
+ INLINE bool
+ dumped_with_unexec_p (void)
+ {
+ #ifdef HAVE_UNEXEC
+ return gflags.dumped_with_unexec_;
+ #else
+ return false;
+ #endif
+ }
+
+ /* This function is the opposite of will_dump_with_unexec_p(), except
+ that it returns false before main runs. It's important to use
+ gmalloc for any pre-main allocations if we're going to unexec. */
+ INLINE bool
+ definitely_will_not_unexec_p (void)
+ {
+ #ifdef HAVE_UNEXEC
+ return gflags.will_not_unexec_;
+ #else
+ return true;
+ #endif
+ }
+
/* Defined in floatfns.c. */
extern double extract_float (Lisp_Object);
{
/* Sub char-table can't be read as a regular
vector because of a two C integer fields. */
- Lisp_Object tbl, tmp = read_list (1, readcharfun);
+ Lisp_Object tbl, tmp = read_list (1, readcharfun, false);
- ptrdiff_t size = XFIXNUM (Flength (tmp));
+ ptrdiff_t size = list_length (tmp);
int i, depth, min_char;
struct Lisp_Cons *cell;
\f
static Lisp_Object
-read_vector (Lisp_Object readcharfun, bool bytecodeflag)
+read_vector (Lisp_Object readcharfun, bool bytecodeflag, bool locate_syms)
{
- ptrdiff_t i, size;
- Lisp_Object *ptr;
- Lisp_Object tem, item, vector;
- struct Lisp_Cons *otem;
- Lisp_Object len;
-
- tem = read_list (1, readcharfun, locate_syms);
- len = Flength (tem);
- if (bytecodeflag && XFIXNAT (len) <= COMPILED_STACK_DEPTH)
- Lisp_Object tem = read_list (1, readcharfun);
++ Lisp_Object tem = read_list (1, readcharfun, locate_syms);
+ ptrdiff_t size = list_length (tem);
+ if (bytecodeflag && size <= COMPILED_STACK_DEPTH)
error ("Invalid byte code");
- vector = Fmake_vector (len, Qnil);
+ Lisp_Object vector = make_nil_vector (size);
- size = XFIXNAT (len);
- ptr = XVECTOR (vector)->contents;
- for (i = 0; i < size; i++)
+ Lisp_Object *ptr = XVECTOR (vector)->contents;
+ for (ptrdiff_t i = 0; i < size; i++)
{
- item = Fcar (tem);
+ Lisp_Object item = Fcar (tem);
/* If `load-force-doc-strings' is t when reading a lazily-loaded
bytecode object, the docstring containing the bytecode and
constants values must be treated as unibyte and passed to
projects / emacs.git / commitdiff