From d6ab9dcbe18803543d23bd2bc1639fd584dd1b2c Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Mon, 9 May 2022 09:53:30 -0700 Subject: [PATCH] Always enable symbols with position MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Remove the variable symbols-with-pos-enabled, which led to confusing semantics. Instead, use a different implementation that should be at least as fast as the old implementation even with symbols-with-pos-enabled set to nil. * src/alloc.c (set_symbol_name): Remove. * src/alloc.c (init_symbol, live_symbol_holding) (process_mark_stack, build_symbol_with_pos): * src/data.c (Ftype_of, Fbare_symbol_p, Fbare_symbol) (Fsymbol_with_pos_pos, Fremove_pos_from_symbol, Fposition_symbol) * src/fns.c (internal_equal, hashfn_eq, sxhash_obj): * src/lisp.h (SYMBOLP, SYMBOL_WITH_POS_P, SYMBOL_WITH_POS_POS): * src/pdumper.c (dump_symbol, dump_vectorlike): * src/print.c (print_vectorlike, print_object): Adapt to new struct Lisp_Symbol layout. A symbol with position is now a symbol instead of a pseudovector. * src/data.c (symbols-with-pos-enabled): Remove. All uses removed; this feature is always enabled now. * src/lisp.h (PSEUDOVECTORP, EQ, SYMBOL_WITH_POS_P): Now functions instead of macros, since they uses args more than once and we don’t want callers to worry about double evaluation. (SYMBOLP): Go back to being a macro, since it no longer needs to eval its argument more than once. Simplify. (BARE_SYMBOL_P, PVEC_SYMBOL_WITH_POS, SYMBOL_WITH_POS_SYM): Remove. All uses removed. (struct Lisp_Symbol.sym): New member. (XSYMBOL): Simplify by using new member. (lisp_h_2TAGGEDP): New macro. (EQ): Boost performance by using it. (SYMBOL_HAS_POS, SYMBOL_SANS_POS): New functions. --- doc/lispref/symbols.texi | 14 +- lisp/emacs-lisp/bytecomp.el | 6 +- lisp/emacs-lisp/comp.el | 1 - lisp/emacs-lisp/macroexp.el | 6 +- src/alloc.c | 36 +++-- src/data.c | 35 ++--- src/fns.c | 23 ++-- src/keyboard.c | 1 - src/lisp.h | 268 ++++++++++++++++-------------------- src/pdumper.c | 10 +- src/print.c | 39 ++---- 11 files changed, 180 insertions(+), 259 deletions(-) diff --git a/doc/lispref/symbols.texi b/doc/lispref/symbols.texi index 336fa9c918..29f1593440 100644 --- a/doc/lispref/symbols.texi +++ b/doc/lispref/symbols.texi @@ -771,25 +771,15 @@ Symbols with Position operation. The byte compiler does this before writing its output to the compiled Lisp file. -For most purposes, when the flag variable -@code{symbols-with-pos-enabled} is non-@code{nil}, symbols with +For most purposes, symbols with positions behave just as bare symbols do. For example, @samp{(eq -# foo)} has a value @code{t} when that variable -is set (but @code{nil} when it isn't set). Most of the time in Emacs this -variable is @code{nil}, but the byte compiler binds it to @code{t} -when it runs. +# foo)} has a value @code{t}. Typically, symbols with position are created by the byte compiler calling the reader function @code{read-positioning-symbols} (@pxref{Input Functions}). One can also be created with the function @code{position-symbol}. -@defvar symbols-with-pos-enabled -When this variable is non-@code{nil}, symbols with position behave -like the contained bare symbol. Emacs runs a little more slowly in -this case. -@end defvar - @defvar print-symbols-bare When bound to non-nil, the Lisp printer prints only the bare symbol of a symbol with position, ignoring the position. diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index c0dffe544c..d27bd4b9f1 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -1226,8 +1226,7 @@ byte-compile-warning-prefix load-file-name dir))) (t ""))) (offset (byte-compile--warning-source-offset)) - (pos (if (and byte-compile-current-file - (or offset (not symbols-with-pos-enabled))) + (pos (if (and byte-compile-current-file offset) (with-current-buffer byte-compile-current-buffer (let (new-l new-c) (save-excursion @@ -2213,7 +2212,6 @@ compile-defun (byte-compile-current-buffer (current-buffer)) (start-read-position (point)) (byte-compile-last-warned-form 'nothing) - (symbols-with-pos-enabled t) (value (eval (displaying-byte-compile-warnings (byte-compile-sexp @@ -2251,7 +2249,7 @@ byte-compile-from-buffer (byte-compile-output nil) ;; #### This is bound in b-c-close-variables. ;; (byte-compile-warnings byte-compile-warnings) - (symbols-with-pos-enabled t)) + ) (byte-compile-close-variables (with-current-buffer (setq byte-compile--outbuffer diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index 237de52884..0452269b95 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -4019,7 +4019,6 @@ comp--native-compile (data function-or-file) (comp-native-compiling t) (byte-native-qualities nil) - (symbols-with-pos-enabled t) ;; Have byte compiler signal an error when compilation fails. (byte-compile-debug t) (comp-ctxt (make-comp-ctxt :output output diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el index 51c6e8e0ca..9f02d0a18e 100644 --- a/lisp/emacs-lisp/macroexp.el +++ b/lisp/emacs-lisp/macroexp.el @@ -107,8 +107,7 @@ macroexp--all-clauses (defun macroexp--compiler-macro (handler form) (condition-case-unless-debug err - (let ((symbols-with-pos-enabled t)) - (apply handler form (cdr form))) + (apply handler form (cdr form)) (error (message "Compiler-macro error for %S: Handler: %S\n%S" (car form) handler err) form))) @@ -731,8 +730,7 @@ macroexp--debug-eager (defun internal-macroexpand-for-load (form full-p) ;; Called from the eager-macroexpansion in readevalloop. - (let ((symbols-with-pos-enabled t) - (print-symbols-bare t)) + (let ((print-symbols-bare t)) (cond ;; Don't repeat the same warning for every top-level element. ((eq 'skip (car macroexp--pending-eager-loads)) form) diff --git a/src/alloc.c b/src/alloc.c index 43fbbb79be..aa9feb54ca 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -577,7 +577,7 @@ pointer_align (void *ptr, int alignment) static ATTRIBUTE_NO_SANITIZE_UNDEFINED void * XPNTR (Lisp_Object a) { - return (BARE_SYMBOL_P (a) + return (SYMBOLP (a) ? (char *) lispsym + (XLI (a) - LISP_WORD_TAG (Lisp_Symbol)) : (char *) XLP (a) - (XLI (a) & ~VALMASK)); } @@ -3616,13 +3616,15 @@ set_symbol_name (Lisp_Object sym, Lisp_Object name) void init_symbol (Lisp_Object val, Lisp_Object name) { + eassert (STRINGP (name)); struct Lisp_Symbol *p = XBARE_SYMBOL (val); + p->u.s.sym = p; set_symbol_name (val, name); - set_symbol_plist (val, Qnil); + p->u.s.plist = Qnil; p->u.s.redirect = SYMBOL_PLAINVAL; SET_SYMBOL_VAL (p, Qunbound); - set_symbol_function (val, Qnil); - set_symbol_next (val, NULL); + p->u.s.function = Qnil; + p->u.s.next = NULL; p->u.s.gcmarkbit = false; p->u.s.interned = SYMBOL_UNINTERNED; p->u.s.trapped_write = SYMBOL_UNTRAPPED_WRITE; @@ -3683,14 +3685,10 @@ make_misc_ptr (void *a) Lisp_Object build_symbol_with_pos (Lisp_Object symbol, Lisp_Object position) { - Lisp_Object val; - struct Lisp_Symbol_With_Pos *p - = (struct Lisp_Symbol_With_Pos *) allocate_vector (2); - XSETVECTOR (val, p); - XSETPVECTYPESIZE (XVECTOR (val), PVEC_SYMBOL_WITH_POS, 2, 0); - p->sym = symbol; - p->pos = position; - + Lisp_Object val = Fmake_symbol (SYMBOL_NAME (symbol)); + struct Lisp_Symbol *sym = XBARE_SYMBOL (val); + sym->u.s.sym = XBARE_SYMBOL (symbol); + sym->u.s.val.value = position; return val; } @@ -4639,6 +4637,7 @@ live_symbol_holding (struct mem_node *m, void *p) || off == offsetof (struct Lisp_Symbol, u.s.val) || off == offsetof (struct Lisp_Symbol, u.s.function) || off == offsetof (struct Lisp_Symbol, u.s.plist) + || off == offsetof (struct Lisp_Symbol, u.s.sym) || off == offsetof (struct Lisp_Symbol, u.s.next)) { struct Lisp_Symbol *s = p = cp -= off; @@ -5238,7 +5237,7 @@ valid_lisp_object_p (Lisp_Object obj) if (PURE_P (p)) return 1; - if (BARE_SYMBOL_P (obj) && c_symbol_p (p)) + if (SYMBOLP (obj) && c_symbol_p (p)) return ((char *) p - (char *) lispsym) % sizeof lispsym[0] == 0; if (p == &buffer_defaults || p == &buffer_local_symbols) @@ -5670,7 +5669,7 @@ purecopy (Lisp_Object obj) pin_string (vec->contents[1]); XSETVECTOR (obj, vec); } - else if (BARE_SYMBOL_P (obj)) + else if (SYMBOLP (obj)) { if (!XBARE_SYMBOL (obj)->u.s.pinned && !c_symbol_p (XBARE_SYMBOL (obj))) { /* We can't purify them, but they appear in many pure objects. @@ -6313,10 +6312,7 @@ DEFUN ("garbage-collect", Fgarbage_collect, Sgarbage_collect, 0, 0, "", if (garbage_collection_inhibited) return Qnil; - specpdl_ref count = SPECPDL_INDEX (); - specbind (Qsymbols_with_pos_enabled, Qnil); garbage_collect (); - unbind_to (count, Qnil); struct gcstat gcst = gcstat; Lisp_Object total[] = { @@ -6464,8 +6460,8 @@ mark_char_table (struct Lisp_Vector *ptr, enum pvec_type pvectype) { Lisp_Object val = ptr->contents[i]; - if (FIXNUMP (val) || - (BARE_SYMBOL_P (val) && symbol_marked_p (XBARE_SYMBOL (val)))) + if (FIXNUMP (val) + || (SYMBOLP (val) && symbol_marked_p (XBARE_SYMBOL (val)))) continue; if (SUB_CHAR_TABLE_P (val)) { @@ -6931,6 +6927,8 @@ #define CHECK_ALLOCATED_AND_LIVE_SYMBOL() ((void) 0) set_symbol_marked (ptr); /* Attempt to catch bogus objects. */ eassert (valid_lisp_object_p (ptr->u.s.function)); + if (ptr->u.s.sym != ptr) + mark_stack_push_value (make_lisp_symbol (ptr->u.s.sym)); mark_stack_push_value (ptr->u.s.function); mark_stack_push_value (ptr->u.s.plist); switch (ptr->u.s.redirect) diff --git a/src/data.c b/src/data.c index 72dcf6f878..4b91b38b72 100644 --- a/src/data.c +++ b/src/data.c @@ -202,7 +202,7 @@ DEFUN ("type-of", Ftype_of, Stype_of, 1, 1, 0, return Qinteger; case Lisp_Symbol: - return Qsymbol; + return SYMBOL_HAS_POS (object) ? Qsymbol_with_pos : Qsymbol; case Lisp_String: return Qstring; @@ -217,7 +217,6 @@ DEFUN ("type-of", Ftype_of, Stype_of, 1, 1, 0, case PVEC_NORMAL_VECTOR: return Qvector; case PVEC_BIGNUM: return Qinteger; case PVEC_MARKER: return Qmarker; - case PVEC_SYMBOL_WITH_POS: return Qsymbol_with_pos; case PVEC_OVERLAY: return Qoverlay; case PVEC_FINALIZER: return Qfinalizer; case PVEC_USER_PTR: return Quser_ptr; @@ -325,7 +324,7 @@ DEFUN ("bare-symbol-p", Fbare_symbol_p, Sbare_symbol_p, 1, 1, 0, attributes: const) (Lisp_Object object) { - if (BARE_SYMBOL_P (object)) + if (SYMBOLP (object) && !SYMBOL_HAS_POS (object)) return Qt; return Qnil; } @@ -781,17 +780,15 @@ DEFUN ("bare-symbol", Fbare_symbol, Sbare_symbol, 1, 1, 0, doc: /* Extract, if need be, the bare symbol from SYM, a symbol. */) (register Lisp_Object sym) { - if (BARE_SYMBOL_P (sym)) - return sym; - /* Type checking is done in the following macro. */ - return SYMBOL_WITH_POS_SYM (sym); + CHECK_SYMBOL (sym); + return SYMBOL_SANS_POS (sym); } DEFUN ("symbol-with-pos-pos", Fsymbol_with_pos_pos, Ssymbol_with_pos_pos, 1, 1, 0, doc: /* Extract the position from a symbol with position. */) (register Lisp_Object ls) { - /* Type checking is done in the following macro. */ + CHECK_TYPE (SYMBOL_WITH_POS_P (ls), Qsymbol_with_pos_p, ls); return SYMBOL_WITH_POS_POS (ls); } @@ -801,9 +798,7 @@ DEFUN ("remove-pos-from-symbol", Fremove_pos_from_symbol, Otherwise, return ARG unchanged. Compare with `bare-symbol'. */) (register Lisp_Object arg) { - if (SYMBOL_WITH_POS_P (arg)) - return (SYMBOL_WITH_POS_SYM (arg)); - return arg; + return SYMBOLP (arg) ? SYMBOL_SANS_POS (arg) : arg; } DEFUN ("position-symbol", Fposition_symbol, Sposition_symbol, 2, 2, 0, @@ -813,20 +808,14 @@ DEFUN ("position-symbol", Fposition_symbol, Sposition_symbol, 2, 2, 0, the position will be taken. */) (register Lisp_Object sym, register Lisp_Object pos) { - Lisp_Object bare; + CHECK_SYMBOL (sym); + Lisp_Object bare = SYMBOL_SANS_POS (sym); Lisp_Object position; - if (BARE_SYMBOL_P (sym)) - bare = sym; - else if (SYMBOL_WITH_POS_P (sym)) - bare = XSYMBOL_WITH_POS (sym)->sym; - else - wrong_type_argument (Qsymbolp, sym); - if (FIXNUMP (pos)) position = pos; else if (SYMBOL_WITH_POS_P (pos)) - position = XSYMBOL_WITH_POS (pos)->pos; + position = SYMBOL_WITH_POS_POS (pos); else wrong_type_argument (Qfixnum_or_symbol_with_pos_p, pos); @@ -4401,12 +4390,6 @@ #define PUT_ERROR(sym, tail, msg) \ Vmost_negative_fixnum = make_fixnum (MOST_NEGATIVE_FIXNUM); make_symbol_constant (intern_c_string ("most-negative-fixnum")); - DEFSYM (Qsymbols_with_pos_enabled, "symbols-with-pos-enabled"); - DEFVAR_BOOL ("symbols-with-pos-enabled", symbols_with_pos_enabled, - doc: /* Non-nil when "symbols with position" can be used as symbols. -Bind this to non-nil in applications such as the byte compiler. */); - symbols_with_pos_enabled = false; - DEFSYM (Qwatchers, "watchers"); DEFSYM (Qmakunbound, "makunbound"); DEFSYM (Qunlet, "unlet"); diff --git a/src/fns.c b/src/fns.c index 2c206c62b2..5455f3feb8 100644 --- a/src/fns.c +++ b/src/fns.c @@ -2512,20 +2512,19 @@ internal_equal (Lisp_Object o1, Lisp_Object o2, enum equal_kind equal_kind, } } - /* A symbol with position compares the contained symbol, and is - `equal' to the corresponding ordinary symbol. */ - if (SYMBOL_WITH_POS_P (o1)) - o1 = SYMBOL_WITH_POS_SYM (o1); - if (SYMBOL_WITH_POS_P (o2)) - o2 = SYMBOL_WITH_POS_SYM (o2); - - if (EQ (o1, o2)) + + if (BASE_EQ (o1, o2)) return true; if (XTYPE (o1) != XTYPE (o2)) return false; switch (XTYPE (o1)) { + case Lisp_Symbol: + /* A symbol with position compares the contained symbol, and equals + the corresponding ordinary symbol. */ + return XSYMBOL (o1) == XSYMBOL (o2); + case Lisp_Float: return same_float (o1, o2); @@ -4148,8 +4147,8 @@ cmpfn_user_defined (Lisp_Object key1, Lisp_Object key2, static Lisp_Object hashfn_eq (Lisp_Object key, struct Lisp_Hash_Table *h) { - if (symbols_with_pos_enabled && SYMBOL_WITH_POS_P (key)) - key = SYMBOL_WITH_POS_SYM (key); + if (SYMBOLP (key)) + key = SYMBOL_SANS_POS (key); return make_ufixnum (XHASH (key) ^ XTYPE (key)); } @@ -4825,7 +4824,7 @@ sxhash_obj (Lisp_Object obj, int depth) return XUFIXNUM (obj); case Lisp_Symbol: - return XHASH (obj); + return XHASH (SYMBOL_SANS_POS (obj)); case Lisp_String: return sxhash_string (SSDATA (obj), SBYTES (obj)); @@ -4865,8 +4864,6 @@ sxhash_obj (Lisp_Object obj, int depth) hash = sxhash_combine (hash, sxhash_obj (XOVERLAY (obj)->plist, depth)); return SXHASH_REDUCE (hash); } - else if (symbols_with_pos_enabled && pvec_type == PVEC_SYMBOL_WITH_POS) - return sxhash_obj (XSYMBOL_WITH_POS (obj)->sym, depth + 1); else /* Others are 'equal' if they are 'eq', so take their address as hash. */ diff --git a/src/keyboard.c b/src/keyboard.c index e8f51f8a6f..f5c4f16245 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -692,7 +692,6 @@ recursive_edit_1 (void) { specbind (Qstandard_output, Qt); specbind (Qstandard_input, Qt); - specbind (Qsymbols_with_pos_enabled, Qnil); specbind (Qprint_symbols_bare, Qnil); } diff --git a/src/lisp.h b/src/lisp.h index 1ad89fc468..66b059b1a3 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -356,41 +356,18 @@ #define LISP_WORDS_ARE_POINTERS (EMACS_INT_MAX == INTPTR_MAX) # define lisp_h_Qnil {0} #endif -#define lisp_h_PSEUDOVECTORP(a,code) \ - (lisp_h_VECTORLIKEP((a)) && \ - ((XUNTAG ((a), Lisp_Vectorlike, union vectorlike_header)->size \ - & (PSEUDOVECTOR_FLAG | PVEC_TYPE_MASK)) \ - == (PSEUDOVECTOR_FLAG | ((code) << PSEUDOVECTOR_AREA_BITS)))) - #define lisp_h_CHECK_FIXNUM(x) CHECK_TYPE (FIXNUMP (x), Qfixnump, x) #define lisp_h_CHECK_SYMBOL(x) CHECK_TYPE (SYMBOLP (x), Qsymbolp, x) #define lisp_h_CHECK_TYPE(ok, predicate, x) \ ((ok) ? (void) 0 : wrong_type_argument (predicate, x)) #define lisp_h_CONSP(x) TAGGEDP (x, Lisp_Cons) #define lisp_h_BASE_EQ(x, y) (XLI (x) == XLI (y)) - -/* FIXME: Do we really need to inline the whole thing? - * What about keeping the part after `symbols_with_pos_enabled` in - * a separate function? */ -#define lisp_h_EQ(x, y) \ - ((XLI ((x)) == XLI ((y))) \ - || (symbols_with_pos_enabled \ - && (SYMBOL_WITH_POS_P ((x)) \ - ? (BARE_SYMBOL_P ((y)) \ - ? XLI (XSYMBOL_WITH_POS((x))->sym) == XLI (y) \ - : SYMBOL_WITH_POS_P((y)) \ - && (XLI (XSYMBOL_WITH_POS((x))->sym) \ - == XLI (XSYMBOL_WITH_POS((y))->sym))) \ - : (SYMBOL_WITH_POS_P ((y)) \ - && BARE_SYMBOL_P ((x)) \ - && (XLI (x) == XLI ((XSYMBOL_WITH_POS ((y)))->sym)))))) - #define lisp_h_FIXNUMP(x) \ (! (((unsigned) (XLI (x) >> (USE_LSB_TAG ? 0 : FIXNUM_BITS)) \ - (unsigned) (Lisp_Int0 >> !USE_LSB_TAG)) \ & ((1 << INTTYPEBITS) - 1))) #define lisp_h_FLOATP(x) TAGGEDP (x, Lisp_Float) -#define lisp_h_NILP(x) BASE_EQ (x, Qnil) +#define lisp_h_NILP(x) BASE_EQ (x, Qnil) #define lisp_h_SET_SYMBOL_VAL(sym, v) \ (eassert ((sym)->u.s.redirect == SYMBOL_PLAINVAL), \ (sym)->u.s.val.value = (v)) @@ -399,14 +376,17 @@ #define lisp_h_SYMBOL_CONSTANT_P(sym) \ #define lisp_h_SYMBOL_TRAPPED_WRITE_P(sym) (XSYMBOL (sym)->u.s.trapped_write) #define lisp_h_SYMBOL_VAL(sym) \ (eassert ((sym)->u.s.redirect == SYMBOL_PLAINVAL), (sym)->u.s.val.value) -#define lisp_h_SYMBOL_WITH_POS_P(x) PSEUDOVECTORP ((x), PVEC_SYMBOL_WITH_POS) -#define lisp_h_BARE_SYMBOL_P(x) TAGGEDP ((x), Lisp_Symbol) -#define lisp_h_SYMBOLP(x) ((BARE_SYMBOL_P ((x)) || \ - (symbols_with_pos_enabled && (SYMBOL_WITH_POS_P ((x)))))) +#define lisp_h_SYMBOLP(x) TAGGEDP (x, Lisp_Symbol) #define lisp_h_TAGGEDP(a, tag) \ (! (((unsigned) (XLI (a) >> (USE_LSB_TAG ? 0 : VALBITS)) \ - (unsigned) (tag)) \ & ((1 << GCTYPEBITS) - 1))) +#define lisp_h_2TAGGEDP(a, b, tag) \ + (! ((((unsigned) (XLI (a) >> (USE_LSB_TAG ? 0 : VALBITS)) \ + - (unsigned) (tag)) \ + | ((unsigned) (XLI (b) >> (USE_LSB_TAG ? 0 : VALBITS)) \ + - (unsigned) (tag))) \ + & ((1 << GCTYPEBITS) - 1))) #define lisp_h_VECTORLIKEP(x) TAGGEDP (x, Lisp_Vectorlike) #define lisp_h_XCAR(c) XCONS (c)->u.s.car #define lisp_h_XCDR(c) XCONS (c)->u.s.u.cdr @@ -447,7 +427,6 @@ #define lisp_h_XHASH(a) XUFIXNUM_RAW (a) # define XLI(o) lisp_h_XLI (o) # define XIL(i) lisp_h_XIL (i) # define XLP(o) lisp_h_XLP (o) -# define BARE_SYMBOL_P(x) lisp_h_BARE_SYMBOL_P (x) # define CHECK_FIXNUM(x) lisp_h_CHECK_FIXNUM (x) # define CHECK_SYMBOL(x) lisp_h_CHECK_SYMBOL (x) # define CHECK_TYPE(ok, predicate, x) lisp_h_CHECK_TYPE (ok, predicate, x) @@ -460,7 +439,7 @@ #define lisp_h_XHASH(a) XUFIXNUM_RAW (a) # define SYMBOL_CONSTANT_P(sym) lisp_h_SYMBOL_CONSTANT_P (sym) # define SYMBOL_TRAPPED_WRITE_P(sym) lisp_h_SYMBOL_TRAPPED_WRITE_P (sym) # define SYMBOL_VAL(sym) lisp_h_SYMBOL_VAL (sym) -/* # define SYMBOLP(x) lisp_h_SYMBOLP (x) */ /* X is accessed more than once. */ +# define SYMBOLP(x) lisp_h_SYMBOLP (x) # define TAGGEDP(a, tag) lisp_h_TAGGEDP (a, tag) # define VECTORLIKEP(x) lisp_h_VECTORLIKEP (x) # define XCAR(c) lisp_h_XCAR (c) @@ -619,7 +598,6 @@ #define ENUM_BF(TYPE) enum TYPE extern void char_table_set (Lisp_Object, int, Lisp_Object); /* Defined in data.c. */ -extern bool symbols_with_pos_enabled; extern AVOID args_out_of_range_3 (Lisp_Object, Lisp_Object, Lisp_Object); extern AVOID wrong_type_argument (Lisp_Object, Lisp_Object); extern Lisp_Object default_value (Lisp_Object symbol); @@ -835,10 +813,10 @@ #define XUNTAG(a, type, ctype) ((ctype *) \ bool_bf gcmarkbit : 1; /* Indicates where the value can be found: - 0 : it's a plain var, the value is in the `value' field. - 1 : it's a varalias, the value is really in the `alias' symbol. - 2 : it's a localized var, the value is in the `blv' object. - 3 : it's a forwarding variable, the value is in `forward'. */ + SYMBOL_PLAINVAL : it's a plain var; see val.value. + SYMBOL_VARALIAS : it's a varalias; see val.alias. + SYMBOL_LOCALIZED : it's a localized var; see val.blv. + SYMBOL_FORWARDED : it's a forwarding variable; see val.fwd. */ ENUM_BF (symbol_redirect) redirect : 3; /* 0 : normal case, just set the value @@ -857,6 +835,13 @@ #define XUNTAG(a, type, ctype) ((ctype *) \ /* True if pointed to from purespace and hence can't be GC'd. */ bool_bf pinned : 1; + /* Ordinarily a self-pointer. But in a symbol with position + this points to the actual symbol, and the only other possibly + nonzero or non-nil members of this struct are gcmarkbit, + redirect (which must be SYMBOL_PLAINVAL), pinned, name (which + must == sym->s.u.s.name), and val.value (the position, a fixnum). */ + struct Lisp_Symbol *sym; + /* The symbol's name, as a Lisp string. */ Lisp_Object name; @@ -1006,12 +991,63 @@ #define ROUNDUP(x, y) (POWER_OF_2 (y) \ ptrdiff_t size; }; -struct Lisp_Symbol_With_Pos +INLINE bool +(SYMBOLP) (Lisp_Object x) { - union vectorlike_header header; - Lisp_Object sym; /* A symbol */ - Lisp_Object pos; /* A fixnum */ -} GCALIGNED_STRUCT; + return lisp_h_SYMBOLP (x); +} + +INLINE struct Lisp_Symbol * ATTRIBUTE_NO_SANITIZE_UNDEFINED +XBARE_SYMBOL (Lisp_Object sym) +{ + eassert (SYMBOLP (sym)); + intptr_t i = (intptr_t) XUNTAG (sym, Lisp_Symbol, struct Lisp_Symbol); + void *p = (char *) lispsym + i; + return p; +} + +INLINE struct Lisp_Symbol * ATTRIBUTE_NO_SANITIZE_UNDEFINED +XSYMBOL (Lisp_Object sym) +{ + return XBARE_SYMBOL (sym)->u.s.sym; +} + +INLINE Lisp_Object +make_lisp_symbol (struct Lisp_Symbol *sym) +{ + /* GCC 7 x86-64 generates faster code if lispsym is + cast to char * rather than to intptr_t. */ + char *symoffset = (char *) ((char *) sym - (char *) lispsym); + Lisp_Object a = TAG_PTR (Lisp_Symbol, symoffset); + eassert (XBARE_SYMBOL (a) == sym); + return a; +} + +INLINE Lisp_Object +builtin_lisp_symbol (int index) +{ + return make_lisp_symbol (&lispsym[index]); +} + +INLINE bool +c_symbol_p (struct Lisp_Symbol *sym) +{ + char *bp = (char *) lispsym; + char *sp = (char *) sym; + if (PTRDIFF_MAX < INTPTR_MAX) + return bp <= sp && sp < bp + sizeof lispsym; + else + { + ptrdiff_t offset = sp - bp; + return 0 <= offset && offset < sizeof lispsym; + } +} + +INLINE void +(CHECK_SYMBOL) (Lisp_Object x) +{ + lisp_h_CHECK_SYMBOL (x); +} /* In the size word of a vector, this bit means the vector has been marked. */ @@ -1036,7 +1072,6 @@ DEFINE_GDB_SYMBOL_END (PSEUDOVECTOR_FLAG) PVEC_MARKER, PVEC_OVERLAY, PVEC_FINALIZER, - PVEC_SYMBOL_WITH_POS, PVEC_MISC_PTR, PVEC_USER_PTR, PVEC_PROCESS, @@ -1096,92 +1131,6 @@ DEFINE_GDB_SYMBOL_END (PSEUDOVECTOR_FLAG) values. They are macros for use in #if and static initializers. */ #define MOST_POSITIVE_FIXNUM (EMACS_INT_MAX >> INTTYPEBITS) #define MOST_NEGATIVE_FIXNUM (-1 - MOST_POSITIVE_FIXNUM) - -INLINE bool -PSEUDOVECTORP (Lisp_Object a, int code) -{ - return lisp_h_PSEUDOVECTORP (a, code); -} - -INLINE bool -(BARE_SYMBOL_P) (Lisp_Object x) -{ - return lisp_h_BARE_SYMBOL_P (x); -} - -INLINE bool -(SYMBOL_WITH_POS_P) (Lisp_Object x) -{ - return lisp_h_SYMBOL_WITH_POS_P (x); -} - -INLINE bool -(SYMBOLP) (Lisp_Object x) -{ - return lisp_h_SYMBOLP (x); -} - -INLINE struct Lisp_Symbol_With_Pos * -XSYMBOL_WITH_POS (Lisp_Object a) -{ - eassert (SYMBOL_WITH_POS_P (a)); - return XUNTAG (a, Lisp_Vectorlike, struct Lisp_Symbol_With_Pos); -} - -INLINE struct Lisp_Symbol * ATTRIBUTE_NO_SANITIZE_UNDEFINED -(XBARE_SYMBOL) (Lisp_Object a) -{ - eassert (BARE_SYMBOL_P (a)); - intptr_t i = (intptr_t) XUNTAG (a, Lisp_Symbol, struct Lisp_Symbol); - void *p = (char *) lispsym + i; - return p; -} - -INLINE struct Lisp_Symbol * ATTRIBUTE_NO_SANITIZE_UNDEFINED -(XSYMBOL) (Lisp_Object a) -{ - eassert (SYMBOLP ((a))); - if (!symbols_with_pos_enabled || BARE_SYMBOL_P (a)) - return XBARE_SYMBOL (a); - return XBARE_SYMBOL (XSYMBOL_WITH_POS (a)->sym); -} - -INLINE Lisp_Object -make_lisp_symbol (struct Lisp_Symbol *sym) -{ - /* GCC 7 x86-64 generates faster code if lispsym is - cast to char * rather than to intptr_t. */ - char *symoffset = (char *) ((char *) sym - (char *) lispsym); - Lisp_Object a = TAG_PTR (Lisp_Symbol, symoffset); - eassert (XSYMBOL (a) == sym); - return a; -} - -INLINE Lisp_Object -builtin_lisp_symbol (int index) -{ - return make_lisp_symbol (&lispsym[index]); -} - -INLINE bool -c_symbol_p (struct Lisp_Symbol *sym) -{ - char *bp = (char *) lispsym; - char *sp = (char *) sym; - if (PTRDIFF_MAX < INTPTR_MAX) - return bp <= sp && sp < bp + sizeof lispsym; - else - { - ptrdiff_t offset = sp - bp; - return 0 <= offset && offset < sizeof lispsym; - } -} - -INLINE void -(CHECK_SYMBOL) (Lisp_Object x) -{ - lisp_h_CHECK_SYMBOL (x); -} /* True if the possibly-unsigned integer I doesn't fit in a fixnum. */ @@ -1322,9 +1271,11 @@ make_fixed_natnum (EMACS_INT n) /* Return true if X and Y are the same object, reckoning a symbol with position as being the same as the bare symbol. */ INLINE bool -(EQ) (Lisp_Object x, Lisp_Object y) +EQ (Lisp_Object x, Lisp_Object y) { - return lisp_h_EQ (x, y); + return (BASE_EQ (x, y) + || (lisp_h_2TAGGEDP (x, y, Lisp_Symbol) + && XSYMBOL (x) == XSYMBOL (y))); } INLINE intmax_t @@ -1795,6 +1746,21 @@ PSEUDOVECTOR_TYPEP (const union vectorlike_header *a, enum pvec_type code) == (PSEUDOVECTOR_FLAG | (code << PSEUDOVECTOR_AREA_BITS))); } +/* True if A is a pseudovector whose code is CODE. */ +INLINE bool +PSEUDOVECTORP (Lisp_Object a, int code) +{ + if (! VECTORLIKEP (a)) + return false; + else + { + /* Converting to union vectorlike_header * avoids aliasing issues. */ + return PSEUDOVECTOR_TYPEP (XUNTAG (a, Lisp_Vectorlike, + union vectorlike_header), + code); + } +} + /* A boolvector is a kind of vectorlike, with contents like a string. */ struct Lisp_Bool_Vector @@ -2307,7 +2273,33 @@ SET_SYMBOL_FWD (struct Lisp_Symbol *sym, void const *v) INLINE Lisp_Object SYMBOL_NAME (Lisp_Object sym) { - return XSYMBOL (sym)->u.s.name; + return XBARE_SYMBOL (sym)->u.s.name; +} + +INLINE bool +SYMBOL_HAS_POS (Lisp_Object sym) +{ + struct Lisp_Symbol *s = XBARE_SYMBOL (sym); + return s->u.s.sym != s; +} + +INLINE bool +SYMBOL_WITH_POS_P (Lisp_Object a) +{ + return SYMBOLP (a) && SYMBOL_HAS_POS (a); +} + +INLINE Lisp_Object +SYMBOL_WITH_POS_POS (Lisp_Object sym) +{ + eassert (SYMBOL_WITH_POS_P (sym)); + return XBARE_SYMBOL (sym)->u.s.val.value; +} + +INLINE Lisp_Object +SYMBOL_SANS_POS (Lisp_Object sym) +{ + return make_lisp_symbol (XSYMBOL (sym)); } /* Value is true if SYM is an interned symbol. */ @@ -2717,22 +2709,6 @@ XOVERLAY (Lisp_Object a) return XUNTAG (a, Lisp_Vectorlike, struct Lisp_Overlay); } -INLINE Lisp_Object -SYMBOL_WITH_POS_SYM (Lisp_Object a) -{ - if (!SYMBOL_WITH_POS_P (a)) - wrong_type_argument (Qsymbol_with_pos_p, a); - return XSYMBOL_WITH_POS (a)->sym; -} - -INLINE Lisp_Object -SYMBOL_WITH_POS_POS (Lisp_Object a) -{ - if (!SYMBOL_WITH_POS_P (a)) - wrong_type_argument (Qsymbol_with_pos_p, a); - return XSYMBOL_WITH_POS (a)->pos; -} - INLINE bool USER_PTRP (Lisp_Object x) { diff --git a/src/pdumper.c b/src/pdumper.c index 5923d9b1d8..87219c97ed 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -2412,7 +2412,7 @@ dump_symbol (struct dump_context *ctx, Lisp_Object object, dump_off offset) { -#if CHECK_STRUCTS && !defined HASH_Lisp_Symbol_999DC26DEC +#if CHECK_STRUCTS && !defined HASH_Lisp_Symbol_7825A51095 # error "Lisp_Symbol changed. See CHECK_STRUCTS comment in config.h." #endif #if CHECK_STRUCTS && !defined (HASH_symbol_redirect_ADB4F5B113) @@ -2441,7 +2441,7 @@ dump_symbol (struct dump_context *ctx, return offset; } - struct Lisp_Symbol *symbol = XSYMBOL (object); + struct Lisp_Symbol *symbol = XBARE_SYMBOL (object); struct Lisp_Symbol out; dump_object_start (ctx, &out, sizeof (out)); eassert (symbol->u.s.gcmarkbit == 0); @@ -2450,6 +2450,8 @@ dump_symbol (struct dump_context *ctx, DUMP_FIELD_COPY (&out, symbol, u.s.interned); DUMP_FIELD_COPY (&out, symbol, u.s.declared_special); DUMP_FIELD_COPY (&out, symbol, u.s.pinned); + dump_field_lv_rawptr (ctx, &out, symbol, &symbol->u.s.sym, Lisp_Symbol, + WEIGHT_NORMAL); dump_field_lv (ctx, &out, symbol, &symbol->u.s.name, WEIGHT_STRONG); switch (symbol->u.s.redirect) { @@ -2949,7 +2951,7 @@ dump_vectorlike (struct dump_context *ctx, Lisp_Object lv, dump_off offset) { -#if CHECK_STRUCTS && !defined HASH_pvec_type_AFF6FED5BD +#if CHECK_STRUCTS && !defined HASH_pvec_type_19F6CF5169 # error "pvec_type changed. See CHECK_STRUCTS comment in config.h." #endif const struct Lisp_Vector *v = XVECTOR (lv); @@ -3033,8 +3035,6 @@ dump_vectorlike (struct dump_context *ctx, error_unsupported_dump_object (ctx, lv, "sqlite"); case PVEC_MODULE_FUNCTION: error_unsupported_dump_object (ctx, lv, "module function"); - case PVEC_SYMBOL_WITH_POS: - error_unsupported_dump_object (ctx, lv, "symbol with pos"); default: error_unsupported_dump_object(ctx, lv, "weird pseudovector"); } diff --git a/src/print.c b/src/print.c index d7583282b6..edd046b629 100644 --- a/src/print.c +++ b/src/print.c @@ -1666,30 +1666,6 @@ print_vectorlike (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag, printchar ('>', printcharfun); break; - case PVEC_SYMBOL_WITH_POS: - { - struct Lisp_Symbol_With_Pos *sp = XSYMBOL_WITH_POS (obj); - if (print_symbols_bare) - print_object (sp->sym, printcharfun, escapeflag); - else - { - print_c_string ("#sym)) - print_object (sp->sym, printcharfun, escapeflag); - else - print_c_string ("NOT A SYMBOL!!", printcharfun); - if (FIXNUMP (sp->pos)) - { - print_c_string (" at ", printcharfun); - print_object (sp->pos, printcharfun, escapeflag); - } - else - print_c_string (" NOT A POSITION!!", printcharfun); - printchar ('>', printcharfun); - } - } - break; - case PVEC_OVERLAY: print_c_string ("#buffer) @@ -2190,6 +2166,9 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) case Lisp_Symbol: { + if (!print_symbols_bare && SYMBOL_HAS_POS (obj)) + print_c_string ("#', printcharfun); + } } break; -- 2.35.3